← Index
NYTProf Performance Profile   « line view »
For bin/benchmark-perlformance
  Run on Fri Apr 17 15:31:48 2015
Reported on Fri Apr 17 15:32:03 2015

Filename/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sys/Info/Base.pm
StatementsExecuted 22 statements in 780µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111524µs1.33msSys::Info::Base::::BEGIN@5Sys::Info::Base::BEGIN@5
11110µs20µsSys::Info::Base::::BEGIN@2Sys::Info::Base::BEGIN@2
1117µs25µsSys::Info::Base::::BEGIN@6Sys::Info::Base::BEGIN@6
1117µs10µsSys::Info::Base::::BEGIN@3Sys::Info::Base::BEGIN@3
1117µs138µsSys::Info::Base::::BEGIN@8Sys::Info::Base::BEGIN@8
1116µs28µsSys::Info::Base::::BEGIN@12Sys::Info::Base::BEGIN@12
1116µs23µsSys::Info::Base::::BEGIN@4Sys::Info::Base::BEGIN@4
1116µs32µsSys::Info::Base::::BEGIN@9Sys::Info::Base::BEGIN@9
1116µs6µsSys::Info::Base::::BEGIN@7Sys::Info::Base::BEGIN@7
0000s0sSys::Info::Base::::date2timeSys::Info::Base::date2time
0000s0sSys::Info::Base::::load_moduleSys::Info::Base::load_module
0000s0sSys::Info::Base::::load_subclassSys::Info::Base::load_subclass
0000s0sSys::Info::Base::::read_fileSys::Info::Base::read_file
0000s0sSys::Info::Base::::slurpSys::Info::Base::slurp
0000s0sSys::Info::Base::::trimSys::Info::Base::trim
0000s0sSys::Info::Base::::unameSys::Info::Base::uname
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Sys::Info::Base;
2218µs230µs
# spent 20µs (10+10) within Sys::Info::Base::BEGIN@2 which was called: # once (10µs+10µs) by base::import at line 2
use strict;
# spent 20µs making 1 call to Sys::Info::Base::BEGIN@2 # spent 10µs making 1 call to strict::import
3218µs214µs
# spent 10µs (7+3) within Sys::Info::Base::BEGIN@3 which was called: # once (7µs+3µs) by base::import at line 3
use warnings;
# spent 10µs making 1 call to Sys::Info::Base::BEGIN@3 # spent 3µs making 1 call to warnings::import
4217µs240µs
# spent 23µs (6+17) within Sys::Info::Base::BEGIN@4 which was called: # once (6µs+17µs) by base::import at line 4
use vars qw( $VERSION );
# spent 23µs making 1 call to Sys::Info::Base::BEGIN@4 # spent 17µs making 1 call to vars::import
52109µs21.48ms
# spent 1.33ms (524µs+804µs) within Sys::Info::Base::BEGIN@5 which was called: # once (524µs+804µs) by base::import at line 5
use IO::File;
# spent 1.33ms making 1 call to Sys::Info::Base::BEGIN@5 # spent 151µs making 1 call to Exporter::import
6219µs243µs
# spent 25µs (7+18) within Sys::Info::Base::BEGIN@6 which was called: # once (7µs+18µs) by base::import at line 6
use Carp qw( croak );
# spent 25µs making 1 call to Sys::Info::Base::BEGIN@6 # spent 18µs making 1 call to Exporter::import
7219µs16µs
# spent 6µs within Sys::Info::Base::BEGIN@7 which was called: # once (6µs+0s) by base::import at line 7
use File::Spec;
# spent 6µs making 1 call to Sys::Info::Base::BEGIN@7
8228µs2270µs
# spent 138µs (7+131) within Sys::Info::Base::BEGIN@8 which was called: # once (7µs+131µs) by base::import at line 8
use Sys::Info::Constants qw( :date OSID );
# spent 138µs making 1 call to Sys::Info::Base::BEGIN@8 # spent 131µs making 1 call to Exporter::import
919µs125µs
# spent 32µs (6+25) within Sys::Info::Base::BEGIN@9 which was called: # once (6µs+25µs) by base::import at line 11
use constant DRIVER_FAIL_MSG => q{Operating system identified as: '%s'. }
# spent 25µs making 1 call to constant::import
10 . q{Native driver can not be loaded: %s. }
11116µs132µs . q{Falling back to compatibility mode};
# spent 32µs making 1 call to Sys::Info::Base::BEGIN@9
122525µs250µs
# spent 28µs (6+22) within Sys::Info::Base::BEGIN@12 which was called: # once (6µs+22µs) by base::import at line 12
use constant YEAR_DIFF => 1900;
# spent 28µs making 1 call to Sys::Info::Base::BEGIN@12 # spent 22µs making 1 call to constant::import
13
141700ns$VERSION = '0.7804';
15
161200nsmy %LOAD_MODULE; # cache
171100nsmy %UNAME; # cache
18
19sub load_subclass { # hybrid: static+dynamic
20 my $self = shift;
21 my $template = shift || croak 'Template missing for load_subclass()';
22 my $class;
23
24 my $eok = eval { $class = $self->load_module( sprintf $template, OSID ); };
25
26 if ( $@ || ! $eok ) {
27 my $msg = sprintf DRIVER_FAIL_MSG, OSID, $@;
28 warn "$msg\n";
29 $class = $self->load_module( sprintf $template, 'Unknown' );
30 }
31
32 return $class;
33}
34
35sub load_module {
36 my $self = shift;
37 my $class = shift || croak 'No class name specified for load_module()';
38 return $class if $LOAD_MODULE{ $class };
39 croak "Invalid class name: $class" if ref $class;
40 (my $check = $class) =~ tr/a-zA-Z0-9_://d;
41 croak "Invalid class name: $class" if $check;
42 my @raw_file = split /::/xms, $class;
43 my $inc_file = join( q{/}, @raw_file) . '.pm';
44 return $class if exists $INC{ $inc_file };
45 my $file = File::Spec->catfile( @raw_file ) . '.pm';
46 my $eok = eval { require $file; };
47 croak "Error loading $class: $@" if $@ || ! $eok;
48 $LOAD_MODULE{ $class } = 1;
49 $INC{ $inc_file } = $file;
50 return $class;
51}
52
53sub trim {
54 my($self, $str) = @_;
55 return $str if ! $str;
56 $str =~ s{ \A \s+ }{}xms;
57 $str =~ s{ \s+ \z }{}xms;
58 return $str;
59}
60
61sub slurp { # fetches all data inside a flat file
62 my $self = shift;
63 my $file = shift;
64 my $msgerr = shift || 'I can not open file %s for reading: ';
65 my $FH = IO::File->new;
66 $FH->open( $file ) or croak sprintf($msgerr, $file) . $!;
67 my $slurped = do {
68 local $/;
69 my $rv = <$FH>;
70 $rv;
71 };
72 $FH->close;
73 return $slurped;
74}
75
76sub read_file {
77 my $self = shift;
78 my $file = shift;
79 my $msgerr = shift || 'I can not open file %s for reading: ';
80 my $FH = IO::File->new;
81 $FH->open( $file ) or croak sprintf( $msgerr, $file ) . $!;
82 my @flat = <$FH>;
83 $FH->close;
84 return @flat;
85}
86
87sub date2time { # date stamp to unix time stamp conversion
88 my $self = shift;
89 my $stamp = shift || croak 'No date input specified';
90 my($i, $j) = (0,0); # index counters
91 my %wdays = map { $_ => $i++ } DATE_WEEKDAYS;
92 my %months = map { $_ => $j++ } DATE_MONTHS;
93 my @junk = split /\s+/xms, $stamp;
94 my $reg = join q{|}, keys %wdays;
95
96 # remove until ve get a day name
97 while ( @junk && $junk[0] !~ m{ \A $reg \z }xmsi ) {
98 shift @junk;
99 }
100 return q{} if ! @junk;
101
102 my($wday, $month, $mday, $time, $zone, $year) = @junk;
103 my($hour, $min, $sec) = split /:/xms, $time;
104
105 require POSIX;
106 my $unix = POSIX::mktime(
107 $sec,
108 $min,
109 $hour,
110 $mday,
111 $months{$month},
112 $year - YEAR_DIFF,
113 $wdays{$wday},
114 DATE_MKTIME_YDAY,
115 DATE_MKTIME_ISDST,
116 );
117
118 return $unix;
119}
120
121sub uname {
122 my $self = shift;
123 %UNAME = do {
124 require POSIX;
125 my %u;
126 @u{ qw( sysname nodename release version machine ) } = POSIX::uname();
127 %u;
128 } if ! %UNAME;
129 return { %UNAME };
130}
131
13212µs1;
133
134__END__