r33382 - in /branches/upstream/libtext-glob-perl: ./ current/ current/Build.PL current/Changes current/MANIFEST current/META.yml current/Makefile.PL current/README current/lib/ current/lib/Text/ current/lib/Text/Glob.pm current/t/ current/t/Text-Glob.t
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Thu Apr 16 03:27:26 UTC 2009
Author: ryan52-guest
Date: Thu Apr 16 03:27:20 2009
New Revision: 33382
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=33382
Log:
[svn-inject] Installing original source of libtext-glob-perl
Added:
branches/upstream/libtext-glob-perl/
branches/upstream/libtext-glob-perl/current/
branches/upstream/libtext-glob-perl/current/Build.PL
branches/upstream/libtext-glob-perl/current/Changes
branches/upstream/libtext-glob-perl/current/MANIFEST
branches/upstream/libtext-glob-perl/current/META.yml
branches/upstream/libtext-glob-perl/current/Makefile.PL
branches/upstream/libtext-glob-perl/current/README
branches/upstream/libtext-glob-perl/current/lib/
branches/upstream/libtext-glob-perl/current/lib/Text/
branches/upstream/libtext-glob-perl/current/lib/Text/Glob.pm
branches/upstream/libtext-glob-perl/current/t/
branches/upstream/libtext-glob-perl/current/t/Text-Glob.t
Added: branches/upstream/libtext-glob-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-glob-perl/current/Build.PL?rev=33382&op=file
==============================================================================
--- branches/upstream/libtext-glob-perl/current/Build.PL (added)
+++ branches/upstream/libtext-glob-perl/current/Build.PL Thu Apr 16 03:27:20 2009
@@ -1,0 +1,12 @@
+use strict;
+use Module::Build;
+
+Module::Build
+ ->new( module_name => "Text::Glob",
+ license => 'perl',
+ build_requires => {
+ 'Test::More' => 0,
+ },
+ create_makefile_pl => 'traditional',
+ )
+ ->create_build_script;
Added: branches/upstream/libtext-glob-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-glob-perl/current/Changes?rev=33382&op=file
==============================================================================
--- branches/upstream/libtext-glob-perl/current/Changes (added)
+++ branches/upstream/libtext-glob-perl/current/Changes Thu Apr 16 03:27:20 2009
@@ -1,0 +1,34 @@
+0.08 Wednesday 2nd May, 2007
+ Expose glob_to_regex_string (Joshua Hoblitt)
+
+0.07 Friday 14th July, 2006
+ Explictly quote @ and %. Though they don't really need it to work
+ normally, it's needed for when you roundtrip the
+ regex back into text (like File::Find::Rule does).
+
+0.06 Monday 1st September, 2003
+ - port to Module::Build
+ - Nested alternations fix from Mike Benson
+
+0.05 15th August, 2002
+ - !match_glob("*.foo", "foo/.foo");
+ - test suite overhaul
+ - backslash expansion fixed
+ - /[+^$|]/ made less 'special'
+ - handle embedded newlines in glob patterns
+ - add tests for 'foo[abc]'
+ - Many thanks go to Nick Cleaton for finding these
+
+0.04 14th August, 2002
+ - $Text::Glob::{strict_leading_dot,strict_wildcard_slash} from
+ bug report from Nick Cleaton
+ - (quite poor) documentation of supported globbing constructs
+
+0.03 2nd August, 2002
+ - complete work of 0.02 by escaping ) too. bug found by Andy Lester
+
+0.02 29th July, 2002
+ - fix handling of ( and ? tokens
+
+0.01 21st July 2002
+ - initital release
Added: branches/upstream/libtext-glob-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-glob-perl/current/MANIFEST?rev=33382&op=file
==============================================================================
--- branches/upstream/libtext-glob-perl/current/MANIFEST (added)
+++ branches/upstream/libtext-glob-perl/current/MANIFEST Thu Apr 16 03:27:20 2009
@@ -1,0 +1,8 @@
+Changes
+README
+MANIFEST
+lib/Text/Glob.pm
+Makefile.PL
+Build.PL
+META.yml
+t/Text-Glob.t
Added: branches/upstream/libtext-glob-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-glob-perl/current/META.yml?rev=33382&op=file
==============================================================================
--- branches/upstream/libtext-glob-perl/current/META.yml (added)
+++ branches/upstream/libtext-glob-perl/current/META.yml Thu Apr 16 03:27:20 2009
@@ -1,0 +1,14 @@
+---
+name: Text-Glob
+version: 0.08
+author:
+ - Richard Clamp <richardc at unixbeard.net>
+abstract: match globbing patterns against text
+license: perl
+build_requires:
+ Test::More: 0
+provides:
+ Text::Glob:
+ file: lib/Text/Glob.pm
+ version: 0.08
+generated_by: Module::Build version 0.25
Added: branches/upstream/libtext-glob-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-glob-perl/current/Makefile.PL?rev=33382&op=file
==============================================================================
--- branches/upstream/libtext-glob-perl/current/Makefile.PL (added)
+++ branches/upstream/libtext-glob-perl/current/Makefile.PL Thu Apr 16 03:27:20 2009
@@ -1,0 +1,13 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'NAME' => 'Text::Glob',
+ 'VERSION_FROM' => 'lib/Text/Glob.pm',
+ 'PREREQ_PM' => {
+ 'Test::More' => '0'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'PL_FILES' => {}
+ )
+;
Added: branches/upstream/libtext-glob-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-glob-perl/current/README?rev=33382&op=file
==============================================================================
--- branches/upstream/libtext-glob-perl/current/README (added)
+++ branches/upstream/libtext-glob-perl/current/README Thu Apr 16 03:27:20 2009
@@ -1,0 +1,69 @@
+README for Text::Glob 0.08
+
+=head1 NAME
+
+Text::Glob - match globbing patterns against text
+
+=head1 SYNOPSIS
+
+ use Text::Glob qw( match_glob glob_to_regex );
+
+ print "matched\n" if match_glob( "foo.*", "foo.bar" );
+
+ # prints foo.bar and foo.baz
+ my $regex = glob_to_regex( "foo.*" );
+ for ( qw( foo.bar foo.baz foo bar ) ) {
+ print "matched: $_\n" if /$regex/;
+ }
+
+
+
+=head1 INSTALLATION
+
+ perl Build.PL
+ perl Build test
+
+and if all goes well
+
+ perl Build install
+
+=head1 HISTORY
+
+What changed over the last 3 revisions
+
+=over
+
+=item 0.08 Wednesday 2nd May, 2007
+
+ Expose glob_to_regex_string (Joshua Hoblitt)
+
+
+=item 0.07 Friday 14th July, 2006
+
+ Explictly quote @ and %. Though they don't really need it to work
+ normally, it's needed for when you roundtrip the
+ regex back into text (like File::Find::Rule does).
+
+
+=item 0.06 Monday 1st September, 2003
+
+ - port to Module::Build
+ - Nested alternations fix from Mike Benson
+
+=back
+
+=head1 AUTHOR
+
+Richard Clamp <richardc at unixbeard.net>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002, 2003, 2006, 2007 Richard Clamp. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<File::Glob>, glob(3)
+
Added: branches/upstream/libtext-glob-perl/current/lib/Text/Glob.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-glob-perl/current/lib/Text/Glob.pm?rev=33382&op=file
==============================================================================
--- branches/upstream/libtext-glob-perl/current/lib/Text/Glob.pm (added)
+++ branches/upstream/libtext-glob-perl/current/lib/Text/Glob.pm Thu Apr 16 03:27:20 2009
@@ -1,0 +1,195 @@
+package Text::Glob;
+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( glob_to_regex glob_to_regex_string match_glob );
+
+$strict_leading_dot = 1;
+$strict_wildcard_slash = 1;
+
+use constant debug => 0;
+
+sub glob_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;
+ 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 '*') {
+ $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__
+
+=head1 NAME
+
+Text::Glob - match globbing patterns against text
+
+=head1 SYNOPSIS
+
+ use Text::Glob qw( match_glob glob_to_regex );
+
+ print "matched\n" if match_glob( "foo.*", "foo.bar" );
+
+ # prints foo.bar and foo.baz
+ my $regex = glob_to_regex( "foo.*" );
+ for ( qw( foo.bar foo.baz foo bar ) ) {
+ print "matched: $_\n" if /$regex/;
+ }
+
+=head1 DESCRIPTION
+
+Text::Glob implements glob(3) style matching that can be used to match
+against text, rather than fetching names from a filesystem. If you
+want to do full file globbing use the File::Glob module instead.
+
+=head2 Routines
+
+=over
+
+=item match_glob( $glob, @things_to_test )
+
+Returns the list of things which match the glob from the source list.
+
+=item glob_to_regex( $glob )
+
+Returns a compiled regex which is the equiavlent of the globbing
+pattern.
+
+=item glob_to_regex_string( $glob )
+
+Returns a regex string which is the equiavlent of the globbing
+pattern.
+
+=back
+
+=head1 SYNTAX
+
+The following metacharacters and rules are respected.
+
+=over
+
+=item C<*> - match zero or more characters
+
+C<a*> matches C<a>, C<aa>, C<aaaa> and many many more.
+
+=item C<?> - match exactly one character
+
+C<a?> matches C<aa>, but not C<a>, or C<aa>
+
+=item Character sets/ranges
+
+C<example.[ch]> matches C<example.c> and C<example.h>
+
+C<demo.[a-c]> matches C<demo.a>, C<demo.b>, and C<demo.c>
+
+=item alternation
+
+C<example.{foo,bar,baz}> matches C<example.foo>, C<example.bar>, and
+C<example.baz>
+
+=item leading . must be explictly matched
+
+C<*.foo> does not match C<.bar.foo>. For this you must either specify
+the leading . in the glob pattern (C<.*.foo>), or set
+C<$Text::Glob::strict_leading_dot> to a false value while compiling
+the regex.
+
+=item C<*> and C<?> do not match /
+
+C<*.foo> does not match C<bar/baz.foo>. For this you must either
+explicitly match the / in the glob (C<*/*.foo>), or set
+C<$Text::Glob::strict_wildcard_slash> to a false value with compiling
+the regex.
+
+=back
+
+=head1 BUGS
+
+The code uses qr// to produce compiled regexes, therefore this module
+requires perl version 5.005_03 or newer.
+
+=head1 AUTHOR
+
+Richard Clamp <richardc at unixbeard.net>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002, 2003, 2006, 2007 Richard Clamp. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<File::Glob>, glob(3)
+
+=cut
Added: branches/upstream/libtext-glob-perl/current/t/Text-Glob.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtext-glob-perl/current/t/Text-Glob.t?rev=33382&op=file
==============================================================================
--- branches/upstream/libtext-glob-perl/current/t/Text-Glob.t (added)
+++ branches/upstream/libtext-glob-perl/current/t/Text-Glob.t Thu Apr 16 03:27:20 2009
@@ -1,0 +1,78 @@
+#!perl -w
+use strict;
+use Test::More tests => 44;
+
+BEGIN { use_ok('Text::Glob', qw( glob_to_regex match_glob ) ) }
+
+my $regex = glob_to_regex( 'foo' );
+is( ref $regex, 'Regexp', "glob_to_regex hands back a regex" );
+ok( 'foo' =~ $regex, "matched foo" );
+ok( 'foobar' !~ $regex, "didn't match foobar" );
+
+ok( match_glob( 'foo', 'foo' ), "absolute string" );
+ok( !match_glob( 'foo', 'foobar' ) );
+
+ok( match_glob( 'foo.*', 'foo.' ), "* wildcard" );
+ok( match_glob( 'foo.*', 'foo.bar' ) );
+ok( !match_glob( 'foo.*', 'gfoo.bar' ) );
+
+ok( match_glob( 'foo.?p', 'foo.cp' ), "? wildcard" );
+ok( !match_glob( 'foo.?p', 'foo.cd' ) );
+
+ok( match_glob( 'foo.{c,h}', 'foo.h' ), ".{alternation,or,something}" );
+ok( match_glob( 'foo.{c,h}', 'foo.c' ) );
+ok( !match_glob( 'foo.{c,h}', 'foo.o' ) );
+
+ok( match_glob( 'foo.\\{c,h}\\*', 'foo.{c,h}*' ), '\escaping' );
+ok( !match_glob( 'foo.\\{c,h}\\*', 'foo.\\c' ) );
+
+ok( match_glob( 'foo.(bar)', 'foo.(bar)'), "escape ()" );
+
+ok( !match_glob( '*.foo', '.file.foo' ), "strict . rule fail" );
+ok( match_glob( '.*.foo', '.file.foo' ), "strict . rule match" );
+{
+local $Text::Glob::strict_leading_dot;
+ok( match_glob( '*.foo', '.file.foo' ), "relaxed . rule" );
+}
+
+ok( !match_glob( '*.fo?', 'foo/file.fob' ), "strict wildcard / fail" );
+ok( match_glob( '*/*.fo?', 'foo/file.fob' ), "strict wildcard / match" );
+{
+local $Text::Glob::strict_wildcard_slash;
+ok( match_glob( '*.fo?', 'foo/file.fob' ), "relaxed wildcard /" );
+}
+
+
+ok( !match_glob( 'foo/*.foo', 'foo/.foo' ), "more strict wildcard / fail" );
+ok( match_glob( 'foo/.f*', 'foo/.foo' ), "more strict wildcard / match" );
+{
+local $Text::Glob::strict_wildcard_slash;
+ok( match_glob( '*.foo', 'foo/.foo' ), "relaxed wildcard /" );
+}
+
+ok( match_glob( 'f+.foo', 'f+.foo' ), "properly escape +" );
+ok( !match_glob( 'f+.foo', 'ffff.foo' ) );
+
+ok( match_glob( "foo\nbar", "foo\nbar" ), "handle embedded \\n" );
+ok( !match_glob( "foo\nbar", "foobar" ) );
+
+ok( match_glob( 'test[abc]', 'testa' ), "[abc]" );
+ok( match_glob( 'test[abc]', 'testb' ) );
+ok( match_glob( 'test[abc]', 'testc' ) );
+ok( !match_glob( 'test[abc]', 'testd' ) );
+
+ok( match_glob( 'foo$bar.*', 'foo$bar.c'), "escaping \$" );
+
+ok( match_glob( 'foo^bar.*', 'foo^bar.c'), "escaping ^" );
+
+ok( match_glob( 'foo|bar.*', 'foo|bar.c'), "escaping |" );
+
+
+ok( match_glob( '{foo,{bar,baz}}', 'foo'), "{foo,{bar,baz}}" );
+ok( match_glob( '{foo,{bar,baz}}', 'bar') );
+ok( match_glob( '{foo,{bar,baz}}', 'baz') );
+ok( !match_glob( '{foo,{bar,baz}}', 'foz') );
+
+ok( match_glob( 'foo at bar', 'foo at bar'), '@ character');
+ok( match_glob( 'foo$bar', 'foo$bar'), '$ character');
+ok( match_glob( 'foo%bar', 'foo%bar'), '% character');
More information about the Pkg-perl-cvs-commits
mailing list