local-lib5/lib/perl5/Text/Glob.pm

   1 package Text::Glob;
   2 use strict;
   3 use Exporter;
   4 use vars qw/$VERSION @ISA @EXPORT_OK
   5             $strict_leading_dot $strict_wildcard_slash/;
   6 $VERSION = '0.08';
   7 @ISA = 'Exporter';
   8 @EXPORT_OK = qw( glob_to_regex glob_to_regex_string match_glob );
   9
  10 $strict_leading_dot    = 1;
  11 $strict_wildcard_slash = 1;
  12
  13 use constant debug => 0;
  14
  15 sub glob_to_regex {
  16     my $glob = shift;
  17     my $regex = glob_to_regex_string($glob);
  18     return qr/^$regex$/;
  19 }
  20
  21 sub glob_to_regex_string
  22 {
  23     my $glob = shift;
  24     my ($regex, $in_curlies, $escaping);
  25     local $_;
  26     my $first_byte = 1;
  27     for ($glob =~ m/(.)/gs) {
  28         if ($first_byte) {
  29             if ($strict_leading_dot) {
  30                 $regex .= '(?=[^\.])' unless $_ eq '.';
  31             }
  32             $first_byte = 0;
  33         }
  34         if ($_ eq '/') {
  35             $first_byte = 1;
  36         }
  37         if ($_ eq '.' || $_ eq '(' || $_ eq ')' || $_ eq '|' ||
  38             $_ eq '+' || $_ eq '^' || $_ eq '$' || $_ eq '@' || $_ eq '%' ) {
  39             $regex .= "\\$_";
  40         }
  41         elsif ($_ eq '*') {
  42             $regex .= $escaping ? "\\*" :
  43               $strict_wildcard_slash ? "[^/]*" : ".*";
  44         }
  45         elsif ($_ eq '?') {
  46             $regex .= $escaping ? "\\?" :
  47               $strict_wildcard_slash ? "[^/]" : ".";
  48         }
  49         elsif ($_ eq '{') {
  50             $regex .= $escaping ? "\\{" : "(";
  51             ++$in_curlies unless $escaping;
  52         }
  53         elsif ($_ eq '}' && $in_curlies) {
  54             $regex .= $escaping ? "}" : ")";
  55             --$in_curlies unless $escaping;
  56         }
  57         elsif ($_ eq ',' && $in_curlies) {
  58             $regex .= $escaping ? "," : "|";
  59         }
  60         elsif ($_ eq "\\") {
  61             if ($escaping) {
  62                 $regex .= "\\\\";
  63                 $escaping = 0;
  64             }
  65             else {
  66                 $escaping = 1;
  67             }
  68             next;
  69         }
  70         else {
  71             $regex .= $_;
  72             $escaping = 0;
  73         }
  74         $escaping = 0;
  75     }
  76     print "# $glob $regex\n" if debug;
  77
  78     return $regex;
  79 }
  80
  81 sub match_glob {
  82     print "# ", join(', ', map { "'$_'" } @_), "\n" if debug;
  83     my $glob = shift;
  84     my $regex = glob_to_regex $glob;
  85     local $_;
  86     grep { $_ =~ $regex } @_;
  87 }
  88
  89 1;
  90 __END__
  91
  92 =head1 NAME
  93
  94 Text::Glob - match globbing patterns against text
  95
  96 =head1 SYNOPSIS
  97
  98  use Text::Glob qw( match_glob glob_to_regex );
  99
 100  print "matched\n" if match_glob( "foo.*", "foo.bar" );
 101
 102  # prints foo.bar and foo.baz
 103  my $regex = glob_to_regex( "foo.*" );
 104  for ( qw( foo.bar foo.baz foo bar ) ) {
 105      print "matched: $_\n" if /$regex/;
 106  }
 107
 108 =head1 DESCRIPTION
 109
 110 Text::Glob implements glob(3) style matching that can be used to match
 111 against text, rather than fetching names from a filesystem.  If you
 112 want to do full file globbing use the File::Glob module instead.
 113
 114 =head2 Routines
 115
 116 =over
 117
 118 =item match_glob( $glob, @things_to_test )
 119
 120 Returns the list of things which match the glob from the source list.
 121
 122 =item glob_to_regex( $glob )
 123
 124 Returns a compiled regex which is the equiavlent of the globbing
 125 pattern.
 126
 127 =item glob_to_regex_string( $glob )
 128
 129 Returns a regex string which is the equiavlent of the globbing
 130 pattern.
 131
 132 =back
 133
 134 =head1 SYNTAX
 135
 136 The following metacharacters and rules are respected.
 137
 138 =over
 139
 140 =item C<*> - match zero or more characters
 141
 142 C<a*> matches C<a>, C<aa>, C<aaaa> and many many more.
 143
 144 =item C<?> - match exactly one character
 145
 146 C<a?> matches C<aa>, but not C<a>, or C<aa>
 147
 148 =item Character sets/ranges
 149
 150 C<example.[ch]> matches C<example.c> and C<example.h>
 151
 152 C<demo.[a-c]> matches C<demo.a>, C<demo.b>, and C<demo.c>
 153
 154 =item alternation
 155
 156 C<example.{foo,bar,baz}> matches C<example.foo>, C<example.bar>, and
 157 C<example.baz>
 158
 159 =item leading . must be explictly matched
 160
 161 C<*.foo> does not match C<.bar.foo>.  For this you must either specify
 162 the leading . in the glob pattern (C<.*.foo>), or set
 163 C<$Text::Glob::strict_leading_dot> to a false value while compiling
 164 the regex.
 165
 166 =item C<*> and C<?> do not match /
 167
 168 C<*.foo> does not match C<bar/baz.foo>.  For this you must either
 169 explicitly match the / in the glob (C<*/*.foo>), or set
 170 C<$Text::Glob::strict_wildcard_slash> to a false value with compiling
 171 the regex.
 172
 173 =back
 174
 175 =head1 BUGS
 176
 177 The code uses qr// to produce compiled regexes, therefore this module
 178 requires perl version 5.005_03 or newer.
 179
 180 =head1 AUTHOR
 181
 182 Richard Clamp <richardc@unixbeard.net>
 183
 184 =head1 COPYRIGHT
 185
 186 Copyright (C) 2002, 2003, 2006, 2007 Richard Clamp.  All Rights Reserved.
 187
 188 This module is free software; you can redistribute it and/or modify it
 189 under the same terms as Perl itself.
 190
 191 =head1 SEE ALSO
 192
 193 L<File::Glob>, glob(3)
 194
 195 =cut