$Sys::Info::Base::VERSION
=
'0.7807'
;
use
constant
DRIVER_FAIL_MSG
=>
q{Operating system identified as: '%s'. }
.
q{Native driver can not be loaded: %s. }
.
q{Falling back to compatibility mode}
;
my
%LOAD_MODULE
;
my
%UNAME
;
sub
load_subclass {
my
$self
=
shift
;
my
$template
=
shift
|| croak
'Template missing for load_subclass()'
;
my
$class
;
my
$eok
=
eval
{
$class
=
$self
->load_module(
sprintf
$template
, OSID ); };
if
( $@ || !
$eok
) {
my
$msg
=
sprintf
DRIVER_FAIL_MSG, OSID, $@;
warn
"$msg\n"
;
$class
=
$self
->load_module(
sprintf
$template
,
'Unknown'
);
}
return
$class
;
}
sub
load_module {
my
$self
=
shift
;
my
$class
=
shift
|| croak
'No class name specified for load_module()'
;
return
$class
if
$LOAD_MODULE
{
$class
};
croak
"Invalid class name: $class"
if
ref
$class
;
(
my
$check
=
$class
) =~
tr
/a-zA-Z0-9_://d;
croak
"Invalid class name: $class"
if
$check
;
my
@raw_file
=
split
/::/xms,
$class
;
my
$inc_file
=
join
(
q{/}
,
@raw_file
) .
'.pm'
;
return
$class
if
exists
$INC
{
$inc_file
};
my
$file
= File::Spec->catfile(
@raw_file
) .
'.pm'
;
my
$eok
=
eval
{
require
$file
; };
croak
"Error loading $class: $@"
if
$@ || !
$eok
;
$LOAD_MODULE
{
$class
} = 1;
$INC
{
$inc_file
} =
$file
;
return
$class
;
}
sub
trim {
my
(
$self
,
$str
) =
@_
;
return
$str
if
!
$str
;
$str
=~ s{ \A \s+ }{}xms;
$str
=~ s{ \s+ \z }{}xms;
return
$str
;
}
sub
slurp {
my
$self
=
shift
;
my
$file
=
shift
;
my
$msgerr
=
shift
||
'I can not open file %s for reading: '
;
my
$FH
= IO::File->new;
$FH
->
open
(
$file
) or croak
sprintf
(
$msgerr
,
$file
) . $!;
my
$slurped
=
do
{
local
$/;
my
$rv
= <
$FH
>;
$rv
;
};
$FH
->
close
;
return
$slurped
;
}
sub
read_file {
my
$self
=
shift
;
my
$file
=
shift
;
my
$msgerr
=
shift
||
'I can not open file %s for reading: '
;
my
$FH
= IO::File->new;
$FH
->
open
(
$file
) or croak
sprintf
(
$msgerr
,
$file
) . $!;
my
@flat
= <
$FH
>;
$FH
->
close
;
return
@flat
;
}
sub
date2time {
my
$self
=
shift
;
my
$stamp
=
shift
|| croak
'No date input specified'
;
my
(
$i
,
$j
) = (0,0);
my
%wdays
=
map
{
$_
=>
$i
++ } DATE_WEEKDAYS;
my
%months
=
map
{
$_
=>
$j
++ } DATE_MONTHS;
my
@junk
=
split
/\s+/xms,
$stamp
;
my
$reg
=
join
q{|}
,
keys
%wdays
;
while
(
@junk
&&
$junk
[0] !~ m{ \A
$reg
\z }xmsi ) {
shift
@junk
;
}
return
q{}
if
!
@junk
;
my
(
$wday
,
$month
,
$mday
,
$time
,
$zone
,
$year
) =
@junk
;
my
(
$hour
,
$min
,
$sec
) =
split
/:/xms,
$time
;
my
$unix
= POSIX::mktime(
$sec
,
$min
,
$hour
,
$mday
,
$months
{
$month
},
$year
- YEAR_DIFF,
$wdays
{
$wday
},
DATE_MKTIME_YDAY,
DATE_MKTIME_ISDST,
);
return
$unix
;
}
sub
uname {
my
$self
=
shift
;
%UNAME
=
do
{
my
%u
;
@u
{
qw( sysname nodename release version machine )
} = POSIX::uname();
%u
;
}
if
!
%UNAME
;
return
{
%UNAME
};
}
1;