Profile of re.pm

Filename	/usr/lib/perl/5.10/re.pm
Statements	Executed 41 statements in 1.13ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
2	1	1	34µs	34µs	re::::bitsre::bits
2	2	2	29µs	63µs	re::::importre::import
1	1	1	19µs	24µs	re::::BEGIN@4re::BEGIN@4
1	1	1	10µs	25µs	re::::BEGIN@5re::BEGIN@5
0	0	0	0s	0s	re::::_do_installre::_do_install
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 regex engine
4	3	29µs	2	28µs	# spent 24µs (19+5) within re::BEGIN@4 which was called: # once (19µs+5µs) by File::Basename::BEGIN@43 at line 4 use strict; # spent 24µs making 1 call to re::BEGIN@4 # spent 5µs making 1 call to strict::import
5	3	969µs	2	40µs	# spent 25µs (10+15) within re::BEGIN@5 which was called: # once (10µs+15µs) by File::Basename::BEGIN@43 at line 5 use warnings; # spent 25µs making 1 call to re::BEGIN@5 # spent 15µs making 1 call to warnings::import
6
7	1	800ns			our $VERSION = "0.09";
8	1	10µs			our @ISA = qw(Exporter);
9	1	800ns			my @XS_FUNCTIONS = qw(regmust);
10	1	3µs			my %XS_FUNCTIONS = map { $_ => 1 } @XS_FUNCTIONS;
11	1	1µs			our @EXPORT_OK = (@XS_FUNCTIONS,
12					qw(is_regexp regexp_pattern
13					regname regnames regnames_count));
14	1	6µs			our %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
15
16					# * WARNING * WARNING * WARNING * WARNING * WARNING *
17					#
18					# If you modify these values see comment below!
19
20	1	1µs			my %bitmask = (
21					taint => 0x00100000, # HINT_RE_TAINT
22					eval => 0x00200000, # HINT_RE_EVAL
23					);
24
25					# - File::Basename contains a literal for 'taint' as a fallback. If
26					# taint is changed here, File::Basename must be updated as well.
27					#
28					# - ExtUtils::ParseXS uses a hardcoded
29					# BEGIN { $^H \|= 0x00200000 }
30					# in it to allow re.xs to be built. So if 'eval' is changed here then
31					# ExtUtils::ParseXS must be changed as well.
32					#
33					# * WARNING * WARNING * WARNING * WARNING * WARNING *
34
35					sub setcolor {
36					eval { # Ignore errors
37					require Term::Cap;
38
39					my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
40					my $props = $ENV{PERL_RE_TC} \|\| 'md,me,so,se,us,ue';
41					my @props = split /,/, $props;
42					my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
43
44					$colors =~ s/\0//g;
45					$ENV{PERL_RE_COLORS} = $colors;
46					};
47					if ($@) {
48					$ENV{PERL_RE_COLORS} \|\|= qq'\t\t> <\t> <\t\t';
49					}
50
51					}
52
53	1	14µs			my %flags = (
54					COMPILE => 0x0000FF,
55					PARSE => 0x000001,
56					OPTIMISE => 0x000002,
57					TRIEC => 0x000004,
58					DUMP => 0x000008,
59					FLAGS => 0x000010,
60
61					EXECUTE => 0x00FF00,
62					INTUIT => 0x000100,
63					MATCH => 0x000200,
64					TRIEE => 0x000400,
65
66					EXTRA => 0xFF0000,
67					TRIEM => 0x010000,
68					OFFSETS => 0x020000,
69					OFFSETSDBG => 0x040000,
70					STATE => 0x080000,
71					OPTIMISEM => 0x100000,
72					STACK => 0x280000,
73					BUFFERS => 0x400000,
74					);
75	1	3µs			$flags{ALL} = -1 & ~($flags{OFFSETS}\|$flags{OFFSETSDBG}\|$flags{BUFFERS});
76	1	1µs			$flags{All} = $flags{all} = $flags{DUMP} \| $flags{EXECUTE};
77	1	900ns			$flags{Extra} = $flags{EXECUTE} \| $flags{COMPILE};
78	1	2µs			$flags{More} = $flags{MORE} = $flags{All} \| $flags{TRIEC} \| $flags{TRIEM} \| $flags{STATE};
79	1	900ns			$flags{State} = $flags{DUMP} \| $flags{EXECUTE} \| $flags{STATE};
80	1	900ns			$flags{TRIE} = $flags{DUMP} \| $flags{EXECUTE} \| $flags{TRIEC};
81
82	1	300ns			my $installed;
83	1	200ns			my $installed_error;
84
85					sub _do_install {
86					if ( ! defined($installed) ) {
87					require XSLoader;
88					$installed = eval { XSLoader::load('re', $VERSION) } \|\| 0;
89					$installed_error = $@;
90					}
91					}
92
93					sub _load_unload {
94					my ($on)= @_;
95					if ($on) {
96					_do_install();
97					if ( ! $installed ) {
98					die "'re' not installed!? ($installed_error)";
99					} else {
100					# We call install() every time, as if we didn't, we wouldn't
101					# "see" any changes to the color environment var since
102					# the last time it was called.
103
104					# install() returns an integer, which if casted properly
105					# in C resolves to a structure containing the regex
106					# hooks. Setting it to a random integer will guarantee
107					# segfaults.
108					$^H{regcomp} = install();
109					}
110					} else {
111					delete $^H{regcomp};
112					}
113					}
114
115					# spent 34µs within re::bits which was called 2 times, avg 17µs/call: # 2 times (34µs+0s) by re::import at line 171, avg 17µs/call sub bits {
116	10	34µs			my $on = shift;
117					my $bits = 0;
118					unless (@_) {
119					require Carp;
120					Carp::carp("Useless use of \"re\" pragma");
121					}
122					foreach my $idx (0..$#_){
123	4	14µs			my $s=$_[$idx];
124					if ($s eq 'Debug' or $s eq 'Debugcolor') {
125					setcolor() if $s =~/color/i;
126					${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
127					for my $idx ($idx+1..$#_) {
128					if ($flags{$_[$idx]}) {
129					if ($on) {
130					${^RE_DEBUG_FLAGS} \|= $flags{$_[$idx]};
131					} else {
132					${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
133					}
134					} else {
135					require Carp;
136					Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
137					join(", ",sort keys %flags ) );
138					}
139					}
140					_load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
141					last;
142					} elsif ($s eq 'debug' or $s eq 'debugcolor') {
143					setcolor() if $s =~/color/i;
144					_load_unload($on);
145					last;
146					} elsif (exists $bitmask{$s}) {
147					$bits \|= $bitmask{$s};
148					} elsif ($XS_FUNCTIONS{$s}) {
149					_do_install();
150					if (! $installed) {
151					require Carp;
152					Carp::croak("\"re\" function '$s' not available");
153					}
154					require Exporter;
155					re->export_to_level(2, 're', $s);
156					} elsif ($EXPORT_OK{$s}) {
157					require Exporter;
158					re->export_to_level(2, 're', $s);
159					} else {
160					require Carp;
161					Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
162					join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
163					")");
164					}
165					}
166					$bits;
167					}
168
169					# spent 63µs (29+34) within re::import which was called 2 times, avg 32µs/call: # once (18µs+24µs) by B::Deparse::BEGIN@3413 at line 3413 of B/Deparse.pm # once (11µs+10µs) by File::Basename::BEGIN@43 at line 46 of File/Basename.pm sub import {
170	4	22µs			shift;
171			2	34µs	$^H \|= bits(1, @_); # spent 34µs making 2 calls to re::bits, avg 17µs/call
172					}
173
174					sub unimport {
175					shift;
176					$^H &= ~ bits(0, @_);
177					}
178
179	1	19µs			1;
180
181					__END__