#  $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;
use IO::Handle;					#  for (auto)flushing handles
use Sys::Syslog qw(:standard :macros);          #  for syslog()
use Getopt::Long;				#  for ...
Getopt::Long::Configure ("bundling");		#  immediately enable bundling (i.e. '-vax' is allowed and the same as '-v -a -x')
use POSIX ":sys_wait_h";              		#  to support reaper(); see waitpid(perldoc)
use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRUSR S_IWUSR);

#  Declare exports
BEGIN {
    use Exporter   ();
    our (@ISA, @EXPORT);
    @ISA         = qw(Exporter);
    #  Note the recently added underscored functions _ade_msg_writer_*. This is because
    #  applications may wish to change how messages are displayed via a ade_err_resetstack()
    #  call.
    @EXPORT      = qw(ade_lck_lock ade_lck_unlock ade_lck_checklock ade_lck_getgenericlockfilename 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_tmp_registerfunc ade_tmp_deregisterfunc 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_std_true ade_std_false ade_err_instack ade_msg_askquestion ade_smf_validate_float ade_smf_validate_integer _ade_msg_writer_stderr _ade_msg_writer_logfile _ade_msg_writer_syslog _ade_msg_writer_null ade_opt_register ade_msg_register ade_opt_process ade_spc_multifork);
}

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_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, $ade_msg_writer_syslog_priority, $ade_msg_writer_syslog_facility);
my(%ade_registers, %ade_registered_opt, @ade_registered_opts);
my($ade_msg_verboselevel);
my($ade_app_usage_text_getter_ref, $ade_app_version_text_getter_ref, $ade_app_listpaths_text_getter_ref);
my($ade_opt_want_to_show_paths, $ade_opt_want_to_show_usage, $ade_opt_want_to_show_version);

#  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_eof             => { fmt => "%s: end of file" },
    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_registered_opt = ();
@ade_registered_opts = ();
($ade_app_usage_text_getter_ref, $ade_app_version_text_getter_ref, $ade_app_listpaths_text_getter_ref) = (undef, undef, undef);

##############################################################################
#
#  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, incredibly, 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 "facility") {
            $ade_msg_writer_syslog_facility = $parameters{$key};
        } elsif ($key eq "priority") {
            $ade_msg_writer_syslog_priority = $parameters{$key};
        } 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) = @_;

    #  The error frames on the stack may be relevant to solving the
    #  problem, so dump them.
    &ade_err_displaystack($errstack_ref);

    &_ade_err_displayinternal($errstack_ref, $message);
    exit(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_register
{
    my($errstack_ref, $usage_text_getter_ref, $version_text_getter_ref, $listpaths_text_getter_ref) = @_;
    my($func_ref, $subref);

    $ade_app_usage_text_getter_ref = $usage_text_getter_ref;
    $ade_app_version_text_getter_ref = $version_text_getter_ref;
    $ade_app_listpaths_text_getter_ref = $listpaths_text_getter_ref;

    foreach $func_ref ($ade_app_usage_text_getter_ref, $ade_app_version_text_getter_ref, $ade_app_listpaths_text_getter_ref) {
        if (!($subref = &_ade_opt_function_exists($func_ref))) {
            &ade_err_internal($errstack_ref, "ade_msg_register: one of usage/version/listpaths: not a function");
        }
    }

    return $ade_err_ok;
}


sub ade_msg_usage
{
    my($errstack_ref, $exit_code) = @_;
    $exit_code = 1 if (!defined($exit_code));
    my($rc, $usage_pass1_text, $usage_pass2_text);
   
    #  Call callbacks to get text into USAGE_PASS1_TEXT and USAGE_PASS1_TEXT
    if (($rc=&$ade_app_usage_text_getter_ref($errstack_ref, \$usage_pass1_text, 1)) != $ade_err_ok) {
        return $rc;
    }
    if (($rc=&$ade_app_usage_text_getter_ref($errstack_ref, \$usage_pass2_text, 2)) != $ade_err_ok) {
        return $rc;
    }

    if ($exit_code) {
        print STDERR "$ade_app_progname: ERROR: type '$ade_app_progname --help' for correct usage.\n";
    } else {
        print "Usage:   $ade_app_progname [ <options> ] ";
        if (defined($usage_pass1_text)) {
            chomp($usage_pass1_text);
            print "$usage_pass1_text\n";
        }
        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";
        if (defined($usage_pass2_text)) {
            chomp($usage_pass2_text);
            print "$usage_pass2_text\n";
        }
        print "\n";
    }

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

sub ade_msg_version
{
    my($errstack_ref) = @_;
    my($version_text, $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=&$ade_app_version_text_getter_ref($errstack_ref, \$version_text)) != $ade_err_ok) {
        return $rc;
    }

    if (defined($version_text)) {
        chomp($version_text);
        print "$ade_app_progname version $version_text\n" 
    }

    &_ade_gep_exit($errstack_ref, 0);
}
   

sub ade_msg_listpaths
{
    my($errstack_ref) = @_;
    my($listpaths_text, $rc);

    if (($rc=&$ade_app_listpaths_text_getter_ref($errstack_ref, \$listpaths_text)) != $ade_err_ok) {
        return $rc;
    }

    if (defined($listpaths_text)) {
        chomp($listpaths_text);
        print "$listpaths_text\n";
    }

    &_ade_gep_exit($errstack_ref, 0);
}
   
#  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);
}

