]> git.vpit.fr Git - perl/modules/Regexp-Wildcards.git/blobdiff - lib/Regexp/Wildcards.pm
This is 1.03
[perl/modules/Regexp-Wildcards.git] / lib / Regexp / Wildcards.pm
index f0b471a8be5cea353f87254b5e3c164849e703db..d0f9ab3f134560b14360adb95d99b5a9e3e8577a 100644 (file)
@@ -12,13 +12,13 @@ Regexp::Wildcards - Converts wildcard expressions to Perl regular expressions.
 
 =head1 VERSION
 
-Version 1.02
+Version 1.03
 
 =cut
 
 use vars qw/$VERSION/;
 BEGIN {
- $VERSION = '1.02';
+ $VERSION = '1.03';
 }
 
 =head1 SYNOPSIS
@@ -230,27 +230,35 @@ They fit into six classes :
 
 =item *
 
-C<'jokers'> converts C<?> to C<.> and C<*> to C<.*> ;
+C<'jokers'>
+
+Converts C<?> to C<.> and C<*> to C<.*>.
 
     'a**\\*b??\\?c' ==> 'a.*\\*b..\\?c'
 
 =item *
 
-C<'sql'> converts C<_> to C<.> and C<%> to C<.*> ;
+C<'sql'>
+
+Converts C<_> to C<.> and C<%> to C<.*>.
 
     'a%%\\%b__\\_c' ==> 'a.*\\%b..\\_c'
 
 =item *
 
-C<'commas'> converts all C<,> to C<|> and puts the complete resulting regular expression inside C<(?: ... )> ;
+C<'commas'>
+
+Converts all C<,> to C<|> and puts the complete resulting regular expression inside C<(?: ... )>.
 
     'a,b{c,d},e' ==> '(?:a|b\\{c|d\\}|e)'
 
 =item *
 
-C<'brackets'> converts all matching C<{ ... ,  ... }> brackets to C<(?: ... | ... )> alternations.
+C<'brackets'>
+
+Converts all matching C<{ ... ,  ... }> brackets to C<(?: ... | ... )> alternations.
 If some brackets are unbalanced, it tries to substitute as many of them as possible, and then escape the remaining unmatched C<{> and C<}>.
-Commas outside of any bracket-delimited block are also escaped ;
+Commas outside of any bracket-delimited block are also escaped.
 
     'a,b{c,d},e'    ==> 'a\\,b(?:c|d)\\,e'
     '{a\\{b,c}d,e}' ==> '(?:a\\{b|c)d\\,e\\}'
@@ -258,14 +266,18 @@ Commas outside of any bracket-delimited block are also escaped ;
 
 =item *
 
-C<'groups'> keeps the parenthesis C<( ... )> of the original string without escaping them.
+C<'groups'>
+
+Keeps the parenthesis C<( ... )> of the original string without escaping them.
 Currently, no check is done to ensure that the parenthesis are matching.
 
     'a(b(c))d\\(\\)' ==> (no change)
 
 =item *
 
-C<'anchors'> prevents the I<beginning-of-line> C<^> and I<end-of-line> C<$> anchors to be escaped.
+C<'anchors'>
+
+Prevents the I<beginning-of-line> C<^> and I<end-of-line> C<$> anchors to be escaped.
 Since C<[...]> character class are currently escaped, a C<^> will always be interpreted as I<beginning-of-line>.
 
     'a^b$c' ==> (no change)
@@ -366,28 +378,36 @@ This method works like L</do>, except that the classes are different :
 
 =item *
 
-C<'single'> will capture all unescaped I<"exactly one"> metacharacters, i.e. C<?> for wildcards or C<_> for SQL ;
+C<'single'>
+
+Captures all unescaped I<"exactly one"> metacharacters, i.e. C<?> for wildcards or C<_> for SQL.
 
     'a???b\\??' ==> 'a(.)(.)(.)b\\?(.)'
     'a___b\\__' ==> 'a(.)(.)(.)b\\_(.)'
 
 =item *
 
-C<'any'> will capture all unescaped I<"any"> metacharacters, i.e. C<*> for wildcards or C<%> for SQL ;
+C<'any'>
+
+Captures all unescaped I<"any"> metacharacters, i.e. C<*> for wildcards or C<%> for SQL.
 
     'a***b\\**' ==> 'a(.*)b\\*(.*)'
     'a%%%b\\%%' ==> 'a(.*)b\\%(.*)'
 
 =item *
 
