← Index
NYTProf Performance Profile   « line view »
For /usr/sbin/pkg_info
  Run on Fri Aug 4 10:12:01 2017
Reported on Fri Aug 4 10:12:17 2017

Filename/usr/libdata/perl5/OpenBSD/PackageName.pm
StatementsExecuted 62574 statements in 230ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
32282.9ms145msOpenBSD::PackageName::::compile_stemlist OpenBSD::PackageName::compile_stemlist
106422156.7ms67.4msOpenBSD::PackageName::::splitstem OpenBSD::PackageName::splitstem
21155.3ms67.0msOpenBSD::PackageLocator::_compiled_stemlist::::find_partialOpenBSD::PackageLocator::_compiled_stemlist::find_partial
106472110.6ms10.6msOpenBSD::PackageName::::CORE:match OpenBSD::PackageName::CORE:match (opcode)
9323115.94ms5.94msOpenBSD::PackageLocator::_compiled_stemlist::::CORE:matchOpenBSD::PackageLocator::_compiled_stemlist::CORE:match (opcode)
984115.90ms10.9msOpenBSD::PackageLocator::_compiled_stemlist::::addOpenBSD::PackageLocator::_compiled_stemlist::add
9323115.74ms5.74msOpenBSD::PackageLocator::_compiled_stemlist::::CORE:regcompOpenBSD::PackageLocator::_compiled_stemlist::CORE:regcomp (opcode)
2111.23ms147msOpenBSD::PackageName::::avail2stems OpenBSD::PackageName::avail2stems
51145µs73µsOpenBSD::PackageName::::is_stem OpenBSD::PackageName::is_stem
11117µs20µsOpenBSD::PackageInfo::::BEGIN@18 OpenBSD::PackageInfo::BEGIN@18
1119µs17µsOpenBSD::PackageInfo::::BEGIN@19 OpenBSD::PackageInfo::BEGIN@19
0000s0sOpenBSD::PackageLocator::_compiled_stemlist::::deleteOpenBSD::PackageLocator::_compiled_stemlist::delete
0000s0sOpenBSD::PackageLocator::_compiled_stemlist::::findOpenBSD::PackageLocator::_compiled_stemlist::find
0000s0sOpenBSD::PackageName::Name::::compare OpenBSD::PackageName::Name::compare
0000s0sOpenBSD::PackageName::Name::::flavor_string OpenBSD::PackageName::Name::flavor_string
0000s0sOpenBSD::PackageName::Name::::has_issues OpenBSD::PackageName::Name::has_issues
0000s0sOpenBSD::PackageName::Name::::to_pattern OpenBSD::PackageName::Name::to_pattern
0000s0sOpenBSD::PackageName::Name::::to_string OpenBSD::PackageName::Name::to_string
0000s0sOpenBSD::PackageName::Stem::::has_issues OpenBSD::PackageName::Stem::has_issues
0000s0sOpenBSD::PackageName::Stem::::to_pattern OpenBSD::PackageName::Stem::to_pattern
0000s0sOpenBSD::PackageName::Stem::::to_string OpenBSD::PackageName::Stem::to_string
0000s0sOpenBSD::PackageName::dewey::::compare OpenBSD::PackageName::dewey::compare
0000s0sOpenBSD::PackageName::dewey::::dewey_compare OpenBSD::PackageName::dewey::dewey_compare
0000s0sOpenBSD::PackageName::dewey::::from_string OpenBSD::PackageName::dewey::from_string
0000s0sOpenBSD::PackageName::dewey::::make OpenBSD::PackageName::dewey::make
0000s0sOpenBSD::PackageName::dewey::::suffix_compare OpenBSD::PackageName::dewey::suffix_compare
0000s0sOpenBSD::PackageName::dewey::::to_string OpenBSD::PackageName::dewey::to_string
0000s0sOpenBSD::PackageName::::from_string OpenBSD::PackageName::from_string
0000s0sOpenBSD::PackageName::::new_from_string OpenBSD::PackageName::new_from_string
0000s0sOpenBSD::PackageName::::splitname OpenBSD::PackageName::splitname
0000s0sOpenBSD::PackageName::::url2pkgname OpenBSD::PackageName::url2pkgname
0000s0sOpenBSD::PackageName::version::::compare OpenBSD::PackageName::version::compare
0000s0sOpenBSD::PackageName::version::::from_string OpenBSD::PackageName::version::from_string
0000s0sOpenBSD::PackageName::version::::has_issues OpenBSD::PackageName::version::has_issues
0000s0sOpenBSD::PackageName::version::::p OpenBSD::PackageName::version::p
0000s0sOpenBSD::PackageName::version::::pnum_compare OpenBSD::PackageName::version::pnum_compare
0000s0sOpenBSD::PackageName::version::::to_string OpenBSD::PackageName::version::to_string
0000s0sOpenBSD::PackageName::version::::v OpenBSD::PackageName::version::v
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# ex:ts=8 sw=4:
2# $OpenBSD: PackageName.pm,v 1.52 2014/03/18 18:53:29 espie Exp $
3#
4# Copyright (c) 2003-2010 Marc Espie <espie@openbsd.org>
5#
6# Permission to use, copy, modify, and distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17
18226µs224µs
# spent 20µs (17+4) within OpenBSD::PackageInfo::BEGIN@18 which was called: # once (17µs+4µs) by OpenBSD::PackageInfo::BEGIN@29 at line 18
use strict;
# spent 20µs making 1 call to OpenBSD::PackageInfo::BEGIN@18 # spent 4µs making 1 call to strict::import
1922.01ms224µs
# spent 17µs (9+8) within OpenBSD::PackageInfo::BEGIN@19 which was called: # once (9µs+8µs) by OpenBSD::PackageInfo::BEGIN@29 at line 19
use warnings;
# spent 17µs making 1 call to OpenBSD::PackageInfo::BEGIN@19 # spent 8µs making 1 call to warnings::import
20
21package OpenBSD::PackageName;
22
23sub url2pkgname($)
24{
25 my $name = $_[0];
26 $name =~ s|.*/||;
27 $name =~ s|\.tgz$||;
28
29 return $name;
30}
31
32# see packages-specs(7)
33sub splitname
34{
35 my $n = shift;
36 if ($n =~ /^(.*?)\-(\d.*)$/o) {
37 my $stem = $1;
38 my $rest = $2;
39 my @all = split /\-/o, $rest;
40 return ($stem, @all);
41 } else {
42 return ($n);
43 }
44}
45
4611µsmy $cached = {};
47
48sub from_string
49{
50 my ($class, $s) = @_;
51 return $cached->{$s} //= $class->new_from_string($s);
52}
53
54sub new_from_string
55{
56 my ($class, $n) = @_;
57 if ($n =~ /^(.*?)\-(\d.*)$/o) {
58 my $stem = $1;
59 my $rest = $2;
60 my @all = split /\-/o, $rest;
61 my $version = OpenBSD::PackageName::version->from_string(shift @all);
62 return bless {
63 stem => $stem,
64 version => $version,
65 flavors => { map {($_, 1)} @all },
66 }, "OpenBSD::PackageName::Name";
67 } else {
68 return bless {
69 stem => $n,
70 }, "OpenBSD::PackageName::Stem";
71 }
72}
73
74sub splitstem
75
# spent 67.4ms (56.7+10.6) within OpenBSD::PackageName::splitstem which was called 10642 times, avg 6µs/call: # 9658 times (52.8ms+9.56ms) by OpenBSD::PackageName::compile_stemlist at line 98, avg 6µs/call # 984 times (3.91ms+1.06ms) by OpenBSD::PackageLocator::_compiled_stemlist::add at line 122, avg 5µs/call
{
76106427.09ms my $s = shift;
771064279.8ms1064210.6ms if ($s =~ /^(.*?)\-\d/o) {
# spent 10.6ms making 10642 calls to OpenBSD::PackageName::CORE:match, avg 998ns/call
78 return $1;
79 } else {
80 return $s;
81 }
82}
83
84sub is_stem
85
# spent 73µs (45+28) within OpenBSD::PackageName::is_stem which was called 5 times, avg 15µs/call: # 5 times (45µs+28µs) by OpenBSD::PkgInfo::find_pkg_in at line 190 of OpenBSD/PkgInfo.pm, avg 15µs/call
{
8654µs my $s = shift;
87564µs528µs if ($s =~ m/\-\d/o || $s eq '-') {
# spent 28µs making 5 calls to OpenBSD::PackageName::CORE:match, avg 6µs/call
88 return 0;
89 } else {
90 return 1;
91 }
92}
93
94sub compile_stemlist
95
# spent 145ms (82.9+62.4) within OpenBSD::PackageName::compile_stemlist which was called 3 times, avg 48.4ms/call: # 2 times (82.9ms+62.4ms) by OpenBSD::PackageName::avail2stems at line 108, avg 72.7ms/call # once (9µs+0s) by OpenBSD::PackageInfo::_init_list at line 56 of OpenBSD/PackageInfo.pm
{
9635µs my $hash = {};
97312µs for my $n (@_) {
98965822.7ms965862.4ms my $stem = splitstem($n);
# spent 62.4ms making 9658 calls to OpenBSD::PackageName::splitstem, avg 6µs/call
99965816.4ms $hash->{$stem} = {} unless defined $hash->{$stem};
100965824.8ms $hash->{$stem}->{$n} = 1;
101 }
102338µs bless $hash, "OpenBSD::PackageLocator::_compiled_stemlist";
103}
104
105sub avail2stems
106
# spent 147ms (1.23+145) within OpenBSD::PackageName::avail2stems which was called 2 times, avg 73.3ms/call: # 2 times (1.23ms+145ms) by OpenBSD::PackageRepository::stemlist at line 171 of OpenBSD/PackageRepository.pm, avg 73.3ms/call
{
1072864µs my @avail = @_;
1082345µs2145ms return OpenBSD::PackageName::compile_stemlist(@avail);
# spent 145ms making 2 calls to OpenBSD::PackageName::compile_stemlist, avg 72.7ms/call
109}
110
111package OpenBSD::PackageLocator::_compiled_stemlist;
112
113sub find
114{
115 my ($self, $stem) = @_;
116 return keys %{$self->{$stem}};
117}
118
119sub add
120
# spent 10.9ms (5.90+4.96) within OpenBSD::PackageLocator::_compiled_stemlist::add which was called 984 times, avg 11µs/call: # 984 times (5.90ms+4.96ms) by OpenBSD::PackageInfo::add_installed at line 73 of OpenBSD/PackageInfo.pm, avg 11µs/call
{
121984631µs my ($self, $pkgname) = @_;
1229842.26ms9844.96ms my $stem = OpenBSD::PackageName::splitstem($pkgname);
# spent 4.96ms making 984 calls to OpenBSD::PackageName::splitstem, avg 5µs/call
1239845.29ms $self->{$stem}->{$pkgname} = 1;
124}
125
126sub delete
127{
128 my ($self, $pkgname) = @_;
129 my $stem = OpenBSD::PackageName::splitstem($pkgname);
130 delete $self->{$stem}->{$pkgname};
131 if(keys %{$self->{$stem}} == 0) {
132 delete $self->{$stem};
133 }
134}
135
136sub find_partial
137
# spent 67.0ms (55.3+11.7) within OpenBSD::PackageLocator::_compiled_stemlist::find_partial which was called 2 times, avg 33.5ms/call: # 2 times (55.3ms+11.7ms) by OpenBSD::Search::PartialStem::match at line 166 of OpenBSD/Search.pm, avg 33.5ms/call
{
13823µs my ($self, $partial) = @_;
13923µs my @result = ();
14029.42ms while (my ($stem, $pkgs) = each %$self) {
141932357.6ms1864611.7ms next unless $stem =~ /\Q$partial\E/i;
# spent 5.94ms making 9323 calls to OpenBSD::PackageLocator::_compiled_stemlist::CORE:match, avg 637ns/call # spent 5.74ms making 9323 calls to OpenBSD::PackageLocator::_compiled_stemlist::CORE:regcomp, avg 616ns/call
142311µs push(@result, keys %$pkgs);
143 }
144213µs return @result;
145}
146
147package OpenBSD::PackageName::dewey;
148
1491800nsmy $cache = {};
150
151sub from_string
152{
153 my ($class, $string) = @_;
154 my $o = bless { deweys => [ split(/\./o, $string) ],
155 suffix => '', suffix_value => 0}, $class;
156 if ($o->{deweys}->[-1] =~ m/^(\d+)(rc|beta|pre|pl)(\d*)$/) {
157 $o->{deweys}->[-1] = $1;
158 $o->{suffix} = $2;
159 $o->{suffix_value} = $3;
160 }
161 return $o;
162}
163
164sub make
165{
166 my ($class, $string) = @_;
167 return $cache->{$string} //= $class->from_string($string);
168}
169
170sub to_string
171{
172 my $self = shift;
173 my $r = join('.', @{$self->{deweys}});
174 if ($self->{suffix}) {
175 $r .= $self->{suffix} . $self->{suffix_value};
176 }
177 return $r;
178}
179
180sub suffix_compare
181{
182 my ($a, $b) = @_;
183 if ($a->{suffix} eq $b->{suffix}) {
184 return $a->{suffix_value} <=> $b->{suffix_value};
185 }
186 if ($a->{suffix} eq 'pl') {
187 return 1;
188 }
189 if ($b->{suffix} eq 'pl') {
190 return -1;
191 }
192
193 if ($a->{suffix} gt $b->{suffix}) {
194 return -suffix_compare($b, $a);
195 }
196 # order is '', beta, pre, rc
197 # we know that a < b,
198 if ($a->{suffix} eq '') {
199 return 1;
200 }
201 if ($a->{suffix} eq 'beta') {
202 return -1;
203 }
204 # refuse to compare pre vs. rc
205 return 0;
206}
207
208sub compare
209{
210 my ($a, $b) = @_;
211 # Try a diff in dewey numbers first
212 for (my $i = 0; ; $i++) {
213 if (!defined $a->{deweys}->[$i]) {
214 if (!defined $b->{deweys}->[$i]) {
215 last;
216 } else {
217 return -1;
218 }
219 }
220 if (!defined $b->{deweys}->[$i]) {
221 return 1;
222 }
223 my $r = dewey_compare($a->{deweys}->[$i],
224 $b->{deweys}->[$i]);
225 return $r if $r != 0;
226 }
227 return suffix_compare($a, $b);
228}
229
230sub dewey_compare
231{
232 my ($a, $b) = @_;
233 # numerical comparison
234 if ($a =~ m/^\d+$/o and $b =~ m/^\d+$/o) {
235 return $a <=> $b;
236 }
237 # added lowercase letter
238 if ("$a.$b" =~ m/^(\d+)([a-z]?)\.(\d+)([a-z]?)$/o) {
239 my ($an, $al, $bn, $bl) = ($1, $2, $3, $4);
240 if ($an != $bn) {
241 return $an <=> $bn;
242 } else {
243 return $al cmp $bl;
244 }
245 }
246 return $a cmp $b;
247}
248
249package OpenBSD::PackageName::version;
250
251sub p
252{
253 my $self = shift;
254
255 return defined $self->{p} ? $self->{p} : -1;
256}
257
258sub v
259{
260 my $self = shift;
261
262 return defined $self->{v} ? $self->{v} : -1;
263}
264
265sub from_string
266{
267 my ($class, $string) = @_;
268 my $o = bless {}, $class;
269 if ($string =~ m/^(.*)v(\d+)$/o) {
270 $o->{v} = $2;
271 $string = $1;
272 }
273 if ($string =~ m/^(.*)p(\d+)$/o) {
274 $o->{p} = $2;
275 $string = $1;
276 }
277 $o->{dewey} = OpenBSD::PackageName::dewey->make($string);
278
279 return $o;
280}
281
282sub to_string
283{
284 my $o = shift;
285 my $string = $o->{dewey}->to_string;
286 if (defined $o->{p}) {
287 $string .= 'p'.$o->{p};
288 }
289 if (defined $o->{v}) {
290 $string .= 'v'.$o->{v};
291 }
292 return $string;
293}
294
295sub pnum_compare
296{
297 my ($a, $b) = @_;
298 return $a->p <=> $b->p;
299}
300
301sub compare
302{
303 my ($a, $b) = @_;
304 # Simple case: epoch number
305 if ($a->v != $b->v) {
306 return $a->v <=> $b->v;
307 }
308 # Simple case: only p number differs
309 if ($a->{dewey} eq $b->{dewey}) {
310 return $a->pnum_compare($b);
311 }
312
313 return $a->{dewey}->compare($b->{dewey});
314}
315
316sub has_issues
317{
318 my $self = shift;
319 if ($self->{dewey}{deweys}[-1] =~ m/v\d+$/ && defined $self->{p}) {
320 return ("correct order is pNvM");
321 } else {
322 return ();
323 }
324}
325
326package OpenBSD::PackageName::Stem;
327sub to_string
328{
329 my $o = shift;
330 return $o->{stem};
331}
332
333sub to_pattern
334{
335 my $o = shift;
336 return $o->{stem}.'-*';
337}
338
339sub has_issues
340{
341 my $self = shift;
342 return ("is a stem");
343}
344
345package OpenBSD::PackageName::Name;
346sub flavor_string
347{
348 my $o = shift;
349 return join('-', sort keys %{$o->{flavors}});
350}
351
352sub to_string
353{
354 my $o = shift;
355 return join('-', $o->{stem}, $o->{version}->to_string,
356 sort keys %{$o->{flavors}});
357}
358
359sub to_pattern
360{
361 my $o = shift;
362 return join('-', $o->{stem}, '*', $o->flavor_string);
363}
364
365sub compare
366{
367 my ($a, $b) = @_;
368 if ($a->{stem} ne $b->{stem} || $a->flavor_string ne $b->flavor_string) {
369 return undef;
370 }
371 return $a->{version}->compare($b->{version});
372}
373
374sub has_issues
375{
376 my $self = shift;
377 return ((map {"flavor $_ can't start with digit"}
378 grep { /^\d/ } keys %{$self->{flavors}}),
379 $self->{version}->has_issues);
380}
381
38215µs1;
 
# spent 5.94ms within OpenBSD::PackageLocator::_compiled_stemlist::CORE:match which was called 9323 times, avg 637ns/call: # 9323 times (5.94ms+0s) by OpenBSD::PackageLocator::_compiled_stemlist::find_partial at line 141, avg 637ns/call
sub OpenBSD::PackageLocator::_compiled_stemlist::CORE:match; # opcode
# spent 5.74ms within OpenBSD::PackageLocator::_compiled_stemlist::CORE:regcomp which was called 9323 times, avg 616ns/call: # 9323 times (5.74ms+0s) by OpenBSD::PackageLocator::_compiled_stemlist::find_partial at line 141, avg 616ns/call
sub OpenBSD::PackageLocator::_compiled_stemlist::CORE:regcomp; # opcode
# spent 10.6ms within OpenBSD::PackageName::CORE:match which was called 10647 times, avg 1000ns/call: # 10642 times (10.6ms+0s) by OpenBSD::PackageName::splitstem at line 77, avg 998ns/call # 5 times (28µs+0s) by OpenBSD::PackageName::is_stem at line 87, avg 6µs/call
sub OpenBSD::PackageName::CORE:match; # opcode
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.