burak / CPAN-Sys-Info-Driver-Unknown
Compatibility layer for Sys::Info (Perl)
Clone this repository (size: 42.3 KB): HTTPS / SSH
$ hg clone http://bitbucket.org/burak/cpan-sys-info-driver-unknown/
Changed (Δ454 bytes):
raw changeset »
Changes (2 lines added, 0 lines removed)
lib/Sys/Info/Driver/Unknown.pm (1 lines added, 1 lines removed)
lib/Sys/Info/Driver/Unknown/Device/CPU.pm (21 lines added, 32 lines removed)
lib/Sys/Info/Driver/Unknown/Device/CPU/Env.pm (36 lines added, 34 lines removed)
1 |
1 |
Revision history for Perl extension Sys::Info::Driver::Unknown. |
2 |
2 |
|
3 |
3 |
Time zone is GMT+2. |
4 |
0.69_02 Thu Mar 12 04:32:14 2009 |
|
5 |
=> CPU fix. |
|
4 |
6 |
|
5 |
7 |
0.69_01 Thu Mar 5 03:10:17 2009 |
6 |
8 |
=> Separation from Sys::Info. |
Up to file-list lib/Sys/Info/Driver/Unknown.pm:
| … | … | @@ -2,7 +2,7 @@ package Sys::Info::Driver::Unknown; |
2 |
2 |
use strict; |
3 |
3 |
use vars qw( $VERSION ); |
4 |
4 |
|
5 |
$VERSION = '0.69_0 |
|
5 |
$VERSION = '0.69_02'; |
|
6 |
6 |
|
7 |
7 |
1; |
8 |
8 |
Up to file-list lib/Sys/Info/Driver/Unknown/Device/CPU.pm:
1 |
1 |
package Sys::Info::Driver::Unknown::Device::CPU; |
2 |
2 |
use strict; |
3 |
use vars qw($VERSION |
|
3 |
use vars qw($VERSION $UP); |
|
4 |
4 |
use base qw(Sys::Info::Driver::Unknown::Device::CPU::Env); |
5 |
5 |
|
6 |
6 |
$VERSION = '0.69_01'; |
7 |
7 |
|
8 |
8 |
BEGIN { |
9 |
9 |
local $SIG{__DIE__}; |
10 |
local $@; |
|
10 |
11 |
eval { |
11 |
12 |
require Unix::Processors; |
12 |
13 |
Unix::Processors->import; |
13 |
1; |
|
14 |
14 |
}; |
15 |
my $UP = $@ ? 0 : 1; |
|
16 |
*_UPOK = sub {$UP}; |
|
15 |
$UP = Unix::Processors->new if ! $@; |
|
17 |
16 |
} |
18 |
17 |
|
19 |
18 |
sub load {0} |
20 |
19 |
|
21 |
20 |
sub identify { |
22 |
21 |
my $self = shift; |
23 |
return $self->_serve_from_cache(wantarray) if $self->{CACHE}; |
|
24 |
||
25 |
my @cpu; |
|
26 |
if ( _UPOK ) { |
|
27 |
my $up = Unix::Processors->new; |
|
28 |
foreach my $proc ( @{ $up->processors } ) { |
|
29 |
push @cpu, { |
|
30 |
||
31 |
data_width => undef, |
|
32 |
address_width => undef, |
|
33 |
bus_speed => undef, |
|
34 |
speed => $proc->clock, |
|
35 |
name => $proc->type, |
|
36 |
family => undef, |
|
37 |
manufacturer => undef, |
|
38 |
model => undef, |
|
39 |
stepping => undef, |
|
40 |
number_of_cores => $up->max_physical, |
|
41 |
number_of_logical_processors => $up->max_online, |
|
42 |
L1_cache => undef, |
|
43 |
flags => undef, |
|
44 |
}; |
|
45 |
} |
|
46 |
} else { |
|
47 |
@cpu = $self->SUPER::identify(@_); |
|
48 |
} |
|
49 |
||
50 |
$self->{CACHE} = [ @cpu ]; |
|
22 |
$self->{META_DATA} ||= [ |
|
23 |
!$UP ? $self->SUPER::identify(@_) : map {{ |
|
24 |
||
25 |
data_width => undef, |
|
26 |
address_width => undef, |
|
27 |
bus_speed => undef, |
|
28 |
speed => $_->clock, |
|
29 |
name => $_->type, |
|
30 |
family => undef, |
|
31 |
manufacturer => undef, |
|
32 |
model => undef, |
|
33 |
stepping => undef, |
|
34 |
number_of_cores => $UP->max_physical, |
|
35 |
number_of_logical_processors => $UP->max_online, |
|
36 |
L1_cache => undef, |
|
37 |
flags => undef, |
|
38 |
}} @{ $UP->processors } |
|
39 |
]; |
|
51 |
40 |
return $self->_serve_from_cache(wantarray); |
52 |
41 |
} |
53 |
42 |
Up to file-list lib/Sys/Info/Driver/Unknown/Device/CPU/Env.pm:
| … | … | @@ -8,47 +8,49 @@ my(%INTEL, %AMD, %OTHER_ID, %OTHER, %CPU |
8 |
8 |
|
9 |
9 |
sub identify { |
10 |
10 |
my $self = shift; |
11 |
return $self->_serve_from_cache(wantarray) if $self->{CACHE}; |
|
12 |
$self->_INSTALL() if not $INSTALLED; |
|
13 |
11 |
|
14 |
if ( not $CPU{id} ) { |
|
15 |
$self->{CACHE} = []; # fake |
|
16 |
return; |
|
17 |
} |
|
12 |
if ( ! $self->{META_DATA} ) { |
|
13 |
$self->_INSTALL() if not $INSTALLED; |
|
18 |
14 |
|
19 |
my($cpu, $count, @cpu); |
|
20 |
if ($CPU{id} =~ /(.+?), (?:Genuine(Intel)|Authentic(AMD))/) { |
|
21 |
my $cid = $1; |
|
22 |
my $corp = $2 || $3; |
|
23 |
if ( my %info = $self->_parse( $cid ) ) { |
|
24 |
if ( my $mn = $self->_corp( $corp, $info{Family} ) ) { |
|
25 |
if ( my $name = $mn->{ $info{Model} } ) { |
|
26 |
$count = ($CPU{number} && $CPU{number} > 1) ? $CPU{number} : ''; |
|
27 |
|
|
15 |
if ( not $CPU{id} ) { |
|
16 |
$self->{META_DATA} = []; # fake |
|
17 |
return; |
|
18 |
} |
|
19 |
||
20 |
my($cpu, $count, @cpu); |
|
21 |
if ($CPU{id} =~ /(.+?), (?:Genuine(Intel)|Authentic(AMD))/) { |
|
22 |
my $cid = $1; |
|
23 |
my $corp = $2 || $3; |
|
24 |
if ( my %info = $self->_parse( $cid ) ) { |
|
25 |
if ( my $mn = $self->_corp( $corp, $info{Family} ) ) { |
|
26 |
if ( my $name = $mn->{ $info{Model} } ) { |
|
27 |
$count = ($CPU{number} && $CPU{number} > 1) ? $CPU{number} : ''; |
|
28 |
$cpu = "$corp $name"; |
|
29 |
} |
|
28 |
30 |
} |
29 |
31 |
} |
30 |
32 |
} |
33 |
||
34 |
foreach my $other (keys %OTHER_ID) { |
|
35 |
if ($CPU{id} =~ /\Q$other/) { |
|
36 |
$cpu = $OTHER_ID{$other}; |
|
37 |
} |
|
38 |
} |
|
39 |
||
40 |
$count = 1 if not $count; |
|
41 |
for ( 1..$count ) { |
|
42 |
push @cpu, { |
|
43 |
architecture => ($CPU{id} =~ m{ \A (.+?) \s? Family }xmsi), |
|
44 |
data_width => undef, |
|
45 |
speed => undef, |
|
46 |
bus_speed => undef, |
|
47 |
address_width => undef, |
|
48 |
name => $cpu, |
|
49 |
}; |
|
50 |
} |
|
51 |
$self->{META_DATA} = [@cpu]; |
|
31 |
52 |
} |
32 |
53 |
|
33 |
foreach my $other (keys %OTHER_ID) { |
|
34 |
if ($CPU{id} =~ /\Q$other/) { |
|
35 |
$cpu = $OTHER_ID{$other}; |
|
36 |
} |
|
37 |
} |
|
38 |
||
39 |
$count = 1 if not $count; |
|
40 |
for ( 1..$count ) { |
|
41 |
push @cpu, { |
|
42 |
architecture => ($CPU{id} =~ m{ \A (.+?) \s? Family }xmsi), |
|
43 |
data_width => undef, |
|
44 |
speed => undef, |
|
45 |
bus_speed => undef, |
|
46 |
address_width => undef, |
|
47 |
name => $cpu, |
|
48 |
}; |
|
49 |
} |
|
50 |
$self->{CACHE} = [@cpu]; |
|
51 |
||
52 |
54 |
return $self->_serve_from_cache(wantarray); |
53 |
55 |
} |
54 |
56 |