3 use vars qw( @ISA @EXPORT $Dat_Dir );
9 use Cwd qw( abs_path );
30 $Bulk_File $Head_File $Odd_File $Woy_File $I8N_File $Narrow_File
32 check_bulk_with_datetool
33 check_odd_with_datetool
34 check_woy_with_datetool
49 use HTML::CalendarMonth;
50 use HTML::CalendarMonth::DateTool;
53 my($vol, $dir, $file) = File::Spec->splitpath(abs_path(__FILE__));
54 $dir = File::Spec->catdir($dir, 'dat');
55 $Dat_Dir = File::Spec->catpath($vol, $dir, '');
58 $Bulk_File = File::Spec->catdir($Dat_Dir, 'bulk.dat');
59 $Head_File = File::Spec->catdir($Dat_Dir, 'head.dat');
60 $Odd_File = File::Spec->catdir($Dat_Dir, 'odd.dat');
61 $Woy_File = File::Spec->catdir($Dat_Dir, 'woy.dat');
62 $Narrow_File = File::Spec->catdir($Dat_Dir, 'narrow.dat');
63 $I8N_File = File::Spec->catdir($Dat_Dir, 'i8n.dat');
64 $I8N_Legacy1_File = File::Spec->catdir($Dat_Dir, 'i8n_leg1.dat');
65 $I8N_Legacy2_File = File::Spec->catdir($Dat_Dir, 'i8n_leg2.dat');
67 my(@Bulk, @Head, @Odd, @Woy, @I8N, @Nar);
71 my $cal = shift || [];
73 return unless open(F, '<', $f);
76 my($d, $wb, @other) = split(/\s+/, $h);
77 my($y, $m) = split(/\//, $d);
80 push(@$cal, [$d, $y, $m, $wb, \@other, clean($c)]);
85 _load_file($Bulk_File, \@Bulk );
86 _load_file($Head_File, \@Head );
87 _load_file($Odd_File, \@Odd );
88 _load_file($Woy_File, \@Woy );
89 _load_file($Narrow_File, \@Nar);
91 if (HTML::CalendarMonth::Locale->_locale_version >= 1.03) {
92 _load_file($I8N_File, \@I8N );
94 elsif (HTML::CalendarMonth::Locale->_locale_version >= 0.93) {
95 _load_file($I8N_Legacy2_File, \@I8N );
98 _load_file($I8N_Legacy1_File, \@I8N );
101 sub bulk_count { scalar @Bulk }
102 sub head_count { scalar @Head }
103 sub odd_count { scalar @Odd }
104 sub woy_count { scalar @Woy }
105 sub i8n_count { scalar @I8N }
106 sub narrow_count { scalar @Nar }
109 my($month, $year) = (localtime(time))[4,5];
113 my $today = sprintf("%d/%02d", $year, $month);
114 my $year_from_now = sprintf("%d/%02d", $year+1, $month);
117 @Bulk = grep { $_ ge $today && $_->[0] le $year_from_now } @Bulk;
122 my $str = shift || Carp::confess "string required";
123 $str =~ s/^\s*//; $str =~ s/\s*$//;
124 # guard against HTML::Tree starting to quote numeric attrs as of
126 $str =~ s/\"(\d+)\"/$1/g;
131 my $datetool = shift;
132 my $module = HTML::CalendarMonth::DateTool->_toolmap($datetool);
133 ok($module, "toolmap($datetool) : $module");
137 sub check_bulk_with_datetool {
138 my $datetool = shift;
141 my($d, $y, $m, $wb, $other, $tc) = @$_;
142 my $c = HTML::CalendarMonth->new(
146 datetool => $datetool,
148 @days = $c->dayheaders unless @days;
149 my $day1 = $days[$wb - 1];
150 my $method = $c->_caltool->_name;
151 $method = "auto-select ($method)" unless $datetool;
153 "(%d/%02d %s 1st day) using %s",
154 $y, $m, $day1, $method
156 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
160 sub check_head_with_datetool {
161 my $datetool = shift;
164 my($d, $y, $m, $wb, $other, $tc) = @$_;
165 my($hm, $hy, $hd, $hw) = @$other;
166 my $c = HTML::CalendarMonth->new(
174 datetool => $datetool,
176 my $method = $c->_caltool->_name;
177 $method = "auto-select ($method)" unless $datetool;
179 "(%d/%02d hm:%d hy:%d hd:%d hw:%d) using %s",
180 $y, $m, $hm, $hy, $hd, $hw, $method
182 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
186 sub check_odd_with_datetool {
187 my $datetool = shift;
190 my($d, $y, $m, $wb, $other, $tc) = @$_;
194 $c = HTML::CalendarMonth->new(
198 datetool => $datetool,
202 croak $@ unless $@ =~ /(no|in)\s*valid date tool/i;
203 skip("$datetool odd $y/$m", 1);
205 @days = $c->dayheaders unless @days;
206 my $day1 = $days[$wb - 1];
207 my $method = $c->_caltool->_name;
208 $method = "auto-select ($method)" unless $datetool;
210 "(%d/%02d %s 1st day) using %s",
211 $y, $m, $day1, $method
213 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
218 sub check_woy_with_datetool {
219 my $datetool = shift;
221 my($d, $y, $m, $wb, $other, $tc) = @$_;
222 my $c = HTML::CalendarMonth->new(
226 datetool => $datetool,
228 my $msg = sprintf("(%d/%02d week of year) using %s", $y, $m, $datetool);
229 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
235 my($d, $y, $m, $id, $other, $tc) = @$_;
236 my $c = HTML::CalendarMonth->new(
241 my $name = $c->loc->loc->name;
243 "(%d/%02d i8n) %s (wb:%d) using auto-detect",
244 $y, $m, $name, $c->week_begin
246 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
253 my($d, $y, $m, $wb, $other, $tc) = @$_;
254 my $c = HTML::CalendarMonth->new(
260 @days = $c->dayheaders unless @days;
261 my $day1 = $days[$wb - 1];
263 "(%d/%02d %s/%s 1st day) narrow/alias using auto-detect",
264 $y, $m, $day1, $c->item_alias($day1)
266 cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
271 my($l1, $str1, $l2, $str2) = @_;
273 open(DUMP, ">$DEBUG") or die "Could not dump to $DEBUG: $!\n";
274 print DUMP "<html><body><table><tr><td>$l1</td><td>$l2</td></tr><tr><td>\n";
275 print DUMP "$str1\n</td><td>\n";
276 print DUMP "$str2\n</td></tr></table></body></html>\n";
278 print STDERR "\nDumped tables to $DEBUG. Aborting test.\n";