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