UR::Exit - methods to allow clean application exits.

  UR::Exit->exit_handler(\&mysub);

  UR::Exit->clean_exit($value);

package UR::Exit;

# set up module
require 5.6.0;
use warnings;
use strict;
our $VERSION = $UR::VERSION;;
our (@ISA, @EXPORT, @EXPORT_OK);

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();

use Carp;

 
sub exit_handler
{
    die "Unimplimented";
}

sub clean_exit 
{
    my $class = shift;
    my ($value) = @_;
    $value = 0 unless defined($value);
    exit($value);
}

sub death
{
    unless ($ENV{'UR_STACK_DUMP_ON_DIE'}) {
        die @_;
    }

    # workaround common error    
    if ($_[0] =~ /Can.*t upgrade that kind of scalar during global destruction/)
    {
        exit 1;
    }

    # check the call stack depth for up-stream evals
    # this handler is only to pretty-up things which AREN'T caught.
    my $call_stack_depth = 0;
    for (1) {
        my @details = caller($call_stack_depth);
        #print Data::Dumper::Dumper(\@details);
        last if scalar(@details) == 0;

        if ($details[1] =~ /\(eval .*\)/) {
            #print "<no carp due to eval string>";
            return;
        }
        elsif ($details[3] eq "(eval)") {
            #print "<no carp due to eval block>";
            return;
        }
        $call_stack_depth++;
        redo;
    }

    if 
    (
        $_[0] =~ /\n$/ 
        and UNIVERSAL::can("UR::Context::Process","is_initialized")
        and defined(UR::Context::Process->is_initialized)
        and (UR::Context::Process->is_initialized == 1)
    )
    {
        # Do normal death if there is a newline at the end, and all other
        # things are sane.
        return;
    }
    else
    {
        # Dump the call stack in other cases.
        # This is a developer error occurring while things are
        # initializing.
        Carp::confess(@_);
	return;
    }
}

sub warning
{

    unless ($ENV{'UR_STACK_DUMP_ON_WARN'}) {
        warn @_;
        return;
    }

    return if $_[0] =~ /Attempt to free unreferenced scalar/;
    return if $_[0] =~ /Use of uninitialized value in exit at/;
    return if $_[0] =~ /Use of uninitialized value in subroutine entry at/;    
    return if $_[0] =~ /One or more DATA sections were not processed by Inline/;
    UR::ModuleBase->warning_message(@_);
    if ($_[0] =~ /Deep recursion on subroutine/)
    {
        print STDERR "Forced exit by UR::Exit on deep recursion.\n";
        print STDERR Carp::longmess("Stack tail:");
        exit 1;
    }
    return;
}

#$SIG{__DIE__} = \&death unless ($SIG{__DIE__});
#$SIG{__WARN__} = \&warning unless ($SIG{__WARN__});

sub enable_hooks_for_warn_and_die {
    $SIG{__DIE__} = \&death;
    $SIG{__WARN__} = \&warning;
}

&enable_hooks_for_warn_and_die();


1;
__END__

#$Header$