package Sys::Statgrab;
$VERSION = 0.01;
use strict;
use warnings;
use constant STATGRAB_CONSTANTS => qw(
SG_ERROR_ASPRINTF
SG_ERROR_DEVSTAT_GETDEVS
SG_ERROR_DEVSTAT_SELECTDEVS
SG_ERROR_ENOENT
SG_ERROR_GETIFADDRS
SG_ERROR_GETMNTINFO
SG_ERROR_GETPAGESIZE
SG_ERROR_KSTAT_DATA_LOOKUP
SG_ERROR_KSTAT_LOOKUP
SG_ERROR_KSTAT_OPEN
SG_ERROR_KSTAT_READ
SG_ERROR_KVM_GETSWAPINFO
SG_ERROR_KVM_OPENFILES
SG_ERROR_MALLOC
SG_ERROR_NONE
SG_ERROR_OPEN
SG_ERROR_OPENDIR
SG_ERROR_PARSE
SG_ERROR_SETEGID
SG_ERROR_SETEUID
SG_ERROR_SETMNTENT
SG_ERROR_SOCKET
SG_ERROR_SWAPCTL
SG_ERROR_SYSCONF
SG_ERROR_SYSCTL
SG_ERROR_SYSCTLBYNAME
SG_ERROR_SYSCTLNAMETOMIB
SG_ERROR_UNAME
SG_ERROR_UNSUPPORTED
SG_ERROR_XSW_VER_MISMATCH
SG_IFACE_DUPLEX_FULL
SG_IFACE_DUPLEX_HALF
SG_IFACE_DUPLEX_UNKNOWN
SG_PROCESS_STATE_RUNNING
SG_PROCESS_STATE_SLEEPING
SG_PROCESS_STATE_STOPPED
SG_PROCESS_STATE_UNKNOWN
SG_PROCESS_STATE_ZOMBIE
);
use constant STATGRAB_BASE_FUNCTIONS => qw(
get_error drop_privileges
get_host_info
get_cpu_stats get_cpu_stats_diff get_cpu_percents
get_disk_io_stats get_disk_io_stats_diff
get_fs_stats
get_load_stats
get_mem_stats
get_swap_stats
get_network_io_stats get_network_io_stats_diff
get_network_iface_stats
get_page_stats get_page_stats_diff
get_user_stats
get_process_stats
);
use constant STATGRAB_SORT_FUNCTIONS => qw(
sort_procs_by_name
sort_procs_by_pid
sort_procs_by_uid
sort_procs_by_gid
sort_procs_by_size
sort_procs_by_res
sort_procs_by_cpu
sort_procs_by_time
);
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);
@EXPORT = (STATGRAB_CONSTANTS, STATGRAB_BASE_FUNCTIONS, STATGRAB_SORT_FUNCTIONS);
@EXPORT_OK = (STATGRAB_CONSTANTS, STATGRAB_BASE_FUNCTIONS, STATGRAB_SORT_FUNCTIONS);
%EXPORT_TAGS = ( 'all' => [ STATGRAB_CONSTANTS, STATGRAB_BASE_FUNCTIONS, STATGRAB_SORT_FUNCTIONS ] );
if ($^O eq 'cygwin') {
require Unix::Statgrab;
import Unix::Statgrab (STATGRAB_CONSTANTS);
# Natively supported by Statgrab (>= 0.8) on cygwin
*drop_privileges = *drop_privileges = \&Unix::Statgrab::drop_privileges;
*get_host_info = *get_host_info = \&Unix::Statgrab::get_host_info;
*get_cpu_stats = *get_cpu_stats = \&Unix::Statgrab::get_cpu_stats;
*get_cpu_stats_diff = *get_cpu_stats_diff = \&Unix::Statgrab::get_cpu_stats_diff;
*get_cpu_percents = *get_cpu_percents = \&Unix::Statgrab::get_cpu_percents;
*get_mem_stats = *get_mem_stats = \&Unix::Statgrab::get_mem_stats;
*get_swap_stats = *get_swap_stats = \&Unix::Statgrab::get_swap_stats;
*get_page_stats = *get_page_stats = \&Unix::Statgrab::get_page_stats;
*get_page_stats_diff = *get_page_stats_diff = \&Unix::Statgrab::get_page_stats_diff;
*get_user_stats = *get_user_stats = \&Unix::Statgrab::get_user_stats;
# Known as not supported by Statgrab (<= 0.13, at least) on cygwin
*get_disk_io_stats = *get_disk_io_stats = sub { return Unix::Statgrab::get_disk_io_stats(@_) || Sys::Statgrab::Cygwin::sg_disk_io_stats->new(); };
*get_disk_io_stats_diff = *get_disk_io_stats_diff = sub { return Unix::Statgrab::get_disk_io_stats_diff(@_) || Sys::Statgrab::Cygwin::sg_disk_io_stats->new('diff'); };
*get_fs_stats = *get_fs_stats = sub { return Unix::Statgrab::get_fs_stats(@_) || Sys::Statgrab::Cygwin::sg_fs_stats->new(); };
*get_load_stats = *get_load_stats = sub { return Unix::Statgrab::get_load_stats(@_) || Sys::Statgrab::Cygwin::sg_load_stats->new(); };
*get_network_io_stats = *get_network_io_stats = sub { return Unix::Statgrab::get_network_io_stats(@_) || Sys::Statgrab::Cygwin::sg_network_io_stats->new(); };
*get_network_io_stats_diff = *get_network_io_stats_diff = sub { return Unix::Statgrab::get_network_io_stats_diff(@_) || Sys::Statgrab::Cygwin::sg_network_io_stats->new('diff'); };
*get_network_iface_stats = *get_network_iface_stats = sub { return Unix::Statgrab::get_network_iface_stats(@_) || Sys::Statgrab::Cygwin::sg_network_iface_stats->new(); };
*get_process_stats = *get_process_stats = sub { return Unix::Statgrab::get_process_stats(@_) || Sys::Statgrab::Cygwin::sg_process_stats->new(); };
*sort_procs_by_name = \&Sys::Statgrab::Cygwin::sg_process_stats::_sort_procs_by_name;
*sort_procs_by_pid = \&Sys::Statgrab::Cygwin::sg_process_stats::_sort_procs_by_pid;
*sort_procs_by_uid = \&Sys::Statgrab::Cygwin::sg_process_stats::_sort_procs_by_uid;
*sort_procs_by_gid = \&Sys::Statgrab::Cygwin::sg_process_stats::_sort_procs_by_gid;
*sort_procs_by_size = \&Sys::Statgrab::Cygwin::sg_process_stats::_sort_procs_by_size;
*sort_procs_by_res = \&Sys::Statgrab::Cygwin::sg_process_stats::_sort_procs_by_res;
*sort_procs_by_cpu = \&Sys::Statgrab::Cygwin::sg_process_stats::_sort_procs_by_cpu;
*sort_procs_by_time = \&Sys::Statgrab::Cygwin::sg_process_stats::_sort_procs_by_time;
}
elsif ($^O eq 'MSWin32')
{
die "$^O not yet supported by ".__PACKAGE__;
require Unix::Statgrab;
import Unix::Statgrab (STATGRAB_CONSTANTS);
require Win32::Process::Info;
import Unix::Statgrab (STATGRAB_CONSTANTS);
}
else {
require Unix::Statgrab;
import Unix::Statgrab (STATGRAB_CONSTANTS, STATGRAB_BASE_FUNCTIONS, STATGRAB_SORT_FUNCTIONS);
}
}
package Sys::Statgrab::Cygwin::sg_disk_io_stats;
use strict;
use warnings;
sub new {
my $type = shift;
my $class = ref($type) || $type;
my $diff = 1 if shift;
warn "get_disk_io_stats not yet implemented";
return undef;
}
package Sys::Statgrab::Cygwin::sg_fs_stats;
use strict;
use warnings;
sub new {
my $type = shift;
my $class = ref($type) || $type;
warn "get_fs_stats not yet implemented";
return undef;
}
package Sys::Statgrab::Cygwin::sg_load_stats;
use strict;
use warnings;
sub new {
my $type = shift;
my $class = ref($type) || $type;
warn "get_load_stats not yet implemented";
return undef;
}
package Sys::Statgrab::Cygwin::sg_network_io_stats;
use strict;
use warnings;
sub new {
my $type = shift;
my $class = ref($type) || $type;
my $diff = 1 if shift;
warn "get_network_io_stats not yet implemented";
return undef;
}
package Sys::Statgrab::Cygwin::sg_network_iface_stats;
use strict;
use warnings;
sub new {
my $type = shift;
my $class = ref($type) || $type;
warn "get_network_iface_stats not yet implemented";
return undef;
}
package Sys::Statgrab::Cygwin::sg_process_stats;
use strict;
use warnings;
use constant SORT_METHOD_PREFIX => '_sort_procs_by_';
use constant SORT_METHODS => qw(
name
pid
uid
gid
size
res
cpu
time
);
sub new {
my $type = shift;
my $class = ref($type) || $type;
### generate process stat objects ###
my @procs;
opendir(PROCDIR, '/proc') || die "Can't read dir /proc: $!";
push @procs, Sys::Statgrab::Cygwin::sg_process_stats::all_procs->new($_) foreach grep(/^\d+$/o, (readdir(PROCDIR)));
closedir PROCDIR;
### optimization for pcpu stat ###
my %cpu_map;
my @line;
if (open(IPCCMD, "procps -e -opid -opcpu |")) {
foreach my $l (<IPCCMD>) {
$l =~ s/^\s+//o;
@line = split(/\s+/o, $l);
chomp @line;
$cpu_map{$line[0]} = $line[1];
}
close IPCCMD;
foreach my $proc (@procs) {
$proc->{cpu_percent} = $cpu_map{$proc->{pid}};
}
}
else {
warn "Can't obtain cpu_percent stats: Can't execute procps: $!";
}
return bless(\@procs, $class);
}
sub all_procs {
my $self = shift;
return @{$self};
}
sub sort_by {
my $self = shift;
my $meth = shift;
die "Usage: ".__PACKAGE__."::sort_by(obj, meth)" unless defined $meth;
my $regex = quotemeta $meth;
my $sort_method = SORT_METHOD_PREFIX.$meth;
@{$self} = sort $sort_method @{$self} if grep(/^$regex$/, SORT_METHODS);
return $self;
}
sub _sort_procs_by_name ($$) { shift->proc_name cmp shift->proc_name }
sub _sort_procs_by_pid ($$) { shift->pid <=> shift->pid }
sub _sort_procs_by_uid ($$) { shift->uid <=> shift->uid }
sub _sort_procs_by_gid ($$) { shift->gid <=> shift->gid }
sub _sort_procs_by_size ($$) { shift->proc_size <=> shift->proc_size }
sub _sort_procs_by_res ($$) { shift->proc_resident <=> shift->proc_resident }
sub _sort_procs_by_cpu ($$) { shift->cpu_percent <=> shift->cpu_percent }
sub _sort_procs_by_time ($$) { shift->time_spent <=> shift->time_spent }
package Sys::Statgrab::Cygwin::sg_process_stats::all_procs;
use strict;
use warnings;
our $AUTOLOAD;
sub new {
my $type = shift;
my $class = ref($type) || $type;
my $pid = shift;
my $o = bless(\$pid, $class);
my $self = {
proc_name => $o->_proc_name,
proc_title => $o->_proc_title,
pid => $o->_pid,
parent_pid => $o->_parent_pid,
pgid => $o->_pgid,
uid => $o->_uid,
euid => $o->_euid,
gid => $o->_gid,
egid => $o->_egid,
proc_size => $o->_proc_size,
proc_resident => $o->_proc_resident,
time_spent => $o->_time_spent,
cpu_percent => undef, #efficiently calculated later by caller class
nice => $o->_nice,
state => $o->_state,
};
return bless($self, $class);
}
sub AUTOLOAD { #read-only
my $self = shift;
my $class = ref($self) || $self;
my $name = $AUTOLOAD;
$name =~ s/.*://o; # strip fully-qualified portion
no strict 'refs';
Carp::confess "Can't access '$name' field in class $class" unless (exists $self->{$name});
return $self->{$name};
}
sub DESTROY {}
sub CLONE {}
sub _proc_name {
my $self = shift;
return Sys::Statgrab::Util::get_hash_value("/proc/${$self}/status", ':', 'Name', 1);
}
sub _proc_title {
my $self = shift;
my $cmdline = Sys::Statgrab::Util::get_value("/proc/${$self}/cmdline");
$cmdline =~ s/\x0/ /go;
return $cmdline;
}
sub _pid {
my $self = shift;
return ${$self};
}
sub _parent_pid {
my $self = shift;
return Sys::Statgrab::Util::get_value("/proc/${$self}/ppid");
}
sub _pgid {
my $self = shift;
return Sys::Statgrab::Util::get_value("/proc/${$self}/pgid");
}
sub _uid {
my $self = shift;
return Sys::Statgrab::Util::get_value("/proc/${$self}/uid");
}
sub _euid { return _uid(@_); } #bug: is euid accessable on cygwin?
sub _gid {
my $self = shift;
return Sys::Statgrab::Util::get_value("/proc/${$self}/gid");
}
sub _egid { return _gid(@_); } #bug: is egid accessable on cygwin?
sub _proc_size { #note: approximated to nearest unit (default is kB)
my $self = shift;
my @size = split(/ /, Sys::Statgrab::Util::get_hash_value("/proc/${$self}/status", ':', 'VmSize', 1));
return $size[0] * (lc $size[1] eq 'kb' ? 1000 : lc $size[1] eq 'mb' ? 1000000 : lc $size[1] eq 'gb' ? 1000000000 : 1);
}
sub _proc_resident { #note: approximated to nearest unit (default is kB)
my $self = shift;
my @rss = split(/ /, Sys::Statgrab::Util::get_hash_value("/proc/${$self}/status", ':', 'VmRSS', 1));
return $rss[0] * (lc $rss[1] eq 'kb' ? 1000 : lc $rss[1] eq 'mb' ? 1000000 : lc $rss[1] eq 'gb' ? 1000000000 : 1);
}
sub _time_spent {
my $self = shift;
my ($utime, $stime) = (split(/ /, Sys::Statgrab::Util::get_value("/proc/${$self}/stat")))[13..14];
return $utime + $stime;
}
sub _cpu_percent { #note: using more efficient method
my $self = shift;
return Sys::Statgrab::Util::get_procps_value(${$self}, 'pcpu');
return undef;
}
sub _nice {
my $self = shift;
# return Sys::Statgrab::Util::get_procps_value(${$self}, 'ni');
return (split(/ /, Sys::Statgrab::Util::get_value("/proc/${$self}/stat")))[18];
}
sub _state {
my $self = shift;
my $state = (split(/ /, Sys::Statgrab::Util::get_value("/proc/${$self}/stat")))[2];
# return $state eq 'R' ? Sys::Statgrab::SG_PROCESS_STATE_RUNNING
# : $state eq 'S' ? Sys::Statgrab::SG_PROCESS_STATE_SLEEPING
# : $state eq 'T' ? Sys::Statgrab::SG_PROCESS_STATE_STOPPED
# : $state eq 'Z' ? Sys::Statgrab::SG_PROCESS_STATE_ZOMBIE #kludge: not sure if this is the correct letter
# : Sys::Statgrab::SG_PROCESS_STATE_UNKNOWN
}
package Sys::Statgrab::Util;
use strict;
use warnings;
sub get_value ($) {
my $file = shift;
open(PROCFILE, "<$file") || die "Can't open file $file";
my @line = <PROCFILE>;
close PROCFILE;
chomp @line;
return $line[0];
}
sub get_array_index ($$$) {
my $file = shift;
my $delimiter = shift;
my $idx = shift;
open(PROCFILE, "<$file") || die "Can't open file $file";
my @line = split(/\s*$delimiter\s*/, <PROCFILE>);
close PROCFILE;
chomp @line;
return $line[$idx];
}
sub get_hash_value ($$$;$) {
my $file = shift;
my $delimiter = shift;
my $key = shift;
my $idx = shift;
open(PROCFILE, "<$file") || die "Can't open file $file";
my @line;
while (@line = split(/\s*$delimiter\s*/, <PROCFILE>)) {
last if $line[0] eq $key;
}
chomp @line;
close PROCFILE;
return defined $idx ? $line[$idx] : wantarray ? @line : $line[1];
}
sub get_procps_value ($$) {
my $pid = shift;
my $format = shift;
if (open(IPCCMD, "procps -e -opid -o$format |")) {
my @line;
foreach my $l (<IPCCMD>) {
$l =~ s/^\s+//o;
@line = split(/\s+/o, $l);
last if $line[0] eq $pid;
}
close IPCCMD;
chomp @line;
return $line[1];
}
else {
warn "Can't obtain cpu_percent stats: Can't execute procps: $!";
return undef;
}
}
1;
__END__
=head1 NAME
Sys::Statgrab - Extension of Unix::Statgrab for greater portability
=head1 SYNOPSIS
use Sys::Statgrab;
local $, = "\n";
my $host = get_host_info or
die get_error;
print $host->os_name,
$host->os_release,
$host->os_version,
...;
my $disks = get_disk_io_stats or
die get_error;
for (0 .. $disks->num_disks - 1) {
print $disks->disk_name($_),
$disks->read_bytes($_),
...;
}
=head1 DESCRIPTION
Sys::Statgrab is an attempt to provide support for platforms unsupported by L<Unix::Statgrab>, and to complete support for other platforms that L<Unix::Statgrab> currently only partially supports. If your platform natively supports all L<Unix::Statgrab> interface functions, then this module will silently act as a pass-through wrapper for L<Unix::Statgrab>.
=head1 BACKGROUND
=head2 What is Unix::Statgrab?
L<Unix::Statgrab> is a wrapper for libstatgrab as available from L<http://www.i-scream.org/libstatgrab/>. It is a reasonably portable attempt to query interesting stats about your computer. It covers information on the operating system, CPU, memory usage, network interfaces, hard-disks etc.
=head2 Why did I make this module?
...instead of spending the time directly supporting the native C libstatgrab project? I am a strong believer in the interface of libstatgrab and use it in many Perl projects, but I simply cannot find the time necessary code and debug large C patches for that project. Also, there are some current limitations in some platforms (e.g. cygwin) at this time that prevent libstatgrab from being able to be completely ported without using a combination of external utilities and other open-source libraries.
Thus, the next best contribution I can offer is to encourage greater interest in libstatgrab, starting with the Perl user community, such that other developers may take an interest in working with the libstatgrab authors to add and complete native support for new platforms. Ideally, as libstatgrab platform support grows, this module will eventually be reduced to a simple pass-through for L<Unix::Statgrab>, at which time that module would likely inherit the Sys:: package namespace of this module.
=head1 USAGE
See L<Unix::Statgrab> for complete usage documentation.
=head1 TODO
Complete as much support as possible for Cygwin (beyond libstatgrab's support, only get_process_stats() has been implemented). Possibly use combo of cygwin netstat and Win32::NetPacket. Maybe try interfacing with other open source tools tools like Etherial.
Complete support for Win32 (extending upon the prelimiary libstatgrab support in MinGW).
Support other platforms, or missing native libstatgrab support for some functions in your current platform? Contact me (or send me your patches), and I'll see what we can do!
=head1 CAVIATS
If using Cygwin, you must have procps (available as a Cygwin package) installed to be able to obtain process-level CPU utilization percentage stats; otherwise, cpu_percent will return undef.
=head1 BUGS
None known at this time, although there may be a few minor ones lurking about. Bug reports and suggestions are always welcome.
=head1 CREDITS
=over
=item Tassilo von Parseval
For writing L<Unix::Statgrab>, for the base test script for this module, and for supporting ideas of portability beyond libstatgrab's current capabilities.
=back
=head1 AUTHOR
Eric Rybski
=head1 COPYRIGHT AND LICENSE
Copyright 2006 by Eric Rybski, All Rights Reserved
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
L<Unix::Statgrab>
=cut