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 fcc48d6bb88ca8065bf9ddfcb9e7483e  Changes
  24 0565ec21b15c0f23f4c51fb327c8926d  README
  25 1965beb0e48253b694220fbb5d6230f5  MD5.pm
  26 5b3c24da3f70f3c0938cc7c205a28ab7  MD5.xs
  27 276da0aa4e9a08b7fe09430c9c5690aa  rfc1321.txt
  28 EOT
  29 } elsif ("\n" eq "\015") { # MacOS
  30     $EXPECT = <<EOT;
  31 f161f474603c54a0093ad2f6f93be33b  Changes
  32 6c950a0211a5a28f023bb482037698cd  README
  33 18178c90bc13d6824f6c96973b6e9433  MD5.pm
  34 2c7fdb2ffa3840dc4f8dcdcf13241015  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 029fa5059ba0b2175cee09ab5d9b7b73  Changes
  41 6c950a0211a5a28f023bb482037698cd  README
  42 18178c90bc13d6824f6c96973b6e9433  MD5.pm
  43 2c7fdb2ffa3840dc4f8dcdcf13241015  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          require Encode;
  92          my $data = cat_file($file);
  93          Encode::from_to($data, 'latin1', 'MacRoman');
  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     my $digest = Digest::MD5->new->addfile(*FILE)->$method();
 179     close(FILE);
 180
 181     $digest;
 182 }
 183
 184 sub cat_file
 185 {
 186     my($file) = @_;
 187     local $/;  # slurp
 188     open(FILE, $file) or die "Can't open $file: $!";
 189
 190     # For PerlIO in case of UTF-8 locales.
 191     eval 'binmode(FILE, ":bytes")' if $] >= 5.008;
 192
 193     my $tmp = <FILE>;
 194     close(FILE);
 195     $tmp;
 196 }
 197