3 use vars qw( @ISA @EXPORT $Dat_Dir );
9 use Cwd qw( abs_path );
27 $Bulk_File $Odd_File $Woy_File $I8N_File $Narrow_File
29 check_bulk_with_datetool
30 check_odd_with_datetool
31 check_woy_with_datetool
46 use HTML::CalendarMonth;
47 use HTML::CalendarMonth::DateTool;
50 my($vol, $dir, $file) = File::Spec->splitpath(abs_path(__FILE__));
51 $dir = File::Spec->catdir($dir, 'dat');
52 $Dat_Dir = File::Spec->catpath($vol, $dir, '');
55 $Bulk_File = File::Spec->catdir($Dat_Dir, 'bulk.dat');
56 $Odd_File = File::Spec->catdir($Dat_Dir, 'odd.dat');
57 $Woy_File = File::Spec->catdir($Dat_Dir, 'woy.dat');
58 $I8N_File = File::Spec->catdir($Dat_Dir, 'i8n.dat');
59 $Narrow_File = File::Spec->catdir($Dat_Dir, 'narrow.dat');
61 my(@Bulk, @Odd, @Woy, @I8N, @Nar);
65 my $cal = shift || [];
67 return unless open(F, '<', $f);
70 my($d, $wb) = split(/\s+/, $h);
71 my($y, $m) = split(/\//, $d);
74 push(@$cal, [$d, $y, $m, $wb, clean($c)]);
79 _load_file($Bulk_File, \@Bulk );
80 _load_file($Odd_File, \@Odd );
81 _load_file($Woy_File, \@Woy );
82 _load_file($I8N_File, \@I8N );
83 _load_file($Narrow_File, \@Nar);
85 sub bulk_count { scalar @Bulk }
86 sub odd_count { scalar @Odd }
87 sub woy_count { scalar @Woy }
88 sub i8n_count { scalar @I8N }
89 sub narrow_count { scalar @Nar }
92 my($month, $year) = (localtime(time))[4,5];
96 my $today = sprintf("%d/%02d", $year, $month);
97 my $year_from_now = sprintf("%d/%02d", $year+1, $month);
100 @Bulk = grep { $_ ge $today && $_->[0] le $year_from_now } @Bulk;
105 my $str = shift || Carp::confess "string required";
106 $str =~ s/^\s*//; $str =~ s/\s*$//;
107 # guard against HTML::Tree starting to quote numeric attrs as of
109 $str =~ s/\"(\d+)\"/$1/g;
114 my $datetool = shift;
115 my $module = HTML::CalendarMonth::DateTool->_toolmap($datetool);
116 ok($module, "toolmap($datetool) : $module");
120 sub check_bulk_with_datetool {
121 my $datetool = shift;
124 my($d, $y, $m, $wb, $tc) = @$_;
125 my $c = HTML::CalendarMonth->new(
129 datetool => $datetool,
131 @days = $c->dayheaders unless @days;
132 my $day1 = $days[$wb - 1];
133 my $method = $c->_caltool->_name;
134 $method = "auto-select ($method)" unless $datetool;
136 "(%d/%02d %s 1st day) using %s",
137 $y, $m, $day1, $method
139 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
143 sub check_odd_with_datetool {
144 my $datetool = shift;
147 my($d, $y, $m, $wb, $tc) = @$_;
151 $c = HTML::CalendarMonth->new(
155 datetool => $datetool,
159 croak $@ unless $@ =~ /(no|in)\s*valid date tool/i;
160 skip("$datetool skip odd $y/$m", 1);
162 @days = $c->dayheaders unless @days;
163 my $day1 = $days[$wb - 1];
164 my $method = $c->_caltool->_name;
165 $method = "auto-select ($method)" unless $datetool;
167 "(%d/%02d %s 1st day) using %s",
168 $y, $m, $day1, $method
170 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
175 sub check_woy_with_datetool {
176 my $datetool = shift;
178 my($d, $y, $m, $wb, $tc) = @$_;
179 my $c = HTML::CalendarMonth->new(
183 datetool => $datetool,
185 my $msg = sprintf("(%d/%02d week of year) using %s", $y, $m, $datetool);
186 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
192 my($d, $y, $m, $id, $tc) = @$_;
193 my $c = HTML::CalendarMonth->new(
198 my $name = $c->loc->loc->name;
200 "(%d/%02d i8n) %s (wb:%d) using auto-detect",
201 $y, $m, $name, $c->week_begin
203 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
210 my($d, $y, $m, $wb, $tc) = @$_;
211 my $c = HTML::CalendarMonth->new(
217 @days = $c->dayheaders unless @days;
218 my $day1 = $days[$wb - 1];
220 "(%d/%02d %s/%s 1st day) narrow/alias using auto-detect",
221 $y, $m, $day1, $c->item_alias($day1)
223 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
228 my($l1, $str1, $l2, $str2) = @_;
230 open(DUMP, ">$DEBUG") or die "Could not dump to $DEBUG: $!\n";
231 print DUMP "<html><body><table><tr><td>$l1</td><td>$l2</td></tr><tr><td>\n";
232 print DUMP "$str1\n</td><td>\n";
233 print DUMP "$str2\n</td></tr></table></body></html>\n";
235 print STDERR "\nDumped tables to $DEBUG. Aborting test.\n";