package LIMS::Local::ErrorHandler;

# http://www.stonehenge.com/merlyn/PerlJournal/col05.html

use strict;

$|++;

use Carp;
use CGI qw(:standard);
use POSIX qw(strftime);
use LIMS::Local::Mail;
use Data::Dumper;
use Sub::Exporter -setup => { exports => [ qw(set_errorhandler_args) ] };

BEGIN {
    use CGI::Application;
=begin
    use Devel::Events::Objects;
    use Devel::Cycle;
    use Devel::Events::Handler::ObjectTracker;
    use Devel::Events::Filter::RemoveFields;
    use Devel::Events::Generator::Objects;

    my $tracker = Devel::Events::Handler::ObjectTracker->new();

    my $gen = Devel::Events::Generator::Objects->new(
        handler => Devel::Events::Filter::RemoveFields->new(
            fields => [qw/generator/], # don't need to have a ref to $gen in each event
            handler => $tracker,
        ),
    );
=cut    
    no warnings 'redefine';
    *CGI::Application::__get_body = sub {
        my $self  = shift;
        my $rm    = shift;
    
        my ($rmeth, $is_autoload) = $self->__get_runmeth($rm);
    
        my $body;
#        $gen->enable();        
        eval {
            $body = $is_autoload ? $self->$rmeth($rm) : $self->$rmeth();
        };
#        $gen->disable();
=begin
        my @leaked_objects = keys %{ $tracker->live_objects };

        print "leaked ", scalar(@leaked_objects), " objects\n";

        foreach my $object ( @leaked_objects ) {
            print "Leaked object: $object\n";

            # the event that generated it
            # print Dumper( $object, $tracker->live_objects->{$object} );
            print '$object: ' . $object . "\n";
            print '$tracker->live_objects->{$object}' .  $tracker->live_objects->{$object}. "\n";
            find_cycle( $object );
        }
=cut        
        if ($@) {
            my $error = $@;
            $self->call_hook('error', $error);
            if (my $em = $self->error_mode) {
                $body = $self->$em( $error );
            }
            else {
                my $error_string = "Error executing run mode '$rm': $error";
                warn $error_string;
                LIMS::Local::ErrorHandler::fatal_error($error_string);
            }
        }

        # Make sure that $body is not undefined (suppress 'uninitialized value'
        # warnings)
        return defined $body ? $body : '';
    }
}

################################################################################
# need 'to', 'from' & 'smtp' vars supplying via $args to initiate email to admin
################################################################################

use vars qw($args);

sub set_errorhandler_args {
    $args = shift; # warn Dumper $args;
}

sub fatal_error {
    my $message = shift;

#    my ($package, $file, $line) = caller; warn Dumper ($package, $file, $line); # don't need it
    my $incident = unpack "H*", pack "NS", time, $$;

    my $time = strftime "%d-%b-%Y %H:%M:%S", localtime;
    my $user = uc $args->{user};
    
    my %report = (
        incident => $incident,
        message  => $message,
        user     => $user,
    );

    # record reason for death into the error log
    warn join "", map {
        sprintf "crash %s [%s %s]: %s\n", $incident, $user, $time, $_;
       }
       split /\n+/, $message;

    # alert admin:
    #send_email(\%report);

    # now give the user a place to record their experience
    print output(\%report);
    return;
}

sub send_email {
    my $report = shift;

    my $cfg = $args->{cgf};
    
    # need 'to', 'from' & 'smtp':
    my $to   = $cfg->{admin_contact} || return 0;
    my $from = $cfg->{email_from}    || return 0;
    my $smtp = $cfg->{smtp}          || return 0;
    
    my $subject = sprintf '%s [%s]', $report->{incident}, $report->{user};
    my $message = $report->{message};
    
    my %mail = (
        to      => $to,
        from    => $from,
        smtp    => $smtp,  
        subject => $subject,
        message => $message,
    );

    my $rtn = LIMS::Local::Mail::dispatch(\%mail);
    # do something with $rtn error if exists ?
}

sub output {
    my $report = shift;

    my $css = q!
        body {
            background: #c0c0c0;
        }
        a { text-decoration: underline }
        a:hover { text-decoration: none }
        a:visited { color: #00f }
        h2 { color: #f00; }
        th { vertical-align: top; text-align: right; }
        td { color: #00f; }
        .content {
            background: #fff;
            margin: 10px;
            border: 1px solid #000;
            padding: 0px 20px;
        }
        .message {
            color: #00f;
            padding: 10px;
            background-color: #ffffe0;
            border-top: solid 2px #c0c0c0;
            border-bottom: solid 2px #c0c0c0;
            font-style: italic;
        }
        .error {
            font-weight: bold;
            margin: 15px;
        }
        .itemhidden { display: none; }
        .itemshown { display: inline; }
    !;

    my $link = 'tell us what you were doing at the time';
    my $contact_telno = $args->{cfg}->{service_telno};
    
    my $js = qq!
    function make_blank() {
        document.form1.comments.innerHTML = "";
    }
    function toggleview (id1,id2) {
        var obj1 = document.getElementById(id1);
        var obj2 = document.getElementById(id2);
        (obj1.className=="itemshown") ? obj1.className="itemhidden" : obj1.className="itemshown";
        (obj1.className=="itemshown") ? obj2.innerHTML="$link" : obj2.innerHTML="$link";
    }!;

    my @html = (
        start_html(-title=>'500 Internal Server Error', -style=>{-code => $css}, -script => $js),
        div({-class=>'content'},
            h2('500 Internal Server Error'),
            p({-class=>'error'}, 'An error has occurred - incident number ' . $report->{incident}),
            p({-class=>'message'}, $report->{message} ),
            p( 'Relevant details have already been logged, but if you want to ',
                a({-href=>"javascript:toggleview('form','toggleform')", id=>'toggleform'}, $link),
                'it might help us determine the cause more accurately and fix the problem more easily.'),
            div({class=>'itemhidden', id=>'form'},
                hr,
                start_form(-method => 'post', -action => '/script/cgi/crash_reporter.cgi',
                   -name => 'form1'),
                hidden('incident', $report->{incident}),
                hidden('message',  $report->{message}),
                table(
                    Tr(
                        th( 'Name:' ),
                        td( textfield( -name => 'name', size => 40 ),  '[optional]'),
                    ),
                    Tr(
                        th( 'Contact telephone number:' ),
                        td( textfield( -name => 'tel', size => 40 ),  '[optional]'),
                    ),
                    Tr(
                        th( 'Email address:' ),
                        td( textfield( -name => 'email', size => 40 ),  '[optional]' ),
                    ),
                    Tr(
                        th( 'Summary:' ),
                        td(
                            textarea( -name => 'comments', rows => 10, cols => 60,
                                default=>'Describe your circumstances here. What were you trying to do?',
                                onClick=>'make_blank();', 
                            )
                        ),
                    ),
                ),
                p({align=>'center'}, submit(-value=>'Submit') ),
                end_form(),
                hr,
            ),
            p( "Or, you can contact us at $contact_telno with reference incident number "
                . $report->{incident} ),
        ),
        end_html,
    );

    unshift @html, header() if grep $ENV{$_}, qw(MOD_PERL FAST_CGI);

    return join "\n", @html;
}

1;