ext/Digest/MD5/t/files.t

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