#
#  This file is part of WebDyne.
#
#  This software is copyright (c) 2025 by Andrew Speer <andrew.speer@isolutions.com.au>.
#
#  This is free software; you can redistribute it and/or modify it under
#  the same terms as the Perl 5 programming language system itself.
#
#  Full license text is available at:
#
#  <http://dev.perl.org/licenses/>
#
<html lang="en">
<head>

<!-- Heading section with status code as page title -->

<title>WebDyne Error ^{status}</title>
<meta charset="!{! $WEBDYNE_META->{'charset'} !}"/>

<!-- Embedded style sheet for formatting -->
<style>

h1 {
    font-size:1.75rem; 
    color:red;
    font-weight: 600; 
}

h2 {
    font-size:1.5rem; 
    color:maroon;
    font-weight: 600;
}

body {
    background-color: #f5f5f5; /* Light gray background */
    margin: 1rem;
    padding: 0;
    color: #333;
}

html {  
    font-family: sans-serif;
    font-size: 12px; /* or any other size you prefer */
}

td {
/*  padding: 0.75rem; */
    border-bottom: 1px solid #ebebeb;
    color: #555;
/* font-size: 0.95rem; */

}

table {
    width: 100%;
    border-collapse: collapse;
    margin-bottom: 1.5rem;
}

.td {
    background-color: #eeeeee
}

.monospace {
    font-family: monospace;
}


</style>
</head>


<!-- Begin body -->

<body>


<!-- Status code and server status message -->

<h1>WebDyne Error ^{status} </h1>
<hr>
<h2><i>!{! status_message($_[0]->r->status) !}</i></h2>

<!-- Perl section to populate blocks with error messages, backtraces etc. -->

<perl handler="err_display" param="!{! $_[1] !}"/>

<!-- Start of error table -->

<table>

<!-- The error string -->

<block name="error">
<tr><td><b>Error: </b></tr></td>

<tr><td class="td">
<br>
<span class="monospace">
${errstr}
</span>
<br>
</td></tr>
</block>

<!-- Render this if extended errors disabled -->

<block name="error_extended_disabled">
<tr><td>
<br>
<br>
<b>Backtrace: </b></tr></td>

<tr><td>
<br>
<span class="monospace">
Set WEBDYNE_ERROR_SHOW_EXTENDED=1 to display backtrace and other information.
</span>
</tr></td>
</block>

<!-- Module backtrace -->

<block name="backtrace">
<tr><td>
<br>
<br>
<b>Backtrace: </b>
</td></tr>

<tr><td class="td">
<span class="monospace">
<b>#&nbsp;&nbsp;&nbsp;Module</b><br>
<br>
<block name="backtrace_line">
${backtrace_line}&nbsp;&nbsp;${package}, line ${line}<br>
</block>
</span></td></tr>
</block>


<!-- The HTML source context -->

<block name="context">
<tr><td>
<br>
<br>
<b>Context: </b>
</td></tr>


<tr><td class="td">
<span class="monospace">
<b>#&nbsp;&nbsp;&nbsp;Source</b> ${srce_fn}<br>
<br>
<block name="context_line">
<span style="!{! $_[1]->{'line_error'} ? 'color:red' : '' !}">${line_no}&nbsp;&nbsp;${line}</span><br>
<!-- ${line_no}&nbsp;&nbsp;${line}<br> -->
</block>
</span></td></tr>
</block>


<!-- Any Eval/Code context -->

<block name="eval">
<tr><td>
<br>
<br>
<b>Code: </b>
</td></tr>


<tr><td class="td">
<span class="monospace">
<b>#&nbsp;&nbsp;&nbsp;Source</b> ${srce_fn}<br>
<br>
<block name="eval_line">
<span style="!{! $_[1]->{'line_error'} ? 'color:red' : '' !}">${line_no}&nbsp;&nbsp;${line}</span><br>
</block>
</span></td></tr>
</block>


<!-- CGI Paramaters -->

<block name="cgi_param">
<tr><td>
<br>
<br>
<b>CGI Parameters: </b>
</td></tr>

<tr><td class="td">
<br>
<pre>
${cgi_param_dump}
</pre>
</td></tr>
</block>


<!-- Environment -->

<block name="env">
<tr><td>
<br>
<br>
<b>Environment:</b>
</td></tr>

<tr><td class="td">
<br>
<pre>
${env}
</pre>
</td></tr>
</block>


<!-- WebDyne Constants -->
<block name="webdyne_constant">
<tr><td>
<br>
<br>
<b>WebDyne Constants:</b>
</td></tr>

