From mboxrd@z Thu Jan 1 00:00:00 1970 From: Fabio M. Di Nitto Date: Tue, 29 Jul 2008 19:39:34 +0000 (UTC) Subject: [Cluster-devel] bindings/perl configure Message-ID: <20080729193934.0998D12001F@lists.fedorahosted.org> List-Id: To: cluster-devel.redhat.com MIME-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit 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 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 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 + +=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 +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 ', + '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"; }