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

[PATCH] new perl typemaps

From: Chia-liang Kao <clkao_at_clkao.org>
Date: 2003-07-19 09:11:15 CEST

Hi,

So here's the latest swig typemaps for perl.
Makefile.PL-based build support high level wrappers are now
at http://svn.elixus.org/member/clkao/svn-perl, you could
check out to bindings/swig/perl and play with it. also you
could get a taste of how the perl script looks like from
test.pl in the above repository. I will write some usual
t/ scripts for regression tests.

Also now pools are optional for callers of the perl functions.
There will be more default pool supporting function soon.
Maybe the python binding could use the default pool stuff.

log message:

Swig perl binding typemaps and support function

* swigutil_pl.[ch]: Implement hash and array convertors and get_logs
  gluing callback.
* apr.i: wrap apr_size_t, apr_hash_t **, PROPHASH, apr_file_t **.
* svn_*.i: include swigutil_pl.h.
* svn_repos.i: wrap baton of get_logs with svn_swig_pl_thunk_log_receiver.
* svn_fs.i: wrap apr_hash_t **entries_p.
* string.i: convert array of strings.
* svn_types.i: wrap generic outparam, default pool handling.
* core.i: wrap FILE *, *ptr/*len pari, and ignore svn_opt_print_generic_help
  not following the pool convention.
* svn_ra.i: ignore svn_ra_{svn,local,dav}_init, as they shouldn't
  be public and don't follow the pool convention.

Index: svn_ra.i
===================================================================
--- svn_ra.i (revision 6452)
+++ svn_ra.i (working copy)
@@ -24,6 +24,12 @@
 %import svn_string.i
 %import svn_delta.i
 
+/* bad pool convention, also these should not be public interface at all
+ as commented by sussman */
+%ignore svn_ra_svn_init;
+%ignore svn_ra_local_init;
+%ignore svn_ra_dav_init;
+
 /* -----------------------------------------------------------------------
    these types (as 'type **') will always be an OUT param
 */
@@ -44,4 +50,8 @@
 #ifdef SWIGJAVA
 #include "swigutil_java.h"
 #endif
+
+#ifdef SWIGPERL
+#include "swigutil_pl.h"
+#endif
 %}
Index: core.i
===================================================================
--- core.i (revision 6452)
+++ core.i (working copy)
@@ -31,10 +31,6 @@
 */
 %ignore svn_error;
 
-/* ### for now, let's not try to handle these structures. swig complains
- ### about setting the 'const char *' inside the struct might leak mem */
-%ignore svn_log_changed_path_t;
-
 /* ### We also get complaints about possible memory leakage for svn_dirent,
    ### but we can live with it for now. */
 /* %ignore svn_dirent; */
@@ -78,6 +74,9 @@
 
 %ignore apr_check_dir_empty;
 
+/* bad pool convention */
+%ignore svn_opt_print_generic_help;
+
 /* scripts can do the printf, then write to a stream. we can't really
    handle the variadic, so ignore it. */
 %ignore svn_stream_printf;
@@ -141,7 +140,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 +153,9 @@
     free($1);
 }
 %typemap(perl5, argout) (char *buffer, apr_size_t *len) {
- /* ### FIXME-perl */
+ $result = sv_2mortal(newSVpvn($1, *$2));
+ argvi++;
+ 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 ;
 }
 
 /* -----------------------------------------------------------------------
@@ -253,4 +280,8 @@
 #include "swigutil_java.h"
 #endif
 
+#ifdef SWIGPERL
+#include "swigutil_pl.h"
+#endif
+
 %}
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, numinputs=0) 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);
 }
 
 /* -----------------------------------------------------------------------
@@ -136,6 +140,8 @@
 %typemap(python,argout,fragment="t_output_helper") svn_filesize_t *
     "$result = t_output_helper($result,PyInt_FromLong((long) (*$1)));";
 
+%apply long *OUTPUT { svn_filesize_t * };
+
 /* -----------------------------------------------------------------------
    Define a general ptr/len typemap. This takes a single script argument
    and expands it into a ptr/len pair for the native call.
@@ -179,7 +185,7 @@
   }
 
 %typemap(perl5, in) (const char *PTR, apr_size_t LEN) {
- /* ### FIXME-perl */
+ /* ### FIXME-perl ptr/len */
 }
 /* -----------------------------------------------------------------------
    Define a generic arginit mapping for pools.
@@ -191,10 +197,38 @@
                     (void **)&$1, $1_descriptor, SWIG_POINTER_EXCEPTION | 0);
     _global_pool = $1;
 }
-%typemap(perl5, arginit) apr_pool_t *pool(apr_pool_t *_global_pool) {
- /* ### FIXME-perl */
+
+/*
+%typemap(perl5, arginit) apr_pool_t *pool(int _mypool) {
 }
+*/
 
