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