File Coverage

lib/Archive/BagIt/Fast.pm

Criterion	Covered	Total	%
statement	62	71	87.3
branch	5	10	50.0
condition	1	2	50.0
subroutine	13	13	100.0
pod	2	2	100.0
total	83	98	84.6

package Archive::BagIt::Fast;
use strict;
use warnings;
use Carp qw( carp croak );
use Time::HiRes qw( time );
use Moo;
use IO::AIO ();
use Net::SSLeay ();
extends "Archive::BagIt";


our $VERSION = '0.090'; # VERSION

# ABSTRACT: A module to use L to get better performance


sub BEGIN {
    Net::SSLeay::OpenSSL_add_all_digests();
}

sub _XXX_digest {
    my $digestobj = shift;
    my $data_ref = shift;
    my $data = ${ $data_ref };
    my $md  = Net::SSLeay::EVP_get_digestbyname($digestobj->name);
    my $internal_digest = Net::SSLeay::EVP_MD_CTX_create();
    Net::SSLeay::EVP_DigestInit($internal_digest, $md);
    Net::SSLeay::EVP_DigestUpdate($internal_digest, $data);
    my $result = Net::SSLeay::EVP_DigestFinal($internal_digest);
    Net::SSLeay::EVP_MD_CTX_destroy($internal_digest);
    my $digest = unpack('H*', $result);
    return $digest;

}

sub sysread_based_digest {
    my $digestobj = shift;
    my $fh = shift;
    my $filesize = shift;
    my $data;
    sysread $fh, $data, $filesize;
    return _XXX_digest( $digestobj, \$data);
}

sub mmap_based_digest {
    my $digestobj = shift;
    my $fh = shift;
    my $filesize = shift;
    my $data='';
    if ($filesize > 0) {
        if (! IO::AIO::mmap $data, $filesize, IO::AIO::PROT_READ, IO::AIO::MAP_SHARED, $fh) {
            carp "mmap fails, fall back to sysread";
            sysread $fh, $data, $filesize;
        };
    }
    return _XXX_digest($digestobj, \$data);
}

has 'digest_callback' => (
    is      => 'ro',
    lazy    => 1,

    builder => sub {
        my ($self) = shift;
        #my $sub = sub {
        #    my ($digestobj, $filename) = @_;
        #    open(my $fh, "<:raw", "$filename") or croak ("Cannot open $filename, $!");
        #    binmode($fh);
        #    my $digest = $digestobj->get_hash_string($fh);
        #    close $fh || croak("could not close file '$filename', $!");
        #    return $digest;
        #};
        my $sub = sub {
            my $digestobj = shift;
            my $filename =shift;
            my $opts = shift;
            my $MMAP_MIN = $opts->{mmap_min} || 8000000;
            my $filesize = -s $filename;
            open(my $fh, "<:raw", "$filename") or croak ("Cannot open $filename, $!");
            $self->{stats}->{files}->{"$filename"}->{size}= $filesize;
            $self->{stats}->{size} += $filesize;
            my $start_time = time();
            my $digest;
            if ($filesize < $MMAP_MIN ) {
                return sysread_based_digest($digestobj, $fh, $filesize);
            }
            elsif ( $filesize < 1500000000) {
                return mmap_based_digest($digestobj, $fh, $filesize);
            }
            else {
                $digest = $digestobj->get_hash_string($fh);
            }
            my $finish_time = time();
            $self->{stats}->{files}->{"$filename"}->{verify_time}= ($finish_time - $start_time);
            $self->{stats}->{verify_time} += ($finish_time-$start_time);
            close($fh);
            return $digest;
        };
        return $sub;
    }
);

1;

__END__