Linux-Info
view release on metacpan or search on metacpan
lib/Linux/Info/ProcStats.pm view on Meta::CPAN
$self{files}{$file} = $opts->{files}->{$file};
}
return bless \%self, $class;
}
sub init {
my $self = shift;
if ( $self->{initfile} && -r $self->{initfile} ) {
$self->{init} = YAML::XS::LoadFile( $self->{initfile} );
$self->{time} = delete $self->{init}->{time};
}
else {
$self->{time} = Time::HiRes::gettimeofday();
$self->{init} = $self->_load;
}
}
sub get {
my $self = shift;
my $class = ref $self;
if ( !exists $self->{init} ) {
croak "$class: there are no initial statistics defined";
}
$self->{stats} = $self->_load;
$self->_deltas;
if ( $self->{initfile} ) {
$self->{init}->{time} = $self->{time};
YAML::XS::DumpFile( $self->{initfile}, $self->{init} );
}
return $self->{stats};
}
sub raw {
my $self = shift;
my $stat = $self->_load;
return $stat;
}
#
# private stuff
#
sub _load {
my $self = shift;
my $class = ref $self;
my $file = $self->{files};
my $lavg = $self->_procs;
my $filename =
$file->{path} ? "$file->{path}/$file->{loadavg}" : $file->{loadavg};
open my $fh, '<', $filename
or croak "$class: unable to open $filename ($!)";
( $lavg->{runqueue}, $lavg->{count} ) =
( split m@/@, ( split /\s+/, <$fh> )[3] );
close($fh);
return $lavg;
}
sub _procs {
my $self = shift;
my $class = ref $self;
my $file = $self->{files};
my %stat = ();
my $filename =
$file->{path} ? "$file->{path}/$file->{stat}" : $file->{stat};
open my $fh, '<', $filename
or croak "$class: unable to open $filename ($!)";
while ( my $line = <$fh> ) {
if ( $line =~ /^processes\s+(\d+)/ ) {
$stat{new} = $1;
}
elsif ( $line =~ /^procs_(blocked|running)\s+(\d+)/ ) {
$stat{$1} = $2;
}
}
close($fh);
return \%stat;
}
sub _deltas {
my $self = shift;
my $class = ref $self;
my $istat = $self->{init};
my $lstat = $self->{stats};
my $time = Time::HiRes::gettimeofday();
my $delta = sprintf( '%.2f', $time - $self->{time} );
$self->{time} = $time;
if ( !defined $istat->{new} || !defined $lstat->{new} ) {
croak "$class: not defined key found 'new'";
}
if ( $istat->{new} !~ /^\d+\z/ || $lstat->{new} !~ /^\d+\z/ ) {
croak "$class: invalid value for key 'new'";
}
my $new_init = $lstat->{new};
if ( $lstat->{new} == $istat->{new} || $istat->{new} > $lstat->{new} ) {
$lstat->{new} = sprintf( '%.2f', 0 );
}
elsif ( $delta > 0 ) {
$lstat->{new} =
sprintf( '%.2f', ( $new_init - $istat->{new} ) / $delta );
}
else {
$lstat->{new} = sprintf( '%.2f', $new_init - $istat->{new} );
}
$istat->{new} = $new_init;
}
( run in 1.182 second using v1.01-cache-2.11-cpan-71847e10f99 )