swigutil_pl.c

subversion-1.4.3-1.tar.gz 配置svn的源码

/*
 * swigutil_pl.c: utility functions for the SWIG Perl bindings
 *
 * ====================================================================
 * Copyright (c) 2000-2004 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/.
 * ====================================================================
 */

#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

#include <stdarg.h>
#ifdef WIN32
#include <io.h>
#endif

#include <apr.h>
#include <apr_general.h>
#include <apr_portable.h>

#include "svn_pools.h"
#include "svn_opt.h"
#include "svn_private_config.h"

#include "swig_perl_external_runtime.swg"

#include "swigutil_pl.h"

/* cache SWIG_TypeQuery results in a perl hash */
static HV *type_cache = NULL;

#define _SWIG_TYPE(name) _swig_perl_type_query(name, 0)
#define POOLINFO         _SWIG_TYPE("apr_pool_t *")

static swig_type_info *_swig_perl_type_query(const char *typename, U32 klen)
{
    SV **type_info;
    swig_type_info *tinfo;

    if (!type_cache)
      type_cache = newHV();

    if (klen == 0)
      klen = strlen(typename);

    if ((type_info = hv_fetch(type_cache, typename, klen, 0)))
      return (swig_type_info *) (SvIV(*type_info));

    tinfo = SWIG_TypeQuery(typename);
    hv_store(type_cache, typename, klen, newSViv((IV)tinfo), 0);

    return tinfo;
}

/* element convertors for perl -> c */
typedef void *(*pl_element_converter_t)(SV *value, void *ctx, 
                                        apr_pool_t *pool);

static void *convert_pl_string(SV *value, void *dummy, apr_pool_t *pool)
{
    void **result = apr_palloc(pool, sizeof(void *));
    *result = SvPV_nolen(value);
    return *result;
}

static void *convert_pl_obj(SV *value, swig_type_info *tinfo, 
                            apr_pool_t *pool)
{
    void **result = apr_palloc(pool, sizeof(void *));
    if (SWIG_ConvertPtr(value, result, tinfo, 0) < 0) {
        croak("unable to convert from swig object");
    }
    return *result;
}

/* perl -> c hash convertors */
static apr_hash_t *svn_swig_pl_to_hash(SV *source,
                                       pl_element_converter_t cv,
                                       void *ctx, apr_pool_t *pool)
{
    apr_hash_t *hash;
    HV *h;
    char *key;
    I32 cnt, retlen;

    if (!(source && SvROK(source) && SvTYPE(SvRV(source)) == SVt_PVHV)) {
	return NULL;
    }

    hash = apr_hash_make(pool);
    h = (HV *)SvRV(source);
    cnt = hv_iterinit(h);
    while (cnt--) {
	SV* item = hv_iternextsv(h, &key, &retlen);
	void *val = cv(item, ctx, pool);
	apr_hash_set(hash, key, APR_HASH_KEY_STRING, val);
    }

    return hash;
}

apr_hash_t *svn_swig_pl_objs_to_hash(SV *source, swig_type_info *tinfo,
                                     apr_pool_t *pool)
{

    return svn_swig_pl_to_hash(source, (pl_element_converter_t)convert_pl_obj,
                               tinfo, pool);
}

apr_hash_t *svn_swig_pl_strings_to_hash(SV *source, apr_pool_t *pool)
{

    return svn_swig_pl_to_hash(source, convert_pl_string, NULL, pool);
}


apr_hash_t *svn_swig_pl_objs_to_hash_by_name(SV *source,
                                             const char *typename,
                                             apr_pool_t *pool)
{
    swig_type_info *tinfo = _SWIG_TYPE(typename);
    return svn_swig_pl_objs_to_hash(source, tinfo, pool);
}

/* perl -> c array convertors */
static const 
apr_array_header_t *svn_swig_pl_to_array(SV *source,
                                         pl_element_converter_t cv,
                                         void *ctx, apr_pool_t *pool)
{
    int targlen;
    apr_array_header_t *temp;
    AV* array;

    if (SvROK(source) && SvTYPE(SvRV(source)) == SVt_PVAV) {
      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 *) = cv(*item, ctx, pool);
        }
    } else if (SvOK(source)) {
        targlen = 1;
        temp = apr_array_make(pool, targlen, sizeof(const char *));
        temp->nelts = targlen;
        APR_ARRAY_IDX(temp, 0, const char *) = cv(source, ctx, pool);
    } else {
        croak("Must pass a single value or an array reference");
    }

    return temp;
}

