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