| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Regexp/Common.pm |
| Statements | Executed 136 statements in 1.19ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2 | 2 | 2 | 298µs | 403µs | Regexp::Common::import (recurses: max depth 1, inclusive time 21µs) |
| 2 | 2 | 1 | 43µs | 66µs | Regexp::Common::pattern |
| 2 | 1 | 1 | 22µs | 31µs | Regexp::Common::FETCH |
| 7 | 1 | 1 | 14µs | 14µs | Regexp::Common::CORE:regcomp (opcode) |
| 1 | 1 | 1 | 9µs | 9µs | Regexp::Common::BEGIN@3 |
| 1 | 1 | 1 | 7µs | 19µs | Regexp::Common::Entry::BEGIN@257 |
| 2 | 1 | 1 | 7µs | 9µs | Regexp::Common::new |
| 1 | 1 | 1 | 6µs | 24µs | Regexp::Common::BEGIN@163 |
| 1 | 1 | 1 | 6µs | 12µs | Regexp::Common::BEGIN@117 |
| 15 | 3 | 1 | 5µs | 5µs | Regexp::Common::CORE:match (opcode) |
| 4 | 2 | 1 | 5µs | 5µs | Regexp::Common::TIEHASH |
| 1 | 1 | 1 | 4µs | 11µs | Regexp::Common::BEGIN@60 |
| 1 | 1 | 1 | 4µs | 9µs | Regexp::Common::BEGIN@69 |
| 1 | 1 | 1 | 4µs | 34µs | Regexp::Common::BEGIN@19 |
| 2 | 1 | 1 | 4µs | 4µs | Regexp::Common::get_cache |
| 1 | 1 | 1 | 4µs | 7µs | Regexp::Common::BEGIN@18 |
| 1 | 1 | 1 | 4µs | 8µs | Regexp::Common::BEGIN@128 |
| 1 | 1 | 1 | 4µs | 5µs | Regexp::Common::BEGIN@4 |
| 1 | 1 | 1 | 3µs | 10µs | Regexp::Common::BEGIN@13 |
| 1 | 1 | 1 | 3µs | 3µs | Regexp::Common::BEGIN@6 |
| 1 | 1 | 1 | 1µs | 1µs | Regexp::Common::CORE:qr (opcode) |
| 2 | 1 | 1 | 800ns | 800ns | Regexp::Common::CORE:subst (opcode) |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::AUTOLOAD |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::DESTROY |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::Entry::__ANON__[:268] |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::Entry::_clone_with |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::__ANON__[:14] |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::__ANON__[:188] |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::__ANON__[:231] |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::_carp |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::_croak |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::_decache |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::croak_version |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::generic_match |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::generic_subs |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::matches |
| 0 | 0 | 0 | 0s | 0s | Regexp::Common::subs |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Regexp::Common; | ||||
| 2 | |||||
| 3 | 2 | 23µs | 1 | 9µs | # spent 9µs within Regexp::Common::BEGIN@3 which was called:
# once (9µs+0s) by SQL::SplitStatement::BEGIN@16 at line 3 # spent 9µs making 1 call to Regexp::Common::BEGIN@3 |
| 4 | 2 | 27µs | 2 | 7µs | # spent 5µs (4+2) within Regexp::Common::BEGIN@4 which was called:
# once (4µs+2µs) by SQL::SplitStatement::BEGIN@16 at line 4 # spent 5µs making 1 call to Regexp::Common::BEGIN@4
# spent 2µs making 1 call to strict::import |
| 5 | |||||
| 6 | # spent 3µs within Regexp::Common::BEGIN@6 which was called:
# once (3µs+0s) by SQL::SplitStatement::BEGIN@16 at line 16 | ||||
| 7 | # This makes sure 'use warnings' doesn't bomb out on 5.005_*; | ||||
| 8 | # warnings won't be enabled on those old versions though. | ||||
| 9 | # Since all other files use this file, we can use 'use warnings' | ||||
| 10 | # elsewhere as well, but *AFTER* 'use Regexp::Common'. | ||||
| 11 | 1 | 4µs | if ($] < 5.006) { | ||
| 12 | $INC {"warnings.pm"} = 1; | ||||
| 13 | 2 | 26µs | 2 | 16µs | # spent 10µs (3+6) within Regexp::Common::BEGIN@13 which was called:
# once (3µs+6µs) by SQL::SplitStatement::BEGIN@16 at line 13 # spent 10µs making 1 call to Regexp::Common::BEGIN@13
# spent 6µs making 1 call to strict::unimport |
| 14 | *{"warnings::unimport"} = sub {0}; | ||||
| 15 | } | ||||
| 16 | 1 | 12µs | 1 | 3µs | } # spent 3µs making 1 call to Regexp::Common::BEGIN@6 |
| 17 | |||||
| 18 | 2 | 14µs | 2 | 10µs | # spent 7µs (4+3) within Regexp::Common::BEGIN@18 which was called:
# once (4µs+3µs) by SQL::SplitStatement::BEGIN@16 at line 18 # spent 7µs making 1 call to Regexp::Common::BEGIN@18
# spent 3µs making 1 call to warnings::import |
| 19 | 2 | 113µs | 2 | 64µs | # spent 34µs (4+30) within Regexp::Common::BEGIN@19 which was called:
# once (4µs+30µs) by SQL::SplitStatement::BEGIN@16 at line 19 # spent 34µs making 1 call to Regexp::Common::BEGIN@19
# spent 30µs making 1 call to vars::import |
| 20 | |||||
| 21 | 1 | 300ns | $VERSION = '2013031301'; | ||
| 22 | |||||
| 23 | |||||
| 24 | sub _croak { | ||||
| 25 | require Carp; | ||||
| 26 | goto &Carp::croak; | ||||
| 27 | } | ||||
| 28 | |||||
| 29 | sub _carp { | ||||
| 30 | require Carp; | ||||
| 31 | goto &Carp::carp; | ||||
| 32 | } | ||||
| 33 | |||||
| 34 | # spent 9µs (7+2) within Regexp::Common::new which was called 2 times, avg 5µs/call:
# 2 times (7µs+2µs) by Regexp::Common::FETCH at line 48, avg 5µs/call | ||||
| 35 | 2 | 900ns | my ($class, @data) = @_; | ||
| 36 | 2 | 200ns | my %self; | ||
| 37 | 2 | 2µs | 2 | 2µs | tie %self, $class, @data; # spent 2µs making 2 calls to Regexp::Common::TIEHASH, avg 1µs/call |
| 38 | 2 | 3µs | return \%self; | ||
| 39 | } | ||||
| 40 | |||||
| 41 | sub TIEHASH { | ||||
| 42 | 4 | 2µs | my ($class, @data) = @_; | ||
| 43 | 4 | 9µs | bless \@data, $class; | ||
| 44 | } | ||||
| 45 | |||||
| 46 | # spent 31µs (22+9) within Regexp::Common::FETCH which was called 2 times, avg 16µs/call:
# 2 times (22µs+9µs) by DBIx::MultiStatementDo::BEGIN@11 at line 52 of SQL/SplitStatement.pm, avg 16µs/call | ||||
| 47 | 2 | 600ns | my ($self, $extra) = @_; | ||
| 48 | 2 | 21µs | 2 | 9µs | return bless ref($self)->new(@$self, $extra), ref($self); # spent 9µs making 2 calls to Regexp::Common::new, avg 5µs/call |
| 49 | } | ||||
| 50 | |||||
| 51 | 1 | 8µs | my %imports = map {$_ => "Regexp::Common::$_"} | ||
| 52 | qw /balanced CC comment delimited lingua list | ||||
| 53 | net number profanity SEN URI whitespace | ||||
| 54 | zip/; | ||||
| 55 | |||||
| 56 | # spent 403µs (298+105) within Regexp::Common::import which was called 2 times, avg 201µs/call:
# once (278µs+124µs) by SQL::SplitStatement::BEGIN@16 at line 16 of SQL/SplitStatement.pm
# once (20µs+-20µs) by Regexp::Common::delimited::BEGIN@3 at line 3 of Regexp/Common/delimited.pm | ||||
| 57 | 2 | 200ns | shift; # Shift off the class. | ||
| 58 | 2 | 4µs | 2 | 3µs | tie %RE, __PACKAGE__; # spent 3µs making 2 calls to Regexp::Common::TIEHASH, avg 1µs/call |
| 59 | { | ||||
| 60 | 4 | 43µs | 2 | 17µs | # spent 11µs (4+6) within Regexp::Common::BEGIN@60 which was called:
# once (4µs+6µs) by SQL::SplitStatement::BEGIN@16 at line 60 # spent 11µs making 1 call to Regexp::Common::BEGIN@60
# spent 6µs making 1 call to strict::unimport |
| 61 | 2 | 4µs | *{caller() . "::RE"} = \%RE; | ||
| 62 | } | ||||
| 63 | |||||
| 64 | 2 | 200ns | my $saw_import; | ||
| 65 | my $no_defaults; | ||||
| 66 | my %exclude; | ||||
| 67 | 6 | 9µs | 4 | 700ns | foreach my $entry (grep {!/^RE_/} @_) { # spent 700ns making 4 calls to Regexp::Common::CORE:match, avg 175ns/call |
| 68 | 4 | 800ns | if ($entry eq 'pattern') { | ||
| 69 | 2 | 142µs | 2 | 14µs | # spent 9µs (4+5) within Regexp::Common::BEGIN@69 which was called:
# once (4µs+5µs) by SQL::SplitStatement::BEGIN@16 at line 69 # spent 9µs making 1 call to Regexp::Common::BEGIN@69
# spent 5µs making 1 call to strict::unimport |
| 70 | 1 | 2µs | *{caller() . "::pattern"} = \&pattern; | ||
| 71 | 1 | 300ns | next; | ||
| 72 | } | ||||
| 73 | # This used to prevent $; from being set. We still recognize it, | ||||
| 74 | # but we won't do anything. | ||||
| 75 | 3 | 400ns | if ($entry eq 'clean') { | ||
| 76 | 1 | 0s | next; | ||
| 77 | } | ||||
| 78 | 2 | 100ns | if ($entry eq 'no_defaults') { | ||
| 79 | 1 | 100ns | $no_defaults ++; | ||
| 80 | 1 | 100ns | next; | ||
| 81 | } | ||||
| 82 | 1 | 400ns | if (my $module = $imports {$entry}) { | ||
| 83 | 1 | 200ns | $saw_import ++; | ||
| 84 | 1 | 14µs | eval "require $module;"; # spent 39µs executing statements in string eval | ||
| 85 | 1 | 100ns | die $@ if $@; | ||
| 86 | 1 | 400ns | next; | ||
| 87 | } | ||||
| 88 | if ($entry =~ /^!(.*)/ && $imports {$1}) { | ||||
| 89 | $exclude {$1} ++; | ||||
| 90 | next; | ||||
| 91 | } | ||||
| 92 | # As a last resort, try to load the argument. | ||||
| 93 | my $module = $entry =~ /^Regexp::Common/ | ||||
| 94 | ? $entry | ||||
| 95 | : "Regexp::Common::" . $entry; | ||||
| 96 | eval "require $module;"; | ||||
| 97 | die $@ if $@; | ||||
| 98 | } | ||||
| 99 | |||||
| 100 | 2 | 300ns | unless ($saw_import || $no_defaults) { | ||
| 101 | foreach my $module (values %imports) { | ||||
| 102 | next if $exclude {$module}; | ||||
| 103 | eval "require $module;"; | ||||
| 104 | die $@ if $@; | ||||
| 105 | } | ||||
| 106 | } | ||||
| 107 | |||||
| 108 | 2 | 300ns | my %exported; | ||
| 109 | 6 | 12µs | 4 | 200ns | foreach my $entry (grep {/^RE_/} @_) { # spent 200ns making 4 calls to Regexp::Common::CORE:match, avg 50ns/call |
| 110 | if ($entry =~ /^RE_(\w+_)?ALL$/) { | ||||
| 111 | my $m = defined $1 ? $1 : ""; | ||||
| 112 | my $re = qr /^RE_${m}.*$/; | ||||
| 113 | while (my ($sub, $interface) = each %sub_interface) { | ||||
| 114 | next if $exported {$sub}; | ||||
| 115 | next unless $sub =~ /$re/; | ||||
| 116 | { | ||||
| 117 | 2 | 39µs | 2 | 18µs | # spent 12µs (6+6) within Regexp::Common::BEGIN@117 which was called:
# once (6µs+6µs) by SQL::SplitStatement::BEGIN@16 at line 117 # spent 12µs making 1 call to Regexp::Common::BEGIN@117
# spent 6µs making 1 call to strict::unimport |
| 118 | *{caller() . "::$sub"} = $interface; | ||||
| 119 | } | ||||
| 120 | $exported {$sub} ++; | ||||
| 121 | } | ||||
| 122 | } | ||||
| 123 | else { | ||||
| 124 | next if $exported {$entry}; | ||||
| 125 | _croak "Can't export unknown subroutine &$entry" | ||||
| 126 | unless $sub_interface {$entry}; | ||||
| 127 | { | ||||
| 128 | 2 | 184µs | 2 | 13µs | # spent 8µs (4+5) within Regexp::Common::BEGIN@128 which was called:
# once (4µs+5µs) by SQL::SplitStatement::BEGIN@16 at line 128 # spent 8µs making 1 call to Regexp::Common::BEGIN@128
# spent 5µs making 1 call to strict::unimport |
| 129 | *{caller() . "::$entry"} = $sub_interface {$entry}; | ||||
| 130 | } | ||||
| 131 | $exported {$entry} ++; | ||||
| 132 | } | ||||
| 133 | } | ||||
| 134 | } | ||||
| 135 | |||||
| 136 | sub AUTOLOAD { _croak "Can't $AUTOLOAD" } | ||||
| 137 | |||||
| 138 | sub DESTROY {} | ||||
| 139 | |||||
| 140 | 1 | 200ns | my %cache; | ||
| 141 | |||||
| 142 | 1 | 5µs | 1 | 1µs | my $fpat = qr/^(-\w+)/; # spent 1µs making 1 call to Regexp::Common::CORE:qr |
| 143 | |||||
| 144 | sub _decache { | ||||
| 145 | my @args = @{tied %{$_[0]}}; | ||||
| 146 | my @nonflags = grep {!/$fpat/} @args; | ||||
| 147 | my $cache = get_cache(@nonflags); | ||||
| 148 | _croak "Can't create unknown regex: \$RE{" | ||||
| 149 | . join("}{",@args) . "}" | ||||
| 150 | unless exists $cache->{__VAL__}; | ||||
| 151 | _croak "Perl $] does not support the pattern " | ||||
| 152 | . "\$RE{" . join("}{",@args) | ||||
| 153 | . "}.\nYou need Perl $cache->{__VAL__}{version} or later" | ||||
| 154 | unless ($cache->{__VAL__}{version}||0) <= $]; | ||||
| 155 | my %flags = ( %{$cache->{__VAL__}{default}}, | ||||
| 156 | map { /$fpat\Q$;\E(.*)/ ? ($1 => $2) | ||||
| 157 | : /$fpat/ ? ($1 => undef) | ||||
| 158 | : () | ||||
| 159 | } @args); | ||||
| 160 | $cache->{__VAL__}->_clone_with(\@args, \%flags); | ||||
| 161 | } | ||||
| 162 | |||||
| 163 | 2 | 357µs | 2 | 42µs | # spent 24µs (6+18) within Regexp::Common::BEGIN@163 which was called:
# once (6µs+18µs) by SQL::SplitStatement::BEGIN@16 at line 163 # spent 24µs making 1 call to Regexp::Common::BEGIN@163
# spent 18µs making 1 call to overload::import |
| 164 | |||||
| 165 | |||||
| 166 | # spent 4µs within Regexp::Common::get_cache which was called 2 times, avg 2µs/call:
# 2 times (4µs+0s) by Regexp::Common::pattern at line 205, avg 2µs/call | ||||
| 167 | 2 | 500ns | my $cache = \%cache; | ||
| 168 | 2 | 600ns | foreach (@_) { | ||
| 169 | $cache = $cache->{$_} | ||||
| 170 | 2 | 2µs | || ($cache->{$_} = {}); | ||
| 171 | } | ||||
| 172 | 2 | 3µs | return $cache; | ||
| 173 | } | ||||
| 174 | |||||
| 175 | sub croak_version { | ||||
| 176 | my ($entry, @args) = @_; | ||||
| 177 | } | ||||
| 178 | |||||
| 179 | # spent 66µs (43+23) within Regexp::Common::pattern which was called 2 times, avg 33µs/call:
# once (28µs+19µs) by Regexp::Common::import at line 50 of Regexp/Common/delimited.pm
# once (14µs+4µs) by Regexp::Common::import at line 56 of Regexp/Common/delimited.pm | ||||
| 180 | 2 | 2µs | my %spec = @_; | ||
| 181 | _croak 'pattern() requires argument: name => [ @list ]' | ||||
| 182 | 2 | 1µs | unless $spec{name} && ref $spec{name} eq 'ARRAY'; | ||
| 183 | _croak 'pattern() requires argument: create => $sub_ref_or_string' | ||||
| 184 | 2 | 200ns | unless $spec{create}; | ||
| 185 | |||||
| 186 | 2 | 500ns | if (ref $spec{create} ne "CODE") { | ||
| 187 | my $fixed_str = "$spec{create}"; | ||||
| 188 | $spec{create} = sub { $fixed_str } | ||||
| 189 | } | ||||
| 190 | |||||
| 191 | 2 | 200ns | my @nonflags; | ||
| 192 | my %default; | ||||
| 193 | 2 | 1µs | foreach ( @{$spec{name}} ) { | ||
| 194 | 5 | 37µs | 14 | 18µs | if (/$fpat=(.*)/) { # spent 14µs making 7 calls to Regexp::Common::CORE:regcomp, avg 2µs/call
# spent 4µs making 7 calls to Regexp::Common::CORE:match, avg 571ns/call |
| 195 | $default{$1} = $2; | ||||
| 196 | } | ||||
| 197 | elsif (/$fpat\s*$/) { | ||||
| 198 | $default{$1} = undef; | ||||
| 199 | } | ||||
| 200 | else { | ||||
| 201 | 2 | 800ns | push @nonflags, $_; | ||
| 202 | } | ||||
| 203 | } | ||||
| 204 | |||||
| 205 | 2 | 1µs | 2 | 4µs | my $entry = get_cache(@nonflags); # spent 4µs making 2 calls to Regexp::Common::get_cache, avg 2µs/call |
| 206 | |||||
| 207 | 2 | 300ns | if ($entry->{__VAL__}) { | ||
| 208 | _carp "Overriding \$RE{" | ||||
| 209 | . join("}{",@nonflags) | ||||
| 210 | . "}"; | ||||
| 211 | } | ||||
| 212 | |||||
| 213 | $entry->{__VAL__} = bless { | ||||
| 214 | create => $spec{create}, | ||||
| 215 | match => $spec{match} || \&generic_match, | ||||
| 216 | subs => $spec{subs} || \&generic_subs, | ||||
| 217 | version => $spec{version}, | ||||
| 218 | 2 | 4µs | default => \%default, | ||
| 219 | }, 'Regexp::Common::Entry'; | ||||
| 220 | |||||
| 221 | 4 | 5µs | 2 | 800ns | foreach (@nonflags) {s/\W/X/g} # spent 800ns making 2 calls to Regexp::Common::CORE:subst, avg 400ns/call |
| 222 | 2 | 1µs | my $subname = "RE_" . join ("_", @nonflags); | ||
| 223 | $sub_interface{$subname} = sub { | ||||
| 224 | push @_ => undef if @_ % 2; | ||||
| 225 | my %flags = @_; | ||||
| 226 | my $pat = $spec{create}->($entry->{__VAL__}, | ||||
| 227 | {%default, %flags}, \@nonflags); | ||||
| 228 | if (exists $flags{-keep}) { $pat =~ s/\Q(?k:/(/g; } | ||||
| 229 | else { $pat =~ s/\Q(?k:/(?:/g; } | ||||
| 230 | return exists $flags {-i} ? qr /(?i:$pat)/ : qr/$pat/; | ||||
| 231 | 2 | 3µs | }; | ||
| 232 | |||||
| 233 | 2 | 4µs | return 1; | ||
| 234 | } | ||||
| 235 | |||||
| 236 | sub generic_match {$_ [1] =~ /$_[0]/} | ||||
| 237 | sub generic_subs {$_ [1] =~ s/$_[0]/$_[2]/} | ||||
| 238 | |||||
| 239 | sub matches { | ||||
| 240 | my ($self, $str) = @_; | ||||
| 241 | my $entry = $self -> _decache; | ||||
| 242 | $entry -> {match} -> ($entry, $str); | ||||
| 243 | } | ||||
| 244 | |||||
| 245 | sub subs { | ||||
| 246 | my ($self, $str, $newstr) = @_; | ||||
| 247 | my $entry = $self -> _decache; | ||||
| 248 | $entry -> {subs} -> ($entry, $str, $newstr); | ||||
| 249 | return $str; | ||||
| 250 | } | ||||
| 251 | |||||
| 252 | |||||
| 253 | package Regexp::Common::Entry; | ||||
| 254 | # use Carp; | ||||
| 255 | |||||
| 256 | use overload | ||||
| 257 | # spent 19µs (7+12) within Regexp::Common::Entry::BEGIN@257 which was called:
# once (7µs+12µs) by SQL::SplitStatement::BEGIN@16 at line 268 | ||||
| 258 | my ($self) = @_; | ||||
| 259 | my $pat = $self->{create}->($self, $self->{flags}, $self->{args}); | ||||
| 260 | if (exists $self->{flags}{-keep}) { | ||||
| 261 | $pat =~ s/\Q(?k:/(/g; | ||||
| 262 | } | ||||
| 263 | else { | ||||
| 264 | $pat =~ s/\Q(?k:/(?:/g; | ||||
| 265 | } | ||||
| 266 | if (exists $self->{flags}{-i}) { $pat = "(?i)$pat" } | ||||
| 267 | return $pat; | ||||
| 268 | 2 | 38µs | 2 | 31µs | }; # spent 19µs making 1 call to Regexp::Common::Entry::BEGIN@257
# spent 12µs making 1 call to overload::import |
| 269 | |||||
| 270 | sub _clone_with { | ||||
| 271 | my ($self, $args, $flags) = @_; | ||||
| 272 | bless { %$self, args=>$args, flags=>$flags }, ref $self; | ||||
| 273 | } | ||||
| 274 | |||||
| 275 | 1 | 4µs | 1; | ||
| 276 | |||||
| 277 | __END__ | ||||
# spent 5µs within Regexp::Common::CORE:match which was called 15 times, avg 327ns/call:
# 7 times (4µs+0s) by Regexp::Common::pattern at line 194, avg 571ns/call
# 4 times (700ns+0s) by Regexp::Common::import at line 67, avg 175ns/call
# 4 times (200ns+0s) by Regexp::Common::import at line 109, avg 50ns/call | |||||
# spent 1µs within Regexp::Common::CORE:qr which was called:
# once (1µs+0s) by SQL::SplitStatement::BEGIN@16 at line 142 | |||||
# spent 14µs within Regexp::Common::CORE:regcomp which was called 7 times, avg 2µs/call:
# 7 times (14µs+0s) by Regexp::Common::pattern at line 194, avg 2µs/call | |||||
# spent 800ns within Regexp::Common::CORE:subst which was called 2 times, avg 400ns/call:
# 2 times (800ns+0s) by Regexp::Common::pattern at line 221, avg 400ns/call |