File Coverage

blib/lib/Linux/Info/SysInfo.pm

Criterion	Covered	Total	%
statement	128	134	95.5
branch	42	58	72.4
condition	8	18	44.4
subroutine	15	15	100.0
pod	2	2	100.0
total	195	227	85.9

package Linux::Info::SysInfo;
use strict;
use warnings;
use Carp qw(croak);
use POSIX 1.15;
use Hash::Util qw(lock_keys);
use base 'Class::Accessor';
our $VERSION = '1.4'; # VERSION

my @_attribs =
  qw(raw_time hostname domain kernel release version mem swap pcpucount tcpucount interfaces arch proc_arch cpu_flags uptime idletime model);

__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_ro_accessors(@_attribs);

=head1 NAME

Linux::Info::SysInfo - Collect linux system information.

=head1 SYNOPSIS

    use Linux::Info::SysInfo;

    my $lxs  = Linux::Info::SysInfo->new;
    print $lxs->get_release(), "\n";

=head1 DESCRIPTION

Linux::Info::SysInfo gathers system information from the virtual F filesystem (procfs).

For more information read the documentation of the front-end module L.

This class interface is B with L.

=head1 ATTRIBUTES

Generated by F
and F, F, F, F.

These are the following attribute available for a instance of this class:

=over

=item *

hostname - The host name.

=item *

domain - The host domain name.

=item *

kernel - The kernel name.

=item *

release - The kernel release.

=item *

version - The kernel version.

=item *

mem - The total size of memory.

=item *

swap - The total size of swap space.

=item *

uptime - The uptime of the system.

=item *

idletime - The idle time of the system.

=item *

pcpucount - The total number of physical CPUs.

=item *

tcpucount - The total number of CPUs (cores, hyper threading).

=item *

interfaces - The interfaces of the system.

=item *

arch - The processor architecture (like C).

=item *

multithread - A boolean indicating if the process has hyper threading enabled or not.

=item *

model - the processor name

=back

C and C are really easy to understand. Both values
are collected from C. C is the number of physical
CPUs, counted by C. C is just the total number
counted by C.

All attributes are read-only. Their corresponding value can will be returned upon invocation of their respective "get_" method.

=head1 METHODS

=head2 new()

Call C to create a new object.

    my $lxs = Linux::Info::SysInfo->new();

Without any parameters.

If you want to get C and C as raw value, then pass the following hash reference as parameter:

    my $lxs = Linux::Info::SysInfo->new({ raw_time => 1});

By default the C attribute is false.

=head2 get_proc_arch

This method will return an integer as the architecture of the CPUs: 32 or 64 bits, depending on the flags
retrieve for one CPU.

It is assumed that all CPUs will have the same flags, so this method will consider only the flags returned
by the CPU with "core id" equal to 0 (in other words, the first CPU found).

=head2 get_cpu_flags

Returns an array reference with all flags retrieve from C using the same logic described in
C documentation.

=head2 is_multithread

A getter for the C attribute.

=head2 get_model

A getter for the C attribute.

=head1 EXPORTS

Nothing.

=head1 KNOWN ISSUES

Linux running on ARM processors have a different interface on /proc/cpuinfo. That means that the methods C and C
will not return their respective information. Tests for this module may fail as well.

=head1 SEE ALSO

=over

=item *

B

=item *

L

=item *

L

=item *

L

=back

=head1 AUTHOR

Alceu Rodrigues de Freitas Junior, [e-mail]

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 of Alceu Rodrigues de Freitas Junior, [e-mail]

This file is part of Linux Info project.

Linux-Info is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Linux-Info is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Linux Info.  If not, see .

=cut

sub new {

    my $class    = shift;
    my $opts_ref = shift;

    my $raw_time;

    (         ( ref($opts_ref) eq 'HASH' )
          and ( exists( $opts_ref->{raw_time} ) )
          and ( $opts_ref->{raw_time} =~ /^[01]$/ ) )
      ? ( $raw_time = $opts_ref->{raw_time} )
      : ( $raw_time = 0 );

    my %self = (
        files => {
            path     => "/proc",
            meminfo  => "meminfo",
            sysinfo  => "sysinfo",
            cpuinfo  => "cpuinfo",
            uptime   => "uptime",
            hostname => "sys/kernel/hostname",
            domain   => "sys/kernel/domainname",
            kernel   => "sys/kernel/ostype",
            release  => "sys/kernel/osrelease",
            version  => "sys/kernel/version",
            netdev   => "net/dev",
        },
        arch     => ( uname() )[4],
        raw_time => $raw_time,
    );

    my $self = bless \%self, $class;

    $self->_set();
    lock_keys( %{$self} );

    return $self;

}

sub _set {

    my $self  = shift;
    my $class = ref $self;
    my $file  = $self->{files};

    foreach my $attrib (@_attribs) {

        $self->{$attrib} = undef unless ( exists( $self->{$attrib} ) );

    }

    $self->_set_common;
    $self->_set_meminfo;
    $self->_set_time;
    $self->_set_interfaces;
    $self->_set_cpuinfo;

    foreach my $attrib (@_attribs) {

        if ( defined( $self->{attrib} ) ) {

            $self->{$attrib} =~ s/\t+/ /g;
            $self->{$attrib} =~ s/\s+/ /g;

        }

    }

}

sub is_multithread {

    my $self = shift;
    return $self->{multithread};

}

