File Coverage

blib/lib/Sledge/Plugin/DebugLeakChecker.pm

Criterion	Covered	Total	%
statement	17	35	48.5
branch	0	8	0.0
condition			n/a
subroutine	5	7	71.4
pod			n/a
total	22	50	44.0

package Sledge::Plugin::DebugLeakChecker;

use strict;
use warnings;
our $VERSION = '0.01';

use Template;
use Devel::Leak::Object qw{ GLOBAL_bless };

our $FIREBUG = 0;
our $TEMPLATE = <<'EOF';
[%- IF FIREBUG %]
 </td>
</tr>

<tr>
<td  class="h" >
<a name="14">14</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> console.log('Leak Modules'); </td>
</tr>

<tr>
<td  class="h" >
<a name="15">15</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> [%- FOR e IN devel_leak_object_count_entries %] </td>
</tr>

<tr>
<td  class="h" >
<a name="16">16</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> console.log('[% e.key %] : [% e.value %] leak[% IF e.value > 1 %]s[% END # END IF %]'); </td>
</tr>

<tr>
<td  class="h" >
<a name="17">17</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> [% END # END FOR -%] </td>
</tr>

<tr>
<td  class="h" >
<a name="18">18</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">
[% ELSE %]

        Leak Modules
         




23




 





 





 





 





 





 



             Module NameLeak Count 




24




 





 





 





 





 





 



             [%- FOR e IN devel_leak_object_count_entries %] 




25




 





 





 





 





 





 



             [% e.key | html %][% e.value | html %] 




26




 





 





 





 





 





 



             [% END # END FOR -%] 




27

            [%- FOR e IN devel_leak_object_count_entries %]

            [% END # END FOR -%]


[% END # END IF -%]

EOF

sub import {
    my $class = shift;
    my @args = @_;
    my $pkg   = caller;

    foreach my $arg (@args) {
        if(uc($arg) eq 'FIREBUG') {
            $FIREBUG = 1;
        }
    }

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

}

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

    my %devel_leak_object_count_entries;
    for (sort keys %Devel::Leak::Object::OBJECT_COUNT) {
        next unless $Devel::Leak::Object::OBJECT_COUNT{$_}; # Don't list class with count zero
        $devel_leak_object_count_entries{ sprintf( "%-40s",$_) } = $Devel::Leak::Object::OBJECT_COUNT{$_};
    }

    my $tt = Template->new;
    $tt->process(
          \$TEMPLATE,
         {
            devel_leak_object_count_entries => \%devel_leak_object_count_entries,
            FIREBUG => $FIREBUG
         },
    \my $out);

    if( $content =~ /<\/body>/ ) {
        $content =~ s/<\/body>/$out/;
    } else {
        $out =~ s/<\/body>//;
        $content .= $out;
    }
    return $content;
}

1;

=head1 NAME

Sledge::Plugin::DebugLeakChecker - Show the memory leak situation of perl modules for Sledge


=head1 VERSION

Version 0.01


=head1 SYNOPSIS

=head2 Apache setting

At first, write this in the startup.pl

    BEGIN {
        use Devel::Leak::Object qw{ GLOBAL_bless };
    }

Example of httpd.conf when I debug it.

    MinSpareServers      1
    MaxSpareServers      1
    StartServers         1
    MaxRequestsPerChild  0


=head2 Sledge Pages Class setting

B

Information is added to the lower part of Web pages displaying now.

    use Sledge::Plugin::BeforeOutput;
    use Sledge::Plugin::DebugLeakChecker;

    ...

B

It is necessary to install Firebug beforehand.

Information is output by console of the Firebug.

    use Sledge::Plugin::BeforeOutput;
    use Sledge::Plugin::DebugLeakChecker qw(Firebug);

    ...


=head1 DESCRIPTION

This module provides information that is leak situation of perl modules.

When you use mod_perl with Apache, I think it to be able to get particularly effective information.


=head1 SEE ALSO

L L

Firebug Firefox Add-ons
L

Firebug Lite for IE, Opera and Safari
L

=head1 BUGS

Please report any bugs or suggestions at
L


=head1 AUTHOR

syushi matsumoto, C<<  >>


=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009 Alink INC. all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.