package ADE;

require Exporter;
@ISA=qw(Exporter);
push(@EXPORT,qw(ade_gep_main $ade_tmp_dir));

require Tie::RefHash;              #  for 'callonexit' hash, which contains code refs 

my(%ade_gep_defined_errors) = (
    ade_err_miscfailure  => { fmt => "%s failed" },
);

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

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

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

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

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

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

##############################################################################
#
#  Private functions
#
##############################################################################

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

    #printf "_ade_gep_main_withstack: sof\n";

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

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

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

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

    return($ade_err_ok);
}

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

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

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

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

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

    &ade_err_resetstack(stack=>$errstack_ref);

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

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

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

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

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

    return($ade_err_ok);
}

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

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

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

    return($ade_err_ok);
}

##############################################################################
#
#  Run the load-time checks
#
##############################################################################

&_ade_gep_loadtimechecks(undef);

1;
