[svn.haxx.se] · SVN Dev · SVN Users · SVN Org · TSVN Dev · TSVN Users · Subclipse Dev · Subclipse Users · this month's index

Re: [PATCH] work in progress perl typemaps for swig

From: Chia-liang Kao <clkao_at_clkao.org>
Date: 2003-07-16 12:08:38 CEST

the last one was just a quick snap for people interested. here comes
the one with wrapper classes. :)

On Wed, Jul 16, 2003 at 12:35:03AM -0700, Greg Stein wrote:
> How about a log message for this patch? Please see the patch posting
> guidelines in HACKING.

log message:

Some works on the swig perl binding support, including some typemap
code and high level wrapper classes. now you could do:

my $pool = SVN::Core::pool_create(undef);
print SVN::Repos->open ('/Users/clkao/svn/pairang',
                        $pool)->fs->youngest_rev ($pool);

The Base class strips defined prefix of functions to be imported into
the module's namespace.

* core.i: Finish typemaps.
* svn_type.i: Typemaps for returned param and apr_pool_t.
* apr.i: Comment the perl sections so it's easier to fix things
  later on.
* perl/Makefile.PL: perl binding's builder (for now).
* perl/Base.pm: Base class for exporting symbol to wrapper classes.
* perl/Client.pm: New file.
* perl/Core.pm: New file.
* perl/Delta.pm: New file.
* perl/Fs.pm: New file.
* perl/Ra.pm: New file.
* perl/Repos.pm: New file.
* perl/Wc.pm: New file.

