t/testload.pm

   1 package testload;
   2
   3 use vars qw( @ISA @EXPORT $Dat_Dir );
   4
   5 use strict;
   6 use warnings;
   7 use Test::More;
   8
   9 use Cwd qw( abs_path );
  10
  11 my $DEBUG = 0;
  12
  13 require Exporter;
  14 @ISA = qw(Exporter);
  15
  16 use vars qw(
  17   $Dat_Dir
  18   $Bulk_File
  19   $Head_File
  20   $Odd_File
  21   $Woy_File
  22   $I8N_File
  23   $Narrow_File
  24 );
  25
  26 @EXPORT = qw(
  27   $Dat_Dir
  28   $Bulk_File $Head_File $Odd_File $Woy_File $I8N_File $Narrow_File
  29   check_datetool
  30   check_bulk_with_datetool
  31   check_odd_with_datetool
  32   check_woy_with_datetool
  33   check_i8n
  34   check_narrow
  35
  36   bulk_count
  37   odd_count
  38   woy_count
  39   i8n_count
  40   narrow_count
  41
  42   clean
  43 );
  44
  45 use File::Spec;
  46
  47 use HTML::CalendarMonth;
  48 use HTML::CalendarMonth::DateTool;
  49
  50 BEGIN {
  51   my($vol, $dir, $file) = File::Spec->splitpath(abs_path(__FILE__));
  52   $dir = File::Spec->catdir($dir, 'dat');
  53   $Dat_Dir = File::Spec->catpath($vol, $dir, '');
  54 }
  55
  56 $Bulk_File   = File::Spec->catdir($Dat_Dir,   'bulk.dat');
  57 $Head_File   = File::Spec->catdir($Dat_Dir,   'head.dat');
  58 $Odd_File    = File::Spec->catdir($Dat_Dir,    'odd.dat');
  59 $Woy_File    = File::Spec->catdir($Dat_Dir,    'woy.dat');
  60 $I8N_File    = File::Spec->catdir($Dat_Dir,    'i8n.dat');
  61 $Narrow_File = File::Spec->catdir($Dat_Dir, 'narrow.dat');
  62
  63 my(@Bulk, @Head, @Odd, @Woy, @I8N, @Nar);
  64
  65 sub _load_file {
  66   my $f   = shift;
  67   my $cal = shift || [];
  68   local(*F);
  69   return unless open(F, '<', $f);
  70   while (my $h = <F>) {
  71     chomp $h;
  72     my($d, $wb, @other) = split(/\s+/, $h);
  73     my($y, $m) = split(/\//, $d);
  74     my $c = <F>;
  75     chomp $c;
  76     push(@$cal, [$d, $y, $m, $wb, \@other, clean($c)]);
  77   }
  78   $cal;
  79 }
  80
  81 _load_file($Bulk_File, \@Bulk    );
  82 _load_file($Head_File,  \@Head   );
  83 _load_file($Odd_File,    \@Odd   );
  84 _load_file($Woy_File,     \@Woy  );
  85 _load_file($I8N_File,      \@I8N );
  86 _load_file($Narrow_File,    \@Nar);
  87
  88 sub bulk_count   { scalar @Bulk }
  89 sub head_count   { scalar @Head }
  90 sub odd_count    { scalar @Odd  }
  91 sub woy_count    { scalar @Woy  }
  92 sub i8n_count    { scalar @I8N  }
  93 sub narrow_count { scalar @Nar  }
  94
  95 # Today's date
  96 my($month, $year) = (localtime(time))[4,5];
  97 ++$month;
  98 $year += 1900;
  99
 100 my $today         = sprintf("%d/%02d", $year, $month);
 101 my $year_from_now = sprintf("%d/%02d", $year+1, $month);
 102
 103 # keep the next year
 104 @Bulk = grep { $_ ge $today && $_->[0] le $year_from_now } @Bulk;
 105
 106 ###
 107
 108 sub clean {
 109   my $str = shift || Carp::confess "string required";
 110   $str =~ s/^\s*//; $str =~ s/\s*$//;
 111   # guard against HTML::Tree starting to quote numeric attrs as of
 112   # v3.19_02
 113   $str =~ s/\"(\d+)\"/$1/g;
 114   $str;
 115 }
 116
 117 sub check_datetool {
 118   my $datetool = shift;
 119   my $module = HTML::CalendarMonth::DateTool->_toolmap($datetool);
 120   ok($module, "toolmap($datetool) : $module");
 121   require_ok($module);
 122 }
 123
 124 sub check_bulk_with_datetool {
 125   my $datetool = shift;
 126   my @days;
 127   foreach (@Bulk) {
 128     my($d, $y, $m, $wb, $other, $tc) = @$_;
 129     my $c = HTML::CalendarMonth->new(
 130       year       => $y,
 131       month      => $m,
 132       week_begin => $wb,
 133       datetool   => $datetool,
 134     );
 135     @days = $c->dayheaders unless @days;
 136     my $day1 = $days[$wb - 1];
 137     my $method = $c->_caltool->_name;
 138     $method = "auto-select ($method)" unless $datetool;
 139     my $msg = sprintf(
 140       "(%d/%02d %s 1st day) using %s",
 141       $y, $m, $day1, $method
 142     );
 143     cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
 144   }
 145 }
 146
 147 sub check_head_with_datetool {
 148   my $datetool = shift;
 149   my @days;
 150   foreach (@Head) {
 151     my($d, $y, $m, $wb, $other, $tc) = @$_;
 152     my($hm, $hy, $hd, $hw) = @$other;
 153     my $c = HTML::CalendarMonth->new(
 154       year       => $y,
 155       month      => $m,
 156       week_begin => $wb,
 157       head_m     => $hm,
 158       head_y     => $hy,
 159       head_dow   => $hd,
 160       head_week  => $hw,
 161       datetool   => $datetool,
 162     );
 163     my $method = $c->_caltool->_name;
 164     $method = "auto-select ($method)" unless $datetool;
 165     my $msg = sprintf(
 166       "(%d/%02d hm:%d hy:%d hd:%d hw:%d) using %s",
 167       $y, $m, $hm, $hy, $hd, $hw, $method
 168     );
 169     cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
 170   }
 171 }
 172
 173 sub check_odd_with_datetool {
 174   my $datetool = shift;
 175   my @days;
 176   foreach (@Odd) {
 177     my($d, $y, $m, $wb, $other, $tc) = @$_;
 178     SKIP: {
 179       my $c;
 180       eval {
 181         $c = HTML::CalendarMonth->new(
 182           year       => $y,
 183           month      => $m,
 184           week_begin => $wb,
 185           datetool   => $datetool,
 186         );
 187       };
 188       if ($@ || !$c) {
 189         croak $@ unless $@ =~ /(no|in)\s*valid date tool/i;
 190         skip("$datetool odd $y/$m", 1);
 191       }
 192       @days = $c->dayheaders unless @days;
 193       my $day1 = $days[$wb - 1];
 194       my $method = $c->_caltool->_name;
 195       $method = "auto-select ($method)" unless $datetool;
 196       my $msg = sprintf(
 197         "(%d/%02d %s 1st day) using %s",
 198         $y, $m, $day1, $method
 199       );
 200       cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
 201     }
 202   }
 203 }
 204
 205 sub check_woy_with_datetool {
 206   my $datetool = shift;
 207   foreach (@Woy) {
 208     my($d, $y, $m, $wb, $other, $tc) = @$_;
 209     my $c = HTML::CalendarMonth->new(
 210       year       => $y,
 211       month      => $m,
 212       head_week  => 1,
 213       datetool   => $datetool,
 214     );
 215     my $msg = sprintf("(%d/%02d week of year) using %s", $y, $m, $datetool);
 216     cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
 217   }
 218 }
 219
 220 sub check_i8n {
 221   foreach (@I8N) {
 222     my($d, $y, $m, $id, $other, $tc) = @$_;
 223     my $c = HTML::CalendarMonth->new(
 224       year   => $y,
 225       month  => $m,
 226       locale => $id,
 227     );
 228     my $name = $c->loc->loc->name;
 229     my $msg = sprintf(
 230       "(%d/%02d i8n) %s (wb:%d) using auto-detect",
 231       $y, $m, $name, $c->week_begin
 232     );
 233     cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
 234   }
 235 }
 236
 237 sub check_narrow {
 238   my @days;
 239   foreach (@Nar) {
 240     my($d, $y, $m, $wb, $other, $tc) = @$_;
 241     my $c = HTML::CalendarMonth->new(
 242       year       => $y,
 243       month      => $m,
 244       week_begin => $wb,
 245       full_days  => -1,
 246     );
 247     @days = $c->dayheaders unless @days;
 248     my $day1 = $days[$wb - 1];
 249     my $msg = sprintf(
 250       "(%d/%02d %s/%s 1st day) narrow/alias using auto-detect",
 251       $y, $m, $day1, $c->item_alias($day1)
 252     );
 253     cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
 254   }
 255 }
 256
 257 sub debug_dump {
 258   my($l1, $str1, $l2, $str2) = @_;
 259   local(*DUMP);
 260   open(DUMP, ">$DEBUG") or die "Could not dump to $DEBUG: $!\n";
 261   print DUMP "<html><body><table><tr><td>$l1</td><td>$l2</td></tr><tr><td>\n";
 262   print DUMP "$str1\n</td><td>\n";
 263   print DUMP "$str2\n</td></tr></table></body></html>\n";
 264   close(DUMP);
 265   print STDERR "\nDumped tables to $DEBUG. Aborting test.\n";
 266   exit;
 267 }
 268
 269 1;