#  $HeadURL$ $LastChangedRevision$

package ADE;

use strict;
#  Allow bare words, so &ade_err_error() calls look nicer.
no strict 'subs';
use warnings;
#  Duplicating file handles generates a 'only used once' warning.
no warnings qw(once);
use Tie::RefHash;              #  for 'callonexit' hash, which contains code refs 
use Cwd;			#  this is needed for _ade_tmp_cleanup()'s call to getcwd
use Data::Dumper;
use Net::SMTP;

BEGIN {
    use Exporter   ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

    # set the version for version checking
    $VERSION     = 1.00;

    @ISA         = qw(Exporter);
    @EXPORT      = qw(ade_gep_main $ade_tmp_dir $ade_app_progname $ade_err_ok $ade_err_fail ade_fnm_basename ade_err_warning ade_err_info ade_err_debug ade_tmp_registerfile ade_tmp_deregisterfile ade_err_error ade_msg_usage $ade_app_progname ade_fnm_basename ade_fnm_makeabsolute stupid_error_in_ade_space ade_err_registerdefderrs %ade_utils_defined_errors ade_fcm_openwritecompressed ade_fcm_openreadcompressed ade_msg_version ade_tmf_extractversionfromsvnstring ade_msg_listpaths ade_spc_autogendheader ade_spc_rollingstatusmanager ade_smf_isvalidregexp ade_mua_addmailheader ade_mua_sendmail ade_err_resetstack ade_usr_amiroot ade_fnm_dirname);
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

    # your exported package globals go here,
    # as well as any optionally exported functions
    @EXPORT_OK   = qw($Var1 %Hashit &func3);
}
our @EXPORT_OK;

# exported package globals go here
our $Var1;
our %Hashit;
our($ade_err_ok, $ade_err_fail);
our($ade_tmp_dir);
our($ade_app_progname);

# non-exported package globals go here
our @more;
our $stuff;

# initialize package globals, first exported ones
$Var1   = '';
%Hashit = ();
$ade_err_ok = 0;
$ade_err_fail = 1;
$ade_tmp_dir = defined($ENV{TMP_DIR}) ? $ENV{TMP_DIR} : "/var/tmp";
($ade_app_progname) = ($0 =~ /.*\/([^\/]*)$/);

# then the others (which are still accessible as $Some::Module::stuff)
$stuff  = '';
@more   = ();

# all file-scoped lexicals must be created before
# the functions below that use them.

# file-private lexicals go here
my $priv_var    = '';
my %secret_hash = ();
my($sendmail_cmd) = "/usr/lib/sendmail";
#  Outside ADE, nobody should *use* ADE error codes, but maybe some
#  people will test for them (e.g. to reset the errorstack in the event
#  of a handlable error). But on the other handle the *tag* will be 
#  made public, not the array.
my(%ade_gep_defined_errors) = (
    ade_err_miscfailure  => { fmt => "%s failed" },
);
my(%ade_utils_defined_errors) = (
    ade_err_miscfailure     => { fmt => "%s failed" },
    ade_err_undefined       => { fmt => "%s: undefined %s" },
    ade_err_obsolete        => { fmt => "%s: obsolete %3\$s; replace with '%s'" },
    ade_err_access          => { fmt => "%s: can't %s (%s)" },
    ade_err_os              => { fmt => "%s: OS command failed (%s)" },
    ade_err_locked          => { fmt => "%s: locked by %s" },
    ade_err_convert         => { fmt => "%s: couldn't convert from %s to %s" },
    ade_err_seeabove        => { fmt => "error detected; see higher frames for more information" },
    ade_err_invalid         => { fmt => "%s: invalid %s" },
    ade_err_misc            => { fmt => "%s" },
    ade_err_internal        => { fmt => "internal error: %s" },
);
my(@ade_registered_defined_errors_hash_refs_array);
my(%valid_headers) = (
	'From', 1,
	'Reply-To', 1,
	'Date', 1,
	'Subject', 1,
	'Received', 1,
	'Keywords', 1,
	'X-Newsreader', 1,
	'Summary', 1,
	'Distribution', 1,
	'Message-Id', 1,
	'Return-Path', 1,
	'Newsgroups', 1,
	'References', 1
);
my($compress_cmd, $uncompress_cmd, $gzip_cmd, $gunzip_cmd);
my($ade_msg_verboselevel);

# here's a file-private function as a closure,
# callable as &$priv_func;  it cannot be prototyped.
my $priv_func = sub {
    # stuff goes here.
};
my($ade_err_dumpwholestack, $ade_msg_writer_logfile_filename, @ade_err_writerfunc_refs);
my(%ade_gep_delonexit);

##############################################################################
#
#  Public functions
#
##############################################################################

sub ade_gep_main(\&)
{
    my($app_main_ref) = @_;
    my($rc);
    my($errstack_ref) = [];

    &ade_err_registerdefderrs(\%ade_gep_defined_errors);
    &ade_err_resetstack(stack=>$errstack_ref, dumpall=>1);

    $SIG{HUP}  = \&_ade_gep_signalhandler;
    $SIG{INT}  = \&_ade_gep_signalhandler;
    $SIG{TERM} = \&_ade_gep_signalhandler;

    if (($rc=&_ade_gep_main_withstack($errstack_ref, $app_main_ref)) != $ade_err_ok) {
        &ade_err_displaystack($errstack_ref);
        &ade_err_resetstack(stack=>$errstack_ref);
    }

    #  Do not return because there is no higher function to convert the
    #  return code into an exit code, and incredible perl does not do it
    #  itself (try: perl -e 'sub f { return(1); }; &f'; echo $?). Do an
    #  exit instead.
    &_ade_gep_exit($errstack_ref, $rc);
}

sub ade_err_resetstack
{
    my(%parameters) = @_;
    my($key, $errstack_ref);

    #  We should take this out even if it is not provided, so that 
    #  this function can itself raise errors.
    $errstack_ref = $parameters{stack};

    #  Look at what was passed
    foreach $key (keys %parameters) {
        #  ade_err_resetstack(stack=>blah): reset stack 'blah'
        if ($key eq "stack") {
            @{$parameters{$key}} = ();
        #  ade_err_resetstack(dumpall=>1 or 0): on error dump whole / top of stack
        } elsif ($key eq "dumpall") {
            $ade_err_dumpwholestack = $parameters{$key};
        #  ade_err_resetstack(logfile=>blah): set log file to 'blah'
        } elsif ($key eq "logfile") {
            $ade_msg_writer_logfile_filename = $parameters{$key};
        #  ade_err_resetstack(level=>99): set debug level to 99
        } elsif ($key eq "level") {
            $ade_msg_verboselevel = $parameters{$key};
        #  ade_err_resetstack(writers=>(\&func1, \&func2)): set writers to funcs
        } elsif ($key eq "writers") {
            @ade_err_writerfunc_refs = @{$parameters{$key}};
        #  unknown key
        } else {
            &ade_err_internal($errstack_ref, "ade_err_resetstack: $key: unexpected key");
        }
    }
   
    return($ade_err_ok);
}

#
#  Is a specified error in the stack? 
#
#  (This is used to say things like "Did that function fail
#  because there are no mails available? If so then don't
#  treat that as an error, and I will handle the situation
#  myself.")
#

sub ade_err_instack
{
    my($errstack_ref, $err) = @_;
    my($i, $framecount);
   
    #  Facilitate doing it the C way with '<' in the 'for' loop instead of '<='.
    $framecount = $#{$errstack_ref}+1;

    #  Scan the stack for the error
    for ($i=0; $i<$framecount; $i++) {
        if (${$errstack_ref}[$i]{err} eq $err) {
            return($i);
        }
    }

    #  If the error was not found (i.e. we got to here) then
    #  return an index to indicate that we didn't find it.
    &ade_err_debug($errstack_ref, 20, "ade_err_instack: not found it");
    return(undef);
}

sub ade_err_registerdefderrs
{
    my($defined_errors_hash_ref) = @_;

    #  Currently there are no registration-time checks or actions other than
    #  the registration. We *could* check that the reference refers to a non-empty
    #  hash, or we could even copy the errors out of it, so that it becomes impossible
    #  to add or delete errors to the set of defined errors *after* registration.
    push(@ade_registered_defined_errors_hash_refs_array, $defined_errors_hash_ref);

    return($ade_err_ok);
}

