—

              
HideShow 74 lines of Pod
=head1 NAME
Sys::Statistics::Linux::SysInfo - Collect linux system informations.
=head1 SYNOPSIS
   use Sys::Statistics::Linux::SysInfo;
   my $lxs   = new Sys::Statistics::Linux::SysInfo;
   my $stats = $lxs->get;
=head1 DESCRIPTION
This module collects statistics by the virtual F</proc> filesystem (procfs) and is developed on default vanilla
kernels. It is tested on x86 hardware with the distributions SuSE (SuSE on s390 and s390x architecture as well),
Red Hat, Debian, Asianux, Slackware and Mandrake on kernel versions 2.4 and 2.6 and should run on all linux
kernels with a default vanilla kernel as well. It is possible that this module doesn't run on all distributions
if the procfs is too much changed.
Further it is necessary to run it as a user with the authorization to read the F</proc> filesystem.
=head1 SYSTEM INFOMATIONS
Generated by F</proc/sys/kernel/{hostname,domainname,ostype,osrelease,version}>
and F</proc/cpuinfo>, F</proc/meminfo>, F</proc/uptime>.
   hostname   -  This is the host name.
   domain     -  This is the host domain name.
   kernel     -  This is the kernel name.
   release    -  This is the release number.
   version    -  This is the version number.
   memtotal   -  The total size of memory.
   swaptotal  -  The total size of swap space.
   countcpus  -  The total (maybe logical) number of CPUs.
   uptime     -  This is the uptime of the system.
   idletime   -  This is the idle time of the system.
=head1 METHODS
=head2 new()
Call C<new()> to create a new object.
   my $lxs = new Sys::Statistics::Linux::SysInfo;
=head2 get()
Call C<get()> to get the statistics. C<get()> returns the statistics as a hash reference.
   my $stats = $lxs->get;
=head1 EXPORTS
No exports.
=head1 SEE ALSO
B<proc(5)>
=head1 REPORTING BUGS
Please report all bugs to <jschulz.cpan(at)bloonix.de>.
=head1 AUTHOR
Jonny Schulz <jschulz.cpan(at)bloonix.de>.
=head1 COPYRIGHT
Copyright (c) 2006, 2007 by Jonny Schulz. All rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut
package Sys::Statistics::Linux::SysInfo;
our $VERSION = '0.02';
use strict;
use warnings;
use IO::File;
use Carp qw(croak);
sub new {
   return bless {
      files => {
         meminfo    => '/proc/meminfo',
         sysinfo    => '/proc/sysinfo',
         cpuinfo    => '/proc/cpuinfo',
         uptime     => '/proc/uptime',
         hostname   => '/proc/sys/kernel/hostname',
         domain     => '/proc/sys/kernel/domainname',
         kernel     => '/proc/sys/kernel/ostype',
         release    => '/proc/sys/kernel/osrelease',
         version    => '/proc/sys/kernel/version',
      },
      stats => {},
   }, shift;
}
sub get {
   my $self = shift;
   $self->{stats} = $self->_load;
   return $self->{stats};
}
#
# private stuff
#
sub _load {
   my $self  = shift;
   my $class = ref $self;
   my $file  = $self->{files};
   my $stats = $self->{stats};
   my $fh    = new IO::File;
   for my $x (qw(hostname domain kernel release version)) {
      $fh->open($file->{$x}, 'r') or croak "$class: unable to open $file->{$x} ($!)";
      $stats->{$x} = <$fh>;
      $fh->close;
   }
   $fh->open($file->{meminfo}, 'r') or croak "$class: unable to open $file->{meminfo} ($!)";
   while (my $line = <$fh>) {
      if ($line =~ /^MemTotal:\s+(\d+ \w+)/) {
         $stats->{memtotal} = $1;
      } elsif ($line =~ /^SwapTotal:\s+(\d+ \w+)/) {
         $stats->{swaptotal} = $1;
      }
   }
   $fh->close;
   $stats->{countcpus} = 0;
   $fh->open($file->{cpuinfo}, 'r') or croak "$class: unable to open $file->{cpuinfo} ($!)";
   while (my $line = <$fh>) {
      if ($line =~ /^processor\s*:\s*\d+/) {            # x86
         $stats->{countcpus}++;
      } elsif ($line =~ /^# processors\s*:\s*(\d+)/) {  # s390
         $stats->{countcpus} = $1;
         last;
      }
   }
   $fh->close;
   $fh->open($file->{uptime}, 'r') or croak "$class: unable to open $file->{uptime} ($!)";
   foreach my $x (split /\s+/, <$fh>) {
      my ($d, $h, $m, $s) = $class->_calsec(sprintf('%li', $x));
      unless (defined $stats->{uptime}) {
         $stats->{uptime} = "${d}d ${h}h ${m}m ${s}s";
         next;
      }
      $stats->{idletime} = "${d}d ${h}h ${m}m ${s}s";
   }
   $fh->close;
   foreach my $key (keys %{$stats}) {
      chomp $stats->{$key};
      $stats->{$key} =~ s/\t+/ /g;
      $stats->{$key} =~ s/\s+/ /g;
   }
   return $stats;
}
sub _calsec {
   my $class = 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;