#  $HeadURL$ $LastChangedRevision$

#  Name of this package
package ADE;

#  Packages required by this package
use strict;
no strict 'subs'; 				#  Allow bare words, so &ade_err_error() calls look nicer.
use warnings;
no warnings qw(once); 				#  Duplicating file handles makes causes only used once' warning
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;

#  Declare exports
BEGIN {
    use Exporter   ();
    our (@ISA, @EXPORT);
    @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_internal ade_err_error ade_msg_usage $ade_app_progname ade_fnm_basename ade_fnm_makeabsolute stupid_error_in_ade_space ade_err_registerdefderrs %ade_defined_errors ade_fcm_openwritecompressed ade_fcm_openreadcompressed ade_msg_version ade_smf_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 ade_spc_procopts ade_std_true ade_std_false ade_err_instack);
}

END { 
}       

#  Instantiate exported data
our($ade_err_ok, $ade_err_fail);
our($ade_tmp_dir);
our($ade_app_progname);

#  Initialise exported data
($ade_err_ok, $ade_err_fail) = (0, 1);
$ade_tmp_dir = defined($ENV{TMP_DIR}) ? $ENV{TMP_DIR} : "/var/tmp";
($ade_app_progname) = ($0 =~ /.*\/([^\/]*)$/);

#  Instantiate private data
my($sendmail_cmd, %ade_defined_errors);
my(@ade_registered_defined_errors_hash_refs_array);
my($ade_err_dumpwholestack, $ade_msg_writer_logfile_filename, @ade_err_writerfunc_refs);
my(%ade_registers);
my($ade_msg_verboselevel);

#  Initialise private data 
#  This could be moved inside ade-config.sh
$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.
%ade_defined_errors = (
    ade_err_undefined       => { fmt => "%s: undefined %s" },
    ade_err_access          => { fmt => "%s: can't %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_notimplemented  => { fmt => "%s: not implemented" },
);
#  ADE can deal with the follow errors (initial none)
@ade_registered_defined_errors_hash_refs_array = ();
$ade_err_dumpwholestack = 1;
$ade_msg_writer_logfile_filename = undef;
@ade_err_writerfunc_refs = (\&_ade_msg_writer_stderr);
%ade_registers = ();
$ade_msg_verboselevel = 2;

##############################################################################
#
#  PUBLIC FUNCTIONS/ENTRY FUNCTIONS
#
##############################################################################

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

    #  Initialise a stack.
    &ade_err_resetstack($errstack_ref, stack=>$errstack_ref, dumpall=>1);

    #  Perform initialisation that requires an error stack. These calls continue
    #  but do not do later calls, so as to be sure to display the stack and
    #  exit correctly.
    $rc = &_ade_gep_initialise_with_stack($errstack_ref);

    #  Call the application (but only if the above calls succeeded.
    if ($rc == $ade_err_ok) {
        $rc = &_ade_gep_main_withstack($errstack_ref, $app_main_ref);
    }

    if ($rc != $ade_err_ok) {
        &ade_err_displaystack($errstack_ref);
        &ade_err_resetstack($errstack_ref, 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);
}

##############################################################################
#
#  PUBLIC FUNCTIONS/ERROR STACK FUNCTIONS
#
##############################################################################

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

    #  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, $instack_flagref) = @_;
    my($i, $framecount);
   
    #  Facilitate doing it the C way with '<' in the 'for' loop instead of '<='.
    $framecount = $#{$errstack_ref}+1;
    #  Assume not found to proved otherwise.
    ${$instack_flagref} = undef;
    #  Scan the stack for the error
    for ($i=0; $i<$framecount; $i++) {
        if (${$errstack_ref}[$i]{err} eq $err) {
            ${$instack_flagref} = $i;
        }
    }

    return($ade_err_ok);
}

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++) {
        #  Skip all but the top frame if requested so to do
        next if ($i != 0 && !$ade_err_dumpwholestack);

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

        #  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}}));
        }
        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");
        }
        $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}});
        if ($number_of_percent_signs_in_format != $number_of_parameters_supplied) {
            &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)");
        }

        #
        #   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);
}

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

    &_ade_err_displayinternal($errstack_ref, $message);
    &_ade_gep_exit($errstack_ref, 5);
}

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($errstack_ref, 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));
}

