view release on metacpan or  search on metacpan

web_status/ecs_status.pl  view on Meta::CPAN

# ----------------------------------------------------------------------
# Format a datetime value
sub format_datetime
{
    my $datetime = shift;
    my $format = '%04d-%02d-%02d %02d:%02d:%02d';
    my ($seconds, $minutes, $hours, $mday, $month, $year, $wday, $yday,
        $isdst) = localtime($datetime);
    return sprintf($format, $year + 1900, $month + 1, $mday,
                   $hours, $minutes, $seconds);
}

# ----------------------------------------------------------------------
# Format a time difference
sub format_timediff
{
    my $time1 = shift;
    my $time2 = shift;
    my $timediff = $time1 - $time2;
    my $seconds = $timediff % 60;
    my $minutes = ($timediff/60) % 60;
    my $hours   = ($timediff/(60*60)) % 24;
    my $days    = int $timediff/(60*60*24);
    my $result = sprintf "%dd %02d:%02d:%02d",
        $days, $hours, $minutes, $seconds;
    $result = "<span class=\"bold\">$result</span>"
        if $days > 0;
    return $result;
}

# ----------------------------------------------------------------------
sub error_message
{
    my $errmsg = shift;
    return "<p>ERROR: $errmsg</p>";
}

# ----------------------------------------------------------------------
sub compute_opt
{
    my $input_value = shift;
    my $default_value = shift;

    return $input_value
        if defined $input_value and $input_value ne '';
    return $default_value;
}

# ----------------------------------------------------------------------
# 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
ZKRD - emdisadm@zkrd.de
Added different bgcolors for in | out | queue according to their status:
green (diff <= 5) yellow (diff > 5) red (diff > 10).
Added new row (Info) which contains further information about the status.
If there is a problem with a missing mail (in_seq < q_min_seq) a torn of rope
is shown in the info area.
The own node_id is now detected by the ecs.cfg.
The path to the node_tbl is now detected by the ecs.cfg.
The daemon status is visible in the header:
green (daemon is running) red (daemon is currently not running)
Added a favicon showing the ECS logo.
Added optional parameter to select a user. This fixes the problem of a wrong
positive runlevel status of the daemons caused by more than one running
instance of (perl) ECS.