view release on metacpan or  search on metacpan

bin/hashl  view on Meta::CPAN

#!/usr/bin/env perl
## Copyright © 2010 by Daniel Friesel <derf@finalrewind.org>
## License: WTFPL <http://sam.zoy.org/wtfpl>
##   0. You just DO WHAT THE FUCK YOU WANT TO.
use strict;
use warnings;
use 5.010;

no if $] >= 5.018, warnings => 'experimental::smartmatch';

use App::Hashl;
use Cwd;
use DateTime;
use File::Copy;
use File::Find;
use Getopt::Long;
use IO::Handle;
use List::MoreUtils qw(any);
use Time::Progress;

my $add_unignore  = 0;
my $base          = getcwd();
my $rel_paths     = 1;
my $db_file       = '.hashl.db';
my $total         = 0;
my $cur           = 0;
my $show_progress = 1;
my $xdev_fsno;
my @edb_files;
my $timer;
my $incoming_dir;
my $read_size;
my ( $find_ref, $find_db_write );

my $hashl;
my @ehashl;

our $VERSION = '1.01';

STDERR->autoflush(1);

GetOptions(
	'd|database=s'      => \$db_file,
	'e|extra-db=s'      => \@edb_files,
	'f|force'           => \$add_unignore,
	'n|no-progress'     => sub { $show_progress = 0 },
	's|read-size=i'     => sub { $read_size = $_[1] * 1024 },
	'V|version'         => sub { say "hashl version ${VERSION}"; exit 0 },
	'x|one-file-system' => sub { $xdev_fsno = ( stat($base) )[0] },
) or usage();

if ( substr( $db_file, 0, 1 ) ne q{/} ) {
	$db_file = "${base}/${db_file}";
}

my $action = shift;

sub usage {
	die(<<"EOF");
Usage: $0 [options] <update|list|info|...> [args]
See 'perldoc -F $0' (or 'man hashl' if it is properly installed)
EOF
}

if ( not defined $action ) {
	usage();
}

if ( -r $db_file ) {
	$hashl = App::Hashl->new_from_file($db_file);
}
else {
	$hashl = App::Hashl->new( read_size => $read_size );

bin/hashl  view on Meta::CPAN

sub cmd_info {
	my ($file) = @_;

	if ($file) {
		file_info($file);
	}
	else {
		print $hashl->db_info();
	}

	return;
}

sub map_with_prefix {
	my ( $prefix, @items ) = @_;
	return map { [ $prefix, $_ ] } @items;
}

sub cmd_list {
	my ($re) = @_;

	ensure_equal_hash_sizes();

	printf(
		"# hashl v%s   Read Size %d bytes (%s)\n",
		$VERSION, $hashl->read_size, $hashl->si_size( $hashl->read_size ),
	);

	for my $pair (
		sort { $a->[1] cmp $b->[1] }
		map { map_with_prefix( $_, $_->files ) } @ehashl
	  )
	{
		my ( $db, $name ) = @{$pair};
		my $file = $db->file($name);

		if ( $re and $name !~ m{$re} ) {
			next;
		}

		printf( "%s %-7s %s\n",
			$file->{hash}, $db->si_size( $file->{size} ), $name );
	}

	return;
}

sub colorize {
	my ( $filename, $cmap ) = @_;

	my $filetype = ( split( qr{ [.] }x, $filename ) )[-1];
	if ( exists $cmap->{$filetype} ) {
		return sprintf( "\e[%sm%s\e[0m", $cmap->{$filetype}, $filename );
	}
	return $filename;
}

sub cmd_ls {
	my ($re) = @_;
	my $now = DateTime->now;

	ensure_equal_hash_sizes();

	my @ls_colors = split( qr{ : }x, $ENV{LS_COLORS} // q{} );
	my %cmap;

	for my $ls_color (@ls_colors) {
		if ( $ls_color =~ m{ ^ [*] [.] (?<filetype> [^=]+ ) = (?<color> .+) }x )
		{
			$cmap{ $+{filetype} } = $+{color};
		}
	}

	for my $pair (
		sort { $a->[1] cmp $b->[1] }
		map { map_with_prefix( $_, $_->files ) } @ehashl
	  )
	{
		my ( $db, $name ) = @{$pair};
		my $file = $db->file($name);
		my $dt   = DateTime->from_epoch(
			epoch => $file->{mtime},
		);
		my $time_format = '%b %d %H:%M';

 # Date math is hard. So we don't account for leap years (or leap seconds) here.
		if ( $now->epoch - $dt->epoch >= 31536000 ) {
			$time_format = '%b %d  %Y';
		}

		if ( $re and $name !~ m{$re} ) {
			next;
		}

		printf( "%-7s %s %s\n",
			$db->si_size( $file->{size} ),
			$dt->strftime($time_format),
			colorize( $name, \%cmap ) );
	}

	return;
}

sub cmd_list_files {
	say join( "\n", sort map { $_->files } @ehashl );

	return;
}

sub cmd_list_ignored {

	ensure_equal_hash_sizes();

	say join( "\n", map { $_->ignored } @ehashl );

	return;
}

sub cmd_update {
	drop_deleted();
	prepare_db_run();

	$find_ref      = \&db_update;
	$find_db_write = 1;

	find( \&process_file, $base );

	print "\n";

	$hashl->save($db_file);

	return;
}

given ($action) {
	when ('copy')         { cmd_copy(@ARGV) }
	when ('find-known')   { cmd_find_known(@ARGV) }
	when ('find-new')     { cmd_find_new(@ARGV) }
	when ('ignore')       { cmd_ignore(@ARGV) }
	when ('info')         { cmd_info(@ARGV) }
	when ('ls')           { cmd_ls(@ARGV) }