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 | BEGIN@2 | Text::Glob::
1 | 1 | 1 | 10µs | 32µs | BEGIN@3 | Text::Glob::
1 | 1 | 1 | 10µs | 55µs | BEGIN@13 | Text::Glob::
1 | 1 | 1 | 9µs | 76µs | BEGIN@4 | Text::Glob::
0 | 0 | 0 | 0s | 0s | glob_to_regex | Text::Glob::
0 | 0 | 0 | 0s | 0s | glob_to_regex_string | Text::Glob::
0 | 0 | 0 | 0s | 0s | match_glob | Text::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 | 2 | 7µs | # 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 | 45µ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__ |