[debian/amanda] / perl / Amanda / MainLoop.pm

# This file was automatically generated by SWIG (http://www.swig.org).
# Version 1.3.39
#
# Do not make changes to this file unless you know what you are doing--modify
# the SWIG interface file instead.

package Amanda::MainLoop;
use base qw(Exporter);
use base qw(DynaLoader);
package Amanda::MainLoopc;
bootstrap Amanda::MainLoop;
package Amanda::MainLoop;
@EXPORT = qw();

# ---------- BASE METHODS -------------

package Amanda::MainLoop;

sub TIEHASH {
    my ($classname,$obj) = @_;
    return bless $obj, $classname;
}

sub CLEAR { }

sub FIRSTKEY { }

sub NEXTKEY { }

sub FETCH {
    my ($self,$field) = @_;
    my $member_func = "swig_${field}_get";
    $self->$member_func();
}

sub STORE {
    my ($self,$field,$newval) = @_;
    my $member_func = "swig_${field}_set";
    $self->$member_func($newval);
}

sub this {
    my $ptr = shift;
    return tied(%$ptr);
}


# ------- FUNCTION WRAPPERS --------

package Amanda::MainLoop;

*run_c = *Amanda::MainLoopc::run_c;
*quit = *Amanda::MainLoopc::quit;
*timeout_source = *Amanda::MainLoopc::timeout_source;
*idle_source = *Amanda::MainLoopc::idle_source;
*child_watch_source = *Amanda::MainLoopc::child_watch_source;
*fd_source = *Amanda::MainLoopc::fd_source;

############# Class : Amanda::MainLoop::Source ##############

package Amanda::MainLoop::Source;
use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);
@ISA = qw( Amanda::MainLoop );
%OWNER = ();
%ITERATORS = ();
sub new {
    my $pkg = shift;
    my $self = Amanda::MainLoopc::new_Source(@_);
    bless $self, $pkg if defined($self);
}

sub DESTROY {
    return unless $_[0]->isa('HASH');
    my $self = tied(%{$_[0]});
    return unless defined $self;
    delete $ITERATORS{$self};
    if (exists $OWNER{$self}) {
        Amanda::MainLoopc::delete_Source($self);
        delete $OWNER{$self};
    }
}

*set_callback = *Amanda::MainLoopc::Source_set_callback;
*remove = *Amanda::MainLoopc::Source_remove;
sub DISOWN {
    my $self = shift;
    my $ptr = tied(%$self);
    delete $OWNER{$ptr};
}

sub ACQUIRE {
    my $self = shift;
    my $ptr = tied(%$self);
    $OWNER{$ptr} = 1;
}


# ------- VARIABLE STUBS --------

package Amanda::MainLoop;

*G_IO_IN = *Amanda::MainLoopc::G_IO_IN;
*G_IO_OUT = *Amanda::MainLoopc::G_IO_OUT;
*G_IO_PRI = *Amanda::MainLoopc::G_IO_PRI;
*G_IO_ERR = *Amanda::MainLoopc::G_IO_ERR;
*G_IO_HUP = *Amanda::MainLoopc::G_IO_HUP;
*G_IO_NVAL = *Amanda::MainLoopc::G_IO_NVAL;

@EXPORT_OK = ();
%EXPORT_TAGS = ();

=head1 NAME

Amanda::MainLoop - Perl interface to the Glib MainLoop

=head1 SYNOPSIS

    use Amanda::MainLoop;
    
    my $to = Amanda::MainLoop::timeout_source(2000);
    $to->set_callback(sub { 
        print "Time's Up!\n";
        $to->remove();              # dont' re-queue this timeout
        Amanda::MainLoop::quit();   # return from Amanda::MainLoop::run
    });

    Amanda::MainLoop::run();

Note that all functions in this module are individually available for export,
e.g.,

    use Amanda::MainLoop qw(run quit);

=head1 OVERVIEW

The main event loop of an application is a tight loop which waits for events,
and calls functions to respond to those events.  This design allows an IO-bound
application to multitask within a single thread, by responding to IO events as
they occur instead of blocking on particular IO operations.

The Amanda security API, transfer API, and other components rely on the event
loop to allow them to respond to their own events in a timely fashion.

