| 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 | Sys::Info::Base::BEGIN@5 |
| 1 | 1 | 1 | 10µs | 20µs | Sys::Info::Base::BEGIN@2 |
| 1 | 1 | 1 | 7µs | 25µs | Sys::Info::Base::BEGIN@6 |
| 1 | 1 | 1 | 7µs | 10µs | Sys::Info::Base::BEGIN@3 |
| 1 | 1 | 1 | 7µs | 138µs | Sys::Info::Base::BEGIN@8 |
| 1 | 1 | 1 | 6µs | 28µs | Sys::Info::Base::BEGIN@12 |
| 1 | 1 | 1 | 6µs | 23µs | Sys::Info::Base::BEGIN@4 |
| 1 | 1 | 1 | 6µs | 32µs | Sys::Info::Base::BEGIN@9 |
| 1 | 1 | 1 | 6µs | 6µs | Sys::Info::Base::BEGIN@7 |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::Base::date2time |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::Base::load_module |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::Base::load_subclass |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::Base::read_file |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::Base::slurp |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::Base::trim |
| 0 | 0 | 0 | 0s | 0s | Sys::Info::Base::uname |
| 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__ |