sub ade_msg_askquestion
{
    my($errstack_ref, $hint, $prompt, $default, $validate_fnc, $rationalise_fnc, $rationalised_response_ref) = @_;
    my($response, $rc, $validated);

    if (defined($hint)) {
        &ade_err_debug($errstack_ref, 20, "ade_msg_askquestion: hint is defined; displaying ...");
        print "$hint\n";
    }

    while (1) {
        print "$ade_app_progname: QUESTION: $prompt [$default]: ";
        #  If this an error occurs below (e.g. 'cos user hits CTRL-D and this function
        #  returns ade_err_eof) then the error output will arrive *before* the text 
        #  printed above. This is due to it not having a new line and the output being
        #  buffered. To avoid this confusion we flush immediately. This uses IO::Handle.
        STDOUT->flush();
        $response = <STDIN>;
        if (!defined($response)) {
            &ade_err_error($errstack_ref, ade_err_eof, "stdin");
            return($ade_err_fail);
        }
        chomp($response);
        ($response eq '')  && ($response = $default);
        ($response eq '.') && ($response = '');
        &ade_err_debug($errstack_ref, 20, "ade_msg_askquestion: \$response=[$response]");
        if (($rc=&$validate_fnc($errstack_ref, $response, \$validated)) != $ade_err_ok) {
            return($rc);
        } elsif ($validated) {
            last;
        }
        &ade_err_warning($errstack_ref, iofdb_err_misc, "invalid response; please retry");
    }

    if (!defined($rationalise_fnc)) {
        ${$rationalised_response_ref} = $response;
    } elsif (($rc=&$rationalise_fnc($errstack_ref, $response, $rationalised_response_ref)) != $ade_err_ok) {
        return($rc);
    } 

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

    &ade_err_debug($errstack_ref, 50, "ade_smf_extractversionfromsvnstring: sof (svnstring=\"$svnstring\")");
    #  Note that a 'svn mv' will result in LastChangedRevision being '-1' until it is commited.
    if ($svnstring !~ m@\$HeadURL: .*?/(trunk|tags/([^/]+)|branches/([^/]+))/.*?\$ \$LastChangedRevision: (-?\d+) \$@) {
        &ade_err_internal($errstack_ref, "ade_smf_extractversionfromsvnstring: failed to match");
    }
   
    #  We have to be a bit careful here: for reason I don't understand, if we reference and $2 and $2 has not
    #  been set by the above code (e.g. for trunk) then a debug statement saying;
    #
    #      &ade_err_debug($errstack_ref, 50, "ade_smf_extractversionfromsvnstring: 1=$1, 2=$2, 3=$3, 4=$4");
    #
    #  results in this function returning non-zero; I'm not sure why it doesn't just bomb out. 
    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);
}

sub ade_smf_validate_float
{
    my($errstack_ref, $value, $validated_ref) = @_;
    
    #  ABC.DEF (where A is 1-9)
    #  0.DEF
    #  .DEF
    #  ABC (where A is 1-9)
    #  0

    ${$validated_ref} = ($value =~ /^[1-9][0-9]*\.[0-9]+$/ || 
                         $value =~ /^0?\.[0-9]+$/ ||
                         $value =~ /^[1-9][0-9]*$/ ||
                         $value =~ /^0$/);

    return($ade_err_ok);
}


