Text-Glob-0.11/0000755000175000017500000000000013060033637013361 5ustar richardcrichardcText-Glob-0.11/t/0000755000175000017500000000000013060033637013624 5ustar richardcrichardcText-Glob-0.11/t/Text-Glob.t0000644000175000017500000000522513060033216015613 0ustar richardcrichardc#!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@bar', 'foo@bar'), '@ character'); ok( match_glob( 'foo$bar', 'foo$bar'), '$ character'); ok( match_glob( 'foo%bar', 'foo%bar'), '% character'); Text-Glob-0.11/t/Text-Glob_Sep.t0000644000175000017500000000540613060033216016423 0ustar richardcrichardc#!perl -w use strict; use Test::More tests => 30; BEGIN { use_ok('Text::Glob', qw( glob_to_regex ) ) } { 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" ); } ######################################################################## # Test '*' ######################################################################## # single char seperator { local $Text::Glob::seperator = ":"; my $regex = glob_to_regex( 'foo*:bar' ); is( ref $regex, 'Regexp', "glob_to_regex hands back a regex" ); ok( 'foo:bar' =~ $regex, "matched foo::bar" ); ok( 'foowibble:bar' =~ $regex, "matched foowibble::bar" ); ok( 'foo/wibble:bar' =~ $regex, "matched foo/wibble::bar" ); ok( 'foo::wibble:bar' !~ $regex, "didn't match foo::wibble::bar" ); } # multi char seperator { local $Text::Glob::seperator = "::"; my $regex = glob_to_regex( 'foo*::bar' ); is( ref $regex, 'Regexp', "glob_to_regex hands back a regex" ); ok( 'foo::bar' =~ $regex, "matched foo::bar" ); ok( 'foowibble::bar' =~ $regex, "matched foowibble::bar" ); ok( 'foo/wibble::bar' =~ $regex, "matched foo/wibble::bar" ); ok( 'foo::wibble::bar' !~ $regex, "didn't match foo::wibble::bar" ); } # meta char seperator { local $Text::Glob::seperator = "("; my $regex = glob_to_regex( 'foo*(bar' ); is( ref $regex, 'Regexp', "glob_to_regex hands back a regex" ); ok( 'foo(bar' =~ $regex, "matched foo(bar" ); ok( 'foowibble(bar' =~ $regex, "matched foowibble(bar" ); ok( 'foo/wibble(bar' =~ $regex, "matched foo/wibble(bar" ); ok( 'foo(wibble(bar' !~ $regex, "didn't match foo(wibble(bar" ); } ######################################################################## # Test '?' ######################################################################## # single char seperator { local $Text::Glob::seperator = ":"; my $regex = glob_to_regex( 'fo?:bar' ); is( ref $regex, 'Regexp', "glob_to_regex hands back a regex" ); ok( 'foo:bar' =~ $regex, "matched foo:bar" ); ok( 'fo::bar' !~ $regex, "didn't match fo::bar" ); } # multi char seperator { local $Text::Glob::seperator = "::"; my $regex = glob_to_regex( 'f??::bar' ); is( ref $regex, 'Regexp', "glob_to_regex hands back a regex" ); ok( 'foo::bar' =~ $regex, "matched foo:bar" ); ok( 'f::::bar' !~ $regex, "didn't match f::::bar" ); ok( 'fo:::bar' !~ $regex, "didn't match fo:::bar" ); } # meta char seperator { local $Text::Glob::seperator = "(("; my $regex = glob_to_regex( 'f??((bar' ); is( ref $regex, 'Regexp', "glob_to_regex hands back a regex" ); ok( 'foo((bar' =~ $regex, "matched foo((bar" ); ok( 'f((((bar' !~ $regex, "didn't match f((((bar" ); ok( 'fo(((bar' !~ $regex, "didn't match fo((((bar" ); } Text-Glob-0.11/MANIFEST0000644000175000017500000000041313060033640014502 0ustar richardcrichardcChanges lib/Text/Glob.pm Makefile.PL MANIFEST This list of files t/Text-Glob.t t/Text-Glob_Sep.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Text-Glob-0.11/lib/0000755000175000017500000000000013060033637014127 5ustar richardcrichardcText-Glob-0.11/lib/Text/0000755000175000017500000000000013060033637015053 5ustar richardcrichardcText-Glob-0.11/lib/Text/Glob.pm0000644000175000017500000001153013060033412016263 0ustar richardcrichardcpackage Text::Glob; use strict; use Exporter; use vars qw/$VERSION @ISA @EXPORT_OK $strict_leading_dot $strict_wildcard_slash/; $VERSION = '0.11'; @ISA = 'Exporter'; @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 $seperator = $Text::Glob::seperator; $seperator = "/" unless defined $seperator; $seperator = quotemeta($seperator); 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 ? "(?:(?!$seperator).)*" : ".*"; } elsif ($_ eq '?') { $regex .= $escaping ? "\\?" : $strict_wildcard_slash ? "(?!$seperator)." : "."; } 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 equivalent of the globbing pattern. =item glob_to_regex_string( $glob ) Returns a regex string which is the equivalent of the globbing pattern. =back =head1 SYNTAX The following metacharacters and rules are respected. =over =item C<*> - match zero or more characters C matches C, C, C and many many more. =item C - match exactly one character C matches C, but not C, or C =item Character sets/ranges C matches C and C C matches C, C, and C =item alternation C matches C, C, and C =item leading . must be explicitly 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 the seperator (i.e. do not match C) C<*.foo> does not match C. 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 while compiling the regex, or change the seperator that Text::Glob uses by setting C<$Text::Glob::seperator> to an alternative value while compiling the 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 =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, glob(3) =cut Text-Glob-0.11/Changes0000644000175000017500000000277313060033400014651 0ustar richardcrichardc0.11 Wednesday 8th March, 2016 Regenerated tarball on a linux machine (0.10 was released from OSX which added non-standard extended header attributes to the tar) 0.10 Wednesday 14th September, 2016 Added ability to alter regex seperator (patch from Mark Fowler) Switch distribution packaging back to ExtUtils::MakeMaker (RT#104876) 0.09 Tuesday 22nd February, 2010 Compiled documentation fixes (collected by Tom Hukins from fixes on rt.cpan) 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 Text-Glob-0.11/Makefile.PL0000644000175000017500000000257713060033216015337 0ustar richardcrichardcuse strict; use warnings; use ExtUtils::MakeMaker; ExtUtils::MakeMaker->VERSION(6.98) if -f '.gitignore'; my %WriteMakefileArgs = ( NAME => 'Text::Glob', VERSION_FROM => 'lib/Text/Glob.pm', ABSTRACT_FROM => 'lib/Text/Glob.pm', AUTHOR => 'Richard Clamp ', LICENSE => 'perl_5', MIN_PERL_VERSION => '5.00503', CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => '0', }, PREREQ_PM => { 'Exporter' => '0', 'constant' => '0', }, TEST_REQUIRES => { 'Test::More' => '0', }, META_MERGE => { 'meta-spec' => { version => 2 }, dynamic_config => 0, resources => { bugtracker => { mailto => 'richardc@unixbeard.net', }, }, }, ); # degrade gracefully for older EUMM/older perls if (!eval { ExtUtils::MakeMaker->VERSION('6.6303') }) { $WriteMakefileArgs{BUILD_REQUIRES} = $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{TEST_REQUIRES}; } if (!eval { ExtUtils::MakeMaker->VERSION('6.5501') }) { @{$WriteMakefileArgs{PREREQ_PM}}{ keys %{$WriteMakefileArgs{BUILD_REQUIRES}} } = @{$WriteMakefileArgs{BUILD_REQUIRES}}{ keys %{$WriteMakefileArgs{BUILD_REQUIRES}} }; delete $WriteMakefileArgs{BUILD_REQUIRES}; } WriteMakefile(%WriteMakefileArgs); Text-Glob-0.11/META.yml0000644000175000017500000000107513060033637014635 0ustar richardcrichardc--- abstract: 'match globbing patterns against text' author: - 'Richard Clamp ' build_requires: ExtUtils::MakeMaker: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.143240' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Text-Glob no_index: directory: - t - inc requires: Exporter: '0' constant: '0' perl: '5.00503' resources: {} version: '0.11' Text-Glob-0.11/META.json0000644000175000017500000000216413060033637015005 0ustar richardcrichardc{ "abstract" : "match globbing patterns against text", "author" : [ "Richard Clamp " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.143240", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Text-Glob", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Exporter" : "0", "constant" : "0", "perl" : "5.00503" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "richardc@unixbeard.net" } }, "version" : "0.11" }