package WebGUI::Middleware::StackTrace; use strict; use warnings; use parent qw/Plack::Middleware/; use Devel::StackTrace; use Devel::StackTrace::AsHTML; use Try::Tiny; use Plack::Util::Accessor qw( force no_print_errors ); use Scalar::Util 'blessed'; use Data::Dumper; use Plack::Middleware::StackTrace; use WebGUI::Session::Log; BEGIN { no warnings 'redefine'; if (eval { require Devel::StackTrace::WithLexicals; 1 }) { # Optional since it needs PadWalker my $old_new = Devel::StackTrace->can('new'); *Devel::StackTrace::new = sub { my $self = $old_new ? $old_new->(@_) : { }; bless $self, 'Devel::StackTrace::WithLexicals'; # rebless }; } } sub call { my($self, $env) = @_; # this won't be Middleware called by the .psgi in the default config unless $env->{'webgui.debug'} is true local $SIG{__DIE__} = sub { WebGUI::Error::RunTime->throw(error => $@); }; my $res = try { $self->app->($env) }; # XXX this try is useless; plack doesn't let errors cross middlewares if( my $e = delete $env->{'webgui.error'} ) { my $trace = $e->trace; my $message = $e->error; my $text = trace_as_string($trace); my @previous_html = $res && $res->[2] ? (map ref $_ ? @{ $_ } : $_, $res->[2]) : (); $env->{'psgi.errors'}->print($text) unless $self->no_print_errors; my $html = eval { trace_as_html($trace, $env->{'webgui.session'}, $message) }; $res = [500, ['Content-Type' => 'text/html; charset=utf-8'], [ utf8_safe($html), @previous_html ] ]; } return $res; } sub trace_as_string { my $trace = shift; my $message = shift; my $st = "$message:\n"; my $first = 1; $trace->reset_pointer; while( my $f = $trace->next_frame ) { $st .= "\t" unless $first; $st .= $f->as_string($first) . "\n"; $first = 0; } return $st; } do { no strict 'subs'; no strict 'refs'; *encode_html = *Devel::StackTrace::AsHTML::encode_html{CODE}; *_build_context = *Devel::StackTrace::AsHTML::_build_context{CODE}; # *_build_arguments = *Devel::StackTrace::AsHTML::_build_arguments{CODE}; # *_build_lexicals = *Devel::StackTrace::AsHTML::_build_lexicals{CODE}; }; sub trace_as_html { my $trace = shift; my $session = shift or die; my $message = shift; my %opt = @_; # copied and modified render() from Devel::StackTrace::WithLexicals # "$trace->as_html" just does "__PACKAGE__->render" in D::ST::WL my $extras = sub { $session->url->extras(@_) }; my $msg = encode_html($trace->frame(1)->args); my $out = qq{Error: ${msg}}; $opt{style} ||= \<${$opt{style}}); } else { $out .= qq(); } $out .= < function toggleThing(ref, type, hideMsg, showMsg) { var css = document.getElementById(type+'-'+ref).style; css.display = css.display == 'block' ? 'none' : 'block'; var hyperlink = document.getElementById('toggle-'+ref); hyperlink.textContent = css.display == 'block' ? hideMsg : showMsg; } function toggleArguments(ref) { toggleThing(ref, 'arguments', 'Hide function arguments', 'Show function arguments'); } function toggleLexicals(ref) { toggleThing(ref, 'lexicals', 'Hide lexical variables', 'Show lexical variables'); }

Error trace

$message
$msg

', $frame->subroutine ? encode_html("in " . $frame->subroutine) : '', ' at ', $frame->filename ? encode_html($frame->filename) : '', ' line ', $frame->line, _build_asset_info($i, ($frame->args)[0], $accumulated_asset_info, $frame), # adds data to $accumulated_asset_info; this line added relative the stock Devel::StackTrace::AsHTML q(
```
),
            _build_context($frame) || '', 
            q(
```
), _build_arguments($i, [$frame->args]), $frame->can('lexicals') ? _build_lexicals($i, $frame->lexicals) : '', q(

}; # # dump the asset tree # # my $assets = WebGUI::Asset->getRoot($session)->getLineage(['descendants'], {returnObjects=>1}); # # my $tree = { type => 'text', label => 'root', children => [], }; # # for my $asset (@$assets) { # # create a tree structure of assets matching their lineage # # the format (arrays, hashes, fields) matches what YAHOO.treeview expects # # when we find an asset mentioned in one of the stack trace frames above, we add the saved file/line/etc info to the label # my $lineage = $asset->get('lineage'); # my @parts = $lineage =~ m/(.{6})/g; # # warn "asset: $asset lineage: $lineage parts: @parts"; # my $node = $tree; # while(@parts) { # my $part = shift @parts; # if((my $child_node) = grep $_->{lineage_chunk} eq $part, @{$node->{children}}) { # $node = $child_node; # } else { # my $label = $asset->get('title') . ': Id: ' . $asset->getId . ' Class: ' . ref($asset); # for my $message ( map $_->{message}, grep $_->{asset_id} eq $asset->getId, @$accumulated_asset_info ) { # $label .= " <----- $message"; # } # my $child_node = { # type => 'text', # label => $label, # lineage_chunk => $part, # children => [ ], # }; # push @{$node->{children}}, $child_node; # $node = $child_node; # } # } # } # # use JSON::PP; # JSON::XS creates something that's mangled # my $json_tree = JSON::PP->new->ascii->pretty->encode( [ $tree ] ); # # warn "json_tree: $json_tree"; # do { open my $fh, '>', 'json.debug2.js' or die $!; $fh->print($json_tree); }; # # $out .= qq{ #

# # }; $out .= ""; return $out; } sub _build_asset_info { my($id, $asset, $accumulated_asset_info, $frame) = @_; return '' unless $asset and Scalar::Util::blessed($asset) and $asset->isa('WebGUI::Asset'); my $asset_title = $asset->get('title'); my $asset_id = $asset->getId; my $asset_class = ref $asset; my $message = "Stack frame number: $id AssetID: $asset_id Class: $asset_class Title: ``$asset_title''"; push @$accumulated_asset_info, { asset_id => $asset_id, message => $message, }; return $message; } my $dumper = sub { my $value = shift; $value = $$value if ref $value eq 'SCALAR' or ref $value eq 'REF'; my $d = Data::Dumper->new([ $value ]); # $d->Indent(1)->Terse(1)->Deparse(1); $d->Indent(1)->Terse(1)->Maxdepth(1); chomp(my $dump = $d->Dump); $dump; }; # copied this in so that we could use a differently configured Data::Dumper sub _build_arguments { my($id, $args) = @_; my $ref = "arg-$id"; return '' unless @$args; my $html = qq(

Show function arguments

); # Don't use while each since Dumper confuses that for my $idx (0 .. @$args - 1) { my $value = $args->[$idx]; my $dump = $dumper->($value); $html .= qq{}; $html .= qq{}; $html .= qq{}; $html .= qq{}; } $html .= qq(

