| 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 | Sys::Info::BEGIN@6 |
| 1 | 1 | 1 | 10µs | 21µs | Sys::Info::BEGIN@2 |
| 1 | 1 | 1 | 10µs | 2.37ms | Sys::Info::BEGIN@7 |
| 2 | 1 | 1 | 10µs | 10µs | Sys::Info::_mk_object |
| 1 | 1 | 1 | 9µs | 13µs | Sys::Info::BEGIN@3 |
| 1 | 1 | 1 | 9µs | 18µs | Sys::Info::BEGIN@77 |
| 1 | 1 | 1 | 7µs | 17µs | Sys::Info::BEGIN@18 |
| 1 | 1 | 1 | 7µs | 26µs | Sys::Info::BEGIN@5 |
| 1 | 1 | 1 | 6µs | 34µs | Sys::Info::BEGIN@4 |
| 1 | 1 | 1 | 5µs | 5µs | Sys::Info::import |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::__ANON__[:80] |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::_legacy_perl |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::httpd |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::new |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::perl |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::perl_build |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::perl_long |
| 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__ |