+%typemap(perl5, in) apr_pool_t *pool "";
+
+%typemap(perl5, default) apr_pool_t *pool(apr_pool_t *_global_pool) {
+ SV *pool = ST(items-1);
+ if (pool && sv_isobject(pool) && sv_derived_from(pool, "_p_apr_pool_t")) {
+ SWIG_ConvertPtr(ST(items-1), (void **)&$1, $1_descriptor, 0);
+ current_pool = $1;
+ }
+ else {
+ if (current_pool)
+ $1 = current_pool;
+ else {
+ apr_pool_create(&$1, NULL);
+ current_pool = $1;
+ }
+ }
+ _global_pool = $1;
+}
+
+%typemap(perl5, freearg) apr_pool_t *pool {
+ /*
+ if (_global_pool_flag)
+ apr_pool_destroy(_global_pool);
+ */
+}
+
 %typemap(java, arginit) apr_pool_t *pool(apr_pool_t *_global_pool) {
     /* ### HACK: Get the input variable based on naming convention */
         _global_pool = *(apr_pool_t **)&j$1;
@@ -245,4 +279,8 @@
 #ifdef SWIGJAVA
 #include "swigutil_java.h"
 #endif
+
+#ifdef SWIGPERL
+#include "swigutil_pl.h"
+#endif
 %}
Index: svn_string.i
===================================================================
--- svn_string.i (revision 6452)
+++ svn_string.i (working copy)
@@ -166,7 +166,10 @@
         return NULL;
 }
 %typemap(perl5,in) const apr_array_header_t *STRINGLIST {
- /* ### FIXME-perl */
+ $1 = (apr_array_header_t *) svn_swig_pl_strings_to_array($input,
+ _global_pool);
+ if ($1 == NULL)
+ return NULL;
 }
 
 %typemap(jni) const apr_array_header_t *STRINGLIST "jobjectArray"
Index: swigutil_pl.c
===================================================================
--- swigutil_pl.c (revision 6452)
+++ swigutil_pl.c (working copy)
@@ -15,3 +15,142 @@
  * history and logs, available at http://subversion.tigris.org/.
  * ====================================================================
  */
+
+#include <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+
+#include <apr.h>
+#include <apr_general.h>
+
+#include "svn_pools.h"
+#include "svn_opt.h"
+
+#include "swigutil_pl.h"
+
+apr_pool_t *current_pool;
+
+SV *convert_hash (apr_hash_t *hash, SV *(*converter_func)(void *value,
+ void *ctx),
+ void *ctx)
+{
+ apr_hash_index_t *hi;
+ HV *hv;
+
+ hv = newHV();
+ for (hi = apr_hash_first(NULL, hash); hi; hi = apr_hash_next(hi)) {
+ const char *key;
+ void *val;
+ int klen;
+ SV *obj;
+
+ apr_hash_this(hi, (void *)&key, NULL, &val);
+ klen = strlen(key);
+
+ obj = converter_func (val, ctx);
+ hv_store(hv, (const char *)key, klen, obj, 0);
+ SvREFCNT_inc(obj);
+ }
+
+ return newRV_inc((SV*)hv);
+}
+
+
+SV *convert_string (const char *value, void *dummy)
+{
+ SV *obj = sv_2mortal(newSVpv(value, 0));
+ return obj;
+}
+
+SV *convert_to_swig_type (void *ptr, swig_type_info *tinfo)
+{
+ SV *obj = sv_newmortal();
+ SWIG_MakePtr(obj, ptr, tinfo, 0);
+ return obj;
+}
+
+SV *svn_swig_pl_prophash_to_hash (apr_hash_t *hash)
+{
+ return convert_hash (hash, convert_string, NULL);
+}
+
+SV *svn_swig_pl_convert_hash (apr_hash_t *hash, swig_type_info *tinfo)
+{
+ return convert_hash (hash, convert_to_swig_type, tinfo);
+}
+const apr_array_header_t *svn_swig_pl_strings_to_array(SV *source,
+ apr_pool_t *pool)
+{
+ int targlen, i;
+ apr_array_header_t *temp;
+ AV* array;
+
+ if (!(source && SvROK(source) && SvTYPE(SvRV(source)) == SVt_PVAV)) {
+ /* raise exception here */
+ return NULL;
+ }
+ array = (AV *)SvRV (source);
+ targlen = av_len (array) + 1;
+ temp = apr_array_make (pool, targlen, sizeof(const char *));
+ temp->nelts = targlen;
+
+ while (targlen--) {
+ /* more error handling here */
+ SV **item = av_fetch (array, targlen, 0);
+ APR_ARRAY_IDX(temp, targlen, const char *) = SvPV_nolen (*item);
+ }
+
+ return temp;
+}
+
+svn_error_t * svn_swig_pl_thunk_log_receiver(void *baton,
+ apr_hash_t *changed_paths,
+ svn_revnum_t rev,
+ const char *author,
+ const char *date,
+ const char *msg,
+ apr_pool_t *pool)
+{
+ SV *receiver = baton, *poolobj;
+ HV *paths;
+ swig_type_info *poolinfo = SWIG_TypeQuery("apr_pool_t *");
+
+ if (!SvOK(receiver))
+ return SVN_NO_ERROR;
+
+ dSP ;
+
+ ENTER ;
+ SAVETMPS ;
+
+ PUSHMARK(SP) ;
+ /* chpaths */
+ if (changed_paths) {
+ swig_type_info *tinfo = SWIG_TypeQuery("svn_log_changed_path_t *");
+ XPUSHs(svn_swig_pl_convert_hash(changed_paths, tinfo));
+ }
+ else
+ XPUSHs(&PL_sv_undef);
+ /* rev */
+ XPUSHs(sv_2mortal(newSViv(rev)));
+ /* author */
+ XPUSHs(author ? sv_2mortal(newSVpv(author, 0)) : &PL_sv_undef);
+ /* date */
+ XPUSHs(date ? sv_2mortal(newSVpv(date, 0)) : &PL_sv_undef);
+ /* msg */
+ XPUSHs(msg ? sv_2mortal(newSVpv(msg, 0)) : &PL_sv_undef);
+ /* pool */
+
+ poolobj = sv_newmortal();
+ SWIG_MakePtr(poolobj, (void *) pool, poolinfo, 0);
+ XPUSHs(poolobj);
+
+ PUTBACK ;
+
+ call_sv(receiver, G_DISCARD);
+
+ FREETMPS ;
+ LEAVE ;
+
+ return SVN_NO_ERROR;
+}
Index: svn_fs.i
===================================================================
--- svn_fs.i (revision 6452)
+++ svn_fs.i (working copy)
@@ -116,8 +116,9 @@
         $result,
         svn_swig_py_convert_hash(*$1, SWIGTYPE_p_svn_fs_dirent_t));
 }
