File Coverage

lib/File/HStore.pm

Criterion	Covered	Total	%
statement	18	99	18.1
branch	0	48	0.0
condition	0	3	0.0
subroutine	6	13	46.1
pod	4	4	100.0
total	28	167	16.7

package File::HStore;

use strict;
use warnings;
use Digest::SHA;
use File::Copy;
use File::Path;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

our %EXPORT_TAGS = (
    'all' => [
        qw(

            )
    ]
);

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( );

our $VERSION = '0.10';

sub new {

    my ( $this, $path, $digest, $prefix ) = @_;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;

    if ( defined($path) ) {
        $self->{path} = $path;
    }
    else {
        $self->{path} = "~/.hstore";
    }

    if ( defined($digest) ) {
        $self->{digest} = $digest;
    }
    else {
        $self->{digest} = "SHA1";
    }

    if ( defined($prefix) ) {
        $self->{prefix} = $prefix;
    }
    else {
        $self->{prefix} = "freearchive";
    }

    if ( !( -e $self->{path} ) ) {
        mkdir( $self->{path} )
            or die "Unable to create directory : $self->{path}";
    }

    return $self;
}

sub add {

    my ( $self, $filename ) = @_;
    my $ldigest;
    my $lSubmitDate;

    if ( $self->{digest} eq "FAT" ) {
        $ldigest = "SHA2";
    }
    else {
        $ldigest = $self->{digest};
    }
    my $localDigest = _DigestAFile( "$filename", $ldigest )
        or die "Unable to digest the file $filename";

    my $SSubDir;

    if ( !( $self->{digest} eq "FAT" ) ) {
        my $localSubDir = substr( $localDigest, 0, 2 );
        $SSubDir = $self->{path} . "/" . $localSubDir;

    }
    else {

        $lSubmitDate = _SubmitDate();
        $lSubmitDate =~ s/-/\//g;
        $SSubDir = $self->{path} . "/" . $self->{prefix} . "/" . $lSubmitDate;

    }

    if ( !( -e $SSubDir ) ) {

        mkpath($SSubDir) or die "Unable to create subdirectoris $SSubDir in the hstore";
    }

    my $destStoredFile = $SSubDir . "/" . $localDigest;

    if ( !( $self->{digest} eq "FAT" ) ) {
        copy( $filename, $destStoredFile )
        or die "Unable to copy file into hstore as $destStoredFile";
    } else {
        mkpath($destStoredFile);
        copy( $filename, $destStoredFile);
    }

    if ( !( $self->{digest} eq "FAT" ) ) {
        return $localDigest;
    }
    else {
        $lSubmitDate =~ s/\//-/g;
        return $self->{prefix} . "-" . $lSubmitDate . "-" . $localDigest;
    }
}

sub remove {

    my ( $self, $id ) = @_;

    my $destStoredFile;

    #    if (!(defined($id))) {die "hash to be removed not defined";}

    if ( !( defined($id) ) ) { return undef; }

    if ( !( $self->{digest} eq "FAT" ) ) {
        my $localSubDir = substr( $id, 0, 2 );
        my $SSubDir = $self->{path} . "/" . $localSubDir;
        $destStoredFile = $SSubDir . "/" . $id;
    }
    else {
        $id =~ s/-/\//g;
        $destStoredFile = $self->{path} . "/" . $id;
    }

    if ( -e $destStoredFile ) {

        if ( !( $self->{digest} eq "FAT" ) ) {
            unlink($destStoredFile) or return undef;
        }
        else {
            rmtree($destStoredFile) or return undef;
        }

        #die "Unable to delete file from hstore named $destStoredFile";
        #return undef;
    }
    else {
        return;
    }

}

sub getpath {

    my ( $self, $id ) = @_;

    my $destStoredFile;

    if ( !( $self->{digest} eq "FAT" ) ) {
        my $localSubDir = substr( $id, 0, 2 );
        my $SSubDir = $self->{path} . "/" . $localSubDir;
        $destStoredFile = $SSubDir . "/" . $id;
    }
    else {
        $id =~ s/-/\//g;
        $destStoredFile = $self->{path} . "/" . $id;
    }

    if ( -e $destStoredFile ) {
	return $destStoredFile;
    } else {
	return;
    }
}

sub _printPath {
    my ($self) = @_;

    return $self->{path};

}

sub _DigestAFile {

    my $file      = shift;
    my $digestdef = shift;
    my $sha;
    open( FILED, "$file" ) or die "Unable to open file $file";
    if ( $digestdef eq "SHA1" ) {
        $sha = Digest::SHA->new("sha1");
    }
    elsif ( $digestdef eq "SHA2" ) {
        $sha = Digest::SHA->new("sha256");
    }
    else {
        print "unknown digest method";
    }
    $sha->addfile(*FILED);
    close(FILED);
    return my $digest = $sha->hexdigest;

}

# Used only for the Free Archive Toolkit mixed-"hash" format
#
# FAT is following this format :
#
# prefix-year-mm-dd-hh-mm-ss-hash
#
# The format is represented on disk with the following format :
#
# prefix/year/mm/dd/hh/mm/ss/hash

# return the date in FAT format

sub _SubmitDate {

    my ( $sec, $min, $hour, $day, $month, $year ) =
        (localtime)[ 0, 1, 2, 3, 4, 5 ];

    return sprintf(
        "%04d-%02d-%02d-%02d-%02d-%02d",
        $year + 1900,
        $month + 1, $day, $hour, $min, $sec
    );

}

1;
__END__