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