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;

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__