File Coverage

blib/lib/App/rshasum.pm

Criterion	Covered	Total	%
statement	58	64	90.6
branch	12	16	75.0
condition	2	2	100.0
subroutine	11	12	91.6
pod	1	1	100.0
total	84	95	88.4

package App::rshasum;
$App::rshasum::VERSION = '0.10.0';
use 5.016;
use strict;
use warnings;

use File::Find::Object ();
use Digest             ();

use Getopt::Long qw/ GetOptions /;
use List::Util 1.33 qw/ any /;

sub _line
{
    my ( $d, $path ) = @_;

    return $d->hexdigest . '  ' . $path . "\n";
}

sub _worker
{
    my ( $self, $args ) = @_;

    my $digest     = $args->{digest};
    my $output_cb  = $args->{output_cb};
    my @prunes     = ( map { qr/$_/ } @{ $args->{prune_re} || [] } );
    my $start_path = ( $args->{start_path} // "." );

    my $t = Digest->new($digest);

    my $ff = File::Find::Object->new( {}, $start_path );
FILES:
    while ( my $r = $ff->next_obj )
    {
        my $path = join '/', @{ $r->full_components };
        if (@prunes)
        {
            if ( any { $path =~ $_ } @prunes )
            {
                $ff->prune;
                next FILES;
            }
        }
        if ( $r->is_file )
        {
            my $fh;
            if ( not( open $fh, '<', $r->path ) )
            {
                warn "Could not open @{[$r->path]} ; skipping";
                next FILES;
            }
            binmode $fh;
            my $d = Digest->new($digest);
            $d->addfile($fh);
            close $fh;
            my $s = _line( $d, $path, );
            $output_cb->( { str => $s } );
            $t->add($s);
        }
    }
    my $s = _line( $t, '-', );
    $output_cb->( { str => $s } );

    return;
}

sub run
{
    my $digest;
    my @skips;
    my $start_path = '.';
    GetOptions(
        'digest=s'     => \$digest,
        'skip=s'       => \@skips,
        'start-path=s' => \$start_path,
    ) or die "Unknown flags $!";
    if ( not defined($digest) )
    {
        die "Please give a --digest=[digest] argument.";
    }
    if (@ARGV)
    {
        die
qq#Leftover arguments "@ARGV" in the command line. (Did you intend to use --start-path ?)#;
    }
    return shift()->_worker(
        {
            digest     => $digest,
            output_cb  => sub { print shift()->{str}; },
            prune_re   => ( \@skips ),
            start_path => $start_path,
        }
    );
}

1;

__END__