Added perl interface.
1998-06-21 Martin Baulig <martin@home-of-linux.org> * perl/*: Added perl interface. * sysdeps/linux/cpu.c: Bug fix. * include/glibtop/global.h: Only including guile header files within libgtop. * configure.in (LIGBTOP_LIBS): Added `-lgtop'. * Makefile.am: Creating `perl/Makefile.PL' from `perl/Makefile.PL.in' and `perl/Libgtop.xs' using `perl/perl.awk'.
This commit is contained in:
committed by
Martin Baulig
parent
71187a5e51
commit
a76522a990
1
perl/.cvsignore
Normal file
1
perl/.cvsignore
Normal file
@@ -0,0 +1 @@
|
||||
Libgtop.xs Makefile blib pm_to_blib Libgtop.c Libgtop.bs Makefile.PL
|
5
perl/Changes
Normal file
5
perl/Changes
Normal file
@@ -0,0 +1,5 @@
|
||||
Revision history for Perl extension Libgtop.
|
||||
|
||||
0.01 Sun Jun 21 21:00:59 1998
|
||||
- original version; created by h2xs 1.18
|
||||
|
26
perl/Libgtop.pm
Normal file
26
perl/Libgtop.pm
Normal file
@@ -0,0 +1,26 @@
|
||||
package Libgtop;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
||||
|
||||
require Exporter;
|
||||
require DynaLoader;
|
||||
require AutoLoader;
|
||||
|
||||
@ISA = qw(Exporter DynaLoader);
|
||||
# Items to export into callers namespace by default. Note: do not export
|
||||
# names by default without a very good reason. Use EXPORT_OK instead.
|
||||
# Do not simply export all your public functions/methods/constants.
|
||||
@EXPORT = qw(
|
||||
|
||||
);
|
||||
$VERSION = '0.01';
|
||||
|
||||
bootstrap Libgtop $VERSION;
|
||||
|
||||
# Preloaded methods go here.
|
||||
|
||||
# Autoload methods go after __END__, and are processed by the autosplit program.
|
||||
|
||||
1;
|
||||
__END__
|
8
perl/MANIFEST
Normal file
8
perl/MANIFEST
Normal file
@@ -0,0 +1,8 @@
|
||||
.cvsignore
|
||||
Changes
|
||||
Libgtop.pm
|
||||
MANIFEST
|
||||
Makefile.PL.in
|
||||
new.pl
|
||||
perl.awk
|
||||
test.pl
|
10
perl/Makefile.PL.in
Normal file
10
perl/Makefile.PL.in
Normal file
@@ -0,0 +1,10 @@
|
||||
# -*-cperl-*-
|
||||
use ExtUtils::MakeMaker;
|
||||
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
# the contents of the Makefile that is written.
|
||||
WriteMakefile('NAME' => 'Libgtop',
|
||||
'VERSION_FROM' => 'Libgtop.pm',
|
||||
'LIBS' => ['@LIBGTOP_GUILE_LIBS@'],
|
||||
'DEFINE' => '',
|
||||
'INC' => '@LIBGTOP_GUILE_INCS@',
|
||||
);
|
13
perl/new.pl
Executable file
13
perl/new.pl
Executable file
@@ -0,0 +1,13 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
require 5.004;
|
||||
|
||||
use blib;
|
||||
use strict;
|
||||
use Libgtop;
|
||||
|
||||
print "CPU Usage: ".join (':', Libgtop::cpu)."\n";
|
||||
print "Memory Usage: ".join (':', Libgtop::mem)."\n";
|
||||
print "Swap Usage: ".join (':', Libgtop::swap)."\n";
|
||||
|
||||
|
86
perl/perl.awk
Normal file
86
perl/perl.awk
Normal file
@@ -0,0 +1,86 @@
|
||||
BEGIN {
|
||||
print "/* Libgtop.xs */";
|
||||
print "/* This is a generated file. Please modify `perl.awk' */";
|
||||
print "";
|
||||
|
||||
print "#ifdef __cplusplus";
|
||||
print "extern \"C\" {";
|
||||
print "#endif";
|
||||
print "#include \"EXTERN.h\"";
|
||||
print "#include \"perl.h\"";
|
||||
print "#include \"XSUB.h\"";
|
||||
print "#ifdef __cplusplus";
|
||||
print "}";
|
||||
print "#endif";
|
||||
print "";
|
||||
print "#undef PACKAGE";
|
||||
print "";
|
||||
print "#include <glibtop.h>";
|
||||
print "#include <glibtop/union.h>";
|
||||
print "";
|
||||
print "MODULE = Libgtop\t\tPACKAGE = Libgtop";
|
||||
print "";
|
||||
|
||||
convert["long"] = "newSViv";
|
||||
convert["ulong"] = "newSViv";
|
||||
convert["double"] = "newSVnv";
|
||||
}
|
||||
|
||||
/^(\w+)/ {
|
||||
feature = $1;
|
||||
|
||||
print "void";
|
||||
if (feature ~ /^proc_/) {
|
||||
print feature"(pid)";
|
||||
print "\tunsigned\tpid;";
|
||||
} else {
|
||||
print feature"()";
|
||||
}
|
||||
|
||||
print "PREINIT:";
|
||||
print "\tglibtop_"feature" "feature";";
|
||||
|
||||
if (feature ~ /^proclist/) {
|
||||
print "\tunsigned i, *ptr;";
|
||||
print "PPCODE:";
|
||||
print "\tptr = glibtop_get_proclist (&proclist);";
|
||||
print "";
|
||||
print "\tif (ptr) {";
|
||||
print "\t\tfor (i = 0; i < proclist.number; i++)";
|
||||
print "\t\t\tXPUSHs (sv_2mortal (newSViv (ptr [i])));";
|
||||
print "\t}";
|
||||
print "";
|
||||
print "\tglibtop_free (ptr);";
|
||||
} else {
|
||||
print "PPCODE:";
|
||||
if (feature ~ /^proc_/) {
|
||||
print "\tglibtop_get_"feature" (&"feature", pid);";
|
||||
} else {
|
||||
print "\tglibtop_get_"feature" (&"feature");";
|
||||
}
|
||||
print "";
|
||||
|
||||
nr_elements = split ($2, elements, /:/);
|
||||
for (element = 1; element <= nr_elements; element++) {
|
||||
list = elements[element];
|
||||
type = elements[element];
|
||||
sub(/\(.*/, "", type);
|
||||
sub(/^\w+\(/, "", list); sub(/\)$/, "", list);
|
||||
count = split (list, fields, /,/);
|
||||
for (field = 1; field <= count; field++) {
|
||||
if (type ~ /^str$/) {
|
||||
print "\tXPUSHs (sv_2mortal (newSVpv ("$1"."fields[field]", 0)));";
|
||||
} else {
|
||||
if (type ~ /^char$/) {
|
||||
print "\tXPUSHs (sv_2mortal (newSVpv (&"$1"."fields[field]", 1)));";
|
||||
} else {
|
||||
print "\tXPUSHs (sv_2mortal ("convert[type]" ("$1"."fields[field]")));";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print "";
|
||||
}
|
||||
|
20
perl/test.pl
Normal file
20
perl/test.pl
Normal file
@@ -0,0 +1,20 @@
|
||||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl test.pl'
|
||||
|
||||
######################### We start with some black magic to print on failure.
|
||||
|
||||
# Change 1..1 below to 1..last_test_to_print .
|
||||
# (It may become useful if the test is moved to ./t subdirectory.)
|
||||
|
||||
BEGIN { $| = 1; print "1..1\n"; }
|
||||
END {print "not ok 1\n" unless $loaded;}
|
||||
use Libgtop;
|
||||
$loaded = 1;
|
||||
print "ok 1\n";
|
||||
|
||||
######################### End of black magic.
|
||||
|
||||
# Insert your test code below (better if it prints "ok 13"
|
||||
# (correspondingly "not ok 13") depending on the success of chunk 13
|
||||
# of the test code):
|
||||
|
Reference in New Issue
Block a user