The overall structure of an application, then, is to initialize its state,
register callbacks for some events, and begin looping.  When some
application-defined state is reached, the loop is terminated and the
application cleans up and exits.

=head2 LOOPING

The actual event loop takes place within a call to C<Amanda::MainLoop::run()>.
This function executes until a call to C<Amanda::MainLoop::quit()> occurs, at
which point C<run()> returns.  You can check whether the loop is running with
C<Amanda::MainLoop::is_running()>.

In some cases, a sub should only run after the loop has started.  The
most common case is when a callback may call C<Amanda::MainLoop::quit>
immediately.  In this circumstance, use C<call_later>, which takes a
subref and an arbitrary number of arguments for that sub:

    my $cb = sub {
        my ($letters, $digits) = @_;
        # ..
        Amanda::MainLoop::quit();
    };
    Amanda::MainLoop::call_later($cb, "abc", 123);
    # ..
    Amanda::MainLoop::run();

Similarly, a tight loop of callbacks with no blocking operations can
lead to excessive stack consumption.  In this case, C<call_later()> is
useful, too. It queues the callback to run at the next cycle of the
MainLoop:

    sub might_delay {
        my ($cb) = @_;
        if (can_do_it_now()) {
            my $result = do_it();
            Amanda::MainLoop::call_later($cb, $result)
        } else {
            # ..
        }
    }

=head2 EVENT SOURCES

An event source is responsible for producing events.  A source may produce
multiple events over its lifetime.

The method C<$src->set_callback(\&cb)> sets the function that will be called
for a given source, and "attaches" the source to the main loop so that it will
begin generating events.  The arguments to the callback depend on the event
source, but the first argument is always the source itself.  Unless specified,
no other arguments are provided.

Event sources persist until they are removed with C<$src->remove()>, even if
the source itself is no longer accessible from Perl.  Although Glib supports
it, there is no provision for "automatically" removing an event source.  As an
example:

  sub start_timer { 
    my ($loops) = @_;

    Amanda::MainLoop::timeout_source(200)->set_callback(sub {
      my ($src) = @_;
      print "timer\n";
      if (--$loops <= 0) {
        $src->remove();
        Amanda::MainLoop::quit();
      }
    });
  }
  start_timer(10);
  Amanda::MainLoop::run();

=head3 Timeout

  my $src = Amanda::MainLoop::timeout_source(10000);

A timeout source will create events at the specified interval, specified in
milliseconds (thousandths of a second).  The events will continue until the
source is destroyed.

=head3 Idle

  my $src = Amanda::MainLoop::idle_source(2);

An idle source will create events continuously except when a higher-priority
source is emitting events.  Priorities are generally small positive integers,
with larger integers denoting lower priorities.  The events will continue until
the source is destroyed.

=head3 Child Watch

  my $src = Amanda::MainLoop::child_watch_source($pid);

A child watch source will issue an event when the process with the given PID
dies.  To avoid race conditions, it will issue an event even if the process
dies before the source is created.  The callback is called with three
arguments: the event source, the PID, and the child's exit status.

Note that this source is totally incompatible with any thing that would cause
perl to change the SIGCHLD handler.  If SIGCHLD is changed, under some
circumstances the module will recognize this circumstance, add a warning to the
debug log, and continue operating.  However, it is impossible to catch all
possible situations.

=head3 File Descriptor

  my $src = Amanda::MainLoop::fd_source($fd, G_IO_IN);

This source will issuen an event whenever one of the given conditions is true
for the given file descriptor.  The conditions are from Glib's GIOCondition,
and are C<$G_IO_IN>, C<G_IO_OUT>, C<$G_IO_PRI>, C<$G_IO_ERR>, C<$G_IO_HUP>, and
C<$G_IO_NVAL>.  These constants are available with the import tag
C<:GIOCondition>.

Generally, when reading from a file descriptor, use C<$G_IO_IN|$G_IO_HUP> to
ensure that an EOF triggers an event as well.  Writing to a file descriptor can
simply use C<$G_IO_OUT>.

=head1 RELATION TO GLIB

Glib's main event loop is described in the Glib manual:
L<http://library.gnome.org/devel/glib/stable/glib-The-Main-Event-Loop.html>.
Note that Amanda depends only on the functionality available in Glib-2.2.0, so
many functions described in that document are not available in Amanda.  This
module provides a much-simplified interface to the glib library, and is not
intended as a generic wrapper for it.  Specifically:

