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