-C<'greedy'>, when used in conjunction with C<'any'>, will make the C<'any'> captures greedy (by default they are not) ;
+C<'greedy'>
+
+When used in conjunction with C<'any'>, it makes the C<'any'> captures greedy (by default they are not).
 
     'a***b\\**' ==> 'a(.*?)b\\*(.*?)'
     'a%%%b\\%%' ==> 'a(.*?)b\\%(.*?)'
 
 =item *
 
-C<'brackets'> will capture matching C<{ ... , ... }> alternations.
+C<'brackets'>
+
+Capture matching C<{ ... , ... }> alternations.
 
     'a{b\\},\\{c}' ==> 'a(b\\}|\\{c)'
 
@@ -399,10 +419,12 @@ C<'brackets'> will capture matching C<{ ... , ... }> alternations.
     $rw->capture(rem => 'greedy');           # No more greed please.
     $rw->capture();                          # Capture nothing.
 
+The C<capture> method returns the L<Regexp::Wildcards> object.
+
 =head2 C<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'> or 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>.
+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>.
 
 =cut
 
@@ -411,21 +433,32 @@ sub convert {
  _check_self $self;
  my $config = (defined $type) ? $self->_type($type) : $self;
  return unless defined $wc;
+
+ my $e = $config->{escape};
+ # Escape :
+ # - an even number of \ that doesn't protect a regexp/wildcard metachar
+ # - an odd number of \ that doesn't protect a wildcard metachar
+ $wc =~ s/
+  (?<!\\)(
+   (?:\\\\)*
+   (?:
+     [^\w\s\\$e]
+    |
+     \\
+     (?: [^\W$e] | \s | $ )
+   )
+  )
+ /\\$1/gx;
+
  my $do = $config->{do};
- my $e  = $config->{escape};
- $wc =~ s/(?<!\\)((?:\\\\)*[^\w\s\\$e])/\\$1/g;
- if ($do->{jokers}) {
-  $wc = $self->_jokers($wc);
- } elsif ($do->{sql}) {
-  $wc = $self->_sql($wc);
- }
+ $wc = $self->_jokers($wc) if $do->{jokers};
+ $wc = $self->_sql($wc)    if $do->{sql};
  if ($do->{brackets}) {
   $wc = $self->_bracketed($wc);
- } elsif ($do->{commas}) {
-  if ($wc =~ /(?<!\\)(?:\\\\)*,/) { # win32 allows comma-separated lists
-   $wc = $self->{'c_brackets'} . $self->_commas($wc) . ')';
-  }
+ } elsif ($do->{commas} and $wc =~ /(?<!\\)(?:\\\\)*,/) {
+  $wc = $self->{'c_brackets'} . $self->_commas($wc) . ')';
  }
+
  return $wc;
 }
 
@@ -466,7 +499,7 @@ Tests code coverage report is available at L<http://www.profvince.com/perl/cover
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright 2007-2008 Vincent Pit, all rights reserved.
+Copyright 2007-2009 Vincent Pit, all rights reserved.
 
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.
@@ -478,8 +511,6 @@ sub _extract ($) { extract_bracketed $_[0], '{',  qr/.*?(?<!\\)(?:\\\\)*(?={)/ }
 sub _jokers {
  my $self = shift;
  local $_ = $_[0];
- # escape an odd number of \ that doesn't protect a regexp/wildcard special char
- s/(?<!\\)((?:\\\\)*\\(?:[\w\s]|$))/\\$1/g;
  # substitute ? preceded by an even number of \
  my $s = $self->{c_single};
  s/(?<!\\)((?:\\\\)*)\?/$1$s/g;
@@ -492,8 +523,6 @@ sub _jokers {
 sub _sql {
  my $self = shift;
  local $_ = $_[0];
- # escape an odd number of \ that doesn't protect a regexp/wildcard special char
- s/(?<!\\)((?:\\\\)*\\(?:[^\W_]|\s|$))/\\$1/g;
  # substitute _ preceded by an even number of \
  my $s = $self->{c_single};
  s/(?<!\\)((?:\\\\)*)_/$1$s/g;