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'.
1998-06-21 22:24:18 +00:00
parent 71187a5e51
commit a76522a990
14 changed files with 218 additions and 4 deletions
--- a/14
+++ b/14
@@ -1,3 +1,17 @@
+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'.
+
 1998-06-18  Martin Baulig  <baulig@taurus.uni-trier.de>

 	* sysdeps/linux/*.c: Reverted some stuff from 06-07-1998
--- a/Makefile.am
+++ b/Makefile.am
@@ -22,6 +22,9 @@ release:
 confexecdir=$(libdir)
 confexec_DATA = $(top_builddir)/libgtopConf.sh

+noinst_DATA = $(top_builddir)/perl/Makefile.PL \
+		$(top_builddir)/perl/Libgtop.xs
+
 ## to automatically rebuild aclocal.m4 if any of the macros in
 ## `macros/' change
@MAINT@include macros/macros.dep
@@ -51,3 +54,27 @@ libgtopConf.sh: libgtopConf.sh.in Makefile
 	    -e 's,\@libgtop_want_examples\@,$(libgtop_want_examples),g' \
 	      < $(srcdir)/libgtopConf.sh.in > libgtopConf.tmp \
 	  && mv libgtopConf.tmp libgtopConf.sh
+
+perl/Makefile.PL: perl/Makefile.PL.in Makefile
+## Use sed and then mv to avoid problems if the user interrupts.
+	sed -e 's,\@LIBGTOP_LIBDIR\@,$(libdir),g' \
+	    -e 's,\@LIBGTOP_INCLUDEDIR\@,$(includedir),g' \
+	    -e 's,\@LIBGTOP_LIBS\@,$(LIBGTOP_LIBS),g' \
+	    -e 's,\@LIBGTOP_INCS\@,$(LIBGTOP_INCS),g' \
+	    -e 's,\@LIBGTOP_GUILE_LIBS\@,$(LIBGTOP_GUILE_LIBS),g' \
+	    -e 's,\@LIBGTOP_GUILE_INCS\@,$(LIBGTOP_GUILE_INCS),g' \
+	    -e 's,\@LIBGTOP_BINDIR\@,$(LIBGTOP_BINDIR),g' \
+	    -e 's,\@LIBGTOP_SERVER\@,$(LIBGTOP_SERVER),g' \
+	    -e 's,\@libgtop_sysdeps_dir\@,$(libgtop_sysdeps_dir),g' \
+	    -e 's,\@libgtop_need_server\@,$(libgtop_need_server),g' \
+	    -e 's,\@libgtop_use_machine_h\@,$(libgtop_use_machine_h),g' \
+	    -e 's,\@libgtop_guile_found\@,$(libgtop_guile_found),g' \
+	    -e 's,\@libgtop_want_names\@,$(libgtop_want_names),g' \
+	    -e 's,\@libgtop_want_guile_names\@,$(libgtop_want_guile_names),g' \
+	    -e 's,\@libgtop_want_examples\@,$(libgtop_want_examples),g' \
+	      < $(srcdir)/perl/Makefile.PL.in > perl/Makefile.tmp \
+	  && mv perl/Makefile.tmp perl/Makefile.PL
+
+perl/Libgtop.xs: perl/perl.awk $(top_builddir)/config.h $(top_srcdir)/features.def
+	$(AWK) -f $(top_srcdir)/perl/perl.awk < $(top_srcdir)/features.def > perl/lgt-t
+	mv perl/lgt_t perl/Libgtop.xs
--- a/configure.in
+++ b/configure.in
@@ -154,7 +154,7 @@ AC_SUBST(LIBSUPPORT)
 AC_SUBST(SUPPORTINCS)

 dnl These definitions are expanded in make.
-LIBGTOP_LIBS='-L$(libdir)'
+LIBGTOP_LIBS='-L$(libdir) -lgtop'
 LIBGTOP_INCS='-I$(includedir)'
 LIBGTOP_GUILE_LIBS="$LIBGTOP_LIBS"
 LIBGTOP_GUILE_INCS="$LIBGTOP_INCS"
--- a/include/glibtop/Makefile.am
+++ b/include/glibtop/Makefile.am
@@ -5,4 +5,4 @@ glibtop_HEADERS		= close.h loadavg.h prockernel.h procstate.h \
 			  proctime.h shm_limits.h version.h cpu.h msg_limits.h \
 			  procmem.h procuid.h swap.h write.h error.h open.h \
 			  procsegment.h read.h sysdeps.h xmalloc.h global.h \
-			  output.h procsignal.h read_data.h union.h
+			  output.h procsignal.h read_data.h union.h types.h
--- a/include/glibtop/global.h
+++ b/include/glibtop/global.h
@@ -62,6 +62,11 @@
 # endif
 #endif

+#ifdef WITHOUT_GUILE
+#undef HAVE_GUILE
+#undef GLIBTOP_GUILE_NAMES
+#endif
+
 #ifdef HAVE_GUILE
 #include <guile/gh.h>
 #endif
--- a/perl/.cvsignore
+++ b/perl/.cvsignore
@@ -0,0 +1 @@
+Libgtop.xs Makefile blib pm_to_blib Libgtop.c Libgtop.bs Makefile.PL
--- a/perl/Changes
+++ b/perl/Changes
@@ -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
+
--- a/perl/Libgtop.pm
+++ b/perl/Libgtop.pm
@@ -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__
--- a/perl/MANIFEST
+++ b/perl/MANIFEST
@@ -0,0 +1,8 @@
+.cvsignore
+Changes
+Libgtop.pm
+MANIFEST
+Makefile.PL.in
+new.pl
+perl.awk
+test.pl
--- a/perl/Makefile.PL.in
+++ b/perl/Makefile.PL.in
@@ -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@',
+	     );
--- a/perl/new.pl
+++ b/perl/new.pl
@@ -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";
+
+
--- a/perl/perl.awk
+++ b/perl/perl.awk
@@ -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 "";
+}
+
--- a/perl/test.pl
+++ b/perl/test.pl
@@ -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):
+
--- a/sysdeps/linux/cpu.c
+++ b/sysdeps/linux/cpu.c
@@ -54,8 +54,7 @@ glibtop_get_cpu_s (glibtop *server, glibtop_cpu *buf)
 		glibtop_error_r (server, "read (%s): %s",
 				 FILENAME, strerror (errno));

-	tmp = strchr (buffer, '\n');
-	tmp = skip_token (tmp);			/* "cpu" */
+	tmp = skip_token (buffer);		/* "cpu" */

 	buf->user  = strtoul (tmp, &tmp, 10);
 	buf->nice  = strtoul (tmp, &tmp, 10);
				`@@ -0,0 +1 @@`
				`Libgtop.xs Makefile blib pm_to_blib Libgtop.c Libgtop.bs Makefile.PL`