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 ed8efe2e2dbab62fcc9dea2df6682569  Changes
  24 0565ec21b15c0f23f4c51fb327c8926d  README
  25 0fcdd6d6e33b8772bd4b4832043035cd  MD5.pm
  26 d7fd24455b9160aa8706635d15e6177e  MD5.xs
  27 276da0aa4e9a08b7fe09430c9c5690aa  rfc1321.txt
  28 EOT
  29 } elsif ("\n" eq "\015") { # MacOS
  30     $EXPECT = <<EOT;
  31 2879619f967d5fc5a00ffe37b639f2ee  Changes
  32 6c950a0211a5a28f023bb482037698cd  README
  33 4e1043f0a7a266416d8408d6fa96f454  MD5.pm
  34 6bff95ff70ba43a6c81e255c6510a865  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 2879619f967d5fc5a00ffe37b639f2ee  Changes
  41 6c950a0211a5a28f023bb482037698cd  README
  42 4e1043f0a7a266416d8408d6fa96f454  MD5.pm
  43 6bff95ff70ba43a6c81e255c6510a865  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      if ($ENV{PERL_CORE}) {
  65          if ($file eq 'rfc1321.txt') { # Don't have it in core.
  66              print "ok ", ++$testno, " # Skip: PERL_CORE\n";
  67              next;
  68          }
  69          use File::Spec;
  70          my @path = qw(ext Digest MD5);
  71          my $path = File::Spec->updir;
  72          while (@path) {
  73            $path = File::Spec->catdir($path, shift @path);
  74          }
  75          $file = File::Spec->catfile($path, $file);
  76      }
  77 #     print "# file = $file\n";
  78      unless (-f $file) {
  79         warn "No such file: $file\n";
  80         next;
  81      }
  82      if ($ENV{EBCDIC_MD5SUM}) {
  83          require Encode;
  84          my $data = cat_file($file);
  85          Encode::from_to($data, 'latin1', 'cp1047');
  86          print md5_hex($data), "  $base\n";
  87          next;
  88      }
  89      if ($ENV{MAC_MD5SUM}) {
  90          my $data = cat_file($file);
  91          print md5_hex($data), "  $base\n";
  92          next;
  93      }
  94      my $md5bin = pack("H*", $md5hex);
  95      my $md5b64;
  96      if ($B64) {
  97          $md5b64 = MIME::Base64::encode($md5bin, "");
  98          chop($md5b64); chop($md5b64);   # remove padding
  99      }
 100      my $failed;
 101      my $got;
 102
 103      if (digest_file($file, 'digest') ne $md5bin) {
 104          print "$file: Bad digest\n";
 105          $failed++;
 106      }
 107
 108      if (($got = digest_file($file, 'hexdigest')) ne $md5hex) {
 109          print "$file: Bad hexdigest: got $got expected $md5hex\n";
 110          $failed++;
 111      }
 112
 113      if ($B64 && digest_file($file, 'b64digest') ne $md5b64) {
 114          print "$file: Bad b64digest\n";
 115          $failed++;
 116      }
 117
 118      my $data = cat_file($file);
 119      if (md5($data) ne $md5bin) {
 120          print "$file: md5() failed\n";
 121          $failed++;
 122      }
 123      if (md5_hex($data) ne $md5hex) {
 124          print "$file: md5_hex() failed\n";
 125          $failed++;
 126      }
 127      if ($B64 && md5_base64($data) ne $md5b64) {
 128          print "$file: md5_base64() failed\n";
 129          $failed++;
 130      }
 131
 132      if (Digest::MD5->new->add($data)->digest ne $md5bin) {
 133          print "$file: MD5->new->add(...)->digest failed\n";
 134          $failed++;
 135      }
 136      if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) {
 137          print "$file: MD5->new->add(...)->hexdigest failed\n";
 138          $failed++;
 139      }
 140      if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) {
 141          print "$file: MD5->new->add(...)->b64digest failed\n";
 142          $failed++;
 143      }
 144
 145      my @data = split //, $data;
 146      if (md5(@data) ne $md5bin) {
 147          print "$file: md5(\@data) failed\n";
 148          $failed++;
 149      }
 150      if (Digest::MD5->new->add(@data)->digest ne $md5bin) {
 151          print "$file: MD5->new->add(\@data)->digest failed\n";
 152          $failed++;
 153      }
 154      my $md5 = Digest::MD5->new;
 155      for (@data) {
 156          $md5->add($_);
 157      }
 158      if ($md5->digest ne $md5bin) {
 159          print "$file: $md5->add()-loop failed\n";
 160          $failed++;
 161      }
 162
 163      print "not " if $failed;
 164      print "ok ", ++$testno, "\n";
 165 }
 166
 167
 168 sub digest_file
 169 {
 170     my($file, $method) = @_;
 171     $method ||= "digest";
 172     #print "$file $method\n";
 173
 174     open(FILE, $file) or die "Can't open $file: $!";
 175     my $digest = Digest::MD5->new->addfile(*FILE)->$method();
 176     close(FILE);
 177
 178     $digest;
 179 }
 180
 181 sub cat_file
 182 {
 183     my($file) = @_;
 184     local $/;  # slurp
 185     open(FILE, $file) or die "Can't open $file: $!";
 186
 187     # For PerlIO in case of UTF-8 locales.
 188     eval 'binmode(FILE, ":bytes")' if $] >= 5.008;
 189
 190     my $tmp = <FILE>;
 191     close(FILE);
 192     $tmp;
 193 }
 194