Regexp-Shellish-0.93/0040755000076400007640000000000007424026516014332 5ustar barriesbarriesRegexp-Shellish-0.93/Shellish.pm0100644000076400007640000001174307424026204016440 0ustar barriesbarriespackage Regexp::Shellish ; # # Copyright 1999, Barrie Slaymaker # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the README file. # =head1 NAME Regexp::Shellish - Shell-like regular expressions =head1 SYNOPSIS use Regexp::Shellish qw( :all ) ; $re = compile_shellish( 'a/c*d' ) ; ## This next one's like 'a*d' except that it'll ## match 'a/d'. $re = compile_shellish( 'a**d' ) ; ## And here '**' won't match 'a/d', but behaves ## like 'a*d', except for the possibility of high ## cpu time consumption. $re = compile_shellish( 'a**d', { star_star => 0 } ) ; ## The next two result in identical $re1 and $re2. ## The second is a noop so that Regexp references can ## be easily accomodated. $re1 = compile_shellish( 'a{b,c}d' ) ; $re2 = compile_shellish( qr/\A(?:a(?:b|c)d)\Z/ ) ; @matches = shellish_glob( $re, @possibilities ) ; =head1 DESCRIPTION Provides shell-like regular expressions. The wildcards provided are C, C<*> and C<**>, where C<**> is like C<*> but matches C. See L for details. Case sensitivity and constructs like <**>, C<(a*b)>, and C<{a,b,c}> can be disabled. =over =cut use strict ; use Carp ; use Exporter ; use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS ) ; $VERSION = '0.93' ; @ISA = qw( Exporter ) ; @EXPORT_OK = qw( compile_shellish shellish_glob ) ; %EXPORT_TAGS = ( 'all' => \@EXPORT_OK ) ; =item compile_shellish Compiles a string containing a 'shellish' regular expression, returning a Regexp reference. Regexp references passed in are passed through unmolested. Here are the transformation rules from shellish expression terms to perl regular expression terms: Shellish Perl RE ======== ======= * [^/]* ? . ** .* ## unless { star_star => 0 } ... .* ## unless { dot_dot_dot => 0 } ( ( ## unless { parens => 0 } ) ) ## unless { parens => 0 } {a,b,c} (?:a|b|c) ## unless { braces => 0 } \a a ## These are de-escaped and \* \* ## passed to quotemeta() The wildcards treat newlines as normal characters. Parens group in to $1..$n, since they are passed through unmolested (unless option parens => 0 is passed). This is useless when using glob_shellish(), though. The final parameter can be a hash reference containing options: compile_shellish( '**', { anchors => 0, ## Doesn't put ^ and $ around the ## resulting regexp case_sensitive => 0, ## Make case insensitive dot_dot_dot => 0, ## '...' is now just three '.' chars star_star => 0, ## '**' is now two '*' wildcards parens => 0, ## '(', ')' are now regular chars braces => 0, ## '{', '}' are now regular chars } ) ; No option affects Regexps passed through. =cut sub compile_shellish { my $o = @_ && ref $_[-1] eq 'HASH' ? pop : {} ; my $re = shift ; return $re if ref $re eq 'Regexp' ; my $star_star = ( ! exists $o->{star_star} || $o->{star_star} ) ? '.*' : '[^/]*[^/]*' ; my $dot_dot_dot = ( ! exists $o->{dot_dot_dot} || $o->{dot_dot_dot} ) ? '.*' : '\.\.\.' ; my $case = ( ! exists $o->{case_sensitive} || $o->{case_sensitive} ) ? '' : 'i' ; my $anchors = ( ! exists $o->{anchors} || $o->{anchors} ) ; my $pass_parens = ( ! exists $o->{parens} || $o->{parens} ) ; my $pass_braces = ( ! exists $o->{braces} || $o->{braces} ) ; my $brace_depth = 0 ; my $orig = $re ; $re =~ s@ ( \\. | \*\* | \.\.\. | . ) @ if ( $1 eq '?' ) { '[^/]' ; } elsif ( $1 eq '*' ) { '[^/]*' ; } elsif ( $1 eq '**' ) { $star_star ; } elsif ( $1 eq '...' ) { $dot_dot_dot; } elsif ( $pass_braces && $1 eq '{' ) { ++$brace_depth ; '(?:' ; } elsif ( $pass_braces && $1 eq '}' ) { croak "Unmatched '}' in '$orig'" unless $brace_depth-- ; ')' ; } elsif ( $pass_braces && $brace_depth && $1 eq ',' ) { '|' ; } elsif ( $pass_parens && index( '()', $1 ) >= 0 ) { $1 ; } else { quotemeta(substr( $1, -1 ) ); } @gexs ; croak "Unmatched '{' in '$orig'" if $brace_depth ; return $anchors ? qr/\A(?$case:$re)\Z/s : qr/(?$case:$re)/s ; } =item shellish_glob Pass a regular expression and a list of possible values, get back a list of matching values. my @matches = shellish_glob( '*/*', @possibilities ) ; my @matches = shellish_glob( '*/*', @possibilities, \%options ) ; =cut sub shellish_glob { my $o = @_ > 1 && ref $_[-1] eq 'HASH' ? pop : {} ; my $re = compile_shellish( shift, $o ) ; return grep { m/$re/ } @_ ; } =back =head1 AUTHOR Barrie Slaymaker =cut 1 ; Regexp-Shellish-0.93/Makefile.PL0100644000076400007640000000066207424026321016277 0ustar barriesbarriesuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Regexp::Shellish', 'VERSION_FROM' => 'Shellish.pm', # finds $VERSION ); sub MY::libscan { package MY ; my $self = shift ; my ( $path ) = @_ ; return '' if /\.sw[a-z]$/ ; return '' unless length $self->SUPER::libscan( $path ) ; return $path ; } Regexp-Shellish-0.93/Changes0100644000076400007640000000060407424026511015615 0ustar barriesbarriesRevision history for Perl extension Regexp::Shellish. 0.93 Thu Jan 24 10:49:02 EST 2002 - Added support for '...' wildcard - minor POD cleanup - Tweaked Makefile.PL to skip editor swap files and backups in lib/ 0.92 Thu Apr 20 02:21:23 EDT 2000 - Added { anchors => 0 } option & assoc. tests. 0.9 Fri Apr 14 12:08:59 2000 - original version; created by h2xs 1.19 Regexp-Shellish-0.93/MANIFEST0100644000076400007640000000011207424024755015455 0ustar barriesbarriesChanges MANIFEST MANIFEST.SKIP Makefile.PL Shellish.pm t/RegexpShellish.t Regexp-Shellish-0.93/MANIFEST.SKIP0100644000076400007640000000013207424026256016222 0ustar barriesbarries\.bak$ \.sw[a-z]$ \.tar\.gz$ ^tmp/ ^foo ^blib/ ^Makefile$ ^Makefile\.[a-z]+$ ^pm_to_blib$ Regexp-Shellish-0.93/t/0040755000076400007640000000000007424026516014575 5ustar barriesbarriesRegexp-Shellish-0.93/t/RegexpShellish.t0100644000076400007640000000515407424026052017705 0ustar barriesbarries#!/usr/bin/perl -w =head1 NAME RegexpShellish.t - Test suite for RegexpShellish =cut use strict ; use Test ; use Regexp::Shellish qw( :all ) ; my @samples = qw( ac AC abc ABC a/c A/C xaz xbz xcz q...t ) ; my $re ; sub k { my $expected ; ( $re, $expected ) = @_ ; $re = compile_shellish( $re, @_ > 2 ? pop : () ) ; @_ = ( join( ',', shellish_glob( $re, @samples ) ), $expected, "/$re/" ) ; goto &ok ; } my @tests = ( sub {k( qr/a.*c/, 'ac,abc,a/c' )}, sub {k( 'a.*c', '' )}, sub {k( 'a?c', 'abc', )}, sub {k( 'a\*c', '', )}, sub {k( 'a\?c', '', )}, sub {k( 'a\bc', 'abc', )}, sub {k( 'a\(c', '', )}, sub {k( 'a\)c', '', )}, sub {k( 'a\{c', '', )}, sub {k( 'a\}c', '', )}, sub {k( 'a*c', 'ac,abc', )}, sub {k( 'a*c', 'ac,abc', { case_sensitive => 1 } )}, sub {k( 'a*c', 'ac,AC,abc,ABC', { case_sensitive => 0 } )}, sub {k( 'a**c', 'ac,abc,a/c', )}, sub {k( 'a**c', 'ac,abc,a/c', { case_sensitive => 1 } )}, sub {k( 'a**c', 'ac,AC,abc,ABC,a/c,A/C', { case_sensitive => 0 } )}, sub {k( 'a**c', 'ac,abc,a/c', )}, sub {k( 'a**c', 'ac,abc,a/c', { star_star => 1 } )}, sub {k( 'a**c', 'ac,abc', { star_star => 0 } )}, sub {k( 'a...c', 'ac,abc,a/c', )}, sub {k( 'a...c', 'ac,abc,a/c', { dot_dot_dot => 1 } )}, sub {k( 'a...c', '', { dot_dot_dot => 0 } )}, sub {k( 'q...t', 'q...t', { dot_dot_dot => 0 } )}, sub { 'abc' =~ compile_shellish( 'a(?)c' ) ; ok( $1, 'b' ) }, sub { 'abc' =~ compile_shellish( 'a(?)c', {parens => 1 } ) ; ok( $1, 'b' ) }, sub { ok( 'a(b)c' =~ compile_shellish( 'a(b)c', { parens => 0 } ) )}, sub {k( 'x{y}z', '', )}, sub {k( 'x{a}z', 'xaz', )}, sub {k( 'x{a,b}z', 'xaz,xbz', )}, sub {k( 'x{a,b}z', 'xaz,xbz', { braces => 1 } )}, sub {k( 'x{a,b}z', '', { braces => 0 } )}, sub { ok( 'x{a}z' =~ compile_shellish( 'x{a}z', { braces => 0 } ) )}, sub { ok( 'abc' !~ compile_shellish( 'c' ) ) }, sub { ok( 'abc' =~ compile_shellish( 'c', { anchors => 0 } ) ) }, ) ; plan tests => scalar( @tests ) ; $_->() for ( @tests ) ;