sub _set_common {

    my $self  = shift;
    my $class = ref($self);
    my $file  = $self->{files};

    for my $attrib (qw(hostname domain kernel release version)) {
        my $filename =
          $file->{path} ? "$file->{path}/$file->{$attrib}" : $file->{$attrib};
        open my $fh, '<', $filename
          or croak "$class: unable to open $filename: $!";
        $self->{$attrib} = <$fh>;
        chomp( $self->{$attrib} );
        close($fh);
    }

}

sub _set_meminfo {
    my $self  = shift;
    my $class = ref($self);
    my $file  = $self->{files};

    my $filename =
      $file->{path} ? "$file->{path}/$file->{meminfo}" : $file->{meminfo};
    open my $fh, '<', $filename
      or croak "$class: unable to open $filename ($!)";

    while ( my $line = <$fh> ) {
        if ( $line =~ /^MemTotal:\s+(\d+ \w+)/ ) {
            $self->{mem} = $1;
        }
        elsif ( $line =~ /^SwapTotal:\s+(\d+ \w+)/ ) {
            $self->{swap} = $1;
        }
    }

    close($fh);
}

sub _set_cpuinfo {
    my $self  = shift;
    my $class = ref($self);
    my $file  = $self->{files};
    my ( %cpu, $phyid );

    $self->{tcpucount} = 0;

    my $filename =
      $file->{path} ? "$file->{path}/$file->{cpuinfo}" : $file->{cpuinfo};
    open my $fh, '<', $filename
      or croak "$class: unable to open $filename ($!)";

    # default value for hyper threading
    $self->{multithread} = 0;

    # model name      : Intel(R) Core(TM) i5-4300M CPU @ 2.60GHz
    my $model_regex = qr/^model\sname\s+\:\s(.*)/;

    # Processor	: ARMv7 Processor rev 4 (v7l)
    my $arm_regex = qr/^Processor\s+\:\s(.*)/;

    while ( my $line = <$fh> ) {

        chomp($line);

      CASE: {

            if ( ( $line =~ $model_regex ) or ( $line =~ $arm_regex ) ) {

                $self->{model} = $1;

            }

            if ( $line =~ /^physical\s+id\s*:\s*(\d+)/ ) {
                $phyid = $1;
                $cpu{$phyid}{count}++;
                last CASE;
            }

            if ( $line =~ /^core\s+id\s*:\s*(\d+)/ ) {
                $cpu{$phyid}{cores}{$1}++;
                last CASE;
            }

            if ( $line =~ /^processor\s*:\s*\d+/ ) {    # x86
                $self->{tcpucount}++;
                last CASE;
            }

            if ( $line =~ /^# processors\s*:\s*(\d+)/ ) {    # s390
                $self->{tcpucount} = $1;
                last CASE;
            }

            if ( $line =~ /^flags\s+\:/ ) {

                last CASE if ( $self->get_cpu_flags );   # no use to repeat this

                my ( $attribute, $value ) = split( /\s+:\s/, $line );
                my @flags = split( /\s/, $value );

                $self->{cpu_flags} = \@flags;

                #long mode
                if ( $value =~ /\slm\s/ ) {

                    $self->{proc_arch} = 64;

                }
                else {

                    $self->{proc_arch} = 32;

                }

                #hyper threading
                if ( $value =~ /\sht\s/ ) {

                    $self->{multithread} = 1;

                }

                last CASE;

            }

        }

    }

    close($fh);

    $self->{pcpucount} = scalar( keys(%cpu) ) || $self->{tcpucount};
}

sub _set_interfaces {
    my $self  = shift;
    my $class = ref($self);
    my $file  = $self->{files};
    my @iface = ();

    my $filename =
      $file->{path} ? "$file->{path}/$file->{netdev}" : $file->{netdev};
    open my $fh, '<', $filename
      or croak "$class: unable to open $filename ($!)";
    { my $head = <$fh>; }

    while ( my $line = <$fh> ) {
        if ( $line =~ /^\s*(\w+):/ ) {
            push @iface, $1;
        }
    }

    close $fh;

    $self->{interfaces} = \@iface;

}

sub _set_time {
    my $self  = shift;
    my $class = ref($self);
    my $file  = $self->{files};

    my $filename =
      $file->{path} ? "$file->{path}/$file->{uptime}" : $file->{uptime};
    open my $fh, '<', $filename
      or croak "$class: unable to open $filename ($!)";
    ( $self->{uptime}, $self->{idletime} ) = split /\s+/, <$fh>;
    close $fh;

    unless ( $self->get_raw_time() ) {
        foreach my $time (qw/uptime idletime/) {
            my ( $d, $h, $m, $s ) =
              $self->_calsec( sprintf( '%li', $self->{$time} ) );
            $self->{$time} = "${d}d ${h}h ${m}m ${s}s";
        }
    }
}

sub _calsec {
    my $self = shift;
    my ( $s, $m, $h, $d ) = ( shift, 0, 0, 0 );
    $s >= 86400 and $d = sprintf( '%i', $s / 86400 ) and $s = $s % 86400;
    $s >= 3600  and $h = sprintf( '%i', $s / 3600 )  and $s = $s % 3600;
    $s >= 60    and $m = sprintf( '%i', $s / 60 )    and $s = $s % 60;
    return ( $d, $h, $m, $s );
}

1;