sub ade_err_displaystack
{
    my($errstack_ref, $displayfunc_ref) = @_;
    my($i, $j, $fmt, $framecount, @errpars, $defined_errors_hash_ref, $error_message);
    my($number_of_percent_signs_in_format, $number_of_parameters_supplied);

    &ade_err_debug($errstack_ref, 40, "ade_err_displaystack: sof");

    #
    #  Check/sanitize parameters.
    #

    #  There is a default display function based on assumption most calls to ade_err_displaystack
    #  are because of errors (not warnings).
    if (!defined($displayfunc_ref)) {
        $displayfunc_ref = \&ade_err_displayerror;
    }

    #
    #  For each error frame on the stack  ...
    #

    for ($i=0; $i<=$#{$errstack_ref}; $i++) {

        #
        #  ... Locate the description of the error message in one of the error message hashes ...
        #

        #  Skip all but the top frame if requested so to do
        next if ($i != 0 && !$ade_err_dumpwholestack);
        #  Locate which hash of defined error messages contains the key
        for ($j=0; $j<=$#ade_registered_defined_errors_hash_refs_array; $j++) {
            last if (defined(${$ade_registered_defined_errors_hash_refs_array[$j]}{${$errstack_ref}[$i]{err}}));
        }
        &ade_err_internal($errstack_ref, "${$errstack_ref}[$i]{err}: unknown error") if (!defined(${$ade_registered_defined_errors_hash_refs_array[$j]}{${$errstack_ref}[$i]{err}}));
        $defined_errors_hash_ref = $ade_registered_defined_errors_hash_refs_array[$j];

        #  
        #   Check sufficient parameters provided
        #
 
        $number_of_percent_signs_in_format = (${${$defined_errors_hash_ref}{${$errstack_ref}[$i]{err}}}{fmt} =~ tr/%//);
        $number_of_parameters_supplied = scalar(@{${$errstack_ref}[$i]{par}});
        &ade_err_internal($errstack_ref, "error message argument count mismatch (tag: ${$errstack_ref}[$i]{err}, args supplied: $number_of_parameters_supplied, args requires: $number_of_percent_signs_in_format)") if ($number_of_percent_signs_in_format != $number_of_parameters_supplied);

        #
        #   Expand the description's format with the parameters in the same stack frame
        #

        $error_message = sprintf(${${$defined_errors_hash_ref}{${$errstack_ref}[$i]{err}}}{fmt} , @{${$errstack_ref}[$i]{par}});

        #
        #  Display the error.
        #

        &$displayfunc_ref($errstack_ref, (($ade_err_dumpwholestack)?"frame#$i: ":"") . $error_message);
    }

    #
    #  If we get this far all is ok.
    #

    return($ade_err_ok);
}

##############################################################################
#
#  Error registration functions (things to call when there is an error)
#
##############################################################################

#sub ade_err_internal
#{
#    my($errstack_ref, $message) = @_;
#
#    &ade_err_warning($errstack_ref, ade_err_obsolete, "ade_err_internal(...)", "ade_err_error(..., ade_err_internal, ...)", "function call");
#
#    &ade_err_error($errstack_ref, ade_err_internal, $message);
#
#    #  *This* function was successful.
#    return($ade_err_ok);
#}

sub ade_err_error
{
    my($errstack_ref, $defined_errors_hash_key, @errpars) = @_;
    my($rc);

    #  Deliberately no third parameter as we don't care about getting the
    #  definition frame at the moment.
    if (($rc=_ade_err_validate_errorkey($errstack_ref, $defined_errors_hash_key)) != $ade_err_ok) {
        return($rc);
    }

    #  Create an anonymous hash consisting of the key leading to the
    #  error format etc and and an anoymous array for the error message's 
    #  parameters. (Note that we *don't* note the hash in which the
    #  key is defined; we will look for it again when we come to print
    #  the stack out.
    push(@{$errstack_ref}, { err => $defined_errors_hash_key, par => \@errpars });

    #
    #  If we get this far all is ok.
    #

    return($ade_err_ok);
}

sub ade_err_warning
{
    my($errstack_ref, $defined_errors_hash_key, @errpars) = @_;
    my($rc);
    
    if (($rc=_ade_err_validate_errorkey($errstack_ref, $defined_errors_hash_key)) != $ade_err_ok) {
        return($rc);
    }

    push(@{$errstack_ref}, { err => $defined_errors_hash_key, par => \@errpars });

    #  Do an immediate stack dump and reset
    if (($rc=&ade_err_displaystack($errstack_ref, \&ade_err_displaywarning)) != $ade_err_ok) {
        return($rc);
    }
    &ade_err_resetstack(stack => $errstack_ref);

    return($ade_err_ok);
}

sub ade_err_info
{
    my($errstack_ref, $message) = @_;

    #  We could stack the message and then demand its immediate display, like
    #  the error case, but here the $message is really free text and not something
    #  in the error stack. Therefore we make a shortcut. Perhaps in the future
    #  I could use a specially registered error with format as just '%s' to
    #  inject the message to the stack and then call the display function
    #  immediately - simply for conformancy, but for the moment not. See also
    #  ade_err_debug().

    return(&ade_err_displayinfo($errstack_ref, $message));
}

sub ade_err_debug
{
    my($errstack_ref, $level, $message) = @_;

    #  We could stack the message and then demand its immediate display, like
    #  the error case, but here the $message is really free text and not something
    #  in the error stack. Therefore we make a shortcut. Perhaps in the future
    #  I could use a specially registered error with format as just '%s' to
    #  inject the message to the stack and then call the display function
    #  immediately - simply for conformancy, but for the moment not. See also
    #  ade_err_info().

    return(&ade_err_displaydebug($errstack_ref, $level, $message));
}

#  
#  Obsolete function warners
# 

sub ade_msg_error
{
    my ($errstack_ref, $errcode, @params) = @_;
    my (@errstack2, $errstack2_ref);

    #  To warn on the use of this obsolete function we need a second error stack. This
    #  is because there is *already* a populated error stack (otherwise we wouldn't
    #  be inside the function ade_msg_error() in the first place!). Calling ade_err_warning()
    #  will reset the stack. (Not sure that it should but for the moment ....) and that
    #  means we will lose the errors that we really want to go on to display. Hence the
    #  need for a second stack.
    $errstack2_ref = \@errstack2;
    ade_err_resetstack(stack => $errstack2_ref);
    #  Now we use that second stack to log the warning.
    &ade_err_warning($errstack2_ref, ade_err_obsolete, "ade_msg_error", "ade_err_error", "function call");
    #  And now delegate to the replacement function using the original stack
    return(&ade_err_error($errstack_ref, $errcode, @params));
}

sub ade_msg_warning
{
    my ($errstack_ref, @params) = @_;

    &ade_err_warning($errstack_ref, ade_err_obsolete, "ade_msg_warning", "ade_err_warning", "function call");
    &ade_err_warning($errstack_ref, @params);
}

##############################################################################
#
#  Error format functions (these are private; applications should not call these)
#
##############################################################################

sub ade_err_displayinternal
{
    my($errstack_ref, $message) = @_;

    return(&_ade_msg_message($errstack_ref, 0, "INTERNAL ERROR: %MESSAGE", $message));
}

sub ade_err_displayerror
{
    my($errstack_ref, $message) = @_;

    #print "ade_err_error: writing messafge \"$message\" ...\n";

    return(&_ade_msg_message($errstack_ref, 1, "ERROR: %MESSAGE", $message));
}

sub ade_err_displaywarning
{
    my($errstack_ref, $message) = @_;

    return(&_ade_msg_message($errstack_ref, 2, "WARNING: %MESSAGE", $message));
}

sub ade_err_displayinfo
{
    my($errstack_ref, $message) = @_;

    return(&_ade_msg_message($errstack_ref, 3, "INFO: %MESSAGE", $message));
}

sub ade_err_displaydebug
{
    my($errstack_ref, $level, $message) = @_;

    return(&_ade_msg_message($errstack_ref, $level, "DEBUG[%LEVEL]: %MESSAGE", $message));
}

##############################################################################
#
#  Error display functions (these are private; applications should not call these,
#  though they may specify them at stack (re)configuration time)
#
##############################################################################

sub ade_msg_writer_stderr
{
    my($errstack_ref, $text) = @_;

    print STDERR "$ade_app_progname: $text\n";
    
    return($ade_err_ok);
}

sub ade_msg_writer_logfile
{
    my($errstack_ref, $text) = @_;

    return if (!defined($ade_msg_writer_logfile_filename));

    open(HANDLE, ">>$ade_msg_writer_logfile_filename");
    #  The 'eval { ... }' is there *only* to provide some grouping
    #  on the elements "5, 4, 3, 2, 1, 0, $text"; otherwise 'map'
    #  greedily eats all of that array leaving no string for printf
    #  to match against the '%s'.
    printf HANDLE "%04d/%02d/%02dT%02d:%02d:%02d: %s\n", eval { map { (localtime)[$_]+(0,0,0,0,1,1900)[$_] } (5,4,3,2,1,0) }, $text;
    close HANDLE;

    return($ade_err_ok);
}

##############################################################################
#
#  Miscellaneous messaging routines
#
##############################################################################

sub ade_msg_usage
{
    my($errstack_ref, $text_generator_funcref, $exit_code) = @_;

    if ($exit_code == 0) {
        #  redirect stderr to stdout in case the user's func sends to stderr. 
        #  Avoid names that might clash with user applications for the handle, since it is a global.
        open(ADEMSGUSAGE_OLD_STDERR, ">&STDERR") || &ade_err_internal($errstack_ref, "ade_msg_usage: can't dup stderr");
        open(STDERR, ">&STDOUT");
        #  Don't bother examining the return code.
        &$text_generator_funcref();
        #  Restore stderr to real stderr.
        open(STDERR, ">&ADEMSGUSAGE_OLD_STDERR") || &ade_err_internal($errstack_ref, "ade_msg_usage: can't restore stderr");
    } else {
        print STDERR "$ade_app_progname: ERROR: type '$ade_app_progname --help' for correct usage.\n";
    }

    &_ade_gep_exit($errstack_ref, $exit_code);
    #  We do not return from this function
}

sub ade_msg_version
{
    my($errstack_ref, $version_returner_funcref) = @_;
    my($version, $rc);

    if (($rc=&$version_returner_funcref($errstack_ref, \$version)) != $ade_err_ok) {
        print STDERR "ade_msg_version: calling ade_err_internal ...\n";
        &ade_err_internal($errstack_ref, "ade_msg_version: failed to determine my own version number!");
    }

    print "$ade_app_progname version $version\n";
    &_ade_gep_exit($errstack_ref, 0);
}
   
sub ade_msg_listpaths
{
    my($errstack_ref, $listpaths_returner_funcref) = @_;
    my($version, $rc, %pathlist, $key);

    if (($rc=&$listpaths_returner_funcref($errstack_ref, \%pathlist)) != $ade_err_ok) {
        print STDERR "ade_msg_listpaths: calling ade_err_internal ...\n";
        &ade_err_internal($errstack_ref, "ade_msg_listpaths: failed to determine paths");
    }

    foreach $key (sort keys %pathlist) {
        printf "%s: %s\n", $key, $pathlist{$key};
    }
    &_ade_gep_exit($errstack_ref, 0);
}
   
##############################################################################
#
#  Maths functions
#  
##############################################################################

#  This function does not take an error stack because it is assumed it cannot
#  go wrong. Yeah, right ;-)
sub ade_mth_minimum
{
    my($errstack_ref, $a, $b, $returnval_ref) = @_;
  
    ${$returnval_ref} = (($a<$b)?$a:$b);

    #  If we get this far all is ok.
    return($ade_err_ok);
}

###############################################################################
#
#  Interactive messaging functions
#
###############################################################################

sub ade_msg_askquestion
{
    my($errstack_ref, $hint, $prompt, $default, $validate_fnc, $rationalise_fnc, $first_response) = @_;

    my($response, $rc);

    &ade_err_debug($errstack_ref, 10, "ade_msg_askquestion: sof (\$hint=$hint, \$prompt=$prompt, \$default=$default, ..., \$first_response=$first_response)");

    #  prompt if necessary
    if (!$first_response && $hint && $ade_msg_verboselevel >= 3) {
        if (!open(TTY_HANDLE, ">/dev/tty")) {
            &ade_err_error($errstack_ref, ade_err_access, "/dev/tty", "open", "$@");
            return($ade_err_fail);
        }
        print TTY_HANDLE $hint;
        close(TTY_HANDLE);
    }

    #  enter loop of reading response and validating until response validates
    while (1) {
        if ($first_response) {
            $response = $first_response;
            #  reset first response, so that if it fails to validate it will not be used next time round loop
            $first_response = "";
        } else {
            if (!open(TTY_HANDLE, ">/dev/tty")) {
                 &ade_err_error($errstack_ref, ade_err_access, "/dev/tty", "open", $@);
                 return($ade_err_fail);
            }
            print TTY_HANDLE "$ade_app_progname: QUESTION: $prompt [$default]: ";
            close(TTY_HANDLE);
            if (!open(TTY_HANDLE, "/dev/tty")) {
                 &ade_err_error($errstack_ref, ade_err_access, "/dev/tty", "open", $@);
                 return($ade_err_fail);
            }
            $response = <TTY_HANDLE>;
            close(TTY_HANDLE);
            chomp($response);
            ($response eq "")  && ($response = $default);
            ($response eq ".") && ($response = "");
            &ade_err_debug($errstack_ref, 10, "ade_msg_askquestion: \$response=[$response]");
        }
        #  Validate response with passed function, if ok break out of prompting loop
        (&$validate_fnc($response) || last);
        &ade_err_warning($errstack_ref, "invalid response, please retry");
    }
    if (($rc=&$rationalise_fnc($errstack_ref, $response)) != $ade_err_ok) {
        return($rc);
    }

    return($ade_err_ok);
}

sub ade_msg_askquestion_number_verify
{
    my($errstack_ref, $number) = @_;

    &ade_err_debug($errstack_ref, 10, "ade_msg_askquestion_number_verify: sof (\$number=$number)");

    if ($number !~ /^\d+$/) {
        return($ade_err_fail);
    }

    return($ade_err_ok);
}

sub ade_msg_askquestion_number_rationalise
{
    my($errstack_ref, $number) = @_;

    &ade_err_debug($errstack_ref, 10, "ade_msg_askquestion_number_rationalise: sof (\$number=$number)");

    #  rationalisation functions return the rationalised number
    return($number);
}

sub ade_msg_askquestion_yesno_verify
{
    my($yesno) = @_;

    return($ade_err_ok) if ($yesno =~ /^(y|yes|n|no)\n?$/i);
 
    return($ade_err_fail);
}

sub ade_msg_askquestion_yesno_rationalise
{
    my($yesno) = @_;
    
    return("yes") if ($yesno =~ /^(yes|y)\n?$/i);
    return("no")  if ($yesno =~ /^(no|n)\n?$/i);
}

###############################################################################
#
#  TEMPORARY FILE MANAGEMENT
#
###############################################################################

sub ade_tmp_registerfunc
{
    my($errstack_ref, @items) = @_;

    return(&ade_tmp_register($errstack_ref, "callonexit", @items));
}

sub ade_tmp_deregisterfunc
{
    my($errstack_ref, @items) = @_;

    return(&ade_tmp_deregister($errstack_ref, "callonexit", @items));
}

sub ade_tmp_registerfile
{
    my($errstack_ref, @items) = @_;
    my($item, $rc);
    
    #  We must enforce that registered items are absolute. This is to protect
    #  the cleanup routings from risking 'shell-init: getcwd failed' errors
    #  if the user presses CTRL-C. 
    #  Note that same must be done at deregistration time or we'll not be able
    #  to make a match in the list of registered items.
    @items = map { 
         &ade_err_debug($errstack_ref, 200, "ade_tmp_registerfile: pre-absolution: $_");
         if (($rc=&ade_fnm_makeabsolute($errstack_ref, $_, undef, \$_)) != $ade_err_ok) { return($rc); }
         &ade_err_debug($errstack_ref, 200, "ade_tmp_registerfile: post-absolution: $_");
         $_;
    } @items;

    return(&ade_tmp_register($errstack_ref, "delonexit", @items));
}

sub ade_tmp_deregisterfile
{
    my($errstack_ref, @items) = @_;
    my($rc);

    @items = map { 
         &ade_err_debug($errstack_ref, 200, "ade_tmp_deregisterfile: pre-absolution: $_");
         if (($rc=&ade_fnm_makeabsolute($errstack_ref, $_, undef, \$_)) != $ade_err_ok) { return($rc); }
         &ade_err_debug($errstack_ref, 200, "ade_tmp_deregisterfile: post-absolution: $_");
         $_;
    } @items;

    return(&ade_tmp_deregister($errstack_ref, "delonexit", @items));
}

sub ade_tmp_register
{
    my($errstack_ref, $listname, @items) = @_;
    my($item);

    if ($listname !~ /.*onexit/) {
        &ade_err_internal($errstack_ref, "ade_tmp_register: looks like you have a call to ade_tmp_register() which should be changed to a call to ade_tmp_registerfile() (\$listname=$listname)");
    }

    #  Add all the specified items to the specified list.
    foreach $item (@items) {
        $ade_gep_delonexit{$listname}{$item} = 1;
    }
}

sub ade_tmp_deregister
{
    my($errstack_ref, $listname, @items) = @_;
    my($item);

    if ($listname !~ /.*onexit/) {
        &ade_err_internal($errstack_ref, "ade_tmp_deregister: looks like you have a call to ade_tmp_deregister() which should be changed to a call to ade_tmp_deregisterfile() (\$listname=$listname)");
    }
    
    #  Delete all the specified items from the specified list.
    foreach $item (@items) {
        delete $ade_gep_delonexit{$listname}{$item};
    }
}

sub ade_tmp_deregisterallfunc
{
    my($errstack_ref) = @_;

    return(&ade_tmp_deregisterall($errstack_ref, "callonexit"));
}

sub ade_tmp_deregisterallfile
{
    my($errstack_ref) = @_;

    return(&ade_tmp_deregisterall($errstack_ref, "delonexit"));
}

sub ade_tmp_deregisterall
{
    my($errstack_ref, $listname) = @_;
    my($item);

    if ($listname !~ /.*onexit/) {
        &ade_err_internal($errstack_ref, "ade_tmp_deregisterall: looks like you have a call to ade_tmp_deregisterall() which should be changed to a call to ade_tmp_deregisterallfile() (\$listname=$listname)");
    }

    foreach $item (keys %{$ade_gep_delonexit{$listname}}) {
        &ade_tmp_deregister($errstack_ref, $listname, $item);
    }
}

###############################################################################
#
#  OTHER SUPPORT FUNCTIONS
#
###############################################################################

sub ade_std_which
{
    my ($cmd) = @_;
    my ($dir);

    foreach $dir (split(/:/, $ENV{'PATH'})) {
        (-x "$dir/$cmd") && return("$dir/$cmd");
    }
    return($ade_err_ok);
}


sub ade_std_remsh
{
    my($errstack_ref) = @_;

    &ade_err_internal($errstack_ref, "ade_std_remsh: not coded yet");
}

###############################################################################
#
#  TEXT MANIPULATION FUNCTIONS
#
###############################################################################

sub ade_tmf_extractversionfromsvnstring
{
    my($errstack_ref, $svnstring, $version_ref) = @_;

    &ade_err_debug($errstack_ref, 50, "ade_tmf_extractversionfromsvnstring: sof (svnstring=$svnstring");
    $svnstring =~ m@\$HeadURL: .*?/(trunk|tags/([^/]+)|branches/([^/]+))/.*?\$ \$LastChangedRevision: (\d+) \$@;
    #&ade_err_debug($errstack_ref, 50, "ade_tmf_extractversionfromsvnstring: \$1=$1, \$2=$2, \$3=$3, \$4=$4");
    if ($1 eq "trunk") {
        $$version_ref = "svn/trunk/$4";
    } elsif ($1 =~ /^tags\/(.*)/) {
        $$version_ref = "$1";
    } elsif ($1 =~ /^branches\/(.*)/) {
        $$version_ref = "svn/branch/$1";
    } else {
        &ade_err_internal($errstack_ref, "ade_tmf_extractversionfromsvnstring: handling of \"$1\" not implemented yet");
    }

    return($ade_err_ok);
}

###############################################################################
#
#  FILENAME MANIPULATION
#
###############################################################################

sub ade_fnm_dirname
{
    my($errstack_ref, $file, $dir_ref) = @_;

    if (!defined($file)) {
        #  We use error rather than internal so as to be able to report more information in the caller.
        &ade_err_error($errstack_ref, "ade_fnm_dirname: \$file: undefined");
        return($ade_err_fail);
    
    } elsif (!defined($dir_ref)) {
        #  We use error rather than internal so as to be able to report more information in the caller.
        &ade_err_error($errstack_ref, "ade_fnm_dirname: \$dir_ref: undefined");
        return($ade_err_fail);
    }

    #  Strip trailing slashes (if not made entirely of slashes). I'm sure POSIX has something to
    #  say on how multiple slashes should be interpreted but this will be okay for now.
    $file =~ s/\/+$// if ($file !~ /^\/+$/);

    #  aaa --> .
    if ($file =~ /^[^\/]+$/) {
        ${$dir_ref} = ".";

    #  /aaa --> /
    } elsif ($file =~ /^\/[^\/]+$/) {
        ${$dir_ref} = "/";

    #  aaa/bbb/ccc --> aaa/bbb
    #  /aaa/bbb/ccc --> /aaa/bbb
    #  aaa/bbb/ccc/ --> aaa/bbb
    #  /aaa/bbb/ccc/ --> /aaa/bbb
    } else {
        (${$dir_ref}) = ($file =~ /^(.*)\/[^\/]+$/);
    }

    return($ade_err_ok);
}

sub ade_fnm_basename 
{
    my($errstack_ref, $file, $basename_ref) = @_;

    $file =~ /^.*\/([^\/]+)/;
    ${$basename_ref} = $1;

    return($ade_err_ok);
}

#  Name:     ade_fnm_makeabsolute - convert paths to absolute paths
#  Synopsis: ade_fnm_makeabsolute(<error-stack-ref>, <path>, { <absdir> | undef }, <abspathref>)
sub ade_fnm_makeabsolute
{
    my($errstack_ref, $what, $cwd, $return_ref) = @_;

    chomp($cwd = `pwd`) if (!defined($cwd));

    #  If it starts with a slash return it as it is
    if ($what =~ /^\//) {
        ${$return_ref} = $what;
    #  If it has ./ or even ././././ at the beginning strip it and prepend cwd
    } elsif ($what =~ /^(?:\.\/)+(.*)/) {
        ${$return_ref} = "$cwd/$1";
    #  else just prepend cwd
    } else {
        ${$return_ref} = "$cwd/$what";
    }

    return($ade_err_ok);
}

#  Section:
#	dcm (directory content manipulation)
#
#  Name:     
#	ade_dcm_movecompressedfile - rename a possibly compressed file with
#		content-type honouring
#
#  Synopsis: 
#	$rc = &ade_dcm_movecompressedfile($src_file, $dst_file);
#
#  Description:
#	This function renames $src_file to $dst_file. 
#	
#	If the filename
#	extensions indicate that both files are compressed using the
#	same tool, of if the filename extensions indicate that both
#	files are not compressed, then this function uses mv(1) to
#	accomplish the renaming.
#
#	If the filename extensions indicate that contents were compressed
#	using different methods, then this function will use
#	ade_fcm_openreadcompressed(3) and ade_fcm_openwritecompressed(3)
#	to transport the content to $dst_file, and then it removes $src_file.
#
#  Options:
#	None.
#
#  Arguments:
#	$src_file	name of the source file
#	$dst_file	name of the destination file
#
#  Returns:
#	0 		if successful
#	non-zero	otherwise (and an error frame is added to the stack)

sub ade_dcm_movecompressedfile
{
    my($errstack_ref, $srcname, $dstname) = @_;
    my($rc);

    &ade_err_debug($errstack_ref, 50, "ade_dcm_movecompressedfile: sof (srcname=$srcname, dstname=$dstname");

    if (($srcname =~ /\.gz$/ && $dstname =~ /\.gz$/) || 
            ($srcname =~ /\.Z$/ && $dstname =~ /\.Z$/) ||
            ($srcname !~ /\.(?:Z|gz)$/ && $dstname  !~ /\.(?:Z|gz)$/)) {
        &ade_err_debug($errstack_ref, 50, "ade_dcm_movecompressedfile: using 'mv' ...");
        #  Linux 'mv' can go interactive, so stdin redirected to avoid this.
        if (($rc=system("mv $srcname $dstname < /dev/null 2>/dev/null")) != 0) {
            &ade_err_debug($errstack_ref, 50, sprintf("ade_dcm_movecompressedfile: exit: %d, sig: %d, dump: %d", ($rc>>8), ($rc&127), ($rc&128)));
            &ade_err_error($errstack_ref, ade_err_os, "mv", $@);
            return($ade_err_fail);
        }
        &ade_err_debug($errstack_ref, 50, "ade_dcm_movecompressedfile: using 'mv' done");
    } else {
        &ade_err_debug($errstack_ref, 50, "ade_dcm_movecompressedfile: using ade_fcm_openreadcompressed|ade_fcm_openwritecompressed ...");
        if (($rc=&ade_fcm_openreadcompressed($errstack_ref, $srcname, \*SRC_HANDLE)) != $ade_err_ok) {
            &ade_err_error($errstack_ref, ade_err_access, $srcname, "open", $@);
            return($rc);
        }
        if (($rc=&ade_fcm_openwritecompressed($errstack_ref, $dstname, \*DST_HANDLE)) != $ade_err_ok) {
            &ade_err_error($errstack_ref, ade_err_access, $dstname, "open", $@);
            return($rc);
        }
        while (<SRC_HANDLE>) {
            print DST_HANDLE;
        }
        close(SRC_HANDLE);
        close(DST_HANDLE);
        if (!unlink($srcname)) {
            &ade_err_error($errstack_ref, ade_err_access, $srcname, "unlink", $@);
            return($ade_err_fail);
        }
    }

    return($ade_err_ok);
}

###############################################################################
#
#  USER- AND GROUP-NAME FUNCTIONS
#
###############################################################################

sub ade_usr_getmyloginname
{
    my($id);

    $id = $ENV{'USER'};
    $id || ($id = $ENV{'LOGNAME'});
    $id || ($id = `id | sed -n 's/^[^(][^(]*(\([^)][^)]*\)).*$/\1/p'`);

    return($id);
}

sub ade_usr_amiroot
{
    my ($errstack_ref, $i_am_root_ref) = @_;

    ${$i_am_root_ref} = ($> == 0) ? 1 : 0;

    return($ade_err_ok);
}

###############################################################################
#
#  FILE CONTENT MANIPULATION
#
###############################################################################

sub ade_fcm_openreadcompressed
{
    my($errstack_ref, $filename, $handle) = @_;

    return($ade_err_fail) if (! -r $filename);

    if (! -r $filename) {
        &ade_err_error($errstack_ref, ade_err_access, $filename, "read", $!);
        return($ade_err_fail);
    } elsif ($filename =~ /^.*\.gz$/) {
        if (! -x $gunzip_cmd) {
            &ade_err_error($errstack_ref, ade_err_access, $gunzip_cmd, "execute", $@);
            return($ade_err_fail);
        }
        if (!open($handle, "$gunzip_cmd < $filename |")) {
            &ade_err_error($errstack_ref, ade_err_access, $filename, "open with '$gunzip_cmd'", $@);
            return($ade_err_fail);
        }
    } elsif ($filename =~ /^.*\.Z$/) {
        if (! -x $uncompress_cmd) {
            &ade_err_error($errstack_ref, ade_err_access, $uncompress_cmd, "execute", $@);
            return($ade_err_fail);
        }
        if (!open($handle, "$uncompress_cmd < $filename |")) {
            &ade_err_error($errstack_ref, ade_err_access, $filename, "open with '$uncompress_cmd'", $@);
            return($ade_err_fail);
        }
    } else {
        if (!open($handle, $filename)) {
            &ade_err_error($errstack_ref, ade_err_access, $filename, "open", $@);
            return($ade_err_fail);
        }
    }

    return($ade_err_ok);
}

sub ade_fcm_openwritecompressed
{
    my($errstack_ref, $filename, $handle) = @_;

    if ($filename =~ /^.*\.gz$/) {
        if (! -x $gzip_cmd) {
            &ade_err_error($errstack_ref, ade_err_access, $gzip_cmd, "execute", $@);
            return($ade_err_fail);
        }
        if (!open($handle, "| $gzip_cmd > $filename")) {
            &ade_err_error($errstack_ref, ade_err_access, $filename, "open with '$gzip_cmd'", $@);
            return($ade_err_fail);
        }
    } elsif ($filename =~ /^.*\.Z$/) {
        if (! -x $compress_cmd) {
            &ade_err_error($errstack_ref, ade_err_access, $compress_cmd, "execute", $@);
            return($ade_err_fail);
        }
        if (!open($handle, "| $compress_cmd > $filename")) {
            &ade_err_error($errstack_ref, ade_err_access, $filename, "open with '$compress_cmd'", $@);
            return($ade_err_fail);
        }
    } else {
        if (!open($handle, ">$filename")) {
            &ade_err_error($errstack_ref, ade_err_access, $filename, "open", $@);
            return($ade_err_fail);
        }
    }

    return($ade_err_ok);
}

#  Name: 
#      ade_fcm_loadconfigfile
#
#  Synopsis:
#      my($rc);		      #  return code (0 for success)
#      my($filename);         #  file to load config from (error if defined and missing)
#      my($default_filename); #  file to load config from if $filename not defined (no error if missing)
#      my($regexp);           #  (unbracketed) regexp for valid directives
#      my(%hash);             #  initially undefined hash for variable-value pair insertion by this function
#      
#      $rc = &ade_fcm_loadconfigfile($filename, $default_filename, $regexp, \%hash);
# 
#  Description:
#      This function loads colon-separated variable-value pairs from a file into a
#      referenced hash. It understands the usual rules of config files (i.e. blank
#      lines, hash-led comments, backslash-continuation character).


sub ade_fcm_loadconfigfile
{
    my($errstack_ref, $filename, $default_filename, $validvars_regexp, $settings_hashref) = @_;
    my($linetext, $newlinetext, $lineno, $rc, $var, $val);
 
    &ade_err_debug($errstack_ref, 10, "ade_fcm_loadconfigfile: sof");

    return($ade_err_ok) if ((!defined($filename) || ($filename eq "")) && (!defined($default_filename) || ($default_filename eq "") || ! -f $default_filename));
    $filename = $default_filename if (!defined($filename) || ($filename eq ""));

    if (($rc=ade_fcm_openreadcompressed($errstack_ref, $filename, \*HANDLE)) != $ade_err_ok) {
        &ade_err_error($errstack_ref, ade_err_access, $filename, "open", $@);
        return($rc);
    }

    for ($lineno=0, $linetext=""; $newlinetext = <HANDLE>;) {
        $lineno++;
        #  Tidy it
        chomp($newlinetext);
        $newlinetext =~ s/^\s*(.*?)\s*$/$1/;
        #  Collect it
        $linetext .= $newlinetext;
        &ade_err_debug($errstack_ref, 10, "ade_fcm_loadconfigfile: now have [$linetext]");
        #  Get more if necessary
        next if ($linetext =~ s/\\$//);

        #  Ignore comments and blanks
        if ($linetext =~ /^(?:$|#)/) {
            $linetext = "";
            next;
        }

        #  Error on invalid line
        if ($linetext !~ /^\s*([\S:]+)\s*:\s*(.*?)\s*$/) {
            close(HANDLE);
            &ade_err_error($errstack_ref, ade_err_misc, "$filename:$lineno: invalid line format (is '$linetext', should be 'var: val')");
            return($ade_err_fail);
        }
        
        #  Check line ok
        $var=$1;
        $val=$2;
        &ade_err_debug($errstack_ref, 10, "ade_fcm_loadconfigfile: var=$var, val=$val");

        if ($1 !~ /^(?:$validvars_regexp)$/) {
            close(HANDLE);
            &ade_err_error($errstack_ref, ade_err_misc, "$filename:$lineno: invalid variable (is '$var', should match '$validvars_regexp')");
            return($ade_err_fail);
        }
        
        #  Check not a duplicate
        if (defined(${$settings_hashref}{$var})) {
            &ade_err_error($errstack_ref, ade_err_misc, "$filename:$lineno: redefinition of '$var'");
            return($ade_err_fail);
        }

        #  Save
        ${$settings_hashref}{$var} = $val;
        $linetext = "";
    }

    close(HANDLE);
    return($ade_err_ok);
}

###############################################################################
#
#  LOCK MANAGEMENT
#
###############################################################################

sub ade_lck_lock
{
    my($errstack_ref, $lock_what, $gen_lock_file_name_fnc) = @_;
    my($lock_file, $tmp_lock_file, $old_umask, $lock_text, $holding_pid, $rc, $running_flag);

    #  If $lock_what looks like an absolute path then just use that
    #  as the lock file name, otherwise assume that it is an 'entity'
    #  of some type (maybe a table name, or a username or something)
    #  and that the third parameter to this function is a reference to
    #  a function which will take the entity name and produce a lock
    #  file name from it. 
    $lock_file = ($lock_what =~ /^\//) ? $lock_what : &$gen_lock_file_name_fnc($errstack_ref, $lock_what);
    &ade_err_debug($errstack_ref, 20, "ade_lck_lock: lock_file=$lock_file");
    $tmp_lock_file = $lock_file . ".$$";

    #  assign the lock text
    $lock_text = $$;

    #  create temporary lock (world readable)
    unlink $tmp_lock_file;
    $old_umask = umask(0022);
    &ade_tmp_registerfile($errstack_ref, $tmp_lock_file);
    if (!open(TMP_LOCK_HANDLE, ">$tmp_lock_file")) {
        &ade_err_error($errstack_ref, ade_err_access, $tmp_lock_file, "create", $@);
        return($ade_err_fail);
    }
    umask($old_umask);
    print TMP_LOCK_HANDLE "$$\n";
    close TMP_LOCK_HANDLE;

    #  slide the temporary lockfile into place - link() returns 1 for success
    &ade_err_debug($errstack_ref, 20, "ade_lck_lock: sliding temp lock into place ...");
    &ade_tmp_registerfile($errstack_ref, $lock_file);
    if (link($tmp_lock_file, $lock_file) == 1) {
        unlink $tmp_lock_file;
        &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file);
        return($ade_err_ok);
    }

    #  If we get this far then the lock did not success. 

    #  Make sure we don't delete somebody else's lock file on error.
    &ade_tmp_deregisterfile($errstack_ref, $lock_file);

    #  Check who is locking us out.
    &ade_err_debug($errstack_ref, 20, "ade_lck_lock: sliding temp lock into place failed, checking existing lock ...");
    if (!open(LOCK_HANDLE, $lock_file)) {
        &ade_err_error($errstack_ref, ade_err_access, $lock_file, "open", $@);
        return($ade_err_fail);
    }
    $holding_pid = <LOCK_HANDLE>;
    close(LOCK_HANDLE);
    chop($holding_pid);
    #  Check lock file contents looks like a PID.
    if ($holding_pid !~ /^\d+$/) {
        unlink($tmp_lock_file);
        &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file);
        &ade_err_error($errstack_ref, ade_err_misc, "$lock_file: corrupt lock file");
        return($ade_err_fail);
    }

    #  Check if the PID is running or is stale.
    &ade_err_debug($errstack_ref, 20, "ade_lck_lock: checking if pid $holding_pid running ...");
    if (($rc=&ade_lck_checklock($errstack_ref, $holding_pid, \$running_flag)) != $ade_err_ok) {
        &ade_err_debug($errstack_ref, 20, "ade_lck_lock: ade_lck_checklock failed");
        return($rc);
    }
    if ($running_flag) {
        &ade_err_debug($errstack_ref, 20, "ade_lck_lock: ade_lck_checklock said PID exists");
        #  If PID is running then clean up and return that it is is locked.
        unlink($tmp_lock_file);
        &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file);
        &ade_err_error($errstack_ref, ade_err_locked, $ade_app_progname, "PID $holding_pid");
        return($ade_err_fail);
    }

    #  if lock is stale (it must be if we get here) remove lock
    &ade_err_info($errstack_ref, "removing stale lock (pid=$holding_pid) ...");
    unlink($lock_file);

    #  try locking again
    &ade_err_debug($errstack_ref, 20, "ade_lck_lock: sliding temporary lock into place - second try ...");
    &ade_tmp_registerfile($errstack_ref, $lock_file);
    if (link($tmp_lock_file, $lock_file) == 1) {
        unlink($tmp_lock_file);
        &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file);
        return($ade_err_ok);
    }

    #  if we still haven't successfully locked by now then there is something
    #  seriously wrong
    unlink($tmp_lock_file);
    &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file);
    &ade_err_internal($errstack_ref, "ade_lck_lock: couldn't lock even after removing stale lockfile");
}

