X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FRegexp-Wildcards.git;a=blobdiff_plain;f=lib%2FRegexp%2FWildcards.pm;h=b65eebe021ea48d90c8ffe45b6bafddc2d50a9a0;hp=15b42c79fccf5f0b8122a5db5938bc2d846e1eb0;hb=510bd793e8fac0683f0ac86adbfd48b5af7b14b9;hpb=0acfe1e394d884c4ff93c844467c446873681c24

diff --git a/lib/Regexp/Wildcards.pm b/lib/Regexp/Wildcards.pm
index 15b42c7..b65eebe 100644
--- a/lib/Regexp/Wildcards.pm
+++ b/lib/Regexp/Wildcards.pm
@@ -13,13 +13,13 @@ Regexp::Wildcards - Converts wildcard expressions to Perl regular expressions.
 
 =head1 VERSION
 
-Version 1.03
+Version 1.04
 
 =cut
 
 use vars qw<$VERSION>;
 BEGIN {
- $VERSION = '1.03';
+ $VERSION = '1.04';
 }
 
 =head1 SYNOPSIS
@@ -96,7 +96,7 @@ my %captures = (
                                             : '(.*?)')
                          : '.*' },
  brackets => sub { $_[1] ? '(' : '(?:'; },
- greedy   => undef
+ greedy   => undef,
 );
 
 sub _validate {
@@ -119,6 +119,7 @@ sub _validate {
  for (qw<set add rem>) {
   my $opt = $opts{$_};
   next unless defined $opt;
+
   my $cb = {
    ''      => sub { +{ ($_[0] => 1) x (exists $valid->{$_[0]}) } },
    'ARRAY' => sub { +{ map { ($_ => 1) x (exists $valid->{$_}) } @{$_[0]} } },
@@ -140,24 +141,29 @@ sub _validate {
 
 sub _do {
  my $self = shift;
+
  my $config;
- $config->{do} = $self->_validate(\%escapes, $self->{do}, @_);
- $config->{escape} = '';
+ $config->{do}      = $self->_validate(\%escapes, $self->{do}, @_);
+ $config->{escape}  = '';
  $config->{escape} .= $escapes{$_} for keys %{$config->{do}};
- $config->{escape} = quotemeta $config->{escape};
+ $config->{escape}  = quotemeta $config->{escape};
+
  $config;
 }
 
 sub do {
  my $self = shift;
  _check_self $self;
- my $config = $self->_do(@_);
+
+ my $config  = $self->_do(@_);
  $self->{$_} = $config->{$_} for keys %$config;
+
  $self;
 }
 
 sub _capture {
  my $self = shift;
+
  my $config;
  $config->{capture} = $self->_validate(\%captures, $self->{capture}, @_);
  $config->{greedy}  = delete $config->{capture}->{greedy};
@@ -165,50 +171,63 @@ sub _capture {
   $config->{'c_' . $_} = $captures{$_}->($config, $config->{capture}->{$_})
                                                if $captures{$_}; # Skip 'greedy'
  }
+
  $config;
 }
 
 sub capture {
  my $self = shift;
  _check_self $self;
- my $config = $self->_capture(@_);
+
+ my $config  = $self->_capture(@_);
  $self->{$_} = $config->{$_} for keys %$config;
+
  $self;
 }
 
 sub _type {
  my ($self, $type) = @_;
- $type = 'unix'      unless defined $type;
- croak 'Wrong type'  unless exists $types{$type};
- my $config = $self->_do($types{$type});
+ $type = 'unix'     unless defined $type;
+ croak 'Wrong type' unless exists $types{$type};
+
+ my $config      = $self->_do($types{$type});
  $config->{type} = $type;
+
  $config;
 }
 
 sub type {
  my $self = shift;
  _check_self $self;
- my $config = $self->_type(@_);
+
+ my $config  = $self->_type(@_);
  $self->{$_} = $config->{$_} for keys %$config;
+
  $self;
 }
 
 sub new {
  my $class = shift;
- $class = ref($class) || $class || __PACKAGE__;
+ $class    = blessed($class) || $class || __PACKAGE__;
+
  croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
  my %args = @_;
- my $self = { };
- bless $self, $class;
+
+ my $self = bless { }, $class;
+
  if (defined $args{do}) {
   $self->do($args{do});
  } else {
   $self->type($args{type});
  }
+
  $self->capture($args{capture});
 }
 
-=head2 C<< new [ do => $what E<verbar> type => $type ], capture => $captures >>
+=head2 C<new>
+
+    my $rw = Regexp::Wildcards->new(do => $what, capture => $capture);
+    my $rw = Regexp::Wildcards->new(type => $type, capture => $capture);
 
 Constructs a new L<Regexp::Wildcard> object.
 
@@ -222,7 +241,12 @@ The C<do> option overrides C<type>.
 C<capture> lists which atoms should be capturing.
 Refer to L</capture> for more details.
 
-=head2 C<< do [ $what E<verbar> set => $c1, add => $c2, rem => $c3 ] >>
+=head2 C<do>
+
+    $rw->do($what);
+    $rw->do(set => $c1);
+    $rw->do(add => $c2);
+    $rw->do(rem => $c3);
 
 Specifies the list of metacharacters to convert or to prevent for escaping.
 They fit into six classes :
@@ -317,7 +341,9 @@ No argument means C<< set => [ ] >>.
 
 The C<do> method returns the L<Regexp::Wildcards> object.
 
-=head2 C<type $type>
+=head2 C<type>
+
+    $rw->type($type);
 
 Notifies to convert the metacharacters that corresponds to the predefined type C<$type>.
 C<$type> can be any of :
@@ -370,7 +396,12 @@ In particular, you can usually pass C<$^O> as the C<$type> and get the correspon
 
 The C<type> method returns the L<Regexp::Wildcards> object.
 
-=head2 C<< capture [ $captures E<verbar> set => $c1, add => $c2, rem => $c3 ] >>
+=head2 C<capture>
+
+    $rw->capture($captures);
+    $rw->capture(set => $c1);
+    $rw->capture(add => $c2);
+    $rw->capture(rem => $c3);
 
 Specifies the list of atoms to capture.
 This method works like L</do>, except that the classes are different :
@@ -422,7 +453,10 @@ Capture matching C<{ ... , ... }> alternations.
 
 The C<capture> method returns the L<Regexp::Wildcards> object.
 
-=head2 C<convert $wc [ , $type ]>
+=head2 C<convert>
+
+    my $rx = $rw->convert($wc);
+    my $rx = $rw->convert($wc, $type);
 
 Converts the wildcard expression C<$wc> into a regular expression according to the options stored into the L<Regexp::Wildcards> object, or to C<$type> if it's supplied.
 It successively escapes all unprotected regexp special characters that doesn't hold any meaning for wildcards, then replace C<'jokers'>, C<'sql'> and C<'commas'> or C<'brackets'> (depending on the L</do> or L</type> options), all of this by applying the C<'capture'> rules specified in the constructor or by L</capture>.
@@ -432,6 +466,7 @@ It successively escapes all unprotected regexp special characters that doesn't h
 sub convert {
  my ($self, $wc, $type) = @_;
  _check_self $self;
+
  my $config = (defined $type) ? $self->_type($type) : $self;
  return unless defined $wc;
 
@@ -460,7 +495,7 @@ sub convert {
   $wc = $self->{'c_brackets'} . $self->_commas($wc) . ')';
  }
 
- return $wc;
+ $wc
 }
 
 =head1 EXPORT
@@ -512,55 +547,67 @@ sub _extract ($) { extract_bracketed $_[0], '{',  qr/.*?(?<!\\)(?:\\\\)*(?={)/ }
 sub _jokers {
  my $self = shift;
  local $_ = $_[0];
+
  # substitute ? preceded by an even number of \
  my $s = $self->{c_single};
  s/(?<!\\)((?:\\\\)*)\?/$1$s/g;
  # substitute * preceded by an even number of \
  $s = $self->{c_any};
  s/(?<!\\)((?:\\\\)*)\*+/$1$s/g;
- return $_;
+
+ $_
 }
 
 sub _sql {
  my $self = shift;
  local $_ = $_[0];
+
  # substitute _ preceded by an even number of \
  my $s = $self->{c_single};
  s/(?<!\\)((?:\\\\)*)_/$1$s/g;
  # substitute % preceded by an even number of \
  $s = $self->{c_any};
  s/(?<!\\)((?:\\\\)*)%+/$1$s/g;
- return $_;
+
+ $_
 }
 
 sub _commas {
  local $_ = $_[1];
+
  # substitute , preceded by an even number of \
  s/(?<!\\)((?:\\\\)*),/$1|/g;
- return $_;
+
+ $_
 }
 
 sub _brackets {
  my ($self, $rest) = @_;
+
  substr $rest, 0, 1, '';
  chop $rest;
+
  my ($re, $bracket, $prefix) = ('');
  while (do { ($bracket, $rest, $prefix) = _extract $rest; $bracket }) {
   $re .= $self->_commas($prefix) . $self->_brackets($bracket);
  }
  $re .= $self->_commas($rest);
- return $self->{c_brackets} . $re . ')';
+
+ $self->{c_brackets} . $re . ')';
 }
 
 sub _bracketed {
  my ($self, $rest) = @_;
+
  my ($re, $bracket, $prefix) = ('');
  while (do { ($bracket, $rest, $prefix) = _extract $rest; $bracket }) {
   $re .= $prefix . $self->_brackets($bracket);
  }
  $re .= $rest;
+
  $re =~ s/(?<!\\)((?:\\\\)*[\{\},])/\\$1/g;
- return $re;
+
+ $re;
 }
 
 1; # End of Regexp::Wildcards