Imported Upstream version 3.2.0
[debian/amanda] / perl / Amanda / Xfer.pm
1 # This file was automatically generated by SWIG (http://www.swig.org).
2 # Version 1.3.39
3 #
4 # Do not make changes to this file unless you know what you are doing--modify
5 # the SWIG interface file instead.
6
7 package Amanda::Xfer;
8 use base qw(Exporter);
9 use base qw(DynaLoader);
10 require Amanda::MainLoop;
11 package Amanda::Xferc;
12 bootstrap Amanda::Xfer;
13 package Amanda::Xfer;
14 @EXPORT = qw();
15
16 # ---------- BASE METHODS -------------
17
18 package Amanda::Xfer;
19
20 sub TIEHASH {
21     my ($classname,$obj) = @_;
22     return bless $obj, $classname;
23 }
24
25 sub CLEAR { }
26
27 sub FIRSTKEY { }
28
29 sub NEXTKEY { }
30
31 sub FETCH {
32     my ($self,$field) = @_;
33     my $member_func = "swig_${field}_get";
34     $self->$member_func();
35 }
36
37 sub STORE {
38     my ($self,$field,$newval) = @_;
39     my $member_func = "swig_${field}_set";
40     $self->$member_func($newval);
41 }
42
43 sub this {
44     my $ptr = shift;
45     return tied(%$ptr);
46 }
47
48
49 # ------- FUNCTION WRAPPERS --------
50
51 package Amanda::Xfer;
52
53 *xfer_new = *Amanda::Xferc::xfer_new;
54 *xfer_unref = *Amanda::Xferc::xfer_unref;
55 *xfer_get_status = *Amanda::Xferc::xfer_get_status;
56 *xfer_repr = *Amanda::Xferc::xfer_repr;
57 *xfer_start = *Amanda::Xferc::xfer_start;
58 *xfer_cancel = *Amanda::Xferc::xfer_cancel;
59 *xfer_element_unref = *Amanda::Xferc::xfer_element_unref;
60 *xfer_element_repr = *Amanda::Xferc::xfer_element_repr;
61 *same_elements = *Amanda::Xferc::same_elements;
62 *xfer_source_random = *Amanda::Xferc::xfer_source_random;
63 *xfer_source_random_get_seed = *Amanda::Xferc::xfer_source_random_get_seed;
64 *xfer_source_pattern = *Amanda::Xferc::xfer_source_pattern;
65 *xfer_source_fd = *Amanda::Xferc::xfer_source_fd;
66 *xfer_source_directtcp_listen = *Amanda::Xferc::xfer_source_directtcp_listen;
67 *xfer_source_directtcp_listen_get_addrs = *Amanda::Xferc::xfer_source_directtcp_listen_get_addrs;
68 *xfer_source_directtcp_connect = *Amanda::Xferc::xfer_source_directtcp_connect;
69 *xfer_filter_xor = *Amanda::Xferc::xfer_filter_xor;
70 *xfer_filter_process = *Amanda::Xferc::xfer_filter_process;
71 *xfer_dest_null = *Amanda::Xferc::xfer_dest_null;
72 *xfer_dest_buffer = *Amanda::Xferc::xfer_dest_buffer;
73 *xfer_dest_buffer_get = *Amanda::Xferc::xfer_dest_buffer_get;
74 *xfer_dest_fd = *Amanda::Xferc::xfer_dest_fd;
75 *xfer_dest_directtcp_listen = *Amanda::Xferc::xfer_dest_directtcp_listen;
76 *xfer_dest_directtcp_listen_get_addrs = *Amanda::Xferc::xfer_dest_directtcp_listen_get_addrs;
77 *xfer_dest_directtcp_connect = *Amanda::Xferc::xfer_dest_directtcp_connect;
78 *xfer_get_amglue_source = *Amanda::Xferc::xfer_get_amglue_source;
79
80 # ------- VARIABLE STUBS --------
81
82 package Amanda::Xfer;
83
84 *XFER_INIT = *Amanda::Xferc::XFER_INIT;
85 *XFER_START = *Amanda::Xferc::XFER_START;
86 *XFER_RUNNING = *Amanda::Xferc::XFER_RUNNING;
87 *XFER_DONE = *Amanda::Xferc::XFER_DONE;
88 *XMSG_INFO = *Amanda::Xferc::XMSG_INFO;
89 *XMSG_ERROR = *Amanda::Xferc::XMSG_ERROR;
90 *XMSG_DONE = *Amanda::Xferc::XMSG_DONE;
91 *XMSG_CANCEL = *Amanda::Xferc::XMSG_CANCEL;
92 *XMSG_PART_DONE = *Amanda::Xferc::XMSG_PART_DONE;
93 *XMSG_READY = *Amanda::Xferc::XMSG_READY;
94
95 @EXPORT_OK = ();
96 %EXPORT_TAGS = ();
97
98
99 =head1 NAME
100
101 Amanda::Xfer - the transfer architecture
102
103 =head1 SYNOPSIS
104
105   use Amanda::MainLoop;
106   use Amanda::Xfer qw( :constants );
107   use POSIX;
108
109   my $infd = POSIX::open("input", POSIX::O_RDONLY, 0);
110   my $outfd = POSIX::open("output", POSIX::O_CREAT|POSIX::O_WRONLY, 0640);
111   my $xfer = Amanda::Xfer->new([
112     Amanda::Xfer::Source::Fd->new($infd),
113     Amanda::Xfer::Dest::Fd->new($outfd)
114   ]);
115   $xfer->start(sub {
116       my ($src, $xmsg, $xfer) = @_;
117       print "Message from $xfer: $xmsg\n"; # use stringify operations
118       if ($msg->{'type'} == $XMSG_DONE) {
119           Amanda::MainLoop::quit();
120       }
121   });
122   Amanda::MainLoop::run();
123
124 See L<http://wiki.zmanda.com/index.php/XFA> for background on the
125 transfer architecture.
126
127 =head1 Amanda::Xfer Objects
128
129 A new transfer is created with C<< Amanda::Xfer->new() >>, which takes
130 an arrayref giving the transfer elements which should compose the
131 transfer.
132
133 The resulting object has the following methods:
134
135 =over
136
137 =item start($cb)
138
139 Start this transfer.  Processing takes place asynchronously, and messages will
140 begin queueing up immediately.  If C<$cb> is given, then it is installed as the
141 callback for messages from this transfer.  The callback receives three
142 arguments: the event source, the message, and a reference to the controlling
143 transfer.  See the description of C<Amanda::Xfer::Msg>, below, for details.
144
145 There is no need to remove the source on completion of the transfer - that is
146 handled for you.
147
148 =item cancel()
149
150 Stop transferring data.  The transfer will send an C<XMSG_CANCEL>,
151 "drain" any buffered data as best it can, and then complete normally
152 with an C<XMSG_DONE>.
153
154 =item get_status()
155
156 Get the transfer's status.  The result will be one of C<$XFER_INIT>,
157 C<$XFER_START>, C<$XFER_RUNNING>, or C<$XFER_DONE>.  These symbols are
158 available for import with the tag C<:constants>.
159
160 =item repr()
161
162 Return a string representation of this transfer, suitable for use in
163 debugging messages.  This method is automatically invoked when a
164 transfer is interpolated into a string:
165
166   print "Starting $xfer\n";
167
168 =item get_source()
169
170 Get the L<Amanda::MainLoop> event source through which messages will
171 be delivered for this transfer.  Use its C<set_callback> method to
172 connect a perl sub for processing events. 
173
174 Use of this method is deprecated; instead, pass a callback to the C<start>
175 method.  If you set a callback via C<get_source>, then you I<must> C<remove>
176 the source when the transfer is complete!
177
178 =back
179
180 =head1 Amanda::Xfer::Element objects
181
182 The individual transfer elements that compose a transfer are instances
183 of subclasses of Amanda::Xfer::Element.  All such objects have a
184 C<repr()> method, similar to that for transfers, and support a similar
185 kind of string interpolation.
186
187 Note that the names of these classes contain the words "Source",
188 "Filter", and "Dest".  This is merely suggestive of their intended
189 purpose -- there are no such abstract classes.
190
191 =head2 Transfer Sources
192
193 =head3 Amanda::Xfer::Source::Device (SERVER ONLY)
194
195   Amanda::Xfer::Source::Device->new($device);
196
197 This source reads data from a device.  The device should already be
198 queued up for reading (C<< $device->seek_file(..) >>).  The element
199 will read until the end of the device file.
200
201 =head3 Amanda::Xfer::Source::Fd
202
203   Amanda::Xfer::Source::Fd->new(fileno($fh));
204
205 This source reads data from a file descriptor.  It reads until EOF,
206 but does not close the descriptor.  Be careful not to let Perl close
207 the file for you!
208
209 =head3 Amanda::Xfer::Source::Holding (SERVER-ONLY)
210
211   Amanda::Xfer::Source::Holding->new($filename);
212
213 This source reads data from a holding file (see L<Amanda::Holding>).
214 If the transfer only consists of a C<Amanda::Xfer::Source::Holding>
215 and an C<Amanda::Xfer::Dest::Taper::Cacher> (with no filters), then the source
216 will call the destination's C<cache_inform> method so that it can use
217 holding chunks for a split-part cache.
218
219 =head3 Amanda::Xfer::Source::Random
220
221   Amanda::Xfer::Source::Random->new($length, $seed);
222
223 This source provides I<length> bytes of random data (or an unlimited
224 amount of data if I<length> is zero).  C<$seed> is the seed used to
225 generate the random numbers; this seed can be used in a destination to
226 check for correct output.
227
228 If you need to string multiple transfers together into a coherent sequence of
229 random numbers, for example when testing the re-assembly of spanned dumps, call
230
231   my $seed = $src->get_seed();
232
233 to get the finishing seed for the source, then pass this to the source
234 constructor for the next transfer.  When concatenated, the bytestreams from the
235 transfers will verify correctly using the original random seed.
236
237 =head3 Amanda::Xfer::Source::Pattern
238
239   Amanda::Xfer::Source::Pattern->new($length, $pattern);
240
241 This source provides I<length> bytes containing copies of
242 I<pattern>. If I<length> is zero, the source provides an unlimited
243 number of bytes.
244
245 =head3 Amanda::Xfer::Source::Recovery (SERVER ONLY)
246
247   Amanda::Xfer::Source::Recovery->new($first_device);
248
249 This source reads a datastream composed of on-device files.  Its constructor
250 takes a pointer to the first device that will be read from; this is used
251 internally to determine whether DirectTCP is supported.
252
253 The element sense C<$XMSG_READY> when it is ready for the first C<start_part>
254 invocation.  Don't do anything with the device between the start of the
255 transfer and when the element sends an C<$XMSG_READY>.
256
257 The element contains no logic to decide I<which> files to assemble into the
258 datastream; instead, it relies on the caller to supply pre-positioned devices:
259
260   $src->start_part($device);
261
262 Once C<start_part> is called, the source will read until C<$device> produces an
263 EOF.  As each part is completed, the element sends an C<$XMSG_PART_DONE>
264 L<Amanda::Xfer::Msg>, with the following keys:
265
266  size       bytes read from the device
267  duration   time spent reading
268  fileno     the on-media file number from which the part was read
269
270 Call C<start_part> with C<$device = undef> to indicate that there are no more
271 parts.
272
273 To switch to a new device in mid-transfer, use C<use_device>:
274
275   $dest->use_device($device);
276
277 This method must be called with a device that is not yet started, and thus must
278 be called before the C<start_part> method is called with a new device.
279
280 =head3 Amanda::Xfer::Source::DirectTCPListen
281
282   Amanda::Xfer::Source::DirectTCPListen->new();
283
284 This source is for use when the transfer data will come in via DirectTCP, with
285 the data's I<source> connecting to the data's I<destination>.  That is, the
286 data source is the connection initiator.  Set up the transfer, and after
287 starting it, call this element's C<get_addrs> method to get an arrayref of ip/port pairs,
288 e.g., C<[ "192.168.4.5", 9924 ]>, all of which are listening for an incoming
289 data connection.  Once a connection arrives, this element will read data from
290 it and send those data into the transfer.
291
292   my $addrs = $src->get_addrs();
293
294 =head3 Amanda::Xfer::Source::DirectTCPConnect
295
296   Amanda::Xfer::Source::DirectTCPConnect->new($addrs);
297
298 This source is for use when the transfer data will come in via DirectTCP, with
299 the data's I<destination> connecting to the the data's I<source>.  That is, the
300 data destination is the connection initiator.  The element connects to
301 C<$addrs> and reads the transfer data from the connection.
302
303 =head2 Transfer Filters
304
305 =head3 Amanda::Xfer::Filter:Process
306
307   Amanda::Xfer::Filter::Process->new([@args], $need_root, $log_stderr);
308
309 This filter will pipe data through the standard file descriptors of the
310 subprocess specified by C<@args>.  If C<$need_root> is true, it will attempt to
311 change to uid 0 before executing the process.  Standard output from the process
312 is redirected to the debug log.  Note that the process is invoked directly, not
313 via a shell, so shell metacharcters (e.g., C<< 2>&1 >>) will not function as
314 expected.  If C<$log_stderr> is set, then the filter's standard error is sent
315 to the debug log; otherwise, it is sent to the parent process's stderr.
316
317 =head3 Amanda::Xfer::Filter:Xor
318
319   Amanda::Xfer::Filter::Xor->new($key);
320
321 This filter applies a bytewise XOR operation to the data flowing
322 through it.
323
324 =head2 Transfer Destinations
325
326 =head3 Amanda::Xfer::Dest::Device (SERVER ONLY)
327
328   Amanda::Xfer::Dest::Device->new($device, $cancel_at_eom);
329
330 This source writes data to a device.  The device should be ready for writing
331 (C<< $device->start_file(..) >>).  On completion of the transfer, the file will
332 be finished.  If an error occurs, or if C<$cancel_at_eom> is true and the
333 device signals LEOM, the transfer will be cancelled.
334
335 Note that this element does not apply any sort of stream buffering.
336
337 =head3 Amanda::Xfer::Dest::Buffer
338
339   Amanda::Xfer::Dest::Buffer->new($max_size);
340
341 This destination records data into an in-memory buffer which can grow up to
342 C<$max_size> bytes.  The buffer is available with the C<get> method, which
343 returns a copy of the buffer as a perl scalar:
344
345     my $buf = $xdb->get();
346
347 =head3 Amanda::Xfer::Dest::DirectTCPListen
348
349   Amanda::Xfer::Dest::DirectTCPListen->new();
350
351 This destination is for use when the transfer data will come in via DirectTCP,
352 with the data's I<destination> connecting to the data's I<source>.  That is,
353 the data destination is the connection initiator.  Set up the transfer, and
354 after starting it, call this element's C<get_addrs> method to get an arrayref
355 of ip/port pairs, e.g., C<[ "192.168.4.5", 9924 ]>, all of which are listening
356 for an incoming data connection.  Once a connection arrives, this element will
357 write the transfer data to it.
358
359   my $addrs = $src->get_addrs();
360
361 =head3 Amanda::Xfer::Dest::DirectTCPConnect
362
363   Amanda::Xfer::Dest::DirectTCPConnect->new($addrs);
364
365 This destination is for use when the transfer data will come in via DirectTCP,
366 with the data's I<source> connecting to the the data's I<destination>.  That
367 is, the data source is the connection initiator.  The element connects to
368 C<$addrs> and writes the transfer data to the connection.
369
370 =head3 Amanda::Xfer::Dest::Fd
371
372   Amanda::Xfer::Dest::Fd->new(fileno($fh));
373
374 This destination writes data to a file descriptor.  The file is not
375 closed after the transfer is completed.  Be careful not to let Perl
376 close the file for you!
377
378 =head3 Amanda::Xfer::Dest::Null
379
380   Amanda::Xfer::Dest::Null->new($seed);
381
382 This destination discards the data it receives.  If C<$seed> is
383 nonzero, then the element will validate that it receives the data that
384 C<Amanda::Xfer::Source::Random> produced with the same seed.  No
385 validation is performed if C<$seed> is zero.
386
387 =head3 Amanda::Xfer::Dest::Taper (SERVER ONLY)
388
389 This is the parent class to C<Amanda::Xfer::Dest::Taper::Cacher> and
390 C<Amanda::Xfer::Dest::Taper::DirectTCP>. These subclasses allow a single
391 transfer to write to multiple files (parts) on a device, and even spread those
392 parts over multiple devices, without interrupting the transfer itself.
393
394 The subclass constructors all take a C<$first_device>, which should be
395 configured but not yet started; and a C<$part_size> giving the maximum size of
396 each part.  Note that this value may be rounded up internally as necessary.
397
398 When a transfer using a taper destination element is first started, no data is
399 transfered until the element's C<start_part> method is called:
400
401   $dest->start_part($retry_part);
402
403 where C<$device> is the device to which the part should be written.  The device
404 should have a file open and ready to write (that is, 
405 C<< $device->start_file(..) >> has already been called).  If C<$retry_part> is
406 true, then the previous, unsuccessful part will be retried.
407
408 As each part is completed, the element sends an C<$XMSG_PART_DONE>
409 C<Amanda::Xfer::Msg>, with the following keys:
410
411  successful true if the part was written successfully
412  eof        recipient should not call start_part again
413  eom        this volume is at EOM; a new volume is required
414  size       bytes written to volume
415  duration   time spent writing, not counting changer ops, etc.
416  partnum    the zero-based number of this part in the overall dumpfile
417  fileno     the on-media file number used for this part, or 0 if no file
418             was used
419
420 If C<eom> is true, then the caller should find a new volume before
421 continuing.  If C<eof> is not true, then C<start_part> should be called
422 again, with C<$retry_part = !successful>.  Note that it is possible
423 for some destinations to write a portion of a part successfully,
424 but still stop at EOM.  That is, C<eom> does not necessarily imply
425 C<!successful>.
426
427 To switch to a new device in mid-transfer, use C<use_device>:
428
429   $dest->use_device($device);
430
431 This method must be called with a device that is not yet started.
432
433 If neither the memory nor disk caches are in use, but the dumpfile is
434 available on disk, then the C<cache_inform> method allows the element
435 to use that on-disk data to support retries.  This is intended to
436 support transfers from Amanda's holding disk (see
437 C<Amanda::Xfer::Source::Holding>), but may be useful for other
438 purposes.
439
440   $dest->cache_inform($filename, $offset, $length);
441
442 This function indicates that C<$filename> contains C<$length> bytes of
443 data, beginning at offset C<$offset> from the beginning of the file.
444 These bytes are assumed to follow immediately after any bytes
445 previously specified to C<cache_inform>.  That is, no gaps or overlaps
446 are allowed in the data stream described to C<cache_inform>.
447 Furthermore, the location of each byte must be specified to this
448 method I<before> it is sent through the transfer.
449
450   $dest->get_part_bytes_written();
451
452 This function returns the number of bytes written for the current part
453 to the device.
454
455 =head3 Amanda::Xfer::Dest::Taper::Splitter
456
457   Amanda::Xfer::Dest::Taper::Splitter->new($first_device, $max_memory,
458                         $part_size, $expect_cache_inform);
459
460 This class splits a data stream into parts on the storage media.  It is for use
461 when the device supports LEOM, when the dump is already available on disk
462 (C<cache_inform>), or when no caching is desired.  It does not cache parts, so
463 it can only retry a partial part if the transfer source is calling
464 C<cache_inform>.  If the element is used with devices that do not support LEOM,
465 then it will cancel the entire transfer if the device reaches EOM and
466 C<cache_inform> is not in use.  Set C<$expect_cache_inform> appropriately based
467 on the incoming data.
468
469 The C<$part_size> and C<$first_device> parameters are described above for
470 C<Amanda::Xfer::Dest::Taper>.
471
472 =head3 Amanda::Xfer::Dest::Taper::Cacher
473
474   Amanda::Xfer::Dest::Taper::Cacher->new($first_device, $max_memory,
475                         $part_size, $use_mem_cache, $disk_cache_dirname);
476
477 This class is similar to the splitter, but caches data from each part in one of
478 a variety of ways to support "rewinding" to retry a failed part (e.g., one that
479 does not fit on a device).  It assumes that when a device reaches EOM while
480 writing, the entire on-volume file is corrupt - that is, that the device does
481 not support logical EOM.  The class does not support C<cache_inform>.
482
483 The C<$part_size> and C<$first_device> parameters are described above for
484 C<Amanda::Xfer::Dest::Taper>.
485
486 If C<$use_mem_cache> is true, each part will be cached in memory (using
487 C<$part_size> bytes of memory; plan accordingly!).  If C<$disk_cache_dirname>
488 is defined, then each part will be cached on-disk in a file in this directory.
489 It is an error to specify both in-memory and on-disk caching.  If neither
490 option is specified, the element will operate successfully, but will not be
491 able to retry a part, and will cancel the transfer if a part fails.
492
493 =head3 Amanda::Xfer::Dest::Taper::DirectTCP
494
495   Amanda::Xfer::Dest::Taper::DirectTCP->new($first_device, $part_size);
496
497 This class uses the Device API DirectTCP methods to write data to a device via
498 DirectTCP.  Since all DirectTCP devices support logical EOM, this class does
499 not cache any data, and will never re-start an unsuccessful part.
500
501 As state above, C<$first_device> must not be started when C<new> is called.
502 Furthermore, no use of that device is allowed until the element sens an
503 C<$XMSG_READY> to indicate that it is finished with the device.  The
504 C<start_part> method must not be called until this method is received either.
505
506 =head1 Amanda::Xfer::Msg objects
507
508 Messages are simple hashrefs, with a few convenience methods.  Like
509 transfers, they have a C<repr()> method that formats the message
510 nicely, and is available through string interpolation:
511
512   print "Received message $msg\n";
513
514 The canonical description of the message types and keys is in
515 C<xfer-src/xmsg.h>, and is not duplicated here.  Every message has the
516 following basic keys.
517
518 =over
519
520 =item type
521
522 The message type -- one of the C<xmsg_type> constants available from
523 the import tag C<:constants>.
524
525 =item elt
526
527 The transfer element that sent the message.
528
529 =item version
530
531 The version of the message.  This is used to support extensibility of
532 the protocol.
533
534 =back
535
536 Additional keys are described in the documentation for the elements
537 that use them.  All keys are listed in C<xfer-src/xmsg.h>.
538
539 =cut
540
541
542
543 push @EXPORT_OK, qw(xfer_status_to_string);
544 push @{$EXPORT_TAGS{"xfer_status"}}, qw(xfer_status_to_string);
545
546 my %_xfer_status_VALUES;
547 #Convert an enum value to a single string
548 sub xfer_status_to_string {
549     my ($enumval) = @_;
550
551     for my $k (keys %_xfer_status_VALUES) {
552         my $v = $_xfer_status_VALUES{$k};
553
554         #is this a matching flag?
555         if ($enumval == $v) {
556             return $k;
557         }
558     }
559
560 #default, just return the number
561     return $enumval;
562 }
563
564 push @EXPORT_OK, qw($XFER_INIT);
565 push @{$EXPORT_TAGS{"xfer_status"}}, qw($XFER_INIT);
566
567 $_xfer_status_VALUES{"XFER_INIT"} = $XFER_INIT;
568
569 push @EXPORT_OK, qw($XFER_START);
570 push @{$EXPORT_TAGS{"xfer_status"}}, qw($XFER_START);
571
572 $_xfer_status_VALUES{"XFER_START"} = $XFER_START;
573
574 push @EXPORT_OK, qw($XFER_RUNNING);
575 push @{$EXPORT_TAGS{"xfer_status"}}, qw($XFER_RUNNING);
576
577 $_xfer_status_VALUES{"XFER_RUNNING"} = $XFER_RUNNING;
578
579 push @EXPORT_OK, qw($XFER_DONE);
580 push @{$EXPORT_TAGS{"xfer_status"}}, qw($XFER_DONE);
581
582 $_xfer_status_VALUES{"XFER_DONE"} = $XFER_DONE;
583
584 #copy symbols in xfer_status to constants
585 push @{$EXPORT_TAGS{"constants"}},  @{$EXPORT_TAGS{"xfer_status"}};
586
587 push @EXPORT_OK, qw(xmsg_type_to_string);
588 push @{$EXPORT_TAGS{"xmsg_type"}}, qw(xmsg_type_to_string);
589
590 my %_xmsg_type_VALUES;
591 #Convert an enum value to a single string
592 sub xmsg_type_to_string {
593     my ($enumval) = @_;
594
595     for my $k (keys %_xmsg_type_VALUES) {
596         my $v = $_xmsg_type_VALUES{$k};
597
598         #is this a matching flag?
599         if ($enumval == $v) {
600             return $k;
601         }
602     }
603
604 #default, just return the number
605     return $enumval;
606 }
607
608 push @EXPORT_OK, qw($XMSG_INFO);
609 push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_INFO);
610
611 $_xmsg_type_VALUES{"XMSG_INFO"} = $XMSG_INFO;
612
613 push @EXPORT_OK, qw($XMSG_ERROR);
614 push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_ERROR);
615
616 $_xmsg_type_VALUES{"XMSG_ERROR"} = $XMSG_ERROR;
617
618 push @EXPORT_OK, qw($XMSG_DONE);
619 push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_DONE);
620
621 $_xmsg_type_VALUES{"XMSG_DONE"} = $XMSG_DONE;
622
623 push @EXPORT_OK, qw($XMSG_CANCEL);
624 push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_CANCEL);
625
626 $_xmsg_type_VALUES{"XMSG_CANCEL"} = $XMSG_CANCEL;
627
628 push @EXPORT_OK, qw($XMSG_PART_DONE);
629 push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_PART_DONE);
630
631 $_xmsg_type_VALUES{"XMSG_PART_DONE"} = $XMSG_PART_DONE;
632
633 push @EXPORT_OK, qw($XMSG_READY);
634 push @{$EXPORT_TAGS{"xmsg_type"}}, qw($XMSG_READY);
635
636 $_xmsg_type_VALUES{"XMSG_READY"} = $XMSG_READY;
637
638 #copy symbols in xmsg_type to constants
639 push @{$EXPORT_TAGS{"constants"}},  @{$EXPORT_TAGS{"xmsg_type"}};
640
641 sub xfer_start_with_callback {
642     my ($xfer, $cb) = @_;
643     if (defined $cb) {
644         my $releasing_cb = sub {
645             my ($src, $msg, $xfer) = @_;
646             my $done = $msg->{'type'} == $XMSG_DONE;
647             $src->remove() if $done;
648             $cb->(@_);
649             $cb = undef if $done; # break potential reference loop
650         };
651         $xfer->get_source()->set_callback($releasing_cb);
652     }
653     xfer_start($xfer);
654 }
655
656 sub xfer_set_callback {
657     my ($xfer, $cb) = @_;
658     if (defined $cb) {
659         my $releasing_cb = sub {
660             my ($src, $msg, $xfer) = @_;
661             my $done = $msg->{'type'} == $XMSG_DONE;
662             $src->remove() if $done;
663             $cb->(@_);
664             $cb = undef if $done; # break potential reference loop
665        };
666         $xfer->get_source()->set_callback($releasing_cb);
667     } else {
668         $xfer->get_source()->set_callback(undef);
669     }
670 }
671
672 package Amanda::Xfer::Xfer;
673
674 sub new { 
675     my $pkg = shift;
676
677
678     Amanda::Xfer::xfer_new(@_);
679 }
680 *DESTROY = *Amanda::Xfer::xfer_unref;
681
682 use overload '""' => sub { $_[0]->repr(); };
683
684 use overload '==' => sub {     Amanda::Xfer::same_elements($_[0], $_[1]); };
685 use overload '!=' => sub { not Amanda::Xfer::same_elements($_[0], $_[1]); };
686 *repr = *Amanda::Xfer::xfer_repr;
687 *get_status = *Amanda::Xfer::xfer_get_status;
688 *get_source = *Amanda::Xfer::xfer_get_amglue_source;
689 *start = *Amanda::Xfer::xfer_start_with_callback;
690 *set_callback = *Amanda::Xfer::xfer_set_callback;
691 *cancel = *Amanda::Xfer::xfer_cancel;
692
693 package Amanda::Xfer::Element;
694 *DESTROY = *Amanda::Xfer::xfer_element_unref;
695
696 use overload '""' => sub { $_[0]->repr(); };
697
698 use overload '==' => sub {     Amanda::Xfer::same_elements($_[0], $_[1]); };
699 use overload '!=' => sub { not Amanda::Xfer::same_elements($_[0], $_[1]); };
700 *repr = *Amanda::Xfer::xfer_element_repr;
701
702 package Amanda::Xfer::Element::Glue;
703
704 use vars qw(@ISA);
705 @ISA = qw( Amanda::Xfer::Element );
706
707 package Amanda::Xfer::Source::Fd;
708
709 use vars qw(@ISA);
710 @ISA = qw( Amanda::Xfer::Element );
711
712 sub new { 
713     my $pkg = shift;
714
715
716     Amanda::Xfer::xfer_source_fd(@_);
717 }
718
719 package Amanda::Xfer::Source::Random;
720
721 use vars qw(@ISA);
722 @ISA = qw( Amanda::Xfer::Element );
723
724 sub new { 
725     my $pkg = shift;
726
727
728     Amanda::Xfer::xfer_source_random(@_);
729 }
730 *get_seed = *Amanda::Xfer::xfer_source_random_get_seed;
731
732 package Amanda::Xfer::Source::DirectTCPListen;
733
734 use vars qw(@ISA);
735 @ISA = qw( Amanda::Xfer::Element );
736
737 sub new { 
738     my $pkg = shift;
739
740
741     Amanda::Xfer::xfer_source_directtcp_listen(@_);
742 }
743 *get_addrs = *Amanda::Xfer::xfer_source_directtcp_listen_get_addrs;
744
745 package Amanda::Xfer::Source::DirectTCPConnect;
746
747 use vars qw(@ISA);
748 @ISA = qw( Amanda::Xfer::Element );
749
750 sub new { 
751     my $pkg = shift;
752
753
754     Amanda::Xfer::xfer_source_directtcp_connect(@_);
755 }
756
757 package Amanda::Xfer::Source::Pattern;
758
759 use vars qw(@ISA);
760 @ISA = qw( Amanda::Xfer::Element );
761
762 sub new { 
763     my $pkg = shift;
764
765
766     Amanda::Xfer::xfer_source_pattern(@_);
767 }
768
769 package Amanda::Xfer::Filter::Xor;
770
771 use vars qw(@ISA);
772 @ISA = qw( Amanda::Xfer::Element );
773
774 sub new { 
775     my $pkg = shift;
776
777
778     Amanda::Xfer::xfer_filter_xor(@_);
779 }
780
781 package Amanda::Xfer::Filter::Process;
782
783 use vars qw(@ISA);
784 @ISA = qw( Amanda::Xfer::Element );
785
786 sub new { 
787     my $pkg = shift;
788
789
790     Amanda::Xfer::xfer_filter_process(@_);
791 }
792
793 package Amanda::Xfer::Dest::Fd;
794
795 use vars qw(@ISA);
796 @ISA = qw( Amanda::Xfer::Element );
797
798 sub new { 
799     my $pkg = shift;
800
801
802     Amanda::Xfer::xfer_dest_fd(@_);
803 }
804
805 package Amanda::Xfer::Dest::Null;
806
807 use vars qw(@ISA);
808 @ISA = qw( Amanda::Xfer::Element );
809
810 sub new { 
811     my $pkg = shift;
812
813
814     Amanda::Xfer::xfer_dest_null(@_);
815 }
816
817 package Amanda::Xfer::Dest::Buffer;
818
819 use vars qw(@ISA);
820 @ISA = qw( Amanda::Xfer::Element );
821
822 sub new { 
823     my $pkg = shift;
824
825
826     Amanda::Xfer::xfer_dest_buffer(@_);
827 }
828 *get = *Amanda::Xfer::xfer_dest_buffer_get;
829
830 package Amanda::Xfer::Dest::DirectTCPListen;
831
832 use vars qw(@ISA);
833 @ISA = qw( Amanda::Xfer::Element );
834
835 sub new { 
836     my $pkg = shift;
837
838
839     Amanda::Xfer::xfer_dest_directtcp_listen(@_);
840 }
841 *get_addrs = *Amanda::Xfer::xfer_dest_directtcp_listen_get_addrs;
842
843 package Amanda::Xfer::Dest::DirectTCPConnect;
844
845 use vars qw(@ISA);
846 @ISA = qw( Amanda::Xfer::Element );
847
848 sub new { 
849     my $pkg = shift;
850
851
852     Amanda::Xfer::xfer_dest_directtcp_connect(@_);
853 }
854
855 package Amanda::Xfer::Msg;
856
857 use Data::Dumper;
858 use overload '""' => sub { $_[0]->repr(); };
859
860 sub repr {
861     my ($self) = @_;
862     local $Data::Dumper::Indent = 0;
863     local $Data::Dumper::Terse = 1;
864     local $Data::Dumper::Useqq = 1;
865
866     my $typestr = Amanda::Xfer::xmsg_type_to_string($self->{'type'});
867     my $str = "{ type => \$$typestr, elt => $self->{'elt'}, version => $self->{'version'},";
868
869     my %skip = ( "type" => 1, "elt" => 1, "version" => 1 );
870     for my $k (keys %$self) {
871         next if $skip{$k};
872         $str .= " $k => " . Dumper($self->{$k}) . ",";
873     }
874
875     # strip the trailing comma and add a closing brace
876     $str =~ s/,$/ }/g;
877
878     return $str;
879 }
880
881 package Amanda::Xfer;
882
883 # make Amanda::Xfer->new equivalent to Amanda::Xfer::Xfer->new (don't
884 # worry, the blessings work out just fine)
885 *new = *Amanda::Xfer::Xfer::new;
886
887 # try to load Amanda::XferServer, which is server-only.  If it's not found, then
888 # its classes just remain undefined.
889 BEGIN {
890     use Amanda::Util;
891     if (Amanda::Util::built_with_component("server")) {
892         eval "use Amanda::XferServer;";
893     }
894 }
895 1;