+%typemap(perl5,in,numinputs=0) apr_hash_t **entries_p = apr_hash_t **OUTPUT;
 %typemap(perl5,argout) apr_hash_t **entries_p {
- /* ### FIXME-perl */
+ ST(argvi++) = svn_swig_pl_convert_hash(*$1, SWIGTYPE_p_svn_fs_dirent_t);
 }
 
 /* -----------------------------------------------------------------------
@@ -167,4 +168,8 @@
 #ifdef SWIGJAVA
 #include "swigutil_java.h"
 #endif
+
+#ifdef SWIGPERL
+#include "swigutil_pl.h"
+#endif
 %}
Index: svn_wc.i
===================================================================
--- svn_wc.i (revision 6452)
+++ svn_wc.i (working copy)
@@ -111,4 +111,8 @@
 #ifdef SWIGJAVA
 #include "swigutil_java.h"
 #endif
+
+#ifdef SWIGPERL
+#include "swigutil_pl.h"
+#endif
 %}
Index: swigutil_pl.h
===================================================================
--- swigutil_pl.h (working copy)
+++ swigutil_pl.h (working copy)
@@ -0,0 +1,83 @@
+/*
+ * swigutil_pl.h : utility functions and stuff for the SWIG Perl bindings
+ *
+ * ====================================================================
+ * Copyright (c) 2000-2003 CollabNet. All rights reserved.
+ *
+ * This software is licensed as described in the file COPYING, which
+ * you should have received as part of this distribution. The terms
+ * are also available at http://subversion.tigris.org/license-1.html.
+ * If newer versions of this license are posted there, you may use a
+ * newer version instead, at your option.
+ *
+ * This software consists of voluntary contributions made by many
+ * individuals. For exact contribution history, see the revision
+ * history and logs, available at http://subversion.tigris.org/.
+ * ====================================================================
+ */
+
+
+#ifndef SVN_SWIG_SWIGUTIL_PL_H
+#define SVN_SWIG_SWIGUTIL_PL_H
+
+#include <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+
+#include <apr.h>
+#include <apr_pools.h>
+#include <apr_strings.h>
+#include <apr_hash.h>
+#include <apr_tables.h>
+
+#include "svn_types.h"
+#include "svn_string.h"
+#include "svn_delta.h"
+#include "svn_client.h"
+#include "svn_repos.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif /* __cplusplus */
+
+
+/* If this file is being included outside of a wrapper file, then need to
+ create stubs for some of the SWIG types. */
+
+/* if SWIGEXPORT is defined, then we're in a wrapper. otherwise, we need
+ the prototypes and type definitions. */
+#ifndef SWIGEXPORT
+#define SVN_NEED_SWIG_TYPES
+#endif
+
+#ifdef SVN_NEED_SWIG_TYPES
+
+typedef struct _unnamed swig_type_info;
+
+swig_type_info *SWIG_TypeQuery(const char *name);
+
+#endif /* SVN_NEED_SWIG_TYPES */
+
+extern apr_pool_t *current_pool;
+
+SV *svn_swig_pl_prophash_to_hash (apr_hash_t *hash);
+SV *svn_swig_pl_convert_hash (apr_hash_t *hash, swig_type_info *tinfo);
+
+const apr_array_header_t *svn_swig_pl_strings_to_array(SV *source,
+ apr_pool_t *pool);
+
+
+/* thunked log receiver function. */
+svn_error_t * svn_swig_pl_thunk_log_receiver(void *py_receiver,
+ apr_hash_t *changed_paths,
+ svn_revnum_t rev,
+ const char *author,
+ const char *date,
+ const char *msg,
+ apr_pool_t *pool);
+
+#ifdef __cplusplus
+}
+#endif /* __cplusplus */
+
+#endif /* SVN_SWIG_SWIGUTIL_PY_H */
Index: svn_client.i
===================================================================
--- svn_client.i (revision 6452)
+++ svn_client.i (working copy)
@@ -265,8 +265,10 @@
 #ifdef SWIGJAVA
 #include "swigutil_java.h"
 #endif
