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:
Martin Baulig
1998-06-21 22:24:18 +00:00
committed by Martin Baulig
parent 71187a5e51
commit a76522a990
14 changed files with 218 additions and 4 deletions

1
perl/.cvsignore Normal file
View File

@@ -0,0 +1 @@
Libgtop.xs Makefile blib pm_to_blib Libgtop.c Libgtop.bs Makefile.PL

5
perl/Changes Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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):