view release on metacpan or  search on metacpan

lib/App/Hashl.pm  view on Meta::CPAN

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

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

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

	return bless( $ref, $obj );
}

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

	my $ref = retrieve($file);

	if ( not defined $ref->{version} ) {
		$ref->{version} = '1.00';
	}

	return bless( $ref, $obj );
}

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

	if ( $bytes == 0 ) {
		return 'infinite';
	}

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

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

sub hash_file {
	my ( $self, $file ) = @_;
	my $data;
	my $digest = Digest::SHA->new(1);

	# read() fails for empty files
	if ( ( stat($file) )[7] == 0 ) {
		return $digest->hexdigest;
	}
	if ( $self->{config}->{read_size} == 0 ) {
		$digest->addfile($file);
		return $digest->hexdigest;
	}

	#<<< 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");

	#>>>
	$digest->add($data);
	return $digest->hexdigest;
}

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 db_info {
	my ($self) = @_;

	return sprintf(
		"Database created by hashl v%s\n"
		  . "Read size: %d bytes (%s)\n"
		  . "contains: %d file%s and %d ignored hash%s\n",
		$self->db_version,
		$self->read_size,
		$self->si_size( $self->read_size ),
		scalar( $self->files ),
		( scalar( $self->files ) == 1 ? q{} : 's' ),
		scalar( $self->ignored ),
		( scalar( $self->ignored ) == 1 ? q{} : 'es' ),
	);
}

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

	return $self->{version};