File Coverage

blib/lib/CTK/Digest.pm
Criterion Covered Total %
statement 29 46 63.0
branch 0 10 0.0
condition 0 3 0.0
subroutine 10 14 71.4
pod 7 7 100.0
total 46 80 57.5


line stmt bran cond sub pod time code
1             package CTK::Digest;
2 1     1   348 use strict;
  1         1  
  1         23  
3 1     1   4 use utf8;
  1         1  
  1         3  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             CTK::Digest - CTK Digest base class
10              
11             =head1 VERSION
12              
13             Version 1.01
14              
15             =head1 SYNOPSIS
16              
17             use parent qw/CTK::Digest/;
18              
19             =head1 DESCRIPTION
20              
21             CTK Digest base class
22              
23             =head1 METHODS
24              
25             =over 8
26              
27             =item B
28              
29             my $provider = CTK::Digest::Provider->new();
30              
31             Returns Digest Provider instance
32              
33             =item B
34              
35             $provider->add("data", "and another data", ...);
36              
37             Add data to digest calculate.
38             All specified data of array will be concatenated to one pool of data
39              
40             =item B
41              
42             $provider->addfile("/path/of/file");
43              
44             Add file content to data pool
45              
46             $provider->addfile(*STDIN);
47              
48             Add STDIN content to data pool
49              
50             =item B
51              
52             my $digest = $provider->digest;
53              
54             Returns sesult digest (as is)
55              
56             =item B
57              
58             my $digest = $provider->hexdigest;
59              
60             Returns sesult digest as hex string
61              
62             =item B, B
63              
64             my $digest = $provider->b64digest;
65              
66             Returns sesult digest as b64 string
67              
68             =item B
69              
70             $provider->reset;
71              
72             Reset data (set to "")
73              
74             =back
75              
76             =head1 HISTORY
77              
78             See C file
79              
80             =head1 TO DO
81              
82             See C file
83              
84             =head1 BUGS
85              
86             * none noted
87              
88             =head1 SEE ALSO
89              
90             L
91              
92             =head1 AUTHOR
93              
94             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
95              
96             =head1 COPYRIGHT
97              
98             Copyright (C) 1998-2022 D&D Corporation. All Rights Reserved
99              
100             =head1 LICENSE
101              
102             This program is free software; you can redistribute it and/or
103             modify it under the same terms as Perl itself.
104              
105             See C file and L
106              
107             =cut
108              
109 1     1   33 use vars qw/$VERSION/;
  1         1  
  1         41  
110             $VERSION = '1.01';
111              
112             use constant {
113 1         75 BUFFER_SIZE => 4*1024, # 4kB
114 1     1   4 };
  1         1  
115              
116 1     1   5 use Carp;
  1         1  
  1         47  
117              
118 1     1   395 use IO::File;
  1         6992  
  1         106  
119 1     1   431 use MIME::Base64;
  1         517  
  1         309  
120              
121             sub digest;
122              
123             sub new {
124 2     2 1 673 my $class = shift;
125 2         7 return bless {
126             data => '',
127             }, $class;
128             }
129             sub add {
130 4     4 1 13 my $self = shift;
131 4         12 $self->{data} .= join('', @_);
132 4         8 return $self;
133             }
134             sub addfile {
135 0     0 1 0 my $self = shift;
136 0         0 my $fh = shift;
137 0 0       0 return $self unless $fh;
138 0 0 0     0 if (!ref($fh) && ref(\$fh) ne "GLOB") {
139 0         0 $fh = IO::File->new($fh, "r");
140 0 0       0 return $self unless $fh;
141             }
142 0 0       0 $fh->binmode() or croak(sprintf("Can't switch to binmode: %s", $!));
143 0         0 my $buf;
144 0         0 while ($fh->read($buf, BUFFER_SIZE)) {
145 0         0 $self->add($buf);
146             }
147 0 0       0 $fh->close() or croak(sprintf("Can't close file: %s", $!));
148 0         0 return $self;
149             }
150             sub reset {
151 2     2 1 4 my $self = shift;
152 2         4 $self->{data} = "";
153 2         6 return $self;
154             }
155             sub hexdigest {
156 0     0 1   my $self = shift;
157 0           return unpack("H*", $self->digest(@_));
158             }
159             sub base64digest {
160 0     0 1   my $self = shift;
161 0           return encode_base64($self->digest(@_), "");
162             }
163 0     0 1   sub b64digest { goto &base64digest }
164              
165             1;
166              
167             __END__