package CGI::Application::Plugin::DebugScreen;
use strict;
use warnings;
use Template;
use Devel::StackTrace;
use IO::File;
our $VERSION = '0.01';
our $TEMPLATE = q{
<html lang="ja">
   <head>
       <title>Error in [% title | html %]</title>
       <style type="text/css">
           body {
               font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
                           Tahoma, Arial, helvetica, sans-serif;
               color: #000;
               background-color: #F5131A;
               margin: 0px;
               padding: 0px;
           }
           :link, :link:hover, :visited, :visited:hover {
               color: #000;
           }
           div.box {
               position: relative;
               background-color: #fff;
               border: 1px solid #aaa;
               padding: 4px;
               margin: 10px;
               -moz-border-radius: 10px;
           }
           div.infos {
               background-color: #fff;
               border: 3px solid #FBEE1A;
               padding: 8px;
               margin: 4px;
               margin-bottom: 10px;
               -moz-border-radius: 10px;
           }
           h1 {
               margin: 0;
           }
           h2 {
               margin-top: 0;
               margin-bottom: 10px;
               font-size: medium;
               font-weight: bold;
               text-decoration: underline;
           }
           div.url {
               font-size: x-small;
           }
           pre {
               font-size: .8em;
               line-height: 120%;
               font-family: 'Courier New', Courier, monospace;
               background-color: #fee;
               color: #333;
               border: 1px dotted #000;
               padding: 5px;
               margin: 8px;
               width: 90%;
           }
           pre b {
               font-weight: bold;
               color: #000;
               background-color: #f99;
           }
       </style>
   </head>
   <body>
       <div class="box">
           <h1>[% title | html %]</h1>
           <div class="url">[% pages.current_url | html %]</div>
           <div class="infos">
               [% desc | html %]<br />
           </div>
           <div class="infos">
               <h2>StackTrace</h2>
               <table>
                   <tr>
                       <th>Package</th>
                       <th>Line   </th>
                       <th>File   </th>
                   </tr>
                   [% FOR s IN stacktrace -%]
                       <tr>
                           <td>[% (s.pkg  || s.package) | html %]</td>
                           <td>[%  s.line               | html %]</td>
                           <td>[% filename = (s.file || s.filename) %][% filename | html %]</td>
                       </tr>
                       <tr>
                           <td colspan="3">[% code_preview = context(filename, s.line) %][% IF code_preview %]<pre>[% code_preview %]</pre>[% END %]</td>
                       </tr>
                   [%- END %]
               </table>
           </div>
       </div>
   </body>
</html>
};
sub import {
    my $caller = scalar caller;
    $caller->add_callback( 'init', sub{
        my $self = shift;
        $caller::SIG{__DIE__} = sub{
            $self->debug_report(@_);
            #die @_;
        };
    });
    no strict 'refs';
    *{"$caller\::debug_report"} = \&debug_report;
}

sub debug_report{
    my $self = shift;
    my $desc = shift;
    my $vars = {
        desc => $desc,
        title => ref $self || $self,
        context => \&print_context,
    };
    $vars->{stacktrace} = [Devel::StackTrace->new(ignore_package=>[qw/CGI::Application::Plugin::DebugScreen Carp/])->frames];
    my $t = Template->new;
    my $output;
    $t->process(\$TEMPLATE, $vars, \$output);
    
    $self->header_props( -type => 'text/html' );
    my $headers = $self->_send_headers();
    print $headers.$output;
}

sub print_context {
    my($file, $linenum) = @_;
    my $code;
    if (-f $file) {
        my $start = $linenum - 3;
        my $end   = $linenum + 3;
        $start = $start < 1 ? 1 : $start;
        if (my $fh = IO::File->new($file, 'r')) {
            my $cur_line = 0;
            while (my $line = <$fh>) {
                ++$cur_line;
                last if $cur_line > $end;
                next if $cur_line < $start;
                my @tag = $cur_line == $linenum ? qw(<b> </b>) : ("","");
                $code .= sprintf(
                    '%s%5d: %s%s',
                        $tag[0], $cur_line, html_escape($line), $tag[1],
                );
            }
        }
    }
    return $code;
}
sub html_escape {
    my $str = shift;
    $str =~ s/&/&amp;/g;
    $str =~ s/</&lt;/g;
    $str =~ s/>/&gt;/g;
    $str =~ s/"/&quot;/g;
    return $str;
}
1;
