X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FRegexp%2FWildcards.pm;h=1b3b4e9271d6aa1b4e0e69e742494ad9a678ca34;hb=b402ceab6bbf7040f8cae87bf08a725b8097750f;hp=ac0cec3d2fec31eaf66b3e66403f93e0c7e22ce3;hpb=d2abbc098aa8c983e2fd330d5282a4363c3f12a9;p=perl%2Fmodules%2FRegexp-Wildcards.git diff --git a/lib/Regexp/Wildcards.pm b/lib/Regexp/Wildcards.pm index ac0cec3..1b3b4e9 100644 --- a/lib/Regexp/Wildcards.pm +++ b/lib/Regexp/Wildcards.pm @@ -104,31 +104,36 @@ sub _validate { my $valid = shift; my $old = shift; $old = { } unless defined $old; - my $c; + + my %opts; if (@_ <= 1) { - $c = { set => $_[0] }; + $opts{set} = defined $_[0] ? $_[0] : { }; } elsif (@_ % 2) { croak 'Arguments must be passed as an unique scalar or as key => value pairs'; } else { - my %args = @_; - $c = { map { (exists $args{$_}) ? ($_ => $args{$_}) : () } qw/set add rem/ }; + %opts = @_; } + + my %checked; for (qw/set add rem/) { - my $v = $c->{$_}; - next unless defined $v; + my $opt = $opts{$_}; + next unless defined $opt; my $cb = { '' => sub { +{ ($_[0] => 1) x (exists $valid->{$_[0]}) } }, 'ARRAY' => sub { +{ map { ($_ => 1) x (exists $valid->{$_}) } @{$_[0]} } }, 'HASH' => sub { +{ map { ($_ => $_[0]->{$_}) x (exists $valid->{$_}) } keys %{$_[0]} } } - }->{ ref $v }; + }->{ ref $opt }; croak 'Wrong option set' unless $cb; - $c->{$_} = $cb->($v); + $checked{$_} = $cb->($opt); } - my $config = (exists $c->{set}) ? $c->{set} : $old; - $config->{$_} = $c->{add}->{$_} for grep $c->{add}->{$_}, - keys %{$c->{add} || {}}; - delete $config->{$_} for grep $c->{rem}->{$_}, keys %{$c->{rem} || {}}; + + my $config = (exists $checked{set}) ? $checked{set} : $old; + $config->{$_} = $checked{add}->{$_} for grep $checked{add}->{$_}, + keys %{$checked{add} || {}}; + delete $config->{$_} for grep $checked{rem}->{$_}, + keys %{$checked{rem} || {}}; + $config; } @@ -394,6 +399,8 @@ C<'brackets'> will capture matching C<{ ... , ... }> alternations. $rw->capture(rem => 'greedy'); # No more greed please. $rw->capture(); # Capture nothing. +The C method returns the L object. + =head2 C Converts the wildcard expression C<$wc> into a regular expression according to the options stored into the L object, or to C<$type> if it's supplied. @@ -404,12 +411,7 @@ It successively escapes all unprotected regexp special characters that doesn't h sub convert { my ($self, $wc, $type) = @_; _check_self $self; - my $config; - if (defined $type) { - $config = $self->_type($type); - } else { - $config = $self; - } + my $config = (defined $type) ? $self->_type($type) : $self; return unless defined $wc; my $do = $config->{do}; my $e = $config->{escape};