subversion/bindings/swig/perl/libsvn_swig_perl/swigutil_pl.c

   1 /*
   2  * swigutil_pl.c: utility functions for the SWIG Perl bindings
   3  *
   4  * ====================================================================
   5  * Copyright (c) 2000-2006 CollabNet.  All rights reserved.
   6  *
   7  * This software is licensed as described in the file COPYING, which
   8  * you should have received as part of this distribution.  The terms
   9  * are also available at http://subversion.tigris.org/license-1.html.
  10  * If newer versions of this license are posted there, you may use a
  11  * newer version instead, at your option.
  12  *
  13  * This software consists of voluntary contributions made by many
  14  * individuals.  For exact contribution history, see the revision
  15  * history and logs, available at http://subversion.tigris.org/.
  16  * ====================================================================
  17  */
  18
  19 #include <EXTERN.h>
  20 #include <perl.h>
  21 #include <XSUB.h>
  22
  23 #include <stdarg.h>
  24 #ifdef WIN32
  25 #include <io.h>
  26 #endif
  27
  28 #include <apr.h>
  29 #include <apr_general.h>
  30 #include <apr_portable.h>
  31
  32 #include "svn_pools.h"
  33 #include "svn_opt.h"
  34 #include "svn_private_config.h"
  35
  36 #include "swig_perl_external_runtime.swg"
  37
  38 #include "swigutil_pl.h"
  39
  40 /* cache SWIG_TypeQuery results in a perl hash */
  41 static HV *type_cache = NULL;
  42
  43 #define _SWIG_TYPE(name) _swig_perl_type_query(name, 0)
  44 #define POOLINFO         _SWIG_TYPE("apr_pool_t *")
  45
  46 static swig_type_info *_swig_perl_type_query(const char *typename, U32 klen)
  47 {
  48     SV **type_info;
  49     swig_type_info *tinfo;
  50
  51     if (!type_cache)
  52       type_cache = newHV();
  53
  54     if (klen == 0)
  55       klen = strlen(typename);
  56
  57     if ((type_info = hv_fetch(type_cache, typename, klen, 0)))
  58       return (swig_type_info *) (SvIV(*type_info));
  59
  60     tinfo = SWIG_TypeQuery(typename);
  61     hv_store(type_cache, typename, klen, newSViv((IV)tinfo), 0);
  62
  63     return tinfo;
  64 }
  65
  66 /* element convertors for perl -> c */
  67 typedef void *(*pl_element_converter_t)(SV *value, void *ctx,
  68                                         apr_pool_t *pool);
  69
  70 static void *convert_pl_string(SV *value, void *dummy, apr_pool_t *pool)
  71 {
  72     void **result = apr_palloc(pool, sizeof(void *));
  73     *result = SvPV_nolen(value);
  74     return *result;
  75 }
  76
  77 static void *convert_pl_obj(SV *value, swig_type_info *tinfo,
  78                             apr_pool_t *pool)
  79 {
  80     void **result = apr_palloc(pool, sizeof(void *));
  81     if (SWIG_ConvertPtr(value, result, tinfo, 0) < 0) {
  82         croak("unable to convert from swig object");
  83     }
  84     return *result;
  85 }
  86
  87 /* perl -> c hash convertors */
  88 static apr_hash_t *svn_swig_pl_to_hash(SV *source,
  89                                        pl_element_converter_t cv,
  90                                        void *ctx, apr_pool_t *pool)
  91 {
  92     apr_hash_t *hash;
  93     HV *h;
  94     char *key;
  95     I32 cnt, retlen;
  96
  97     if (!(source && SvROK(source) && SvTYPE(SvRV(source)) == SVt_PVHV)) {
  98         return NULL;
  99     }
 100
 101     hash = apr_hash_make(pool);
 102     h = (HV *)SvRV(source);
 103     cnt = hv_iterinit(h);
 104     while (cnt--) {
 105         SV* item = hv_iternextsv(h, &key, &retlen);
 106         void *val = cv(item, ctx, pool);
 107         apr_hash_set(hash, key, APR_HASH_KEY_STRING, val);
 108     }
 109
 110     return hash;
 111 }
 112
 113 apr_hash_t *svn_swig_pl_objs_to_hash(SV *source, swig_type_info *tinfo,
 114                                      apr_pool_t *pool)
 115 {
 116
 117     return svn_swig_pl_to_hash(source, (pl_element_converter_t)convert_pl_obj,
 118                                tinfo, pool);
 119 }
 120
 121 apr_hash_t *svn_swig_pl_strings_to_hash(SV *source, apr_pool_t *pool)
 122 {
 123
 124     return svn_swig_pl_to_hash(source, convert_pl_string, NULL, pool);
 125 }
 126
 127
 128 apr_hash_t *svn_swig_pl_objs_to_hash_by_name(SV *source,
 129                                              const char *typename,
 130                                              apr_pool_t *pool)
 131 {
 132     swig_type_info *tinfo = _SWIG_TYPE(typename);
 133     return svn_swig_pl_objs_to_hash(source, tinfo, pool);
 134 }
 135
 136 /* perl -> c array convertors */
 137 static const
 138 apr_array_header_t *svn_swig_pl_to_array(SV *source,
 139                                          pl_element_converter_t cv,
 140                                          void *ctx, apr_pool_t *pool)
 141 {
 142     int targlen;
 143     apr_array_header_t *temp;
 144     AV* array;
 145
 146     if (SvROK(source) && SvTYPE(SvRV(source)) == SVt_PVAV) {
 147       array = (AV *)SvRV(source);
 148       targlen = av_len(array) + 1;
 149       temp = apr_array_make(pool, targlen, sizeof(const char *));
 150         temp->nelts = targlen;
 151
 152         while (targlen--) {
 153             /* more error handling here */
 154           SV **item = av_fetch(array, targlen, 0);
 155           APR_ARRAY_IDX(temp, targlen, const char *) = cv(*item, ctx, pool);
 156         }
 157     } else if (SvOK(source)) {
 158         targlen = 1;
 159         temp = apr_array_make(pool, targlen, sizeof(const char *));
 160         temp->nelts = targlen;
 161         APR_ARRAY_IDX(temp, 0, const char *) = cv(source, ctx, pool);
 162     } else {
 163         croak("Must pass a single value or an array reference");
 164     }
 165
 166     return temp;
 167 }
 168
 169 const apr_array_header_t *svn_swig_pl_strings_to_array(SV *source,
 170                                                        apr_pool_t *pool)
 171 {
 172   return svn_swig_pl_to_array(source, convert_pl_string, NULL, pool);
 173 }
 174
 175 const apr_array_header_t *svn_swig_pl_objs_to_array(SV *source,
 176                                                     swig_type_info *tinfo,
 177                                                     apr_pool_t *pool)
 178 {
 179   return svn_swig_pl_to_array(source,
 180                               (pl_element_converter_t)convert_pl_obj,
 181                               tinfo, pool);
 182 }
 183
 184 /* element convertors for c -> perl */
 185 typedef SV *(*element_converter_t)(void *value, void *ctx);
 186
 187 static SV *convert_string(const char *value, void *dummy)
 188 {
 189     SV *obj = sv_2mortal(newSVpv(value, 0));
 190     return obj;
 191 }
 192
 193 static SV *convert_svn_string_t(svn_string_t *value, void *dummy)
 194 {
 195     SV *obj = sv_2mortal(newSVpv(value->data, value->len));
 196     return obj;
 197 }
 198
 199 static SV *convert_to_swig_type(void *ptr, swig_type_info *tinfo)
 200 {
 201     SV *obj = sv_newmortal();
 202     SWIG_MakePtr(obj, ptr, tinfo, 0);
 203     return obj;
 204 }
 205
 206 static SV *convert_int(int value, void *dummy)
 207 {
 208   return sv_2mortal(newSViv(value));
 209 }
 210
 211 /* c -> perl hash convertors */
 212 static SV *convert_hash(apr_hash_t *hash, element_converter_t converter_func,
 213                         void *ctx)
 214 {
 215     apr_hash_index_t *hi;
 216     HV *hv;
 217
 218     hv = newHV();
 219     for (hi = apr_hash_first(NULL, hash); hi; hi = apr_hash_next(hi)) {
 220         const char *key;
 221         void *val;
 222         int klen;
 223         SV *obj;
 224
 225         apr_hash_this(hi, (void *)&key, NULL, &val);
 226         klen = strlen(key);
 227
 228         obj = converter_func(val, ctx);
 229         hv_store(hv, (const char *)key, klen, obj, 0);
 230         SvREFCNT_inc(obj);
 231     }
 232
 233     return sv_2mortal(newRV_noinc((SV*)hv));
 234 }
 235
 236 SV *svn_swig_pl_prophash_to_hash(apr_hash_t *hash)
 237 {
 238   return convert_hash(hash, (element_converter_t)convert_svn_string_t,
 239                       NULL);
 240 }
 241
 242 SV *svn_swig_pl_convert_hash(apr_hash_t *hash, swig_type_info *tinfo)
 243 {
 244   return convert_hash(hash, (element_converter_t)convert_to_swig_type,
 245                       tinfo);
 246 }
 247
 248 /* c -> perl array convertors */
 249 static SV *convert_array(const apr_array_header_t *array,
 250                   element_converter_t converter_func, void *ctx)
 251 {
 252     AV *list = newAV();
 253     int i;
 254
 255     for (i = 0; i < array->nelts; ++i) {
 256         void *element = APR_ARRAY_IDX(array, i, void *);
 257         SV *item = converter_func(element, ctx);
 258         av_push(list, item);
 259         SvREFCNT_inc(item);
 260     }
 261     return sv_2mortal(newRV_noinc((SV*)list));
 262 }
 263
 264 SV *svn_swig_pl_array_to_list(const apr_array_header_t *array)
 265 {
 266   return convert_array(array, (element_converter_t)convert_string, NULL);
 267 }
 268
 269 /* Formerly used by pre-1.0 APIs. Now unused
 270 SV *svn_swig_pl_ints_to_list(const apr_array_header_t *array)
 271 {
 272     return convert_array (array, (element_converter_t)convert_int, NULL);
 273 }
 274 */
 275
 276 SV *svn_swig_pl_convert_array(const apr_array_header_t *array,
 277                               swig_type_info *tinfo)
 278 {
 279   return convert_array(array, (element_converter_t)convert_to_swig_type,
 280                        tinfo);
 281 }
 282
 283 /* put the va_arg in stack and invoke caller_func with func.
 284    fmt:
 285    * O: perl object
 286    * i: apr_int32_t
 287    * u: apr_uint32_t
 288    * L: apr_int64_t
 289    * U: apr_uint64_t
 290    * s: string
 291    * S: swigtype
 292    * r: svn_revnum_t
 293    * b: svn_boolean_t
 294    * t: svn_string_t
 295    * z: apr_size_t
 296
 297    Please do not add C types here.  Add a new format code if needed.
 298    Using the underlying C types and not the APR or SVN types can break
 299    things if these data types change in the future or on platforms which
 300    use different types.
 301
 302    put returned value in result if result is not NULL
 303 */
 304
 305 svn_error_t *svn_swig_pl_callback_thunk(perl_func_invoker_t caller_func,
 306                                         void *func,
 307                                         SV **result,
 308                                         const char *fmt, ...)
 309 {
 310     const char *fp = fmt;
 311     va_list ap;
 312     int count;
 313     I32 call_flags = result ? G_SCALAR : (G_VOID & G_DISCARD);
 314
 315     dSP ;
 316     ENTER ;
 317     SAVETMPS ;
 318
 319     PUSHMARK(SP) ;
 320
 321     va_start(ap, fmt);
 322     while (*fp) {
 323         char *c;
 324         void *o;
 325         SV *obj;
 326         swig_type_info *t;
 327         svn_string_t *str;
 328
 329         switch (*fp++) {
 330         case 'O':
 331           XPUSHs(va_arg(ap, SV *));
 332             break;
 333         case 'S': /* swig object */
 334           o = va_arg(ap, void *);
 335           t = va_arg(ap, swig_type_info *);
 336
 337           obj = sv_newmortal();
 338           SWIG_MakePtr(obj, o, t, 0);
 339             XPUSHs(obj);
 340             break;
 341
 342         case 's': /* string */
 343           c = va_arg(ap, char *);
 344             XPUSHs(c ? sv_2mortal(newSVpv(c, 0)) : &PL_sv_undef);
 345             break;
 346
 347         case 'i': /* apr_int32_t */
 348             XPUSHs(sv_2mortal(newSViv(va_arg(ap, apr_int32_t))));
 349             break;
 350
 351         case 'u': /* apr_uint32_t */
 352             XPUSHs(sv_2mortal(newSViv(va_arg(ap, apr_uint32_t))));
 353             break;
 354
 355         case 'r': /* svn_revnum_t */
 356             XPUSHs(sv_2mortal(newSViv(va_arg(ap, svn_revnum_t))));
 357             break;
 358
 359         case 'b': /* svn_boolean_t */
 360             XPUSHs(sv_2mortal(newSViv(va_arg(ap, svn_boolean_t))));
 361             break;
 362
 363         case 't': /* svn_string_t */
 364             str = va_arg(ap, svn_string_t *);
 365             XPUSHs(str ? sv_2mortal(newSVpv(str->data, str->len))
 366                    : &PL_sv_undef);
 367             break;
 368
 369         case 'L': /* apr_int64_t */
 370             /* Pass into perl as a string because some implementations may
 371              * not be able to handle a 64-bit int.  If it's too long to
 372              * fit in Perl's interal IV size then perl will only make
 373              * it available as a string.  If not then perl will convert
 374              * it to an IV for us.  So this handles the problem gracefully */
 375             c = malloc(30);
 376             snprintf(c,30,"%" APR_INT64_T_FMT,va_arg(ap, apr_int64_t));
 377             XPUSHs(sv_2mortal(newSVpv(c, 0)));
 378             free(c);
 379             break;
 380
 381         case 'U': /* apr_uint64_t */
 382             c = malloc(30);
 383             snprintf(c,30,"%" APR_UINT64_T_FMT,va_arg(ap, apr_uint64_t));
 384             XPUSHs(sv_2mortal(newSVpv(c, 0)));
 385             free(c);
 386             break;
 387
 388         case 'z': /* apr_size_t */
 389             if (sizeof(apr_size_t) >= 8)
 390               {
 391                 c = malloc(30);
 392                 snprintf(c,30,"%" APR_SIZE_T_FMT,va_arg(ap, apr_size_t));
 393                 XPUSHs(sv_2mortal(newSVpv(c, 0)));
 394                 free(c);
 395               }
 396             else
 397               {
 398                 XPUSHs(sv_2mortal(newSViv(va_arg(ap, apr_size_t))));
 399               }
 400              break;
 401         }
 402     }
 403
 404     va_end(ap);
 405
 406     PUTBACK;
 407     switch (caller_func) {
 408     case CALL_SV:
 409       count = call_sv(func, call_flags );
 410         break;
 411     case CALL_METHOD:
 412       count = call_method(func, call_flags );
 413         break;
 414     default:
 415       croak("unkonwn calling type");
 416         break;
 417     }
 418     SPAGAIN ;
 419
 420     if (((call_flags & G_SCALAR) && count != 1) ||
 421         ((call_flags & G_VOID) && count != 0))
 422       croak("Wrong number of returns");
 423
 424     if (result) {
 425         *result = POPs;
 426         SvREFCNT_inc(*result);
 427     }
 428
 429     PUTBACK;
 430     FREETMPS ;
 431     LEAVE ;
 432
 433     return SVN_NO_ERROR;
 434 }
 435
 436 /*** Editor Wrapping ***/
 437
 438 /* this could be more perlish */
 439 typedef struct {
 440     SV *editor;     /* the editor handling the callbacks */
 441     SV *baton;      /* the dir/file baton (or NULL for edit baton) */
 442 } item_baton;
 443
 444 static item_baton * make_baton(apr_pool_t *pool,
 445                                SV *editor, SV *baton)
 446 {
 447     item_baton *newb = apr_palloc(pool, sizeof(*newb));
 448
 449     newb->editor = editor;
 450     newb->baton = baton;
 451
 452     return newb;
 453 }
 454
 455 static svn_error_t * close_baton(void *baton, const char *method, apr_pool_t *pool)
 456 {
 457     item_baton *ib = baton;
 458
 459     if (ib->baton) {
 460       SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 461                                          (void *)method, NULL,
 462                                          "OOS", ib->editor, ib->baton,
 463                                          pool, POOLINFO));
 464         SvREFCNT_dec(ib->baton);
 465     }
 466     else {
 467       SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 468                                          (void *)method, NULL,
 469                                          "OS", ib->editor, pool, POOLINFO));
 470     }
 471
 472     return SVN_NO_ERROR;
 473 }
 474
 475 static svn_error_t * thunk_set_target_revision(void *edit_baton,
 476                                                svn_revnum_t target_revision,
 477                                                apr_pool_t *pool)
 478 {
 479     item_baton *ib = edit_baton;
 480
 481     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 482                                        (void *)"set_target_revision", NULL,
 483                                        "Or", ib->editor, target_revision));
 484
 485     return SVN_NO_ERROR;
 486 }
 487
 488 static svn_error_t * thunk_open_root(void *edit_baton,
 489                                      svn_revnum_t base_revision,
 490                                      apr_pool_t *dir_pool,
 491                                      void **root_baton)
 492 {
 493     item_baton *ib = edit_baton;
 494     SV *result;
 495
 496     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 497                                        (void *)"open_root", &result,
 498                                        "OrS", ib->editor, base_revision,
 499                                        dir_pool, POOLINFO));
 500
 501     *root_baton = make_baton(dir_pool, ib->editor, result);
 502     return SVN_NO_ERROR;
 503 }
 504
 505 static svn_error_t * thunk_delete_entry(const char *path,
 506                                         svn_revnum_t revision,
 507                                         void *parent_baton,
 508                                         apr_pool_t *pool)
 509 {
 510     item_baton *ib = parent_baton;
 511
 512     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 513                                        (void *)"delete_entry", NULL,
 514                                        "OsrOS", ib->editor, path, revision,
 515                                        ib->baton, pool, POOLINFO));
 516     return SVN_NO_ERROR;
 517 }
 518
 519 static svn_error_t * thunk_add_directory(const char *path,
 520                                          void *parent_baton,
 521                                          const char *copyfrom_path,
 522                                          svn_revnum_t copyfrom_revision,
 523                                          apr_pool_t *dir_pool,
 524                                          void **child_baton)
 525 {
 526     item_baton *ib = parent_baton;
 527     SV *result;
 528
 529     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 530                                        (void *)"add_directory", &result,
 531                                        "OsOsrS", ib->editor, path, ib->baton,
 532                                        copyfrom_path, copyfrom_revision,
 533                                        dir_pool, POOLINFO));
 534     *child_baton = make_baton(dir_pool, ib->editor, result);
 535     return SVN_NO_ERROR;
 536 }
 537
 538 static svn_error_t * thunk_open_directory(const char *path,
 539                                           void *parent_baton,
 540                                           svn_revnum_t base_revision,
 541                                           apr_pool_t *dir_pool,
 542                                           void **child_baton)
 543 {
 544     item_baton *ib = parent_baton;
 545     SV *result;
 546
 547     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 548                                        (void *)"open_directory", &result,
 549                                        "OsOrS", ib->editor, path, ib->baton,
 550                                        base_revision, dir_pool, POOLINFO));
 551
 552     *child_baton = make_baton(dir_pool, ib->editor, result);
 553
 554     return SVN_NO_ERROR;
 555 }
 556
 557 static svn_error_t * thunk_change_dir_prop(void *dir_baton,
 558                                            const char *name,
 559                                            const svn_string_t *value,
 560                                            apr_pool_t *pool)
 561 {
 562     item_baton *ib = dir_baton;
 563
 564     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 565                                        (void *)"change_dir_prop", NULL,
 566                                        "OOstS", ib->editor, ib->baton, name,
 567                                        value, pool, POOLINFO));
 568
 569     return SVN_NO_ERROR;
 570 }
 571
 572 static svn_error_t * thunk_close_directory(void *dir_baton,
 573                                            apr_pool_t *pool)
 574 {
 575     return close_baton(dir_baton, "close_directory", pool);
 576 }
 577
 578 static svn_error_t * thunk_absent_directory(const char *path,
 579                                             void *parent_baton,
 580                                             apr_pool_t *pool)
 581 {
 582     item_baton *ib = parent_baton;
 583
 584     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 585                                        (void *)"absent_directory", NULL,
 586                                        "OsOS", ib->editor, path, ib->baton,
 587                                        pool, POOLINFO));
 588
 589     return SVN_NO_ERROR;
 590 }
 591
 592 static svn_error_t * thunk_add_file(const char *path,
 593                                     void *parent_baton,
 594                                     const char *copyfrom_path,
 595                                     svn_revnum_t copyfrom_revision,
 596                                     apr_pool_t *file_pool,
 597                                     void **file_baton)
 598 {
 599     item_baton *ib = parent_baton;
 600     SV *result;
 601
 602     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 603                                        (void *)"add_file", &result,
 604                                        "OsOsrS", ib->editor, path, ib->baton,
 605                                        copyfrom_path, copyfrom_revision,
 606                                        file_pool, POOLINFO));
 607
 608     *file_baton = make_baton(file_pool, ib->editor, result);
 609     return SVN_NO_ERROR;
 610 }
 611
 612 static svn_error_t * thunk_open_file(const char *path,
 613                                      void *parent_baton,
 614                                      svn_revnum_t base_revision,
 615                                      apr_pool_t *file_pool,
 616                                      void **file_baton)
 617 {
 618     item_baton *ib = parent_baton;
 619     SV *result;
 620
 621     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 622                                        (void *)"open_file", &result,
 623                                        "OsOrS", ib->editor, path, ib->baton,
 624                                        base_revision, file_pool, POOLINFO));
 625
 626     *file_baton = make_baton(file_pool, ib->editor, result);
 627     return SVN_NO_ERROR;
 628 }
 629
 630 static svn_error_t * thunk_window_handler(svn_txdelta_window_t *window,
 631                                           void *baton)
 632 {
 633     SV *handler = baton;
 634
 635     if (window == NULL) {
 636       SVN_ERR(svn_swig_pl_callback_thunk(CALL_SV,
 637                                          handler, NULL, "O",
 638                                          &PL_sv_undef));
 639         SvREFCNT_dec(handler);
 640     }
 641     else {
 642         swig_type_info *tinfo = _SWIG_TYPE("svn_txdelta_window_t *");
 643         SVN_ERR(svn_swig_pl_callback_thunk(CALL_SV, handler,
 644                                            NULL, "S", window, tinfo));
 645     }
 646
 647     return SVN_NO_ERROR;
 648 }
 649
 650 static svn_error_t *
 651 thunk_apply_textdelta(void *file_baton,
 652                       const char *base_checksum,
 653                       apr_pool_t *pool,
 654                       svn_txdelta_window_handler_t *handler,
 655                       void **h_baton)
 656 {
 657     item_baton *ib = file_baton;
 658     SV *result;
 659
 660     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 661                                        (void *)"apply_textdelta", &result,
 662                                        "OOsS", ib->editor, ib->baton,
 663                                        base_checksum, pool, POOLINFO));
 664     if (SvOK(result)) {
 665         if (SvROK(result) && SvTYPE(SvRV(result)) == SVt_PVAV) {
 666             swig_type_info *handler_info =
 667               _SWIG_TYPE("svn_txdelta_window_handler_t");
 668             swig_type_info *void_info = _SWIG_TYPE("void *");
 669             AV *array = (AV *)SvRV(result);
 670
 671             if (SWIG_ConvertPtr(*av_fetch(array, 0, 0),
 672                                 (void **)handler, handler_info,0) < 0) {
 673                 croak("Unable to convert from SWIG Type");
 674             }
 675             if (SWIG_ConvertPtr(*av_fetch(array, 1, 0),
 676                                 h_baton, void_info,0) < 0) {
 677                 croak("Unable to convert from SWIG Type ");
 678             }
 679             SvREFCNT_dec(result);
 680         }
 681         else {
 682             *handler = thunk_window_handler;
 683             *h_baton = result;
 684         }
 685     }
 686     else {
 687         *handler = svn_delta_noop_window_handler;
 688         *h_baton = NULL;
 689     }
 690
 691     return SVN_NO_ERROR;
 692 }
 693
 694 static svn_error_t * thunk_change_file_prop(void *file_baton,
 695                                             const char *name,
 696                                             const svn_string_t *value,
 697                                             apr_pool_t *pool)
 698 {
 699     item_baton *ib = file_baton;
 700
 701     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 702                                        (void *)"change_file_prop", NULL,
 703                                        "OOstS", ib->editor, ib->baton, name,
 704                                        value, pool, POOLINFO));
 705
 706     return SVN_NO_ERROR;
 707 }
 708
 709 static svn_error_t * thunk_close_file(void *file_baton,
 710                                       const char *text_checksum,
 711                                       apr_pool_t *pool)
 712 {
 713     item_baton *ib = file_baton;
 714
 715     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 716                                        (void *)"close_file", NULL, "OOsS",
 717                                        ib->editor, ib->baton, text_checksum,
 718                                        pool, POOLINFO));
 719
 720     SvREFCNT_dec(ib->baton);
 721
 722     return SVN_NO_ERROR;
 723 }
 724
 725 static svn_error_t * thunk_absent_file(const char *path,
 726                                        void *parent_baton,
 727                                        apr_pool_t *pool)
 728 {
 729     item_baton *ib = parent_baton;
 730
 731     SVN_ERR(svn_swig_pl_callback_thunk(CALL_METHOD,
 732                                        (void *)"absent_file", NULL,
 733                                        "OsOS", ib->editor, path, ib->baton,
 734                                        pool, POOLINFO));
 735
 736     return SVN_NO_ERROR;
 737 }
 738
 739 static svn_error_t * thunk_close_edit(void *edit_baton,
 740                                       apr_pool_t *pool)
 741 {
 742     return close_baton(edit_baton, "close_edit", pool);
 743 }
 744
 745 static svn_error_t * thunk_abort_edit(void *edit_baton,
 746                                       apr_pool_t *pool)
 747 {
 748     return close_baton(edit_baton, "abort_edit", pool);
 749 }
 750
 751
 752 void
 753 svn_delta_wrap_window_handler(svn_txdelta_window_handler_t *handler,
 754                               void **h_baton,
 755                               SV *callback,
 756                               apr_pool_t *pool)
 757 {
 758     *handler = thunk_window_handler;
 759     *h_baton = callback;
 760     SvREFCNT_inc(callback);
 761     svn_swig_pl_hold_ref_in_pool(pool, callback);
 762 }
 763
 764 void svn_delta_make_editor(svn_delta_editor_t **editor,
 765                            void **edit_baton,
 766                            SV *perl_editor,
 767                            apr_pool_t *pool)
 768 {
 769   svn_delta_editor_t *thunk_editor = svn_delta_default_editor(pool);
 770
 771     thunk_editor->set_target_revision = thunk_set_target_revision;
 772     thunk_editor->open_root = thunk_open_root;
 773     thunk_editor->delete_entry = thunk_delete_entry;
 774     thunk_editor->add_directory = thunk_add_directory;
 775     thunk_editor->open_directory = thunk_open_directory;
 776     thunk_editor->change_dir_prop = thunk_change_dir_prop;
 777     thunk_editor->close_directory = thunk_close_directory;
 778     thunk_editor->absent_directory = thunk_absent_directory;
 779     thunk_editor->add_file = thunk_add_file;
 780     thunk_editor->open_file = thunk_open_file;
 781     thunk_editor->apply_textdelta = thunk_apply_textdelta;
 782     thunk_editor->change_file_prop = thunk_change_file_prop;
 783     thunk_editor->close_file = thunk_close_file;
 784     thunk_editor->absent_file = thunk_absent_file;
 785     thunk_editor->close_edit = thunk_close_edit;
 786     thunk_editor->abort_edit = thunk_abort_edit;
 787
 788     *editor = thunk_editor;
 789     *edit_baton = make_baton(pool, perl_editor, NULL);
 790     svn_swig_pl_hold_ref_in_pool(pool, perl_editor);
 791 }
 792
 793 svn_error_t *svn_swig_pl_thunk_log_receiver(void *baton,
 794                                             apr_hash_t *changed_paths,
 795                                             svn_revnum_t rev,
 796                                             const char *author,
 797                                             const char *date,
 798                                             const char *msg,
 799                                             apr_pool_t *pool)
 800 {
 801     SV *receiver = baton;
 802     swig_type_info *tinfo = _SWIG_TYPE("svn_log_changed_path_t *");
 803
 804     if (!SvOK(receiver))
 805         return SVN_NO_ERROR;
 806
 807     svn_swig_pl_callback_thunk(CALL_SV,
 808                                receiver, NULL,
 809                                "OrsssS", (changed_paths) ?
 810                                svn_swig_pl_convert_hash(changed_paths, tinfo)
 811                                : &PL_sv_undef,
 812                                rev, author, date, msg, pool, POOLINFO);
 813
 814     return SVN_NO_ERROR;
 815 }
 816
 817 svn_error_t *svn_swig_pl_thunk_history_func(void *baton,
 818                                             const char *path,
 819                                             svn_revnum_t revision,
 820                                             apr_pool_t *pool)
 821 {
 822     SV *func = baton;
 823
 824     if (!SvOK(func))
 825         return SVN_NO_ERROR;
 826
 827     svn_swig_pl_callback_thunk(CALL_SV,
 828                                func, NULL,
 829                                "srS", path, revision, pool, POOLINFO);
 830
 831     return SVN_NO_ERROR;
 832 }
 833
 834 svn_error_t *svn_swig_pl_thunk_authz_func(svn_boolean_t *allowed,
 835                                           svn_fs_root_t *root,
 836                                           const char *path,
 837                                           void *baton,
 838                                           apr_pool_t *pool)
 839 {
 840     SV *func = baton, *result;
 841
 842     if (!SvOK(func))
 843         return SVN_NO_ERROR;
 844
 845     svn_swig_pl_callback_thunk(CALL_SV,
 846                                func, &result,
 847                                "SsS", root, _SWIG_TYPE("svn_fs_root_t *"),
 848                                path, pool, POOLINFO);
 849
 850     *allowed = SvIV(result);
 851     SvREFCNT_dec(result);
 852
 853     return SVN_NO_ERROR;
 854 }
 855
 856 svn_error_t *svn_swig_pl_thunk_commit_callback(svn_revnum_t new_revision,
 857                                                const char *date,
 858                                                const char *author,
 859                                                void *baton)
 860 {
 861     if (!SvOK((SV *)baton))
 862         return SVN_NO_ERROR;
 863
 864     svn_swig_pl_callback_thunk(CALL_SV, baton, NULL,
 865                                "rss", new_revision, date, author);
 866
 867     return SVN_NO_ERROR;
 868 }
 869
 870 /* Wrap RA */
 871
 872 static svn_error_t * thunk_open_tmp_file(apr_file_t **fp,
 873                                          void *callback_baton,
 874                                          apr_pool_t *pool)
 875 {
 876     SV *result;
 877     swig_type_info *tinfo = _SWIG_TYPE("apr_file_t *");
 878
 879     svn_swig_pl_callback_thunk(CALL_METHOD, (void *)"open_tmp_file",
 880                                &result, "OS", callback_baton, pool, POOLINFO);
 881
 882     if (SWIG_ConvertPtr(result, (void *)fp, tinfo,0) < 0) {
 883         croak("Unable to convert from SWIG Type");
 884     }
 885
 886     SvREFCNT_dec(result);
 887     return SVN_NO_ERROR;
 888 }
 889
 890 svn_error_t *thunk_get_wc_prop(void *baton,
 891                                const char *relpath,
 892                                const char *name,
 893                                const svn_string_t **value,
 894                                apr_pool_t *pool)
 895 {
 896     SV *result;
 897     char *data;
 898     STRLEN len;
 899
 900     svn_swig_pl_callback_thunk(CALL_METHOD, (void *)"get_wc_prop",
 901                                &result, "OssS", baton, relpath, name,
 902                                pool, POOLINFO);
 903
 904     /* this is svn_string_t * typemap in */
 905     if (!SvOK(result) || result == &PL_sv_undef) {
 906         *value = NULL;
 907     }
 908     else if (SvPOK(result)) {
 909         data = SvPV(result, len);
 910         *value = svn_string_ncreate(data, len, pool);
 911     }
 912     else {
 913         SvREFCNT_dec(result);
 914         croak("not a string");
 915     }
 916
 917     SvREFCNT_dec(result);
 918     return SVN_NO_ERROR;
 919 }
 920
 921
 922 svn_error_t *svn_ra_make_callbacks(svn_ra_callbacks_t **cb,
 923                                    void **c_baton,
 924                                    SV *perl_callbacks,
 925                                    apr_pool_t *pool)
 926 {
 927     SV *auth_baton;
 928
 929     *cb = apr_pcalloc(pool, sizeof(**cb));
 930
 931     (*cb)->open_tmp_file = thunk_open_tmp_file;
 932     (*cb)->get_wc_prop = thunk_get_wc_prop;
 933     (*cb)->set_wc_prop = NULL;
 934     (*cb)->push_wc_prop = NULL;
 935     (*cb)->invalidate_wc_props = NULL;
 936     auth_baton = *hv_fetch((HV *)SvRV(perl_callbacks), "auth", 4, 0);
 937
 938     if (SWIG_ConvertPtr(auth_baton,
 939                         (void **)&(*cb)->auth_baton, _SWIG_TYPE("svn_auth_baton_t *"),0) < 0) {
 940         croak("Unable to convert from SWIG Type");
 941     }
 942     *c_baton = perl_callbacks;
 943     svn_swig_pl_hold_ref_in_pool(pool, perl_callbacks);
 944     return SVN_NO_ERROR;
 945 }
 946
 947 svn_error_t *svn_swig_pl_thunk_simple_prompt(svn_auth_cred_simple_t **cred,
 948                                              void *baton,
 949                                              const char *realm,
 950                                              const char *username,
 951                                              svn_boolean_t may_save,
 952                                              apr_pool_t *pool)
 953 {
 954     /* Be nice and allocate the memory for the cred structure before passing it
 955      * off to the perl space */
 956   *cred = apr_pcalloc(pool, sizeof(**cred));
 957     if (!*cred) {
 958       croak("Could not allocate memory for cred structure");
 959     }
 960     svn_swig_pl_callback_thunk(CALL_SV,
 961                                baton, NULL,
 962                                "SssbS", *cred, _SWIG_TYPE("svn_auth_cred_simple_t *"),
 963                                realm, username, may_save, pool, POOLINFO);
 964
 965     return SVN_NO_ERROR;
 966 }
 967
 968 svn_error_t *svn_swig_pl_thunk_username_prompt(svn_auth_cred_username_t **cred,
 969                                                void *baton,
 970                                                const char *realm,
 971                                                svn_boolean_t may_save,
 972                                                apr_pool_t *pool)
 973 {
 974     /* Be nice and allocate the memory for the cred structure before passing it
 975      * off to the perl space */
 976   *cred = apr_pcalloc(pool, sizeof(**cred));
 977     if (!*cred) {
 978       croak("Could not allocate memory for cred structure");
 979     }
 980     svn_swig_pl_callback_thunk(CALL_SV,
 981                                baton, NULL,
 982                                "SsbS", *cred, _SWIG_TYPE("svn_auth_cred_username_t *"),
 983                                realm, may_save, pool, POOLINFO);
 984
 985     return SVN_NO_ERROR;
 986 }
 987
 988 svn_error_t *svn_swig_pl_thunk_ssl_server_trust_prompt(
 989                               svn_auth_cred_ssl_server_trust_t **cred,
 990                               void *baton,
 991                               const char *realm,
 992                               apr_uint32_t failures,
 993                               const svn_auth_ssl_server_cert_info_t *cert_info,
 994                               svn_boolean_t may_save,
 995                               apr_pool_t *pool)
 996 {
 997     /* Be nice and allocate the memory for the cred structure before passing it
 998      * off to the perl space */
 999   *cred = apr_pcalloc(pool, sizeof(**cred));
1000     if (!*cred) {
1001       croak("Could not allocate memory for cred structure");
1002     }
1003     svn_swig_pl_callback_thunk(CALL_SV,
1004                                baton, NULL,
1005                                "SsiSbS", *cred, _SWIG_TYPE("svn_auth_cred_ssl_server_trust_t *"),
1006                                realm, failures,
1007                                cert_info, _SWIG_TYPE("svn_auth_ssl_server_cert_info_t *"),
1008                                may_save, pool, POOLINFO);
1009
1010     /* Allow the perl callback to indicate failure by setting all vars to 0
1011      * or by simply doing nothing.  While still allowing them to indicate
1012      * failure by setting the cred strucutre's pointer to 0 via $$cred = 0 */
1013     if (*cred) {
1014         if ((*cred)->may_save == 0 && (*cred)->accepted_failures == 0) {
1015             *cred = NULL;
1016         }
1017     }
1018
1019     return SVN_NO_ERROR;
1020 }
1021
1022 svn_error_t *svn_swig_pl_thunk_ssl_client_cert_prompt(
1023                 svn_auth_cred_ssl_client_cert_t **cred,
1024                 void *baton,
1025                 const char * realm,
1026                 svn_boolean_t may_save,
1027                 apr_pool_t *pool)
1028 {
1029     /* Be nice and allocate the memory for the cred structure before passing it
1030      * off to the perl space */
1031   *cred = apr_pcalloc(pool, sizeof(**cred));
1032     if (!*cred) {
1033       croak("Could not allocate memory for cred structure");
1034     }
1035     svn_swig_pl_callback_thunk(CALL_SV,
1036                                baton, NULL,
1037                                "SsbS", *cred, _SWIG_TYPE("svn_auth_cred_ssl_client_cert_t *"),
1038                                realm, may_save, pool, POOLINFO);
1039
1040     return SVN_NO_ERROR;
1041 }
1042
1043 svn_error_t *svn_swig_pl_thunk_ssl_client_cert_pw_prompt(
1044                                      svn_auth_cred_ssl_client_cert_pw_t **cred,
1045                                      void *baton,
1046                                      const char *realm,
1047                                      svn_boolean_t may_save,
1048                                      apr_pool_t *pool)
1049 {
1050     /* Be nice and allocate the memory for the cred structure before passing it
1051      * off to the perl space */
1052   *cred = apr_pcalloc(pool, sizeof(**cred));
1053     if (!*cred) {
1054       croak("Could not allocate memory for cred structure");
1055     }
1056     svn_swig_pl_callback_thunk(CALL_SV,
1057                                baton, NULL,
1058                                "SsbS", *cred, _SWIG_TYPE("svn_auth_cred_ssl_client_cert_pw_t *"),
1059                                realm, may_save, pool, POOLINFO);
1060
1061     return SVN_NO_ERROR;
1062 }
1063
1064 /* Thunked version of svn_wc_notify_func_t callback type */
1065 void svn_swig_pl_notify_func(void * baton,
1066                              const char *path,
1067                              svn_wc_notify_action_t action,
1068                              svn_node_kind_t kind,
1069                              const char *mime_type,
1070                              svn_wc_notify_state_t content_state,
1071                              svn_wc_notify_state_t prop_state,
1072                              svn_revnum_t revision)
1073 {
1074     if (!SvOK((SV *)baton)) {
1075         return;
1076     }
1077
1078     svn_swig_pl_callback_thunk(CALL_SV,
1079                                baton, NULL,
1080                                "siisiir", path, action, kind, mime_type,
1081                                content_state, prop_state, revision);
1082
1083 }
1084
1085 /* Thunked version of svn_client_get_commit_log3_t callback type. */
1086 svn_error_t *svn_swig_pl_get_commit_log_func(const char **log_msg,
1087                                              const char **tmp_file,
1088                                              const apr_array_header_t *
1089                                              commit_items,
1090                                              void *baton,
1091                                              apr_pool_t *pool)
1092 {
1093     SV *result;
1094     svn_error_t *ret_val = SVN_NO_ERROR;
1095     SV *log_msg_sv;
1096     SV *tmp_file_sv;
1097     SV *commit_items_sv;
1098
1099     if (!SvOK((SV *)baton)) {
1100       *log_msg = apr_pstrdup(pool, "");
1101         *tmp_file = NULL;
1102         return SVN_NO_ERROR;
1103     }
1104
1105     log_msg_sv = newRV_noinc(sv_newmortal());
1106     tmp_file_sv = newRV_noinc(sv_newmortal());
1107     commit_items_sv = svn_swig_pl_convert_array
1108       (commit_items, _SWIG_TYPE("svn_client_commit_item3_t *"));
1109
1110     svn_swig_pl_callback_thunk(CALL_SV,
1111                                baton, &result,
1112                                "OOOS", log_msg_sv, tmp_file_sv,
1113                                commit_items_sv, pool, POOLINFO);
1114
1115     if (!SvOK(SvRV(log_msg_sv))) {
1116         /* client returned undef to us */
1117         *log_msg = NULL;
1118     } else if (SvPOK(SvRV(log_msg_sv))) {
1119         /* client returned string so get the string and then duplicate
1120          * it using pool memory */
1121         *log_msg = apr_pstrdup(pool, SvPV_nolen(SvRV(log_msg_sv)));
1122     } else {
1123         croak("Invalid value in log_msg reference, must be undef or a string");
1124     }
1125
1126     if (!SvOK(SvRV(tmp_file_sv))) {
1127         *tmp_file = NULL;
1128     } else if (SvPOK(SvRV(tmp_file_sv))) {
1129         *tmp_file = apr_pstrdup(pool, SvPV_nolen(SvRV(tmp_file_sv)));
1130     } else {
1131         croak("Invalid value in tmp_file reference, "
1132               "must be undef or a string");
1133     }
1134
1135     if (sv_derived_from(result, "_p_svn_error_t")) {
1136         swig_type_info *errorinfo = _SWIG_TYPE("svn_error_t *");
1137         if (SWIG_ConvertPtr(result, (void *)&ret_val, errorinfo, 0) < 0) {
1138             SvREFCNT_dec(result);
1139             croak("Unable to convert from SWIG Type");
1140         }
1141     }
1142
1143     SvREFCNT_dec(result);
1144     return ret_val;
1145 }
1146
1147 /* Thunked version of svn_client_info_t callback type. */
1148 svn_error_t *svn_swig_pl_info_receiver(void *baton,
1149                                        const char *path,
1150                                        const svn_info_t *info,
1151                                        apr_pool_t *pool)
1152 {
1153     SV *result;
1154     svn_error_t *ret_val;
1155     swig_type_info *infoinfo = _SWIG_TYPE("svn_info_t *");
1156
1157     if (!SvOK((SV *)baton))
1158         return SVN_NO_ERROR;
1159
1160     svn_swig_pl_callback_thunk(CALL_SV, baton, &result, "sSS", path, info,
1161                                infoinfo, pool, POOLINFO);
1162
1163     if (sv_derived_from(result, "_p_svn_error_t")) {
1164         swig_type_info *errorinfo = _SWIG_TYPE("svn_error_t *");
1165         if (SWIG_ConvertPtr(result, (void *)&ret_val, errorinfo, 0) < 0) {
1166             SvREFCNT_dec(result);
1167             croak("Unable to convert from SWIG Type");
1168         }
1169     }
1170     else
1171         ret_val = SVN_NO_ERROR;
1172
1173     SvREFCNT_dec(result);
1174     return ret_val;
1175 }
1176
1177
1178 /* Thunked version of svn_wc_cancel_func_t callback type. */
1179 svn_error_t *svn_swig_pl_cancel_func(void *cancel_baton) {
1180     SV *result;
1181     svn_error_t *ret_val;
1182
1183     if (!SvOK((SV *)cancel_baton)) {
1184         return SVN_NO_ERROR;
1185     }
1186     svn_swig_pl_callback_thunk(CALL_SV, cancel_baton, &result, "");
1187
1188     if (sv_derived_from(result,"_p_svn_error_t")) {
1189         swig_type_info *errorinfo = _SWIG_TYPE("svn_error_t *");
1190         if (SWIG_ConvertPtr(result, (void *)&ret_val, errorinfo, 0) < 0) {
1191             SvREFCNT_dec(result);
1192             croak("Unable to convert from SWIG Type");
1193         }
1194     } else if (SvIOK(result) && SvIV(result)) {
1195         ret_val = svn_error_create(SVN_ERR_CANCELLED, NULL,
1196                                    "By cancel callback");
1197     } else if (SvTRUE(result) && SvPOK(result)) {
1198         ret_val = svn_error_create(SVN_ERR_CANCELLED, NULL,
1199                                    SvPV_nolen(result));
1200     } else {
1201         ret_val = SVN_NO_ERROR;
1202     }
1203     SvREFCNT_dec(result);
1204     return ret_val;
1205 }
1206
1207 /* Thunked version of svn_wc_status_func_t callback type. */
1208 void svn_swig_pl_status_func(void *baton,
1209                              const char *path,
1210                              svn_wc_status_t *status)
1211 {
1212   swig_type_info *statusinfo = _SWIG_TYPE("svn_wc_status_t *");
1213
1214   if (!SvOK((SV *)baton)) {
1215     return;
1216   }
1217
1218   svn_swig_pl_callback_thunk(CALL_SV, baton, NULL, "sS",
1219                              path, status, statusinfo);
1220
1221 }
1222
1223 /* Thunked version of svn_client_blame_receiver_t callback type. */
1224 svn_error_t *svn_swig_pl_blame_func(void *baton,
1225                                     apr_int64_t line_no,
1226                                     svn_revnum_t revision,
1227                                     const char *author,
1228                                     const char *date,
1229                                     const char *line,
1230                                     apr_pool_t *pool)
1231 {
1232     SV *result;
1233     svn_error_t *ret_val = SVN_NO_ERROR;
1234
1235     svn_swig_pl_callback_thunk(CALL_SV, baton, &result, "LrsssS",
1236                                line_no, revision, author, date, line,
1237                                pool, POOLINFO);
1238
1239     if (sv_derived_from(result, "_p_svn_error_t")) {
1240         swig_type_info *errorinfo = _SWIG_TYPE("svn_error_t *");
1241         if (SWIG_ConvertPtr(result, (void *)&ret_val, errorinfo, 0) < 0) {
1242             SvREFCNT_dec(result);
1243             croak("Unable to convert from SWIG Type");
1244         }
1245     }
1246
1247     SvREFCNT_dec(result);
1248     return ret_val;
1249 }
1250
1251 /* Thunked config enumerator */
1252 svn_boolean_t svn_swig_pl_thunk_config_enumerator(const char *name, const char *value, void *baton)
1253 {
1254     SV *result;
1255     if (!SvOK((SV *)baton))
1256         return 0;
1257
1258     svn_swig_pl_callback_thunk(CALL_SV, baton, &result,
1259                                "ss", name, value);
1260
1261     return SvOK(result);
1262 }
1263
1264
1265 /* default pool support */
1266
1267 #if defined(SVN_AVOID_CIRCULAR_LINKAGE_AT_ALL_COSTS_HACK)
1268 static svn_swig_pl_get_current_pool_t svn_swig_pl_get_current_pool = NULL;
1269 static svn_swig_pl_set_current_pool_t svn_swig_pl_set_current_pool = NULL;
1270
1271 void svn_swig_pl_bind_current_pool_fns(svn_swig_pl_get_current_pool_t get,
1272                                        svn_swig_pl_set_current_pool_t set)
1273 {
1274   svn_swig_pl_get_current_pool = get;
1275   svn_swig_pl_set_current_pool = set;
1276 }
1277 #else
1278 apr_pool_t *svn_swig_pl_get_current_pool(void);
1279 void svn_swig_pl_set_current_pool(apr_pool_t *pool);
1280 #endif
1281
1282
1283 apr_pool_t *svn_swig_pl_make_pool(SV *obj)
1284 {
1285     apr_pool_t *pool;
1286
1287     if (obj && sv_isobject(obj)) {
1288       if (sv_derived_from(obj, "SVN::Pool")) {
1289             obj = SvRV(obj);
1290         }
1291         if (sv_derived_from(obj, "_p_apr_pool_t")) {
1292             SWIG_ConvertPtr(obj, (void **)&pool, POOLINFO, 0);
1293             return pool;
1294         }
1295     }
1296
1297     if (!svn_swig_pl_get_current_pool())
1298       svn_swig_pl_callback_thunk(CALL_METHOD, (void *)"new_default",
1299                                  &obj, "s", "SVN::Pool");
1300
1301     return svn_swig_pl_get_current_pool();
1302 }
1303
1304 /* stream interpolability with io::handle */
1305
1306 typedef struct  {
1307     SV *obj;
1308     IO *io;
1309 } io_baton_t;
1310
1311 static svn_error_t *io_handle_read(void *baton,
1312                                    char *buffer,
1313                                    apr_size_t *len)
1314 {
1315     io_baton_t *io = baton;
1316     MAGIC *mg;
1317
1318     if ((mg = SvTIED_mg((SV*)io->io, PERL_MAGIC_tiedscalar))) {
1319         SV *ret;
1320         SV *buf = sv_newmortal();
1321
1322         svn_swig_pl_callback_thunk(CALL_METHOD, (void *)"READ", &ret, "OOz",
1323                                    SvTIED_obj((SV*)io->io, mg),
1324                                    buf, *len);
1325         *len = SvIV(ret);
1326         SvREFCNT_dec(ret);
1327         memmove(buffer, SvPV_nolen(buf), *len);
1328     }
1329     else
1330       *len = PerlIO_read(IoIFP(io->io), buffer, *len);
1331     return SVN_NO_ERROR;
1332 }
1333
1334 static svn_error_t *io_handle_write(void *baton,
1335                                     const char *data,
1336                                     apr_size_t *len)
1337 {
1338     io_baton_t *io = baton;
1339     MAGIC *mg;
1340
1341     if ((mg = SvTIED_mg((SV*)io->io, PERL_MAGIC_tiedscalar))) {
1342         SV *ret, *pv;
1343         pv = sv_2mortal(newSVpvn(data, *len));
1344         svn_swig_pl_callback_thunk(CALL_METHOD, (void *)"WRITE", &ret, "OOz",
1345                                    SvTIED_obj((SV*)io->io, mg), pv, *len);
1346         *len = SvIV(ret);
1347         SvREFCNT_dec(ret);
1348     }
1349     else
1350       *len = PerlIO_write(IoIFP(io->io), data, *len);
1351     return SVN_NO_ERROR;
1352 }
1353
1354 static svn_error_t *io_handle_close(void *baton)
1355 {
1356     io_baton_t *io = baton;
1357     MAGIC *mg;
1358
1359     if ((mg = SvTIED_mg((SV*)io->io, PERL_MAGIC_tiedscalar))) {
1360       svn_swig_pl_callback_thunk(CALL_METHOD, (void *)"CLOSE", NULL, "O",
1361                                  SvTIED_obj((SV*)io->io, mg));
1362     }
1363     else {
1364       PerlIO_close(IoIFP(io->io));
1365     }
1366
1367     return SVN_NO_ERROR;
1368 }
1369
1370 static apr_status_t io_handle_cleanup(void *baton)
1371 {
1372     io_baton_t *io = baton;
1373     SvREFCNT_dec(io->obj);
1374     return APR_SUCCESS;
1375 }
1376
1377 svn_error_t *svn_swig_pl_make_stream(svn_stream_t **stream, SV *obj)
1378 {
1379     IO *io;
1380     int simple_type = 1;
1381
1382     if (!SvOK(obj)) {
1383         *stream = NULL;
1384         return SVN_NO_ERROR;
1385     }
1386
1387     if (obj && sv_isobject(obj)) {
1388       if (sv_derived_from(obj, "SVN::Stream"))
1389         svn_swig_pl_callback_thunk(CALL_METHOD, (void *)"svn_stream",
1390                                    &obj, "O", obj);
1391         else if (!sv_derived_from(obj, "_p_svn_stream_t"))
1392             simple_type = 0;
1393
1394         if (simple_type) {
1395             SWIG_ConvertPtr(obj, (void **)stream, _SWIG_TYPE("svn_stream_t *"), 0);
1396             return SVN_NO_ERROR;
1397         }
1398     }
1399
1400     if (obj && SvROK(obj) && SvTYPE(SvRV(obj)) == SVt_PVGV &&
1401         (io = GvIO(SvRV(obj)))) {
1402         apr_pool_t *pool = svn_swig_pl_get_current_pool();
1403         io_baton_t *iob = apr_palloc(pool, sizeof(io_baton_t));
1404         SvREFCNT_inc(obj);
1405         iob->obj = obj;
1406         iob->io = io;
1407         *stream = svn_stream_create(iob, pool);
1408         svn_stream_set_read(*stream, io_handle_read);
1409         svn_stream_set_write(*stream, io_handle_write);
1410         svn_stream_set_close(*stream, io_handle_close);
1411         apr_pool_cleanup_register(pool, iob, io_handle_cleanup,
1412                                   io_handle_cleanup);
1413
1414     }
1415     else
1416       croak("unknown type for svn_stream_t");
1417
1418     return SVN_NO_ERROR;
1419 }
1420
1421 SV *svn_swig_pl_from_stream(svn_stream_t *stream)
1422 {
1423     SV *ret;
1424
1425     svn_swig_pl_callback_thunk(CALL_METHOD, (void *)"new", &ret, "sS",
1426                                "SVN::Stream", stream, _SWIG_TYPE("svn_stream_t *"));
1427
1428     return sv_2mortal(ret);
1429 }
1430
1431 apr_file_t *svn_swig_pl_make_file(SV *file, apr_pool_t *pool)
1432 {
1433     apr_file_t *apr_file = NULL;
1434
1435     if (!SvOK(file) || file == &PL_sv_undef)
1436         return NULL;
1437
1438     if (SvPOKp(file)) {
1439       apr_file_open(&apr_file, SvPV_nolen(file),
1440                     APR_CREATE | APR_READ | APR_WRITE,
1441                     APR_OS_DEFAULT,
1442                     pool);
1443     } else if (SvROK(file) && SvTYPE(SvRV(file)) == SVt_PVGV) {
1444         apr_status_t status;
1445 #ifdef WIN32
1446         apr_os_file_t osfile = (apr_os_file_t)
1447           _get_osfhandle(PerlIO_fileno(IoIFP(sv_2io(file))));
1448 #else
1449         apr_os_file_t osfile = PerlIO_fileno(IoIFP(sv_2io(file)));
1450 #endif
1451         status = apr_os_file_put(&apr_file, &osfile,
1452                                  O_CREAT | O_WRONLY, pool);
1453         if (status)
1454             return NULL;
1455     }
1456     return apr_file;
1457 }
1458
1459 static apr_status_t cleanup_refcnt(void *data)
1460 {
1461     SV *sv = data;
1462     SvREFCNT_dec(sv);
1463     return APR_SUCCESS;
1464 }
1465
1466 void svn_swig_pl_hold_ref_in_pool(apr_pool_t *pool, SV *sv)
1467 {
1468     SvREFCNT_inc(sv);
1469     apr_pool_cleanup_register(pool, sv, cleanup_refcnt, apr_pool_cleanup_null);
1470 }
1471
1472 SV *svn_swig_pl_from_md5(unsigned char *digest)
1473 {
1474     SV *ret;
1475
1476     svn_swig_pl_callback_thunk(CALL_METHOD, (void *)"new", &ret, "sS",
1477                                "SVN::MD5", digest,
1478                                _SWIG_TYPE("unsigned char *"));
1479
1480     return sv_2mortal(ret);
1481 }