File Coverage

blib/lib/App/Du/Analyze/Filter.pm

Criterion	Covered	Total	%
statement	58	58	100.0
branch	14	16	87.5
condition	3	3	100.0
subroutine	10	10	100.0
pod	2	2	100.0
total	87	89	97.7

package App::Du::Analyze::Filter;
$App::Du::Analyze::Filter::VERSION = '0.2.2';
use strict;
use warnings;

sub _my_all
{
    my $cb = shift;

    foreach my $x (@_)
    {
        if ( not $cb->( local $_ = $x ) )
        {
            return 0;
        }
    }

    return 1;
}

sub new
{
    my $class = shift;

    my $self = bless {}, $class;

    $self->_init(@_);

    return $self;
}

sub _depth
{
    my $self = shift;

    if (@_)
    {
        $self->{_depth} = shift;
    }

    return $self->{_depth};
}

sub _prefix
{
    my $self = shift;

    if (@_)
    {
        $self->{_prefix} = shift;
    }

    return $self->{_prefix};
}

sub _should_sort
{
    my $self = shift;

    if (@_)
    {
        $self->{_should_sort} = shift;
    }

    return $self->{_should_sort};
}

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

    $self->_prefix( $args->{prefix} );
    $self->_depth( $args->{depth} );
    $self->_should_sort(1);

    if ( exists( $args->{should_sort} ) )
    {
        $self->_should_sort( $args->{should_sort} );
    }

    return;
}

sub filter
{
    my ( $self, $in_fh, $out_fh ) = @_;

    my $prefix = $self->_prefix;
    my $sort   = $self->_should_sort;
    my $depth  = $self->_depth;

    my $compare_depth = $depth - 1;
    my @results;

    $prefix =~ s#/+\z##;

    my @prefix_to_test = split( m#/#, $prefix );

    while ( my $line = <$in_fh> )
    {
        chomp($line);
        if ( my ( $size, $total_path, $path ) =
            $line =~ m#\A(\d+)\t(\.(.*?))\z# )
        {
            my @path_to_test = split( m#/#, $total_path );

            # Get rid of the ".".
            shift(@path_to_test);

            if (
                ( @path_to_test == @prefix_to_test + $depth )
                and (
                    _my_all(
                        sub { $path_to_test[$_] eq $prefix_to_test[$_] },
                        ( 0 .. $#prefix_to_test )
                    )
                )
                )
            {
                $path =~ s#\A/##;
                push @results, [ $path, $size ];
            }
        }
    }

    if ($sort)
    {
        @results = ( sort { $a->[1] <=> $b->[1] } @results );
    }

    foreach my $r (@results)
    {
        print {$out_fh} "$r->[1]\t$r->[0]\n";
    }

    return;
}

1;

__END__