#! /usr/bin/perl
#
########################################################################
# 
#  Error handling
#
#  Written by Raymond L. Plante  (rplante@ncsa.uiuc.edu) 
#  Adapted from adilerror.pl used by the NCSA Astronomy Digital 
#     Image Library
#
########################################################################

$adilerror_set = 1;
$true = 1; $false = 0;

sub inform {
#
#  print an informational message to STDERR.  If $quiet is set,
#    printing of message is suppressed.  The second argument indicates
#    whether the message should be also sent to a logfile; if true, the
#    message will also be appended to the log only if $dolog is also
#    true and $logfile contains the name of a file to write to.
#
#  Arguments:  $msg     string containing message to print
#              $dolog   if true, also print to $logfile (default: $dolog)
#              $donl    if false, do not append newline character to
#                         $msg (default: true)
#
    local($msg, $logit, $donl) = @_;
    local($q) = (defined($quiet)) ? $quiet : 0;
    local($l) = (defined($dolog)) ? $dolog : 0;
    $logit = $l if ($logit eq "");
    $donl = $true if ($donl eq "");

    $msg .= "\n" if ($donl);
    print STDERR "$msg" if (! $q);
    &logmsg($msg, $false, $false) if ($logit);

    return;
}

sub logmsg {
#
#  print a message to a logfile.  Request is ignored and false is
#  returned if $logfile is not contain the value of a writable file.
#
#  Arguments:  $msg     string containing message to print
#              $doterm  if true, also print to STDERR (default: false)
#              $donl    if false, do not append newline character to
#                         $msg (default: true)
#
#  Returns: $true       if logging was successful
#
    local($msg,$doterm,$donl) = @_;
    $donl = $true if ($donl eq '');
    local($Prog) = $prog;  $Prog =~ tr/a-z/A-Z/;

    $msg .= "\n" if ($donl);
    print STDERR "$msg" if ($doterm);
    return $false if ($logfile eq "");

    # initialize log file if it does not exist
    if (! -e "$logfile") {
	$date = `date`; chop $date;
	system("echo $Prog Log created $date > $logfile") if (! -e "$logfile");
    }
    return $false if (! -w "$logfile");

    # write the message
    open(LOGFILE, ">>$logfile") || die "Could not open $logfile: $!";
    print LOGFILE "$msg";
    close(LOGFILE);

    return $true;
}

sub fatal {
#
#  print fatal error message to STDERR and exit with an error status.
#    If $quiet is set, printing of message is suppressed.  If $prog is 
#    set, message will be prepended with "$prog:".  If $stat is not 
#    specified or is not an integer, the status will set to 10.
#
#  Arguments:  $msg    string containing message to print
#              $stat   error status to exit with
#              $logit  if true, also print to $logfile (default: $dolog)
#              $donl   if false, do not append newline character to
#                         $msg (default: true)
#
    local($msg, $stat, $logit, $donl) = @_;
    local($p) = (defined($prog)) ? "$prog: " : '';
    local($q) = (defined($quiet)) ? $quiet : 0;
    local($l) = (defined($dolog)) ? $dolog : 0;
    $stat = 10 if (@_ < 2 || $stat eq '' || $stat !~ /^-?[0-9]+$/);
    $logit = $l if ($logit eq "");
    $donl = $true if ($donl eq "");

    $msg .= "\n" if ($donl);
    print STDERR "$p$msg" if (! $q);
    &logmsg("$p$msg", $false, $false) if ($logit);

    exit($stat);

    return;
}

sub warn {
#
#  print warning message to STDERR.  Does nothing if $quiet is set.  
#    If $prog is set, message will be prepended with "$prog:"
#    Will also set a global flag, $adil_warn, which can be checked
#    by the calling process (see also reset_warn).
#
#  Arguments:  $msg    string containing message to print
#              $logit  if true, also print to $logfile (default: $dolog)
#              $donl   if true, append a newline character (default: true)
#
    local($msg, $logit, $donl) = @_;
    local($p) = (defined($prog)) ? "$prog: " : '';
    local($q) = (defined($quiet)) ? $quiet : 0;
    local($l) = (defined($dolog)) ? $dolog : 0;
    $logit = $l if ($logit eq "");
    $donl = $true if ($donl eq "");
    $adil_warn = $true;

    $msg .= "\n" if ($donl);
    print STDERR "$p$msg" if (! $q);
    &logmsg("$p$msg", $false, $false) if ($logit);

    return;
}

sub reset_warn {
#
# reset the $adil_warn flag to false.
#
    $adil_warn = $false;
}

1;