1BEGIN { 2 if($ENV{PERL_CORE}) { 3 chdir 't'; 4 @INC = '../lib'; 5 } else { 6 push @INC, '../lib'; 7 } 8} 9 10use strict; 11use Test; 12BEGIN { plan tests => 26 }; 13use Pod::Simple::TextContent; 14use Pod::Simple::Text; 15 16BEGIN { 17 *mytime = defined(&Win32::GetTickCount) 18 ? sub () {Win32::GetTickCount() / 1000} 19 : sub () {time()} 20} 21 22$Pod::Simple::Text::FREAKYMODE = 1; 23use Pod::Simple::TiedOutFH (); 24 25chdir 't' unless $ENV{PERL_CORE}; 26 27sub source_path { 28 my $file = shift; 29 if ($ENV{PERL_CORE}) { 30 require File::Spec; 31 my $updir = File::Spec->updir; 32 my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 'Simple', 't'); 33 return File::Spec->catfile ($dir, $file); 34 } else { 35 return $file; 36 } 37} 38 39my $outfile = '10000'; 40 41foreach my $file ( 42 "junk1.pod", 43 "junk2.pod", 44 "perlcyg.pod", 45 "perlfaq.pod", 46 "perlvar.pod", 47) { 48 49 unless(-e source_path($file)) { 50 ok 0; 51 print "# But $file doesn't exist!!\n"; 52 exit 1; 53 } 54 55 my @out; 56 my $precooked = source_path($file); 57 $precooked =~ s<\.pod><o.txt>s; 58 unless(-e $precooked) { 59 ok 0; 60 print "# But $precooked doesn't exist!!\n"; 61 exit 1; 62 } 63 64 print "#\n#\n#\n###################\n# $file\n"; 65 foreach my $class ('Pod::Simple::TextContent', 'Pod::Simple::Text') { 66 my $p = $class->new; 67 push @out, ''; 68 $p->output_string(\$out[-1]); 69 my $t = mytime(); 70 $p->parse_file(source_path($file)); 71 printf "# %s %s %sb, %.03fs\n", 72 ref($p), source_path($file), length($out[-1]), mytime() - $t ; 73 ok 1; 74 } 75 76 print "# Reading $precooked...\n"; 77 open(IN, $precooked) or die "Can't read-open $precooked: $!"; 78 { 79 local $/; 80 push @out, <IN>; 81 } 82 close(IN); 83 print "# ", length($out[-1]), " bytes pulled in.\n"; 84 85 86 for (@out) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; } 87 88 my $faily = 0; 89 print "#\n#Now comparing 1 and 2...\n"; 90 $faily += compare2($out[0], $out[1]); 91 print "#\n#Now comparing 2 and 3...\n"; 92 $faily += compare2($out[1], $out[2]); 93 print "#\n#Now comparing 1 and 3...\n"; 94 $faily += compare2($out[0], $out[2]); 95 96 if($faily) { 97 ++$outfile; 98 99 my @outnames = map $outfile . $_ , qw(0 1); 100 open(OUT2, ">$outnames[0].~out.txt") || die "Can't write-open $outnames[0].txt: $!"; 101 102 foreach my $out (@out) { push @outnames, $outnames[-1]; ++$outnames[-1] }; 103 pop @outnames; 104 printf "# Writing to %s.txt .. %s.txt\n", $outnames[0], $outnames[-1]; 105 shift @outnames; 106 107 binmode(OUT2); 108 foreach my $out (@out) { 109 my $outname = shift @outnames; 110 open(OUT, ">$outname.txt") || die "Can't write-open $outname.txt: $!"; 111 binmode(OUT); 112 print OUT $out, "\n"; 113 print OUT2 $out, "\n"; 114 close(OUT); 115 } 116 close(OUT2); 117 } 118} 119 120print "# Wrapping up... one for the road...\n"; 121ok 1; 122print "# --- Done with ", __FILE__, " --- \n"; 123exit; 124 125 126sub compare2 { 127 my @out = @_; 128 if($out[0] eq $out[1]) { 129 ok 1; 130 return 0; 131 } elsif( do{ 132 for ($out[0], $out[1]) { tr/ //d; }; 133 $out[0] eq $out[1]; 134 }){ 135 print "# Differ only in whitespace.\n"; 136 ok 1; 137 return 0; 138 } else { 139 #ok $out[0], $out[1]; 140 141 my $x = $out[0] ^ $out[1]; 142 $x =~ m/^(\x00*)/s or die; 143 my $at = length($1); 144 print "# Difference at byte $at...\n"; 145 if($at > 10) { 146 $at -= 5; 147 } 148 { 149 print "# ", substr($out[0],$at,20), "\n"; 150 print "# ", substr($out[1],$at,20), "\n"; 151 print "# ^..."; 152 } 153 154 155 156 ok 0; 157 printf "# Unequal lengths %s and %s\n", length($out[0]), length($out[1]); 158 return 1; 159 } 160} 161 162 163__END__ 164 165