##############################################################################
#
#  PUBLIC FUNCTIONS/MESSAGING FUNCTIONS
#
##############################################################################

sub ade_msg_usage
{
    my($errstack_ref, $text_generator_funcref, $exit_code) = @_;
   
    #print "ade_msg_usage: sof\n";

    if ($exit_code != 0) {
        print STDERR "$ade_app_progname: ERROR: type '$ade_app_progname --help' for correct usage.\n";

    } else {
        print "Usage:   $ade_app_progname [ <options> ] ";
        &$text_generator_funcref($errstack_ref, 1);
        print "\n";
        print "Options: -V        | --version               display program version\n";
        print "         -v        | --verbose               verbose\n";
        print "         -d        | --debug=<level>         set debug level\n";
        print "         -h        | --help                  display this text\n";
        print "         -p        | --list-paths            list used paths\n";
        print "         -f <file> | --config-file=<file>    load alternative config file\n";
        &$text_generator_funcref($errstack_ref, 2);
        print "\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);

    #  The shell equivalent checks that $version_returner_funcref is a function here. But
    #  out of laziness I've not done that yet here.

    if (($rc=&$version_returner_funcref($errstack_ref, \$version)) != $ade_err_ok) {
        &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) {
        &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);
}
   
#  Deliberately commented out but left in!
#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);
#}

#  Very very few programs actually need to know the verbosity level themselves;
#  mostly they just get ADE to display messages for them, knowing that ADE will
#  decide whether to display the message or not on their behalf, but *some*
#  programs will need to know. But $ade_msg_verboselevel is to be
#  considered private to ADE, so we need to provide a public function to 
#  read it.

sub ade_msg_getverboselevel
{
    my ($errstack_ref, $verboselevel_ref) = @_;

    ${$verboselevel_ref} = $ade_msg_verboselevel;

    return($ade_err_ok);
}

##############################################################################
#
#  PUBLIC FUNCTIONS/MATHS FUNCTIONS
#  
##############################################################################

sub ade_mth_minimum
{
    my($errstack_ref, $a, $b, $returnval_ref) = @_;
  
    ${$returnval_ref} = (($a<$b)?$a:$b);

    return($ade_err_ok);
}

###############################################################################
#
#  PUBLIC FUNCTIONS/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));
}

###############################################################################
#
#  PUBLIC FUNCTIONS/STANDARDIZED COMMANDS
#
###############################################################################

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

    return($ade_err_ok);
}

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

    &ade_err_error($errstack_ref, ade_err_misc, "false-forced error");

    return($ade_err_fail);
}

sub ade_std_which
{
    my ($errstack_ref, $program, $return_value_ref) = @_;
    my ($dir, $found);

    if ($program =~ /^\// && -f $program && -x $program) {
        ${$return_value_ref} = $program;
    } elsif ($program =~ /^\//) {
        &ade_err_error($errstack_ref, ade_err_access, $program, "find");
        return($ade_err_fail);
    } else {
        $found = 0;
        foreach $dir (split(/:/, $ENV{'PATH'})) {
            if (-f "$dir/$program" && -x "$dir/$program") {
                ${$return_value_ref} = "$dir/$program";
                $found = 1;
                last;
            }
        }
        if (!$found) {
            &ade_err_error($errstack_ref, ade_err_access, $program, "find");
            return($ade_err_fail);
        }
    }

    return($ade_err_ok);
}

