Server IP : 85.214.239.14 / Your IP : 3.22.242.169 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /proc/3/task/3/cwd/proc/2/root/usr/share/perl5/Text/ |
Upload File : |
package 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<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<aaa> =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 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 separator (i.e. do not match C</>) 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 while compiling the regex, or change the separator that Text::Glob uses by setting C<$Text::Glob::seperator> (with the typo, yes) to an alternative value while 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@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