File Coverage

lib/Badger/Filter.pm

Criterion	Covered	Total	%
statement	73	91	80.2
branch	31	48	64.5
condition	12	19	63.1
subroutine	13	13	100.0
pod	7	10	70.0
total	136	181	75.1

package Badger::Filter;

use Badger::Class
    version   => 0.01,
    debug     => 0,
    import    => 'class',
    base      => 'Badger::Base',
    utils     => 'is_object',
    constants => 'NONE ALL TRUE FALSE CODE REGEX ARRAY HASH',
    constant  => {
        FILTER => 'Badger::Filter',
    },
    exports   => {
        any   => 'FILTER Filter',
    };


sub Filter {
    return FILTER unless @_;
    return @_ == 1 && is_object(FILTER, $_[0])
        ? $_[0]                                 # return existing Filter object
        : FILTER->new(@_);                      # or construct a new one
}

#-----------------------------------------------------------------------------
# Initialisation methods
#-----------------------------------------------------------------------------

sub init {
    my ($self, $config) = @_;
    my $class  = $self->class;
    my $accept = $config->{ accept };
    my ($include, $exclude);

    if ($accept) {
        if ($accept eq ALL) {
            # default behaviour - no include, no exclude
        }
        elsif ($accept eq NONE) {
            $exclude = '*';
        }
        else {
            # list of "item" (include), "-item" (exclude) or "+item" (include)
            my @items = split(/[^\w\-\+]+/, $accept);
            my (@inc, @exc);

            foreach my $item (@items) {
                if      ($item =~ s/^\-//)  { push(@exc, $item); }
                elsif   ($item =~ s/^\+//)  { push(@inc, $item); }
                else                        { push(@inc, $item); }
            }
            $include = \@inc if @inc;
            $exclude = \@exc if @exc;
        }
    }
    else {
        $include = $class->list_vars(
            INCLUDE => $config->{ include }
        );
        $exclude = $class->list_vars(
            EXCLUDE => $config->{ exclude }
        );
    }

    $self->{ include } = $self->init_filter_set(
        include => $include
    ) if $include;

    $self->{ exclude } = $self->init_filter_set(
        exclude => $exclude
    ) if $exclude;

    return $self;
}

sub init_filter_set {
    my ($self, $name, @items) = @_;
    my $static  = { };
    my $dynamic = [ ];
    my $n       = 0;

    $self->debug(
        "init_filter_set($name) : ",
        $self->dump_data(\@items)
    ) if DEBUG;

    while (@items) {
        my $item = shift @items;

        if (! ref $item) {
            if ((my $copy = $item) =~ s/\*/.*/g) {
                push(@$dynamic, sub { $_[0] =~ /^$copy$/ });
                $self->debug("$name: set wildcard item: $item") if DEBUG;
            }
            else {
                $static->{ $item } = 1;
                $self->debug("$name: set static item: $item") if DEBUG;
            }
            $n++;
        }
        elsif (ref $item eq ARRAY) {
            unshift(@items, @$item);
            $self->debug("$name: expanded array: ", $self->dump_data($item)) if DEBUG;
        }
        elsif (ref $item eq HASH) {
            my $truly = {
                map  { @$_   }                  # unpack key and value
                grep { $_[1] }                  # only accept true value
                map  { [$_, $item->{ $_ }] }    # pack key and value
                keys %$item
            };
            @$static{ keys %$truly } = map { 1 } values %$truly;
            $n += scalar keys %$truly;
            $self->debug("$name: set hash of true items: ", $self->dump_data($truly)) if DEBUG;
        }
        elsif (ref $item eq CODE) {
            push(@$dynamic, $item);
            $n++;
            $self->debug("$name: added code ref: $item") if DEBUG;
        }
        elsif (ref $item eq REGEX) {
            my $regex = $item;
            push(@$dynamic, sub { $_[0] =~ $regex });
            $n++;
            $self->debug("$name: added regex: $item") if DEBUG;
        }
        else {
            return $self->error_msg( invalid => $name => $item );
        }
    }

    return undef unless $n;

    my $set = {
        static  => $static,
        dynamic => $dynamic,
    };

    $self->debug(
        "init_filter_set($name) $n items: ",
        $self->dump_data($set)
    ) if DEBUG;

    return $set;
}


#-----------------------------------------------------------------------------
# List filtering methods
#-----------------------------------------------------------------------------

sub accept {
    my $self   = shift;
    my $items  = (@_ == 1 && ref $_[0] eq ARRAY) ? shift : [@_];
    my @accept = grep { $self->item_accepted($_) } @$items;
    return wantarray
        ?  @accept
        : \@accept;
}

sub reject {
    my $self   = shift;
    my $items  = (@_ == 1 && ref $_[0] eq ARRAY) ? shift : [@_];
    my @reject = grep { $self->item_rejected($_) } @$items;
    return wantarray
        ?  @reject
        : \@reject;
}


#-----------------------------------------------------------------------------
# Item filtering methods
#-----------------------------------------------------------------------------

sub item_accepted {
    my ($self, $item) = @_;
    return  $self->item_included($item)
        && !$self->item_excluded($item);
}

sub item_rejected {
    ! shift->item_accepted(@_);
}

sub item_included {
    my $self    = shift;
    my $include = $self->{ include } || return TRUE;
    return $self->check_item($include, @_);
}

sub item_excluded {
    my $self    = shift;
    my $exclude = $self->{ exclude } || return FALSE;
    return $self->check_item($exclude, @_);
}

sub check_item {
    my ($self, $checks, $item) = @_;

    $self->debug(
        "check [$item] via ",
        $self->dump_data($checks)
    ) if DEBUG;

    return TRUE
        if $checks->{ static }->{ $item }
        || $checks->{ static }->{"*"};

    foreach my $check (@{ $checks->{ dynamic } }) {
        $self->debug("check: $check") if DEBUG;
        return TRUE
            if $check->($item);
    }

    return FALSE;
}


1;

__END__