git.gag.com Git - debian/amanda/blob - perl/Amanda/Xfer.swg

   1 /*
   2  * Copyright (c) 2008, 2009, 2010 Zmanda, Inc.  All Rights Reserved.
   3  *
   4  * This program is free software; you can redistribute it and/or modify it
   5  * under the terms of the GNU General Public License version 2 as published
   6  * by the Free Software Foundation.
   7  *
   8  * This program is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  11  * for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License along
  14  * with this program; if not, write to the Free Software Foundation, Inc.,
  15  * 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16  *
  17  * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
  18  * Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
  19  */
  20
  21 %module "Amanda::Xfer"
  22 %include "amglue/amglue.swg"
  23 %include "exception.i"
  24 %include "cstring.i"
  25 %import "Amanda/MainLoop.swg"
  26
  27 %include "Xfer.pod"
  28
  29 %{
  30 #include "glib-util.h"
  31 #include "amxfer.h"
  32 %}
  33
  34 /* The SWIGging of the transfer architecture.
  35  *
  36  * The C layer of the transfer architecture exposes some structs, which are
  37  * arranged through GObject magic into a class hierarchy.  It also exposes
  38  * regular C functions which are intended to act as methods on these structs.
  39  * Furthermore, it exposes Perl callbacks (via Amanda::MainLoop) with
  40  * parameters involving objects of these classes.
  41  *
  42  * SWIG doesn't support callbacks very well, and makes it particularly
  43  * difficult to represent a GObject class hierarchy.  Rather than try to "make
  44  * it fit" into SWIG, this module uses custom typemaps and perl/C conversions
  45  * to get all of this stuff right in the first place.
  46  *
  47  * For Xfer objects, we define two functions, new_sv_for_xfer and xfer_from_sv,
  48  * which create a new SV for an Xfer object, and subsequently extract a pointer
  49  * to the object from the SV.  The SV is both blessed and tied to the
  50  * Amanda::Xfer::Xfer class, in which all of the method calls are defined, and
  51  * which defines a DESTROY method that calls xfer_unref.
  52  *
  53  * XferElements are similar, but we have the added challenge of representing
  54  * subclasses with appropriate perl subclasses.  The solution is to tag each C
  55  * class with a perl class name, and use that name when blessing a new SV.
  56  *
  57  * Finally, XMsgs are reflected entirely into perl hashrefs, in the interest of
  58  * efficiency.
  59  */
  60
  61 /*
  62  * Initialization
  63  */
  64
  65 %init %{
  66     /* We need GType and GThread initialized to use xfers */
  67     glib_init();
  68 %}
  69
  70 /*
  71  * Constants
  72  */
  73
  74 amglue_add_enum_tag_fns(xfer_status);
  75 amglue_add_constant(XFER_INIT, xfer_status);
  76 amglue_add_constant(XFER_START, xfer_status);
  77 amglue_add_constant(XFER_RUNNING, xfer_status);
  78 amglue_add_constant(XFER_DONE, xfer_status);
  79 amglue_copy_to_tag(xfer_status, constants);
  80
  81 amglue_add_enum_tag_fns(xmsg_type);
  82 amglue_add_constant(XMSG_INFO, xmsg_type);
  83 amglue_add_constant(XMSG_ERROR, xmsg_type);
  84 amglue_add_constant(XMSG_DONE, xmsg_type);
  85 amglue_add_constant(XMSG_CANCEL, xmsg_type);
  86 amglue_add_constant(XMSG_PART_DONE, xmsg_type);
  87 amglue_add_constant(XMSG_READY, xmsg_type);
  88 amglue_copy_to_tag(xmsg_type, constants);
  89
  90 /*
  91  * Wrapping machinery
  92  */
  93
  94 %{
  95 /* Given an XMsg, return a hashref representing the message as a pure-perl
  96  * object.  The object is new, has refcount 1, and is totally independent of
  97  * the underlying XMsg.
  98  *
  99  * Reflecting the XMsg directly into Perl avoids the need to reference-count
 100  * the XMsg objects themselves, which can simply be freed after a callback
 101  * completes.  The overhead of creating a hash is likely equivalent to or
 102  * less than the overhead that would be consumed with SWIG's swig_$field_get
 103  * accessors, assuming that perl code examines most of the fields in a message.
 104  *
 105  * @param msg: the message to represent
 106  * @returns: a perl SV
 107  */
 108 static SV *
 109 new_sv_for_xmsg(
 110     XMsg *msg)
 111 {
 112     static HV *amanda_xfer_msg_stash = NULL;
 113     HV *hash = newHV();
 114     SV *rv = newRV_noinc((SV *)hash);
 115
 116     /* bless the rv as an Amanda::Xfer::Msg object */
 117     if (!amanda_xfer_msg_stash) {
 118         amanda_xfer_msg_stash = gv_stashpv("Amanda::Xfer::Msg", GV_ADD);
 119     }
 120     sv_bless(rv, amanda_xfer_msg_stash);
 121
 122     /* TODO: consider optimizing by precomputing the hash values of
 123      * the keys? */
 124
 125     /* elt */
 126     hv_store(hash, "elt", 3, new_sv_for_xfer_element(msg->elt), 0);
 127
 128     /* type */
 129     hv_store(hash, "type", 4, newSViv(msg->type), 0);
 130
 131     /* type */
 132     hv_store(hash, "version", 7, newSViv(msg->version), 0);
 133
 134     /* message */
 135     if (msg->message)
 136         hv_store(hash, "message", 7, newSVpv(msg->message, 0), 0);
 137
 138     /* successful */
 139     hv_store(hash, "successful", 10, newSViv(msg->successful), 0);
 140
 141     /* eom */
 142     hv_store(hash, "eom", 3, newSViv(msg->eom), 0);
 143
 144     /* eof */
 145     hv_store(hash, "eof", 3, newSViv(msg->eof), 0);
 146
 147     /* size */
 148     hv_store(hash, "size", 4, amglue_newSVu64(msg->size), 0);
 149
 150     /* duration */
 151     hv_store(hash, "duration", 8, newSVnv(msg->duration), 0);
 152
 153     /* partnum */
 154     hv_store(hash, "partnum", 7, amglue_newSVu64(msg->partnum), 0);
 155
 156     /* fileno */
 157     hv_store(hash, "fileno", 6, amglue_newSVu64(msg->fileno), 0);
 158
 159     return rv;
 160 }
 161 %}
 162
 163 %typemap(in) Xfer * {
 164     $1 = xfer_from_sv($input);
 165 }
 166
 167 %typemap(in) XferElement * {
 168     $1 = xfer_element_from_sv($input);
 169 }
 170
 171 %typemap(out) Xfer * {
 172     $result = sv_2mortal(new_sv_for_xfer($1));
 173     argvi++;
 174 }
 175
 176 %typemap(out) XferElement * {
 177     $result = sv_2mortal(new_sv_for_xfer_element($1));
 178     argvi++;
 179 }
 180
 181 %typemap(newfree) Xfer * {
 182     xfer_unref($1);
 183 }
 184
 185 %typemap(newfree) XferElement * {
 186     xfer_element_unref($1);
 187 }
 188
 189 /*
 190  * Xfer functions
 191  */
 192
 193 /* A typemap for the input to the Xfer constructor, a.k.a. xfer_new */
 194 %typemap(in,numinputs=1) (XferElement **elementlist, unsigned int nelements) {
 195     AV *av;
 196     unsigned int i;
 197
 198     /* check that it's an arrayref */
 199     if (!SvROK($input) || SvTYPE(SvRV($input)) != SVt_PVAV) {
 200         SWIG_exception(SWIG_TypeError, "Expected an arrayref");
 201     }
 202     av = (AV *)SvRV($input);
 203
 204     /* allocate memory for $1 */
 205     $2 = av_len(av)+1; /* av_len(av) is like $#av */
 206     $1 = g_new(XferElement *, $2);
 207
 208     /* extract the underlying XferElement objects and add pointers to
 209      * them, "borrowing" the caller's references for the moment. */
 210     for (i = 0; i < $2; i++) {
 211         SV **sv = av_fetch(av, i, 0);
 212         XferElement *elt = sv? xfer_element_from_sv(*sv):NULL;
 213
 214         if (!elt) {
 215             SWIG_exception(SWIG_TypeError, "Expected an arrayref of Amanda::Xfer::Element objects");
 216         }
 217         $1[i] = elt;
 218     }
 219 }
 220
 221 %typemap(freearg) (XferElement **elementlist, unsigned int nelements) {
 222     /* free the element vector allocated in the (in) typemap */
 223     g_free($1);
 224 }
 225
 226 %newobject xfer_new;
 227 Xfer *xfer_new(XferElement **elementlist, unsigned int nelements);
 228 void xfer_unref(Xfer *);
 229 xfer_status xfer_get_status(Xfer *xfer);
 230 char *xfer_repr(Xfer *xfer);
 231 void xfer_start(Xfer *xfer);
 232 void xfer_cancel(Xfer *xfer);
 233 /* xfer_get_source is implemented below */
 234
 235 %inline %{
 236 /* SWIG wants to treat this as a function */
 237 #define xfer_get_status(xfer) ((xfer)->status)
 238 %}
 239
 240 /* upgrade the start method to optionally take a callback, which is
 241  * passed to the GSource's set_callback */
 242 %perlcode %{
 243 sub xfer_start_with_callback {
 244     my ($xfer, $cb) = @_;
 245     if (defined $cb) {
 246         my $releasing_cb = sub {
 247             my ($src, $msg, $xfer) = @_;
 248             my $done = $msg->{'type'} == $XMSG_DONE;
 249             $src->remove() if $done;
 250             $cb->(@_);
 251             $cb = undef if $done; # break potential reference loop
 252         };
 253         $xfer->get_source()->set_callback($releasing_cb);
 254     }
 255     xfer_start($xfer);
 256 }
 257 %}
 258
 259 /* Change the callback */
 260 %perlcode %{
 261 sub xfer_set_callback {
 262     my ($xfer, $cb) = @_;
 263     if (defined $cb) {
 264         my $releasing_cb = sub {
 265             my ($src, $msg, $xfer) = @_;
 266             my $done = $msg->{'type'} == $XMSG_DONE;
 267             $src->remove() if $done;
 268             $cb->(@_);
 269             $cb = undef if $done; # break potential reference loop
 270        };
 271         $xfer->get_source()->set_callback($releasing_cb);
 272     } else {
 273         $xfer->get_source()->set_callback(undef);
 274     }
 275 }
 276 %}
 277
 278 /*
 279  * XferElement functions
 280  *
 281  * Some of these methods are not intended to be used from Perl; they are annotated
 282  * as "private".
 283  */
 284
 285 void xfer_element_unref(XferElement *elt); /* (wrap the macro, above) */
 286 /* xfer_element_link_to -- private */
 287 char *xfer_element_repr(XferElement *elt);
 288 /* xfer_element_start -- private */
 289 /* xfer_element_cancel -- private */
 290
 291 %inline %{
 292 static gboolean same_elements(
 293         XferElement *a,
 294         XferElement *b)
 295 {
 296     return a == b;
 297 }
 298 %}
 299
 300 /* subclass constructors */
 301
 302 /* N.B. When adding new classes, ensure that the class_init function
 303  * sets perl_class to the appropriate value. */
 304
 305 %newobject xfer_source_random;
 306 XferElement *xfer_source_random(
 307     guint64 length,
 308     guint32 seed);
 309
 310 guint32 xfer_source_random_get_seed(
 311     XferElement *self);
 312
 313 %typemap(in) (void * pattern, size_t pattern_length) {
 314  size_t len;
 315  char * pat;
 316
 317  pat = SvPV($input, len);
 318  $1 = g_memdup(pat, len);
 319  $2 = len;
 320 }
 321
 322 %typemap(in) (gchar **argv) {
 323     AV *av;
 324     unsigned int len;
 325     unsigned int i;
 326
 327     /* check that it's an arrayref */
 328     if (!SvROK($input) || SvTYPE(SvRV($input)) != SVt_PVAV) {
 329         SWIG_exception(SWIG_TypeError, "Expected a non-empty arrayref");
 330     }
 331     av = (AV *)SvRV($input);
 332
 333     /* allocate memory for $1 */
 334     len = av_len(av)+1; /* av_len(av) is like $#av */
 335     if (!len) {
 336         SWIG_exception(SWIG_TypeError, "Expected a non-empty arrayref");
 337     }
 338     $1 = g_new0(gchar *, len+1);
 339
 340     for (i = 0; i < len; i++) {
 341         SV **sv = av_fetch(av, i, 0);
 342         g_assert(sv != NULL);
 343         $1[i] = g_strdup(SvPV_nolen(*sv));
 344     }
 345
 346     /* final element is already NULL due to g_new0; xfer_filter_process takes
 347      * care of freeing this array, so we don't have to */
 348 }
 349
 350 %newobject xfer_source_pattern;
 351 XferElement *xfer_source_pattern(
 352     guint64 length,
 353     void * pattern,
 354     size_t pattern_length);
 355
 356 %newobject xfer_source_fd;
 357 XferElement *xfer_source_fd(
 358     int fd);
 359
 360 %newobject xfer_source_directtcp_listen;
 361 XferElement *xfer_source_directtcp_listen(void);
 362
 363 %inline %{
 364 static DirectTCPAddr *
 365 xfer_source_directtcp_listen_get_addrs(XferElement *elt) {
 366     return elt->input_listen_addrs;
 367 }
 368 %}
 369
 370 %newobject xfer_source_directtcp_connect;
 371 XferElement *xfer_source_directtcp_connect(DirectTCPAddr *addrs);
 372
 373 %newobject xfer_filter_xor;
 374 XferElement *xfer_filter_xor(
 375     unsigned char xor_key);
 376
 377 %newobject xfer_filter_process;
 378 XferElement *xfer_filter_process(
 379     gchar **argv,
 380     gboolean need_root,
 381     gboolean log_stderr);
 382
 383 %newobject xfer_dest_null;
 384 XferElement *xfer_dest_null(
 385     guint32 prng_seed);
 386
 387 %newobject xfer_dest_buffer;
 388 XferElement *xfer_dest_buffer(
 389     gsize max_size);
 390
 391 %cstring_output_allocate_size(gpointer *buf, gsize *size, );
 392 void xfer_dest_buffer_get(
 393     XferElement *elt,
 394     gpointer *buf,
 395     gsize *size);
 396
 397 %newobject xfer_dest_fd;
 398 XferElement *xfer_dest_fd(
 399     int fd);
 400
 401 %newobject xfer_dest_directtcp_listen;
 402 XferElement *xfer_dest_directtcp_listen(void);
 403
 404 %inline %{
 405 static DirectTCPAddr *
 406 xfer_dest_directtcp_listen_get_addrs(XferElement *elt) {
 407     return elt->output_listen_addrs;
 408 }
 409 %}
 410
 411 %newobject xfer_dest_directtcp_connect;
 412 XferElement *xfer_dest_directtcp_connect(DirectTCPAddr *addrs);
 413
 414 /*
 415  * Callback handling
 416  */
 417
 418 %types(amglue_Source *);
 419 %{
 420 static gboolean
 421 xmsgsource_perl_callback(
 422     gpointer data,
 423     struct XMsg *msg,
 424     Xfer *xfer)
 425 {
 426     dSP;
 427     amglue_Source *src = (amglue_Source *)data;
 428     SV *src_sv = NULL;
 429     SV *msg_sv = NULL;
 430     SV *xfer_sv = NULL;
 431
 432     /* keep the source around long enough for the call to finish */
 433     amglue_source_ref(src);
 434     g_assert(src->callback_sv != NULL);
 435
 436     ENTER;
 437     SAVETMPS;
 438
 439     /* create a new SV pointing to 'src', and increase its refcount
 440      * accordingly. */
 441     amglue_source_ref(src);
 442     src_sv = SWIG_NewPointerObj(src, SWIGTYPE_p_amglue_Source,
 443                                  SWIG_OWNER | SWIG_SHADOW);
 444     SvREFCNT_inc(src_sv);
 445
 446     msg_sv = new_sv_for_xmsg(msg);
 447     xfer_sv = new_sv_for_xfer(xfer);
 448
 449     PUSHMARK(SP);
 450     XPUSHs(sv_2mortal(src_sv));
 451     XPUSHs(sv_2mortal(msg_sv));
 452     XPUSHs(sv_2mortal(xfer_sv));
 453     PUTBACK;
 454
 455     call_sv(src->callback_sv, G_EVAL|G_DISCARD);
 456
 457     FREETMPS;
 458     LEAVE;
 459
 460     /* we no longer need the src */
 461     amglue_source_unref(src);
 462     src = NULL;
 463
 464     /* these may be gone, so NULL them out */
 465     src_sv = NULL;
 466     msg_sv = NULL;
 467     xfer_sv = NULL;
 468
 469     /* check for an uncaught 'die'.  If we don't do this, then Perl will longjmp()
 470      * over the GMainLoop mechanics, leaving GMainLoop in an inconsistent (locked)
 471      * state. */
 472     if (SvTRUE(ERRSV)) {
 473         /* We handle this just the way the default 'die' handler in Amanda::Debug
 474          * does, but since Amanda's debug support may not yet be running, we back
 475          * it up with an exit() */
 476         g_critical("%s", SvPV_nolen(ERRSV));
 477         exit(1);
 478     }
 479
 480     return TRUE;
 481 }
 482 %}
 483
 484 %newobject xfer_get_amglue_source;
 485 %inline %{
 486 amglue_Source *
 487 xfer_get_amglue_source(
 488     Xfer *xfer)
 489 {
 490     return amglue_source_get(xfer_get_source(xfer),
 491         (GSourceFunc)xmsgsource_perl_callback);
 492 }
 493 %}
 494
 495 /*
 496  * XMsg and XMsgSource handling
 497  */
 498
 499 /*
 500  * The perl side
 501  */
 502
 503 /* First, a few macros to generate decent Perl */
 504
 505 %define PACKAGE(PKG)
 506 %perlcode {
 507 package PKG;
 508 }
 509 %enddef
 510
 511 %define XFER_ELEMENT_SUBCLASS_OF(PARENT)
 512 %perlcode {
 513 use vars qw(@ISA);
 514 @ISA = qw( PARENT );
 515 }
 516 %enddef
 517
 518 %define XFER_ELEMENT_SUBCLASS()
 519 XFER_ELEMENT_SUBCLASS_OF(Amanda::Xfer::Element)
 520 %enddef
 521
 522 %define DECLARE_CONSTRUCTOR(C_CONSTRUCTOR)
 523 %perlcode {
 524 sub new {
 525     my $pkg = shift;
 526     # The C function adds the proper blessing -- this function
 527     # just gets $pkg out of the way.
 528     C_CONSTRUCTOR(@_);
 529 }
 530 }
 531 %enddef
 532
 533 %define OVERLOAD_REPR()
 534 %perlcode {
 535 use overload '""' => sub { $_[0]->repr(); };
 536 # overload comparison, so users can ask if one obj == another
 537 use overload '==' => sub {     Amanda::Xfer::same_elements($_[0], $_[1]); };
 538 use overload '!=' => sub { not Amanda::Xfer::same_elements($_[0], $_[1]); };
 539 }
 540 %enddef
 541
 542 %define DECLARE_METHOD(METHOD_NAME, C_FUNCTION)
 543 %perlcode {*METHOD_NAME = *C_FUNCTION;
 544 }
 545 %enddef
 546
 547 /* And now define the required perl classes */
 548
 549 PACKAGE(Amanda::Xfer::Xfer)
 550 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_new);
 551 DECLARE_METHOD(DESTROY, Amanda::Xfer::xfer_unref);
 552 OVERLOAD_REPR()
 553 DECLARE_METHOD(repr, Amanda::Xfer::xfer_repr);
 554 DECLARE_METHOD(get_status, Amanda::Xfer::xfer_get_status);
 555 DECLARE_METHOD(get_source, Amanda::Xfer::xfer_get_amglue_source);
 556 DECLARE_METHOD(start, Amanda::Xfer::xfer_start_with_callback);
 557 DECLARE_METHOD(set_callback, Amanda::Xfer::xfer_set_callback);
 558 DECLARE_METHOD(cancel, Amanda::Xfer::xfer_cancel);
 559
 560 /* ---- */
 561
 562 PACKAGE(Amanda::Xfer::Element)
 563 DECLARE_METHOD(DESTROY, Amanda::Xfer::xfer_element_unref);
 564 OVERLOAD_REPR()
 565 DECLARE_METHOD(repr, Amanda::Xfer::xfer_element_repr);
 566
 567 /* ---- */
 568
 569 PACKAGE(Amanda::Xfer::Element::Glue)
 570 XFER_ELEMENT_SUBCLASS()
 571 /* no constructor -- internal use only */
 572
 573 /* ---- */
 574
 575 PACKAGE(Amanda::Xfer::Source::Fd)
 576 XFER_ELEMENT_SUBCLASS()
 577 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_source_fd)
 578
 579 /* ---- */
 580
 581 PACKAGE(Amanda::Xfer::Source::Random)
 582 XFER_ELEMENT_SUBCLASS()
 583 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_source_random)
 584 DECLARE_METHOD(get_seed, Amanda::Xfer::xfer_source_random_get_seed)
 585
 586 /* ---- */
 587
 588 PACKAGE(Amanda::Xfer::Source::DirectTCPListen)
 589 XFER_ELEMENT_SUBCLASS()
 590 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_source_directtcp_listen)
 591 DECLARE_METHOD(get_addrs, Amanda::Xfer::xfer_source_directtcp_listen_get_addrs)
 592
 593 /* ---- */
 594
 595 PACKAGE(Amanda::Xfer::Source::DirectTCPConnect)
 596 XFER_ELEMENT_SUBCLASS()
 597 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_source_directtcp_connect)
 598
 599 /* ---- */
 600
 601 PACKAGE(Amanda::Xfer::Source::Pattern)
 602 XFER_ELEMENT_SUBCLASS()
 603 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_source_pattern)
 604
 605 /* ---- */
 606
 607 PACKAGE(Amanda::Xfer::Filter::Xor)
 608 XFER_ELEMENT_SUBCLASS()
 609 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_filter_xor)
 610
 611 /* ---- */
 612
 613 PACKAGE(Amanda::Xfer::Filter::Process)
 614 XFER_ELEMENT_SUBCLASS()
 615 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_filter_process)
 616
 617 /* ---- */
 618
 619 PACKAGE(Amanda::Xfer::Dest::Fd)
 620 XFER_ELEMENT_SUBCLASS()
 621 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_dest_fd)
 622
 623 /* ---- */
 624
 625 PACKAGE(Amanda::Xfer::Dest::Null)
 626 XFER_ELEMENT_SUBCLASS()
 627 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_dest_null)
 628
 629 /* ---- */
 630
 631 PACKAGE(Amanda::Xfer::Dest::Buffer)
 632 XFER_ELEMENT_SUBCLASS()
 633 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_dest_buffer)
 634 DECLARE_METHOD(get, Amanda::Xfer::xfer_dest_buffer_get)
 635
 636 /* ---- */
 637
 638 PACKAGE(Amanda::Xfer::Dest::DirectTCPListen)
 639 XFER_ELEMENT_SUBCLASS()
 640 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_dest_directtcp_listen)
 641 DECLARE_METHOD(get_addrs, Amanda::Xfer::xfer_dest_directtcp_listen_get_addrs)
 642
 643 /* ---- */
 644
 645 PACKAGE(Amanda::Xfer::Dest::DirectTCPConnect)
 646 XFER_ELEMENT_SUBCLASS()
 647 DECLARE_CONSTRUCTOR(Amanda::Xfer::xfer_dest_directtcp_connect)
 648
 649 /* ---- */
 650
 651 PACKAGE(Amanda::Xfer::Msg)
 652 %perlcode %{
 653 use Data::Dumper;
 654 use overload '""' => sub { $_[0]->repr(); };
 655
 656 sub repr {
 657     my ($self) = @_;
 658     local $Data::Dumper::Indent = 0;
 659     local $Data::Dumper::Terse = 1;
 660     local $Data::Dumper::Useqq = 1;
 661
 662     my $typestr = Amanda::Xfer::xmsg_type_to_string($self->{'type'});
 663     my $str = "{ type => \$$typestr, elt => $self->{'elt'}, version => $self->{'version'},";
 664
 665     my %skip = ( "type" => 1, "elt" => 1, "version" => 1 );
 666     for my $k (keys %$self) {
 667         next if $skip{$k};
 668         $str .= " $k => " . Dumper($self->{$k}) . ",";
 669     }
 670
 671     # strip the trailing comma and add a closing brace
 672     $str =~ s/,$/ }/g;
 673
 674     return $str;
 675 }
 676 %}
 677
 678 /* ---- */
 679
 680 PACKAGE(Amanda::Xfer)
 681 %perlcode %{
 682 # make Amanda::Xfer->new equivalent to Amanda::Xfer::Xfer->new (don't
 683 # worry, the blessings work out just fine)
 684 *new = *Amanda::Xfer::Xfer::new;
 685
 686 # try to load Amanda::XferServer, which is server-only.  If it's not found, then
 687 # its classes just remain undefined.
 688 BEGIN {
 689     use Amanda::Util;
 690     if (Amanda::Util::built_with_component("server")) {
 691         eval "use Amanda::XferServer;";
 692     }
 693 }
 694 %}