sub ade_smf_validate_integer
{
    my($errstack_ref, $value, $validated_ref) = @_;
    
    #  ABC (where A is 1-9)
    #  0

    ${$validated_ref} = ($value =~ /^[1-9][0-9]*$/ ||
                         $value =~ /^0$/);

    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 ($errstack_ref, $id_ref) = @_;

    ${$id_ref} = (getpwuid($<))[0];

    return($ade_err_ok);
}

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);
    $tmp_lock_file = $lock_file . ".$$";
    &ade_err_debug($errstack_ref, 10, "ade_lck_lock: \$lock_file=$lock_file, \$tmp_lock_file=$tmp_lock_file");

    #  assign the lock text
    $lock_text = $$;

    #  create temporary lock (world readable)
    &ade_err_debug($errstack_ref, 10, "ade_lck_lock: creating temporary lock ...");
    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 ...");
    #  Don't register the actual lock file for cleanup purposes yet, as it may exist and below
    #  to someone else!
    if (link($tmp_lock_file, $lock_file) == 1) {
        &ade_tmp_registerfile($errstack_ref, $lock_file);
        unlink $tmp_lock_file;
        &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file);
        return($ade_err_ok);
    }

    #  Check who is locking us out.
    &ade_err_debug($errstack_ref, 20, "ade_lck_lock: calling ade_lck_checklock() to see who's locking us out ...");
    if (($rc=&ade_lck_checklock($errstack_ref, $lock_file, \$holding_pid, \$running_flag)) != $ade_err_ok) {
        &ade_err_debug($errstack_ref, 20, "ade_lck_lock: ade_lck_checklock failed");
        return($rc);
    }
    &ade_err_debug($errstack_ref, 20, "ade_lck_lock: \$holding_pid=$holding_pid, \$running_flag=$running_flag");
    if ($running_flag) {
        &ade_err_debug($errstack_ref, 20, "ade_lck_lock: we're locked out by running process; returning ...");
        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);
    }

    #  Remove stale lock
    &ade_err_info($errstack_ref, "removing stale lock ...");
    unlink($lock_file);

    #  Try to lock 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) {
        &ade_tmp_registerfile($errstack_ref, $lock_file);
        unlink($tmp_lock_file);
        &ade_tmp_deregisterfile($errstack_ref, $tmp_lock_file);
        return($ade_err_ok);
    }

    #  If get here then 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, $lock_file, $pid_ref, $runningflag_ref) = @_;

    #  Assume not running as default.  
    ${$runningflag_ref} = 0;

    #  If no lock file, nothing more to do.
    if (! -e $lock_file) {
        return($ade_err_ok);
    }

    #  If lock file exists but is not a file then error.
    if (! -f $lock_file) {
        &ade_err_error($errstack_ref, ade_err_misc, "$lock_file: not a file");
        return($ade_err_fail);
    }

    #  Extract PID from lockfile
    if (!open(LOCK_HANDLE, $lock_file)) {
        &ade_err_error($errstack_ref, ade_err_access, $lock_file, "open");
        return($ade_err_fail);
    }

    #  Pass lock file and *not* running; we'll overrule those if needed shortly.
    ${$pid_ref} = <LOCK_HANDLE>;
    close(LOCK_HANDLE);
    chop(${$pid_ref});

    #  If invalid lockfile then return (and accept default "not running" setting above).
    if (${$pid_ref} !~ /^[1-9]\d*$/) {
        return($ade_err_ok);
    }

    #  If no PID dir (and allow for 5-digit-padding) return (and accept ...).
    if (! -d "/proc/${$pid_ref}" && ! -d sprintf("%05d", ${$pid_ref})) {
        return($ade_err_ok);
    }

    #  If we get this far then it is running so note that.
    ${$runningflag_ref} = 1;

    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/OPTION-PROCESSING
#
##############################################################################

sub _ade_opt_function_exists {
    no strict 'refs';
    my $funcname = shift;
    return \&{$funcname} if defined &{$funcname};
    return;
}