sub ade_lck_getgenericlockfilename
{
    return("$ade_tmp_dir/$ade_app_progname.pid");
}

sub ade_lck_checklock
{
    my($errstack_ref, $pid, $runningflag_ref) = @_;
    my($found, $pspid, $junk, $ps_cmd, $unames);

    if (-d "/proc/$pid") {
        &ade_err_debug($errstack_ref, 20, "ade_lck_checklock: /proc/$pid exists, returning ...");
        ${$runningflag_ref} = 1;
        return($ade_err_ok);
    }
    $pid = sprintf("%05d", $pid);
    if (-d "/proc/$pid") {
        &ade_err_debug($errstack_ref, 20, "ade_lck_checklock: /proc/$pid exists, returning ...");
        ${$runningflag_ref} = 1;
        return($ade_err_ok);
    }

    chop($unames = `uname -s`);
    if ($unames eq "Linux") {
        $ps_cmd = "ps ax";
    } elsif ($unames eq "SunOS") {
        $ps_cmd = "ps -ae";
    } elsif ($unames eq "HP-UX") {
        $ps_cmd = "ps -e";
    } else {
        &ade_err_internal($errstack_ref, "ade_lck_checklock: don't know who to handle OS $unames (this function needs to be updated)");
    }
    
    open(PS_HANDLE, "$ps_cmd|") || &ade_err_internal($errstack_ref, "ade_lck_checklock: failed to get ps listing with '$ps_cmd'");
    #  Assume not running until we discover otherwise.
    ${$runningflag_ref} = 0;
    while (<PS_HANDLE>) {
        ($pspid, $junk) = split;
        ${$runningflag_ref} = 1 if ($pspid == $pid);
    }
    close PS_HANDLE;

    #
    #  If we get this far everything is ok.
    #

    return($ade_err_ok);
}