const apr_array_header_t *svn_swig_pl_strings_to_array(SV *source,
                                                       apr_pool_t *pool)
{
  return svn_swig_pl_to_array(source, convert_pl_string, NULL, pool);
}

const apr_array_header_t *svn_swig_pl_objs_to_array(SV *source,
						    swig_type_info *tinfo,
						    apr_pool_t *pool)
{
  return svn_swig_pl_to_array(source,
                              (pl_element_converter_t)convert_pl_obj,
                              tinfo, pool);
}

/* element convertors for c -> perl */
typedef SV *(*element_converter_t)(void *value, void *ctx);

static SV *convert_string(const char *value, void *dummy)
{
    SV *obj = sv_2mortal(newSVpv(value, 0));
    return obj;
}

static SV *convert_svn_string_t(svn_string_t *value, void *dummy)
{
    SV *obj = sv_2mortal(newSVpv(value->data, value->len));
    return obj;
}

static SV *convert_to_swig_type(void *ptr, swig_type_info *tinfo)
{
    SV *obj = sv_newmortal();
    SWIG_MakePtr(obj, ptr, tinfo, 0);
    return obj;
}

static SV *convert_int(int value, void *dummy)
{
  return sv_2mortal(newSViv(value));
}

/* c -> perl hash convertors */
static SV *convert_hash(apr_hash_t *hash, element_converter_t converter_func,
                        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 sv_2mortal(newRV_noinc((SV*)hv));
}

SV *svn_swig_pl_prophash_to_hash(apr_hash_t *hash)
{
  return convert_hash(hash, (element_converter_t)convert_svn_string_t,
                      NULL);
}

SV *svn_swig_pl_convert_hash(apr_hash_t *hash, swig_type_info *tinfo)
{
  return convert_hash(hash, (element_converter_t)convert_to_swig_type,
                      tinfo);
}

/* c -> perl array convertors */
static SV *convert_array(const apr_array_header_t *array,
		  element_converter_t converter_func, void *ctx)
{
    AV *list = newAV();
    int i;

    for (i = 0; i < array->nelts; ++i) {
	void *element = APR_ARRAY_IDX(array, i, void *);
	SV *item = converter_func(element, ctx);
	av_push(list, item);
	SvREFCNT_inc(item);
    }
    return sv_2mortal(newRV_noinc((SV*)list));
}

SV *svn_swig_pl_array_to_list(const apr_array_header_t *array)
{
  return convert_array(array, (element_converter_t)convert_string, NULL);
}

/* Formerly used by pre-1.0 APIs. Now unused
SV *svn_swig_pl_ints_to_list(const apr_array_header_t *array)
{
    return convert_array (array, (element_converter_t)convert_int, NULL);
}
*/

SV *svn_swig_pl_convert_array(const apr_array_header_t *array,
                              swig_type_info *tinfo)
{
  return convert_array(array, (element_converter_t)convert_to_swig_type,
                       tinfo);		          
}

/* put the va_arg in stack and invoke caller_func with func.
   fmt:
   * O: perl object
   * i: apr_int32_t
   * u: apr_uint32_t
   * L: apr_int64_t
   * U: apr_uint64_t
   * s: string
   * S: swigtype
   * r: svn_revnum_t
   * b: svn_boolean_t
   * z: apr_size_t
   
   Please do not add C types here.  Add a new format code if needed.
   Using the underlying C types and not the APR or SVN types can break
   things if these data types change in the future or on platforms which
   use different types.

   put returned value in result if result is not NULL
*/