Index: core.i
===================================================================
--- core.i (revision 6452)
+++ core.i (working copy)
@@ -141,7 +141,9 @@
     $2 = ($2_ltype)&temp;
 }
 %typemap(perl5, in) (char *buffer, apr_size_t *len) ($*2_type temp) {
- /* ### FIXME-perl */
+ temp = SvIV($input);
+ $1 = malloc(temp);
+ $2 = ($2_ltype)&temp;
 }
 
 /* ### need to use freearg or somesuch to ensure the string is freed.
@@ -152,7 +154,8 @@
     free($1);
 }
 %typemap(perl5, argout) (char *buffer, apr_size_t *len) {
- /* ### FIXME-perl */
+ $result = newSVpvn($1, $2);
+ free($1);
 }
 
 /* -----------------------------------------------------------------------
@@ -169,7 +172,7 @@
     $2 = ($2_ltype)&temp;
 }
 %typemap(perl5, in) (const char *data, apr_size_t *len) ($*2_type temp) {
- /* ### FIXME-perl */
+ $1 = SvPV($input, *$2);
 }
 
 %typemap(python, argout, fragment="t_output_helper") (const char *data, apr_size_t *len) {
@@ -177,7 +180,8 @@
 }
 
 %typemap(perl5, argout, fragment="t_output_helper") (const char *data, apr_size_t *len) {
- /* ### FIXME-perl */
+ $result = newSViv(*$2);
+
 }
 
 /* -----------------------------------------------------------------------
@@ -191,7 +195,30 @@
     }
 }
 %typemap(perl5, in) FILE * {
- /* ### FIXME-perl */
+ dSP ;
+ int count, fd ;
+
+ ENTER ;
+ SAVETMPS;
+
+ PUSHMARK(SP) ;
+ XPUSHs($input);
+ PUTBACK ;
+
+ count = call_pv("fileno", G_SCALAR);
+ SPAGAIN ;
+
+ if (count != 1)
+ croak("Big trouble\n") ;
+
+ if (fd = POPi < 0)
+ croak("not an accessible filehandle");
+
+ $1 = fdopen (fd, "r+");
+
+ PUTBACK ;
+ FREETMPS ;
+ LEAVE ;
 }
 
 /* -----------------------------------------------------------------------
Index: svn_types.i
===================================================================
--- svn_types.i (revision 6452)
+++ svn_types.i (working copy)
@@ -34,12 +34,16 @@
 %typemap(java, in) SWIGTYPE **OUTPARAM ($*1_type temp) {
     $1 = ($1_ltype)&temp;
 }
+%typemap(perl5, in) SWIGTYPE **OUTPARAM ($*1_type temp) {
+ $1 = ($1_ltype)&temp;
+}
 %typemap(python, argout, fragment="t_output_helper") SWIGTYPE **OUTPARAM {
     $result = t_output_helper($result,
                               SWIG_NewPointerObj(*$1, $*1_descriptor, 0));
 }
 %typemap(perl5, argout) SWIGTYPE **OUTPARAM {
- /* ### FIXME-perl */
+ ST(argvi) = sv_newmortal();
+ SWIG_MakePtr(ST(argvi++), (void *)*$1, $*1_descriptor,0);
 }
 
 /* -----------------------------------------------------------------------
@@ -192,7 +196,9 @@
     _global_pool = $1;
 }
 %typemap(perl5, arginit) apr_pool_t *pool(apr_pool_t *_global_pool) {
- /* ### FIXME-perl */
+ SWIG_ConvertPtr(ST($argnum-1),
+ (void **)&$1, $1_descriptor, 0);
+ _global_pool = $1;
 }
 
 %typemap(java, arginit) apr_pool_t *pool(apr_pool_t *_global_pool) {
Index: perl/Repos.pm
===================================================================
--- perl/Repos.pm (working copy)
+++ perl/Repos.pm (working copy)
@@ -0,0 +1,13 @@
+package SVN::Repos;
+use SVN::Base qw(Repos svn_repos_);
+
+package _p_svn_repos_t;
+
+my @methods = qw/fs/;
+
+for (@methods) {
+ *{$_} = *{"SVN::Repos::$_"};
+}
+
+
+1;
Index: perl/Fs.pm
===================================================================
--- perl/Fs.pm (working copy)
+++ perl/Fs.pm (working copy)
@@ -0,0 +1,13 @@
+package SVN::Fs;
+use SVN::Base qw(Fs svn_fs_);
+
+package _p_svn_fs_t;
+
+my @methods = qw/youngest_rev/;
+
+for (@methods) {
+ *{$_} = *{"SVN::Fs::$_"};
+}
+
+
+1;
Index: perl/Core.pm
===================================================================
--- perl/Core.pm (working copy)
+++ perl/Core.pm (working copy)
@@ -0,0 +1,13 @@
+package SVN::Core;
+use SVN::Base qw(Core svn_);
+
+BEGIN {
+ SVN::_Core::apr_initialize;
+
+}
+
+END {
+ SVN::_Core::apr_terminate;
+}
+
+1;
Index: perl/Wc.pm
===================================================================
--- perl/Wc.pm (working copy)
+++ perl/Wc.pm (working copy)
@@ -0,0 +1,11 @@
+package SVN::Wc;
+use SVN::Base qw(Wc svn_wc_);
+
+package _p_svn_wc_t;
+
+package _p_svn_wc_entry_t;
+# still need to check if the function prototype allows it to be called
+# as method.
+use SVN::Base qw(Wc svn_wc_entry_t_);
+
+1;
Index: perl/Delta.pm
===================================================================
--- perl/Delta.pm (working copy)
+++ perl/Delta.pm (working copy)
@@ -0,0 +1,4 @@
+package SVN::Delta;
+use SVN::Base qw(Delta svn_delta_);
+
+1;
Index: perl/Base.pm
===================================================================
--- perl/Base.pm (working copy)
+++ perl/Base.pm (working copy)
@@ -0,0 +1,23 @@
+package SVN::Base;
+
+sub import {
+ my (undef, $pkg, $prefix) = @_;
+ unless (defined %{"SVN::_${pkg}::"}) {
+ @{"SVN::_${pkg}::ISA"} = qw(DynaLoader);
+ eval qq'
+package SVN::_$pkg;
+require DynaLoader;
+bootstrap SVN::_$pkg;
+1;
+ ' or die $@;
+ };
+
+ for (keys %{"SVN::_${pkg}::"}) {
+ my $name = $_;
+ next unless s/^$prefix//i;
+ *{caller(0)."::$_"} = ${"SVN::_${pkg}::"}{$name};
+ }
+
+}
+
+1;
Index: perl/Makefile.PL
===================================================================
--- perl/Makefile.PL (working copy)
+++ perl/Makefile.PL (working copy)
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+use ExtUtils::MakeMaker;
+
+my @modules = qw/client delta fs ra repos wc/;
+my @ldmodules = map {"-lsvn_$_-1"} (@modules, qw/subr/);
+
+my $apr_cflags = `apr-config --includes`;
+my $apr_ldflags = `apr-config --libs`;
+
+chomp $apr_cflags;
+chomp $apr_ldflags;
+
+my %config = (
+ ABSTRACT => 'perl binding for subversion',
+ CCFLAGS => join(' ', $apr_cflags, `perl -MExtUtils::Embed -e ccopts`,
+ ' -I.. -I../../../include -g'),
+ OBJECT => q/$(O_FILES)/,
+ dynamic_lib => {
+ OTHERLDFLAGS => join(' ', $apr_ldflags, '-L/usr/local/lib',
+ @ldmodules, `swig -perl -ldflags`),
+ },
+);
+
+sub perlish {
+ local $_ = $_[0];
+ s/^(\w)/\U$1/;
+ $_;
+}
+
+WriteMakefile(%config, NAME => 'SVN::_Core', C => ['core.c'],
+ PM => {map { ("$_.pm" => "\$(INST_LIBDIR)/$_.pm") }
+ map { perlish $_ }
+ ('base', 'core', @modules)},
+ );
+
+for (@modules) {
+ WriteMakefile(%config,
+ MAKEFILE=> "Makefile.$_",
+ NAME => "SVN::_".perlish($_),
+ PM => {"$_.pm" => "\$(INST_LIBDIR)/SVN/$_.pm"},
+ C => ["svn_$_.c"],
+ );
+}
+
+sub MY::postamble {
+ package MY ;
+ return join('', "all :: modules\n\n",
+ "modules :: ",(map { " svn_$_.c"} @modules),"\n",
+ (map {"\tmake -f Makefile.$_\n"} @modules),
+ "\ncore.pm core.c :: ../core.i\n",
+ "\tswig -c -nopm -perl -I.. -I../../../include $apr_cflags -module SVN::_Core -o core.c ../core.i\n",
+ map {"\nsvn_$_.c :: ../svn_$_.i\n".
+ "\tswig -c -shadow -perl -I.. -I../../../include $apr_cflags -module SVN::_".main::perlish($_)." -o svn_$_.c ../svn_$_.i\n"}
+ @modules
+ );
+}
Index: perl/Client.pm
===================================================================
--- perl/Client.pm (working copy)
+++ perl/Client.pm (working copy)
@@ -0,0 +1,4 @@
+package SVN::Client;
+use SVN::Base qw(Client svn_client_);
+
+1;
Index: perl/Ra.pm
===================================================================
--- perl/Ra.pm (working copy)
+++ perl/Ra.pm (working copy)
@@ -0,0 +1,4 @@
+package SVN::Ra;
+use SVN::Base qw(Ra svn_ra_);
+
+1;
Index: apr.i
===================================================================
--- apr.i (revision 6452)
+++ apr.i (working copy)
@@ -44,7 +44,7 @@
     "$result = t_output_helper($result,PyInt_FromLong((long) (*$1)));";
 
 %typemap(perl5,argout) apr_off_t * {
- /* ### FIXME-perl */
+ /* ### FIXME-perl apr_off_t out*/
 }
 
 /* ----------------------------------------------------------------------- */
@@ -86,7 +86,7 @@
 }
 
 %typemap(perl5,argout) apr_time_t * {
- /* ### FIXME-perl */
+ /* ### FIXME-perl apr_time_t out */
 }
 /* -----------------------------------------------------------------------
    create some INOUT typemaps for apr_size_t
@@ -104,6 +104,8 @@
 }
 
 %typemap(perl5,in) apr_size_t *INOUT (apr_size_t temp) {
+ temp = (apr_size_t) SvIV($input);
+ $1 = &temp;
     /* ### FIXME-perl */
 }
 /* -----------------------------------------------------------------------
@@ -172,7 +174,7 @@
 }
 
 %typemap(perl5,argout) apr_hash_t **PROPHASH {
- /* ### FIXME-perl */
+ /* ### FIXME-perl apr_hash out */
 }
 /* -----------------------------------------------------------------------
   handle apr_file_t *
@@ -182,7 +184,7 @@
   $1 = svn_swig_py_make_file($input, _global_pool);
 }
 %typemap(perl5, in) apr_file_t * {
- /* ### FIXME-perl */
+ /* ### FIXME-perl apr_file_t in*/
 }
 
 /* -----------------------------------------------------------------------
@@ -198,6 +200,6 @@
         SWIG_NewPointerObj(*$1, $*1_descriptor, 0));";
 
 %typemap(perl5,argout) apr_file_t ** {
- /* ### FIXME-perl */
+ /* ### FIXME-perl apr_file_t out*/
 }
 /* ----------------------------------------------------------------------- */

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@subversion.tigris.org
For additional commands, e-mail: dev-help@subversion.tigris.org
Received on Wed Jul 16 12:09:17 2003

This is an archived mail posted to the Subversion Dev mailing list.

This site is subject to the Apache Privacy Policy and the Apache Public Forum Archive Policy.