Profile of re.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:35 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/x86_64-linux/re.pm
Statements | Executed 40 statements in 975µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 20µs | 25µs | re::::BEGIN@4re::BEGIN@4
2 | 1 | 1 | 19µs | 19µs | re::::bitsre::bits
2 | 2 | 2 | 13µs | 32µs | re::::importre::import
1 | 1 | 1 | 8µs | 28µs | re::::BEGIN@5re::BEGIN@5
0 | 0 | 0 | 0s | 0s | re::::_load_unloadre::_load_unload
0 | 0 | 0 | 0s | 0s | re::::setcolorre::setcolor
0 | 0 | 0 | 0s | 0s | re::::unimportre::unimport

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package re;
2 |  |  |  |  |
3 |  |  |  |  | # pragma for controlling the regexp engine
4 | 3 | 21µs | 2 | 30µs | # spent 25µs (20+5) within re::BEGIN@4 which was called: # once (20µs+5µs) by Moose::Util::TypeConstraints::BEGIN@614 at line 4 use strict; # spent 25µs making 1 call to re::BEGIN@4 # spent 5µs making 1 call to strict::import
5 | 3 | 615µs | 2 | 47µs | # spent 28µs (8+19) within re::BEGIN@5 which was called: # once (8µs+19µs) by Moose::Util::TypeConstraints::BEGIN@614 at line 5 use warnings; # spent 28µs making 1 call to re::BEGIN@5 # spent 19µs making 1 call to warnings::import
6 |  |  |  |  |
7 | 1 | 400ns |  |  | our $VERSION = "0.11";
8 | 1 | 10µs |  |  | our @ISA = qw(Exporter);
9 | 1 | 1µs |  |  | our @EXPORT_OK = ('regmust',
10 |  |  |  |  | qw(is_regexp regexp_pattern
11 |  |  |  |  | regname regnames regnames_count));
12 | 1 | 12µs |  |  | our %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
13 |  |  |  |  |
14 | 1 | 1µs |  |  | my %bitmask = (
15 |  |  |  |  | taint => 0x00100000, # HINT_RE_TAINT
16 |  |  |  |  | eval => 0x00200000, # HINT_RE_EVAL
17 |  |  |  |  | );
18 |  |  |  |  |
19 |  |  |  |  | sub setcolor {
20 |  |  |  |  | eval { # Ignore errors
21 |  |  |  |  | require Term::Cap;
22 |  |  |  |  |
23 |  |  |  |  | my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
24 |  |  |  |  | my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
25 |  |  |  |  | my @props = split /,/, $props;
26 |  |  |  |  | my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
27 |  |  |  |  |
28 |  |  |  |  | $colors =~ s/\0//g;
29 |  |  |  |  | $ENV{PERL_RE_COLORS} = $colors;
30 |  |  |  |  | };
31 |  |  |  |  | if ($@) {
32 |  |  |  |  | $ENV{PERL_RE_COLORS} ||= qq'\t\t> <\t> <\t\t';
33 |  |  |  |  | }
34 |  |  |  |  |
35 |  |  |  |  | }
36 |  |  |  |  |
37 | 1 | 7µs |  |  | my %flags = (
38 |  |  |  |  | COMPILE => 0x0000FF,
39 |  |  |  |  | PARSE => 0x000001,
40 |  |  |  |  | OPTIMISE => 0x000002,
41 |  |  |  |  | TRIEC => 0x000004,
42 |  |  |  |  | DUMP => 0x000008,
43 |  |  |  |  | FLAGS => 0x000010,
44 |  |  |  |  |
45 |  |  |  |  | EXECUTE => 0x00FF00,
46 |  |  |  |  | INTUIT => 0x000100,
47 |  |  |  |  | MATCH => 0x000200,
48 |  |  |  |  | TRIEE => 0x000400,
49 |  |  |  |  |
50 |  |  |  |  | EXTRA => 0xFF0000,
51 |  |  |  |  | TRIEM => 0x010000,
52 |  |  |  |  | OFFSETS => 0x020000,
53 |  |  |  |  | OFFSETSDBG => 0x040000,
54 |  |  |  |  | STATE => 0x080000,
55 |  |  |  |  | OPTIMISEM => 0x100000,
56 |  |  |  |  | STACK => 0x280000,
57 |  |  |  |  | BUFFERS => 0x400000,
58 |  |  |  |  | GPOS => 0x800000,
59 |  |  |  |  | );
60 | 1 | 2µs |  |  | $flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
61 | 1 | 900ns |  |  | $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
62 | 1 | 600ns |  |  | $flags{Extra} = $flags{EXECUTE} | $flags{COMPILE} | $flags{GPOS};
63 | 1 | 700ns |  |  | $flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
64 | 1 | 600ns |  |  | $flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
65 | 1 | 600ns |  |  | $flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
66 |  |  |  |  |
67 | 1 | 2µs |  |  | if (defined &DynaLoader::boot_DynaLoader) {
68 | 1 | 600ns |  |  | require XSLoader;
69 | 1 | 248µs | 1 | 241µs | XSLoader::load( __PACKAGE__, $VERSION); # spent 241µs making 1 call to XSLoader::load
70 |  |  |  |  | }
71 |  |  |  |  | # else we're miniperl
72 |  |  |  |  | # We need to work for miniperl, because the XS toolchain uses Text::Wrap, which
73 |  |  |  |  | # uses re 'taint'.
74 |  |  |  |  |
75 |  |  |  |  | sub _load_unload {
76 |  |  |  |  | my ($on)= @_;
77 |  |  |  |  | if ($on) {
78 |  |  |  |  | # We call install() every time, as if we didn't, we wouldn't
79 |  |  |  |  | # "see" any changes to the color environment var since
80 |  |  |  |  | # the last time it was called.
81 |  |  |  |  |
82 |  |  |  |  | # install() returns an integer, which if casted properly
83 |  |  |  |  | # in C resolves to a structure containing the regexp
84 |  |  |  |  | # hooks. Setting it to a random integer will guarantee
85 |  |  |  |  | # segfaults.
86 |  |  |  |  | $^H{regcomp} = install();
87 |  |  |  |  | } else {
88 |  |  |  |  | delete $^H{regcomp};
89 |  |  |  |  | }
90 |  |  |  |  | }
91 |  |  |  |  |
92 |  |  |  |  | # spent 19µs within re::bits which was called 2 times, avg 10µs/call: # 2 times (19µs+0s) by re::import at line 140, avg 10µs/call sub bits {
93 | 14 | 24µs |  |  | my $on = shift;
94 |  |  |  |  | my $bits = 0;
95 |  |  |  |  | unless (@_) {
96 |  |  |  |  | require Carp;
97 |  |  |  |  | Carp::carp("Useless use of \"re\" pragma");
98 |  |  |  |  | }
99 |  |  |  |  | foreach my $idx (0..$#_){
100 |  |  |  |  | my $s=$_[$idx];
101 |  |  |  |  | if ($s eq 'Debug' or $s eq 'Debugcolor') {
102 |  |  |  |  | setcolor() if $s =~/color/i;
103 |  |  |  |  | ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
104 |  |  |  |  | for my $idx ($idx+1..$#_) {
105 |  |  |  |  | if ($flags{$_[$idx]}) {
106 |  |  |  |  | if ($on) {
107 |  |  |  |  | ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
108 |  |  |  |  | } else {
109 |  |  |  |  | ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
110 |  |  |  |  | }
111 |  |  |  |  | } else {
112 |  |  |  |  | require Carp;
113 |  |  |  |  | Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
114 |  |  |  |  | join(", ",sort keys %flags ) );
115 |  |  |  |  | }
116 |  |  |  |  | }
117 |  |  |  |  | _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
118 |  |  |  |  | last;
119 |  |  |  |  | } elsif ($s eq 'debug' or $s eq 'debugcolor') {
120 |  |  |  |  | setcolor() if $s =~/color/i;
121 |  |  |  |  | _load_unload($on);
122 |  |  |  |  | last;
123 |  |  |  |  | } elsif (exists $bitmask{$s}) {
124 |  |  |  |  | $bits |= $bitmask{$s};
125 |  |  |  |  | } elsif ($EXPORT_OK{$s}) {
126 |  |  |  |  | require Exporter;
127 |  |  |  |  | re->export_to_level(2, 're', $s);
128 |  |  |  |  | } else {
129 |  |  |  |  | require Carp;
130 |  |  |  |  | Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
131 |  |  |  |  | join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
132 |  |  |  |  | ")");
133 |  |  |  |  | }
134 |  |  |  |  | }
135 |  |  |  |  | $bits;
136 |  |  |  |  | }
137 |  |  |  |  |
138 |  |  |  |  | # spent 32µs (13+19) within re::import which was called 2 times, avg 16µs/call: # once (7µs+12µs) by File::Slurp::BEGIN@263 at line 263 of File/Slurp.pm # once (6µs+7µs) by Moose::Util::TypeConstraints::BEGIN@614 at line 614 of Moose/Util/TypeConstraints.pm sub import {
139 | 4 | 11µs |  |  | shift;
140 |  |  | 2 | 19µs | $^H |= bits(1, @_); # spent 19µs making 2 calls to re::bits, avg 10µs/call
141 |  |  |  |  | }
142 |  |  |  |  |
143 |  |  |  |  | sub unimport {
144 |  |  |  |  | shift;
145 |  |  |  |  | $^H &= ~ bits(0, @_);
146 |  |  |  |  | }
147 |  |  |  |  |
148 | 1 | 18µs |  |  | 1;
149 |  |  |  |  |
150 |  |  |  |  | __END__