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