r30656 - in /trunk/libsys-statistics-linux-perl: ./ debian/ examples/ lib/Sys/Statistics/ lib/Sys/Statistics/Linux/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Fri Feb 13 13:44:37 UTC 2009
Author: gregoa
Date: Fri Feb 13 13:44:33 2009
New Revision: 30656
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=30656
Log:
New upstream release.
Modified:
trunk/libsys-statistics-linux-perl/ChangeLog
trunk/libsys-statistics-linux-perl/LICENCE
trunk/libsys-statistics-linux-perl/META.yml
trunk/libsys-statistics-linux-perl/README
trunk/libsys-statistics-linux-perl/debian/changelog
trunk/libsys-statistics-linux-perl/examples/diskusage.pl
trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux.pm
trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux/Compilation.pm
trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux/Processes.pm
trunk/libsys-statistics-linux-perl/t/120-processes.t
trunk/libsys-statistics-linux-perl/t/130-search.t
trunk/libsys-statistics-linux-perl/t/140-psfind.t
Modified: trunk/libsys-statistics-linux-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/ChangeLog?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/ChangeLog (original)
+++ trunk/libsys-statistics-linux-perl/ChangeLog Fri Feb 13 13:44:33 2009
@@ -1,3 +1,24 @@
+0.47 Released at 2009-02-10.
+ - GRML - forget to upgrade $VERSION in Processes.pm :)
+
+0.46 Released at 2009-02-10.
+ - Fixed a bug in Processs.pm. If /proc/<pid>/fd is empty then
+ t/120-processes.t returns an error.
+
+0.45 Released at 2009-02-02.
+ - Just a full release.
+
+0.44_03 Released at 2009-01-19.
+ - Fixed some tests.
+
+0.44_02 Released at 2009-01-18.
+ - Fixed a bug: delete a process if the process doesn't exists
+ any more and jump to the next PID with "next PID;".
+ - Fixed some tests.
+
+0.44_01 Released at 2009-01-13.
+ - Added "wchan" and "fd" to Processes.pm.
+
0.43 Released at 2008-10-29.
- Kicked UNIVERSAL::require.
- Now it's possible to pass $sleep_time to get().
Modified: trunk/libsys-statistics-linux-perl/LICENCE
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/LICENCE?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/LICENCE (original)
+++ trunk/libsys-statistics-linux-perl/LICENCE Fri Feb 13 13:44:33 2009
@@ -1,4 +1,4 @@
-Copyright (C) 2007 by Jonny Schulz. All rights reserved.
+Copyright (C) 2007-2008 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.
Modified: trunk/libsys-statistics-linux-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/META.yml?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/META.yml (original)
+++ trunk/libsys-statistics-linux-perl/META.yml Fri Feb 13 13:44:33 2009
@@ -1,12 +1,12 @@
---
name: Sys-Statistics-Linux
-version: 0.43
+version: 0.47
author:
- Jonny Schulz
abstract: Front-end module to collect system statistics
license: perl
resources:
- license: http://dev.perl.org/licenses/
+ license: ~
requires:
Carp: 0
POSIX: 0
@@ -16,10 +16,10 @@
provides:
Sys::Statistics::Linux:
file: lib/Sys/Statistics/Linux.pm
- version: 0.43
+ version: 0.47
Sys::Statistics::Linux::Compilation:
file: lib/Sys/Statistics/Linux/Compilation.pm
- version: 0.07
+ version: 0.09
Sys::Statistics::Linux::CpuStats:
file: lib/Sys/Statistics/Linux/CpuStats.pm
version: 0.15
@@ -49,14 +49,14 @@
version: 0.13
Sys::Statistics::Linux::Processes:
file: lib/Sys/Statistics/Linux/Processes.pm
- version: 0.20
+ version: 0.23
Sys::Statistics::Linux::SockStats:
file: lib/Sys/Statistics/Linux/SockStats.pm
version: 0.06
Sys::Statistics::Linux::SysInfo:
file: lib/Sys/Statistics/Linux/SysInfo.pm
version: 0.06
-generated_by: Module::Build version 0.2808
+generated_by: Module::Build version 0.31012
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
version: 1.2
Modified: trunk/libsys-statistics-linux-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/README?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/README (original)
+++ trunk/libsys-statistics-linux-perl/README Fri Feb 13 13:44:33 2009
@@ -360,7 +360,7 @@
Jonny Schulz <jschulz.cpan(at)bloonix.de>.
COPYRIGHT
- Copyright (c) 2006, 2007 by Jonny Schulz. All rights reserved.
+ Copyright (C) 2006-2008 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.
Modified: trunk/libsys-statistics-linux-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/debian/changelog?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/debian/changelog (original)
+++ trunk/libsys-statistics-linux-perl/debian/changelog Fri Feb 13 13:44:33 2009
@@ -1,4 +1,4 @@
-libsys-statistics-linux-perl (0.43-1) UNRELEASED; urgency=low
+libsys-statistics-linux-perl (0.47-1) UNRELEASED; urgency=low
PROBLEM:
FTBFS in a cowbuilder chroot: t/090-diskusage.t and t/130-search.t fail
@@ -23,6 +23,9 @@
[ Rene Mayorga ]
* debian/control: update my email address.
+ [ gregor herrmann ]
+ * New upstream release.
+
-- Rene Mayorga <rmayorga at debian.org> Tue, 20 Jan 2009 01:29:00 -0600
libsys-statistics-linux-perl (0.42-1) unstable; urgency=low
Modified: trunk/libsys-statistics-linux-perl/examples/diskusage.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/examples/diskusage.pl?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/examples/diskusage.pl (original)
+++ trunk/libsys-statistics-linux-perl/examples/diskusage.pl Fri Feb 13 13:44:33 2009
@@ -1,12 +1,30 @@
#!/usr/bin/perl
use strict;
use warnings;
-use Data::Dumper;
use Sys::Statistics::Linux;
use Sys::Statistics::Linux::DiskUsage;
-$Sys::Statistics::Linux::DiskUsage::DF_CMD = 'df -akP';
+$Sys::Statistics::Linux::DiskUsage::DF_CMD = 'df -hP';
my $sys = Sys::Statistics::Linux->new(diskusage => 1);
-my $disk = $sys->get;
+my $stat = $sys->get;
-print Dumper($disk);
+# $stat->diskusage returns the first level keys of the
+# statistic hash as a array. The first level keys are
+# the disk names.
+foreach my $disk ( $stat->diskusage ) { # Gimme the disk names
+
+ print "Statistics for disk $disk:\n";
+
+ # $stat->diskusage($disk) returns the seconds level keys of
+ # the statistics. The second level keys are the statistic keys
+ # for the passed disk.
+ foreach my $key ( sort $stat->diskusage($disk) ) { # Gimme the statistic keys
+
+ # $stat->diskusage($disk, $key) returns the value for the passed
+ # disk and key.
+ printf " %-20s %s\n", $key, $stat->diskusage($disk, $key);
+
+ }
+
+}
+
Modified: trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux.pm?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux.pm (original)
+++ trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux.pm Fri Feb 13 13:44:33 2009
@@ -360,14 +360,14 @@
=head1 COPYRIGHT
-Copyright (c) 2006, 2007 by Jonny Schulz. All rights reserved.
+Copyright (C) 2006-2008 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;
-our $VERSION = '0.43';
+our $VERSION = '0.47';
use strict;
use warnings;
Modified: trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux/Compilation.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux/Compilation.pm?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux/Compilation.pm (original)
+++ trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux/Compilation.pm Fri Feb 13 13:44:33 2009
@@ -88,18 +88,13 @@
my @dev = $stat->netstats; # the devices eth0, eth1, ...
my $eth0 = $stat->netstats('eth0'); # eth0 statistics as a hash reference
my @keys = $stat->netstats('eth0'); # the statistic keys
- my @vals = $stat->netstats('eth0', @keys); # the values for @keys
-
-I was thinking about to return all keys sorted but if you need that you can call
+ my @vals = $stat->netstats('eth0', @keys); # the values for the passed device and @keys
+ my $val = $stat->netstats('eth0', $key); # the value for the passed device and key
+
+Sorted ...
my @dev = sort $stat->netstats;
my @keys = sort $stat->netstats('eth0');
-
-LoadAVG example:
-
- my $load = $stat->loadavg; # loadavg as a hash reference
- my @keys = $stat->loadavg; # the statistic keys
- my @vals = $stat->loadavg(@keys); # the values for @keys
=head2 pstop()
@@ -198,7 +193,7 @@
Jonny Schulz <jschulz.cpan(at)bloonix.de>.
-Thanks to Moritz Lenz for his suggestion for the name for this module.
+Thanks to Moritz Lenz for his suggestion for the name of this module.
=head1 COPYRIGHT
@@ -209,7 +204,7 @@
=cut
package Sys::Statistics::Linux::Compilation;
-our $VERSION = '0.07';
+our $VERSION = '0.09';
use strict;
use warnings;
@@ -281,7 +276,6 @@
foreach my $x (keys %{$fref}) {
if (ref($fref->{$x}) eq 'HASH') {
-
# if the key $proc->{eth0} doesn't exists
# then we continue with the next defined filter
next unless exists $proc->{$x};
@@ -296,7 +290,13 @@
foreach my $key (keys %{$proc}) {
if (ref($proc->{$key}) eq 'HASH') {
$subref = $proc->{$key};
- if (defined $subref->{$x} && $self->_compare($subref->{$x}, $fref->{$x})) {
+ if (ref $subref->{$x} eq 'HASH') {
+ foreach my $y (keys %{$subref->{$x}}) {
+ if ($self->_compare($subref->{$x}->{$y}, $fref->{$x})) {
+ $hits{$opt}{$key}{$x}{$y} = $subref->{$x}->{$y};
+ }
+ }
+ } elsif (defined $subref->{$x} && $self->_compare($subref->{$x}, $fref->{$x})) {
$hits{$opt}{$key}{$x} = $subref->{$x};
}
} else { # must be a scalar now
@@ -309,6 +309,7 @@
}
}
}
+
return wantarray ? %hits : \%hits;
}
@@ -318,11 +319,21 @@
my $proc = $self->{processes} or return undef;
my @hits = ();
- foreach my $pid (keys %{$proc}) {
+ PID: foreach my $pid (keys %{$proc}) {
my $proc = $proc->{$pid};
while ( my ($key, $value) = each %{$filter} ) {
- if (exists $proc->{$key} && $self->_compare($proc->{$key}, $value)) {
- push @hits, $pid;
+ if (exists $proc->{$key}) {
+ if (ref $proc->{$key} eq 'HASH') {
+ foreach my $v (values %{$proc->{$key}}) {
+ if ($self->_compare($v, $value)) {
+ push @hits, $pid;
+ next PID;
+ }
+ }
+ } elsif ($self->_compare($proc->{$key}, $value)) {
+ push @hits, $pid;
+ next PID;
+ }
}
}
}
Modified: trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux/Processes.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux/Processes.pm?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux/Processes.pm (original)
+++ trunk/libsys-statistics-linux-perl/lib/Sys/Statistics/Linux/Processes.pm Fri Feb 13 13:44:33 2009
@@ -50,6 +50,9 @@
nswap - The size of swap space of the process.
cnswap - The size of swap space of the childrens of the process.
cpu - The CPU number the process was last executed on.
+ wchan - The "channel" in which the process is waiting.
+ fd - This is a subhash containing each file which the process has open, named by its file descriptor.
+ 0 is standard input, 1 standard output, 2 standard error, etc.
cmd - Command of the process.
cmdline - Command line of the process.
@@ -130,7 +133,7 @@
use Time::HiRes;
use constant NUMBER => qr/^-{0,1}\d+(?:\.\d+){0,1}\z/;
-our $VERSION = '0.20';
+our $VERSION = '0.23';
our $PAGES_TO_BYTES = 0;
sub new {
@@ -143,6 +146,7 @@
p_statm => 'statm',
p_status => 'status',
p_cmdline => 'cmdline',
+ p_wchan => 'wchan',
},
);
@@ -239,7 +243,7 @@
closedir $pdir;
}
- foreach my $pid (@$pids) {
+ PID: foreach my $pid (@$pids) {
# memory usage for each process
if (open my $fh, '<', "$file->{basedir}/$pid/$file->{p_statm}") {
@@ -260,7 +264,7 @@
close($fh);
} else {
delete $stats{$pid};
- next;
+ next PID;
}
# different other informations for each process
@@ -274,7 +278,7 @@
close($fh);
} else {
delete $stats{$pid};
- next;
+ next PID;
}
# calculate the active time of each process
@@ -291,7 +295,7 @@
close($fh);
} else {
delete $stats{$pid};
- next;
+ next PID;
}
# command line for each process
@@ -305,6 +309,32 @@
}
$stats{$pid}{cmdline} = 'N/a' unless $stats{$pid}{cmdline};
close($fh);
+ } else {
+ delete $stats{$pid};
+ next PID;
+ }
+
+ if (open my $fh, '<', "$file->{basedir}/$pid/$file->{p_wchan}") {
+ $stats{$pid}{wchan} = <$fh>;
+ chomp($stats{$pid}{wchan});
+ } else {
+ delete $stats{$pid};
+ next PID;
+ }
+
+ if (opendir my $dh, "$file->{basedir}/$pid/fd") {
+ $stats{$pid}{fd} = { }; # maybe $dh is empty
+ foreach my $link (grep !/^\.+\z/, readdir($dh)) {
+ if (my $target = readlink("$file->{basedir}/$pid/fd/$link")) {
+ $stats{$pid}{fd}{$link} = $target;
+ } else {
+ delete $stats{$pid};
+ next PID;
+ }
+ }
+ } else {
+ delete $stats{$pid};
+ next PID;
}
}
Modified: trunk/libsys-statistics-linux-perl/t/120-processes.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/t/120-processes.t?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/t/120-processes.t (original)
+++ trunk/libsys-statistics-linux-perl/t/120-processes.t Fri Feb 13 13:44:33 2009
@@ -1,42 +1,44 @@
use strict;
use warnings;
-use Test::More tests => 33;
+use Test::More tests => 35;
use Sys::Statistics::Linux;
my @processes = qw(
- ppid
- nlwp
- owner
- pgrp
- state
- session
- ttynr
- minflt
- cminflt
- mayflt
- cmayflt
- stime
- utime
- ttime
- cstime
- cutime
- prior
- nice
- sttime
- actime
- vsize
- nswap
- cnswap
- cpu
- size
- resident
- share
- trs
- drs
- lrs
- dtp
- cmd
- cmdline
+ ppid
+ nlwp
+ owner
+ pgrp
+ state
+ session
+ ttynr
+ minflt
+ cminflt
+ mayflt
+ cmayflt
+ stime
+ utime
+ ttime
+ cstime
+ cutime
+ prior
+ nice
+ sttime
+ actime
+ vsize
+ nswap
+ cnswap
+ cpu
+ size
+ resident
+ share
+ trs
+ drs
+ lrs
+ dtp
+ cmd
+ cmdline
+ wchan
+ fd
);
my $lxs = Sys::Statistics::Linux->new;
Modified: trunk/libsys-statistics-linux-perl/t/130-search.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/t/130-search.t?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/t/130-search.t (original)
+++ trunk/libsys-statistics-linux-perl/t/130-search.t Fri Feb 13 13:44:33 2009
@@ -17,6 +17,7 @@
sleep 1;
my $stat = $lxs->get();
+my $pid = (keys %{$stat->{processes}})[0];
# just some simple searches that should match every time
my $foo = $stat->search({
@@ -24,10 +25,12 @@
procstats => { count => 'ne:1' },
memstats => { memtotal => 'gt:1' },
diskusage => { usageper => qr/\d+/ },
- processes => { 1 => { ppid => 'eq:0' } },
+ processes => { $pid => { ppid => qr/\d+/ } },
});
-ok(defined %{$foo->{$_}}, "checking $_") for keys %{$foo};
+foreach my $key (qw/cpustats procstats memstats diskusage processes/) {
+ ok(exists $foo->{$key} && ref($foo->{$key}) eq 'HASH', "checking $key");
+}
my %filter = (
cpustats => {
Modified: trunk/libsys-statistics-linux-perl/t/140-psfind.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libsys-statistics-linux-perl/t/140-psfind.t?rev=30656&op=diff
==============================================================================
--- trunk/libsys-statistics-linux-perl/t/140-psfind.t (original)
+++ trunk/libsys-statistics-linux-perl/t/140-psfind.t Fri Feb 13 13:44:33 2009
@@ -7,5 +7,5 @@
$lxs->set(processes => 1);
sleep 1;
my $stat = $lxs->get;
-my $foo = $stat->psfind({cmd => qr/init/});
+my $foo = $stat->psfind({cmd => qr/\w/});
ok(@{$foo}, "checking psfind");
More information about the Pkg-perl-cvs-commits
mailing list