I needed to get a stack trace when a CGI program was throwing errors, so I turned to Devel::StackTrace and printed the result using CGI::Carp's set_message subroutine. That was a good start, but the result wasn't very easy to read.

So I wrote the below to colorize the output of the stack trace. The colors can be configured with the %TRACE_COLORS hash. Setting $VERBOSE to a true value will cause the arguments to the subroutines to be printed with Data::Dumper--useful if you're going to passing references. Otherwise, it'll print out the raw args.

Remember, you need to import both fatalsToBrowser and set_message from CGI::Carp for this to work.

use CGI::Carp qw( fatalsToBrowser set_message );
BEGIN {
        my %TRACE_COLORS = (
                subroutine  => 'blue',
                args        => 'red',
                file        => 'blue',
                line        => 'green',
        );
        my $VERBOSE = 1;
        sub print_stack_trace 
        {
                my $msg = shift;
                use Devel::StackTrace;
                print "<h1>Error</h1>\n";
                print "<pre>$msg</pre>\n";
                print "<hr>\n";
                print "<h3>Stacktrace</h3>\n";
                print qq(<pre>\n);

                my $trace = Devel::StackTrace->new();
                while( my $frame = $trace->next_frame() ) {
                        print qq(<font color="$TRACE_COLORS{subroutine
+}">);
                        print $frame->subroutine;
                        print qq#</font>(#;

                        if($VERBOSE) {
                                print qq(<font color="$TRACE_COLORS{ar
+gs}">);
                                use Data::Dumper 'Dumper';
                                print Dumper(+($frame->args));
                                print qq(</font>);
                        }
                        else {
                                print join ', ',
                                map {
                                        qq(<font color="$TRACE_COLORS{
+args}">').
                                        $_ .
                                        qq('</font>)
                                } $frame->args;
                        }
                        print qq#)\n\t called at #;
                        print qq(<font color="$TRACE_COLORS{file}">);
                        print $frame->filename;
                        print qq(</font> );
                        print qq(line );
                        print qq(<font color="$TRACE_COLORS{line}">);
                        print $frame->line;
                        print qq(</font>);
                        print qq(\n);
                }

                print "</pre>\n";
        }

        set_message(\&print_stack_trace);
}

[download]

Replies are listed 'Best First'.
Re: Colorized HTML stack trace (via HTML::Template)
by jeffa (Bishop) on Oct 01, 2003 at 01:07 UTC
    I just had to see what would happen if i seperated the content from its presentation. I know it's overkill, but what the heck. 
    use CGI::Carp qw( fatalsToBrowser set_message );
use Devel::StackTrace;
use HTML::Template;
use Data::Dumper;
BEGIN {
   my $VERBOSE = 0;
   set_message(sub {
      my $msg   = shift;
      my $trace = Devel::StackTrace->new;
      my $tmpl  = HTML::Template->new(filehandle => \*DATA);
      my %param = (msg => $msg);
      while(my $frame = $trace->next_frame) {
         my %frame = (subroutine => $frame->subroutine);
         chomp($VERBOSE    # Nov. 10, 2003 did i make a typo?
         #chomp($frame{args} = $VERBOSE
            ? $frame{args} = Dumper($frame->args)
            : join(',', $frame->args)
         );
         $frame{file} = $frame->filename;
         $frame{line} = $frame->line;
         push @{$param{stack}}, \%frame;
      }
      $tmpl->param(%param);
      print $tmpl->output;
   });
}

__DATA__
<html>
<head>
<title>debug the error!!!</title>
<style type="text/css">
span.subroutine { color: blue; }
span.args       { color: red; }
span.file       { color: blue; }
span.line       { color: green; }
</style>
</head>
<body>
<h1>debug the error!!!</h1>
<pre><tmpl_var msg></pre>
<hr/>
<h3>Stacktrace</h3>
<pre>
<tmpl_loop stack>
<span class="subroutine"><tmpl_var subroutine></span>('<span class="ar
+gs"><tmpl_var args></span>')
   called at <span class="file"><tmpl_var file></span> line <span clas
+s="line"><tmpl_var line></span>
</tmpl_loop>
</pre>
</body>
</html>

    [download]

    jeffa

    L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)
[reply]
[d/l]

Back to Cool Uses for Perl