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