sub ade_opt_register
{
    my($errstack_ref, $short_opts, $long_opts, $opt_func_template) = @_;
    my($opt_type, $opts, $opt, $re, $opt_suff, $opt_argc, $opt_argt, $opt_func, $subref, $dollar_2);

    $opt_func_template = "option_handler_%s" if (not defined $opt_func_template);

    &ade_err_debug($errstack_ref, 10, sprintf("ade_opt_register: short_opts=%s, long_opts=%s, opt_func_template=%s", defined($short_opts) ? $short_opts : "undef", defined($long_opts) ? $long_opts : "undef", defined($opt_func_template) ? $opt_func_template : "undef"));

    #  Register the shorts and then the longs
    foreach $opt_type ("short", "long") {
        if ($opt_type eq "short") {
            $opts = $short_opts;
            $re='^([a-zA-Z])(:[siof])?(.*)$'
        } else {
            $opts = $long_opts;
            $re='^([a-zA-Z][-a-zA-Z0-9]+)(:[siof])?,?(.*)$'
        }
        #  Allow caller so specify undef.
        next if (!defined($opts));
        &ade_err_debug($errstack_ref, 10, "ade_opt_register: opt_type=$opt_type, opts=$opts, re=$re");
        while ($opts =~ /$re/) {
            $opt = $1;
            #  Captures in regexps that capture nothing are undefined not blank. Fix for ease of use.
            $dollar_2 = defined($2) ? $2 : "";
            $opt_argc = ($dollar_2 eq "") ? 0 : 1;
            #  Get the character after the colon
            $opt_argt = (split(//, $dollar_2))[1];
            #  Remaining opts are here
            $opts = $3;
            #  These substitutions reset $1, etc. So finish using $1, etc first.
            $opt_suff = $opt; $opt_suff =~ s/-/_/g;
            $opt_func = $opt_func_template; $opt_func =~ s/%s/$opt_suff/g;
            &ade_err_debug($errstack_ref, 10, sprintf("ade_opt_register: opt=%s, opt_suff=%s, opt_argc=%s, opt_argt=%s, opt_func=%s, opts=%s", map { defined($_) ? $_ : "undef" } ($opt, $opt_suff, $opt_argc, $opt_argt, $opt_func, $opts)));
            if (!($subref = &_ade_opt_function_exists($opt_func))) {
                &ade_err_error($errstack_ref, ade_err_undefined, $opt_func, "function");
                return($ade_err_fail);
            }
            &ade_err_debug($errstack_ref, 10, "ade_opt_register: registering callback $opt_func for $opt_type option '$opt' ...");
            #  Map <short-opt>  to (<handler-function>, <count-of-args-to-pass>, <colon-or-nothing>)
            #  (The <colon-or-nothing> will help when constructing the list of accepted options in
            #  the format that the normal getopt command wants - i.e. <opt><colon> or <opt>).
            #  Bash version 3 doesn't support hashes so use "eval VAR_SUFFIX" trick.
            $ade_registered_opt{$opt_suff} = [$opt_type, $subref, $opt_argc, $opt_argt];
            #  In addition, store the short option in an array with a fixed name,
            #  this will make it easier to process later.
            push(@ade_registered_opts, $opt);
        }
    }

    return($ade_err_ok);
}
 
sub ade_opt_process
{
    my($errstack_ref) = @_;
    my($new_dollar_at_ref, $opt, $opt_suff, $opt_type, $opt_func, $opt_argc, $opt_argt, $short_opts, $long_opts, $reordered_dollar_at, $found, %opt_hash);
    my($old_sigwarn_handler, $rc);

    #  Collect all the short options and long options together in format suitable for getopts.
    &ade_err_debug($errstack_ref, 10, "ade_opt_process: assembling hash ...");
    foreach $opt (@ade_registered_opts) { 
        &ade_err_debug($errstack_ref, 10, "ade_opt_process: assembling hash entry for $opt ...");
        $opt_suff = $opt; $opt_suff =~ s/-/_/g;
        $opt_type = $ade_registered_opt{$opt_suff}[0];
        $opt_func = $ade_registered_opt{$opt_suff}[1];
        $opt_argc = $ade_registered_opt{$opt_suff}[2];
        $opt_argt = $ade_registered_opt{$opt_suff}[3];
        &ade_err_debug($errstack_ref, 10, sprintf("ade_opt_process: opt=%s, opt_suff=%s, opt_argc=%s, opt_argt=%s, opt_func=%s", map { defined($_) ? $_ : "undef" } ($opt, $opt_suff, $opt_argc, $opt_argt, $opt_func)));
        if ($opt_argc == 0) {
            $opt_hash{$opt} = $opt_func;
        } elsif ($opt_argc == 1) {
            $opt_hash{"$opt=$opt_argt"} = $opt_func;
        } else {
            &ade_err_internal($errstack_ref, "ade_opt_process: internal error");
        }
    }

    #  Redirect GetOptions's alerts to our alerter.
    &ade_err_debug($errstack_ref, 10, "ade_opt_process: calling GetOptions ...");
    $old_sigwarn_handler = $SIG{'__WARN__'};
    $SIG{'__WARN__'} = sub { &ade_msg_usage($errstack_ref); };
    Getopt::Long::GetOptions(%opt_hash);
    $SIG{'__WARN__'} = $old_sigwarn_handler;

    &ade_err_debug($errstack_ref, 10, "ade_opt_process: checking whether to call message handlers ...");
    &ade_err_debug($errstack_ref, 10, "ade_opt_process: ade_opt_want_to_show_paths=$ade_opt_want_to_show_paths, ade_opt_want_to_show_usage=$ade_opt_want_to_show_usage, ade_opt_want_to_show_version=$ade_opt_want_to_show_version");

    if ($ade_opt_want_to_show_paths) {
        $rc = &ade_msg_listpaths($errstack_ref);
        &ade_err_internal($errstack_ref, "ade_opt_process: ade_msg_listpaths() unexpectedly returned (rc=$rc)");
    }
    if ($ade_opt_want_to_show_usage) {
        $rc = &ade_msg_usage($errstack_ref, 0);
        &ade_err_internal($errstack_ref, "ade_opt_process: ade_msg_usage() unexpectedly returned (rc=$rc)");
    }
    if ($ade_opt_want_to_show_version) {
        $rc = &ade_msg_version($errstack_ref);
        &ade_err_internal($errstack_ref, "ade_opt_process: ade_msg_version() unexpectedly returned (rc=$rc)");
    }

    return($ade_err_ok);
}

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

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

        #  The temporary snapshot file has been preserved under a proper name, so 
        #  we no longer need to delete it.
        &ade_tmp_deregisterfile($errstack_ref, $newest_status_file);
    }

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

    #  For checks without a schedule file we can now delete the temporary snapshot.
    unlink($newest_status_file);
    &ade_tmp_deregisterfile($errstack_ref, $newest_status_file);

    return($ade_err_ok);
}

