EMDIS-ECS

 view release on metacpan or  search on metacpan

script/ecstool  view on Meta::CPAN


# maildrop
if($opt_maildrop)
{
    die "Invalid number of parameters specified for --maildrop command.\n" .
        "$usage"
        if ($#ARGV > 0);
    my ($filename) = @ARGV;
    my $msg = '';

    if(defined $filename)
    {
        # check whether file exists
        die "File not found: $filename\n"
            unless -f $filename;
    }

    my $msg_text;
    if(defined $filename)
    {
        # read from file
        open INPUT, "< $filename"
            or die "Unable to open file $filename: $!\n";
        $msg_text = join('', <INPUT>);
        close INPUT;
    }
    else
    {
        # read from STDIN
        $msg_text = join('', <STDIN>);
    }

    # check existence of maildrop dir
    my $targetdir = $ECS_CFG->ECS_DRP_DIR;
    die "Maildrop directory not found:  $targetdir"
        unless -d $targetdir;

    # print $msg_text to newly created file in maildrop directory
    my ($sec, $microsec) = gettimeofday;
    my $template = format_datetime($sec, '%04d%02d%02d_%02d%02d%02d');
    $template .= ".${microsec}_XXXX";
    my ($fh, $tempfilename) = tempfile($template,
                                       DIR    => $targetdir,
                                       SUFFIX => '.fml');
    die "Unable to open tempfile in directory $targetdir: $!"
        unless $fh;
    # get exclusive lock
    # locking strategy is needed in order to avoid possibly of
    # ecs_scan_mail daemon reading file before we're finished writing it
    if(!flock($fh, LOCK_EX | LOCK_NB))
    {
        my $err = $!;
        close $fh;
        die "Unable to lock output file $tempfilename: $err";
    }
    my $err = '';
    print $fh $msg_text
        or $err = "Unable to write output file $tempfilename: $!";
    flock($fh, LOCK_UN);
    close $fh;
    chmod $EMDIS::ECS::FILEMODE, $tempfilename;

    print "Message copied to $targetdir directory.\n";
}

# meta
if($opt_meta) {
    die "Invalid number of parameters specified for --meta command.\n$usage"
        unless $#ARGV >= 1;
    my ($node_id, $msg_type, $seq1, $seq2) = @ARGV;
    $ECS_NODE_TBL->lock()     # lock node_tbl
        or die "Error: unable to lock node_tbl: " .
            $ECS_NODE_TBL->ERROR . "\n";
    my $node = $ECS_NODE_TBL->read($node_id);
    $ECS_NODE_TBL->unlock();  # unlock node_tbl
    die "Error: node '$node_id' not defined.\n"
        unless $node;
    for ($msg_type) {
        /^READY/i and do {
            $err = send_ecs_message($node_id, '',
                "msg_type=READY\n",
                ((exists $node->{in_seq}) &&
                    ((!exists $node->{ready_num_disabled}) ||
                     not is_yes($node->{ready_num_disabled}))
                    ? "last_recv_num=" . $node->{in_seq}
                    : "") . "\n",
                ((exists $node->{out_seq}) &&
                    ((!exists $node->{ready_num_disabled}) ||
                     not is_yes($node->{ready_num_disabled}))
                    ? "last_sent_num=" . $node->{out_seq}
                    : "") . "\n",
                ((exists $node->{doc_in_seq}) &&
                    ((!exists $node->{ready_num_disabled}) ||
                     not is_yes($node->{ready_num_disabled}))
                    ? "last_recv_doc=" . $node->{doc_in_seq}
                    : "") . "\n",
                ((exists $node->{doc_out_seq}) &&
                    ((!exists $node->{ready_num_disabled}) ||
                     not is_yes($node->{ready_num_disabled}))
                    ? "last_sent_doc=" . $node->{doc_out_seq}
                    : "") . "\n",
                "# Hello Partner, I am alive. " . rand() . "\n");
            last;
        };
        /^MSG_ACK/i and do {
            die "Error: seq_num not defined.\n"
                unless defined $seq1;
            die "Error: seq_num not numeric: '$seq1'\n"
                unless $seq1 =~ /^\d+$/;
            if(defined $seq2)
            {
                die "Error: seq2 not numeric: '$seq2'\n"
                    unless $seq2 =~ /^\d+$/;
                die "Error: seq2 ($seq2) cannot be less than seq_num ($seq1)\n"
                    if $seq2 < $seq1;
            }
            else
            {
                $seq2 = $seq1;
            }
            my $seq_num;



( run in 1.714 second using v1.01-cache-2.11-cpan-39bf76dae61 )