File Coverage

blib/lib/Linux/stat.pm

Criterion	Covered	Total	%
statement	32	71	45.0
branch	23	44	52.2
condition	2	11	18.1
subroutine	2	3	66.6
pod	0	2	0.0
total	59	131	45.0

#######################################################################
#                                                                     #
# Linux::stat                                                         #
#                                                                     #
#   Extract data from /proc/stat                                      #
#   Supported kernels: 2.4.x, 2.2.x (don't know about others)         #
#                                                                     #
#######################################################################

package Linux::stat;

$VERSION = "1.00";

require 5.000;
use strict;

my $kernel = `uname -r`;
$kernel =~ s/^(\d+\.\d+)\..*/$1/;

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $this = {
    stat => "/proc/stat",
    @_,
  };
  die "Unable to read ".$this->{stat}.", stopped" unless -r $this->{stat};
  $this = bless $this, $class;
  return $this;
}

sub stat {
  my $this = shift;
  my $stat;
  if (defined $this) {
    if (ref($this)) {
      $stat = $this->{stat};
    } else {
      $stat = $this;
    }
  } else {
    $stat = "/proc/stat";
  }
  die "Unable to read $stat, stopped" unless -r $stat;
  open(STAT, $stat);
  my %result = ();
  if ($kernel < 2.4) {
    $result{disks} = [];
    foreach (0..3) {
      my $tmpHash = {
        major => 0,
        disk => $_,
        io => 0,
        read_count => 0,
        read_sectors => 0,
        write_count => 0,
        write_sectors => 0,
      };
      push @{$result{disks}}, $tmpHash;
    }
  }
  foreach () {
    chomp($_);
    next unless /^([^\s:]+):?\s+(.+)$/;
    my ($desc, $data) = ($1, $2);
    $desc =~ tr/A-Z/a-z/;
    if ($desc =~ /^cpu(\d*)$/) {
      my ($user, $nice, $system, $idle) = split(/ /, $data);
      $result{$desc} = {
        user => $user / 100,
        nice => $nice / 100,
        system => $system / 100,
        idle => $idle / 100,
      };
      $result{uptime} = ($user + $nice + $system + $idle) / 100 if $desc eq "cpu";
    } elsif ($desc eq "page") {
      my @pgs = split(/\s+/, $data);
      ($result{pages_in}, $result{pages_out}) = @pgs;
    } elsif ($desc eq "swap") {
      my @swps = split(/\s+/, $data);
      ($result{swap_pages_in}, $result{swap_pages_out}) = @swps;
    } elsif ($desc eq "intr") {
      my @irqs = split(/\s+/, $data);
      $result{interrupts_total} = shift @irqs;
      $result{interrupts} = [@irqs];
    } elsif (($desc eq "disk_io") && ($kernel >= 2.4)) {
      my @disks = split(/\s+/, $data);
      my @diskResult;
      my $tot = $result{disks_io};
      foreach (@disks) {
        next unless /^\((\d+),(\d+)\):\((\d+),(\d+),(\d+),(\d+),(\d+)\)$/;
        my $currDisk = {
          major => $1,
          disk => $2,
          io => $3,
          read_count => $4,
          read_sectors => $5,
          write_count => $6,
          write_sectors => $7,
        };
        push @diskResult, $currDisk;
        if (defined $tot) {
          foreach (keys %$currDisk) {
            $tot->{$_} += $currDisk->{$_};
          }
        } else {
          %$tot = %$currDisk;
        }
      }
      push @{$result{disks}}, @diskResult;
      delete $tot->{major};
      delete $tot->{disk};
      $result{disks_io} = $tot;
    } elsif (($desc =~ /^disk(_(rio|wio|rblk|wblk))?$/) && ($kernel < 2.4)) {
      my @diskData = split(/ /, $data);
      next if @diskData < 4;
      $desc = {
        "" => "io",
        "rio" => "read_count", "wio" => "write_count",
        "rblk" => "read_sectors", "wblk" => "write_sectors",
      }->{$2 || ""};
      foreach (0..3) {
        $result{disks}->[$_]->{$desc} = $diskData[$_];
      }
    } elsif ($desc eq "ctxt") {
      next unless $data =~ /^(\d+)/;
      $result{context_switch} = $1;
    } elsif ($desc eq "btime") {
      next unless $data =~ /^(\d+)/;
      $result{boot_timestamp} = $1;
    } elsif ($desc eq "processes") {
      next unless $data =~ /^(\d+)/;
      $result{total_forks} = $1;
    } else {
      $result{$desc} = $data;
      next;
    }
  }
  return \%result;
}

1;

__END__