view release on metacpan or  search on metacpan

Alarm.pm  view on Meta::CPAN

our $VERSION       = 0.05;
our $TIMEOUT       = 180;
our $LOCAL_TIMEOUT = 30;

# add a \. if we ever support HiRes alarm()
my $ALARM_RE = qr/^[\d]+$/;

BEGIN {
    __PACKAGE__->mk_accessors(qw/ alarm /);
}

sub setup_finalize {
    my $c   = shift;
    my $ret = $c->next::method(@_);

    my %conf = %{ $c->config->{alarm} };

    if ( $conf{use_native_signals} ) {
        $USE_NATIVE_SIGNALS = 1;
    }
    else {
        require Sys::SigAction;    # defer till runtime
    }

    return $ret;
}

# must call on every request
sub prepare {
    my $class = shift;
    my $c     = $class->next::method(@_);

    return $c unless exists $c->config->{alarm};

    my %alarm;

    # copy of config for easy checking and temp overriding
    my %conf = %{ $c->config->{alarm} };

    # should we override forward method?
    $alarm{forward} = $conf{forward} || 0;

    # check if we should override forward() based on regex
    if (    exists $conf{timeout}
        and exists $conf{override}
        and $conf{timeout} )
    {
        my $re = $conf{override}->{re} || '';
        if ( $re && $c->req->path =~ m/$re/ ) {
            $alarm{override} = $c->req->path;
            if ( $c->debug ) {
                $c->log->debug(
                    "found alarm override for: " . $c->req->path );
                $c->log->debug( "setting this request global alarm to "
                        . $conf{override}->{timeout} );
            }
            $conf{global} = $conf{override}->{timeout};
        }
    }

    # special case - allow for disable global timer
    if ( exists $conf{global}
        && $conf{global} != 0 )
    {
        my $timeout = $conf{global};

        my $handler = $conf{handler}
            || sub {
            Catalyst::Exception->throw("Global Alarm timeout: $timeout");
            };

        if ( !$timeout or $timeout !~ m/$ALARM_RE/ ) {

            # avoid spurious warning
            no warnings;

            #$timeout = '' unless defined $timeout;
            Catalyst::Exception->throw(
                "Global Alarm timeout value is invalid: $timeout");
        }

        # configure alarm
        $alarm{timeout} = $timeout;
        $alarm{start}   = [ Time::HiRes::gettimeofday() ];
        $alarm{handler} = $handler;
        $alarm{failed}  = [];

        my $alarm_handler = sub {
            $c->alarm->on(1);
            $c->alarm->sounded( Time::HiRes::gettimeofday() );
            $c->error(
                "Global Alarm sounded at ~$timeout seconds: "
                    . Time::HiRes::tv_interval(
                    $c->alarm->start, $c->alarm->sounded
                    )
            );

            push( @{ $c->alarm->{failed} }, $c->action->name );
            &$handler( $c, 1 );
        };

        if ($USE_NATIVE_SIGNALS) {
            $SIG{ALRM} = $alarm_handler;
        }
        else {

            $alarm{sig_handler}
                = Sys::SigAction::set_sig_handler( 'ALRM', $alarm_handler,
                { safe => 1 } );

        }

        # set alarm -- see NOTE in timeout about HiRes::alarm()
        #Time::HiRes::alarm($timeout);
        CORE::alarm($timeout);

        $c->log->debug("global alarm set for $timeout seconds")
            if $c->debug;

    }