=over

=item Amanda's perl-accessible main loop only runs a single C<GMainContext>, and
always runs in the main thread.

=item Besides idle sources, event priorities are not accessible from Perl.

=back

=head1 PROGRAMMING HINTS

Most often, callbacks are short, and can be specified as anonymous subs:

    $src->set_callback(sub {
        my ($src) = @_;
        # ...
    });

There is currently no means in place to specify extra arguments for a callback
when it is set.  If the callback needs access to other data, it should use a
Perl closure in the form of lexically scoped variables and a (possibly
anonymous) sub:

    {
        my $total_results = 0;

        $src->set_callback(sub {
            my ($src, $result) = @_;
            $total_results += $result;
        });
    }

Event sources are often set up in groups, e.g., a long-term operation and a
timeout.  When this is the case, be careful that all sources are removed when
the operation is complete.  The easiest way to accomplish this is to include all
sources in a lexical scope and remove them at the appropriate times:

    {
        my $op_src = long_operation_src();
        my $timeout_src = Amanda::MainLoop::timeout_source($timeout);

        sub finish {
            $op_src->remove();
            $timeout_src->remove();
        }

        $op_src->set_callback(sub {
            print "Operation complete\n";
            finish();
        });

        $timeout_src->set_callback(sub {
            print "Operation timed out\n";
            finish();
        });
    }

Both of these limitations may be lifted in future revisions of
L<Amanda::MainLoop>.

=cut

# glib's g_is_main_loop_running() seems inaccurate, so we just
# track that information locally..
my $mainloop_running = 0;

my @waiting_to_call_later;
sub call_later {
    my ($sub, @args) = @_;

    # add the callback if nothing is waiting right now
    if (!@waiting_to_call_later) {
        timeout_source(0)->set_callback(sub {
            my ($src) = @_;
            $src->remove();

            while (@waiting_to_call_later) {
                my ($sub, @args) = @{pop @waiting_to_call_later};
                $sub->(@args);
            }
        });
    }

    push @waiting_to_call_later, [ $sub, @args ];
}

sub run {
    $mainloop_running = 1;
    run_c();
    $mainloop_running = 0;
}

sub is_running {
    return $mainloop_running;
}

push @EXPORT_OK, qw(GIOCondition_to_strings);
push @{$EXPORT_TAGS{"GIOCondition"}}, qw(GIOCondition_to_strings);

my %_GIOCondition_VALUES;
#Convert a flag value to a list of names for flags that are set.
sub GIOCondition_to_strings {
    my ($flags) = @_;
    my @result = ();

    for my $k (keys %_GIOCondition_VALUES) {
        my $v = $_GIOCondition_VALUES{$k};

        #is this a matching flag?
        if (($v == 0 && $flags == 0) || ($v != 0 && ($flags & $v) == $v)) {
            push @result, $k;
        }
    }

#by default, just return the number as a 1-element list
    if (!@result) {
        return ($flags);
    }

    return @result;
}

push @EXPORT_OK, qw($G_IO_IN);
push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_IN);

$_GIOCondition_VALUES{"G_IO_IN"} = $G_IO_IN;

push @EXPORT_OK, qw($G_IO_OUT);
push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_OUT);

$_GIOCondition_VALUES{"G_IO_OUT"} = $G_IO_OUT;

push @EXPORT_OK, qw($G_IO_PRI);
push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_PRI);

$_GIOCondition_VALUES{"G_IO_PRI"} = $G_IO_PRI;

push @EXPORT_OK, qw($G_IO_ERR);
push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_ERR);

$_GIOCondition_VALUES{"G_IO_ERR"} = $G_IO_ERR;

push @EXPORT_OK, qw($G_IO_HUP);
push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_HUP);

$_GIOCondition_VALUES{"G_IO_HUP"} = $G_IO_HUP;

push @EXPORT_OK, qw($G_IO_NVAL);
push @{$EXPORT_TAGS{"GIOCondition"}}, qw($G_IO_NVAL);

$_GIOCondition_VALUES{"G_IO_NVAL"} = $G_IO_NVAL;

#copy symbols in GIOCondition to constants
push @{$EXPORT_TAGS{"constants"}},  @{$EXPORT_TAGS{"GIOCondition"}};
1;