view release on metacpan or  search on metacpan

News/Gateway.in  view on Meta::CPAN

    # If our package has been loaded, which it should have been, we can
    # derive the name of the directory our modules are in from it.
    # Otherwise, we'll do a full @INC search for the module we're looking
    # for.
    my $name = $INC{"$package.pm"};
    if ($name) {
        $name =~ s%^(.*)$package\.pm$%$1auto/$package/$module.al%;
        undef $name unless (-r $name);
    }
    unless ($name) { $name = "auto/$package/$module.al" }

    # Now comes the fun.  We try to load the module.  If the routine trying
    # to be autoloaded is DESTROY or import, we generate a null one on the
    # fly to avoid annoying error messages at shutdown or use time.
    #
    # We have to handle a few things specially here.  First, if the sub that
    # we're trying and failing to autoload is mail_error() (which may be
    # called by error()), then we have a major problem and need to avoid
    # calling more methods.  Second, if the first argument to the sub isn't
    # a reference (meaning that they're not calling a method), we can't then
    # call our error() method since we don't have an object.  (This should
    # really be fixed by making error() robust in that case....)
    my $save = $@;
    eval { require $name };
    if ($@) {
        $@ =~ s/ at .*\n//;
        if (substr ($AUTOLOAD, -9) eq '::DESTROY'
            || substr ($AUTOLOAD, -8) eq '::import') {
            *$AUTOLOAD = sub {};
        } elsif (substr ($AUTOLOAD, -12) eq '::mail_error') {
            warn "Autoload of $AUTOLOAD failed: $@\n";
            warn "Unable to autoload error methods, aborting\n";
            exit $FAILCODE;
        } elsif (not ref $_[0]) {
            warn "Autoload of $AUTOLOAD failed: $@\n";
            warn "Attempted to autoload non-method, aborting\n";
            exit $FAILCODE;
        } else {
            $_[0]->error ("Autoload of $AUTOLOAD failed: $@");
        }
    }
    $@ = $save;
    goto &$AUTOLOAD;
}


############################################################################
# Creation and initialization of a new gateway
############################################################################

# This method creates a new gateway object.  It takes arguments specifying
# whether we're running interactively (if we are, errors can be dealt with
# by dying; otherwise, we need to send mail), the maintainer (administrative
# contact address) which defaults to the user we're running as if none is
# given, and the envelope sender that should be used for any and all replies
# to articles.
sub new {
    my $that = shift;
    my $class = ref $that || $that;
    my ($interactive, $maintainer, $envelope) = @_;
    unless ($maintainer) { $maintainer = (getpwuid ($<))[0] }
    unless ($envelope) { $envelope = $maintainer }
    my $self = {
        confhooks   => {},
        mesghooks   => [],
        envelope    => $envelope,
        interactive => $interactive,
        maintainer  => $maintainer
    };
    bless ($self, $class);
}

# Takes a list of modules as arguments and installs all of the callbacks for
# those modules (as determined by the %HOOKS hash defined above).  The
# arguments to this constructor can just be a list of modules, or can be an
# intermixed list of modules and module/argument pairs.  Arguments must be
# anonymous arrays, and if arguments are present for a module, they're
# passed in to the _init method of the module.
sub modules {
    my $self = shift;
    my $module;
    while (defined ($module = shift)) {
        unless (defined $HOOKS{$module}) {
            $self->error ("Unknown module $module");
        }
        my @hook = @{$HOOKS{$module}};
        if (ref $_[0]) {
            my $method = $module . '_init';
            $self->$method (@{+shift});
        }
        push (@{$$self{mesghooks}}, $module);
        for (@hook) { push (@{$$self{confhooks}{$_}}, $module) }
    }
}


############################################################################
# Message handling
############################################################################

# Read in the article from a source, returning undef if this fails (either
# because no data is available or because the size limits are exceeded) and
# the number of bytes read if it succeeds.  This is mostly just a wrapper
# around the News::Article constructor.
sub read {
    my $self = shift;
    $$self{article} = News::Article->new (@_);
}

# Apply the given modules, or if none are given, apply all of the ones we
# have pending.  Each hook should return undef on success and a string
# indicating the error message on failure; as soon as any hook fails, this
# method aborts and returns a list consisting of the name of the module that
# failed and the error message in an array context or the message prepended
# with the name of the module in a scalar context.
sub apply {
    my $self = shift;
    my @modules = @_ ? @_ : @{$$self{mesghooks}};
    for (@modules) {
        my $module = $_ . '_mesg';
        my $error = $self->$module ();