← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 03:09:29 2017
Reported on Mon Nov 6 13:20:45 2017

Filename/usr/local/lib/perl5/5.24/mach/re.pm
StatementsExecuted 953 statements in 7.55ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
66212.82ms2.82msre::::bitsre::bits
6565651.04ms3.81msre::::importre::import
11134µs41µsre::::BEGIN@4re::BEGIN@4
11125µs74µsre::::unimportre::unimport
11118µs37µsre::::BEGIN@5re::BEGIN@5
0000s0sre::::_load_unloadre::_load_unload
0000s0sre::::setcolorre::setcolor
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package re;
2
3# pragma for controlling the regexp engine
4250µs248µs
# spent 41µs (34+7) within re::BEGIN@4 which was called: # once (34µs+7µs) by Mail::SpamAssassin::BEGIN@65 at line 4
use strict;
# spent 41µs making 1 call to re::BEGIN@4 # spent 7µs making 1 call to strict::import
522.77ms257µs
# spent 37µs (18+20) within re::BEGIN@5 which was called: # once (18µs+20µs) by Mail::SpamAssassin::BEGIN@65 at line 5
use warnings;
# spent 37µs making 1 call to re::BEGIN@5 # spent 20µs making 1 call to warnings::import
6
712µsour $VERSION = "0.32";
8116µsour @ISA = qw(Exporter);
913µsour @EXPORT_OK = ('regmust',
10 qw(is_regexp regexp_pattern
11 regname regnames regnames_count));
12731µsour %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
13
1414µsmy %bitmask = (
15 taint => 0x00100000, # HINT_RE_TAINT
16 eval => 0x00200000, # HINT_RE_EVAL
17);
18
1911µsmy $flags_hint = 0x02000000; # HINT_RE_FLAGS
2012µsmy $PMMOD_SHIFT = 0;
21114µsmy %reflags = (
22 m => 1 << ($PMMOD_SHIFT + 0),
23 s => 1 << ($PMMOD_SHIFT + 1),
24 i => 1 << ($PMMOD_SHIFT + 2),
25 x => 1 << ($PMMOD_SHIFT + 3),
26 n => 1 << ($PMMOD_SHIFT + 5),
27 p => 1 << ($PMMOD_SHIFT + 6),
28 strict => 1 << ($PMMOD_SHIFT + 10),
29# special cases:
30 d => 0,
31 l => 1,
32 u => 2,
33 a => 3,
34 aa => 4,
35);
36
37sub setcolor {
38 eval { # Ignore errors
39 require Term::Cap;
40
41 my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
42 my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
43 my @props = split /,/, $props;
44 my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
45
46 $colors =~ s/\0//g;
47 $ENV{PERL_RE_COLORS} = $colors;
48 };
49 if ($@) {
50 $ENV{PERL_RE_COLORS} ||= qq'\t\t> <\t> <\t\t';
51 }
52
53}
54
55113µsmy %flags = (
56 COMPILE => 0x0000FF,
57 PARSE => 0x000001,
58 OPTIMISE => 0x000002,
59 TRIEC => 0x000004,
60 DUMP => 0x000008,
61 FLAGS => 0x000010,
62 TEST => 0x000020,
63
64 EXECUTE => 0x00FF00,
65 INTUIT => 0x000100,
66 MATCH => 0x000200,
67 TRIEE => 0x000400,
68
69 EXTRA => 0xFF0000,
70 TRIEM => 0x010000,
71 OFFSETS => 0x020000,
72 OFFSETSDBG => 0x040000,
73 STATE => 0x080000,
74 OPTIMISEM => 0x100000,
75 STACK => 0x280000,
76 BUFFERS => 0x400000,
77 GPOS => 0x800000,
78);
7914µs$flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
8012µs$flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
8112µs$flags{Extra} = $flags{EXECUTE} | $flags{COMPILE} | $flags{GPOS};
8212µs$flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
8312µs$flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
8412µs$flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
85
8614µsif (defined &DynaLoader::boot_DynaLoader) {
8716µs require XSLoader;
881400µs1383µs XSLoader::load();
# spent 383µs making 1 call to XSLoader::load
89}
90# else we're miniperl
91# We need to work for miniperl, because the XS toolchain uses Text::Wrap, which
92# uses re 'taint'.
93
94sub _load_unload {
95 my ($on)= @_;
96 if ($on) {
97 # We call install() every time, as if we didn't, we wouldn't
98 # "see" any changes to the color environment var since
99 # the last time it was called.
100
101 # install() returns an integer, which if casted properly
102 # in C resolves to a structure containing the regexp
103 # hooks. Setting it to a random integer will guarantee
104 # segfaults.
105 $^H{regcomp} = install();
106 } else {
107 delete $^H{regcomp};
108 }
109}
110
111
# spent 2.82ms within re::bits which was called 66 times, avg 43µs/call: # 65 times (2.78ms+0s) by re::import at line 275, avg 43µs/call # once (49µs+0s) by re::unimport at line 280
sub bits {
11266136µs my $on = shift;
11366138µs my $bits = 0;
11466191µs my $turning_all_off = ! @_ && ! $on;
11566134µs my %seen; # Has flag already been seen?
11666113µs if ($turning_all_off) {
117
118 # Pretend were called with certain parameters, which are best dealt
119 # with that way.
120 push @_, keys %bitmask; # taint and eval
121 push @_, 'strict';
122 }
123
124 # Process each subpragma parameter
125 ARG:
12666487µs foreach my $idx (0..$#_){
12766199µs my $s=$_[$idx];
12866625µs if ($s eq 'Debug' or $s eq 'Debugcolor') {
129 setcolor() if $s =~/color/i;
130 ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
131 for my $idx ($idx+1..$#_) {
132 if ($flags{$_[$idx]}) {
133 if ($on) {
134 ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
135 } else {
136 ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
137 }
138 } else {
139 require Carp;
140 Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
141 join(", ",sort keys %flags ) );
142 }
143 }
144 _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
145 last;
146 } elsif ($s eq 'debug' or $s eq 'debugcolor') {
147 setcolor() if $s =~/color/i;
148 _load_unload($on);
149 last;
150 } elsif (exists $bitmask{$s}) {
15166165µs $bits |= $bitmask{$s};
152 } elsif ($EXPORT_OK{$s}) {
153 require Exporter;
154 re->export_to_level(2, 're', $s);
155 } elsif ($s eq 'strict') {
156 if ($on) {
157 $^H{reflags} |= $reflags{$s};
158 warnings::warnif('experimental::re_strict',
159 "\"use re 'strict'\" is experimental");
160
161 # Turn on warnings if not already done.
162 if (! warnings::enabled('regexp')) {
163 require warnings;
164 warnings->import('regexp');
165 $^H{re_strict} = 1;
166 }
167 }
168 else {
169 $^H{reflags} &= ~$reflags{$s} if $^H{reflags};
170
171 # Turn off warnings if we turned them on.
172 warnings->unimport('regexp') if $^H{re_strict};
173 }
174 if ($^H{reflags}) {
175 $^H |= $flags_hint;
176 }
177 else {
178 $^H &= ~$flags_hint;
179 }
180 } elsif ($s =~ s/^\///) {
181 my $reflags = $^H{reflags} || 0;
182 my $seen_charset;
183 while ($s =~ m/( . )/gx) {
184 local $_ = $1;
185 if (/[adul]/) {
186 # The 'a' may be repeated; hide this from the rest of the
187 # code by counting and getting rid of all of them, then
188 # changing to 'aa' if there is a repeat.
189 if ($_ eq 'a') {
190 my $sav_pos = pos $s;
191 my $a_count = $s =~ s/a//g;
192 pos $s = $sav_pos - 1; # -1 because got rid of the 'a'
193 if ($a_count > 2) {
194 require Carp;
195 Carp::carp(
196 qq 'The "a" flag may only appear a maximum of twice'
197 );
198 }
199 elsif ($a_count == 2) {
200 $_ = 'aa';
201 }
202 }
203 if ($on) {
204 if ($seen_charset) {
205 require Carp;
206 if ($seen_charset ne $_) {
207 Carp::carp(
208 qq 'The "$seen_charset" and "$_" flags '
209 .qq 'are exclusive'
210 );
211 }
212 else {
213 Carp::carp(
214 qq 'The "$seen_charset" flag may not appear '
215 .qq 'twice'
216 );
217 }
218 }
219 $^H{reflags_charset} = $reflags{$_};
220 $seen_charset = $_;
221 }
222 else {
223 delete $^H{reflags_charset}
224 if defined $^H{reflags_charset}
225 && $^H{reflags_charset} == $reflags{$_};
226 }
227 } elsif (exists $reflags{$_}) {
228 $seen{$_}++;
229 $on
230 ? $reflags |= $reflags{$_}
231 : ($reflags &= ~$reflags{$_});
232 } else {
233 require Carp;
234 Carp::carp(
235 qq'Unknown regular expression flag "$_"'
236 );
237 next ARG;
238 }
239 }
240 ($^H{reflags} = $reflags or defined $^H{reflags_charset})
241 ? $^H |= $flags_hint
242 : ($^H &= ~$flags_hint);
243 } else {
244 require Carp;
245 Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
246 join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
247 ")");
248 }
249 }
25066139µs if (exists $seen{'x'} && $seen{'x'} > 1
251 && (warnings::enabled("deprecated")
252 || warnings::enabled("regexp")))
253 {
254 my $message = "Having more than one /x regexp modifier is deprecated";
255 if (warnings::enabled("deprecated")) {
256 warnings::warn("deprecated", $message);
257 }
258 else {
259 warnings::warn("regexp", $message);
260 }
261 }
262
26366115µs if ($turning_all_off) {
264 _load_unload(0);
265 $^H{reflags} = 0;
266 $^H{reflags_charset} = 0;
267 $^H &= ~$flags_hint;
268 }
269
27066544µs $bits;
271}
272
273
# spent 3.81ms (1.04+2.78) within re::import which was called 65 times, avg 59µs/call: # once (21µs+57µs) by Mail::SpamAssassin::Message::BEGIN@47 at line 47 of Mail/SpamAssassin/Message.pm # once (19µs+55µs) by Mail::SpamAssassin::BayesStore::DBM::BEGIN@23 at line 23 of Mail/SpamAssassin/BayesStore/DBM.pm # once (20µs+54µs) by Mail::SpamAssassin::BEGIN@65 at line 65 of Mail/SpamAssassin.pm # once (19µs+54µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@50 at line 50 of Mail/SpamAssassin/Plugin/SpamCop.pm # once (18µs+54µs) by Mail::SpamAssassin::Plugin::AskDNS::BEGIN@189 at line 189 of Mail/SpamAssassin/Plugin/AskDNS.pm # once (20µs+51µs) by File::Basename::BEGIN@42 at line 45 of File/Basename.pm # once (17µs+54µs) by Mail::SpamAssassin::Conf::Parser::BEGIN@146 at line 146 of Mail/SpamAssassin/Conf/Parser.pm # once (21µs+48µs) by Mail::SpamAssassin::Plugin::URIDNSBL::BEGIN@302 at line 302 of Mail/SpamAssassin/Plugin/URIDNSBL.pm # once (19µs+50µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@54 at line 54 of Mail/SpamAssassin/Message/Metadata.pm # once (19µs+50µs) by Mail::SpamAssassin::PerMsgLearner::BEGIN@52 at line 52 of Mail/SpamAssassin/PerMsgLearner.pm # once (20µs+49µs) by Mail::SpamAssassin::Plugin::HTTPSMismatch::BEGIN@25 at line 25 of Mail/SpamAssassin/Plugin/HTTPSMismatch.pm # once (18µs+50µs) by Mail::SpamAssassin::Plugin::SPF::BEGIN@42 at line 42 of Mail/SpamAssassin/Plugin/SPF.pm # once (19µs+49µs) by Mail::SpamAssassin::Plugin::Hashcash::BEGIN@89 at line 89 of Mail/SpamAssassin/Plugin/Hashcash.pm # once (18µs+49µs) by Mail::SpamAssassin::Locker::UnixNFSSafe::BEGIN@23 at line 23 of Mail/SpamAssassin/Locker/UnixNFSSafe.pm # once (18µs+48µs) by Mail::SpamAssassin::Plugin::Check::BEGIN@19 at line 19 of Mail/SpamAssassin/Plugin/Check.pm # once (18µs+49µs) by Mail::SpamAssassin::ArchiveIterator::BEGIN@25 at line 25 of Mail/SpamAssassin/ArchiveIterator.pm # once (18µs+48µs) by Mail::SpamAssassin::Plugin::TxRep::BEGIN@205 at line 205 of Mail/SpamAssassin/Plugin/TxRep.pm # once (18µs+48µs) by Mail::SpamAssassin::Plugin::AutoLearnThreshold::BEGIN@59 at line 59 of Mail/SpamAssassin/Plugin/AutoLearnThreshold.pm # once (19µs+48µs) by Mail::SpamAssassin::Plugin::MIMEEval::BEGIN@23 at line 23 of Mail/SpamAssassin/Plugin/MIMEEval.pm # once (18µs+48µs) by Mail::SpamAssassin::Plugin::Razor2::BEGIN@49 at line 49 of Mail/SpamAssassin/Plugin/Razor2.pm # once (19µs+47µs) by Mail::SpamAssassin::NetSet::BEGIN@24 at line 24 of Mail/SpamAssassin/NetSet.pm # once (17µs+49µs) by Mail::SpamAssassin::Plugin::RelayEval::BEGIN@27 at line 27 of Mail/SpamAssassin/Plugin/RelayEval.pm # once (17µs+48µs) by Mail::SpamAssassin::Conf::SQL::BEGIN@49 at line 49 of Mail/SpamAssassin/Conf/SQL.pm # once (18µs+47µs) by Mail::SpamAssassin::DBBasedAddrList::BEGIN@23 at line 23 of Mail/SpamAssassin/DBBasedAddrList.pm # once (17µs+48µs) by Mail::SpamAssassin::Plugin::BEGIN@103 at line 103 of Mail/SpamAssassin/Plugin.pm # once (17µs+46µs) by Mail::SpamAssassin::Constants::BEGIN@26 at line 26 of Mail/SpamAssassin/Constants.pm # once (16µs+46µs) by Mail::SpamAssassin::Message::Node::BEGIN@39 at line 39 of Mail/SpamAssassin/Message/Node.pm # once (16µs+45µs) by Mail::SpamAssassin::Plugin::VBounce::BEGIN@34 at line 34 of Mail/SpamAssassin/Plugin/VBounce.pm # once (13µs+47µs) by Mail::SpamAssassin::PersistentAddrList::BEGIN@52 at line 52 of Mail/SpamAssassin/PersistentAddrList.pm # once (16µs+43µs) by Mail::SpamAssassin::Util::TieOneStringHash::BEGIN@24 at line 24 of Mail/SpamAssassin/Util/TieOneStringHash.pm # once (16µs+41µs) by Mail::SpamAssassin::Plugin::URIEval::BEGIN@26 at line 26 of Mail/SpamAssassin/Plugin/URIEval.pm # once (16µs+40µs) by Mail::SpamAssassin::Plugin::BodyEval::BEGIN@27 at line 27 of Mail/SpamAssassin/Plugin/BodyEval.pm # once (15µs+42µs) by Mail::SpamAssassin::Plugin::DNSEval::BEGIN@35 at line 35 of Mail/SpamAssassin/Plugin/DNSEval.pm # once (16µs+40µs) by Mail::SpamAssassin::RegistryBoundaries::BEGIN@31 at line 31 of Mail/SpamAssassin/RegistryBoundaries.pm # once (13µs+43µs) by Mail::SpamAssassin::Conf::LDAP::BEGIN@49 at line 49 of Mail/SpamAssassin/Conf/LDAP.pm # once (15µs+41µs) by Mail::SpamAssassin::Plugin::HTMLEval::BEGIN@23 at line 23 of Mail/SpamAssassin/Plugin/HTMLEval.pm # once (15µs+41µs) by Mail::SpamAssassin::Plugin::DKIM::BEGIN@129 at line 129 of Mail/SpamAssassin/Plugin/DKIM.pm # once (16µs+40µs) by Mail::SpamAssassin::Util::Progress::BEGIN@48 at line 48 of Mail/SpamAssassin/Util/Progress.pm # once (16µs+39µs) by Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@63 at line 63 of Mail/SpamAssassin/Plugin/MIMEHeader.pm # once (16µs+39µs) by Mail::SpamAssassin::BayesStore::BEGIN@34 at line 34 of Mail/SpamAssassin/BayesStore.pm # once (15µs+39µs) by Mail::SpamAssassin::Plugin::HeaderEval::BEGIN@23 at line 23 of Mail/SpamAssassin/Plugin/HeaderEval.pm # once (15µs+39µs) by Mail::SpamAssassin::Plugin::ReplaceTags::BEGIN@59 at line 59 of Mail/SpamAssassin/Plugin/ReplaceTags.pm # once (14µs+40µs) by Mail::SpamAssassin::Plugin::WhiteListSubject::BEGIN@50 at line 50 of Mail/SpamAssassin/Plugin/WhiteListSubject.pm # once (15µs+38µs) by Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@88 at line 88 of Mail/SpamAssassin/Plugin/ImageInfo.pm # once (14µs+39µs) by Mail::SpamAssassin::PluginHandler::BEGIN@34 at line 34 of Mail/SpamAssassin/PluginHandler.pm # once (12µs+39µs) by Mail::SpamAssassin::Logger::BEGIN@41 at line 41 of Mail/SpamAssassin/Logger.pm # once (13µs+39µs) by Mail::SpamAssassin::AsyncLoop::BEGIN@39 at line 39 of Mail/SpamAssassin/AsyncLoop.pm # once (14µs+38µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@47 at line 47 of Mail/SpamAssassin/Message/Metadata/Received.pm # once (15µs+36µs) by Mail::SpamAssassin::Plugin::URIDetail::BEGIN@76 at line 76 of Mail/SpamAssassin/Plugin/URIDetail.pm # once (14µs+36µs) by Mail::SpamAssassin::Plugin::WLBLEval::BEGIN@26 at line 26 of Mail/SpamAssassin/Plugin/WLBLEval.pm # once (14µs+36µs) by Mail::SpamAssassin::Conf::BEGIN@83 at line 83 of Mail/SpamAssassin/Conf.pm # once (14µs+36µs) by Mail::SpamAssassin::Timeout::BEGIN@59 at line 59 of Mail/SpamAssassin/Timeout.pm # once (14µs+34µs) by Mail::SpamAssassin::Plugin::Bayes::BEGIN@49 at line 49 of Mail/SpamAssassin/Plugin/Bayes.pm # once (13µs+35µs) by Mail::SpamAssassin::Bayes::Combine::BEGIN@34 at line 34 of Mail/SpamAssassin/Bayes/CombineChi.pm # once (13µs+35µs) by Mail::SpamAssassin::Locker::BEGIN@23 at line 23 of Mail/SpamAssassin/Locker.pm # once (13µs+35µs) by Mail::SpamAssassin::DnsResolver::BEGIN@41 at line 41 of Mail/SpamAssassin/DnsResolver.pm # once (13µs+34µs) by Mail::SpamAssassin::Util::ScopedTimer::BEGIN@25 at line 25 of Mail/SpamAssassin/Util/ScopedTimer.pm # once (13µs+34µs) by Mail::SpamAssassin::Logger::Stderr::BEGIN@35 at line 35 of Mail/SpamAssassin/Logger/Stderr.pm # once (14µs+33µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@54 at line 54 of Mail/SpamAssassin/PerMsgStatus.pm # once (12µs+34µs) by Mail::SpamAssassin::Util::BEGIN@46 at line 46 of Mail/SpamAssassin/Util.pm # once (13µs+33µs) by Mail::SpamAssassin::Locales::BEGIN@23 at line 23 of Mail/SpamAssassin/Locales.pm # once (13µs+33µs) by Mail::SpamAssassin::HTML::BEGIN@25 at line 25 of Mail/SpamAssassin/HTML.pm # once (13µs+32µs) by Mail::SpamAssassin::AICache::BEGIN@45 at line 45 of Mail/SpamAssassin/AICache.pm # once (12µs+32µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@26 at line 26 of Mail/SpamAssassin/Dns.pm # once (13µs+31µs) by Mail::SpamAssassin::Bayes::BEGIN@38 at line 38 of Mail/SpamAssassin/Bayes.pm
sub import {
27465116µs shift;
275651.06ms652.78ms $^H |= bits(1, @_);
# spent 2.78ms making 65 calls to re::bits, avg 43µs/call
276}
277
278
# spent 74µs (25+49) within re::unimport which was called: # once (25µs+49µs) by Mail::SpamAssassin::Util::BEGIN@288 at line 288 of Mail/SpamAssassin/Util.pm
sub unimport {
27912µs shift;
280119µs149µs $^H &= ~ bits(0, @_);
# spent 49µs making 1 call to re::bits
281}
282
283144µs1;
284
285__END__
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.