File Coverage

blib/lib/Digest/SHA3.pm
Criterion Covered Total %
statement 38 88 43.1
branch 15 50 30.0
condition 0 15 0.0
subroutine 8 12 66.6
pod 3 3 100.0
total 64 168 38.1


line stmt bran cond sub pod time code
1             package Digest::SHA3;
2              
3             require 5.003000;
4              
5 13     13   7169 use strict;
  13         105  
  13         411  
6 13     13   72 use warnings;
  13         27  
  13         554  
7 13     13   93 use vars qw($VERSION @ISA @EXPORT_OK $errmsg);
  13         24  
  13         1267  
8 13     13   90 use Fcntl qw(O_RDONLY);
  13         29  
  13         776  
9 13     13   8004 use integer;
  13         200  
  13         71  
10              
11             $VERSION = '1.03';
12              
13             require Exporter;
14             @ISA = qw(Exporter);
15             @EXPORT_OK = qw(
16             $errmsg
17             shake128 shake128_base64 shake128_hex
18             shake256 shake256_base64 shake256_hex
19             sha3_224 sha3_224_base64 sha3_224_hex
20             sha3_256 sha3_256_base64 sha3_256_hex
21             sha3_384 sha3_384_base64 sha3_384_hex
22             sha3_512 sha3_512_base64 sha3_512_hex);
23              
24             # Inherit from Digest::base if possible
25              
26             eval {
27             require Digest::base;
28             push(@ISA, 'Digest::base');
29             };
30              
31             # The following routines aren't time-critical, so they can be left in Perl
32              
33             sub new {
34 18     18 1 1275 my($class, $alg) = @_;
35 18 100       81 $alg =~ s/\D+//g if defined $alg;
36 18 100       117 $alg =~ s/^3?(224|256|384|512|128000|256000)$/$1/ if defined $alg;
37 18 50       64 if (ref($class)) { # instance method
38 0 0 0     0 if (!defined($alg) || ($alg == $class->algorithm)) {
39 0         0 sharewind($class);
40 0         0 return($class);
41             }
42 0 0       0 return shainit($class, $alg) ? $class : undef;
43             }
44 18 100       52 $alg = 224 unless defined $alg;
45 18         134 return newSHA3($class, $alg);
46             }
47              
48 13     13   14624 BEGIN { *reset = \&new }
49              
50             sub add_bits {
51 23     23 1 440 my($self, $data, $nbits, $lsb) = @_;
52 23 100       71 if (defined $nbits) {
53 18         35 my $max = length($data) * 8;
54 18 50       59 $nbits = $max if $nbits > $max;
55             }
56 23 100       55 if ($lsb) {
57 17         119 shawrite($data, $nbits, $self);
58 17         163 return($self);
59             }
60 6 100       12 unless (defined $nbits) {
61 5         6 $nbits = length($data);
62 5         16 $data = pack("B*", $data);
63             }
64 6 50       14 if ($nbits % 8) {
65 6         12 my $b = unpack("C", substr($data, -1));
66 6         13 $b >>= (8 - $nbits % 8);
67 6         11 substr($data, -1) = pack("C", $b);
68             }
69 6         23 shawrite($data, $nbits, $self);
70 6         47 return($self);
71             }
72              
73             sub _bail {
74 0     0     my $msg = shift;
75              
76 0           $errmsg = $!;
77 0           $msg .= ": $!";
78 0           require Carp;
79 0           Carp::croak($msg);
80             }
81              
82             {
83             my $_can_T_filehandle;
84              
85             sub _istext {
86 0     0     local *FH = shift;
87 0           my $file = shift;
88              
89 0 0         if (! defined $_can_T_filehandle) {
90 0           local $^W = 0;
91 0           my $istext = eval { -T FH };
  0            
92 0 0         $_can_T_filehandle = $@ ? 0 : 1;
93 0 0         return $_can_T_filehandle ? $istext : -T $file;
94             }
95 0 0         return $_can_T_filehandle ? -T FH : -T $file;
96             }
97             }
98              
99             sub _addfile {
100 0     0     my ($self, $handle) = @_;
101              
102 0           my $n;
103 0           my $buf = "";
104              
105 0           while (($n = read($handle, $buf, 4096))) {
106 0           $self->add($buf);
107             }
108 0 0         _bail("Read failed") unless defined $n;
109              
110 0           $self;
111             }
112              
113             sub addfile {
114 0     0 1   my ($self, $file, $mode) = @_;
115              
116 0 0         return(_addfile($self, $file)) unless ref(\$file) eq 'SCALAR';
117              
118 0 0         $mode = defined($mode) ? $mode : "";
119             my ($binary, $UNIVERSAL, $BITS) =
120 0           map { $_ eq $mode } ("b", "U", "0");
  0            
121              
122             ## Always interpret "-" to mean STDIN; otherwise use
123             ## sysopen to handle full range of POSIX file names
124              
125 0           local *FH;
126 0 0 0       $file eq '-' and open(FH, '< -')
      0        
127             or sysopen(FH, $file, O_RDONLY)
128             or _bail('Open failed');
129              
130 0 0         if ($BITS) {
131 0           my ($n, $buf, $bits) = (0, "", "");
132 0           while (($n = read(FH, $buf, 4096))) {
133 0           $buf =~ tr/01//cd;
134 0           $bits .= $buf;
135 0 0         if (length($bits) >= 4096) {
136 0           $self->add_bits(substr($bits, 0, 4096));
137 0           $bits = substr($bits, 4096);
138             }
139             }
140 0 0         $self->add_bits($bits) if length($bits) > 0;
141 0 0         _bail("Read failed") unless defined $n;
142 0           close(FH);
143 0           return($self);
144             }
145              
146 0 0 0       binmode(FH) if $binary || $UNIVERSAL;
147 0 0 0       if ($UNIVERSAL && _istext(*FH, $file)) {
148 0           $self->_addfileuniv(*FH);
149             }
150 0           else { $self->_addfilebin(*FH) }
151 0           close(FH);
152              
153 0           $self;
154             }
155              
156             eval {
157             require XSLoader;
158             XSLoader::load('Digest::SHA3', $VERSION);
159             1;
160             } or do {
161             require DynaLoader;
162             push @ISA, 'DynaLoader';
163             Digest::SHA3->bootstrap($VERSION);
164             };
165              
166             1;
167             __END__