1 # This file was automatically generated by SWIG (http://www.swig.org).
4 # Do not make changes to this file unless you know what you are doing--modify
5 # the SWIG interface file instead.
7 package Amanda::MainLoop;
9 use base qw(DynaLoader);
10 package Amanda::MainLoopc;
11 bootstrap Amanda::MainLoop;
12 package Amanda::MainLoop;
15 # ---------- BASE METHODS -------------
17 package Amanda::MainLoop;
20 my ($classname,$obj) = @_;
21 return bless $obj, $classname;
31 my ($self,$field) = @_;
32 my $member_func = "swig_${field}_get";
33 $self->$member_func();
37 my ($self,$field,$newval) = @_;
38 my $member_func = "swig_${field}_set";
39 $self->$member_func($newval);
48 # ------- FUNCTION WRAPPERS --------
50 package Amanda::MainLoop;
52 *run_c = *Amanda::MainLoopc::run_c;
53 *quit = *Amanda::MainLoopc::quit;
54 *timeout_source = *Amanda::MainLoopc::timeout_source;
55 *idle_source = *Amanda::MainLoopc::idle_source;
56 *child_watch_source = *Amanda::MainLoopc::child_watch_source;
57 *fd_source = *Amanda::MainLoopc::fd_source;
59 ############# Class : Amanda::MainLoop::Source ##############
61 package Amanda::MainLoop::Source;
62 use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
63 @ISA = qw( Amanda::MainLoop );
68 my $self = Amanda::MainLoopc::new_Source(@_);
69 bless $self, $pkg if defined($self);
73 return unless $_[0]->isa('HASH');
74 my $self = tied(%{$_[0]});
75 return unless defined $self;
76 delete $ITERATORS{$self};
77 if (exists $OWNER{$self}) {
78 Amanda::MainLoopc::delete_Source($self);
83 *set_callback = *Amanda::MainLoopc::Source_set_callback;
84 *remove = *Amanda::MainLoopc::Source_remove;
87 my $ptr = tied(%$self);
93 my $ptr = tied(%$self);
98 # ------- VARIABLE STUBS --------
100 package Amanda::MainLoop;
102 *G_IO_IN = *Amanda::MainLoopc::G_IO_IN;
103 *G_IO_OUT = *Amanda::MainLoopc::G_IO_OUT;
104 *G_IO_PRI = *Amanda::MainLoopc::G_IO_PRI;
105 *G_IO_ERR = *Amanda::MainLoopc::G_IO_ERR;
106 *G_IO_HUP = *Amanda::MainLoopc::G_IO_HUP;
107 *G_IO_NVAL = *Amanda::MainLoopc::G_IO_NVAL;
115 Amanda::MainLoop - Perl interface to the Glib MainLoop
119 use Amanda::MainLoop;
121 my $to = Amanda::MainLoop::timeout_source(2000);
122 $to->set_callback(sub {
123 print "Time's Up!\n";
124 $to->remove(); # dont' re-queue this timeout
125 Amanda::MainLoop::quit(); # return from Amanda::MainLoop::run
128 Amanda::MainLoop::run();
130 Note that all functions in this module are individually available for
133 use Amanda::MainLoop qw(run quit);
137 The main event loop of an application is a tight loop which waits for
138 events, and calls functions to respond to those events. This design
139 allows an IO-bound application to multitask within a single thread, by
140 responding to IO events as they occur instead of blocking on
141 particular IO operations.
143 The Amanda security API, transfer API, and other components rely on
144 the event loop to allow them to respond to their own events in a
147 The overall structure of an application, then, is to initialize its
148 state, register callbacks for some events, and begin looping. In each
149 iteration, the loop waits for interesting events to occur (data
150 available for reading or writing, timeouts, etc.), and then calls
151 functions to handle those interesting things. Thus, the application
152 spends most of its time waiting. When some application-defined state
153 is reached, the loop is terminated and the application cleans up and
156 The Glib main loop takes place within a call to
157 C<Amanda::MainLoop::run()>. This function executes until a call to
158 C<Amanda::MainLoop::quit()> occurs, at which point C<run()> returns.
159 You can check whether the loop is running with
160 C<Amanda::MainLoop::is_running()>.
162 =head1 HIGH-LEVEL INTERFACE
164 The functions in this section are intended to make asynchronous
165 programming as simple as possible. They are implemented on top of the
166 interfaces described in the LOW-LEVEL INTERFACE section.
170 In most cases, a callback does not need to be invoked immediately. In
171 fact, because Perl does not do tail-call optimization, a long chain of
172 callbacks may cause the perl stack to grow unnecessarily.
174 The solution is to queue the callback for execution on the next
175 iteration of the main loop, and C<call_later($cb, @args)> does exactly
180 if (can_do_it_now()) {
181 my $result = do_it();
182 Amanda::MainLoop::call_later($cb, $result)
188 When starting the main loop, an application usually has a sub that
189 should run after the loop has started. C<call_later> works in this
194 Amanda::MainLoop::quit();
196 Amanda::MainLoop::call_later($main);
198 Amanda::MainLoop::run();
202 As an optimization, C<make_cb> wraps a sub with a call to call_later
203 while also naming the sub (using C<Sub::Name>, if available):
205 my $fetched_cb = make_cb(fetched_cb => sub {
209 In general, C<make_cb> should be used whenever a callback is passed to
210 some other library. For example, the Changer API (see
211 L<Amanda::Changer>) might be invoked like this:
213 my $reset_finished_cb = make_cb(reset_finished_cb => sub {
215 die "while resetting: $err" if $err;
219 Be careful I<not> to use C<make_cb> in cases where some action must
220 take place before the next iteration of the main loop. In practice,
221 this means C<make_cb> should be avoided with file-descriptor
222 callbacks, which will trigger repeatedly until the descriptors' needs
225 C<make_cb> is exported automatically.
229 Sometimes you need the MainLoop equivalent of C<sleep()>. That comes
230 in the form of C<call_later($delay, $cb, @args)>, which takes a delay
231 (in milliseconds), a sub, and an arbitrary number of arguments. The
232 sub is called with the arguments after the delay has elapsed.
239 Amanda::MainLoop::call_after(1000, $counter, $i-1);
245 The function returns the underlying event source (see below), enabling
246 the caller to cancel the pending call:
248 my $tosrc = Amanda::MainLoop::call_after(15000, $timeout_cb):
249 # ...data arrives before timeout...
252 =head3 call_on_child_termination
254 To monitor a child process for termination, give its pid to
255 C<call_on_child_termination($pid, $cb, @args)>. When the child exits
256 for any reason, this will collect its exit status (via C<waitpid>) and
259 $cb->($exitstatus, @args);
261 Like C<call_after>, this function returns the event source to allow
262 early cancellation if desired.
268 size => $size, # optional, default 0
269 async_read_cb => $async_read_cb,
270 args => [ .. ]); # optional
272 This function will read C<$size> bytes when they are available from
273 file descriptor C<$fd>, and invoke the callback with the results:
275 $async_read_cb->($err, $buf, @args);
277 If C<$size> is zero, then the callback will get whatever data is
278 available as soon as it is available, up to an arbitrary buffer size.
279 If C<$size> is nonzero, then a short read may still occur if C<$size>
280 bytes do not become available simultaneously. On EOF, C<$buf> will be
281 the empty string. It is the caller's responsibility to set C<$fd> to
282 non-blocking mode. Note that not all operating sytems generate errors
283 that might be reported here. For example, on Solaris an invalid file
284 descriptor will be silently ignored.
286 The return value is an event source, and calling its C<remove> method
287 will cancel the read. It is an error to have more than one
288 C<async_read> operation on a single file descriptor at any time, and
289 will lead to unpredictable results.
291 This function adds a new FdSource every time it is invoked, so it is
292 not well-suited to processing large amounts of data. For that
293 purpose, consider using the low-level interface or, better, the
294 transfer architecture (see L<Amanda::Xfer>).
301 async_write_cb => $async_write_cb,
302 args => [ .. ]); # optional
304 This function will write C<$data> to file descriptor C<$fd> and invoke
305 the callback with the number of bytes written:
307 $cb->($err, $bytes_written, @args);
309 If C<$bytes_written> is less than then length of <$data>, then an
310 error occurred, and is given in C<$err>. As for C<async_read>, the
311 caller should set C<$fd> to non-blocking mode. Multiple parallel
312 invocations of this function for the same file descriptor are allowed
313 and will be serialized in the order the calls were made:
315 async_write($fd, "HELLO!\n",
316 async_write_cb => make_cb(wrote_hello => sub {
317 print "wrote 'HELLO!'\n";
319 async_write($fd, "GOODBYE!\n",
320 async_write_cb => make_cb(wrote_goodbye => sub {
321 print "wrote 'GOODBYE!'\n";
324 In this case, the two strings are guaranteed to be written in the same
325 order, and the callbacks will be called in the correct order.
327 Like async_read, this function may add a new FdSource every time it is
328 invoked, so it is not well-suited to processing large amounts of data.
332 Java has the notion of a "synchronized" method, which can only execute in one
333 thread at any time. This is a particular application of a lock, in which the
334 lock is acquired when the method begins, and released when it finishes.
336 With C<Amanda::MainLoop>, this functionality is generally not needed because
337 there is no unexpected preemeption. However, if you break up a long-running
338 operation (that doesn't allow concurrency) into several callbacks, you'll need
339 to ensure that at most one of those operations is going on at a time. The
340 C<synchronized> function manages that for you.
342 The function takes a C<$lock> argument, which should be initialized to an empty
343 arrayref (C<[]>). It is used like this:
345 use Amanda::MainLoop 'synchronized';
349 my ($arg1, $arg2, $dump_cb) = @_;
351 synchronized($self->{'lock'}, $dump_cb, sub {
352 my ($dump_cb) = @_; # IMPORTANT! See below
353 $self->do_dump_data($arg1, $arg2, $dump_cb);
357 Here, C<do_dump_data> may take a long time to complete (perhaps it starts
358 a long-running data transfer) but only one such operation is allowed at any
359 time and other C<Amanda::MainLoop> callbacks may occur (e.g. a timeout).
360 When the critical operation is complete, it calls C<$dump_cb> which will
361 release the lock before transferring control to the caller.
363 Note that the C<$dump_cb> in the inner C<sub> shadows that in
364 C<dump_data> -- this is intentional, the a call to the the inner
365 C<$dump_cb> is how C<synchronized> knows that the operation has completed.
367 Several methods may be synchronized with one another by simply sharing the same
370 =head1 ASYNCHRONOUS STYLE
372 When writing asynchronous code, it's easy to write code that is *very*
373 difficult to read or debug. The suggestions in this section will help
374 write code that is more readable, and also ensure that all asynchronous
375 code in Amanda uses similar, common idioms.
377 =head2 USING CALLBACKS
379 Most often, callbacks are short, and can be specified as anonymous
380 subs. They should be specified with make_cb, like this:
382 some_async_function(make_cb(foo_cb => sub {
387 If a callback is more than about two lines, specify it in a named
388 variable, rather than directly in the function call:
390 my $foo_cb = make_cb(foo_cb => sub {
396 some_async_function($foo_cb);
398 When using callbacks from an object-oriented package, it is often
399 useful to treat a method as a callback. This requires an anonymous
400 sub "wrapper", which can be written on one line:
402 some_async_function(sub { $self->foo_cb(@_) });
406 The single most important factor in readability is linearity. If a function
407 that performs operations A, B, and C in that order, then the code for A, B, and
408 C should appear in that order in the source file. This seems obvious, but it's
409 all too easy to write
412 my $do_c = sub { .. };
413 my $do_b = sub { .. $do_c->() .. };
414 my $do_a = sub { .. $do_b->() .. };
418 Which isn't very readable. Be readable.
420 =head2 SINGLE ENTRY AND EXIT
422 Amanda's use of callbacks emulates continuation-passing style. As such, when a
423 function finishes -- whether successfully or with an error -- it should call a
424 single callback. This ensures that the function has a simple control
425 interface: perform the operation and call the callback.
427 =head2 MULTIPLE STEPS
429 Some operations require a long squence of asynchronous operations. For
430 example, often the results of one operation are required to initiate
431 another. The I<step> syntax is useful to make this much more readable, and
432 also eliminate some nasty reference-counting bugs. The idea is that each "step"
433 in the process gets its own sub, and then each step calls the next step. The
434 first step defined will be called automatically.
437 my ($hostname, $port, $data, $sendfile_cb) = @_;
438 my ($addr, $socket); # shared lexical variables
439 my $steps = define_steps
440 cb_ref => \$sendfile_cb;
441 step lookup_addr => sub {
442 return async_gethostbyname(hostname => $hostname,
443 ghbn_cb => $steps->{'got_addr'});
445 step ghbn_cb => sub {
446 my ($err, $hostinfo) = @_;
448 $addr = $hostinfo->{'ipaddr'};
449 return $steps->{'connect'}->();
451 step connect => sub {
452 return async_connect(
455 connect_cb => $steps->{'connect_cb'},
458 step connect_cb => sub {
459 my ($err, $conn_sock) = @_;
461 $socket = $conn_sock;
462 return $steps->{'write_block'}->();
467 The C<define_steps> function sets the stage. It is given a reference to the
468 callback for this function (recall there is only one exit point!), and
469 "patches" that reference to free C<$steps>, which otherwise forms a reference
472 WARNING: if the function or method needs to do any kind of setup before its
473 first step, that setup should be done either in a C<setup> step or I<before>
474 the C<define_steps> invocation. Do not write any statements other than step
475 declarations after the C<define_steps> call.
477 Note that there are more steps in this example than are strictly necessary: the
478 body of C<connect> could be appended to C<ghbn_cb>. The extra steps make the
479 overall operation more readable by adding "punctuation" to separate the task of
480 handling a callback (C<ghbn_cb>) from starting the next operation (C<connect>).
482 Also note that the enclosing scope contains some lexical (C<my>)
483 variables which are shared by several of the callbacks.
485 All of the steps are wrapped by C<make_cb>, so each step will be executed on a
486 separate iteration of the MainLoop. This generally has the effect of making
487 asynchronous functions share CPU time more fairly. Sometimes, especially when
488 using the low-level interface, a callback must be called immediately. To
489 achieve this for all callbacks, add C<< immediate => 1 >> to the C<define_steps>
492 my $steps = define_steps
493 cb_ref => \$finished_cb,
496 To do the same for a single step, add the same keyword to the C<step> invocation:
499 connect => sub { .. };
501 In some case, you want to execute some code when the step finish, it can
502 be done by defining a finalize code in define_steps:
504 my $steps = define_steps
505 cb_ref => \$finished_cb,
506 finalize => sub { .. };
508 =head2 JOINING ASYNCHRONOUS "THREADS"
510 With slow operations, it is often useful to perform multiple operations
511 simultaneously. As an example, the following code might run two system
512 commands simultaneously and capture their output:
514 sub run_two_commands {
515 my ($finished_cb) = @_;
516 my $running_commands = 0;
517 my ($result1, $result2);
518 my $steps = define_steps
519 cb_ref => \$finished_cb;
522 run_command($command1,
523 run_cb => $steps->{'command1_done'});
525 run_command($command2,
526 run_cb => $steps->{'command2_done'});
528 step command1_done => sub {
530 $steps->{'maybe_done'}->();
532 step command2_done => sub {
534 $steps->{'maybe_done'}->();
536 step maybe_done => sub {
537 return if --$running_commands; # not done yet
538 $finished_cb->($result1, $result2);
542 It is tempting to optimize out the C<$running_commands> with something like:
544 step maybe_done { ## BAD!
545 return unless defined $result1 and defined $result2;
546 $finished_cb->($result1, $result2);
549 However this can lead to trouble. Remember that define_steps automatically
550 applies C<make_cb> to each step, so a C<maybe_done> is not invoked immediately
551 by C<command1_done> and C<command2_done> - instead, C<maybe_done> is scheduled
552 for invocation in the next loop of the mainloop (via C<call_later>). If both
553 commands finish before C<maybe_done> is invoked, C<call_later> will be called
554 I<twice>, with both C<$result1> and C<$result2> defined both times. The result
555 is that C<$finished_cb> is called twice, and mayhem ensues.
557 This is a complex case, but worth understanding if you want to be able to debug
558 difficult MainLoop bugs.
560 =head2 WRITING ASYNCHRONOUS INTERFACES
562 When designing a library or interface that will accept and invoke
563 callbacks, follow these guidelines so that users of the interface will
564 not need to remember special rules.
566 Each callback signature within a package should always have the same
567 name, ending with C<_cb>. For example, a hypothetical
568 C<Amanda::Estimate> module might provide its estimates through a
569 callback with four parameters. This callback should be referred to as
570 C<estimate_cb> throughout the package, and its parameters should be
571 clearly defined in the package's documentation. It should take
572 positional parameters only. If error conditions must also be
573 communicated via the callback, then the first parameter should be an
574 C<$error> parameter, which is undefined when no error has occurred.
575 The Changer API's C<res_cb> is typical of such a callback signature.
577 A caller can only know that an operation is complete by the invocation
578 of the callback, so it is important that a callback be invoked
579 I<exactly once> in all circumstances. Even in an error condition, the
580 caller needs to know that the operation has failed. Also beware of
581 bugs that might cause a callback to be invoked twice.
583 Functions or methods taking callbacks as arguments should either take
584 only a callback (like C<call_later>), or take hash-key parameters,
585 where the callback's key is the signature name. For example, the
586 C<Amanda::Estimate> package might define a function like
587 C<perform_estimate>, invoked something like this:
589 my $estimate_cb = make_cb(estimate_cb => sub {
590 my ($err, $size, $level) = @_;
594 Amanda::Estimate::perform_estimate(
597 estimate_cb => $estimate_cb,
600 When invoking a user-supplied callback within the library, there is no
601 need to wrap it in a C<call_later> invocation, as the user already
602 supplied that wrapper via C<make_cb>, or is not interested in using
605 Callbacks are a form of continuation
606 (L<http://en.wikipedia.org/wiki/Continuations>), and as such should
607 only be called at the I<end> of a function. Do not do anything after
608 invoking a callback, as you cannot know what processing has gone on in
613 $self->{'estimate_cb'}->(undef, $size, $level);
614 $self->{'estimate_in_progress'} = 0; # BUG!!
617 In this case, the C<estimate_cb> invocation may have called
618 C<perform_estimate> again, setting C<estimate_in_progress> back to 1.
619 A technique to avoid this pitfall is to always C<return> a callback's
620 result, even though that result is not important. This makes the bug
625 return $self->{'estimate_cb'}->(undef, $size, $level);
626 $self->{'estimate_in_progress'} = 0; # BUG (this just looks silly)
629 =head1 LOW-LEVEL INTERFACE
631 MainLoop events are generated by event sources. A source may produce
632 multiple events over its lifetime. The higher-level methods in the
633 previous section provide a more Perlish abstraction of event sources,
634 but for efficiency it is sometimes necessary to use event sources
637 The method C<< $src->set_callback(\&cb) >> sets the function that will
638 be called for a given source, and "attaches" the source to the main
639 loop so that it will begin generating events. The arguments to the
640 callback depend on the event source, but the first argument is always
641 the source itself. Unless specified, no other arguments are provided.
643 Event sources persist until they are removed with
644 C<< $src->remove() >>, even if the source itself is no longer accessible from Perl.
645 Although Glib supports it, there is no provision for "automatically"
646 removing an event source. Also, calling C<< $src->remove() >> more than
647 once is a potentially-fatal error. As an example:
651 Amanda::MainLoop::timeout_source(200)->set_callback(sub {
656 Amanda::MainLoop::quit();
661 Amanda::MainLoop::run();
663 There is no means in place to specify extra arguments to be provided
664 to a source callback when it is set. If the callback needs access to
665 other data, it should use a Perl closure in the form of lexically
666 scoped variables and an anonymous sub. In fact, this is exactly what
667 the higher-level functions (described above) do.
671 my $src = Amanda::MainLoop::timeout_source(10000);
673 A timeout source will create events at the specified interval,
674 specified in milliseconds (thousandths of a second). The events will
675 continue until the source is destroyed.
679 my $src = Amanda::MainLoop::idle_source(2);
681 An idle source will create events continuously except when a
682 higher-priority source is emitting events. Priorities are generally
683 small positive integers, with larger integers denoting lower
684 priorities. The events will continue until the source is destroyed.
688 my $src = Amanda::MainLoop::child_watch_source($pid);
690 A child watch source will issue an event when the process with the
691 given PID dies. To avoid race conditions, it will issue an event even
692 if the process dies before the source is created. The callback is
693 called with three arguments: the event source, the PID, and the
696 Note that this source is totally incompatible with any thing that
697 would cause perl to change the SIGCHLD handler. If SIGCHLD is
698 changed, under some circumstances the module will recognize this
699 circumstance, add a warning to the debug log, and continue operating.
700 However, it is impossible to catch all possible situations.
702 =head2 File Descriptor
704 my $src = Amanda::MainLoop::fd_source($fd, $G_IO_IN);
706 This source will issue an event whenever one of the given conditions
707 is true for the given file (a file handle or integer file descriptor).
708 The conditions are from Glib's GIOCondition, and are C<$G_IO_IN>,
709 C<G_IO_OUT>, C<$G_IO_PRI>, C<$G_IO_ERR>, C<$G_IO_HUP>, and
710 C<$G_IO_NVAL>. These constants are available with the import tag
713 Generally, when reading from a file descriptor, use
714 C<$G_IO_IN|$G_IO_HUP|$G_IO_ERR> to ensure that an EOF triggers an
715 event as well. Writing to a file descriptor can simply use
716 C<$G_IO_OUT|$G_IO_ERR>.
718 The callback attached to an FdSource should read from or write to the
719 underlying file descriptor before returning, or it will be called
720 again in the next iteration of the main loop, which can lead to
721 unexpected results. Do I<not> use C<make_cb> here!
723 =head2 Combining Event Sources
725 Event sources are often set up in groups, e.g., a long-term operation
726 and a timeout. When this is the case, be careful that all sources are
727 removed when the operation is complete. The easiest way to accomplish
728 this is to include all sources in a lexical scope and remove them at
729 the appropriate times:
732 my $op_src = long_operation_src();
733 my $timeout_src = Amanda::MainLoop::timeout_source($timeout);
737 $timeout_src->remove();
740 $op_src->set_callback(sub {
741 print "Operation complete\n";
745 $timeout_src->set_callback(sub {
746 print "Operation timed out\n";
751 =head2 Relationship to Glib
753 Glib's main event loop is described in the Glib manual:
754 L<http://library.gnome.org/devel/glib/stable/glib-The-Main-Event-Loop.html>.
755 Note that Amanda depends only on the functionality available in
756 Glib-2.2.0, so many functions described in that document are not
757 available in Amanda. This module provides a much-simplified interface
758 to the glib library, and is not intended as a generic wrapper for it:
759 Amanda's perl-accessible main loop only runs a single C<GMainContext>,
760 and always runs in the main thread; and (aside from idle sources),
761 event priorities are not accessible from Perl.
774 my $have_sub_name = eval "use Sub::Name; 1";
775 if (!$have_sub_name) {
778 my ($name, $sub) = @_;
785 # glib's g_is_main_loop_running() seems inaccurate, so we just
786 # track that information locally..
787 my $mainloop_running = 0;
789 $mainloop_running = 1;
791 $mainloop_running = 0;
793 push @EXPORT_OK, "run";
796 return $mainloop_running;
798 push @EXPORT_OK, "is_running";
800 # quit is a direct call to C
801 push @EXPORT_OK, "quit";
805 my @waiting_to_call_later;
807 my ($sub, @args) = @_;
809 confess "undefined sub" unless ($sub);
811 # add the callback if nothing is waiting right now
812 if (!@waiting_to_call_later) {
813 timeout_source(0)->set_callback(sub {
817 while (@waiting_to_call_later) {
818 my ($sub, @args) = @{shift @waiting_to_call_later};
819 $sub->(@args) if $sub;
824 push @waiting_to_call_later, [ $sub, @args ];
826 push @EXPORT_OK, "call_later";
829 my ($name, $sub) = @_;
832 my ($pkg, $filename, $line) = caller;
833 my $newname = sprintf('$%s::%s@l%s', $pkg, $name, $line);
834 $sub = subname($newname => $sub);
836 $sub = $name; # no name => sub is actually in first parameter
840 Amanda::MainLoop::call_later($sub, @_);
843 push @EXPORT, 'make_cb';
846 my ($delay_ms, $sub, @args) = @_;
848 confess "undefined sub" unless ($sub);
850 my $src = timeout_source($delay_ms);
851 $src->set_callback(sub {
858 push @EXPORT_OK, "call_after";
860 sub call_on_child_termination {
861 my ($pid, $cb, @args) = @_;
863 confess "undefined sub" unless ($cb);
865 my $src = child_watch_source($pid);
866 $src->set_callback(sub {
867 my ($src, $pid, $exitstatus) = @_;
869 return $cb->($exitstatus);
872 push @EXPORT_OK, "call_on_child_termination";
876 my $fd = $params{'fd'};
877 my $size = $params{'size'} || 0;
878 my $cb = $params{'async_read_cb'};
880 @args = @{$params{'args'}} if exists $params{'args'};
887 my $res = POSIX::read($fd, $buf, $size || 32768);
889 return $cb->($!, undef, @args);
891 return $cb->(undef, $buf, @args);
894 my $src = fd_source($fd, $G_IO_IN|$G_IO_HUP|$G_IO_ERR);
895 $src->set_callback($fd_cb);
898 push @EXPORT_OK, "async_read";
900 my %outstanding_writes;
903 my $fd = $params{'fd'};
904 my $data = $params{'data'};
905 my $cb = $params{'async_write_cb'};
907 @args = @{$params{'args'}} if exists $params{'args'};
909 # more often than not, writes will not block, so just try it.
910 if (!exists $outstanding_writes{$fd}) {
911 my $res = POSIX::write($fd, $data, length($data));
913 if ($! != POSIX::EAGAIN) {
914 return $cb->($!, 0, @args);
916 } elsif ($res eq length($data)) {
917 return $cb->(undef, $res, @args);
919 # chop off whatever data was written
920 $data = substr($data, $res);
924 if (!exists $outstanding_writes{$fd}) {
925 my $fd_writes = $outstanding_writes{$fd} = [];
926 my $src = fd_source($fd, $G_IO_OUT|$G_IO_HUP|$G_IO_ERR);
928 # (note that this does not coalesce consecutive outstanding writes
929 # into a single POSIX::write call)
931 my $ow = $fd_writes->[0];
932 my ($buf, $nwritten, $len, $cb, $args) = @$ow;
934 my $res = POSIX::write($fd, $buf, $len-$nwritten);
937 $cb->($!, $nwritten, @$args);
939 $ow->[1] = $nwritten = $nwritten + $res;
940 if ($nwritten == $len) {
942 $cb->(undef, $nwritten, @$args);
944 $ow->[0] = substr($buf, $res);
948 # (the following is *intentionally* done after calling $cb, allowing
949 # $cb to add a new message to $fd_writes if desired, and thus avoid
950 # removing and re-adding the source)
951 if (@$fd_writes == 0) {
953 delete $outstanding_writes{$fd};
957 $src->set_callback($fd_cb);
960 push @{$outstanding_writes{$fd}}, [ $data, 0, length($data), $cb, \@args ];
962 push @EXPORT_OK, "async_write";
965 my ($lock, $orig_cb, $sub) = @_;
968 $continuation_cb = sub {
971 # shift this invocation off the queue
972 my ($last_sub, $last_orig_cb) = @{ shift @$lock };
974 # start the next invocation, if the queue isn't empty
976 Amanda::MainLoop::call_later($lock->[0][0], $continuation_cb);
979 # call through to the original callback for the last invocation
980 return $last_orig_cb->(@args);
983 # push this sub onto the lock queue
984 if ((push @$lock, [ $sub, $orig_cb ]) == 1) {
985 # if this is the first addition to the queue, start it
986 $sub->($continuation_cb);
989 push @EXPORT_OK, "synchronized";
991 { # privat variables to track the "current" step definition
996 sub define_steps (@) {
998 my $cb_ref = $params{'cb_ref'};
999 my $finalize = $params{'finalize'};
1002 croak "cb_ref is undefined" unless defined $cb_ref;
1003 croak "cb_ref is not a reference" unless ref($cb_ref) eq 'REF';
1004 croak "cb_ref is not a code double-reference" unless ref($$cb_ref) eq 'CODE';
1006 # arrange to clear out $steps when $exit_cb is called; this eliminates
1007 # reference loops (values in %steps are closures which point to %steps).
1008 # This also clears $current_steps, which is likely holding a reference to
1010 my $orig_cb = $$cb_ref;
1013 $current_steps = undef;
1014 $finalize->() if defined($finalize);
1019 $current_steps = \%steps;
1020 $immediate = $params{'immediate'};
1023 return $current_steps;
1025 push @EXPORT, "define_steps";
1029 my $step_immediate = $immediate || $params{'immediate'};
1030 delete $params{'immediate'} if $step_immediate;
1032 my ($name) = keys %params;
1033 my $cb = $params{$name};
1035 croak "expected a sub at key $name" unless ref($cb) eq 'CODE';
1037 # make the sub delayed
1038 unless ($step_immediate) {
1040 $cb = sub { Amanda::MainLoop::call_later($orig_cb, @_); }
1043 # patch up the callback
1044 my ($pkg, $filename, $line) = caller;
1045 my $newname = sprintf('$%s::%s@l%s', $pkg, $name, $line);
1046 $cb = subname($newname => $cb);
1048 # store the step for later
1049 $current_steps->{$name} = $cb;
1051 # and invoke it, if it's the first step given
1053 if ($step_immediate) {
1061 push @EXPORT, "step";
1064 push @EXPORT_OK, qw(GIOCondition_to_strings);
1065 push @{$EXPORT_TAGS{"GIOCondition"}}, qw(GIOCondition_to_strings);
1067 my %_GIOCondition_VALUES;
1068 #Convert a flag value to a list of names for flags that are set.
1069 sub GIOCondition_to_strings {
1073 for my $k (keys %_GIOCondition_VALUES) {
1074 my $v = $_GIOCondition_VALUES{$k};
1076 #is this a matching flag?
1077 if (($v == 0 && $flags == 0) || ($v != 0 && ($flags & $v) == $v)) {
1082 #by default, just return the number as a 1-element list
1090 push @EXPORT_OK, qw($G_IO_IN);
1091 push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_IN);
1093 $_GIOCondition_VALUES{"G_IO_IN"} = $G_IO_IN;
1095 push @EXPORT_OK, qw($G_IO_OUT);
1096 push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_OUT);
1098 $_GIOCondition_VALUES{"G_IO_OUT"} = $G_IO_OUT;
1100 push @EXPORT_OK, qw($G_IO_PRI);
1101 push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_PRI);
1103 $_GIOCondition_VALUES{"G_IO_PRI"} = $G_IO_PRI;
1105 push @EXPORT_OK, qw($G_IO_ERR);
1106 push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_ERR);
1108 $_GIOCondition_VALUES{"G_IO_ERR"} = $G_IO_ERR;
1110 push @EXPORT_OK, qw($G_IO_HUP);
1111 push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_HUP);
1113 $_GIOCondition_VALUES{"G_IO_HUP"} = $G_IO_HUP;
1115 push @EXPORT_OK, qw($G_IO_NVAL);
1116 push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_NVAL);
1118 $_GIOCondition_VALUES{"G_IO_NVAL"} = $G_IO_NVAL;
1120 #copy symbols in GIOCondition to constants
1121 push @{$EXPORT_TAGS{"constants"}}, @{$EXPORT_TAGS{"GIOCondition"}};