Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Sys/Info/Base.pm |
Statements | Executed 22 statements in 780µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 524µs | 1.33ms | BEGIN@5 | Sys::Info::Base::
1 | 1 | 1 | 10µs | 20µs | BEGIN@2 | Sys::Info::Base::
1 | 1 | 1 | 7µs | 25µs | BEGIN@6 | Sys::Info::Base::
1 | 1 | 1 | 7µs | 10µs | BEGIN@3 | Sys::Info::Base::
1 | 1 | 1 | 7µs | 138µs | BEGIN@8 | Sys::Info::Base::
1 | 1 | 1 | 6µs | 28µs | BEGIN@12 | Sys::Info::Base::
1 | 1 | 1 | 6µs | 23µs | BEGIN@4 | Sys::Info::Base::
1 | 1 | 1 | 6µs | 32µs | BEGIN@9 | Sys::Info::Base::
1 | 1 | 1 | 6µs | 6µs | BEGIN@7 | Sys::Info::Base::
0 | 0 | 0 | 0s | 0s | date2time | Sys::Info::Base::
0 | 0 | 0 | 0s | 0s | load_module | Sys::Info::Base::
0 | 0 | 0 | 0s | 0s | load_subclass | Sys::Info::Base::
0 | 0 | 0 | 0s | 0s | read_file | Sys::Info::Base::
0 | 0 | 0 | 0s | 0s | slurp | Sys::Info::Base::
0 | 0 | 0 | 0s | 0s | trim | Sys::Info::Base::
0 | 0 | 0 | 0s | 0s | uname | Sys::Info::Base::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Sys::Info::Base; | ||||
2 | 2 | 18µs | 2 | 30µ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 # spent 20µs making 1 call to Sys::Info::Base::BEGIN@2
# spent 10µs making 1 call to strict::import |
3 | 2 | 18µs | 2 | 14µ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 # spent 10µs making 1 call to Sys::Info::Base::BEGIN@3
# spent 3µs making 1 call to warnings::import |
4 | 2 | 17µs | 2 | 40µ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 # spent 23µs making 1 call to Sys::Info::Base::BEGIN@4
# spent 17µs making 1 call to vars::import |
5 | 2 | 109µs | 2 | 1.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 # spent 1.33ms making 1 call to Sys::Info::Base::BEGIN@5
# spent 151µs making 1 call to Exporter::import |
6 | 2 | 19µs | 2 | 43µ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 # spent 25µs making 1 call to Sys::Info::Base::BEGIN@6
# spent 18µs making 1 call to Exporter::import |
7 | 2 | 19µs | 1 | 6µs | # spent 6µs within Sys::Info::Base::BEGIN@7 which was called:
# once (6µs+0s) by base::import at line 7 # spent 6µs making 1 call to Sys::Info::Base::BEGIN@7 |
8 | 2 | 28µs | 2 | 270µ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 # spent 138µs making 1 call to Sys::Info::Base::BEGIN@8
# spent 131µs making 1 call to Exporter::import |
9 | 1 | 9µs | 1 | 25µ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 # spent 25µs making 1 call to constant::import |
10 | . q{Native driver can not be loaded: %s. } | ||||
11 | 1 | 16µs | 1 | 32µs | . q{Falling back to compatibility mode}; # spent 32µs making 1 call to Sys::Info::Base::BEGIN@9 |
12 | 2 | 525µs | 2 | 50µ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 # spent 28µs making 1 call to Sys::Info::Base::BEGIN@12
# spent 22µs making 1 call to constant::import |
13 | |||||
14 | 1 | 700ns | $VERSION = '0.7804'; | ||
15 | |||||
16 | 1 | 200ns | my %LOAD_MODULE; # cache | ||
17 | 1 | 100ns | my %UNAME; # cache | ||
18 | |||||
19 | sub 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 | |||||
35 | sub 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 | |||||
53 | sub 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 | |||||
61 | sub 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 | |||||
76 | sub 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 | |||||
87 | sub 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 | |||||
121 | sub 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 | |||||
132 | 1 | 2µs | 1; | ||
133 | |||||
134 | __END__ |