5 CGI::Ex::Die - A CGI::Carp::FatalsToBrowser type utility.
9 ###----------------------------------------------------------------###
10 # Copyright 2006 - Paul Seamons #
11 # Distributed under the Perl Artistic License without warranty #
12 ###----------------------------------------------------------------###
15 use vars
qw($no_recurse
16 $EXTENDED_ERRORS $SHOW_TRACE $IGNORE_EVAL
18 $LOG_HANDLER $FINAL_HANDLER
22 use CGI
::Ex
::Dump
qw(debug ctrace dex_html);
25 $SHOW_TRACE = 0 if ! defined $SHOW_TRACE;
26 $IGNORE_EVAL = 0 if ! defined $IGNORE_EVAL;
27 $EXTENDED_ERRORS = 1 if ! defined $EXTENDED_ERRORS;
30 ###----------------------------------------------------------------###
37 &Carp
::croak
("Usage: use ".__PACKAGE__
." register => 1");
41 # use CGI::Ex::Die register => 1;
43 # use CGI::Ex::Die register => [qw(die)];
44 if (! ref($args{register
}) || grep {/die/} @{ $args{register
} }) {
45 $SIG{__DIE__
} = \
&die_handler
;
47 $SHOW_TRACE = $args{'show_trace'} if exists $args{'show_trace'};
48 $IGNORE_EVAL = $args{'ignore_eval'} if exists $args{'ignore_eval'};
49 $EXTENDED_ERRORS = $args{'extended_errors'} if exists $args{'extended_errors'};
50 $ERROR_TEMPLATE = $args{'error_template'} if exists $args{'error_template'};
51 $LOG_HANDLER = $args{'log_handler'} if exists $args{'log_handler'};
52 $FINAL_HANDLER = $args{'final_handler'} if exists $args{'final_handler'};
57 ###----------------------------------------------------------------###
62 die $err if $no_recurse;
63 local $no_recurse = 1;
65 ### test for eval - if eval - propogate it up
67 if (! $ENV{MOD_PERL
}) {
69 while (my $sub = (caller(++$n))[3]) {
70 next if $sub !~ /eval/;
71 die $err; # die and let the eval catch it
74 ### test for eval in a mod_perl environment
78 while (my $sub = (caller(++$n))[3]) {
79 $found = $n if ! $found && $sub =~ /eval/;
80 last if $sub =~ /^(Apache|ModPerl)::(PerlRun|Registry)/;
82 if ($found && $n - 1 != $found) {
88 ### decode the message
91 } elsif ($EXTENDED_ERRORS && $err) {
93 if ($copy =~ m
|^Execution of
([/\w\
.\
-]+) aborted due to compilation errors
|si
) {
95 local $SIG{__WARN__
} = sub {};
99 $error =~ s
|Compilation failed
in require at
[/\w/\
.\
-]+/Die
.pm line \d
+\
.\s
*$||is;
101 $err .= "\n($error)\n";
102 } elsif ($copy =~ m
|^syntax error at
([/\w
.\
-]+) line \d
+, near
|mi
) {
106 ### prepare common args
107 my $msg = &CGI
::Ex
::Dump
::_html_quote
("$err");
108 $msg = "<pre style='background:red;color:white;border:2px solid black;font-size:120%;padding:3px'>Error: $msg</pre>\n";
109 my $ctrace = ! $SHOW_TRACE ? ""
110 : "<pre style='background:white;color:black;border:2px solid black;padding:3px'>"
111 . dex_html
(ctrace
)."</pre>";
112 my $args = {err
=> "$err", msg
=> $msg, ctrace
=> $ctrace};
114 &$LOG_HANDLER($args) if $LOG_HANDLER;
116 ### web based - give more options
117 if ($ENV{REQUEST_METHOD
}) {
118 my $cgix = CGI
::Ex-
>new;
120 ### get the template and swap it in
121 # allow for a sub that returns the template
123 # or a filename (string starting with /)
125 if ($ERROR_TEMPLATE) {
126 $out = UNIVERSAL
::isa
($ERROR_TEMPLATE, 'CODE') ? &$ERROR_TEMPLATE($args) # coderef
127 : (substr($ERROR_TEMPLATE,0,1) ne '/') ? $ERROR_TEMPLATE # html string
129 if (open my $fh, $ERROR_TEMPLATE) {
130 read($fh, my $str, -s
$ERROR_TEMPLATE);
131 $str; # return of the do
135 $cgix->swap_template(\
$out, $args);
137 $out = $msg.'<p></p>'.$ctrace;
140 ### similar to CGI::Carp
141 if (my $r = $cgix->apache_request) {
142 if ($r->bytes_sent) {
146 $r->custom_response(500, $out);
149 $cgix->print_content_type;
153 ### command line execution
156 &$FINAL_HANDLER($args) if $FINAL_HANDLER;
168 $SIG{__DIE__} = \&CGI::Ex::Die::die_handler;
172 use CGI::Ex::Die register => 1;
176 This module is intended for showing more useful messages to
177 the developer, should errors occur. This is a stub phase module.
178 More features (error notification, custom error page, etc) will
183 Paul Seamons <perlspam at seamons dot com>