[libcode-tidyall-perl] 76/374: add

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libcode-tidyall-perl.

commit f4341b1e4d63fc9872a7941f0ef3ec1f3b24a16b
Author: Jonathan Swartz <swartz at pobox.com>
Date:   Thu Jul 5 17:38:36 2012 -0700

    add
---
 lib/Code/TidyAll/Util/Zglob.pm |  110 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 110 insertions(+)

diff --git a/lib/Code/TidyAll/Util/Zglob.pm b/lib/Code/TidyAll/Util/Zglob.pm
new file mode 100644
index 0000000..5c7531d
--- /dev/null
+++ b/lib/Code/TidyAll/Util/Zglob.pm
@@ -0,0 +1,110 @@
+# This is a copy of Text::Glob, modified to support "**/"
+#
+package Code::TidyAll::Util::Zglob;
+use strict;
+use Exporter;
+use vars qw/$VERSION @ISA @EXPORT_OK
+  $strict_leading_dot $strict_wildcard_slash/;
+$VERSION   = '0.08';
+ at ISA       = 'Exporter';
+ at EXPORT_OK = qw( zglob_to_regex );
+
+$strict_leading_dot    = 1;
+$strict_wildcard_slash = 1;
+
+use constant debug => 0;
+
+sub zglob_to_regex {
+    my $glob  = shift;
+    my $regex = glob_to_regex_string($glob);
+    return qr/^$regex$/;
+}
+
+sub glob_to_regex_string {
+    my $glob = shift;
+    my ( $regex, $in_curlies, $escaping );
+    local $_;
+    my $first_byte = 1;
+    $glob =~ s/\*\*\//\cZ/g;    # convert **/ to single character
+    for ( $glob =~ m/(.)/gs ) {
+        if ($first_byte) {
+            if ($strict_leading_dot) {
+                $regex .= '(?=[^\.])' unless $_ eq '.';
+            }
+            $first_byte = 0;
+        }
+        if ( $_ eq '/' ) {
+            $first_byte = 1;
+        }
+        if (   $_ eq '.'
+            || $_ eq '('
+            || $_ eq ')'
+            || $_ eq '|'
+            || $_ eq '+'
+            || $_ eq '^'
+            || $_ eq '$'
+            || $_ eq '@'
+            || $_ eq '%' )
+        {
+            $regex .= "\\$_";
+        }
+        elsif ( $_ eq "\cZ" ) {    # handle **/ - if escaping, only escape first *
+            $regex .=
+              $escaping
+              ? ( "\\*" . ( $strict_wildcard_slash ? "[^/]*" : ".*" ) . "/" )
+              : ".*";
+        }
+        elsif ( $_ eq '*' ) {
+            $regex .=
+                $escaping              ? "\\*"
+              : $strict_wildcard_slash ? "[^/]*"
+              :                          ".*";
+        }
+        elsif ( $_ eq '?' ) {
+            $regex .=
+                $escaping              ? "\\?"
+              : $strict_wildcard_slash ? "[^/]"
+              :                          ".";
+        }
+        elsif ( $_ eq '{' ) {
+            $regex .= $escaping ? "\\{" : "(";
+            ++$in_curlies unless $escaping;
+        }
+        elsif ( $_ eq '}' && $in_curlies ) {
+            $regex .= $escaping ? "}" : ")";
+            --$in_curlies unless $escaping;
+        }
+        elsif ( $_ eq ',' && $in_curlies ) {
+            $regex .= $escaping ? "," : "|";
+        }
+        elsif ( $_ eq "\\" ) {
+            if ($escaping) {
+                $regex .= "\\\\";
+                $escaping = 0;
+            }
+            else {
+                $escaping = 1;
+            }
+            next;
+        }
+        else {
+            $regex .= $_;
+            $escaping = 0;
+        }
+        $escaping = 0;
+    }
+    print "# $glob $regex\n" if debug;
+
+    return $regex;
+}
+
+sub match_glob {
+    print "# ", join( ', ', map { "'$_'" } @_ ), "\n" if debug;
+    my $glob  = shift;
+    my $regex = glob_to_regex $glob;
+    local $_;
+    grep { $_ =~ $regex } @_;
+}
+
+1;
+__END__

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcode-tidyall-perl.git