# Copyright (C) 2002 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.package Text::Glob;use strict;use Exporter;use vars qw/$VERSION @ISA @EXPORT_OK $strict_leading_dot $strict_wildcard_slash/;$VERSION = '0.06';@ISA = 'Exporter';@EXPORT_OK = qw( glob_to_regex match_glob );$strict_leading_dot = 1;$strict_wildcard_slash = 1;use constant debug => 0;sub glob_to_regex { 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 '$' ) { $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; qr/^$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 NAMEText::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 DESCRIPTIONText::Glob implements glob(3) style matching that can be used to matchagainst text, rather than fetching names from a filesystem. If youwant 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 globbingpattern.=back=head1 SYNTAXThe following metacharacters and rules are respected.=over=item C<*> - match zero or more charactersC<a*> matches C<a>, C<aa>, C<aaaa> and many many more.=item C<?> - match exactly one characterC<a?> matches C<aa>, but not C<a>, or C<aa>=item Character sets/rangesC<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 alternationC<example.{foo,bar,baz}> matches C<example.foo>, C<example.bar>, andC<example.baz>=item leading . must be explictly matchedC<*.foo> does not match C<.bar.foo>. For this you must either specifythe leading . in the glob pattern (C<.*.foo>), or setC<$Text::Glob::strict_leading_dot> to a false value while compilingthe regex.=item C<*> and C<?> do not match /C<*.foo> does not match C<bar/baz.foo>. For this you must eitherexplicitly match the / in the glob (C<*/*.foo>), or setC<$Text::Glob::strict_wildcard_slash> to a false value with compilingthe regex.=back=head1 BUGSThe code uses qr// to produce compiled regexes, therefore this modulerequires perl version 5.005_03 or newer.=head1 AUTHORRichard Clamp <richardc@unixbeard.net>=head1 COPYRIGHTCopyright (C) 2002 Richard Clamp. All Rights Reserved.This module is free software; you can redistribute it and/or modify itunder the same terms as Perl itself.=head1 SEE ALSOL<File::Glob>, glob(3)=cut