package testload; use vars qw( @ISA @EXPORT $Dat_Dir ); use strict; use Test::More; my $DEBUG = 0; require Exporter; @ISA = qw(Exporter); @EXPORT = qw( $Dat_Dir check_datetool case_count check_basic_with_datetool check_woy_with_datetool dq_nums ); use File::Spec; use HTML::CalendarMonth; use HTML::CalendarMonth::DateTool; my($base_dir, $vol, $dir); BEGIN { my $pkg = __PACKAGE__; $pkg =~ s%::%/%g; $pkg .= '.pm'; $pkg = File::Spec->canonpath($INC{$pkg}); my $file; ($vol, $dir, $file) = File::Spec->splitpath($pkg); $base_dir = File::Spec->catpath($vol, $dir, ''); } $Dat_Dir = $base_dir; my($tcount, $rds, %dates, @tmethods, @twy_methods, @Cals); # Required test dates my $dat_file = File::Spec->catpath($vol, $dir, 'test.dat'); open(D, "<$dat_file") or die "Problem reading $dat_file: $!\n"; $rds = ; foreach (split(' ', $rds)) { ++$dates{$_}; } my %WOY_data; eval join('', ); die "Oops on eval: $@\n" if $@; # Today's date my($month, $year) = (localtime(time))[4,5]; ++$month; $year += 1900; # Flag tests for a year foreach my $y ($year .. $year + 1) { foreach my $m (1 .. 12) { ++$dates{sprintf("%d/%02d", $y, $m)}; } } # Yank test cases while () { chomp; my($d, $wb) = split(' ', $_); my($y, $m) = split('/', $d); my $cal = ; push(@Cals, [$y, $m, $cal, $wb]) if $dates{"$y/$m"}; } close(D); ############# # guard against HTML::Tree starting to quote numeric attrs as of # v3.19_02 sub dq_nums { my $str = shift; $str =~ s/\"(\d+)\"/$1/g; return $str; } sub case_count { scalar @Cals } sub check_datetool { my $datetool = shift; my $module = HTML::CalendarMonth::DateTool->toolmap($datetool); ok($module, "toolmap($datetool) : $module"); require_ok($module); } sub check_basic_with_datetool { my $datetool = shift; my @days = qw( Sun Mon Tue Wed Thr Fri Sat ); my $method = $datetool || 'auto-select'; foreach my $cal (@Cals) { my $c = HTML::CalendarMonth->new( year => $cal->[0], month => $cal->[1], week_begin => $cal->[3], datetool => $datetool, ); my $day1 = $days[$cal->[3] - 1]; cmp_ok(dq_nums($c->as_HTML), 'eq', $cal->[2], sprintf("(%d/%-02d %s 1st day) using %s", $cal->[0], $cal->[1], $day1, $method)); if ($DEBUG && $c->as_HTML ne $cal->[2]) { debug_dump('Broken', $c->as_HTML, 'Test Data', $cal->[2]); } } } sub check_woy_with_datetool { my $datetool = shift; my $year = 2000; foreach my $month (qw(01 12)) { my $tc = $WOY_data{"$year/$month"}; my $cal = HTML::CalendarMonth->new( year => $year, month => $month, head_week => 1, datetool => $datetool, ); my $ct = dq_nums($cal->as_HTML); chomp $ct; cmp_ok($ct, 'eq', $tc, "($year/$month week of year) using $datetool"); if ($DEBUG && $ct ne $tc) { debug_dump('Broken', $ct, 'Test Data', $tc); } } } sub debug_dump { my($l1, $str1, $l2, $str2) = @_; local(*DUMP); open(DUMP, ">$DEBUG") or die "Could not dump to $DEBUG: $!\n"; print DUMP "
$l1$l2
\n"; print DUMP "$str1\n\n"; print DUMP "$str2\n
\n"; close(DUMP); print STDERR "\nDumped tables to $DEBUG. Aborting test.\n"; exit; } __DATA__ $WOY_data{'2000/01'} = '
January2000
SunMonTueWedThuFriSat 
            152
23456781
91011121314152
161718192021223
232425262728294
3031          5
'; $WOY_data{'2000/12'} = '
December2000
SunMonTueWedThuFriSat 
          1248
345678949
1011121314151650
1718192021222351
2425262728293052
31            1
';