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