EMDIS-ECS

 view release on metacpan or  search on metacpan

lib/EMDIS/ECS.pm  view on Meta::CPAN

    $cmd_output = '';

    # initialize
    my ($reader, $writer) = (IO::Handle->new, IO::Handle->new);
    my ($pid, @msgs, $status);
    my $result = '';

    # set up "local" SIG_PIPE and SIG_ALRM handlers
    # (Note:  not using "local $SIG{PIPE}" because it ignores die())
    my $broken_pipe = '';
    my $oldsigpipe = $SIG{PIPE};
    $SIG{PIPE} = sub { $broken_pipe = 1; };
    my $oldsigalrm = $SIG{ALRM};
    $SIG{ALRM} = sub {
        die "timeout - $timelimit second processing time limit exceeded\n";
    };

    # use eval {}; to enforce time limit (see Perl Cookbook, 16.21)
    eval {
        alarm($timelimit);  # set time limit
        $broken_pipe = '';
        $pid = open2($reader, $writer, $cmd);
        print $writer $input_data if defined $input_data;

lib/EMDIS/ECS.pm  view on Meta::CPAN

        my $signal_num = $status & 127;
        my $dumped_core = $status & 128;
        # construct error message
        $result = sprintf("Status 0x%04x (exit %d%s%s)",
                          $status, $exit_value,
                          ($signal_num ? ", signal $signal_num" : ''),
                          ($dumped_core ? ', core dumped' : ''));
    }
    $writer->close if $writer->opened;
    $reader->close if $reader->opened;
    if(defined $oldsigpipe) { $SIG{PIPE} = $oldsigpipe; }
    else                    { delete $SIG{PIPE}; }
    if(defined $oldsigalrm) { $SIG{ALRM} = $oldsigalrm; }
    else                    { delete $SIG{ALRM}; }
    $result .= "\n----------\n" . join("", @msgs) if($result and $#msgs >= 0);
    # set module-level variable containing command output
    if($#msgs >= 0) { $cmd_output = join('', @msgs); }
    else            { $cmd_output = ''; }
    return $result;
}

# ----------------------------------------------------------------------
# Unlink PID file.

lib/EMDIS/ECS/LockedHash.pm  view on Meta::CPAN

# avoid indefinite blocking.  Returns true if able to obtain lock within
# time limit;  otherwise returns false.
sub _lock_unix {
    my $this = shift;
    my $lock_type = shift;
    $lock_type = LOCK_EX unless defined $lock_type;
    my $result = 1;

    # set up "local" SIG_ALRM handler
    # (Note:  not using "local $SIG{PIPE}" because it ignores die())
    my $oldsigalrm = $SIG{ALRM};
    $SIG{ALRM} = sub {
        die "timeout - $this->{lock_timeout} second time limit exceeded\n";
    };

    # attempt to obtain lock, with time limit
    eval {
        alarm($this->{lock_timeout});   # set alarm
        die "flock() failed: $!\n"
            unless flock($this->{FH_LOCK}, $lock_type);
# File::lockf -- potential alternate locking method:

lib/EMDIS/ECS/LockedHash.pm  view on Meta::CPAN

#            if $status != 0;
        alarm(0);  # turn off alarm
    };
    if($@) {
        alarm(0);  # turn off alarm
        $this->ERROR("EMDIS::ECS::LockedHash::_lock_unix() failed: $@");
        $this->LOCK(0);  # reset status indicator
        $result = '';
    }
    # restore previous SIG_ALRM handler
    if(defined $oldsigalrm) { $SIG{ALRM} = $oldsigalrm; }
    else                    { delete $SIG{ALRM}; }
    $this->LOCK($lock_type)   # set status indicator
        if $result;
    return $result;  # successful
}

# ----------------------------------------------------------------------
# Internal subroutine:  obtain (advisory) lock, using time limit to
# avoid indefinite blocking.  Returns true if able to obtain lock within
# time limit;  otherwise returns false.

t/ecs.t  view on Meta::CPAN

ok(log_warn("error text") =~ /$msg/);
ok(log_error("error text") =~ /$msg/);
ok(log_fatal("error text") =~ /$msg/);
ok(read_ecs_message_id("filename") =~ /$msg/);
ok(send_admin_email("error description") =~ /$msg/);
ok(send_ecs_message("node_id", "seq_num", "message_body") =~ /$msg/);
ok(send_email("recipient", "subject", undef, "body") =~ /$msg/);
ok(send_encrypted_message("encr_typ", "encr_recip", "recipient", "subject",
                          {}, "body") =~ /$msg/);
ok(format_msg_filename("node_id", "seq_num") =~ /$msg/);
ok(openpgp_decrypt("infile", "outfile", "reqdsig") =~ /$msg/);
ok(openpgp_encrypt("infile", "outfile", "recipient") =~ /$msg/);
ok(pgp2_decrypt("infile", "outfile", "reqdsig") =~ /$msg/);
ok(pgp2_encrypt("infile", "outfile", "recipient") =~ /$msg/);
#ok(check_pid() =~ /$msg/);
#ok(save_pid() =~ /$msg/);

# [] aaaaa
#ok('AA_BB_0000012345.msg' eq format_msg_filename('AA', 'BB', 12345));

# [44..87] read_ecs_message_id
require EMDIS::ECS::Config;
$ECS_CFG = { MAIL_MRK => 'EMDIS' };

web_status/ecs_status.pl  view on Meta::CPAN

# lock file, with time limit
sub lock
{
    my $fh = shift;
    my $lock_timeout = 5;
    my $lock_type = LOCK_EX;
    my $result = 1;

    # set up "local" SIG_ALRM handler
    # (Note:  not using "local $SIG{PIPE}" because it ignores die())
    my $oldsigalrm = $SIG{ALRM};
    $SIG{ALRM} = sub {
        die "timeout - $lock_timeout second time limit exceeded\n";
    };

    # attempt to obtain lock, with time limit
    eval {
        alarm($lock_timeout);   # set alarm
        die "flock() failed: $!\n"
            unless flock($fh, $lock_type);
        alarm(0);  # turn off alarm
    };
    if($@) {
        alarm(0);  # turn off alarm
        $result = '';
    }

    # restore previous SIG_ALRM handler
    if(defined $oldsigalrm) { $SIG{ALRM} = $oldsigalrm; }
    else                    { delete $SIG{ALRM}; }

    return $result;
}

#= EOF =

__END__

2007-08-01