File Coverage

blib/lib/Plack/Middleware/Debug/LazyLoadModules.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	12	14	85.7
condition	12	15	80.0
subroutine	10	10	100.0
pod	2	2	100.0
total	77	82	93.9

package Plack::Middleware::Debug::LazyLoadModules;
use strict;
use warnings;
use Plack::Util::Accessor qw/filter class elements/;
use parent qw/Plack::Middleware::Debug::Base/;
our $VERSION = '0.06';

sub prepare_app {
    my $self = shift;
    $self->elements([qw/lazy preload/])
        unless $self->elements;
}

sub run {
    my($self, $env, $panel) = @_;

    my %modules = ();
    $modules{$_}++ for keys %INC;

    return sub {
        my %preload_modules;
        my %lazy_load_modules;
        my $preload = $self->_included('preload');
        my $lazy    = $self->_included('lazy');
        my $filter  = $self->filter;
        for my $module (keys %INC) {
            next if $filter && _is_regexp($filter) && $module !~ /$filter/;
            if ($preload && $modules{$module}) {
                $preload_modules{$self->_classnize($module)} = $INC{$module};
            }
            elsif ($lazy && !$modules{$module}) {
                $lazy_load_modules{$self->_classnize($module)} = $INC{$module};
            }
        }

        $panel->title('Lazy Load Modules');
        $panel->nav_subtitle(
            sprintf(
                "%d/%d lazy loaded",
                    scalar(keys %lazy_load_modules), scalar(keys %modules),
            )
        );
        $panel->content(
            $self->render_hash(
                +{
                    lazy    => \%lazy_load_modules,
                    preload => \%preload_modules,
                },
                $self->elements,
            )
        );
    };
}

sub _classnize {
    my ($self, $module_path) = @_;

    if ($self->class && $module_path =~ /\.pm$/) {
        $module_path =~ s!/!::!g;
        $module_path =~ s!\.pm$!!g;
    }
    return $module_path;
}

sub _is_regexp {
    (ref($_[0]) eq 'Regexp') ? 1 : 0;
}

sub _included {
    my ($self, $element) = @_;

    for my $e (@{$self->elements}) {
        return 1 if $element eq $e;
    }
    return;
}

1;

__END__