--- /dev/null
+package testload;
+
+use vars qw( @ISA @EXPORT $Dat_Dir );
+
+use strict;
+use warnings;
+use Test::More;
+
+use Cwd qw( abs_path );
+
+my $DEBUG = 0;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+use vars qw(
+ $Dat_Dir
+ $Bulk_File
+ $Head_File
+ $Odd_File
+ $Woy_File
+ $I8N_File
+ $Narrow_File
+);
+
+@EXPORT = qw(
+ $Dat_Dir
+ $Bulk_File $Head_File $Odd_File $Woy_File $I8N_File $Narrow_File
+ check_datetool
+ check_bulk_with_datetool
+ check_odd_with_datetool
+ check_woy_with_datetool
+ check_i8n
+ check_narrow
+
+ bulk_count
+ odd_count
+ woy_count
+ i8n_count
+ narrow_count
+
+ clean
+);
+
+use File::Spec;
+
+use HTML::CalendarMonth;
+use HTML::CalendarMonth::DateTool;
+
+BEGIN {
+ my($vol, $dir, $file) = File::Spec->splitpath(abs_path(__FILE__));
+ $dir = File::Spec->catdir($dir, 'dat');
+ $Dat_Dir = File::Spec->catpath($vol, $dir, '');
+}
+
+$Bulk_File = File::Spec->catdir($Dat_Dir, 'bulk.dat');
+$Head_File = File::Spec->catdir($Dat_Dir, 'head.dat');
+$Odd_File = File::Spec->catdir($Dat_Dir, 'odd.dat');
+$Woy_File = File::Spec->catdir($Dat_Dir, 'woy.dat');
+$I8N_File = File::Spec->catdir($Dat_Dir, 'i8n.dat');
+$Narrow_File = File::Spec->catdir($Dat_Dir, 'narrow.dat');
+
+my(@Bulk, @Head, @Odd, @Woy, @I8N, @Nar);
+
+sub _load_file {
+ my $f = shift;
+ my $cal = shift || [];
+ local(*F);
+ return unless open(F, '<', $f);
+ while (my $h = <F>) {
+ chomp $h;
+ my($d, $wb, @other) = split(/\s+/, $h);
+ my($y, $m) = split(/\//, $d);
+ my $c = <F>;
+ chomp $c;
+ push(@$cal, [$d, $y, $m, $wb, \@other, clean($c)]);
+ }
+ $cal;
+}
+
+_load_file($Bulk_File, \@Bulk );
+_load_file($Head_File, \@Head );
+_load_file($Odd_File, \@Odd );
+_load_file($Woy_File, \@Woy );
+_load_file($I8N_File, \@I8N );
+_load_file($Narrow_File, \@Nar);
+
+sub bulk_count { scalar @Bulk }
+sub head_count { scalar @Head }
+sub odd_count { scalar @Odd }
+sub woy_count { scalar @Woy }
+sub i8n_count { scalar @I8N }
+sub narrow_count { scalar @Nar }
+
+# Today's date
+my($month, $year) = (localtime(time))[4,5];
+++$month;
+$year += 1900;
+
+my $today = sprintf("%d/%02d", $year, $month);
+my $year_from_now = sprintf("%d/%02d", $year+1, $month);
+
+# keep the next year
+@Bulk = grep { $_ ge $today && $_->[0] le $year_from_now } @Bulk;
+
+###
+
+sub clean {
+ my $str = shift || Carp::confess "string required";
+ $str =~ s/^\s*//; $str =~ s/\s*$//;
+ # guard against HTML::Tree starting to quote numeric attrs as of
+ # v3.19_02
+ $str =~ s/\"(\d+)\"/$1/g;
+ $str;
+}
+
+sub check_datetool {
+ my $datetool = shift;
+ my $module = HTML::CalendarMonth::DateTool->_toolmap($datetool);
+ ok($module, "toolmap($datetool) : $module");
+ require_ok($module);
+}
+
+sub check_bulk_with_datetool {
+ my $datetool = shift;
+ my @days;
+ foreach (@Bulk) {
+ my($d, $y, $m, $wb, $other, $tc) = @$_;
+ my $c = HTML::CalendarMonth->new(
+ year => $y,
+ month => $m,
+ week_begin => $wb,
+ datetool => $datetool,
+ );
+ @days = $c->dayheaders unless @days;
+ my $day1 = $days[$wb - 1];
+ my $method = $c->_caltool->_name;
+ $method = "auto-select ($method)" unless $datetool;
+ my $msg = sprintf(
+ "(%d/%02d %s 1st day) using %s",
+ $y, $m, $day1, $method
+ );
+ cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
+ }
+}
+
+sub check_head_with_datetool {
+ my $datetool = shift;
+ my @days;
+ foreach (@Head) {
+ my($d, $y, $m, $wb, $other, $tc) = @$_;
+ my($hm, $hy, $hd, $hw) = @$other;
+ my $c = HTML::CalendarMonth->new(
+ year => $y,
+ month => $m,
+ week_begin => $wb,
+ head_m => $hm,
+ head_y => $hy,
+ head_dow => $hd,
+ head_week => $hw,
+ datetool => $datetool,
+ );
+ my $method = $c->_caltool->_name;
+ $method = "auto-select ($method)" unless $datetool;
+ my $msg = sprintf(
+ "(%d/%02d hm:%d hy:%d hd:%d hw:%d) using %s",
+ $y, $m, $hm, $hy, $hd, $hw, $method
+ );
+ cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
+ }
+}
+
+sub check_odd_with_datetool {
+ my $datetool = shift;
+ my @days;
+ foreach (@Odd) {
+ my($d, $y, $m, $wb, $other, $tc) = @$_;
+ SKIP: {
+ my $c;
+ eval {
+ $c = HTML::CalendarMonth->new(
+ year => $y,
+ month => $m,
+ week_begin => $wb,
+ datetool => $datetool,
+ );
+ };
+ if ($@ || !$c) {
+ croak $@ unless $@ =~ /(no|in)\s*valid date tool/i;
+ skip("$datetool odd $y/$m", 1);
+ }
+ @days = $c->dayheaders unless @days;
+ my $day1 = $days[$wb - 1];
+ my $method = $c->_caltool->_name;
+ $method = "auto-select ($method)" unless $datetool;
+ my $msg = sprintf(
+ "(%d/%02d %s 1st day) using %s",
+ $y, $m, $day1, $method
+ );
+ cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
+ }
+ }
+}
+
+sub check_woy_with_datetool {
+ my $datetool = shift;
+ foreach (@Woy) {
+ my($d, $y, $m, $wb, $other, $tc) = @$_;
+ my $c = HTML::CalendarMonth->new(
+ year => $y,
+ month => $m,
+ head_week => 1,
+ datetool => $datetool,
+ );
+ my $msg = sprintf("(%d/%02d week of year) using %s", $y, $m, $datetool);
+ cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
+ }
+}
+
+sub check_i8n {
+ foreach (@I8N) {
+ my($d, $y, $m, $id, $other, $tc) = @$_;
+ my $c = HTML::CalendarMonth->new(
+ year => $y,
+ month => $m,
+ locale => $id,
+ );
+ my $name = $c->loc->loc->name;
+ my $msg = sprintf(
+ "(%d/%02d i8n) %s (wb:%d) using auto-detect",
+ $y, $m, $name, $c->week_begin
+ );
+ cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
+ }
+}
+
+sub check_narrow {
+ my @days;
+ foreach (@Nar) {
+ my($d, $y, $m, $wb, $other, $tc) = @$_;
+ my $c = HTML::CalendarMonth->new(
+ year => $y,
+ month => $m,
+ week_begin => $wb,
+ full_days => -1,
+ );
+ @days = $c->dayheaders unless @days;
+ my $day1 = $days[$wb - 1];
+ my $msg = sprintf(
+ "(%d/%02d %s/%s 1st day) narrow/alias using auto-detect",
+ $y, $m, $day1, $c->item_alias($day1)
+ );
+ cmp_ok(clean($c->as_HTML), 'eq', $tc, $msg);
+ }
+}
+
+sub debug_dump {
+ my($l1, $str1, $l2, $str2) = @_;
+ local(*DUMP);
+ open(DUMP, ">$DEBUG") or die "Could not dump to $DEBUG: $!\n";
+ print DUMP "<html><body><table><tr><td>$l1</td><td>$l2</td></tr><tr><td>\n";
+ print DUMP "$str1\n</td><td>\n";
+ print DUMP "$str2\n</td></tr></table></body></html>\n";
+ close(DUMP);
+ print STDERR "\nDumped tables to $DEBUG. Aborting test.\n";
+ exit;
+}
+
+1;
projects / deb_pkgs / libhtml-calendarmonth-perl.git / blobdiff