###############################################################################
#
#  PUBLIC FUNCTIONS/STRING MANIPULATION FUNCTIONS
#
###############################################################################

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

    &ade_err_debug($errstack_ref, 50, "ade_smf_extractversionfromsvnstring: sof (svnstring=$svnstring)");
    $svnstring =~ m@\$HeadURL: .*?/(trunk|tags/([^/]+)|branches/([^/]+))/.*?\$ \$LastChangedRevision: (\d+) \$@;
    #&ade_err_debug($errstack_ref, 50, "ade_smf_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_smf_extractversionfromsvnstring: handling of \"$1\" not implemented yet");
    }

    return($ade_err_ok);
}

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);
}

###############################################################################
#
#  PUBLIC FUNCTIONS/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);
}

##############################################################################
#
#  PUBLIC FUNCTIONS/DIRECTORY CONTENT MANIPULATION
#
##############################################################################

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_access, $srcname, "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);
}

###############################################################################
#
#  PUBLIC FUNCTIONS/USER-RELATED
#
###############################################################################

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) = @_;
    my($rc, $gunzip_cmd, $uncompress_cmd);

    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 (($rc=&ade_std_which($errstack_ref, 'gunzip', \$gunzip_cmd)) != $ade_err_ok) {
            return($rc);
        } elsif (!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 (($rc=&ade_std_which($errstack_ref, 'uncompress', \$uncompress_cmd)) != $ade_err_ok) {
            return($rc);
        } elsif (!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) = @_;
    my($rc, $gzip_cmd, $compress_cmd);

    if ($filename =~ /^.*\.gz$/) {
        if (($rc=&ade_std_which($errstack_ref, 'gzip', \$gzip_cmd)) != $ade_err_ok) {
            return($rc);
        } elsif (!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 (($rc=&ade_std_which($errstack_ref, 'compress', \$compress_cmd)) != $ade_err_ok) {
            return($rc);
        } elsif (!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);
}

###############################################################################
#
#  PUBLIC FUNCTIONS/LOCKING
#
###############################################################################

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)");
    }
    
    if (!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);
}

##############################################################################
#
#  PUBLIC FUNCTIONS/SPECIAL
#
##############################################################################

