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 |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 20µs | 25µs | BEGIN@4 | re::
2 | 1 | 1 | 19µs | 19µs | bits | re::
2 | 2 | 2 | 13µs | 32µs | import | re::
1 | 1 | 1 | 8µs | 28µs | BEGIN@5 | re::
0 | 0 | 0 | 0s | 0s | _load_unload | re::
0 | 0 | 0 | 0s | 0s | setcolor | re::
0 | 0 | 0 | 0s | 0s | unimport | re::
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 # 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 # 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 | ||||
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 | ||||
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__ |