view release on metacpan or  search on metacpan

lib/CGI/Carp/Throw.pm  view on Meta::CPAN

            $r->print($mess);
            $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
        } else {
            # MSIE won't display a custom 500 response unless it is >512 bytes!
            if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) {
                $mess = "<!-- " . (' ' x 513) . " -->\n$mess";
            }
            $r->custom_response(500,$mess);
        }
    } else {
        my $bytes_written = eval{tell STDOUT};
        if (defined $bytes_written && $bytes_written > 0) {
            print STDOUT $mess;
        }
        else {
            print STDOUT "Content-type: text/html\n\n";
            print STDOUT $mess;
        }
    }
}

my $throw_format_fref;

#####################################################################
# Set / retrieve the throw_format_sub class attribute
#
# throw_format_sub class attribute is a user supplied routine to
# format error messages in some format, probably using template
# technology, resulting in an appearance compatible with a web site.
#####################################################################
sub throw_format_sub {
    
    if (@_) {
        my $new_fref = shift;
        
        croak 'throw_format_sub setting must be code reference'
            if (    $new_fref                   and
                    (   (not ref($new_fref))          or
                        ref($new_fref) !~ /CODE/i
                    )
            );
        
        $throw_format_fref = $new_fref;
    }
    
    return $throw_format_fref;
}

my $old_fatals_to_browser = \&CGI::Carp::fatalsToBrowser;

{
no warnings 'redefine';

#####################################################################
# Partially replace fatalsToBrowser so that it gets called
# unless the exception came from one of our throw_browser routines.
#####################################################################
*CGI::Carp::fatalsToBrowser = sub {
  my $msg = shift;
  
  my($pack,undef,undef,$sub) = caller(2);
  if (($sub || '') =~ /::_throw_browser$/) {
    die_msg_io($msg);
  }
  else {
    $old_fatals_to_browser->($msg)
  }
};
}

#####################################################################
# Shared throw browser logic for cloaked and non-cloaked variants.
#
# If you called this you wanted CGI::Carp wrapping (unless you're in
# an eval) so turn that on.  If a formatting routine was specified
# call it and die with its message.  Otherwise die and let the
# fatalsToBrowser replacement take over.
#####################################################################
sub _throw_browser {
    unless ($CGI::Carp::WRAP or CGI::Carp::ineval) {
        $CGI::Carp::WRAP++;
    }
    
    if ($throw_format_fref) {
        my $die_msg = $throw_format_fref->(@_);
        $die_msg =~ s/([^\n])$/$1\n/ if $die_msg;
        die $die_msg;
    }
    else {
        if ($_[-1] and $_[-1] !~ /\n$/) {
            die @_, "\n";
        }
        else {
            die @_;
        }
    }
}

#####################################################################
# Standard throw browser.  "Uncloaked" which includes stack trace
# HTML comment.
#####################################################################
sub throw_browser {
    undef $throw_cloaked;
    _throw_browser(@_);
}

#####################################################################
# Standard throw browser.  "Cloaked" to hide stack trace HTML comment.
#####################################################################
sub throw_browser_cloaked {
    $throw_cloaked = 1;
    _throw_browser(@_);
}

END {
    CGI::Carp::warningsToBrowser(1) if $final_warn_browser;
}

1;
__END__