File Coverage

blib/lib/Data/Digest.pm

Criterion	Covered	Total	%
statement	58	63	92.0
branch	17	28	60.7
condition	7	15	46.6
subroutine	17	17	100.0
pod	5	5	100.0
total	104	128	81.2

package Data::Digest;

=pod

=head1 NAME

Data::Digest - Objects that represent a digest values

=head1 SYNOPSIS

  $digest = Data::Digest->new(
      'MD5.d41d8cd98f00b204e9800998ecf8427e'
  );

  $digest = Data::Digest->new(
      'SHA-256' => '47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU',
  );

  $digest->matches( \$data );
  $digest->matches( $filename );

=head1 DESCRIPTION

The C class provides utility objects that represents
a digest value. It is used primarily as a convenience and to simplify code
when dealing with situations where you are provided with a digest, and need
to check it against some data.

It initially supports 4 different digest types, (MD5, SHA-1,
SHA-256 and SHA-512) to provide varying strengths of checking.
The default, which is intended for speed and basic non-cryptographic
file integrity checking, is MD5.

Users hand-crafting guest specifications may want to use a stronger
digest.

=head1 METHODS

=cut

use 5.005;
use strict;
use Carp         ();
use Digest       ();
use IO::File     ();
use Params::Util qw{_STRING _SCALAR0 _INSTANCE};

use vars qw{$VERSION};
BEGIN {
	$VERSION = '1.04';
}

# For all supported digest types, provide the expected lengths of the digest
# in each format in bits.
# These will be used to help generate the regular expressions used to
# validate the input strings.
my %DIGEST = (
	'MD5' => {
		bits      => 128,
		digest    => 16,
		hexdigest => 32,
		b64digest => 22,
	},
	'SHA-1' => {
		bits      => 160,
		digest    => 20,
		hexdigest => 40,
		b64digest => 27,
	},
	'SHA-256' => {
		bits      => 256,
		digest    => 32,
		hexdigest => 64,
		b64digest => 43,
	},
	'SHA-512' => {
		bits      => 512,
		digest    => 64,
		hexdigest => 128,
		b64digest => 86,
	},
);





#####################################################################
# Constructor and Accessors

=pod

=head2 new

  # Two-argument digest constructor
  $digest = Data::Digest->new(
      'SHA-256' => '47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU',
  );

  # One-argument digest constructor
  $digest = Data::Digest->new(
      'MD5.d41d8cd98f00b204e9800998ecf8427e'
  );

The C constructor takes one or two strings parameters, and creates
a new digest object, that can be stored or used to compared the digest
value to existing data, or a file.

The basic two-argument form takes the name of a supported digest driver,
and the digest value.

The digest driver is case sensitive and should be one of C<'MD5'>,
C<'SHA-1'>, C<'SHA-256'> or C<'SHA-512'>. (case sensitive)

The second param should be a string containing the value of the digest
in either binary, hexidecimal or base 64 format.

The constructor will auto-detect the encoding type.

For example, for a 128-bit MD5 digest, the constructor will allow a
16-character binary string, a 32-character hexedecimal string, or
a 22-character base 64 string.

Returns a C object, or throws an exception on error.

=cut

sub new {
	my $class = shift;
	my ($driver, $digest, $method) = ();
	if ( @_ == 1 and _STRING($_[0]) ) {
		if ( $_[0] =~ /^(\w+(?:-\d+)?)\.(\S+)$/ ) {
			$driver = $1;
			$digest = $2;
		} else {
			Carp::croak("Unrecognised or unsupported Data::Digest string");
		}
	} elsif ( @_ == 2 and _STRING($_[0]) and _STRING($_[1]) ) {
		$driver = $_[0];
		$digest = $_[1];
	} else {
		Carp::croak("Missing or invalid params provided to Data::Digest constructor");
	}

	# Check the digest values
	my $len = $DIGEST{$driver}
		or Carp::croak("Invalid or unsupported digest type '$driver'.");

	# Check the digest content to find the method
	if ( length $digest == $len->{digest} ) {
		$method = 'digest';
	} elsif ( length $digest == $len->{hexdigest} and $digest !~ /[^0-9a-f]/ ) {
		$method = 'hexdigest';
	} elsif ( length $digest == $len->{b64digest} and $digest !~ /[^\w\+\/]/ ) {
		$method = 'b64digest';
	} else {
		Carp::croak("Digest string is not a recognised $driver");
	}

	# Create the object
	my $self = bless {
		driver => $driver,
		digest => $digest,
		method => $method,
	}, $class;

	return $self;
}

=pod

=head2 driver

The C accessor returns the digest driver name, which be one of
either C<'MD5'>, C<'SHA-1'>, C<'SHA-256'> or C<'SHA-512'>.

=cut

sub driver {
	$_[0]->{driver};
}

=pod

=head2 digest

The C accessor returns the digest value, in the original format.

This could be either binary, hexidecimal or base 64 and without knowing
what was originally entered you may not necesarily know which it will be.

=cut

sub digest {
	$_[0]->{digest};
}





#####################################################################
# Main Methods

=pod

=head2 as_string

The C method returns the stringified form of the digest,
which will be equivalent to and suitable for use as the value passed
to the single-parameter form of the constructor.

  print $digest->as_string . "\n";
  > MD5.d41d8cd98f00b204e9800998ecf8427e

Returns a string between around 15 and 90 characters, depending on the
type and encoding of the digest value.

=cut

sub as_string {
	$_[0]->driver . '.' . $_[0]->digest;
}

=pod

=head2 matches

  # Check the digest against something
  $digest->matches( $filename  );
  $digest->matches( $io_handle );
  $digest->matches( \$string   );

The C methods checks the digest object against various forms of
arbitrary data to determine if they match the digest.

It takes a single parameter, consisting of either the name of a file,
an L object, or the reference to a C string.

Returns true if the digest matches the data, false if not, or throws
an exception on error.

=cut

sub matches {
	my $self = shift;
	return $self->_matches_file(shift)   if _STRING($_[0]);
	return $self->_matches_scalar(shift) if _SCALAR0($_[0]);
	return $self->_matches_handle(shift) if _INSTANCE($_[0], 'IO::Handle');
	Carp::croak("Did not provide a valid data value to check digest against");
}

sub _matches_scalar {
	my ($self, $scalar_ref) = @_;

	# Generate the digest for the string
	my $method = $self->{method};
	my $digest = $self->_digest->add($$scalar_ref)->$method();

	return ($self->digest eq $digest);
}

sub _matches_file {
	my ($self, $file) = @_;

	# Check the filename
	-f $file or Carp::croak("File '$file' does not exist");
	-r $file or Carp::croak("No permissions to read '$file'");

	# Load and generate the digest for the file
	my $handle = IO::File->new($file)
		or Carp::croak("Failed to load '$file': $!");
	return $self->_matches_handle($handle);
}

sub _matches_handle {
	my ($self, $handle) = @_;

	# Generate the digest for the handle
	my $method = $self->{method};
	my $digest = $self->_digest->addfile($handle)->$method();

	return ($self->digest eq $digest);
}

sub _digest {
	my $self = shift;
	Digest->new($self->driver)
		or die("Failed to create Digest object");
}

1;

=pod

=head1 SUPPORT

Bugs should be reported via the CPAN bug tracker at

L

For other issues, contact the author.

=head1 AUTHOR

Adam Kennedy [e-mail]

=head1 SEE ALSO

L, L, L

=head1 COPYRIGHT

Copyright 2006 - 2008 Adam Kennedy.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut