cpan/DB_File/t/db-threads.t See if DB_File works
cpan/DB_File/typemap Berkeley DB extension interface types
cpan/DB_File/version.c Berkeley DB extension interface version check
-cpan/Digest/Digest.pm Digest extensions
-cpan/Digest/Digest/base.pm Digest extensions
-cpan/Digest/Digest/file.pm Digest extensions
+cpan/Digest/lib/Digest.pm
+cpan/Digest/lib/Digest/base.pm
+cpan/Digest/lib/Digest/file.pm
cpan/Digest/t/base.t See if Digest extensions work
cpan/Digest/t/digest.t See if Digest extensions work
cpan/Digest/t/file.t See if Digest extensions work
},
'Digest' => {
- 'DISTRIBUTION' => 'GAAS/Digest-1.17.tar.gz',
+ 'DISTRIBUTION' => 'TODDR/Digest-1.19.tar.gz',
'FILES' => q[cpan/Digest],
'EXCLUDED' => ['digest-bench'],
'CUSTOMIZED' => [
- # CVE-2016-1238
- qw( Digest.pm )
],
},
# usually because they pull in their version from some other file.
my %skip;
@skip{
+ 'cpan/Digest/t/lib/Digest/Dummy.pm', # just a test module
'cpan/ExtUtils-Install/t/lib/MakeMaker/Test/Setup/BFD.pm', # just a test module
'cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/BFD.pm', # just a test module
'cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/XS.pm', # just a test module
package Digest;
use strict;
-use vars qw($VERSION %MMAP $AUTOLOAD);
-
-$VERSION = "1.17_01";
-
-%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::RIPEMD160",
+use warnings;
+
+our $VERSION = "1.19";
+
+our %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 ] ],
+ "SHA3-224" => [ [ "Digest::SHA3", 224 ] ],
+ "SHA3-256" => [ [ "Digest::SHA3", 256 ] ],
+ "SHA3-384" => [ [ "Digest::SHA3", 384 ] ],
+ "SHA3-512" => [ [ "Digest::SHA3", 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::RIPEMD160",
);
-sub new
-{
- shift; # class ignored
+sub new {
+ shift; # class ignored
my $algorithm = shift;
- my $impl = $MMAP{$algorithm} || do {
+ my $impl = $MMAP{$algorithm} || do {
$algorithm =~ s/\W+//g;
"Digest::$algorithm";
};
$impl = [$impl] unless ref($impl);
- local $@; # don't clobber it for our caller
+ local $@; # don't clobber it for our caller
my $err;
- for (@$impl) {
+ for (@$impl) {
my $class = $_;
my @args;
- ($class, @args) = @$class if ref($class);
+ ( $class, @args ) = @$class if ref($class);
no strict 'refs';
- unless (exists ${"$class\::"}{"VERSION"}) {
+ unless ( exists ${"$class\::"}{"VERSION"} ) {
my $pm_file = $class . ".pm";
$pm_file =~ s{::}{/}g;
eval {
next;
}
}
- return $class->new(@args, @_);
+ return $class->new( @args, @_ );
}
die $err;
}
-sub AUTOLOAD
-{
- my $class = shift;
- my $algorithm = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
- $class->new($algorithm, @_);
+our $AUTOLOAD;
+
+sub AUTOLOAD {
+ my $class = shift;
+ my $algorithm = substr( $AUTOLOAD, rindex( $AUTOLOAD, '::' ) + 2 );
+ $class->new( $algorithm, @_ );
}
1;
identifiers, e.g. "SHA-1". If no implementation for the given algorithm
can be found, then an exception is raised.
+To know what arguments (if any) the constructor takes (the C<$args,...> above)
+consult the docs for the specific digest implementation.
+
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
=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.
+bytes to be appended to the message. Most users can just ignore
+this method since typical applications involve only whole-byte data.
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
=item $ctx->b64digest
Same as $ctx->digest, but will return the digest as a base64 encoded
+string without padding.
+
+=item $ctx->base64_padded_digest
+
+Same as $ctx->digest, but will return the digest as a base64 encoded
string.
=back
package Digest::base;
use strict;
-use vars qw($VERSION);
-$VERSION = "1.16";
+use warnings;
+
+our $VERSION = "1.19";
# subclass is supposed to implement at least these
sub new;
sub reset {
my $self = shift;
- $self->new(@_); # ugly
+ $self->new(@_); # ugly
}
sub addfile {
- my ($self, $handle) = @_;
+ my ( $self, $handle ) = @_;
my $n;
my $buf = "";
- while (($n = read($handle, $buf, 4*1024))) {
+ while ( ( $n = read( $handle, $buf, 4 * 1024 ) ) ) {
$self->add($buf);
}
- unless (defined $n) {
- require Carp;
- Carp::croak("Read failed: $!");
+ unless ( defined $n ) {
+ require Carp;
+ Carp::croak("Read failed: $!");
}
$self;
my $self = shift;
my $bits;
my $nbits;
- if (@_ == 1) {
- my $arg = shift;
- $bits = pack("B*", $arg);
- $nbits = length($arg);
+ if ( @_ == 1 ) {
+ my $arg = shift;
+ $bits = pack( "B*", $arg );
+ $nbits = length($arg);
}
else {
- ($bits, $nbits) = @_;
+ ( $bits, $nbits ) = @_;
}
- if (($nbits % 8) != 0) {
- require Carp;
- Carp::croak("Number of bits must be multiple of 8 for this algorithm");
+ 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));
+ return $self->add( substr( $bits, 0, $nbits / 8 ) );
}
sub hexdigest {
my $self = shift;
- return unpack("H*", $self->digest(@_));
+ return unpack( "H*", $self->digest(@_) );
}
sub b64digest {
my $self = shift;
- require MIME::Base64;
- my $b64 = MIME::Base64::encode($self->digest(@_), "");
+ my $b64 = $self->base64_padded_digest;
$b64 =~ s/=+$//;
return $b64;
}
+sub base64_padded_digest {
+ my $self = shift;
+ require MIME::Base64;
+ return MIME::Base64::encode( $self->digest(@_), "" );
+}
+
1;
__END__
package Digest::file;
use strict;
+use warnings;
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);
+our $VERSION = "1.19";
+our @ISA = qw(Exporter);
+our @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);
+ open( my $fh, "<", $file ) || croak("Can't open '$file': $!");
+ binmode($fh);
my $ctx = Digest->new(@_);
- $ctx->addfile(*F);
- close(F);
+ $ctx->addfile($fh);
+ close($fh);
return $ctx;
}
#!perl -w
-use Test::More tests => 12;
+use strict;
+use warnings;
+
+use Test::More tests => 13;
+
+use File::Temp 'tempfile';
{
- 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;
- }
+
+ package LenDigest;
+ require Digest::base;
+ our @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;
-is($ctx->digest, "X0000");
+is( $ctx->digest, "X0000" );
my $EBCDIC = ord('A') == 193;
if ($EBCDIC) {
- is($ctx->hexdigest, "e7f0f0f0f0");
- is($ctx->b64digest, "5/Dw8PA");
-} else {
- is($ctx->hexdigest, "5830303030");
- is($ctx->b64digest, "WDAwMDA");
+ is( $ctx->hexdigest, "e7f0f0f0f0" );
+ is( $ctx->b64digest, "5/Dw8PA" );
+ is( $ctx->base64_padded_digest, "5/Dw8PA=" );
+}
+else {
+ is( $ctx->hexdigest, "5830303030" );
+ is( $ctx->b64digest, "WDAwMDA" );
+ is( $ctx->base64_padded_digest, "WDAwMDA=" );
}
$ctx->add("foo");
-is($ctx->digest, "f0003");
+is( $ctx->digest, "f0003" );
$ctx->add("foo");
-is($ctx->hexdigest, $EBCDIC ? "86f0f0f0f3" : "6630303033");
+is( $ctx->hexdigest, $EBCDIC ? "86f0f0f0f3" : "6630303033" );
$ctx->add("foo");
-is($ctx->b64digest, $EBCDIC ? "hvDw8PM" : "ZjAwMDM");
+is( $ctx->b64digest, $EBCDIC ? "hvDw8PM" : "ZjAwMDM" );
-open(F, ">xxtest$$") || die;
-binmode(F);
-print F "abc" x 100, "\n";
-close(F) || die;
+{
+ my ( $fh, $tempfile ) = tempfile();
+ binmode($fh);
+ print $fh "abc" x 100, "\n";
+ close($fh) || die;
-open(F, "xxtest$$") || die;
-$ctx->addfile(*F);
-close(F);
-unlink("xxtest$$") || warn;
+ open( my $fh2, $tempfile ) || die;
+ $ctx->addfile($fh2);
+ close($fh2);
-is($ctx->digest, "a0301");
+ is( $ctx->digest, "a0301" );
+}
-eval {
- $ctx->add_bits("1010");
-};
-like($@, '/^Number of bits must be multiple of 8/');
+eval { $ctx->add_bits("1010"); };
+like( $@, '/^Number of bits must be multiple of 8/' );
-$ctx->add_bits($EBCDIC ? "11100100" : "01010101");
-is($ctx->digest, "U0001");
+$ctx->add_bits( $EBCDIC ? "11100100" : "01010101" );
+is( $ctx->digest, "U0001" );
-eval {
- $ctx->add_bits("abc", 12);
-};
-like($@, '/^Number of bits must be multiple of 8/');
+eval { $ctx->add_bits( "abc", 12 ); };
+like( $@, '/^Number of bits must be multiple of 8/' );
-$ctx->add_bits("abc", 16);
-is($ctx->digest, "a0002");
+$ctx->add_bits( "abc", 16 );
+is( $ctx->digest, "a0002" );
-$ctx->add_bits("abc", 32);
-is($ctx->digest, "a0003");
+$ctx->add_bits( "abc", 32 );
+is( $ctx->digest, "a0003" );
#!/usr/bin/env perl
use strict;
+use warnings;
+
use Test::More tests => 4;
# To find Digest::Dummy
$d = Digest->Dummy;
is $d->digest, "ooo";
-$Digest::MMAP{"Dummy-24"} = [["NotThere"], "NotThereEither", ["Digest::Dummy", 24]];
+$Digest::MMAP{"Dummy-24"} = [ ["NotThere"], "NotThereEither", [ "Digest::Dummy", 24 ] ];
$d = Digest->new("Dummy-24");
is $d->digest, "24";
#!perl -w
+use strict;
+use warnings;
+
use Test::More tests => 5;
+use File::Temp 'tempfile';
+
{
- 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);
- }
+
+ package Digest::Foo;
+ $INC{'Digest/Foo.pm'} = "local";
+ require Digest::base;
+ our @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': $!";
-
-is(digest_file($file, "Foo"), "0005");
-
-if (ord('A') == 193) { # EBCDIC.
- is(digest_file_hex($file, "Foo"), "f0f0f0f5");
- is(digest_file_base64($file, "Foo"), "8PDw9Q");
-} else {
- is(digest_file_hex($file, "Foo"), "30303035");
- is(digest_file_base64($file, "Foo"), "MDAwNQ");
+{
+ my ( $fh, $file ) = tempfile();
+ binmode($fh);
+ print $fh "foo\0\n";
+ close($fh) || die "Can't write '$file': $!";
+
+ is( digest_file( $file, "Foo" ), "0005" );
+
+ if ( ord('A') == 193 ) { # EBCDIC.
+ is( digest_file_hex( $file, "Foo" ), "f0f0f0f5" );
+ is( digest_file_base64( $file, "Foo" ), "8PDw9Q" );
+ }
+ else {
+ is( digest_file_hex( $file, "Foo" ), "30303035" );
+ is( digest_file_base64( $file, "Foo" ), "MDAwNQ" );
+ }
}
-unlink($file) || warn "Can't unlink '$file': $!";
-
-ok !eval { digest_file("not-there.txt", "Foo") };
+ok !eval { digest_file( "not-there.txt", "Foo" ) };
ok $@;
package Digest::Dummy;
use strict;
-use vars qw($VERSION @ISA);
-$VERSION = 1;
+use warnings;
+
+our $VERSION = 1;
+our @ISA = qw(Digest::base);
require Digest::base;
-@ISA = qw(Digest::base);
sub new {
my $class = shift;
- my $d = shift || "ooo";
+ my $d = shift || "ooo";
bless { d => $d }, $class;
}
-sub add {}
+sub add { }
sub digest { shift->{d} }
1;
# ./perl -I../lib porting/customized.t --regen
Config::Perl::V cpan/Config-Perl-V/V.pm 0a0f7207e6505b78ee345a933acb0246a13579f5
Devel::PPPort dist/Devel-PPPort/Makefile.PL c939c8d33d11994c06f546869df63d4518ece797
-Digest cpan/Digest/Digest.pm 43f7f544cb11842b2f55c73e28930da50774e081
ExtUtils::Constant cpan/ExtUtils-Constant/t/Constant.t d5c75c41d6736a0c5897130f534af0896a7d6f4d
ExtUtils::PL2Bat cpan/ExtUtils-PL2Bat/t/make_executable.t 2f58339b567d943712488812f06d99f907af46ab
Filter::Util::Call pod/perlfilter.pod 9b4aec0d8518274ddb0dd37e3b770fe13a44dd1f
https://perl5.git.perl.org / perl5.git / commitdiff