\$_[$idx]

} . encode_html($dump) . qq{

); return $html; } # copied this in so that we could use a differently configured Data::Dumper sub _build_lexicals { my($id, $lexicals) = @_; my $ref = "lex-$id"; return '' unless keys %$lexicals; my $html = qq(

Show lexical variables

); # Don't use while each since Dumper confuses that for my $var (sort keys %$lexicals) { my $value = $lexicals->{$var}; my $dump = $dumper->($value); $dump =~ s/^\{(.*)\}$/($1)/s if $var =~ /^\%/; $dump =~ s/^\[(.*)\]$/($1)/s if $var =~ /^\@/; $html .= qq{}; $html .= qq{}; $html .= qq{}; $html .= qq{}; } $html .= qq(

} . encode_html($var) . qq{

} . encode_html($dump) . qq{

); return $html; } sub utf8_safe { my $str = shift; # NOTE: I know messing with utf8:: in the code is WRONG, but # because we're running someone else's code that we can't # guarnatee which encoding an exception is encoded, there's no # better way than doing this. The latest Devel::StackTrace::AsHTML # (0.08 or later) encodes high-bit chars as HTML entities, so this # path won't be executed. if (utf8::is_utf8($str)) { utf8::encode($str); } $str; } 1; __END__ =head1 NAME Plack^HWebGUI::Middleware::StackTrace - Displays stack trace when your app dies =head1 SYNOPSIS enable "+WebGUI::Middleware::StackTrace"; =head1 DESCRIPTION This middleware is a copy and modification of L, a middleware which catches exceptions (run-time errors) happening in your application and displays nice stack trace screen. This copy has been extended to display additional WebGUI specific information. The stack trace is annotated with titles and object types of assets for stack frames running inside of method calls to assets. This fork of C also hooks into L. Stack traces are generated on call to C<< $session->log->error >> or C<< $session->log->fatal >>. L will (almost) never display a stack trace for WebGUI as errors are caught and turned into HTTP C<200> replies. You're recommended to use this middleware during the development and use L in the deployment mode as a replacement, so that all the exceptions thrown from your application still get caught and rendered as a 500 error response, rather than crashing the web server. Catching errors in streaming response is not supported. =head1 CONFIGURATION =over 4 =item force enable "+WebGUI::Middleware::StackTrace", force => 1; Force display the stack trace when an error occurs within your application and the response code from your application is 500. Defaults to off. The use case of this option is that when your framework catches all the exceptions in the main handler and returns all failures in your code as a normal 500 PSGI error response. In such cases, this middleware would never have a chance to display errors because it can't tell if it's an application error or just random C in your code. This option enforces the middleware to display stack trace even if it's not the direct error thrown by the application. =item no_print_errors enable "+WebGUI::Middleware::StackTrace", no_print_errors => 1; Skips printing the text stacktrace to console (C). Defaults to 0, which means the text version of the stack trace error is printed to the errors handle, which usually is a standard error. =back =head1 AUTHOR Scott Walters With code taken from: Tatsuhiko Miyagawa Emiyagawa@bulknews.netE Tokuhiro Matsuno Shawn M Moore HTML generation code is ripped off from L written by Tokuhiro Matsuno and Kazuho Oku. =head1 SEE ALSO L L L L L =cut