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

package CTK::Digest; # $Id: Digest.pm 285 2020-08-28 21:34:27Z minus $
use strict;
use utf8;

=encoding utf-8

=head1 NAME

CTK::Digest - CTK Digest base class

=head1 VERSION

Version 1.00

=head1 SYNOPSIS

    use parent qw/CTK::Digest/;

=head1 DESCRIPTION

CTK Digest base class

=head1 METHODS

=over 8

=item B

    my $provider = CTK::Digest::Provider->new();

Returns Digest Provider instance

=item B

    $provider->add("data", "and another data", ...);

Add data to digest calculate.
All specified data of array will be concatenated to one pool of data

=item B

    $provider->addfile("/path/of/file");

Add file content to data pool

    $provider->addfile(*STDIN);

Add STDIN content to data pool

=item B

    my $digest = $provider->digest;

Returns sesult digest (as is)

=item B

    my $digest = $provider->hexdigest;

Returns sesult digest as hex string

=item B, B

    my $digest = $provider->b64digest;

Returns sesult digest as b64 string

=item B

    $provider->reset;

Reset data (set to "")

=back

=head1 HISTORY

See C file

=head1 TO DO

See C file

=head1 BUGS

* none noted

=head1 SEE ALSO

L

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L [e-mail]

=head1 COPYRIGHT

Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved

=head1 LICENSE

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

See C file and L

=cut

use vars qw/$VERSION/;
$VERSION = '1.00';

use constant {
    BUFFER_SIZE => 4*1024, # 4kB
};

use Carp;

use IO::File;
use MIME::Base64;

sub digest;

sub new {
    my $class = shift;
    return bless {
        data => '',
    }, $class;
}
sub add {
    my $self = shift;
    $self->{data} .= join('', @_);
    return $self;
}
sub addfile {
    my $self = shift;
    my $fh = shift;
    return $self unless $fh;
    if (!ref($fh) && ref(\$fh) ne "GLOB") {
        $fh = IO::File->new($fh, "r");
        return $self unless $fh;
    }
    $fh->binmode() or croak(sprintf("Can't switch to binmode: %s", $!));
    my $buf;
    while ($fh->read($buf, BUFFER_SIZE)) {
        $self->add($buf);
    }
    $fh->close() or croak(sprintf("Can't close file: %s", $!));
    return $self;
}
sub reset {
        my $self = shift;
        $self->{data} = "";
        return $self;
}
sub hexdigest {
    my $self = shift;
    return unpack("H*", $self->digest(@_));
}
sub base64digest {
    my $self = shift;
    return encode_base64($self->digest(@_), "");
}
sub b64digest { goto &base64digest }

1;

__END__