summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
Diffstat (limited to 'ext')
-rw-r--r--ext/.gitignore1
-rw-r--r--ext/Digest/Changes164
-rw-r--r--ext/Digest/Digest.pm316
-rw-r--r--ext/Digest/Digest/base.pm100
-rw-r--r--ext/Digest/Digest/file.pm85
-rw-r--r--ext/Digest/t/base.t84
-rw-r--r--ext/Digest/t/digest.t36
-rw-r--r--ext/Digest/t/file.t52
8 files changed, 838 insertions, 0 deletions
diff --git a/ext/.gitignore b/ext/.gitignore
index ecb386442c..499602c17b 100644
--- a/ext/.gitignore
+++ b/ext/.gitignore
@@ -24,6 +24,7 @@ ppport.h
/CGI/Makefile.PL
/CPANPLUS-Dist-Build/Makefile.PL
/Data-Dumper/Makefile.PL
+/Digest/Makefile.PL
/Devel-SelfStubber/Makefile.PL
/FileCache/Makefile.PL
/File-Fetch/Makefile.PL
diff --git a/ext/Digest/Changes b/ext/Digest/Changes
new file mode 100644
index 0000000000..be5a3de54d
--- /dev/null
+++ b/ext/Digest/Changes
@@ -0,0 +1,164 @@
+2009-06-09 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.16.
+
+ Gisle Aas (3):
+ For SHA-1 try Digest::SHA before tryign Digest::SHA1 as suggested by Adam Trickett
+ Support Digest->new("RIPEMD-160") as suggested by Zefram
+ Use 3-arg open for fewer surprises
+
+ Jarkko Hietaniemi (1):
+ Sync up with EBCDIC changes from core perl.
+
+
+
+2006-03-20 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.15.
+
+ Improved documentation.
+
+
+
+2005-11-26 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.14
+
+ Documentation tweaks.
+
+
+
+2005-10-18 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.13
+
+ Fixed documentation typo.
+
+
+
+2005-09-29 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.12
+
+ Fix documentation typo. Patch by <steve@fisharerojo.org>.
+
+
+
+2005-09-11 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.11
+
+ Make Digest->new("SHA-224") work. Patch by Mark Shelor
+ <shelor@cpan.org>.
+
+
+
+2004-11-08 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.10
+
+ Added Digest::file module which provide convenience functions
+ that calculate digests of files.
+
+
+
+2004-11-05 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.09
+
+ Fix trivial documentation typo.
+
+
+
+2004-04-29 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.08
+
+ Make Digest->new("CRC-16"), Digest->new("CRC-32") and
+ Digest->new("CRC-CCITT") work.
+ Patch by Oliver Maul <oliver@maul.tv>.
+
+
+
+2004-04-25 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.07
+
+ Updated benchmark.
+
+
+
+2004-04-01 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.06
+
+ Added MIME::Base64 dependency.
+
+ Minor doc tweak.
+
+
+
+2003-12-01 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.05
+
+ Drop Digest::MD5 dependency. Avoids circular dependency
+ now that Digest::MD5 depend on this package to inherit
+ Digest::base.
+
+ Included a section about digest speed with benchmark
+ results for some implementations of this API.
+
+
+
+2003-11-29 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.04
+
+ Doc tweaks to unconfuse search.cpan.org.
+
+
+
+2003-11-28 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.03
+
+ Added add_bits() method as requested by the
+ Digest::SHA author Mark Shelor.
+
+ Added Digest::base class that Digest implementations
+ can use to get default implementations of addfile(),
+ add_bits(), hexdigest() and b64digest().
+
+ Digest->new("SHA-256") and similar should work now
+ given that you have either Digest::SHA or Digest::SHA2
+ installed.
+
+
+
+2003-01-18 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.02
+
+ Sync up with version bundled with perl-5.8.
+ Patch by Jarkko Hietaniemi <jhi@iki.fi>.
+
+ Override INSTALLDIRS for 5.8 as suggested by
+ Guido Ostkamp <Guido.Ostkamp@t-online.de>.
+
+
+
+2003-01-04 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.01
+
+ Document the clone() method.
+
+
+
+2001-03-13 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.00
+
+ Broken out of the Digest-MD5-2.12 distribution and made into
+ a separate dist.
diff --git a/ext/Digest/Digest.pm b/ext/Digest/Digest.pm
new file mode 100644
index 0000000000..384dfc8266
--- /dev/null
+++ b/ext/Digest/Digest.pm
@@ -0,0 +1,316 @@
+package Digest;
+
+use strict;
+use vars qw($VERSION %MMAP $AUTOLOAD);
+
+$VERSION = "1.16";
+
+%MMAP = (
+ "SHA-1" => [["Digest::SHA", 1], "Digest::SHA1", ["Digest::SHA2", 1]],
+ "SHA-224" => [["Digest::SHA", 224]],
+ "SHA-256" => [["Digest::SHA", 256], ["Digest::SHA2", 256]],
+ "SHA-384" => [["Digest::SHA", 384], ["Digest::SHA2", 384]],
+ "SHA-512" => [["Digest::SHA", 512], ["Digest::SHA2", 512]],
+ "HMAC-MD5" => "Digest::HMAC_MD5",
+ "HMAC-SHA-1" => "Digest::HMAC_SHA1",
+ "CRC-16" => [["Digest::CRC", type => "crc16"]],
+ "CRC-32" => [["Digest::CRC", type => "crc32"]],
+ "CRC-CCITT" => [["Digest::CRC", type => "crcccitt"]],
+ "RIPEMD-160" => "Crypt::PIPEMD160",
+);
+
+sub new
+{
+ shift; # class ignored
+ my $algorithm = shift;
+ my $impl = $MMAP{$algorithm} || do {
+ $algorithm =~ s/\W+//;
+ "Digest::$algorithm";
+ };
+ $impl = [$impl] unless ref($impl);
+ my $err;
+ for (@$impl) {
+ my $class = $_;
+ my @args;
+ ($class, @args) = @$class if ref($class);
+ no strict 'refs';
+ unless (exists ${"$class\::"}{"VERSION"}) {
+ eval "require $class";
+ if ($@) {
+ $err ||= $@;
+ next;
+ }
+ }
+ return $class->new(@args, @_);
+ }
+ die $err;
+}
+
+sub AUTOLOAD
+{
+ my $class = shift;
+ my $algorithm = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
+ $class->new($algorithm, @_);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Digest - Modules that calculate message digests
+
+=head1 SYNOPSIS
+
+ $md5 = Digest->new("MD5");
+ $sha1 = Digest->new("SHA-1");
+ $sha256 = Digest->new("SHA-256");
+ $sha384 = Digest->new("SHA-384");
+ $sha512 = Digest->new("SHA-512");
+
+ $hmac = Digest->HMAC_MD5($key);
+
+=head1 DESCRIPTION
+
+The C<Digest::> modules calculate digests, also called "fingerprints"
+or "hashes", of some data, called a message. The digest is (usually)
+some small/fixed size string. The actual size of the digest depend of
+the algorithm used. The message is simply a sequence of arbitrary
+bytes or bits.
+
+An important property of the digest algorithms is that the digest is
+I<likely> to change if the message change in some way. Another
+property is that digest functions are one-way functions, that is it
+should be I<hard> to find a message that correspond to some given
+digest. Algorithms differ in how "likely" and how "hard", as well as
+how efficient they are to compute.
+
+Note that the properties of the algorithms change over time, as the
+algorithms are analyzed and machines grow faster. If your application
+for instance depends on it being "impossible" to generate the same
+digest for a different message it is wise to make it easy to plug in
+stronger algorithms as the one used grow weaker. Using the interface
+documented here should make it easy to change algorithms later.
+
+All C<Digest::> modules provide the same programming interface. A
+functional interface for simple use, as well as an object oriented
+interface that can handle messages of arbitrary length and which can
+read files directly.
+
+The digest can be delivered in three formats:
+
+=over 8
+
+=item I<binary>
+
+This is the most compact form, but it is not well suited for printing
+or embedding in places that can't handle arbitrary data.
+
+=item I<hex>
+
+A twice as long string of lowercase hexadecimal digits.
+
+=item I<base64>
+
+A string of portable printable characters. This is the base64 encoded
+representation of the digest with any trailing padding removed. The
+string will be about 30% longer than the binary version.
+L<MIME::Base64> tells you more about this encoding.
+
+=back
+
+
+The functional interface is simply importable functions with the same
+name as the algorithm. The functions take the message as argument and
+return the digest. Example:
+
+ use Digest::MD5 qw(md5);
+ $digest = md5($message);
+
+There are also versions of the functions with "_hex" or "_base64"
+appended to the name, which returns the digest in the indicated form.
+
+=head1 OO INTERFACE
+
+The following methods are available for all C<Digest::> modules:
+
+=over 4
+
+=item $ctx = Digest->XXX($arg,...)
+
+=item $ctx = Digest->new(XXX => $arg,...)
+
+=item $ctx = Digest::XXX->new($arg,...)
+
+The constructor returns some object that encapsulate the state of the
+message-digest algorithm. You can add data to the object and finally
+ask for the digest. The "XXX" should of course be replaced by the proper
+name of the digest algorithm you want to use.
+
+The two first forms are simply syntactic sugar which automatically
+load the right module on first use. The second form allow you to use
+algorithm names which contains letters which are not legal perl
+identifiers, e.g. "SHA-1". If no implementation for the given algorithm
+can be found, then an exception is raised.
+
+If new() is called as an instance method (i.e. $ctx->new) it will just
+reset the state the object to the state of a newly created object. No
+new object is created in this case, and the return value is the
+reference to the object (i.e. $ctx).
+
+=item $other_ctx = $ctx->clone
+
+The clone method creates a copy of the digest state object and returns
+a reference to the copy.
+
+=item $ctx->reset
+
+This is just an alias for $ctx->new.
+
+=item $ctx->add( $data )
+
+=item $ctx->add( $chunk1, $chunk2, ... )
+
+The string value of the $data provided as argument is appended to the
+message we calculate the digest for. The return value is the $ctx
+object itself.
+
+If more arguments are provided then they are all appended to the
+message, thus all these lines will have the same effect on the state
+of the $ctx object:
+
+ $ctx->add("a"); $ctx->add("b"); $ctx->add("c");
+ $ctx->add("a")->add("b")->add("c");
+ $ctx->add("a", "b", "c");
+ $ctx->add("abc");
+
+Most algorithms are only defined for strings of bytes and this method
+might therefore croak if the provided arguments contain chars with
+ordinal number above 255.
+
+=item $ctx->addfile( $io_handle )
+
+The $io_handle is read until EOF and the content is appended to the
+message we calculate the digest for. The return value is the $ctx
+object itself.
+
+The addfile() method will croak() if it fails reading data for some
+reason. If it croaks it is unpredictable what the state of the $ctx
+object will be in. The addfile() method might have been able to read
+the file partially before it failed. It is probably wise to discard
+or reset the $ctx object if this occurs.
+
+In most cases you want to make sure that the $io_handle is in
+"binmode" before you pass it as argument to the addfile() method.
+
+=item $ctx->add_bits( $data, $nbits )
+
+=item $ctx->add_bits( $bitstring )
+
+The add_bits() method is an alternative to add() that allow partial
+bytes to be appended to the message. Most users should just ignore
+this method as partial bytes is very unlikely to be of any practical
+use.
+
+The two argument form of add_bits() will add the first $nbits bits
+from $data. For the last potentially partial byte only the high order
+C<< $nbits % 8 >> bits are used. If $nbits is greater than C<<
+length($data) * 8 >>, then this method would do the same as C<<
+$ctx->add($data) >>.
+
+The one argument form of add_bits() takes a $bitstring of "1" and "0"
+chars as argument. It's a shorthand for C<< $ctx->add_bits(pack("B*",
+$bitstring), length($bitstring)) >>.
+
+The return value is the $ctx object itself.
+
+This example shows two calls that should have the same effect:
+
+ $ctx->add_bits("111100001010");
+ $ctx->add_bits("\xF0\xA0", 12);
+
+Most digest algorithms are byte based and for these it is not possible
+to add bits that are not a multiple of 8, and the add_bits() method
+will croak if you try.
+
+=item $ctx->digest
+
+Return the binary digest for the message.
+
+Note that the C<digest> operation is effectively a destructive,
+read-once operation. Once it has been performed, the $ctx object is
+automatically C<reset> and can be used to calculate another digest
+value. Call $ctx->clone->digest if you want to calculate the digest
+without resetting the digest state.
+
+=item $ctx->hexdigest
+
+Same as $ctx->digest, but will return the digest in hexadecimal form.
+
+=item $ctx->b64digest
+
+Same as $ctx->digest, but will return the digest as a base64 encoded
+string.
+
+=back
+
+=head1 Digest speed
+
+This table should give some indication on the relative speed of
+different algorithms. It is sorted by throughput based on a benchmark
+done with of some implementations of this API:
+
+ Algorithm Size Implementation MB/s
+
+ MD4 128 Digest::MD4 v1.3 165.0
+ MD5 128 Digest::MD5 v2.33 98.8
+ SHA-256 256 Digest::SHA2 v1.1.0 66.7
+ SHA-1 160 Digest::SHA v4.3.1 58.9
+ SHA-1 160 Digest::SHA1 v2.10 48.8
+ SHA-256 256 Digest::SHA v4.3.1 41.3
+ Haval-256 256 Digest::Haval256 v1.0.4 39.8
+ SHA-384 384 Digest::SHA2 v1.1.0 19.6
+ SHA-512 512 Digest::SHA2 v1.1.0 19.3
+ SHA-384 384 Digest::SHA v4.3.1 19.2
+ SHA-512 512 Digest::SHA v4.3.1 19.2
+ Whirlpool 512 Digest::Whirlpool v1.0.2 13.0
+ MD2 128 Digest::MD2 v2.03 9.5
+
+ Adler-32 32 Digest::Adler32 v0.03 1.3
+ CRC-16 16 Digest::CRC v0.05 1.1
+ CRC-32 32 Digest::CRC v0.05 1.1
+ MD5 128 Digest::Perl::MD5 v1.5 1.0
+ CRC-CCITT 16 Digest::CRC v0.05 0.8
+
+These numbers was achieved Apr 2004 with ActivePerl-5.8.3 running
+under Linux on a P4 2.8 GHz CPU. The last 5 entries differ by being
+pure perl implementations of the algorithms, which explains why they
+are so slow.
+
+=head1 SEE ALSO
+
+L<Digest::Adler32>, L<Digest::CRC>, L<Digest::Haval256>,
+L<Digest::HMAC>, L<Digest::MD2>, L<Digest::MD4>, L<Digest::MD5>,
+L<Digest::SHA>, L<Digest::SHA1>, L<Digest::SHA2>, L<Digest::Whirlpool>
+
+New digest implementations should consider subclassing from L<Digest::base>.
+
+L<MIME::Base64>
+
+http://en.wikipedia.org/wiki/Cryptographic_hash_function
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@aas.no>
+
+The C<Digest::> interface is based on the interface originally
+developed by Neil Winton for his C<MD5> module.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+ Copyright 1998-2006 Gisle Aas.
+ Copyright 1995,1996 Neil Winton.
+
+=cut
diff --git a/ext/Digest/Digest/base.pm b/ext/Digest/Digest/base.pm
new file mode 100644
index 0000000000..b2844ba340
--- /dev/null
+++ b/ext/Digest/Digest/base.pm
@@ -0,0 +1,100 @@
+package Digest::base;
+
+use strict;
+use vars qw($VERSION);
+$VERSION = "1.16";
+
+# subclass is supposed to implement at least these
+sub new;
+sub clone;
+sub add;
+sub digest;
+
+sub reset {
+ my $self = shift;
+ $self->new(@_); # ugly
+}
+
+sub addfile {
+ my ($self, $handle) = @_;
+
+ my $n;
+ my $buf = "";
+
+ while (($n = read($handle, $buf, 4*1024))) {
+ $self->add($buf);
+ }
+ unless (defined $n) {
+ require Carp;
+ Carp::croak("Read failed: $!");
+ }
+
+ $self;
+}
+
+sub add_bits {
+ my $self = shift;
+ my $bits;
+ my $nbits;
+ if (@_ == 1) {
+ my $arg = shift;
+ $bits = pack("B*", $arg);
+ $nbits = length($arg);
+ }
+ else {
+ ($bits, $nbits) = @_;
+ }
+ if (($nbits % 8) != 0) {
+ require Carp;
+ Carp::croak("Number of bits must be multiple of 8 for this algorithm");
+ }
+ return $self->add(substr($bits, 0, $nbits/8));
+}
+
+sub hexdigest {
+ my $self = shift;
+ return unpack("H*", $self->digest(@_));
+}
+
+sub b64digest {
+ my $self = shift;
+ require MIME::Base64;
+ my $b64 = MIME::Base64::encode($self->digest(@_), "");
+ $b64 =~ s/=+$//;
+ return $b64;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Digest::base - Digest base class
+
+=head1 SYNOPSIS
+
+ package Digest::Foo;
+ use base 'Digest::base';
+
+=head1 DESCRIPTION
+
+The C<Digest::base> class provide implementations of the methods
+C<addfile> and C<add_bits> in terms of C<add>, and of the methods
+C<hexdigest> and C<b64digest> in terms of C<digest>.
+
+Digest implementations might want to inherit from this class to get
+this implementations of the alternative I<add> and I<digest> methods.
+A minimal subclass needs to implement the following methods by itself:
+
+ new
+ clone
+ add
+ digest
+
+The arguments and expected behaviour of these methods are described in
+L<Digest>.
+
+=head1 SEE ALSO
+
+L<Digest>
diff --git a/ext/Digest/Digest/file.pm b/ext/Digest/Digest/file.pm
new file mode 100644
index 0000000000..3b86e63503
--- /dev/null
+++ b/ext/Digest/Digest/file.pm
@@ -0,0 +1,85 @@
+package Digest::file;
+
+use strict;
+
+use Exporter ();
+use Carp qw(croak);
+use Digest ();
+
+use vars qw($VERSION @ISA @EXPORT_OK);
+
+$VERSION = "1.16";
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(digest_file_ctx digest_file digest_file_hex digest_file_base64);
+
+sub digest_file_ctx {
+ my $file = shift;
+ croak("No digest algorithm specified") unless @_;
+ local *F;
+ open(F, "<", $file) || croak("Can't open '$file': $!");
+ binmode(F);
+ my $ctx = Digest->new(@_);
+ $ctx->addfile(*F);
+ close(F);
+ return $ctx;
+}
+
+sub digest_file {
+ digest_file_ctx(@_)->digest;
+}
+
+sub digest_file_hex {
+ digest_file_ctx(@_)->hexdigest;
+}
+
+sub digest_file_base64 {
+ digest_file_ctx(@_)->b64digest;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Digest::file - Calculate digests of files
+
+=head1 SYNOPSIS
+
+ # Poor mans "md5sum" command
+ use Digest::file qw(digest_file_hex);
+ for (@ARGV) {
+ print digest_file_hex($_, "MD5"), " $_\n";
+ }
+
+=head1 DESCRIPTION
+
+This module provide 3 convenience functions to calculate the digest
+of files. The following functions are provided:
+
+=over
+
+=item digest_file( $file, $algorithm, [$arg,...] )
+
+This function will calculate and return the binary digest of the bytes
+of the given file. The function will croak if it fails to open or
+read the file.
+
+The $algorithm is a string like "MD2", "MD5", "SHA-1", "SHA-512".
+Additional arguments are passed to the constructor for the
+implementation of the given algorithm.
+
+=item digest_file_hex( $file, $algorithm, [$arg,...] )
+
+Same as digest_file(), but return the digest in hex form.
+
+=item digest_file_base64( $file, $algorithm, [$arg,...] )
+
+Same as digest_file(), but return the digest as a base64 encoded
+string.
+
+=back
+
+=head1 SEE ALSO
+
+L<Digest>
diff --git a/ext/Digest/t/base.t b/ext/Digest/t/base.t
new file mode 100644
index 0000000000..b2614f79e0
--- /dev/null
+++ b/ext/Digest/t/base.t
@@ -0,0 +1,84 @@
+#!perl -w
+
+use Test qw(plan ok);
+plan tests => 12;
+
+{
+ package LenDigest;
+ require Digest::base;
+ use vars qw(@ISA);
+ @ISA = qw(Digest::base);
+
+ sub new {
+ my $class = shift;
+ my $str = "";
+ bless \$str, $class;
+ }
+
+ sub add {
+ my $self = shift;
+ $$self .= join("", @_);
+ return $self;
+ }
+
+ sub digest {
+ my $self = shift;
+ my $len = length($$self);
+ my $first = ($len > 0) ? substr($$self, 0, 1) : "X";
+ $$self = "";
+ return sprintf "$first%04d", $len;
+ }
+}
+
+my $ctx = LenDigest->new;
+ok($ctx->digest, "X0000");
+
+my $EBCDIC = ord('A') == 193;
+
+if ($EBCDIC) {
+ ok($ctx->hexdigest, "e7f0f0f0f0");
+ ok($ctx->b64digest, "5/Dw8PA");
+} else {
+ ok($ctx->hexdigest, "5830303030");
+ ok($ctx->b64digest, "WDAwMDA");
+}
+
+$ctx->add("foo");
+ok($ctx->digest, "f0003");
+
+$ctx->add("foo");
+ok($ctx->hexdigest, $EBCDIC ? "86f0f0f0f3" : "6630303033");
+
+$ctx->add("foo");
+ok($ctx->b64digest, $EBCDIC ? "hvDw8PM" : "ZjAwMDM");
+
+open(F, ">xxtest$$") || die;
+binmode(F);
+print F "abc" x 100, "\n";
+close(F) || die;
+
+open(F, "xxtest$$") || die;
+$ctx->addfile(*F);
+close(F);
+unlink("xxtest$$") || warn;
+
+ok($ctx->digest, "a0301");
+
+eval {
+ $ctx->add_bits("1010");
+};
+ok($@ =~ /^Number of bits must be multiple of 8/);
+
+$ctx->add_bits($EBCDIC ? "11100100" : "01010101");
+ok($ctx->digest, "U0001");
+
+eval {
+ $ctx->add_bits("abc", 12);
+};
+ok($@ =~ /^Number of bits must be multiple of 8/);
+
+$ctx->add_bits("abc", 16);
+ok($ctx->digest, "a0002");
+
+$ctx->add_bits("abc", 32);
+ok($ctx->digest, "a0003");
diff --git a/ext/Digest/t/digest.t b/ext/Digest/t/digest.t
new file mode 100644
index 0000000000..c5da8f02c8
--- /dev/null
+++ b/ext/Digest/t/digest.t
@@ -0,0 +1,36 @@
+print "1..3\n";
+
+use Digest;
+
+{
+ package Digest::Dummy;
+ use vars qw($VERSION @ISA);
+ $VERSION = 1;
+
+ require Digest::base;
+ @ISA = qw(Digest::base);
+
+ sub new {
+ my $class = shift;
+ my $d = shift || "ooo";
+ bless { d => $d }, $class;
+ }
+ sub add {}
+ sub digest { shift->{d} }
+}
+
+my $d;
+$d = Digest->new("Dummy");
+print "not " unless $d->digest eq "ooo";
+print "ok 1\n";
+
+$d = Digest->Dummy;
+print "not " unless $d->digest eq "ooo";
+print "ok 2\n";
+
+$Digest::MMAP{"Dummy-24"} = [["NotThere"], "NotThereEither", ["Digest::Dummy", 24]];
+$d = Digest->new("Dummy-24");
+print "not " unless $d->digest eq "24";
+print "ok 3\n";
+
+
diff --git a/ext/Digest/t/file.t b/ext/Digest/t/file.t
new file mode 100644
index 0000000000..f431a385a5
--- /dev/null
+++ b/ext/Digest/t/file.t
@@ -0,0 +1,52 @@
+#!perl -w
+
+use Test qw(plan ok);
+plan tests => 5;
+
+{
+ package Digest::Foo;
+ require Digest::base;
+ use vars qw(@ISA $VERSION);
+ @ISA = qw(Digest::base);
+
+ sub new {
+ my $class = shift;
+ my $str = "";
+ bless \$str, $class;
+ }
+
+ sub add {
+ my $self = shift;
+ $$self .= join("", @_);
+ return $self;
+ }
+
+ sub digest {
+ my $self = shift;
+ return sprintf "%04d", length($$self);
+ }
+}
+
+use Digest::file qw(digest_file digest_file_hex digest_file_base64);
+
+my $file = "test-$$";
+die if -f $file;
+open(F, ">$file") || die "Can't create '$file': $!";
+binmode(F);
+print F "foo\0\n";
+close(F) || die "Can't write '$file': $!";
+
+ok(digest_file($file, "Foo"), "0005");
+
+if (ord('A') == 193) { # EBCDIC.
+ ok(digest_file_hex($file, "Foo"), "f0f0f0f5");
+ ok(digest_file_base64($file, "Foo"), "8PDw9Q");
+} else {
+ ok(digest_file_hex($file, "Foo"), "30303035");
+ ok(digest_file_base64($file, "Foo"), "MDAwNQ");
+}
+
+unlink($file) || warn "Can't unlink '$file': $!";
+
+ok(eval { digest_file("not-there.txt", "Foo") }, undef);
+ok($@);
View Lorry Controller Status