File Coverage

blib/lib/Digest/SHA3.pm

Criterion	Covered	Total	%
statement	41	95	43.1
branch	15	60	25.0
condition	0	9	0.0
subroutine	9	13	69.2
pod	3	3	100.0
total	68	180	37.7

package Digest::SHA3;

require 5.003000;

use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT_OK $errmsg);
use Fcntl qw(O_RDONLY O_RDWR);
use Cwd qw(getcwd);
use integer;

$VERSION = '1.05';

require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
	$errmsg
	shake128	shake128_base64		shake128_hex
	shake256	shake256_base64		shake256_hex
	sha3_224	sha3_224_base64		sha3_224_hex
	sha3_256	sha3_256_base64		sha3_256_hex
	sha3_384	sha3_384_base64		sha3_384_hex
	sha3_512	sha3_512_base64		sha3_512_hex);

# Inherit from Digest::base if possible

eval {
	require Digest::base;
	push(@ISA, 'Digest::base');
};

# The following routines aren't time-critical, so they can be left in Perl

sub new {
	my($class, $alg) = @_;
	$alg =~ s/\D+//g if defined $alg;
	$alg =~ s/^3?(224|256|384|512|128000|256000)$/$1/ if defined $alg;
	if (ref($class)) {	# instance method
		if (!defined($alg) || ($alg == $class->algorithm)) {
			sharewind($class);
			return($class);
		}
		return shainit($class, $alg) ? $class : undef;
	}
	$alg = 224 unless defined $alg;
	return newSHA3($class, $alg);
}

BEGIN { *reset = \&new }

sub add_bits {
	my($self, $data, $nbits, $lsb) = @_;
	if (defined $nbits) {
		my $max = length($data) * 8;
		$nbits = $max if $nbits > $max;
	}
	if ($lsb) {
		shawrite($data, $nbits, $self);
		return($self);
	}
	unless (defined $nbits) {
		$nbits = length($data);
		$data = pack("B*", $data);
	}
	if ($nbits % 8) {
		my $b = unpack("C", substr($data, -1));
		$b >>= (8 - $nbits % 8);
		substr($data, -1) = pack("C", $b);
	}
	shawrite($data, $nbits, $self);
	return($self);
}

sub _bail {
	my $msg = shift;

	$errmsg = $!;
	$msg .= ": $!";
        require Carp;
        Carp::croak($msg);
}

{
	my $_can_T_filehandle;

	sub _istext {
		local *FH = shift;
		my $file = shift;

		if (! defined $_can_T_filehandle) {
			local $^W = 0;
			my $istext = eval { -T FH };
			$_can_T_filehandle = $@ ? 0 : 1;
			return $_can_T_filehandle ? $istext : -T $file;
		}
		return $_can_T_filehandle ? -T FH : -T $file;
	}
}

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

	my $n;
	my $buf = "";

	while (($n = read($handle, $buf, 4096))) {
		$self->add($buf);
	}
	_bail("Read failed") unless defined $n;

	$self;
}

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

	return(_addfile($self, $file)) unless ref(\$file) eq 'SCALAR';

	$mode = defined($mode) ? $mode : "";
	my ($binary, $UNIVERSAL, $BITS) =
		map { $_ eq $mode } ("b", "U", "0");

		## Always interpret "-" to mean STDIN; otherwise use
		##	sysopen to handle full range of POSIX file names.
		## If $file is a directory, force an EISDIR error
		##	by attempting to open with mode O_RDWR

	local *FH;
	if ($file eq '-') {
		if (-d STDIN) {
			sysopen(FH, getcwd(), O_RDWR)
				or _bail('Open failed');
		}
		open(FH, '< -')
			or _bail('Open failed');
	}
	else {
		sysopen(FH, $file, -d $file ? O_RDWR : O_RDONLY)
			or _bail('Open failed');
	}

	if ($BITS) {
		my ($n, $buf, $bits) = (0, "", "");
		while (($n = read(FH, $buf, 4096))) {
			$buf =~ tr/01//cd;
			$bits .= $buf;
			if (length($bits) >= 4096) {
				$self->add_bits(substr($bits, 0, 4096));
				$bits = substr($bits, 4096);
			}
		}
		$self->add_bits($bits) if length($bits) > 0;
		_bail("Read failed") unless defined $n;
		close(FH);
		return($self);
	}

	binmode(FH) if $binary || $UNIVERSAL;
	if ($UNIVERSAL && _istext(*FH, $file)) {
		$self->_addfileuniv(*FH);
	}
	else { $self->_addfilebin(*FH) }
	close(FH);

	$self;
}

eval {
	require XSLoader;
	XSLoader::load('Digest::SHA3', $VERSION);
	1;
} or do {
	require DynaLoader;
	push @ISA, 'DynaLoader';
	Digest::SHA3->bootstrap($VERSION);
};

1;
__END__