GTop - Perl interface to libgtop
use GTop (); my \$gtop = GTop->new;
Perl interface to libgtop:
http://ftp.gnome.org/pub/gnome/sources/libgtop/
EOF
my %constructors = map {$_,1} qw(mountlist proclist proc_map mountentry proc_args map_entry); my %notunion = map {$_,1} qw(mountentry map_entry); use constant IS_SOLARIS => $^O eq 'solaris';
for my $if (sort keys %interface) { local *FH; (my $leaf = $if) =~ s/_(.)/uc $1/e; my $class = sprintf "GTop::%s", ucfirst $leaf; (my $typedef = $class) =~ s/:/_/g;
print BOOTXS " boot_GTop_$if(aTHX);\n"; print TYPEMAP "$class\tT_PTROBJ\n"; print BOOTINC "typedef glibtop_$if * $typedef;\n"; print BOOTINC qq(\#include "$if.boot"\n); my(@args) = ('','','','()'); if ($if =~ /^proc_/) { @args = (', pid', 'pid_t pid', '($pid)', '($$)'); } elsif ($if =~ /^netload/) { @args = (', interface', 'char * interface', '($interface)', '(\'eth0\')'); } elsif ($if =~ /^mountlist/) { @args = (', all_fs', 'int all_fs', '($all_fs)', '(1)'); } elsif ($if =~ /^fsusage/) { @args = (', disk', 'char *disk', '($disk)', '(\'/\')'); } print XS <<EOF unless $constructors{$if};
$class $if(gtop$args[0]) GTop gtop $args[1]
CODE: RETVAL = (glibtop_$if *)safemalloc(sizeof(*RETVAL)); trace_malloc(RETVAL); Zero(RETVAL, 1, glibtop_$if); glibtop_get_$if(RETVAL$args[0]); OUTPUT: RETVAL
print TEST <<EOF unless $notunion{$if};
my \$$if = \$gtop->$if$args[3]; print "# $if\\n"; for (qw(@{ $interface{$if} })) { (my \$x = \$_) =~ s/:\\w+\$//; printf "# %s => %d\\n", \$x, \$$if->\$x(); }
unless ($notunion{$if}) { print POD "\n=head2 $class\n"; print POD "\n my \$$if = \$gtop->$if$args[2];\n\n"; print POD "=over 4\n"; } open FH, ">$if.boot" or die $!; if (IS_SOLARIS) { for my $entry (@{ $interface{$if} }) { my $type = 'u_int64_t'; if ($entry =~ s/:(\w+)$//) { $type = $1; } my $field = $entry; my $xsname = "XS_glibtop_${if}_$field"; print FH <<EOF; static XS($xsname) { dXSARGS; glibtop_$if *s = (void *)SvIV((SV*)SvRV(ST(0))); ST(0) = sv_2mortal(newSVnv((unsigned long)s->$field)); XSRETURN(1); } EOF } } print FH "static void boot_GTop_$if (pTHX)\n{\n"; for my $entry (@{ $interface{$if} }) { my $type = 'u_int64_t'; if ($entry =~ s/:(\w+)$//) { $type = $1; } my $field = $entry; my $method = join '::', $class, $field; my $xsname = "XS_glibtop_${if}_$field"; if (IS_SOLARIS) { print FH qq{ newXS("$method", $xsname, __FILE__);\n}; } else { print FH qq{ newGTopXS_$type("$method", glibtop_$if, $field);\n}; } unless ($notunion{$if}) { print POD "\n=item $field\n\n"; print POD " my \$$field = \$$if->$field;\n"; } } print FH qq{ newXS("$class\::DESTROY", XS_GTop_destroy, __FILE__);\n} unless $notunion{$if}; print FH "\n}\n"; print POD "\n=back\n" unless $notunion{$if}; }
print BOOTXS "\n}\n"; print POD <<EOF;
Doug MacEachern
print TEST <<EOF; ok 1; # XXX: need to do some real testing
close TYPEMAP; close BOOTINC; close BOOTXS; close XS; close POD; close TEST;
#needed for remote connection my $xlibs = "-L/usr/X11/lib -L/usr/X11R6/lib -lXau";
# if none can be found will try the defaults my $GTOP_LIB_DEFAULT = "-lgtop -lgtop_sysdeps -lgtop_common -lglib $xlibs "; my $GTOP_LIB = ""; if (my $path = $ENV{GTOP_LIB}) { $GTOP_LIB = "-L$path "; } my $GTOP_INCLUDE = ""; if (my $path = $ENV{GTOP_INCLUDE}) { $GTOP_INCLUDE = "-I$path "; }
chomp(my $ginc = `glib-config --cflags`);
my @insure = (); if (0) { @insure = ( OPTIMIZE => '-g', CC => 'insure gcc', LD => 'insure gcc', ); }
my %config = get_glibtop_config();
# give the default a try $GTOP_LIB = $GTOP_LIB_DEFAULT unless $GTOP_LIB || $config{libs};
my $inc = join " ", $GTOP_INCLUDE, $ginc, $config{incs}; my $libs = join " ", $GTOP_LIB, $config{libs};
if (DEBUG) { warn "Using INC: $inc\n"; warn "Using LIBS: $libs\n"; }
WriteMakefile( @insure, NAME => 'GTop', VERSION_FROM => 'lib/GTop.pm', INC => $inc, LIBS => [$libs], TYPEMAPS => [qw(typemap.gtop typemap)], PREREQ_PM => \%prereq, clean => { FILES => "@{[<*.boot>, <*.gtop>]}", }, 'macro' => { CVSROOT => 'modperl.com:/local/cvs_repository', }, );
sub MY::postamble { return <<'EOF';
cvs_tag : cvs -d $(CVSROOT) tag v$(VERSION_SYM) . @echo update GTop.pm VERSION now EOF }
# get libgtop CFLAGS/LIBS across 1.x-2.x versions sub get_glibtop_config { my %c = ();
if (system('pkg-config --exists libgtop-2.0') == 0) { # 2.x chomp($c{incs} = qx|pkg-config --cflags libgtop-2.0|); chomp($c{libs} = qx|pkg-config --libs libgtop-2.0|); # 2.0.0 bugfix chomp(my $libdir = qx|pkg-config --variable=libdir libgtop-2.0|); $c{libs} =~ s|\$\(libdir\)|$libdir|; } elsif (system('gnome-config --libs libgtop') == 0) { chomp($c{incs} = qx|gnome-config --cflags libgtop|); chomp($c{libs} = qx|gnome-config --libs libgtop|); # buggy ( < 1.0.9?) versions fixup $c{incs} =~ s|^/|-I/|; $c{libs} =~ s|^/|-L/|; } return %c; }
To install GTop, copy and paste the appropriate command in to your terminal.
cpanm
cpanm GTop
CPAN shell
perl -MCPAN -e shell install GTop
For more information on module installation, please visit the detailed CPAN module installation guide.