sub ade_lck_unlock
{
    my($errstack_ref, $lock_what, $gen_lock_file_name_fnc) = @_;
    my($lock_file);

    &ade_err_debug($errstack_ref, 50, "ade_lck_lock: sof");

    #  If $lock_what looks like an absolute path then just use that
    #  as the lock file name, otherwise assume that it is an 'entity'
    #  of some type (maybe a table name, or a username or something)
    #  and that the third parameter to this function is a reference to
    #  a function which will take the entity name and produce a lock
    #  file name from it. 
    $lock_file = ($lock_what =~ /^\//) ? $lock_what : &$gen_lock_file_name_fnc($errstack_ref, $lock_what);

    unlink $lock_file;

    #
    #  If we get this far everything is ok.
    #

    return($ade_err_ok);
}

###############################################################################
#
#  STRING MANIPULATION FUNCTIONS
#
###############################################################################

sub ade_smf_isvalidregexp
{
    my($errstack_ref, $regex) = @_;
    my($coderef);

    if ($coderef = eval { "junk" =~ /$regex/ }) { }

    if (!defined($coderef)) {
        &ade_err_error($errstack_ref, ade_err_invalid, $regex, "regexp");
        return($ade_err_fail);
    }

    return($ade_err_ok);
}

##############################################################################
#
#  SPECIAL FUNCTIONS
#
##############################################################################

#  Rolling Status Manager
sub ade_spc_rollingstatusmanager
{
    my ($errstack_ref, $mode, $sched_file, $scan_funcref, $comp_funcref, $midhook_funcref,
            $oldscan_stem, $oldscan_compext, $log_file, $scanarg, $tmp_dir, $rollcount) = @_;
    my($rc, $newest_status_file, $i, $newer_status_file, $older_status_file);

    #print STDERR Dumper($scanarg);

    &ade_err_debug($errstack_ref, 10, "ade_spc_rollingstatusmanager: mode=$mode, sched_file=$sched_file, oldscan_stem=$oldscan_stem, oldscan_compext=$oldscan_compext, log_file=$log_file, scanarg=$scanarg, tmp_dir=$tmp_dir, rollcount=$rollcount");

    $newest_status_file = "$tmp_dir/$ade_app_progname.$$.snap";

    #  For init, check or refresh, do a new scan.
    if ($mode eq "init" || $mode eq "check" || $mode eq "refresh") {
        &ade_tmp_registerfile($errstack_ref, $newest_status_file);
        #  Get ready to write to the (compressed) new scan file.
        &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: opening new scan file $newest_status_file ...");
        if (($rc=&ade_fcm_openwritecompressed($errstack_ref, $newest_status_file, \*NEWSCAN_HANDLE)) != $ade_err_ok) {
            &ade_err_error($errstack_ref, ade_err_access, $newest_status_file, "open", $@);
            return($rc);
        }
        #  In a moment we'll redirect stdout, but before we do we need to
        #  remember where stdout is pointing now so that we can restore it
        #  in a moment.
        &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: remembering stdout ...");
        #  Avoid names that might clash with user applications for the handle, since it is a global.
        open(ADESPCRSM_OLD_STDOUT, ">&STDOUT") || &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: can't dup stdout");
	#  Here we redirect it.
        &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: redirecting stdout ...");
        open(STDOUT, ">&NEWSCAN_HANDLE");
        #  Now scan_funcref() can just merrily output to stdout.
        &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: calling the scanning callback ...");
        if (($rc=&$scan_funcref($errstack_ref, $scanarg)) != $ade_err_ok) {
            &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: scanning callback failed");
            close NEWSCAN_HANDLE;
            open(STDOUT, ">&ADESPCRSM_OLD_STDOUT") || &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: can't dup stdout");
            return($rc);
        }
        &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: scanning callback successful");
        #  Restore stdout.
        &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: restoring stdout ...");
        open(STDOUT, ">&ADESPCRSM_OLD_STDOUT") || &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: can't restore stdout");
        #  Close the (compressed) new scan file.
        &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: closing scan handle ...");
        close NEWSCAN_HANDLE;
    }

    #  For check or refresh, compare the old and new scans.
    if ($mode eq "check" || $mode eq "refresh") {
        for ($i=$rollcount; $i>0; $i--) {
            if ($i == 1) {
                $newer_status_file = $newest_status_file;
                $older_status_file = sprintf("%s%s", $oldscan_stem, $oldscan_compext);
            } elsif ($i == 2) {
                $newer_status_file = sprintf("%s%s", $oldscan_stem, $oldscan_compext);
                $older_status_file = sprintf("%s.%s%s", $oldscan_stem, $i, $oldscan_compext);
            } else {
                $newer_status_file = sprintf("%s.%s%s", $oldscan_stem, $i-1, $oldscan_compext);
                $older_status_file = sprintf("%s.%s%s", $oldscan_stem, $i, $oldscan_compext);
            }
            &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: \$rollcount=$rollcount, \$i=$i, \$older_status_file=$older_status_file, \$newer_status_file=$newer_status_file");

            #  When first running this, there may not be enough 'old'
            #  scan logs to make all the desired comparisons. i.e.
	    #  oldest with second-to-oldest, second-to-oldest with
	    #  third-from-oldest, etc. This isn't really an error; it's
	    #  just a natural part of the initial use of this rolling
	    #  state monitor. If/when it does happen, then clearly we
	    #  need to move on to the 'slightly newer' - which may 
            #  exist - for comparison.
            #
            #  Actually, there is an exception to this; and that is
	    #  when we only maintain *one* file older than the temporary
	    #  copy. And in that case this older file should *always*
            #  exist; if it doesn't then we've obviously gone wrong
            #  in reaching this point in the program.
            if (! -f $older_status_file) {
                if ($rollcount > 1) {
                    next;
                } else {
                    &ade_err_error($errstack_ref, ade_err_access, $older_status_file, "access", $@);
                    return($ade_err_fail);
                }
            }

            &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: doing a comparision ...");
            if (defined($log_file)) {
                if (($rc=&ade_fcm_openwritecompressed($errstack_ref, $log_file, \*LOG_HANDLE)) != $ade_err_ok) {
                    &ade_err_error($errstack_ref, ade_err_access, $log_file, "open", $@);
                    return($rc);
                } else {
                    &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: \$log_file not defined; not an error");
                }
                #  Avoid names that might clash with user applications for the handle, since it is a global.
                open(ADESPCRSM_OLD_STDOUT, ">&STDOUT") || &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: can't dup stdout");
                open(STDOUT, ">&LOG_HANDLE");
            }
            if (($rc=&$comp_funcref($errstack_ref, $older_status_file, $newer_status_file, $i)) != $ade_err_ok) {
                #  don't bother checking if open produces an error when we are
		#  already in an error situation.
                if (defined($log_file)) {
                    open(STDOUT, ">&ADESPCRSM_OLD_STDOUT");
                    close LOG_HANDLE;
                    #  We have to inform the user of where they can get the error
	            #  because zdiff (called from anonymous callback in wkrep)
	            #  is not well behaved about where it sends errors to. Try
	            #  'zdiff asdfg sdfdfg > /dev/null' and there is no error
	            #  message on stdout saying 'files do not exist'. But to
	            #  assume that the error is *never* displayed and cat the
	            #  log file *here* would be too presumtive. 
                    &ade_err_error($errstack_ref, ade_err_misc, "comparison failed; $log_file may provide more information");
                } else {
                    &ade_err_error($errstack_ref, ade_err_misc, "comparison failed");
                }
                return($rc);
            }
            &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: comparing callback successful");
            if (defined($log_file)) {
                open(STDOUT, ">&ADESPCRSM_OLD_STDOUT") || &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: can't restore STDOUT: $!");
                close LOG_HANDLE;
            }
        }
    }

    #  This hook is specifically for checkntp to allow it to write
    #  'marking NTP ok even though it failed and is about to be restarted
    #  so that in five minutes when checkntp runs again, even though NTP
    #  will not be ok and all historical records show it never was ok we
    #  still do not restart it.'
    if (defined($midhook_funcref)) {
        if (($rc=&$midhook_funcref($errstack_ref, $newest_status_file)) != $ade_err_ok) {
            &ade_err_error($errstack_ref, ade_err_misc, "midhook function failed");
            return($rc);
        }
    }
    
    #  For check with schedule, or refresh, or init, make the new snap the 
    #  old snap. Don't do it by moving or copying 'cos we may move a gzipped 
    #  file to a non-gzipped name, which will cause problems.
    if (($mode eq "check" && defined($sched_file) && -f $sched_file) || $mode eq "refresh" || $mode eq "init") {
        for ($i=$rollcount; $i>0; $i--) {
            if ($i == 1) {
                $newer_status_file = $newest_status_file;
                $older_status_file = sprintf("%s%s", $oldscan_stem, $oldscan_compext);
            } elsif ($i == 2) {
                $newer_status_file = sprintf("%s%s", $oldscan_stem, $oldscan_compext);
                $older_status_file = sprintf("%s.%s%s", $oldscan_stem, $i, $oldscan_compext);
            } else {
                $newer_status_file = sprintf("%s.%s%s", $oldscan_stem, $i-1, $oldscan_compext);
                $older_status_file = sprintf("%s.%s%s", $oldscan_stem, $i, $oldscan_compext);
            }

            #  This is the same as the comparsion case when there isn't
	    #  the needed 'old' scan files.
            if (! -f $newer_status_file) {
                if ($rollcount > 1) {
                    next;
                } else {
                    &ade_err_error($errstack_ref, ade_err_access, $newer_status_file, "access for stealing", $@);
                    return($ade_err_fail);
                }
            }

            &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: shuffling up ($newer_status_file -> $older_status_file) ...");
            if (($rc=&ade_dcm_movecompressedfile($errstack_ref, $newer_status_file, $older_status_file)) != $ade_err_ok) {
                &ade_err_error($errstack_ref, ade_err_access, $newer_status_file, "move", $@);
                return($rc);
            }
        }
    }

    #  For check with schedule, or refresh, delete the schedule file.
    if (defined($sched_file) && (($mode eq "check" && -f $sched_file) || $mode eq "refresh")) {
        &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: removing sched file ...");
        unlink($sched_file);
    }

    #  For scheduling, create the schedule file.
    if ($mode eq "schedule") {
        if (!defined($sched_file)) {
            &ade_err_internal($errstack_ref, "ade_spc_rollingstatusmanager: called in 'schedule' mode, but the schedule file is undefined");
        }
        &ade_err_debug($errstack_ref, 40, "ade_spc_rollingstatusmanager: creating sched file ...");
        if (!open(HANDLE, ">$sched_file")) {
            &ade_err_error($errstack_ref, ade_err_access, $sched_file, "create", $@);
            return($ade_err_fail);
        }
        close HANDLE;
    }

    return($ade_err_ok);
}

sub ade_spc_autogendheader
{
    my($errstack_ref, $outhandle, $comment_start, $comment_end, $headersize_ref) = @_;
    my($user, $unamen, $date, $linelength, $textlength);

    &ade_err_debug($errstack_ref, 4, "ade_spc_autogendheader: sof (COS=$comment_start, COE=$comment_end)");

    $comment_start = '#' if (!defined($comment_start));
    $comment_end = '' if (!defined($comment_end));

    $user   = &ade_usr_getmyloginname;
    $linelength = 78;
    chop($unamen = `uname -n`);
    chop($date = `date`);
    $textlength = $linelength - (length($comment_start) + length($comment_end));
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "=" x $textlength, $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "", $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "               T H I S   I S   A   G E N E R A T E D   F I L E", $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "", $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "               M A N U A L   E D I T S   M A Y   B E   L O S T", $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "", $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "  Generated by:      $user", $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "  Generated with:    $ade_app_progname", $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "  Generated on host: $unamen", $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "  Generated on date: $date", $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "", $comment_end;
    printf $outhandle "%s%-*s%s\n", $comment_start, $textlength, "=" x $textlength, $comment_end;
    
    #  pass the number of lines add to the the parent.
    ${$headersize_ref} = 12 if (defined($headersize_ref));

    return($ade_err_ok);
}

sub ade_spc_cachemanager
{
    my ($errstack_ref, $cache_file, $cache_expiry_period, $desired_cache_expiry, $new_cache_tester_fncref, $new_cache_getter_fncref, $cache_id) = @_;
    my ($actual_cache_expiry, $cache_dir, $refresh_cache, $rc);

    #  Determine if cache actually expired
    $actual_cache_expiry = (time - (stat($cache_file))[9] >= 86400 * $cache_expiry_period);

    #  This is the logic for combining the desired cache expiry status and
    #  the actual cache expiry status to determine if the cache should be 
    #  refreshed.
    #
    #                 DESIRED EXPIRY
    #             Y          N     don't care
    #        ----------+is-cache--+----------
    #       |          |          |          |
    #   A   |          |    no    |          |
    #   C   |          |  update  |          |
    #   T   |          |          |          |
    #   U Y |  update  |no-cache--|  update  |
    #   A   |          |          |          |
    #   L   |          |  update  |          |
    #       |          |          |          |
    #        ----------+----------+----------
    #   E   |          |          |          |
    #   X   |          |          |          |
    #   P   |          |          |          |
    #   I   |          |    no    |    no    |
    #   R N |  update  |  update  |  update  |
    #   Y   |          |          |          |
    #       |          |          |          |
    #       |          |          |          |
    #        ----------+----------+----------
    # 
    #  And now here it is in code, using the usual 'bite off the big
    #  bits first' approach.
 
    if ($desired_cache_expiry) {
        $refresh_cache = 1;
    } elsif (!$actual_cache_expiry) {
        $refresh_cache = 0;
    } elsif (!defined($desired_cache_expiry)) {
        $refresh_cache = 1;
    } elsif (-f $cache_file) {
        $refresh_cache = 0;
    } else {
        &ade_err_warning($errstack_ref, "cache will be refreshed against user's desire because no cache file exists yet");
        $refresh_cache = 1;
    }

    &ade_err_debug($errstack_ref, 4, "ade_spc_cachemanager: desired_cache_expiry=$desired_cache_expiry, actual_cache_expiry=$actual_cache_expiry, refresh_cache=$refresh_cache");
        
    if ($refresh_cache) {
        return($rc) if (($rc=&ade_fnm_dirname($errstack_ref, $cache_file, \$cache_dir)) != $ade_err_ok);

        # sanity check cache
        if (-f $cache_file) {
            if (! -w $cache_file) {
                &ade_err_error($errstack_ref, ade_err_misc, "$cache_file: cache file exists but is not writable!") if (! -w $cache_file);
                return($ade_err_fail);
            }
        } elsif (-d $cache_dir) {
            if (! -w $cache_dir) {
                &ade_err_error($errstack_ref, ade_err_misc, "$cache_file: cannot create cache file") if (! -w $cache_dir);
                return($ade_err_fail);
            }
        } else {
            &ade_err_error($errstack_ref, ade_err_misc, "$cache_dir: cache file's directory does not exist");
            return($ade_err_fail);
        }
             
        #  update cache
        &ade_err_info($errstack_ref, "updating '$cache_id' cache, please wait ... ");
        &ade_tmp_registerfile($errstack_ref, "$ade_tmp_dir/$ade_app_progname.$$.newcache");
        &ade_err_debug($errstack_ref, 4, "ade_spc_cachemanager: calling $new_cache_getter_fncref() ...");
        if (!open(TMPCACHE_HANDLE, ">$ade_tmp_dir/$ade_app_progname.$$.newcache")) {
            &ade_err_error($errstack_ref, ade_err_access, "$ade_tmp_dir/$ade_app_progname.$$.newcache", "open", $@);
            return($ade_err_fail);
        }
        #  Avoid names that might clash with user applications for the handle, since it is a global.
        open(ADESPCCM_OLD_STDOUT, ">&STDOUT") || &ade_err_internal($errstack_ref, "ade_spc_cachemanager: can't dup stdout");
        open(STDOUT, ">&TMPCACHE_HANDLE");
        &$new_cache_getter_fncref;
        open(STDOUT, ">&ADESPCCM_OLD_STDOUT") || &ade_err_internal($errstack_ref, "ade_spc_cachemanager: can't dup stdout");
        close(TMPCACHE_HANDLE);

        #  if tests pass, accept it.
        if (&$new_cache_tester_fncref("$ade_tmp_dir/$ade_app_progname.$$.newcache") == 0) {
            system("cat $ade_tmp_dir/$ade_app_progname.$$.newcache > $cache_file");
            unlink("$ade_tmp_dir/$ade_app_progname.$$.newcache");
            &ade_tmp_deregisterfile($errstack_ref, "$ade_tmp_dir/$ade_app_progname.$$.newcache");
            &ade_err_info($errstack_ref, "'$cache_id' cache update succeeded");

        #  if tests fail but we have an old version, reject with warning
        } elsif (-f $cache_file) {
            &ade_tmp_deregisterfile($errstack_ref, "$ade_tmp_dir/$ade_app_progname.$$.newcache");
            &ade_err_warning($errstack_ref, "'$cache_id' cache update failed, old cache available (see $ade_tmp_dir/$ade_app_progname.$$.newcache for new data which failed acceptance test)");

        #  if tests fail and we don't have an old version, reject with error
        } else {
            &ade_tmp_deregisterfile($errstack_ref, "$ade_tmp_dir/$ade_app_progname.$$.newcache");
            &ade_err_error($errstack_ref, ade_err_misc, "'$cache_id' cache update failed, old cache not available (see $ade_tmp_dir/$ade_app_progname.$$.newcache for new data which failed acceptance test)");
            return($ade_err_fail);
        }
    }

    #  Pass cache to parent
    system("cat $cache_file");

    #  success return code
    return($ade_err_ok);
}

sub ade_mua_addmailheader
{
    my($errstack_ref, $headers_ref, $header_line) = @_;
    my($header_name, $header_value, $current_element_count);

    ($header_name, $header_value) = split(/:\s+/, $header_line, 2);
    $current_element_count = scalar keys(%$headers_ref);
    &ade_err_debug($errstack_ref, 4, "ade_mua_addmailheader: number of elements so far is $current_element_count");
    $$headers_ref{$header_name} = {
        lineno => $current_element_count,
        value  => $header_line
    };

    return($ade_err_ok);
}

sub ade_mua_delmailheader
{
    my($errstack_ref, $headers_ref, $header_name) = @_;

    delete($$headers_ref{$header_name});

    return($ade_err_ok);
}

#sub ade_mua_loadrcfile
#{
#    my($headers_ref) = @_;
#    my($mymailrc_file, $rc);
#
#    $mymailrc_file = $ENV{'HOME'} . "/.mymailrc";
#    #  It is not an error for this file to be inaccessible.
#    if (open(MYMAILRC_HANDLE, $mymailrc_file)) {
#        while (<MYMAILRC_HANDLE>) {
#            chomp;
#            &ade_err_debug($errstack_ref, 4, "ade_mua_loadrcfile: read line $_");
#            if (/^\s*$/) {
#                next;
#            } elsif (/^\s*#.*$/) {
#                next;
#            } else {
#                if (($rc=&ade_mua_addmailheader($headers_ref, $_)) != 0) {
#                    &ade_err_error($errstack_ref, ade_err_misc, "ade_mua_addmailheader() failed, returning early ...");
#                    return($rc);
#                }
#            }
#        }
#        close(MYMAILRC_HANDLE);
#    }
#
#    return($ade_err_ok);
#}

sub ade_mua_sendmail
{
    my($errstack_ref, $headers_ref, $body_handle, $mailto_ref) = @_;
    my($smtp, $mymailrc_file, $key);

    #
    #  If sendmail command defined then use it.
    #

    if ($sendmail_cmd) {
        &ade_err_debug($errstack_ref, 4, "ade_mua_sendmail: mailing with $sendmail_cmd");
        if (!open(PIPE_HANDLE, "| $sendmail_cmd " . join(' ', @$mailto_ref))) {
            &ade_err_error($errstack_ref, ade_err_misc, "can't open pipe to $sendmail_cmd");
            return($ade_err_fail);
        }
        print PIPE_HANDLE map { $$headers_ref{$_}{value} . "\n" } (sort { $$headers_ref{$a}{lineno} <=> $$headers_ref{$b}{lineno} } keys %$headers_ref);
        print PIPE_HANDLE "\n";
        while (<$body_handle>) {
            print PIPE_HANDLE;
        }
        close PIPE_HANDLE;

    #
    #  Else use SMTPSERVER
    #

    } elsif ($ENV{'SMTPSERVER'}) {
        &ade_err_debug($errstack_ref, 4, "ade_mua_sendmail: mailing with Net::SMTP to $ENV{'SMTPSERVER'} for " . join(' ', @$mailto_ref));
        $smtp = Net::SMTP->new($ENV{'SMTPSERVER'});
        #  this is about the safest definition of our own email address,
        $smtp->mail(&ade_usr_getmyloginname . "\@[127.0.0.1]");
        $smtp->to(@$mailto_ref);
        $smtp->data();
        $smtp->datasend(map { $$headers_ref{$_}{value} . "\n" } (sort { $$headers_ref{$a}{lineno} <=> $$headers_ref{$b}{lineno} } keys %$headers_ref));
        $smtp->datasend("\n");
        while (<$body_handle>) {
            $smtp->datasend($_);
        }
        $smtp->dataend();
        $smtp->quit;

    #
    #  Otherwise give up (shouldn't this have been detected at load-time? 
    #

    } else {
        &ade_err_error($errstack_ref, ade_err_misc, "cannot pass to MTA, please define 'SMTPSERVER' in your environment");
        return($ade_err_fail);
    }
    
    return($ade_err_ok);
}

sub ade_mua_parsemail
{
    my($errstack_ref, $letter_handle, $headers_ref, $body_handle) = @_;
    my($header_name, $header_value, $finished_processing_headers);
    my($last_header_line_was_received_leader, %new_headers);
    
    #  Put lines into 'new' headers and bodylines
    $finished_processing_headers = 0;
    %new_headers = ();
    while (<$letter_handle>) {
	chomp;

        &ade_err_debug($errstack_ref, 4, "ade_mua_parsemail: line=[$_]");
        ($header_name, $header_value) = split(/:\s+/, $_, 2);

        if ($finished_processing_headers) {
	    ;

        } elsif (defined($valid_headers{$header_name}) && !$header_value) {
            &ade_err_error($errstack_ref, ade_err_misc, "header '$header_name' has no value");
            return($ade_err_fail);

	} elsif (defined($valid_headers{$header_name})) {
            ;

        } else {
            $finished_processing_headers = 1;
        }


        if ($finished_processing_headers) {
            print $body_handle "$_\n";
        } else {
            &ade_mua_addmailheader(\%new_headers, $_);
        }
    }

    &ade_mua_mergemailheaders($headers_ref, \%new_headers);
    undef %new_headers;

    return($ade_err_ok);
}

sub ade_mua_mergemailheaders
{
    my($headers_ref, $new_headers_ref) = @_;
    my($new_header_key);
    #my($new_bodyline);

    #foreach $new_bodyline (@$new_bodylines_ref) {
    #    push(@$bodylines_ref, $new_bodyline);
    #}

    foreach $new_header_key (keys %$new_headers_ref) {
        $$headers_ref{$new_header_key} = $$new_headers_ref{$new_header_key};
    }

    return($ade_err_ok);
}

#sub ade_mua_getconfiginfo
#{
#    return($sendmail_cmd ? $sendmail_cmd : $ENV{'SMTPSERVER'} ? "SMTP via $ENV{'SMTPSERVER'}" : "not defined");
#}
###############################################################################
#
#  PRIVATE FUNCTIONS (NOT FOR PUBLIC USE)
#
###############################################################################

##############################################################################
#
#  Private functions 
#
#  These are not *truly* private functions (that could only be done by using
#  a my'ed coderef (see template in perlmod(1)) as they could be called by
#  the name &ADE::whatever(), but to indicate that they are private we prefix
#  them with underscores.
#
##############################################################################

sub _ade_msg_loadtimechecks
{
    @ade_err_writerfunc_refs = (\&ade_msg_writer_stderr);
    $ade_msg_verboselevel = 2;

    return($ade_err_ok);
}

sub _ade_gep_main_withstack
{
    my($errstack_ref, $app_main_ref) =@_;
    my($rc);

    #printf "_ade_gep_main_withstack: sof\n";

    #  In perl we check if functions return $ade_err_ok, but this is not
    #  really practical in a shell script; '|| ...' is such a natural
    #  construct that we don't want to change it to 'RC=$?; if [ $RC != 0 ]; then'

    #printf "_ade_gep_main_withstack: calling _ade_gep_getosid ...\n";
    if (($rc=&_ade_gep_getosid($errstack_ref)) != $ade_err_ok) {
        &ade_err_error($errstack_ref, ade_err_miscfailure, "determination of OS");
        return($rc);
    }

    #print "_ade_gep_main_withstack: calling app_main_ref function (btw: \$ade_err_ok is $ade_err_ok) ...\n";
    if(($rc=&{$app_main_ref}($errstack_ref)) != $ade_err_ok) {
        #print "_ade_gep_main_withstack: app_main_ref function failed\n";
        &ade_err_error($errstack_ref, ade_err_miscfailure, "application's entry function");
        return($rc);
    } else {
        #print "_ade_gep_main_withstack: app_main_ref function succeeded! (\$rc=$rc)\n";
    }

    #
    #  If we get this far then everything is ok.
    #

    return($ade_err_ok);
}

#  This contains the *only* call to exit.
sub _ade_gep_exit
{
    my($errstack_ref, $rc) = @_;

    #  Should be expanded as the shell version to call all
    #  registered functions.

    &_ade_tmp_cleanup($errstack_ref);
    &_ade_tmp_funcup($errstack_ref);

    #  This line maps ADE function return codes into Unix program exit codes.
    #  It should be the only call to 'exit' anywhere.
    exit(($rc==$ade_err_ok)?0:1);
}

sub _ade_gep_signalhandler
{
    my($errstack_ref) = [];

    &ade_err_resetstack(stack=>$errstack_ref);

    &ade_err_info($errstack_ref, "clearing up ...");
    &_ade_gep_exit($errstack_ref, 4);
}

sub _ade_gep_getosid
{
    my($errstack_ref) = @_;
    my($ade_unames, $ade_unamer, $ade_unamen, $ade_unamem, $ade_osid);
    
    #  Very useful settings
    chomp($ade_unames=`uname -s`);
    chomp($ade_unamer=`uname -r`);
    chomp($ade_unamen=`uname -n`);
    chomp($ade_unamem=`uname -m`);

    #  Don't differentiate Intel processors
    $ade_unamem = "i386" if ($ade_unamem =~ /^i[3456]86$/);

    #  ADE_OSID is the absolute OS reference. It has no spaces or slashes in
    #  it for safer use later on. Linux requires some massaging here, 
    #  since revision comes from the kernel version and this is not 
    #  really terribly useful. 
    if ($ade_unames ne "Linux") {
        chomp($ade_osid=`uname -sr | sed 's/[ \/]/_/g'`);
    } elsif (-f '/etc/redhat-release') {
        chomp($ade_osid=`sed -n 's/.*release \([^ ][^ ]*\) .*/\1/p' /etc/redhat-release`);
        $ade_osid="Linux_Redhat_${ade_osid}_$ade_unamem";
    } elsif (-f '/etc/debian_version') {
        chomp($ade_osid=`cat /etc/debian_version`);
        $ade_osid="Linux_Debian_${ade_osid}_$ade_unamem";
    } else {
        $ade_osid="Linux_Unknown_$ade_unamem";
    }
    if ($ade_osid =~ /^Linux_Redhat_6\.1_i.*86$/) {
        $ade_osid='Linux_Redhat_6.1_i386'; 
    } elsif ($ade_osid =~ /^Linux_Debian_2\.2_i.*86$/) {
        $ade_osid='Linux_Debian_2.2_i386'; 
    } elsif ($ade_osid =~ /^HP-UX_B\.11\.00$/) {
        chomp($ade_osid="${ade_osid}_`/usr/bin/getconf KERNEL_BITS`");
    }

    #
    #  If we get this far then everything is ok.
    #

    return($ade_err_ok);
}

sub _ade_gep_loadtimechecks
{
    my($errstack_ref) = @_;

    #  The callonexit hash uses code references (of the functions to be called
    #  at exit-time) as the keys in the hash. But this is only possible if
    #  this line is done; otherwise hash keys must be strings (and code references
    #  will be stringified and thereafter uncallable).
    tie %{$ade_gep_delonexit{callonexit}}, 'Tie::RefHash';

    #  CDPATH causes all sorts of trouble!
    $ENV{'CDPATH'}  && (delete($ENV{'CDPATH'}));
    
    #  The shell version doesn't need to do this since it can access $TMPDIR
    #  directly.
    if ($ENV{'TMPDIR'} && -d $ENV{'TMPDIR'}) {
        $ade_tmp_dir = $ENV{'TMPDIR'};
    } elsif (-d '/var/tmp') {
        $ade_tmp_dir = '/var/tmp';
    }
    
    #
    #  If we get this far then everything is ok.
    #

    return($ade_err_ok);
}

sub _ade_err_validate_errorkey
{

    my($errstack_ref, $defined_errors_hash_key) = @_;
    my($i);

    #  Scan over the list of registered hashes ...
    for ($i=0; $i<=$#ade_registered_defined_errors_hash_refs_array; $i++) {
        last if (defined(${$ade_registered_defined_errors_hash_refs_array[$i]}{$defined_errors_hash_key}));
    }
    &ade_err_internal($errstack_ref, "$defined_errors_hash_key: unknown error") if (!defined(${$ade_registered_defined_errors_hash_refs_array[$i]}{$defined_errors_hash_key}));
    
    return($ade_err_ok);
}

sub _ade_fcm_loadtimechecks
{
    $ENV{'GZIP_CMD'} && ($gzip_cmd = $ENV{'GZIP_CMD'});
    ($gzip_cmd) || ($gzip_cmd = &ade_std_which('gzip'));

    $ENV{'GUNZIP_CMD'} && ($gunzip_cmd = $ENV{'GUNZIP_CMD'});
    ($gunzip_cmd) || ($gunzip_cmd = &ade_std_which('gunzip'));

    $ENV{'COMPRESS_CMD'} && ($compress_cmd = $ENV{'COMPRESS_CMD'});
    ($compress_cmd) || ($compress_cmd = &ade_std_which('compress'));

    $ENV{'UNCOMPRESS_CMD'} && ($uncompress_cmd = $ENV{'UNCOMPRESS_CMD'});
    ($uncompress_cmd) || ($uncompress_cmd = &ade_std_which('uncompress'));

    &ade_err_registerdefderrs(\%ade_utils_defined_errors);

    return($ade_err_ok);
}

sub _ade_msg_message
{
    my($errstack_ref, $level, $template, $message) = @_;
    my($writerfunc_ref);

    $ade_msg_verboselevel=2 if (!defined($ade_msg_verboselevel));
    return($ade_err_ok) if ($level > $ade_msg_verboselevel);

    $template =~ s/%MESSAGE/$message/;
    $template =~ s/%LEVEL/$level/;

    #printf "_ade_msg_message: about to check which writer functions to call ...\n";
    foreach $writerfunc_ref (@ade_err_writerfunc_refs) {
        #printf "_ade_msg_message: calling writer function ...\n";
        &$writerfunc_ref($errstack_ref, $template);
    }

    return($ade_err_ok);
}

sub _ade_tmp_cleanup
{
    my($errstack_ref) = @_;
    my($item, $pwd);

    &ade_err_debug($errstack_ref, 4, "_ade_tmp_cleanup: sof");

    #  The system() call invokes 'sh' which invokes 'rm'. After 'rm' has exited
    #  there is a brief return to the 'sh' before that exits and system() returns.
    #  That brief stay in 'sh' on the return trip is enough to provoke warnings
    #  like 'shell-init: error retrieving current directory' if the we happen to
    #  be in the directory we're deleting! Here we make a brief check for that.
    #
    #$pwd = getcwd;
    #foreach $item (keys %{$ade_gep_delonexit{delonexit}}) {
    #    #  If item is pwd or item is a leading component of pwd ...
    #    if ($item eq $pwd || "$item/" eq substr($pwd,0,length($item)+1)) {
    #        &ade_err_internal($errstack_ref, "_ade_tmp_cleanup: looks like you do not cd out of $item before allowing the cleanup routines to delete it");
    #    }
    #}
    # 
    #  Actually, later I realised that if you press CTRL-C then you get the
    #  same problem. The best solution is that this cleanup function itself
    #  cd's to / and does the cleanup. And that we force all registered paths
    #  to be absolute.
    #
    chdir("/");

    foreach $item (keys %{$ade_gep_delonexit{delonexit}}) {
        #  unlink is not enough, 'cos directories are sometimes registered,
	#  and what's more the caller does not expect to have to register 
	#  the contents of directories one by one.
        &ade_err_debug($errstack_ref, 4, "_ade_tmp_cleanup: deleting $item ...");
        system("rm -fr $item 2>/dev/null");
    }
    return(&ade_tmp_deregisterallfile($errstack_ref));
}

sub _ade_tmp_funcup
{
    my($errstack_ref) = @_;
    my($item);

    &ade_err_debug($errstack_ref, 4, "_ade_tmp_funcup: sof");
    foreach $item (keys %{$ade_gep_delonexit{callonexit}}) {
        &$item;
    }
    return(&ade_tmp_deregisterallfunc($errstack_ref));
}

sub _ade_mua_loadtimechecks
{
    my($errstack_ref) = @_;

    ##  Allow environment override
    #$ENV{'SENDMAIL_CMD'} && ($sendmail_cmd = $ENV{'SENDMAIL_CMD'});
    
    #  Sanity check setting
    if ($sendmail_cmd && $sendmail_cmd !~ /^\//) {
        &ade_err_error($errstack_ref, ade_err_misc, "sendmail command ($sendmail_cmd) is not absolute");
        return($ade_err_fail);
    } elsif ($sendmail_cmd && ! -x $sendmail_cmd) {
        &ade_err_error($errstack_ref, ade_err_misc, "can't execute $sendmail_cmd");
        return($ade_err_fail);
    } elsif ($sendmail_cmd) {
        ;
    } elsif (! $ENV{'SMTPSERVER'}) {
        &ade_err_error($errstack_ref, ade_err_misc, "no deliver method available, define SENDMAIL_CMD or SMTPSERVER");
        return($ade_err_fail);
    }
}


END { }       # module clean-up code here (global destructor)

## YOUR CODE GOES HERE

&_ade_gep_loadtimechecks(undef);
&_ade_fcm_loadtimechecks(undef);
&_ade_msg_loadtimechecks(undef);
&_ade_mua_loadtimechecks(undef);

1;
