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