sub ade_spc_procopts
{
    my($errstack_ref, $app_listpaths_funcref, $app_usage_funcref, $app_version_funcref, $config_hasharray_ref, $hash_of_option_handlers_ref) = @_;
    my($key, $old_sigwarn_handler, $i, %hash_of_option_handlers, $listpaths_flag);

    #
    #  Unset everything.
    #
    #  (This function needs to be re-entrant;it can be called when the
    #  program starts, but it can also be called when SIGHUP is recieved.)
    #

    for ($i=0; $i<=$#{$config_hasharray_ref}; $i++) {
        undef ${${$config_hasharray_ref}[$i]{var}};
    }

    #
    #  Some options can be handled only once we have processed all other options
    #

    $listpaths_flag = 0;

    %hash_of_option_handlers = (
        #  Standard opts
        "V|version"       => sub { &ade_msg_version($errstack_ref, $app_version_funcref); },
        "v|verbose"       => sub { &ade_err_resetstack($errstack_ref, level=>3); },
        "d|debug=i"       => sub { &ade_err_resetstack($errstack_ref, level=>$_[1]); },
        "h|help"          => sub { &ade_msg_usage($errstack_ref, $app_usage_funcref, 0); },
        "p|list-paths"    => \$listpaths_flag,
        "f|config-file"   => sub { &ade_err_error($errstack_ref, ade_err_notimplemented, "support for -f/--config-file option"); return($ade_err_fail); },
        #  Application specific opts
        %{$hash_of_option_handlers_ref}
    );

    #
    #  Process command line options (top priority).
    #

    #  Redirect GetOptions's alerts to our alerter.
    $old_sigwarn_handler = $SIG{'__WARN__'};
    $SIG{'__WARN__'} = sub { &ade_msg_usage($errstack_ref, $app_usage_funcref, 1); };
    Getopt::Long::GetOptions(%hash_of_option_handlers);
    $SIG{'__WARN__'} = $old_sigwarn_handler;

    #
    #  Assign defaults (third priority therefore done third)
    #

    for ($i=0; $i<=$#{$config_hasharray_ref}; $i++) {
        #print "examining ${${$config_hasharray_ref}[$i]}{dsc} ...\n";
        #  Skip using default if variable already has value
        next if (defined(${${$config_hasharray_ref}[$i]{var}}));
        #  Skip using default if there is no default!
        next if (!defined(${$config_hasharray_ref}[$i]{dfl}));
        #  Use default
        ${${$config_hasharray_ref}[$i]{var}} = ${$config_hasharray_ref}[$i]{dfl};
    }

    #
    #  Derivations
    #
    #  Some values depend on others. Work those out now.
    #
    #  Note that the order in which they are worked out is important
    #  (e.g. mail_log_dir needs to be determined *before* mail_log_file
    #  because if the second is not absolute then the first is used as
    #  a prefix). Hence the 'sort' and 'if (key is ...) elsif (key is ..)'
    #

#    foreach $key (sort { if (!defined($a{pri})) { return($ade_err_fail); } elsif (!defined($b{pri})) { return(-1); } else { return ($a{pri} <=> $b{pri}); }} @{$config_hasharray_ref}) {
#        &ade_err_debug($errstack_ref, 10, "load_options_and_config_file: key: $key");
#        if ($key =~ /mail_retr_port/ && !defined(${$confighash_map{$key}{var}})) {
#            ${$confighash_map{$key}{var}} = (${$confighash_map{mail_retr_method}{var}} eq "IMAP")
#? 143 : 110;
#        } elsif ($key =~ /mail_retr_(username|password)/ && !defined(${$confighash_map{$key}{var}}) && ${$confighash_map{mail_retr_authenticate}{var}} eq "NONE") {
#            #  Put dummy text in so that the 'is everything set?' test below passes.
#            #  Put dummy text in so that the 'is everything set?' test below passes.
#            ${$confighash_map{$key}{var}} = "unused";
#        } elsif ($key =~ /mail_send_(username|password)/ && !defined(${$confighash_map{$key}{var}}) && ${$confighash_map{mail_send_authenticate}{var}} eq "NONE") {
#            #  Put dummy text in so that the 'is everything set?' test below passes.
#            ${$confighash_map{$key}{var}} = "unused";
#        } elsif ($key =~ /mail_.*_dir/) {
#            #  If a directtory specification is not absolute, make it so.
#            ${$confighash_map{$key}{var}} =~ s/^(?!\/)/getcwd."\/"/e;
#        } elsif ($key =~ /mail_lock_file/) {
#            #  If lock file not absolute, make it so.
#            ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$lock_dir\//;
#        } elsif ($key =~ /mail_log_file/) {
#            #  If log file not absolute, make it so.
#            ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$log_dir\//;
#        } elsif ($key =~ /mail_(retr|send)_mbox_file/) {
#            #  If log file not absolute, make it so.
#            ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$log_dir\//;
#        } elsif ($key =~ /mail_(status|stats_archive)_table/) {
#            #  If status table not absolute, make it so.
#            ${$confighash_map{$key}{var}} =~ s/^(?!\/)/$state_dir\//;
#        }
#    }

    #
    #  Handle list paths option only now we have all relevent info. (Do this *before*
    #  we check everything now set, as we want to print paths even if enough info
    #  for doing *other* stuff has not been supplied.)
    #
    
    &ade_msg_listpaths($errstack_ref, $app_listpaths_funcref) if ($listpaths_flag);

    #
    #  Verify that everything is now set.
    #

    for ($i=0; $i<=$#{$config_hasharray_ref}; $i++) {
        next if (defined(${${$config_hasharray_ref}[$i]{var}}));
        &ade_err_error($errstack_ref, ade_err_undefined, ${$config_hasharray_ref}[$i]{dsc}, "configuration parameter");
        return($ade_err_fail);
    }

    #
    #  Miscellaneous sanity checks
    #

#    if (!$retr_interval && !$send_interval && !$stat_interval) {
#        &ade_err_error($errstack_ref, ade_err_config, "retrieve, send and stat intervals are all zero!");
#        return($ade_err_fail);
#    }

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

    return($ade_err_ok);
}