sub ade_spc_autogendheader
{
    my($errstack_ref, $outhandle, $first_line_comment_start, $first_line_comment_end, $mid_line_comment_start, $mid_line_comment_end, $last_line_comment_start, $last_line_comment_end, $headersize_ref) = @_;
    my($user, $unamen, $date, $linelength, $textlength, $rc);

    &ade_err_debug($errstack_ref, 4, "ade_spc_autogendheader: sof (FLCS=$first_line_comment_start, FLCE=$first_line_comment_end, MLCS=$mid_line_comment_start, MLCE=$mid_line_comment_end, LLCS=$last_line_comment_start, LLCE=$last_line_comment_end)");

    if (($rc=&ade_usr_getmyloginname($errstack_ref, \$user)) != $ade_err_ok) {
        return($rc);
    }
    chop($unamen = `uname -n`);
    $linelength = 78;
    chop($date = `date`);
    $textlength = $linelength - (length($first_line_comment_start) + length($first_line_comment_end));
    printf $outhandle "%s%-*s%s", $first_line_comment_start, $textlength, "=" x $textlength,                                                $first_line_comment_end;
    printf $outhandle "%s%-*s%s", $mid_line_comment_start,   $textlength, "",                                                               $mid_line_comment_end;
    printf $outhandle "%s%-*s%s", $mid_line_comment_start,   $textlength, "               T H I S   I S   A   G E N E R A T E D   F I L E", $mid_line_comment_end;
    printf $outhandle "%s%-*s%s", $mid_line_comment_start,   $textlength, "",                                                               $mid_line_comment_end;
    printf $outhandle "%s%-*s%s", $mid_line_comment_start,   $textlength, "               M A N U A L   E D I T S   M A Y   B E   L O S T", $mid_line_comment_end;
    printf $outhandle "%s%-*s%s", $mid_line_comment_start,   $textlength, "",                                                               $mid_line_comment_end;
    printf $outhandle "%s%-*s%s", $mid_line_comment_start,   $textlength, "  Generated by:      $user",                                     $mid_line_comment_end;
    printf $outhandle "%s%-*s%s", $mid_line_comment_start,   $textlength, "  Generated with:    $ade_app_progname",                         $mid_line_comment_end;
    printf $outhandle "%s%-*s%s", $mid_line_comment_start,   $textlength, "  Generated on host: $unamen",                                   $mid_line_comment_end;
    printf $outhandle "%s%-*s%s", $mid_line_comment_start,   $textlength, "  Generated on date: $date",                                     $mid_line_comment_end;
    printf $outhandle "%s%-*s%s", $mid_line_comment_start,   $textlength, "",                                                               $mid_line_comment_end;
    printf $outhandle "%s%-*s%s", $last_line_comment_start,  $textlength, "=" x $textlength,                                                $last_line_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);
}

