File Coverage

blib/lib/Sledge/Plugin/DebugMessage.pm

Criterion	Covered	Total	%
statement	23	43	53.4
branch	0	10	0.0
condition	0	4	0.0
subroutine	7	10	70.0
pod	1	1	100.0
total	31	68	45.5

package Sledge::Plugin::DebugMessage;
use strict;
use warnings;
our $VERSION = '0.04';

use Jcode;
use Data::Dumper;
use Template;

our $LOG_SIZE = 20;
our $TEMPLATE = <<'EOF';

        debug message

            [%- FOR v IN pages.session.param('_debug_msg') %]
            [% v.replace("\n", "") | html %]
            [%- END %]

        tmpl
         




21




 





 





 





 





 





 



             [%- FOR v IN pages.tmpl.param() %] 




22




 





 





 





 





 





 



             [% v | html %][% pages.tmpl.param(v) | html %] 




23




 





 





 





 





 





 



             [%- END %] 




24
            [%- FOR v IN pages.tmpl.param() %]

            [%- END %]

        r
         




27




 





 





 





 





 





 



             [%- FOR v IN pages.r.param() %] 




28




 





 





 





 





 





 



             [% v | html %][% pages.r.param(v) | html %] 




29




 





 





 





 





 





 



             [%- END %] 




30
            [%- FOR v IN pages.r.param() %]

            [%- END %]

        session
         




33




 





 





 





 





 





 



             [%- FOR v IN pages.session.param() %] 




34




 





 





 





 





 





 



             [% v | html %][% pages.session.param(v) | html %] 




35




 





 





 





 





 





 



             [%- END %] 




36
            [%- FOR v IN pages.session.param() %]

            [%- END %]

        last_mail
        [% last_mail | html %]

EOF

sub import {
    my $class = shift;
    my $pkg   = caller;

    $pkg->register_hook(BEFORE_OUTPUT => sub {
        my $self = shift;
        if ($self->debug_level) {
            $self->add_filter(sub {
                $class->_debug_message_filter(@_);
            });
        }
    });

    no strict 'refs';
    *{"$pkg\::debug"} = \&debug;
}

sub debug {
    my $self = shift;
    my $msg  = shift;

    if ($self->debug_level) {
        my ($package, $filename, $line) = caller(0);
        my $page = $self->page || 'index';
        my $dumped = Dumper(@_);
        my $dbg_line = "$page, $package($line) : $msg : $dumped";
        if ($self->session) {
            $self->session->param(
                '_debug_msg' => [(
                    $dbg_line,
                    @{$self->session->param('_debug_msg') || []},
                )[0..$LOG_SIZE]]
            );
        }
    }
}

sub _debug_message_filter {
    my ($self, $pages, $content) = @_;

    my $last_mail = $pages->session ? Jcode->new($pages->session->param('last_mail') || '', 'jis')->euc : '';

    my $tt = Template->new;
    $tt->process(\$TEMPLATE, {pages => $pages, last_mail => $last_mail}, \my $out);
    $content =~ s{}{$out};

    return $content;
}

1;
__END__