#  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);

    &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.
        if (!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");
        }
        &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 ...");
        if (!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.
                if (!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)) {
                if (!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.
        if (!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;
        if (!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);
}

##############################################################################
#
#  PUBLIC FUNCTIONS/MAIL
#
##############################################################################

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, $rc);

    # 
    #  Catch relative and unexecutable sendmail. (Previously these were done at start-time, not
    #  at when-sendmail-actually-needed-time, but this presents problems to users - e.g. Thomas -
    #  who don't have sendmail and don't want it and won't write programs that use it.
    #

    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);

    #
    #  If sendmail command defined then use it.
    #

    } elsif ($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_access, "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.
    #

    } else {
        &ade_err_error($errstack_ref, ade_err_misc, "no deliver method available");
        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 ($header_name !~ /^(?:From|Reply-To|Date|Subject|Received|Keywords|X-Newsreader|Summary|Distribution|Message-Id|Return-Path|Newsgroups|References)$/) {
            $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);
}

###############################################################################
#
#  PRIVATE FUNCTIONS 
#
###############################################################################

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_misc, "failed to determine 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_misc, "application's entry function failed");
        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($errstack_ref, 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_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}));
    }
    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");
    }
    
    return($ade_err_ok);
}

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

    #  Don't bother continuing if the message is not sufficiently important.
    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) {
        &$writerfunc_ref($errstack_ref, $template);
    }

    return($ade_err_ok);
}

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

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

    return($ade_err_ok);
}

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

    #  Delete all the specified items from the specified list.
    foreach $item (@items) {
        delete $ade_registers{$listname}{$item};
    }

    return($ade_err_ok);
}

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);

    foreach $item (keys %{$ade_registers{$listname}}) {
        &_ade_tmp_deregister($errstack_ref, $listname, $item);
    }

    return($ade_err_ok);
}

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

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

    #  Avoid 'shell-init: error retrieving current directory'
    chdir("/");

    foreach $item (keys %{$ade_registers{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.
        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, 40, "_ade_tmp_funcup: sof");
    foreach $item (keys %{$ade_registers{callonexit}}) {
        &$item;
    }
    return(&_ade_tmp_deregisterallfunc($errstack_ref));
}

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

    return(&_ade_msg_message($errstack_ref, 3, "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));
}

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);
}

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

    return($ade_err_ok);
}

#  This should only be stuff guaranteed to succeed.
sub _ade_gep_initialise_without_stack
{
    #  CDPATH causes all sorts of trouble!
    delete($ENV{'CDPATH'});
    
    #  ADE will always use $ade_tmp_dir and it makes this available to clients.
    if ($ENV{'TMPDIR'} && -d $ENV{'TMPDIR'}) {
        $ade_tmp_dir = $ENV{'TMPDIR'};
    } elsif ($ENV{'TMP_DIR'} && -d $ENV{'TMP_DIR'}) {
        $ade_tmp_dir = $ENV{'TMP_DIR'};
    } elsif (-d '/var/tmp') {
        $ade_tmp_dir = '/var/tmp';
    }

    #  There is no point in passing an error stack to ade_err_registerdefderrs(), 
    #  because if it failed then it cannot report the error since no error formats
    #  have been successfully register.
    &ade_err_registerdefderrs(\%ade_defined_errors);

    #  Set up auto-clean-up.
    $SIG{HUP}  = \&_ade_gep_signalhandler;
    $SIG{INT}  = \&_ade_gep_signalhandler;
    $SIG{TERM} = \&_ade_gep_signalhandler;

    #  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_registers{callonexit}}, 'Tie::RefHash';
}

##############################################################################
#
#  CODE
#
##############################################################################

&_ade_gep_initialise_without_stack;
#  Initialisation which requires a stack will be done inside ade_gep_main.

##############################################################################
#
#  NON-ZERO MODULE EXIT CODE
#
##############################################################################

1;
