File Coverage

blib/lib/App/Hashl.pm

Criterion	Covered	Total	%
statement	82	85	96.4
branch	14	22	63.6
condition	4	8	50.0
subroutine	20	20	100.0
pod	15	15	100.0
total	135	150	90.0

package App::Hashl;

use strict;
use warnings;
use 5.010;

use Digest::SHA qw(sha1_hex);
use Storable qw(nstore retrieve);

our $VERSION = '1.00';

sub new {
	my ( $obj, %conf ) = @_;

	my $ref = {
		files   => {},
		ignored => {},
	};

	$ref->{config} = \%conf;
	$ref->{config}->{read_size} //= ( 2**20 ) * 4;    # 4 MiB

	return bless( $ref, $obj );
}

sub new_from_file {
	my ( $obj, $file ) = @_;

	my $ref = retrieve($file);

	return bless( $ref, $obj );
}

sub si_size {
	my ( $self, $bytes ) = @_;
	my @post = ( q{ }, qw(k M G T) );

	while ( $bytes >= 1024 ) {
		$bytes /= 1024;
		shift @post;
	}

	return sprintf( '%6.1f%s', $bytes, $post[0] );
}

sub hash_file {
	my ( $self, $file ) = @_;
	my $data;

	# read() fails for empty files
	if ( ( stat($file) )[7] == 0 ) {
		return sha1_hex();
	}

	#<<< perltidy has problems indenting 'or die' with tabs

	open( my $fh, '<', $file )
		or die("Can't open ${file} for reading: $!\n");
	binmode($fh)
		or die("Can't set binmode on ${file}: $!\n");
	read( $fh, $data, $self->{config}->{read_size} )
		or die("Can't read ${file}: $!\n");
	close($fh)
		or die("Can't close ${file}: $!\n");

	#>>>
	return sha1_hex($data);
}

sub hash_in_db {
	my ( $self, $hash ) = @_;

	if ( $self->{ignored}->{$hash} ) {
		return '// ignored';
	}

	for my $name ( $self->files() ) {
		my $file = $self->file($name);

		if ( $file->{hash} eq $hash ) {
			return $name;
		}
	}
	return;
}

sub file_in_db {
	my ( $self, $file ) = @_;

	return $self->hash_in_db( $self->hash_file($file) );
}

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

	return $self->{config}->{read_size};
}

sub file {
	my ( $self, $name ) = @_;

	return $self->{files}->{$name};
}

sub delete_file {
	my ( $self, $name ) = @_;

	delete $self->{files}->{$name};

	return 1;
}

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

	return keys %{ $self->{files} };
}

sub add_file {
	my ( $self, %opt ) = @_;
	my $file = $opt{file};
	my $path = $opt{path};
	my ( $size, $mtime ) = ( stat($path) )[ 7, 9 ];

	if (    $self->file($file)
		and $self->file($file)->{mtime} == $mtime
		and $self->file($file)->{size} == $size )
	{
		return;
	}

	my $hash = $self->hash_file($path);

	if ( $self->{ignored}->{$hash} ) {
		if ( $opt{unignore} ) {
			$self->unignore($hash);
		}
		else {
			return;
		}
	}

	$self->{files}->{$file} = {
		hash  => $hash,
		mtime => $mtime,
		size  => $size,
	};

	return 1;
}

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

	if ( exists $self->{ignored} ) {
		return keys %{ $self->{ignored} };
	}

	return ();
}

sub ignore {
	my ( $self, $file, $path ) = @_;

	$self->delete_file($file);
	$self->{ignored}->{ $self->hash_file($path) } = 1;

	return 1;
}

sub unignore {
	my ( $self, $hash ) = @_;

	delete $self->{ignored}->{$hash};

	return 1;
}

sub save {
	my ( $self, $file ) = @_;

	return nstore( $self, $file );
}

1;

__END__