svn_error_t *svn_swig_pl_callback_thunk(perl_func_invoker_t caller_func,
                                        void *func,
                                        SV **result,
                                        const char *fmt, ...)
{
    const char *fp = fmt;
    va_list ap;
    int count;
    I32 call_flags = result ? G_SCALAR : (G_VOID & G_DISCARD);

    dSP ;
    ENTER ;
    SAVETMPS ;

    PUSHMARK(SP) ;

    va_start(ap, fmt);
    while (*fp) {
	char *c;
	void *o;
	SV *obj;
	swig_type_info *t;

	switch (*fp++) {
	case 'O':
          XPUSHs(va_arg(ap, SV *));
	    break;
	case 'S': /* swig object */
          o = va_arg(ap, void *);
          t = va_arg(ap, swig_type_info *);

          obj = sv_newmortal();
          SWIG_MakePtr(obj, o, t, 0);
	    XPUSHs(obj);
	    break;

	case 's': /* string */
          c = va_arg(ap, char *);
	    XPUSHs(c ? sv_2mortal(newSVpv(c, 0)) : &PL_sv_undef);
	    break;

	case 'i': /* apr_int32_t */
	    XPUSHs(sv_2mortal(newSViv(va_arg(ap, apr_int32_t))));
	    break;

	case 'u': /* apr_uint32_t */
            XPUSHs(sv_2mortal(newSViv(va_arg(ap, apr_uint32_t))));
	    break;

	case 'r': /* svn_revnum_t */
	    XPUSHs(sv_2mortal(newSViv(va_arg(ap, svn_revnum_t))));
	    break;

	case 'b': /* svn_boolean_t */
	    XPUSHs(sv_2mortal(newSViv(va_arg(ap, svn_boolean_t))));
	    break;
	    
	case 'L': /* apr_int64_t */
	    /* Pass into perl as a string because some implementations may
	     * not be able to handle a 64-bit int.  If it's too long to
	     * fit in Perl's interal IV size then perl will only make
	     * it available as a string.  If not then perl will convert
	     * it to an IV for us.  So this handles the problem gracefully */
	    c = malloc(30);
	    snprintf(c,30,"%" APR_INT64_T_FMT,va_arg(ap, apr_int64_t));
	    XPUSHs(sv_2mortal(newSVpv(c, 0)));
	    free(c);
	    break;
	    
	case 'U': /* apr_uint64_t */
	    c = malloc(30);
	    snprintf(c,30,"%" APR_UINT64_T_FMT,va_arg(ap, apr_uint64_t));
	    XPUSHs(sv_2mortal(newSVpv(c, 0)));
	    free(c);
	    break;

	case 'z': /* apr_size_t */
	    if (sizeof(apr_size_t) >= 8)
	      {
	        c = malloc(30);
	        snprintf(c,30,"%" APR_SIZE_T_FMT,va_arg(ap, apr_size_t));
	        XPUSHs(sv_2mortal(newSVpv(c, 0)));
	        free(c);
	      }
	    else
	      {
	        XPUSHs(sv_2mortal(newSViv(va_arg(ap, apr_size_t))));
	      }
	     break;
	}
    }

    va_end(ap);

    PUTBACK;
    switch (caller_func) {
    case CALL_SV:
      count = call_sv(func, call_flags );
	break;
    case CALL_METHOD:
      count = call_method(func, call_flags );
	break;
    default:
      croak("unkonwn calling type");
	break;
    }
    SPAGAIN ;

    if (((call_flags & G_SCALAR) && count != 1) ||
	((call_flags & G_VOID) && count != 0))
      croak("Wrong number of returns");

    if (result) {
	*result = POPs;
	SvREFCNT_inc(*result);
    }

    PUTBACK;
    FREETMPS ;
    LEAVE ;

    return SVN_NO_ERROR;
}

/*** Editor Wrapping ***/

/* this could be more perlish */
typedef struct {
    SV *editor;     /* the editor handling the callbacks */
    SV *baton;      /* the dir/file baton (or NULL for edit baton) */
} item_baton;

static item_baton * make_baton(apr_pool_t *pool,
                               SV *editor, SV *baton)
{
    item_baton *newb = apr_palloc(pool, sizeof(*newb));

    newb->editor = editor;
    newb->baton = baton;

    return newb;
}

static svn_error_t * close_baton(void *baton, const char *method, apr_pool_t *pool)
{
    item_baton *ib = baton;

    if (ib->baton) {
      SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
                                         (void *)method, NULL,
                                         "OOS", ib->editor, ib->baton,
                                         pool, POOLINFO));
        SvREFCNT_dec(ib->baton);
    }
    else {
      SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
                                         (void *)method, NULL,
                                         "OS", ib->editor, pool, POOLINFO));
    }

    return SVN_NO_ERROR;
}

static svn_error_t * thunk_set_target_revision(void *edit_baton,
                                               svn_revnum_t target_revision,
                                               apr_pool_t *pool)
{
    item_baton *ib = edit_baton;

    SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
                                       (void *)"set_target_revision", NULL,
                                       "Or", ib->editor, target_revision));

    return SVN_NO_ERROR;
}

static svn_error_t * thunk_open_root(void *edit_baton,
                                     svn_revnum_t base_revision,
                                     apr_pool_t *dir_pool,
                                     void **root_baton)
{
    item_baton *ib = edit_baton;
    SV *result;