Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sys/Info.pm |
Statements | Executed 33 statements in 696µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 630µs | 1.38ms | BEGIN@6 | Sys::Info::
1 | 1 | 1 | 10µs | 21µs | BEGIN@2 | Sys::Info::
1 | 1 | 1 | 10µs | 2.37ms | BEGIN@7 | Sys::Info::
2 | 1 | 1 | 10µs | 10µs | _mk_object | Sys::Info::
1 | 1 | 1 | 9µs | 13µs | BEGIN@3 | Sys::Info::
1 | 1 | 1 | 9µs | 18µs | BEGIN@77 | Sys::Info::
1 | 1 | 1 | 7µs | 17µs | BEGIN@18 | Sys::Info::
1 | 1 | 1 | 7µs | 26µs | BEGIN@5 | Sys::Info::
1 | 1 | 1 | 6µs | 34µs | BEGIN@4 | Sys::Info::
1 | 1 | 1 | 5µs | 5µs | import | Sys::Info::
0 | 0 | 0 | 0s | 0s | __ANON__[:80] | Sys::Info::
0 | 0 | 0 | 0s | 0s | _legacy_perl | Sys::Info::
0 | 0 | 0 | 0s | 0s | httpd | Sys::Info::
0 | 0 | 0 | 0s | 0s | new | Sys::Info::
0 | 0 | 0 | 0s | 0s | perl | Sys::Info::
0 | 0 | 0 | 0s | 0s | perl_build | Sys::Info::
0 | 0 | 0 | 0s | 0s | perl_long | Sys::Info::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Sys::Info; | ||||
2 | 2 | 18µs | 2 | 31µs | # spent 21µs (10+10) within Sys::Info::BEGIN@2 which was called:
# once (10µs+10µs) by Benchmark::Perl::Formance::BEGIN@21 at line 2 # spent 21µs making 1 call to Sys::Info::BEGIN@2
# spent 10µs making 1 call to strict::import |
3 | 2 | 19µs | 2 | 17µs | # spent 13µs (9+4) within Sys::Info::BEGIN@3 which was called:
# once (9µs+4µs) by Benchmark::Perl::Formance::BEGIN@21 at line 3 # spent 13µs making 1 call to Sys::Info::BEGIN@3
# spent 4µs making 1 call to warnings::import |
4 | 2 | 19µs | 2 | 61µs | # spent 34µs (6+27) within Sys::Info::BEGIN@4 which was called:
# once (6µs+27µs) by Benchmark::Perl::Formance::BEGIN@21 at line 4 # spent 34µs making 1 call to Sys::Info::BEGIN@4
# spent 28µs making 1 call to vars::import |
5 | 2 | 19µs | 2 | 45µs | # spent 26µs (7+19) within Sys::Info::BEGIN@5 which was called:
# once (7µs+19µs) by Benchmark::Perl::Formance::BEGIN@21 at line 5 # spent 26µs making 1 call to Sys::Info::BEGIN@5
# spent 19µs making 1 call to Exporter::import |
6 | 2 | 109µs | 2 | 1.43ms | # spent 1.38ms (630µs+745µs) within Sys::Info::BEGIN@6 which was called:
# once (630µs+745µs) by Benchmark::Perl::Formance::BEGIN@21 at line 6 # spent 1.38ms making 1 call to Sys::Info::BEGIN@6
# spent 52µs making 1 call to Exporter::import |
7 | 2 | 63µs | 2 | 4.74ms | # spent 2.37ms (10µs+2.36) within Sys::Info::BEGIN@7 which was called:
# once (10µs+2.36ms) by Benchmark::Perl::Formance::BEGIN@21 at line 7 # spent 2.37ms making 1 call to Sys::Info::BEGIN@7
# spent 2.36ms making 1 call to base::import |
8 | |||||
9 | 1 | 500ns | $VERSION = '0.78'; | ||
10 | 1 | 600ns | @EXPORT_OK = qw( OSID ); | ||
11 | |||||
12 | 1 | 6µs | 2 | 10µs | __PACKAGE__->_mk_object( $_ ) for qw( OS Device ); # spent 10µs making 2 calls to Sys::Info::_mk_object, avg 5µs/call |
13 | |||||
14 | # spent 5µs within Sys::Info::import which was called:
# once (5µs+0s) by Benchmark::Perl::Formance::BEGIN@21 at line 21 of lib/Benchmark/Perl/Formance.pm | ||||
15 | 1 | 700ns | my($class, @names) = @_; | ||
16 | 1 | 400ns | my $caller = caller; | ||
17 | 1 | 2µs | my %cache = map { $_ => 1 } @EXPORT_OK; | ||
18 | 2 | 311µs | 2 | 27µs | # spent 17µs (7+10) within Sys::Info::BEGIN@18 which was called:
# once (7µs+10µs) by Benchmark::Perl::Formance::BEGIN@21 at line 18 # spent 17µs making 1 call to Sys::Info::BEGIN@18
# spent 10µs making 1 call to strict::unimport |
19 | 1 | 700ns | foreach my $name ( @names ) { | ||
20 | croak "Bogus import: $name" if not $class->can($name); | ||||
21 | croak "Caller already has the $name method" if $caller->can($name); | ||||
22 | croak "Access denied for $name" if not exists $cache{$name}; | ||||
23 | *{ $caller . q{::} . $name } = *{ $class . q{::} . $name }; | ||||
24 | } | ||||
25 | 1 | 4µs | return; | ||
26 | } | ||||
27 | |||||
28 | sub new { | ||||
29 | my $class = shift; | ||||
30 | my $self = {}; | ||||
31 | bless $self, $class; | ||||
32 | return $self; | ||||
33 | } | ||||
34 | |||||
35 | sub perl { return defined $^V ? sprintf( '%vd', $^V ) : _legacy_perl( $] ) } | ||||
36 | |||||
37 | sub perl_build { | ||||
38 | return 0 if OSID ne 'Windows'; | ||||
39 | require Win32 if $] >= 5.006; | ||||
40 | return 0 if not defined &Win32::BuildNumber; | ||||
41 | return Win32::BuildNumber(); | ||||
42 | } | ||||
43 | |||||
44 | sub perl_long { return join q{.}, perl(), perl_build() } | ||||
45 | |||||
46 | sub httpd { | ||||
47 | my $self = shift; | ||||
48 | my $server = $ENV{SERVER_SOFTWARE} || return; | ||||
49 | |||||
50 | if ( $server =~ m{\A Microsoft\-IIS/ (.+?) \z}xms ) { | ||||
51 | return 'Microsoft Internet Information Server ' . $1; | ||||
52 | } | ||||
53 | |||||
54 | if ( $server =~ m{\A (Apache)/(.+?) \z}xmsi ) { | ||||
55 | my $apache = $1; | ||||
56 | my @data = split /\s+/xms, $2; | ||||
57 | my $v = shift @data; | ||||
58 | my @mods; | ||||
59 | my($mn, $mv); | ||||
60 | foreach my $e (@data) { | ||||
61 | next if $e =~ m{ \A \( .+? \) \z}xms; | ||||
62 | ($mn,$mv) = split m{/}xms, $e; | ||||
63 | $mn =~ s{ \-(.+?) \z }{}xms; | ||||
64 | push @mods, $mn .'(' . $mv . ')'; | ||||
65 | } | ||||
66 | return "$apache $v. Modules: " . join q{ }, @mods; | ||||
67 | } | ||||
68 | |||||
69 | return $server; | ||||
70 | } | ||||
71 | |||||
72 | # ------------------------[ P R I V A T E ]------------------------ # | ||||
73 | |||||
74 | # spent 10µs within Sys::Info::_mk_object which was called 2 times, avg 5µs/call:
# 2 times (10µs+0s) by Benchmark::Perl::Formance::BEGIN@21 at line 12, avg 5µs/call | ||||
75 | 2 | 600ns | my $self = shift; | ||
76 | 2 | 500ns | my $name = shift || croak '_mk_object() needs a name'; | ||
77 | 2 | 107µs | 2 | 27µs | # spent 18µs (9+9) within Sys::Info::BEGIN@77 which was called:
# once (9µs+9µs) by Benchmark::Perl::Formance::BEGIN@21 at line 77 # spent 18µs making 1 call to Sys::Info::BEGIN@77
# spent 9µs making 1 call to strict::unimport |
78 | *{ lc $name } = sub { | ||||
79 | shift->load_module( 'Sys::Info::' . $name )->new( @_ ); | ||||
80 | 2 | 6µs | }; | ||
81 | 2 | 6µs | return; | ||
82 | } | ||||
83 | |||||
84 | sub _legacy_perl { # function | ||||
85 | my $v = shift or return; | ||||
86 | my($rev, $patch_sub) = split m{[.]}xms, $v; | ||||
87 | $patch_sub =~ s{[0_]}{}xmsg; | ||||
88 | my @v = split m{}xms, $patch_sub; | ||||
89 | return sprintf '%d.%d.%d', $rev, $v[0], $v[1] || '0'; | ||||
90 | } | ||||
91 | |||||
92 | 1 | 4µs | 1; | ||
93 | |||||
94 | __END__ |