files.t revision 1.4
1 2print "1..3\n"; 3 4use strict; 5use Digest::MD5 qw(md5 md5_hex md5_base64); 6 7# To update the EBCDIC section even on a Latin 1 platform, 8# run this script with $ENV{EBCDIC_MD5SUM} set to a true value. 9# (You'll need to have Perl 5.7.3 or later, to have the Encode installed.) 10# (And remember that under the Perl core distribution you should 11# also have the $ENV{PERL_CORE} set to a true value.) 12 13my $EXPECT; 14if (ord "A" == 193) { # EBCDIC 15 $EXPECT = <<EOT; 160956ffb4f6416082b27d6680b4cf73fc README 17b349234bb1005785bb6e377990209dc7 MD5.xs 18276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt 19EOT 20} else { 21 # This is the output of: 'md5sum README MD5.xs rfc1321.txt' 22 $EXPECT = <<EOT; 232f93400875dbb56f36691d5f69f3eba5 README 241d2a7c4f7a6180a7f3369d703ffe7cd0 MD5.xs 25754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt 26EOT 27} 28 29if (!(-f "README") && -f "../README") { 30 chdir("..") or die "Can't chdir: $!"; 31} 32 33my $testno = 0; 34 35my $B64 = 1; 36eval { require MIME::Base64; }; 37if ($@) { 38 print "# $@: Will not test base64 methods\n"; 39 $B64 = 0; 40} 41 42for (split /^/, $EXPECT) { 43 my($md5hex, $file) = split ' '; 44 my $base = $file; 45# print "# $base\n"; 46 if ($ENV{PERL_CORE}) { 47 if ($file eq 'rfc1321.txt') { # Don't have it in core. 48 print "ok ", ++$testno, " # Skip: PERL_CORE\n"; 49 next; 50 } 51 } 52# print "# file = $file\n"; 53 unless (-f $file) { 54 warn "No such file: $file\n"; 55 next; 56 } 57 if ($ENV{EBCDIC_MD5SUM}) { 58 require Encode; 59 my $data = cat_file($file); 60 Encode::from_to($data, 'latin1', 'cp1047'); 61 print md5_hex($data), " $base\n"; 62 next; 63 } 64 my $md5bin = pack("H*", $md5hex); 65 my $md5b64; 66 if ($B64) { 67 $md5b64 = MIME::Base64::encode($md5bin, ""); 68 chop($md5b64); chop($md5b64); # remove padding 69 } 70 my $failed; 71 my $got; 72 73 if (digest_file($file, 'digest') ne $md5bin) { 74 print "$file: Bad digest\n"; 75 $failed++; 76 } 77 78 if (($got = digest_file($file, 'hexdigest')) ne $md5hex) { 79 print "$file: Bad hexdigest: got $got expected $md5hex\n"; 80 $failed++; 81 } 82 83 if ($B64 && digest_file($file, 'b64digest') ne $md5b64) { 84 print "$file: Bad b64digest\n"; 85 $failed++; 86 } 87 88 my $data = cat_file($file); 89 if (md5($data) ne $md5bin) { 90 print "$file: md5() failed\n"; 91 $failed++; 92 } 93 if (md5_hex($data) ne $md5hex) { 94 print "$file: md5_hex() failed\n"; 95 $failed++; 96 } 97 if ($B64 && md5_base64($data) ne $md5b64) { 98 print "$file: md5_base64() failed\n"; 99 $failed++; 100 } 101 102 if (Digest::MD5->new->add($data)->digest ne $md5bin) { 103 print "$file: MD5->new->add(...)->digest failed\n"; 104 $failed++; 105 } 106 if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) { 107 print "$file: MD5->new->add(...)->hexdigest failed\n"; 108 $failed++; 109 } 110 if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) { 111 print "$file: MD5->new->add(...)->b64digest failed\n"; 112 $failed++; 113 } 114 115 my @data = split //, $data; 116 if (md5(@data) ne $md5bin) { 117 print "$file: md5(\@data) failed\n"; 118 $failed++; 119 } 120 if (Digest::MD5->new->add(@data)->digest ne $md5bin) { 121 print "$file: MD5->new->add(\@data)->digest failed\n"; 122 $failed++; 123 } 124 my $md5 = Digest::MD5->new; 125 for (@data) { 126 $md5->add($_); 127 } 128 if ($md5->digest ne $md5bin) { 129 print "$file: $md5->add()-loop failed\n"; 130 $failed++; 131 } 132 133 print "not " if $failed; 134 print "ok ", ++$testno, "\n"; 135} 136 137 138sub digest_file 139{ 140 my($file, $method) = @_; 141 $method ||= "digest"; 142 #print "$file $method\n"; 143 144 open(FILE, $file) or die "Can't open $file: $!"; 145 my $digest = Digest::MD5->new->addfile(*FILE)->$method(); 146 close(FILE); 147 148 $digest; 149} 150 151sub cat_file 152{ 153 my($file) = @_; 154 local $/; # slurp 155 open(FILE, $file) or die "Can't open $file: $!"; 156 157 # For PerlIO in case of UTF-8 locales. 158 eval 'binmode(FILE, ":bytes")' if $] >= 5.008; 159 160 my $tmp = <FILE>; 161 close(FILE); 162 $tmp; 163} 164 165