diff --git a/lib/Digest.pm b/lib/Digest.pm index b62ef64..087274a 100644 --- a/lib/Digest.pm +++ b/lib/Digest.pm @@ -64,6 +64,8 @@ sub AUTOLOAD { $class->new( $algorithm, @_ ); } +sub DESTROY { } # prevent AUTOLOAD from catching implicit DESTROY calls + 1; __END__ diff --git a/lib/Digest/file.pm b/lib/Digest/file.pm index 088fabf..1bcfff0 100644 --- a/lib/Digest/file.pm +++ b/lib/Digest/file.pm @@ -3,12 +3,11 @@ package Digest::file; use strict; use warnings; -use Exporter (); +use base 'Exporter'; use Carp qw(croak); use Digest (); our $VERSION = "1.20"; -our @ISA = qw(Exporter); our @EXPORT_OK = qw(digest_file_ctx digest_file digest_file_hex digest_file_base64); sub digest_file_ctx { @@ -52,11 +51,24 @@ Digest::file - Calculate digests of files =head1 DESCRIPTION -This module provide 3 convenience functions to calculate the digest +This module provide 4 convenience functions to calculate the digest of files. The following functions are provided: =over +=item digest_file_ctx( $file, $algorithm, [$arg,...] ) + +This function will open the given file in binary mode, feed its +contents to a new digest object, and return the L context +object. This is useful when you need to call a specific digest +method yourself rather than using one of the shorthand functions +below. The function will croak if no algorithm is specified or 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( $file, $algorithm, [$arg,...] ) This function will calculate and return the binary digest of the bytes diff --git a/t/digest.t b/t/digest.t index 941f21d..0f5dfe4 100644 --- a/t/digest.t +++ b/t/digest.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 4; +use Test::More tests => 5; # To find Digest::Dummy use lib 't/lib'; @@ -22,3 +22,6 @@ is $d->digest, "ooo"; $Digest::MMAP{"Dummy-24"} = [ ["NotThere"], "NotThereEither", [ "Digest::Dummy", 24 ] ]; $d = Digest->new("Dummy-24"); is $d->digest, "24"; + +# DESTROY should not trigger AUTOLOAD +ok( Digest->can("DESTROY"), "Digest has explicit DESTROY method" ); diff --git a/t/file.t b/t/file.t index 48ef39d..b83a563 100644 --- a/t/file.t +++ b/t/file.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 5; +use Test::More tests => 9; use File::Temp 'tempfile'; @@ -32,7 +32,7 @@ use File::Temp 'tempfile'; } } -use Digest::file qw(digest_file digest_file_hex digest_file_base64); +use Digest::file qw(digest_file_ctx digest_file digest_file_hex digest_file_base64); { my ( $fh, $file ) = tempfile( UNLINK => 1 ); @@ -52,5 +52,21 @@ use Digest::file qw(digest_file digest_file_hex digest_file_base64); } } +# digest_file_ctx returns a usable Digest context object +{ + my ( $fh2, $file2 ) = tempfile( UNLINK => 1 ); + binmode($fh2); + print $fh2 "test data"; + close($fh2) || die "Can't write '$file2': $!"; + + my $ctx = digest_file_ctx( $file2, "Foo" ); + isa_ok( $ctx, "Digest::Foo", "digest_file_ctx returns correct class" ); + is( $ctx->digest, "0009", "digest_file_ctx feeds file content to context" ); +} + +# Error handling +ok !eval { digest_file_ctx( "not-there.txt", "Foo" ) }; +like $@, qr/Can't open/, "digest_file_ctx croaks on missing file"; + ok !eval { digest_file( "not-there.txt", "Foo" ) }; ok $@;