sub ade_spc_multifork
{
    my($errstack_ref, $timeout, $threads, @cmds) = @_;
    my($pid, @job_statuses, $running_count, $running_but_requested_to_exit_count, $queued_count, $exited_count, $failed_to_start_count, $first_queued_job_index);
    my($exited_zero_count, $exited_non_zero_count, @rcs, $failed_count, $total_count);
    my($soonest_kill_time, $now_time, @timed_out_pids, @timed_out_jobids, $jobid);
    my($just_reaped_job_index, $sighandler_to_mainloop_message_ref, $exitcode, $quit, $sleep_period);
    my($msqid, $msgrcv_ok, $rcvd_buf, $msgrcv_rc, $msgq_type_rcvd, $anon_func);
    my($msgq_type_sent) = 1;           #  any positive int would do

    &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: initialising message queue ...");
    $anon_func = sub { msgctl($msqid, IPC_RMID, 0) || die "msgctl failed: $!\n"; };
    &ade_tmp_registerfunc($errstack_ref, $anon_func);
    if (!defined($msqid=msgget(IPC_PRIVATE, IPC_CREAT | S_IRUSR | S_IWUSR))) {
        &ade_err_error($errstack_ref, 'ade_err_misc', "ade_spc_multifork: failed to create message queue");
        return($ade_err_fail);
    }
    &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: initialising job status table ...");
    @job_statuses = map { { command => $_, status => 'queued'} } @cmds;
    &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: initialising SIGCHLD handler ...");
    $SIG{'CHLD'} = sub {
        my($pid);

        while (1) {
            $pid = waitpid(-1, WNOHANG);
            last if ($pid <= 0);
            &ade_err_debug($errstack_ref, 100, "ade_spc_multifork_reaper: writing message to queue ...");
            if (!msgsnd($msqid, pack("l l l", $msgq_type_sent, $pid, $?), 0)) {
                &ade_err_internal($errstack_ref, "ade_spc_multifork_reaper: msgsnd() failed");
            }
        }
    };

    #  Main loop.
    while (1) {
        &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: top of loop; reading counters ...");
        #  Get some counts used below.
        $running_count                       = scalar(map { (${$_}{status} eq 'running')         ? $_ : () } @job_statuses);
        $running_but_requested_to_exit_count = scalar(map { (${$_}{status} eq 'running-but-requested-to-exit')         ? $_ : () } @job_statuses);
        $queued_count                        = scalar(map { (${$_}{status} eq 'queued')          ? $_ : () } @job_statuses);
        $exited_count                        = scalar(map { (${$_}{status} eq 'exited')          ? $_ : () } @job_statuses);
        $failed_to_start_count               = scalar(map { (${$_}{status} eq 'failed-to-start') ? $_ : () } @job_statuses);
        $total_count                         = $#job_statuses+1;
        $now_time                            = time();
        &ade_err_debug($errstack_ref, 10, "ade_spc_multifork: total_count=$total_count, running_count=$running_count, running_but_requested_to_exit_count=$running_but_requested_to_exit_count, queued_count=$queued_count, exited_count=$exited_count, failed_to_start_count=$failed_to_start_count");

        #  If no jobs left then exit.
        if ($queued_count == 0 and $running_count == 0 and $running_but_requested_to_exit_count == 0) {
            &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: queue is empty and no jobs are running or running-but-requested-to-exit; exiting loop ...");
            last;
        }
        
        #  If jobs are queued and slots are available then launch job (and jump to top of loop in case more slots free).
        if ($queued_count != 0 and $running_count+$running_but_requested_to_exit_count < $threads) {
            &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: there are jobs in the queue and slots available to run them; launching a job ...");
            $first_queued_job_index = (grep { $job_statuses[$_]{status} eq 'queued' } 0..$#job_statuses)[0];
            &ade_err_debug($errstack_ref, 100, sprintf("ade_spc_multifork: first_queued_job_index=%d", $first_queued_job_index));
            $pid = fork();
            if (!defined($pid)) {
                &ade_err_debug($errstack_ref, 10, "fork failed");
                $job_statuses[$first_queued_job_index]{status} = 'failed-to-start';
            } elsif ($pid == 0) {
                &ade_err_debug($errstack_ref, 100, "ade_spc_multifork_child: about to exec [$job_statuses[$first_queued_job_index]{command}] ...");
                #  Enclosing exec in curly braces supresses a "sure you didn't mean system()?" warning (see
                #  'perldoc -f exec' for details).
                { exec $job_statuses[$first_queued_job_index]{command}; }
                #  If exec fails then error.
                &ade_err_error($errstack_ref, 'ade_err_misc', "ade_spc_multifork[child]: exec failed");
                return($ade_err_fail);
            } else { 
                &ade_err_debug($errstack_ref, 100, sprintf("ade_spc_multifork: forked process %d with timeout $timeout", $pid));
                $job_statuses[$first_queued_job_index]{pid}    = $pid;
                $job_statuses[$first_queued_job_index]{killtime} = ($timeout > 0) ? ($now_time + $timeout) : 0;
                $job_statuses[$first_queued_job_index]{status} = 'running';
            }
            #  If we started a process then there may be more that can be started so jump straight to top of loop.
            next;
        }
        
        #  Scan for timed out children and "ask" them to exit.
        &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: scanning for child processes whose timeouts have expired ...");
        @timed_out_jobids = grep { $job_statuses[$_]{status} eq 'running' and $job_statuses[$_]{killtime} > 0 and $job_statuses[$_]{killtime} <= $now_time } 0..$#job_statuses;
        if ($#timed_out_jobids+1 > 0) {
            #  Mark status before we kill it (remember the status key is the 'critical' key).
            foreach $jobid (@timed_out_jobids) {
                $job_statuses[$jobid]{status} = 'running-but-requested-to-exit';
            }
            #  Convert job ids to pids.
            @timed_out_pids = map { $job_statuses[$_]{pid} } @timed_out_jobids;
            &ade_err_debug($errstack_ref, 100, sprintf("ade_spc_multifork: killing pids (%s) whose timeouts have expired ...", join(', ', @timed_out_pids)));
            kill 15, @timed_out_pids;
        }       

        #  Get the timeout of the soonest-to-timeout child. This is the maximum length of time we will
        #  wait for for a message from the signal handler (which we will do in a moment).
        &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: scanning for the child process whose timeout will expire next ...");
        if (defined($soonest_kill_time=(sort map { $job_statuses[$_]{killtime} } grep { $job_statuses[$_]{status} eq 'running' and $job_statuses[$_]{killtime} != 0 } 0..$#job_statuses)[0])) {
            $sleep_period = $soonest_kill_time - $now_time;
        } else {
            $sleep_period = 0;
        }
        &ade_err_debug($errstack_ref, 100, sprintf("ade_spc_multifork: next timeout expires in %s", $sleep_period ? sprintf("%ds", $sleep_period) : "never"));
            
        #  Wait for a message on the message queue. There are three possible things that can happen here:
        #
        #  1) a message arrives
        #  2) the timeout (if there is one) expires before a message arrives
        #  3) the attempt to read a message is interrupted for another reason (typically because of a SIGCHLD, 
        #     but note that the message from the signal handler is not available until some time after the
        #     SIGCHLD arrives)
        #
        #  We use a construct detailed in alarm(perldoc). Interestingly, the 'elsif ($@)' clause never gets
        #  called, but the situation it is meant to be detecting is detected by the 'elsif (!$msgrcv_ok)' clause,
        #  which follows it.
        eval {
            local $SIG{ALRM} = sub { die "alarm\n" };
            alarm($sleep_period) if ($sleep_period);
            $msgrcv_ok = msgrcv($msqid, $rcvd_buf, 100, 0, 0);
            alarm(0);
        };
        if ($@ eq "alarm\n") {
            &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: msgrcv() interrupted by timeout");
        } elsif ($@) {
            &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: msgrcv() interrupted, probably by SIGCHLD (case #1)");
        } elsif (!$msgrcv_ok) {
            &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: msgrcv() interrupted, probably by SIGCHLD (case #2)");
        } else {
            ($msgq_type_rcvd, $pid, $exitcode) = unpack("l l l", $rcvd_buf);
            &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: signal handler messaged main loop to say that pid $pid exited with exitcode $exitcode; updating job table accordingly ...");
            $just_reaped_job_index = (grep { ($job_statuses[$_]{status} eq 'running' or $job_statuses[$_]{status} eq 'running-but-requested-to-exit') and $job_statuses[$_]{pid} == $pid } 0..$#job_statuses)[0];
            $job_statuses[$just_reaped_job_index]{status} = 'exited';
            $job_statuses[$just_reaped_job_index]{exitcode} = $exitcode;
            delete $job_statuses[$just_reaped_job_index]{pid};
        }
        &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: bottom of loop");
    }

    #  Clean up.
    &ade_err_debug($errstack_ref, 100, "ade_spc_multifork: destroying queue ...");
    msgctl($msqid, IPC_RMID, 0) || die "msgctl failed: $!\n";
    &ade_tmp_deregisterfunc($errstack_ref, $anon_func);
    $SIG{'CHLD'} = 'DEFAULT';

    #  Convert Unix exit codes to ADE-style return codes.
    @rcs = map { (${$_}{status} eq 'exited' and ${$_}{exitcode} == 0) ? $ade_err_ok : $ade_err_fail } @job_statuses;

    #  Propogate errors upwards.
    if (($failed_count=scalar(map { $_ == $ade_err_fail } @rcs)) != 0) {
        &ade_err_error($errstack_ref, ade_err_misc, "$failed_count commands failed");
    }
    return(@rcs);
}
##############################################################################
#
#  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($user, $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,
        if (($rc=&ade_usr_getmyloginname($errstack_ref, \$user)) != $ade_err_ok) {
            return($rc);
        }
        $smtp->mail($user . "\@[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'

    if (($rc=&_ade_gep_getosid($errstack_ref)) != $ade_err_ok) {
        &ade_err_error($errstack_ref, ade_err_misc, "failed to determine OS");
        return($rc);
    }

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

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_msg_writer_syslog
{
    my($errstack_ref, $text) = @_;
    my($facility, $priority);

    $facility = (defined($ade_msg_writer_syslog_facility)) ? $ade_msg_writer_syslog_facility : "local0"; 
    $priority = (defined($ade_msg_writer_syslog_priority)) ? $ade_msg_writer_syslog_priority : "alert";

    #  openlog() wants a facility (according to docs) even though it can be specified when 
    #  calling syslog().
    openlog($ade_app_progname, 'pid', $facility);
    syslog("$facility|$priority", $text);
    closelog();

    return($ade_err_ok);
}

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

    return($ade_err_ok);
}

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

    #  Set defaults for ADE options
    $ade_opt_want_to_show_paths = 0;
    $ade_opt_want_to_show_version = 0;
    $ade_opt_want_to_show_usage = 0;
    $ade_msg_verboselevel = 2;

    #  Register the options ADE will handle (and the functions to handle them).
    &ade_err_debug($errstack_ref, 10, "_ade_gep_initialise_with_stack: calling ade_opt_register() to register ADE options ...");
    if (($rc=&ade_opt_register($errstack_ref, "Vd:ivhp",  "version,debug:i,verbose,help,list-paths", "_ade_opt_handler_%s")) != $ade_err_ok) {
        &ade_err_error($errstack_ref, ade_err_misc, "ade_opt_register() call to register ADE options failed");
        return($rc);
    }

    return($ade_err_ok);
}

sub _ade_opt_handler_V
{
    return(&_ade_opt_handler_version(@_));
}

sub _ade_opt_handler_p
{
    return(&_ade_opt_handler_list_paths(@_));
}

sub _ade_opt_handler_h
{
    return(&_ade_opt_handler_help(@_));
}

sub _ade_opt_handler_d
{
    return(&_ade_opt_handler_debug(@_));
}

sub _ade_opt_handler_v
{
    return(&_ade_opt_handler_verbose(@_));
}

sub _ade_opt_handler_version
{
    $ade_opt_want_to_show_version = 1; 
    return($ade_err_ok);
}

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

    $ade_opt_want_to_show_usage = 1;
    return($ade_err_ok);
}

sub _ade_opt_handler_list_paths
{
    $ade_opt_want_to_show_paths = 1;
    return($ade_err_ok);
}

sub _ade_opt_handler_debug
{
    my($errstack_ref, $verboselevel) = @_;
    
    &ade_err_debug($errstack_ref, 10, "_ade_opt_handler_debug: setting \$ade_msg_verboselevel to $verboselevel ...");
    $ade_msg_verboselevel = $verboselevel;

    return($ade_err_ok);
}

sub _ade_opt_handler_verbose
{
    my($errstack_ref) = @_;
    
    $ade_msg_verboselevel = 3;

    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;