package Exception::Handler;
use strict;
$Exception::Handler::VERSION   = 1.00;          # 8/28/2002, 12:06:56 PM

=pod

   AUTHOR
      -Tommy Butler, professional contractor and open source proponent

       Atrixnet™, for Internet Business Software®
         http://atrixnet.com
         6711 Forest Park Dr
         Arlington, TX
             76001

   COPYRIGHT
       Copyright Tommy Butler. All rights reserved

   LISCENCE
       This software is free, and you may use and distribute it under the
       GNU GPL liscence.  If you modify the code for your own purposes
       please acknowledge its original author.

   BUGS
     Please report any of the following to me
       - bugs
       - interface inconsistencies
       - suggestions
       - comments
       - complaints
       - smart remarks


=cut

# --------------------------------------------------------
# Constructor
# --------------------------------------------------------
sub new { bless({ }, shift(@_)); }


# --------------------------------------------------------
# Exception::Handler::quit()
# --------------------------------------------------------
sub quit {

   my($this) = shift(@_);

   print(qq[Content-Type: text/html\012\012]) if ($ENV{'REQUEST_METHOD'});

   print(q[PROCESS TERMINATED DUE TO ERRORS, see log...]);

   warn($this->trace(@_));

   exit;
}


# --------------------------------------------------------
# Exception::Handler::fail(), error()
# --------------------------------------------------------
sub error { goto &fail; }
sub fail  {

   my($this) = shift(@_);
   my($throw_count) = $this->{'tflag'} || 0;

   {
     # I refuse to manually initialize a standard environment
     # variable.  This is an example where the warnings pragma
     # is going too far.  It's something we live with.
      local($^W) = undef;

     # if we're running in a CGI gateway iface, we need
     # to output the necessary HTTP headers
     if ( $ENV{'REQUEST_METHOD'} ) {

       print(<<__crash__) and exit;
Content-Type: text/html; charset=ISO-8859-1


<pre>
PROCESS TERMINATED DUE TO ERRORS
@{[ $this->trace(@_) ]}
</pre>
__crash__
     }
     else {

       print(<<__crash__) and exit;
PROCESS TERMINATED DUE TO ERRORS
@{[ $this->trace(@_) ]}
__crash__
     }
   }

   exit;
}


# --------------------------------------------------------
# Exception::Handler::trace()
# --------------------------------------------------------
sub trace {

   my($this)    = shift(@_);
   my(@errors)  = @_;
   my($errfile) = '';
   my($caught)  = 0;
   my(
      $pak,    $file,  $line,  $sub,
      $hasargs, $wantarray, $evaltext, $req_OR_use,
      @stack,   $trace,    $i,      $ialias,
   );

   $ialias = 0;

   while (
      (
         $pak,    $file,  $line,  $sub,
         $hasargs, $wantarray, $evaltext, $req_OR_use
      ) = caller( $i++ )
     )
   {
      $ialias = $i - 2; next unless ($ialias > 0);

      my(@tree) = split ( /\:\:/, $sub );

      if ( $tree[0] ne __PACKAGE__ ) {

         push (
            @stack, qq[
$ialias. $sub
    -called at line ($line) of $file
       @{[

         ($hasargs)
            ? '-was called with args'
            : '-was called without args'
       ]}
       @{[
         ($evaltext)
            ? '-was called to evalate text'
            : '-was not called to evaluate anything'
       ]}]
         );
      }
      else {
         $caught = qq[\012] . uc(qq[exception was raised at])
           . qq[ line ($line) of $file];
     }
   }

   $i = 0;

   if ( scalar(@errors) == 0 ) {

     push ( @errors, qq[[Unspecified error.  Frame no. $ialias...]] );
   }

   foreach (@errors) {

      $_ = ( defined($_) ) ? $_ : '';

      if (!length($_)) { $_ = qq[Something is wrong.  Frame no. $ialias...]; }
      else {

         $_ =~ s/^(?:\r|\n)//o; $_ =~ s/(?:\r|\n)$//o;

         $_ = qq[\012$_\012];
      }

      ++$i;
   }

   $trace  = join ( qq[\012] x 2, @errors, ) . $caught . qq[\012] x 2;
   $trace .= join ( qq[\012] x 2, @stack );

   $trace;
}


# --------------------------------------------------------
# Exception::Handler::DESTROY()
# --------------------------------------------------------
sub DESTROY { } sub AUTOLOAD { }
1;