5 CGI::Ex::Die - A CGI::Carp::FatalsToBrowser type utility.
9 ###----------------------------------------------------------------###
10 # Copyright 2007 - Paul Seamons #
11 # Distributed under the Perl Artistic License without warranty #
12 ###----------------------------------------------------------------###
17 $EXTENDED_ERRORS $SHOW_TRACE $IGNORE_EVAL
19 $LOG_HANDLER $FINAL_HANDLER
23 use CGI
::Ex
::Dump
qw(debug ctrace dex_html);
27 $SHOW_TRACE = 0 if ! defined $SHOW_TRACE;
28 $IGNORE_EVAL = 0 if ! defined $IGNORE_EVAL;
29 $EXTENDED_ERRORS = 1 if ! defined $EXTENDED_ERRORS;
32 ###----------------------------------------------------------------###
39 &Carp
::croak
("Usage: use ".__PACKAGE__
." register => 1");
43 # use CGI::Ex::Die register => 1;
45 # use CGI::Ex::Die register => [qw(die)];
46 if (! ref($args{register
}) || grep {/die/} @{ $args{register
} }) {
47 $SIG{__DIE__
} = \
&die_handler
;
49 $SHOW_TRACE = $args{'show_trace'} if exists $args{'show_trace'};
50 $IGNORE_EVAL = $args{'ignore_eval'} if exists $args{'ignore_eval'};
51 $EXTENDED_ERRORS = $args{'extended_errors'} if exists $args{'extended_errors'};
52 $ERROR_TEMPLATE = $args{'error_template'} if exists $args{'error_template'};
53 $LOG_HANDLER = $args{'log_handler'} if exists $args{'log_handler'};
54 $FINAL_HANDLER = $args{'final_handler'} if exists $args{'final_handler'};
59 ###----------------------------------------------------------------###
64 die $err if $no_recurse;
65 local $no_recurse = 1;
67 ### test for eval - if eval - propogate it up
69 if (! $ENV{MOD_PERL
}) {
71 while (my $sub = (caller(++$n))[3]) {
72 next if $sub !~ /eval/;
73 die $err; # die and let the eval catch it
76 ### test for eval in a mod_perl environment
80 while (my $sub = (caller(++$n))[3]) {
81 $found = $n if ! $found && $sub =~ /eval/;
82 last if $sub =~ /^(Apache|ModPerl)::(PerlRun|Registry)/;
84 if ($found && $n - 1 != $found) {
90 ### decode the message
93 } elsif ($EXTENDED_ERRORS && $err) {
95 if ($copy =~ m
|^Execution of
([/\w\
.\
-]+) aborted due to compilation errors
|si
) {
97 local $SIG{__WARN__
} = sub {};
100 my $error = $@ || '';
101 $error =~ s
|Compilation failed
in require at
[/\w/\
.\
-]+/Die
.pm line \d
+\
.\s
*$||is;
103 $err .= "\n($error)\n";
104 } elsif ($copy =~ m
|^syntax error at
([/\w
.\
-]+) line \d
+, near
|mi
) {
108 ### prepare common args
109 my $msg = &CGI
::Ex
::Dump
::_html_quote
("$err");
110 $msg = "<pre style='background:red;color:white;border:2px solid black;font-size:120%;padding:3px'>Error: $msg</pre>\n";
111 my $ctrace = ! $SHOW_TRACE ? ""
112 : "<pre style='background:white;color:black;border:2px solid black;padding:3px'>"
113 . dex_html
(ctrace
)."</pre>";
114 my $args = {err
=> "$err", msg
=> $msg, ctrace
=> $ctrace};
116 &$LOG_HANDLER($args) if $LOG_HANDLER;
118 ### web based - give more options
119 if ($ENV{REQUEST_METHOD
}) {
120 my $cgix = CGI
::Ex-
>new;
122 ### get the template and swap it in
123 # allow for a sub that returns the template
125 # or a filename (string starting with /)
127 if ($ERROR_TEMPLATE) {
128 $out = UNIVERSAL
::isa
($ERROR_TEMPLATE, 'CODE') ? &$ERROR_TEMPLATE($args) # coderef
129 : (substr($ERROR_TEMPLATE,0,1) ne '/') ? $ERROR_TEMPLATE # html string
131 if (open my $fh, $ERROR_TEMPLATE) {
132 read($fh, my $str, -s
$ERROR_TEMPLATE);
133 $str; # return of the do
137 $cgix->swap_template(\
$out, $args);
139 $out = $msg.'<p></p>'.$ctrace;
142 ### similar to CGI::Carp
143 if (my $r = $cgix->apache_request) {
144 if ($r->bytes_sent) {
148 $r->custom_response(500, $out);
151 $cgix->print_content_type;
155 ### command line execution
158 &$FINAL_HANDLER($args) if $FINAL_HANDLER;
170 $SIG{__DIE__} = \&CGI::Ex::Die::die_handler;
174 use CGI::Ex::Die register => 1;
178 This module is intended for showing more useful messages to
179 the developer, should errors occur. This is a stub phase module.
180 More features (error notification, custom error page, etc) will
185 Paul Seamons <perlspam at seamons dot com>