view release on metacpan or  search on metacpan

lib/Algorithm/IncludeExclude.pm  view on Meta::CPAN

Regexes are matched against any remaining path elements when they are
first encountered.  In the following example:

   $ie->include('foo', qr/bar/);
   $ie->evaluate('foo', 'baz', 'quux', 'bar'); # include

The match works like this.  First, 'foo' (from the include rule) and
'foo' (from the path being evaluated) are compared.  Since there's a
match, the next element in the path is examined against C<foo>'s
subtree.  The only remaining item in the rule tree is a regex, so the
regex is compared to the rest of the path being evaluated, joined by
the C<join> argument to new (see L</METHODS/new>); namely:

   baz/quux/bar

Since the regular expression matches this string, the include rule is
matched.

=item *

Regex rules are checked before non-regex rules.  For example:

  $ie->exclude('foo', 'bar');
  $ie->include(qr/bar/);

  $ie->evaluate('foo', 'bar'); # include, due to regex

=item *

If two or more regular expressions at the same level match a path, the
result is undefined:

  $ie->include(qr/foo/);
  $ie->exclude(qr/bar/);
 
  $ie->evaluate('foobar'); # undef is returned

=back

=cut

=head1 METHODS

=head2 new

Create a new instance.  Accepts an optional hashref of arguments.  The
arguments may be:

=over 4

=item join 

String to join remaining path elements with when matching against a
regex.  Defaults to C</>, which is good for matching against URLs or
filesystem paths.

=back

=cut

# self is a tree, that looks like:
# {path1 => [ value1, {path2 => [ value2, ... ]}]}
# path1 has value value1
# path1->path2 has value value2
# path3 is undefined
# etc

sub new {
    my $class = shift;
    my $args = shift || {};
    $args->{join} ||= ''; # avoid warnings
    $args->{regexes} = {};
    my $self = [undef, {}, $args];
    return bless $self => $class;
}

# walks down the tree and sets the value of path to value
sub _set {
    my $tree  = shift;
    my $path  = shift;
    my $value = shift;
    
    my $regexes = $tree->[2]->{regexes};

    my $ref = 0;
    foreach my $head (@$path){
	# ignore everything after a qr// rule
	croak "Ignoring values after a qr// rule" if $ref;
	if(ref $head){
	    $ref = 1;
	    $regexes->{"X$head"} = $head;
	    $head = "X$head";
	}
	else {
	    $head = "0$head";
	}
	my $node = $tree->[1]->{$head};
	$node = $tree->[1]->{$head} = [undef, {}]
	  if('ARRAY' ne ref $node);
	
	$tree = $node;
    }
    $tree->[0] = $value;
}

=head2 include(@path)

Add an include path to the rule tree.  C<@path> may end with a regex.

=cut

sub include {
    my $self = shift;
    my @path = @_;
    $self->_set(\@path, 1);
}

=head2 exclude(@path)

Add an exclude path to the rule tree.  C<@path> may end with a regex.