[Cluster-devel] bindings/perl configure

[Fabio M. Di Nitto <fabbione@fedoraproject.org>]

 bindings/perl/Makefile        |   15 +++-
 bindings/perl/ccs/CCS.pm      |  145 ++++++++++++++++++++++++++++++++++++++++++
 bindings/perl/ccs/CCS.xs      |   82 +++++++++++++++++++++++
 bindings/perl/ccs/MANIFEST    |    7 ++
 bindings/perl/ccs/META.yml    |   13 +++
 bindings/perl/ccs/Makefile.PL |   28 ++++++++
 bindings/perl/ccs/test.pl     |   20 +++++
 bindings/perl/ccs/typemap     |   14 ++++
 configure                     |    7 ++
 9 files changed, 329 insertions(+), 2 deletions(-)

New commits:
commit 3b97eed446aef7b19c0547dc3d31abe16990891e
Author: Fabio M. Di Nitto <fdinitto@redhat.com>
Date:   Tue Jul 29 21:03:16 2008 +0200

    bindings: add first cut of perl Cluster:CCS
    
    Add new perl binding for libccs.
    
    This is a first version and while the code works fine, the build system
    and many other details are still not clean.
    
    Signed-off-by: Fabio M. Di Nitto <fdinitto@redhat.com>

diff --git a/bindings/perl/Makefile b/bindings/perl/Makefile
index 810b2d4..91fefc4 100644
--- a/bindings/perl/Makefile
+++ b/bindings/perl/Makefile
@@ -1,4 +1,15 @@
 include ../../make/defines.mk
-include $(OBJDIR)/make/passthrough.mk
 
