line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sys::Info::Base; |
2
|
|
|
|
|
|
|
$Sys::Info::Base::VERSION = '0.7807'; |
3
|
1
|
|
|
1
|
|
527
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
25
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
511
|
use IO::File; |
|
1
|
|
|
|
|
8596
|
|
|
1
|
|
|
|
|
113
|
|
7
|
1
|
|
|
1
|
|
8
|
use Carp qw( croak ); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
39
|
|
8
|
1
|
|
|
1
|
|
6
|
use File::Spec; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
23
|
|
9
|
1
|
|
|
1
|
|
5
|
use Sys::Info::Constants qw( :date OSID ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
188
|
|
10
|
1
|
|
|
|
|
62
|
use constant DRIVER_FAIL_MSG => q{Operating system identified as: '%s'. } |
11
|
|
|
|
|
|
|
. q{Native driver can not be loaded: %s. } |
12
|
1
|
|
|
1
|
|
8
|
. q{Falling back to compatibility mode}; |
|
1
|
|
|
|
|
2
|
|
13
|
1
|
|
|
1
|
|
6
|
use constant YEAR_DIFF => 1900; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
998
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my %LOAD_MODULE; # cache |
16
|
|
|
|
|
|
|
my %UNAME; # cache |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub load_subclass { # hybrid: static+dynamic |
19
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
20
|
0
|
|
0
|
|
|
0
|
my $template = shift || croak 'Template missing for load_subclass()'; |
21
|
0
|
|
|
|
|
0
|
my $class; |
22
|
|
|
|
|
|
|
|
23
|
0
|
|
|
|
|
0
|
my $eok = eval { $class = $self->load_module( sprintf $template, OSID ); }; |
|
0
|
|
|
|
|
0
|
|
24
|
|
|
|
|
|
|
|
25
|
0
|
0
|
0
|
|
|
0
|
if ( $@ || ! $eok ) { |
26
|
0
|
|
|
|
|
0
|
my $msg = sprintf DRIVER_FAIL_MSG, OSID, $@; |
27
|
0
|
|
|
|
|
0
|
warn "$msg\n"; |
28
|
0
|
|
|
|
|
0
|
$class = $self->load_module( sprintf $template, 'Unknown' ); |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
0
|
|
|
|
|
0
|
return $class; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub load_module { |
35
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
36
|
1
|
|
33
|
|
|
5
|
my $class = shift || croak 'No class name specified for load_module()'; |
37
|
1
|
50
|
|
|
|
4
|
return $class if $LOAD_MODULE{ $class }; |
38
|
1
|
50
|
|
|
|
6
|
croak "Invalid class name: $class" if ref $class; |
39
|
1
|
|
|
|
|
5
|
(my $check = $class) =~ tr/a-zA-Z0-9_://d; |
40
|
1
|
50
|
|
|
|
4
|
croak "Invalid class name: $class" if $check; |
41
|
1
|
|
|
|
|
4
|
my @raw_file = split /::/xms, $class; |
42
|
1
|
|
|
|
|
5
|
my $inc_file = join( q{/}, @raw_file) . '.pm'; |
43
|
1
|
50
|
|
|
|
4
|
return $class if exists $INC{ $inc_file }; |
44
|
1
|
|
|
|
|
15
|
my $file = File::Spec->catfile( @raw_file ) . '.pm'; |
45
|
1
|
|
|
|
|
3
|
my $eok = eval { require $file; }; |
|
1
|
|
|
|
|
326
|
|
46
|
1
|
50
|
33
|
|
|
112
|
croak "Error loading $class: $@" if $@ || ! $eok; |
47
|
1
|
|
|
|
|
3
|
$LOAD_MODULE{ $class } = 1; |
48
|
1
|
|
|
|
|
3
|
$INC{ $inc_file } = $file; |
49
|
1
|
|
|
|
|
7
|
return $class; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub trim { |
53
|
1
|
|
|
1
|
1
|
5
|
my($self, $str) = @_; |
54
|
1
|
50
|
|
|
|
4
|
return $str if ! $str; |
55
|
1
|
|
|
|
|
7
|
$str =~ s{ \A \s+ }{}xms; |
56
|
1
|
|
|
|
|
6
|
$str =~ s{ \s+ \z }{}xms; |
57
|
1
|
|
|
|
|
5
|
return $str; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub slurp { # fetches all data inside a flat file |
61
|
1
|
|
|
1
|
1
|
88
|
my $self = shift; |
62
|
1
|
|
|
|
|
3
|
my $file = shift; |
63
|
1
|
|
50
|
|
|
7
|
my $msgerr = shift || 'I can not open file %s for reading: '; |
64
|
1
|
|
|
|
|
8
|
my $FH = IO::File->new; |
65
|
1
|
50
|
|
|
|
58
|
$FH->open( $file ) or croak sprintf($msgerr, $file) . $!; |
66
|
1
|
|
|
|
|
58
|
my $slurped = do { |
67
|
1
|
|
|
|
|
4
|
local $/; |
68
|
1
|
|
|
|
|
30
|
my $rv = <$FH>; |
69
|
1
|
|
|
|
|
7
|
$rv; |
70
|
|
|
|
|
|
|
}; |
71
|
1
|
|
|
|
|
11
|
$FH->close; |
72
|
1
|
|
|
|
|
24
|
return $slurped; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub read_file { |
76
|
1
|
|
|
1
|
1
|
4
|
my $self = shift; |
77
|
1
|
|
|
|
|
2
|
my $file = shift; |
78
|
1
|
|
50
|
|
|
6
|
my $msgerr = shift || 'I can not open file %s for reading: '; |
79
|
1
|
|
|
|
|
7
|
my $FH = IO::File->new; |
80
|
1
|
50
|
|
|
|
35
|
$FH->open( $file ) or croak sprintf( $msgerr, $file ) . $!; |
81
|
1
|
|
|
|
|
71
|
my @flat = <$FH>; |
82
|
1
|
|
|
|
|
6
|
$FH->close; |
83
|
1
|
|
|
|
|
23
|
return @flat; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub date2time { # date stamp to unix time stamp conversion |
87
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
88
|
1
|
|
33
|
|
|
5
|
my $stamp = shift || croak 'No date input specified'; |
89
|
1
|
|
|
|
|
3
|
my($i, $j) = (0,0); # index counters |
90
|
1
|
|
|
|
|
3
|
my %wdays = map { $_ => $i++ } DATE_WEEKDAYS; |
|
7
|
|
|
|
|
67
|
|
91
|
1
|
|
|
|
|
15
|
my %months = map { $_ => $j++ } DATE_MONTHS; |
|
12
|
|
|
|
|
26
|
|
92
|
1
|
|
|
|
|
11
|
my @junk = split /\s+/xms, $stamp; |
93
|
1
|
|
|
|
|
6
|
my $reg = join q{|}, keys %wdays; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# remove until ve get a day name |
96
|
1
|
|
66
|
|
|
61
|
while ( @junk && $junk[0] !~ m{ \A $reg \z }xmsi ) { |
97
|
1
|
|
|
|
|
13
|
shift @junk; |
98
|
|
|
|
|
|
|
} |
99
|
1
|
50
|
|
|
|
4
|
return q{} if ! @junk; |
100
|
|
|
|
|
|
|
|
101
|
1
|
|
|
|
|
5
|
my($wday, $month, $mday, $time, $zone, $year) = @junk; |
102
|
1
|
|
|
|
|
4
|
my($hour, $min, $sec) = split /:/xms, $time; |
103
|
|
|
|
|
|
|
|
104
|
1
|
|
|
|
|
535
|
require POSIX; |
105
|
|
|
|
|
|
|
my $unix = POSIX::mktime( |
106
|
|
|
|
|
|
|
$sec, |
107
|
|
|
|
|
|
|
$min, |
108
|
|
|
|
|
|
|
$hour, |
109
|
|
|
|
|
|
|
$mday, |
110
|
|
|
|
|
|
|
$months{$month}, |
111
|
|
|
|
|
|
|
$year - YEAR_DIFF, |
112
|
1
|
|
|
|
|
6401
|
$wdays{$wday}, |
113
|
|
|
|
|
|
|
DATE_MKTIME_YDAY, |
114
|
|
|
|
|
|
|
DATE_MKTIME_ISDST, |
115
|
|
|
|
|
|
|
); |
116
|
|
|
|
|
|
|
|
117
|
1
|
|
|
|
|
15
|
return $unix; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub uname { |
121
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
122
|
0
|
0
|
|
|
|
|
%UNAME = do { |
123
|
0
|
|
|
|
|
|
require POSIX; |
124
|
0
|
|
|
|
|
|
my %u; |
125
|
0
|
|
|
|
|
|
@u{ qw( sysname nodename release version machine ) } = POSIX::uname(); |
126
|
0
|
|
|
|
|
|
%u; |
127
|
|
|
|
|
|
|
} if ! %UNAME; |
128
|
0
|
|
|
|
|
|
return { %UNAME }; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
1; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
__END__ |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=pod |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=encoding UTF-8 |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head1 NAME |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
Sys::Info::Base |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=head1 VERSION |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
version 0.7807 |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=head1 SYNOPSIS |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
use base qw(Sys::Info::Base); |
150
|
|
|
|
|
|
|
#... |
151
|
|
|
|
|
|
|
sub foo { |
152
|
|
|
|
|
|
|
my $self = shift; |
153
|
|
|
|
|
|
|
my $data = $self->slurp("/foo/bar.txt"); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head1 DESCRIPTION |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Includes some common methods. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head1 NAME |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Sys::Info::Base - Base class for Sys::Info |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head1 METHODS |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=head2 load_module CLASS |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
Loads the module named with C<CLASS>. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=head2 load_subclass TEMPLATE |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
Loads the specified class via C<TEMPLATE>: |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
my $class = __PACKAGE__->load_subclass('Sys::Info::Driver::%s::OS'); |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
C<%s> will be replaced with C<OSID>. Apart from the template usage, it is |
177
|
|
|
|
|
|
|
the same as C<load_module>. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 trim STRING |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Returns the trimmed version of C<STRING>. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head2 slurp FILE |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Caches all contents of C<FILE> into a scalar and then returns it. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head2 read_file FILE |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Caches all contents of C<FILE> into an array and then returns it. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=head2 date2time DATE_STRING |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
Converts C<DATE_STRING> into unix timestamp. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head2 uname |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
Returns a hashref built from C<POSIX::uname>. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head1 SEE ALSO |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
L<Sys::Info>. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=head1 AUTHOR |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
Burak Gursoy <burak@cpan.org> |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
This software is copyright (c) 2006 by Burak Gursoy. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
212
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=cut |