Sys::Info::Driver::Linux::Device::CPU - Linux CPU Device Driver


Sys-Info-Driver-Linux documentation Contained in the Sys-Info-Driver-Linux distribution.

Index


Code Index:

NAME

Top

Sys::Info::Driver::Linux::Device::CPU - Linux CPU Device Driver

SYNOPSIS

Top

-

DESCRIPTION

Top

This document describes version 0.78 of Sys::Info::Driver::Linux::Device::CPU released on 17 April 2011.

Identifies the CPU with Unix::Processors, POSIX and /proc.

METHODS

Top

identify

See identify in Sys::Info::Device::CPU.

load

See load in Sys::Info::Device::CPU.

bitness

See bitness in Sys::Info::Device::CPU.

SEE ALSO

Top

Sys::Info, Sys::Info::Device::CPU, Unix::Processors, POSIX, proc filesystem.

AUTHOR

Top

Burak Gursoy <burak@cpan.org>.

COPYRIGHT

Top

LICENSE

Top

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available.


Sys-Info-Driver-Linux documentation Contained in the Sys-Info-Driver-Linux distribution.

package Sys::Info::Driver::Linux::Device::CPU;
use strict;
use warnings;
use vars qw($VERSION);
use base qw(Sys::Info::Base);
use Sys::Info::Driver::Linux;
use Unix::Processors;
use POSIX ();
use Carp qw( croak );

$VERSION = '0.78';

sub identify {
    my $self = shift;

    if ( ! $self->{META_DATA} ) {
        my $mach = $self->uname->{machine};
        my $arch = $mach =~ m{ i [0-9] 86 }xmsi ? 'x86'
                 : $mach =~ m{ ia64       }xmsi ? 'IA64'
                 : $mach =~ m{ x86_64     }xmsi ? 'AMD-64'
                 :                                 $mach
                 ;

        my @raw = split m{\n\n}xms,
                        $self->trim( $self->slurp( proc->{cpuinfo} ) );
        $self->{META_DATA} = [];
        foreach my $e ( @raw ) {
            push @{ $self->{META_DATA} },
                  { $self->_parse_cpuinfo($e), architecture => $arch };
        }
    }

    return $self->_serve_from_cache(wantarray);
}

sub bitness {
    my $self = shift;
    my @cpu  = $self->identify;
    my $flags = $cpu[0]->{flags};
    if ( $flags ) {
        my $lm = grep { $_ eq 'lm' } @{$flags};
        return '64' if $lm;
    }
    return $cpu[0]->{architecture} =~ m{64}xms ? '64' : '32';
}

sub load {
    my $self  = shift;
    my $level = shift;
    my @loads = split /\s+/xms, $self->slurp( proc->{loadavg} );
    return $loads[$level];
}

sub _parse_cpuinfo {
    my $self = shift;
    my $raw  = shift || croak 'Parser called without data';
    my($k, $v);
    my %cpu;
    foreach my $line (split /\n/xms, $raw) {
        ($k, $v) = split /\s+:\s+/xms, $line;
        $cpu{$k} = $v;
    }

    my @flags = $cpu{flags} ? (split /\s+/xms, $cpu{flags}) : ();
    my %flags = map { $_ => 1 } @flags;
    my $up    = Unix::Processors->new;
    my $name  = $cpu{'model name'};
    $name     =~ s[ \s{2,} ][ ]xms if $name;

    return(
        processor_id                 => $cpu{processor},
        data_width                   => $flags{lm} ? '64' : '32', # guess
        address_width                => $flags{lm} ? '64' : '32', # guess
        bus_speed                    => undef,
        speed                        => $cpu{'cpu MHz'},
        name                         => $name || q{},
        family                       => $cpu{'cpu family'},
        manufacturer                 => $cpu{vendor_id},
        model                        => $cpu{model},
        stepping                     => $cpu{stepping},
        number_of_cores              => $cpu{'cpu cores'} || $up->max_physical,
        number_of_logical_processors => $up->max_online,
        L2_cache                     => {max_cache_size => $cpu{'cache size'}},
        flags                        => @flags ? [ @flags ] : undef,
    );
}

1;

__END__