<tr><td class="td">
<br>
<pre>
${webdyne_constant}
</pre>
</td></tr>
</block>


<!-- WebDyne Version -->
<block name="webdyne_version">
<tr><td>
<br>
<br>
<b>WebDyne Version:</b>
</td></tr>

<tr><td class="td">
<br>
<pre>
${webdyne_version}
</pre>
</td></tr>


<!-- Error internals -->
<block name="webdyne_err_internal" dump=1>
<tr><td>
<br>
<br>
<b>Error internals:</b>
</td></tr>

<tr><td class="td">
<br>
<pre>
${webdyne_err_internal}
</pre>
</td></tr>



</block>

<!-- End of error table -->

</table>


<!-- End of error table. Display requested URI -->

<br>

<block name="uri">
<b>Requested URI: </b>^{uri}
</block>

<br>

<hr>

<!-- And finally WebDyne version information -->

<block name="version">
<b>Version Information:</b>&nbsp; WebDyne Version:!{! $WebDyne::VERSION !}
</block>


</body>
</html>

__PERL__
#!perl

#  Need WebDyne Constants and some other modules
#
use WebDyne::Constant;
use HTTP::Status qw(status_message);
use Data::Dumper;
$Data::Dumper::Indent=1;
$Data::Dumper::Sortkeys=1;

#  Commented out when not actively debugging (as are debug() statements)
#  
#use WebDyne::Util qw(debug); # Commented out when not actually insertu