-SUBDIRS=
+SUBDIRS=ccs
+
+all: ${SUBDIRS}
+
+%:
+	set -e && \
+	for i in ${SUBDIRS}; do \
+		cd $$i; \
+		perl Makefile.PL INC='-I${ccsincdir}' LIBS='-L${ccslibdir} -lccs' INSTALLDIRS=vendor; \
+		${MAKE} $@ LD_RUN_PATH=""; \
+		rm -f Makefile.old; \
+		cd ..; \
+	done
diff --git a/bindings/perl/ccs/CCS.pm b/bindings/perl/ccs/CCS.pm
new file mode 100644
index 0000000..c5b8a12
--- /dev/null
+++ b/bindings/perl/ccs/CCS.pm
@@ -0,0 +1,145 @@
+package Cluster::CCS;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+require Exporter;
+require DynaLoader;
+
+ at 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.
+our %EXPORT_TAGS = ( 'all' => [qw(
+
+)]);
+ at EXPORT = qw(
+	
+);
+ at EXPORT_OK = (@{$EXPORT_TAGS{'all'}});
+
+our $VERSION = '0.01';
+
+require XSLoader;
+XSLoader::load('Cluster::CCS', $VERSION);
+
+sub new {
+	my $class = shift;
+	my $self = bless { 
+		@_
+	};
+	return $self;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Cluster::CCS - Perl wrapper for the cluster configuration API
+
+=head1 SYNOPSIS
+
+  use Cluster::CCS;
+
+  my $ccs = new Cluster::CCS();
+
+  $ccs->fullxpath(1);
+
+  my $ccshandle = $ccs->connect();
+
+  if ($ccshandle < 1) {
+    print "Cannot comunicate with libccs\n";
+    exit $ccshandle;
+  }
+
+  my $rtn;
+  my $err;
+
+  $err = $ccs->get($ccshandle, '/cluster/@name', $rtn);
+
+  if ($err != 0) {
+    print "Query is not valid\n";
+  }
+
+  print "My Cluster name is $rtn\n";
+
+  $err = $ccs->disconnect($ccshandle);
+
+  if ($err != 0) {
+    print "Problems disconnecting from libccs\n";
+  }
+
+  exit $err;
+
+=head1 DESCRIPTION
+
+  Cluster::CCS provides a perl XS wrapper for libccs. 
+
+=head1 METHODS
+
+=head2 new
+
+  Creates a new Cluster::CCS object.
+
+=head2 fullxpath(value)
+
+  Enable or disable full xpath queries. Set 1 to enable, 0 to disable.
+  This has to be set before connect() or force_connect.
+  In order to change this value, a disconnect operation is required.
+
+=head2 connect()
+
+  Initialize the connection to libccs/libconfdb/corosync objdb.
+  Returns 1 on success or negative on failure.
+
+=head2 force_connect(cluster_name, blocking)
+
+  Initialize the connection to libccs/libconfdb/corosync objdb.
+  If blocking is set, it will retry the operation until it succeed.
+  Returns 1 on success or negative on failure.
+
+=head2 disconnect(desc)
+
+  Disconnect and free resources allocated during opertaion.
+  Returns 0 on success.
+
+=head2 get(desc, query, rtn)
+
+  Perform a simple xpath query.
+  Returns 0 on success, negative otherwise. On success rtn will contain the
+  requested data.
+
+=head2 get_list(desc, query, rtn)
+
+  Perform a simple xpath query and retain some data to iterate over a list of
+  results.
+  Returns 0 on success, negative otherwise. On success rtn will contain the
+  requested data.
+
+=head2 set(desc, path, val)
+
+  This operation is not yet implemented in libccs.
+
+=head2 lookup_nodename(desc, nodename, rtn)
+
+  Perform a nodename lookup using several methods.
+  Return 0 on success and rtn will contain the requested data.
+
+=head1 EXPORTS
+
+Nothing is exported by default.
+
+=head1 BUGS
+
+  https://bugzilla.redhat.com/
+
+=head1 SEE ALSO
+
+  cluster.conf(5), ccs(7), ccs_tool(8)
+
+=head1 AUTHOR
+
+Fabio M. Di Nitto <fdinitto@redhat.com>
+
+=cut
diff --git a/bindings/perl/ccs/CCS.xs b/bindings/perl/ccs/CCS.xs
new file mode 100644
index 0000000..6d29dcf
--- /dev/null
+++ b/bindings/perl/ccs/CCS.xs
@@ -0,0 +1,82 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "ccs.h"
+
+MODULE = Cluster::CCS PACKAGE = Cluster::CCS
+
+PROTOTYPES: ENABLE
+
+void
+fullxpath(self, value)
+    int value;
+    CODE:
+	fullxpath = value;
+
+int
+connect(self)
+    CODE:
+        RETVAL = ccs_connect();
+    OUTPUT:
+    RETVAL
+
+int
+force_connect(self, cluster_name, blocking)
+    char const *cluster_name;
+    int blocking;
+    CODE:
+	RETVAL = ccs_force_connect(cluster_name, blocking);
+    OUTPUT:
+    RETVAL
+
+int
+disconnect(self, desc)
+    int desc;
+    CODE:
+	RETVAL = ccs_disconnect(desc);
+    OUTPUT:
+    RETVAL
+
+int
+get(self, desc, query, rtn)
+    int desc;
+    const char *query;
+    char *rtn;
+    CODE:
+	RETVAL = ccs_get(desc, query, &rtn);
+    OUTPUT:
+    RETVAL
+    rtn
+
+int
+get_list(self, desc, query, rtn)
+    int desc;
+    const char *query;
+    char *rtn;
+    CODE:
+	RETVAL = ccs_get_list(desc, query, &rtn);
+    OUTPUT:
+    RETVAL
+    rtn
+
+int
+set(self, desc, path, val)
+    int desc;
+    char *path;
+    char *val;
+    CODE:
+	RETVAL = ccs_set(desc, path, val);
+    OUTPUT:
+    RETVAL
+
+int
+lookup_nodename(self, desc, nodename, rtn)
+    int desc;
+    const char *nodename;
+    char *rtn;
+    CODE:
+	RETVAL = ccs_lookup_nodename(desc, nodename, &rtn);
+    OUTPUT:
+    RETVAL
+    rtn
diff --git a/bindings/perl/ccs/MANIFEST b/bindings/perl/ccs/MANIFEST
new file mode 100644
index 0000000..c089dd7
--- /dev/null
+++ b/bindings/perl/ccs/MANIFEST
@@ -0,0 +1,7 @@
+CCS.pm
+CCS.xs
+Makefile.PL
+MANIFEST
+test.pl
+typemap
+META.yml                                 Module meta-data (added by MakeMaker)
diff --git a/bindings/perl/ccs/META.yml b/bindings/perl/ccs/META.yml
new file mode 100644
index 0000000..eda2445
--- /dev/null
+++ b/bindings/perl/ccs/META.yml
@@ -0,0 +1,13 @@
+--- #YAML:1.0
+name:                Cluster-CCS
+version:             0.01
+abstract:            ~
+license:             ~
+author:              
+    - Fabio M. Di Nitto <fdinitto@redhat.com>
+generated_by:        ExtUtils::MakeMaker version 6.42
+distribution_type:   module
+requires:     
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3
diff --git a/bindings/perl/ccs/Makefile.PL b/bindings/perl/ccs/Makefile.PL
new file mode 100644
index 0000000..b5504ea
--- /dev/null
+++ b/bindings/perl/ccs/Makefile.PL
@@ -0,0 +1,28 @@
+use ExtUtils::MakeMaker;
+
+my %INFOS = (
+    'NAME'	=> 'Cluster::CCS',
+    'VERSION_FROM' => 'CCS.pm', # finds $VERSION
+    'AUTHOR'	=> 'Fabio M. Di Nitto <fdinitto@redhat.com>',
+    'ABSTRACT'	=> 'Interface to Cluster Configuration Service library',
+);
+
+# read extra configurations from the commandline
+my %params;
+ at params{qw(DEBUG DEFINE EXTRALIBDIR GDOME INC LIBS SKIP_SAX_INSTALL XMLPREFIX)}=();
+
+ at ARGV = grep {
+  my ($key, $val) = split(/=/, $_, 2);
+  if (exists $params{$key}) {
+    $config{$key} = $val; 0
+  } else { 1 }
+} @ARGV;
+
+$extralibdir = $config{EXTRALIBDIR};
+delete $config{EXTRALIBDIR};
+
+WriteMakefile(
+              %INFOS,
+              %config,
+);
+
diff --git a/bindings/perl/ccs/test.pl b/bindings/perl/ccs/test.pl
new file mode 100644
index 0000000..64d740d
--- /dev/null
+++ b/bindings/perl/ccs/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 Cluster::CCS;
+$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):
+
diff --git a/bindings/perl/ccs/typemap b/bindings/perl/ccs/typemap
new file mode 100644
index 0000000..267d1e5
--- /dev/null
+++ b/bindings/perl/ccs/typemap
@@ -0,0 +1,14 @@
+TYPEMAP
+unsigned int *    T_PTROBJ
+char **           T_PTROBJ
+int *             T_PTROBJ
+char const *      T_PTROBJ
+struct sockaddr_in * T_sockaddr_in
+
+INPUT
+T_sockaddr_in
+    $var = ($type)SvPV($arg,na)
+
+OUTPUT
+T_sockaddr_in
+    sv_setpvn($arg, (char *)$var, sizeof(struct sockaddr_in));
diff --git a/configure b/configure
index ae90287..72053a6 100755
--- a/configure
+++ b/configure
@@ -387,6 +387,13 @@ if (! -d "$objdir/make") {
   symlinks("gnbd-kernel","*.h");
   symlinks("gfs-kernel","*.c");
   symlinks("gfs-kernel","*.h");
+  symlinks("bindings","*.pl");
+  symlinks("bindings","*.pm");
+  symlinks("bindings","*.xs");
+  symlinks("bindings","*.PL");
+  symlinks("bindings","MANIFEST");
+  symlinks("bindings","META.yml");
+  symlinks("bindings","typemap");
 } else {
   print "nothing to do\n";
 }