+
+#ifdef SWIGPERL
+#include "swigutil_pl.h"
+#endif
 %}
 
 %include svn_client.h
-
-
Index: svn_repos.i
===================================================================
--- svn_repos.i (revision 6452)
+++ svn_repos.i (working copy)
@@ -24,6 +24,7 @@
 %import svn_string.i
 %import svn_fs.i
 
+
 /* -----------------------------------------------------------------------
    these types (as 'type **') will always be an OUT param
 */
@@ -50,7 +51,8 @@
 }
 %typemap(perl5, in) (svn_log_message_receiver_t receiver,
                       void *receiver_baton) {
- /* ### FIXME-perl */
+ $1 = svn_swig_pl_thunk_log_receiver;
+ $2 = (void *)$input;
 }
 
 /* -----------------------------------------------------------------------
@@ -74,4 +76,8 @@
 #ifdef SWIGJAVA
 #include "swigutil_java.h"
 #endif
+
+#ifdef SWIGPERL
+#include "swigutil_pl.h"
+#endif
 %}
Index: svn_delta.i
===================================================================
--- svn_delta.i (revision 6452)
+++ svn_delta.i (working copy)
@@ -68,4 +68,8 @@
 #ifdef SWIGJAVA
 #include "swigutil_java.h"
 #endif
+
+#ifdef SWIGPERL
+#include "swigutil_pl.h"
+#endif
 %}
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,7 +104,8 @@
 }
 
 %typemap(perl5,in) apr_size_t *INOUT (apr_size_t temp) {
- /* ### FIXME-perl */
+ temp = (apr_size_t) SvIV($input);
+ $1 = &temp;
 }
 /* -----------------------------------------------------------------------
    create an OUTPUT argument typemap for an apr_hash_t **
@@ -113,6 +114,9 @@
 %typemap(python,in,numinputs=0) apr_hash_t **OUTPUT (apr_hash_t *temp)
     "$1 = &temp;";
 
+%typemap(perl5,in,numinputs=0) apr_hash_t **OUTPUT (apr_hash_t *temp)
+ "$1 = &temp;";
+
 /* -----------------------------------------------------------------------
    create an OUTPUT argument defn for an apr_hash_t ** which is storing
    property values
@@ -172,7 +176,8 @@
 }
 
 %typemap(perl5,argout) apr_hash_t **PROPHASH {
- /* ### FIXME-perl */
+ /* ### FIXME-perl apr_hash out prophash */
+ $result = svn_swig_pl_prophash_to_hash(*$1);
 }
 /* -----------------------------------------------------------------------
   handle apr_file_t *
@@ -182,7 +187,7 @@
   $1 = svn_swig_py_make_file($input, _global_pool);
 }
 %typemap(perl5, in) apr_file_t * {
- /* ### FIXME-perl */
+ /* ### FIXME-perl apr_file_t in*/
 }
 
 /* -----------------------------------------------------------------------
@@ -197,7 +202,9 @@
         $result,
         SWIG_NewPointerObj(*$1, $*1_descriptor, 0));";
 
-%typemap(perl5,argout) apr_file_t ** {
- /* ### FIXME-perl */
+%typemap(perl5, argout) apr_file_t ** {
+ ST(argvi) = sv_newmortal();
+ SWIG_MakePtr(ST(argvi++), (void *)*$1, $*1_descriptor,0);
 }
+
 /* ----------------------------------------------------------------------- */

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@subversion.tigris.org
For additional commands, e-mail: dev-help@subversion.tigris.org
Received on Sat Jul 19 09:12:00 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.