sub err_display {


    #  Get self ref, extract supplied params
    #
    #  Note adjustment after cgi_or and request (r) not supplied automatically anymore
    #
    #my ($self, $r, $cgi_or, $param_hr)=@_;
    my ($self, $param_hr)=@_;
    my %err_internal;
    
    
    #  Get CGI ref, request
    #
    my ($cgi_or, $r)=map { $self->$_ } qw(CGI r);


    #  Local vars used across all routines
    #
    my $errstr=$param_hr->{'errstr'};
    my @errstack=@{$param_hr->{'errstack_ar'}};
    my $errtrace_ar=pop @errstack;
    @err_internal{qw(errstr errstack errtrace_ar)}=(
        $errstr,
        \@errstack,
        $errtrace_ar
    );


    #  Get data block from paramaters and load line numbers and other params. Throw first one away
    #  because it's us being compiled. If we have an error it wil revert back to text handler
    #
    pop @{$param_hr->{'data_ar_err'}};
    my $data_ar=pop @{$param_hr->{'data_ar_err'}};

    my ($html_line_no_tag_start, $html_line_no_tag_end)=$self->data_ar_html_line_no($data_ar) if $data_ar;
    my $inline=$data_ar->[$WEBDYNE_NODE_ATTR_IX] && $data_ar->[$WEBDYNE_NODE_ATTR_IX]->{'inline'};
    @err_internal{qw(html_line_no_tag_start html_line_no_tag_end data_ar)}=(
        $html_line_no_tag_start,
        $html_line_no_tag_end,
        $data_ar
    );


    #  Get any eval text if supplied
    #
    my $eval_text_sr=$param_hr->{'err_eval_perl_sr'};
    $err_internal{'eval_text_sr'}=$eval_text_sr;
    #debug('err_internal: %s', Dumper(\%err_internal));


    #  Source file name and tag start/finish line numbers for this error
    #
    my $srce_fn=$self->data_ar_html_srce_fn($data_ar) if $data_ar;
    my $srce_fn_display=$srce_fn if $WEBDYNE_ERROR_SOURCE_FILENAME_SHOW;
    my $document_root=$r->document_root();
    unless ($WEBDYNE_ERROR_SOURCE_FILENAME_FULL) {
        $srce_fn_display=~s/^${document_root}\/?//;
        $srce_fn_display ||= '/';
    }
    $err_internal{'srce_fn'}=$srce_fn;


    #  Display error string
    #
    if ($WEBDYNE_ERROR_SHOW) {
        

        #  Translate CR's to line breaks so errors are formatted somewhat nicely and escape any HTML. Also
        #  massage line numbers displayed so make more sense in context of source file.
        #
        my $errstr_display=$errstr;
        $errstr_display=$cgi_or->escapeHTML($errstr_display);
        $errstr_display=~s/\n/<br>/g;
        $errstr_display=~s/[\x00]+/./g;


        #  Render
        #
        $self->render_block('error', errstr=>$errstr_display);
        
        
        #  Return now if full/extended error messages not required
        #
        unless ($WEBDYNE_ERROR_SHOW_EXTENDED) {
            $self->render_block('error_extended_disabled');
            return \undef;
            }

    }
    else {


        #  Output generic error message
        #
        my $errstr_display=$WEBDYNE_ERROR_SHOW_ALTERNATE;
        $self->render_block('error', errstr=>$errstr_display);
        
        
        #  Don't do any more - skip display of all other sections by just returning
        #
        return \undef;
        
    }


    #  Number of pre and post lines, max line length to show.
    #
    my $lines_pre=$WEBDYNE_ERROR_SOURCE_CONTEXT_LINES_PRE;
    my $lines_post=$WEBDYNE_ERROR_SOURCE_CONTEXT_LINES_POST;
    my $line_fragment_max=$WEBDYNE_ERROR_SOURCE_CONTEXT_LINE_FRAGMENT_MAX;


    #  Pull out the backtrace from the error handler internals and present as nicely as possible
    #
    if ($WEBDYNE_ERROR_BACKTRACE_SHOW) {


        #  Iterate through error backtrace
        #
        my $webdyne_backtrace_short=$WEBDYNE_ERROR_BACKTRACE_SHORT;
        my $backtrace_line=1;
        my $webdyne_module_seen;
        for (my $i=1; defined($errtrace_ar->[$i]); $i++) {

            
            #  Get method
            #
            my $method=$errtrace_ar->[$i+1][3] || $errtrace_ar->[$i][0] ||  last;
            

            #  If brief output look to see if we are in internal stack and quit
            #
            if ($method=~/^WebDyne::\w{32}:+/) {
                $webdyne_module_seen++;
            }
            elsif ($method=~/^WebDyne::/ && !$webdyne_module_seen) {
                $webdyne_module_seen++;
            }
            
            
            #  Skip unless we really want full trace
            #
            unless ($WEBDYNE_ERROR_BACKTRACE_FULL) {
                next if ($method=~/^\(eval\)/);
                next if ($method=~/^WebDyne::__ANON__/);
            }
            

            #  Get line no
            #
            my $line_no=$errtrace_ar->[$i][2];
            

            #  Format nicely and render line
            #
            my $backtrace_line_fmt=sprintf("%-2d",$backtrace_line);
            $self->render_block('backtrace_line',
                backtrace_line=>$backtrace_line_fmt, package=>$method, line=>$line_no);
            $backtrace_line++;

            if ($webdyne_backtrace_short && $webdyne_module_seen) {
                last;
            }


        }
        
        
        #  And render whole block
        #
        $self->render_block('backtrace');
        
    }


    #  Print source file region that caused error to show context. Only do if show source flag set
    #  and we have found a line number.
    #  
    #  Cache file in case needed for next block
    #
    if ($WEBDYNE_ERROR_SOURCE_CONTEXT_SHOW && $html_line_no_tag_start) {


        #  Pretty printing
        #
        my $sprintf_max=length($html_line_no_tag_start + $lines_post);
        $sprintf_max=2 if ($sprintf_max<2);

        
        #  Iterate through source lines till we get to area, then print
        #
        if ($srce_fn && $html_line_no_tag_start) {
                my $fh=IO::File->new($srce_fn, &Fcntl::O_RDONLY) || die;
                my $line_no;
                while (my $line=<$fh>) {
                    if ($line_no++ > ($html_line_no_tag_start - $lines_pre)) {
                        if ($line_fragment_max) {
                            $line=(length($line) > $line_fragment_max) ?
                                substr($line,0,$line_fragment_max) . '...' : $line;
                        }
                        $line=$cgi_or->escapeHTML($line);
                        my $line_no_formatted=sprintf("\%-${sprintf_max}d",$line_no);
                        $line_no_formatted=~s/ /&nbsp;/g;
                        my $line_error=($line_no >= $html_line_no_tag_start && $line_no <= $html_line_no_tag_end);
                        
                        #  Render line
                        #
                        $self->render_block('context_line',
                            line_no=>$line_no_formatted, line=>$line, line_error=>$line_error)
                    }
                    last if ($line_no > ($html_line_no_tag_end + $lines_post));
                }
                $fh->close()
        }
        
        #  Render block
        #
        $self->render_block('context', srce_fn=>$srce_fn_display);
    }



    #  Now any eval backtrace ?
    #
    if ($WEBDYNE_ERROR_EVAL_CONTEXT_SHOW && $eval_text_sr && (my $err_eval_line=$param_hr->{'err_eval_line'})) {


        #  Get the eval line
        #        
        #my $err_eval_line=$param_hr->{'err_eval_line'};
        #debug("err_eval_line: $err_eval_line, srce_fn: $srce_fn");

        #  Pretty printing
        #
        my $sprintf_max=length($err_eval_line + $lines_post);
        $sprintf_max=2 if ($sprintf_max<2);
        
        
        #  Iterate through source lines till we get to area, then print
        #
        if ($srce_fn && $err_eval_line) {


                my $fh=IO::File->new($srce_fn, &Fcntl::O_RDONLY) || die;
                my $line_no;
                while (my $line=<$fh>) {
                    if ($line_no++ > ($err_eval_line - $lines_pre)) {
                        if ($line_fragment_max) {
                            $line=(length($line) > $line_fragment_max) ?
                                substr($line,0,$line_fragment_max) . '...' : $line;
                        }
                        $line=$cgi_or->escapeHTML($line);
                        my $line_no_formatted=sprintf("\%-${sprintf_max}d",$line_no);
                        $line_no_formatted=~s/ /&nbsp;/g;
                        my $line_error=($line_no == $err_eval_line);
                        
                        #  Render line
                        #
                        $self->render_block('eval_line',
                            line_no=>$line_no_formatted, line=>$line, line_error=>$line_error)
                    }
                    last if ($line_no > ($err_eval_line + $lines_post));
                }
                $fh->close()
        }
        
        #  Render block
        #
        $self->render_block('eval', srce_fn=>$srce_fn_display);


    }


    #  Now any CGI params
    #
    if ($WEBDYNE_ERROR_CGI_PARAM_SHOW && %_) {


        #  Get message
        #
        my $cgi_param_dump=Data::Dumper->Dump([\%_], ['WebDyne::CGI']);
        $cgi_param_dump=$cgi_or->escapeHTML($cgi_param_dump);
        $cgi_param_dump=~s/[\x00]+/,/g;
        $self->render_block('cgi_param', cgi_param_dump=>$cgi_param_dump );

    }


    if ($WEBDYNE_ERROR_ENV_SHOW) {


        #  Get environment
        #
        my $env_dumper=Data::Dumper->Dump([\%ENV], ['WebDyne::ENV']);
        $env_dumper=$cgi_or->escapeHTML($env_dumper);
        $self->render_block('env', env=>$env_dumper );

    }


    if ($WEBDYNE_ERROR_WEBDYNE_CONSTANT_SHOW) {


        #  Get environment
        #
        #my $webdyne_constant_dumper=Data::Dumper->Dump([\%WebDyne::Constant::Constant], ['WebDyne::Constant']);
        
        
        #  Update - take from WebDyne module vars, don't trust hasn't changed from Constants file
        #
        my %constant;
        while (my ($k, $cv) = each %WebDyne::Constant::Constant) {
            my $wv=${"WebDyne::${k}"};
            $constant{$k}=($cv eq $wv) ? $wv : "$wv [$cv]";
        }
        my $webdyne_constant_dumper=Data::Dumper->Dump([\%constant], ['WebDyne::Constant']);
        $webdyne_constant_dumper=$cgi_or->escapeHTML($webdyne_constant_dumper);
        $self->render_block('webdyne_constant', webdyne_constant=>$webdyne_constant_dumper );

    }
    
    my %version=(
        VERSION         => $WebDyne::VERSION,
        VERSION_GIT_REF => $WebDyne::VERSION_GIT_REF
    );
    my $webdyne_version_dumper=Data::Dumper->Dump([\%version], ['WebDyne::VERSION']);
    $self->render_block('webdyne_version', webdyne_version=>$webdyne_version_dumper);


    #  Only for internal debugging when error handler goes wrong
    #
    if ($WEBDYNE_ERROR_INTERNAL_SHOW) {
        my $webdyne_err_internal_dumper=Data::Dumper->Dump([\%err_internal], ['WebDyne::ERROR']);
        $webdyne_err_internal_dumper=$cgi_or->escapeHTML($webdyne_err_internal_dumper);
        $self->render_block('webdyne_err_internal', webdyne_err_internal=>$webdyne_err_internal_dumper);
    }


    #  Render version and URI blocks
    #
    $self->render_block('uri') if $WEBDYNE_ERROR_URI_SHOW;
    #$self->render_block('version') if $WEBDYNE_ERROR_VERSION_SHOW;


    #  All done
    #
    return \undef;

}

