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

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