| Filename | /Users/ap13/perl5/lib/perl5/Text/Glob.pm |
| Statements | Executed 14 statements in 554µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 12µs | 24µs | Text::Glob::BEGIN@2 |
| 1 | 1 | 1 | 10µs | 32µs | Text::Glob::BEGIN@3 |
| 1 | 1 | 1 | 10µs | 55µs | Text::Glob::BEGIN@13 |
| 1 | 1 | 1 | 9µs | 76µs | Text::Glob::BEGIN@4 |
| 0 | 0 | 0 | 0s | 0s | Text::Glob::glob_to_regex |
| 0 | 0 | 0 | 0s | 0s | Text::Glob::glob_to_regex_string |
| 0 | 0 | 0 | 0s | 0s | Text::Glob::match_glob |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Text::Glob; | ||||
| 2 | 2 | 22µs | 2 | 35µs | # spent 24µs (12+12) within Text::Glob::BEGIN@2 which was called:
# once (12µs+12µs) by File::Find::Rule::BEGIN@6 at line 2 # spent 24µs making 1 call to Text::Glob::BEGIN@2
# spent 12µs making 1 call to strict::import |
| 3 | 2 | 27µs | 2 | 54µs | # spent 32µs (10+22) within Text::Glob::BEGIN@3 which was called:
# once (10µs+22µs) by File::Find::Rule::BEGIN@6 at line 3 # spent 32µs making 1 call to Text::Glob::BEGIN@3
# spent 22µs making 1 call to Exporter::import |
| 4 | 1 | 600ns | # spent 76µs (9+67) within Text::Glob::BEGIN@4 which was called:
# once (9µs+67µs) by File::Find::Rule::BEGIN@6 at line 5 | ||
| 5 | 1 | 51µs | 2 | 143µs | $strict_leading_dot $strict_wildcard_slash/; # spent 76µs making 1 call to Text::Glob::BEGIN@4
# spent 67µs making 1 call to vars::import |
| 6 | 1 | 700ns | $VERSION = '0.09'; | ||
| 7 | 1 | 8µs | @ISA = 'Exporter'; | ||
| 8 | 1 | 900ns | @EXPORT_OK = qw( glob_to_regex glob_to_regex_string match_glob ); | ||
| 9 | |||||
| 10 | 1 | 200ns | $strict_leading_dot = 1; | ||
| 11 | 1 | 100ns | $strict_wildcard_slash = 1; | ||
| 12 | |||||
| 13 | 2 | 436µs | 2 | 100µs | # spent 55µs (10+45) within Text::Glob::BEGIN@13 which was called:
# once (10µs+45µs) by File::Find::Rule::BEGIN@6 at line 13 # spent 55µs making 1 call to Text::Glob::BEGIN@13
# spent 45µs making 1 call to constant::import |
| 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 | 7µs | 1; | ||
| 90 | __END__ |