File Coverage

blib/lib/Perl/Metrics/Lite/Analysis/File.pm

Criterion	Covered	Total	%
statement	105	111	94.5
branch	12	20	60.0
condition	2	3	66.6
subroutine	22	23	95.6
pod	0	13	0.0
total	141	170	82.9

package Perl::Metrics::Lite::Analysis::File;
use strict;
use warnings;

use Carp qw(cluck confess);
use Perl::Metrics::Lite::Analysis;
use Perl::Metrics::Lite::Analysis::Util;
use Perl::Metrics::Lite::Analysis::DocumentFactory;

our $VERSION = '0.092';

use Module::Pluggable
    require     => 1,
    search_path => 'Perl::Metrics::Lite::Analysis::File::Plugin',
    sub_name    => 'file_plugins';

use Module::Pluggable
    require     => 1,
    search_path => 'Perl::Metrics::Lite::Analysis::Sub::Plugin',
    sub_name    => 'sub_plugins';

# Private instance variables:
my %_PATH       = ();
my %_MAIN_STATS = ();
my %_SUBS       = ();
my %_PACKAGES   = ();
my %_LINES      = ();

sub new {
    my ( $class, %parameters ) = @_;
    my $self = {};
    bless $self, $class;
    $self->_init(%parameters);
    return $self;
}

sub _init {
    my ( $self, %parameters ) = @_;
    $_PATH{$self} = $parameters{'path'};

    my $path = $self->path();

    my $document = Perl::Metrics::Lite::Analysis::DocumentFactory
        ->create_normalized_document($path);
    if ( !defined $document ) {
        cluck "Could not make a PPI document from '$path'";
        return;
    }

    my $packages
        = Perl::Metrics::Lite::Analysis::Util::get_packages($document);

    my @sub_analysis = ();
    my $sub_elements = $document->find('PPI::Statement::Sub');
    @sub_analysis = @{ $self->analyze_subs($sub_elements) };

    $_MAIN_STATS{$self} = $self->analyze_file($document);
    $_SUBS{$self}       = \@sub_analysis;
    $_PACKAGES{$self}   = $packages;
    $_LINES{$self}
        = Perl::Metrics::Lite::Analysis::Util::get_node_length($document);

    return $self;
}

sub all_counts {
    my $self       = shift;
    my $stats_hash = {
        path       => $self->path,
        lines      => $self->lines,
        main_stats => $self->main_stats,
        subs       => $self->subs,
        packages   => $self->packages,
    };
    return $stats_hash;
}

sub analyze_file {
    my ($self, $document) = @_;

    if ( !$document->isa('PPI::Document') ) {
        Carp::confess('Did not supply a PPI::Document');
    }

    my $metrics = $self->measure_file_metrics($document);
    $metrics->{path} = $self->path;
    return $metrics;
}

sub measure_file_metrics {
    my ( $self, $file ) = @_;
    my $metrics = {};
    foreach my $plugin ( $self->file_plugins ) {
        $plugin->init;
        next unless $plugin->can('init');
        next unless $plugin->can('measure');
        my $metric = $plugin->measure( $self, $file );
        my $metric_name = $self->metric_name($plugin);
        $metrics->{$metric_name} = $metric;
    }
    return $metrics;
}

sub metric_name {
    my ( $self, $plugin ) = @_;
    my $metric_name = $plugin;
    $metric_name =~ s/.*::(.*)$/$1/;
    $metric_name = _decamelize($metric_name);
    $metric_name;
}

sub _decamelize {
    my $s = shift;
    $s =~ s{([^a-zA-Z]?)([A-Z]*)([A-Z])([a-z]?)}{
        my $fc = pos($s)==0;
        my ($p0,$p1,$p2,$p3) = ($1,lc$2,lc$3,$4);
        my $t = $p0 || $fc ? $p0 : '_';
        $t .= $p3 ? $p1 ? "${p1}_$p2$p3" : "$p2$p3" : "$p1$p2";
        $t;
    }ge;
    $s;
}

sub path {
    my ($self) = @_;
    return $_PATH{$self};
}

sub main_stats {
    my ($self) = @_;
    return $_MAIN_STATS{$self};
}

sub subs {
    my ($self) = @_;
    return $_SUBS{$self};
}

sub packages {
    my ($self) = @_;
    return $_PACKAGES{$self};
}

sub lines {
    my ($self) = @_;
    return $_LINES{$self};
}

sub analyze_subs {
    my $self       = shift;
    my $found_subs = shift;

    return []
        if (
        !Perl::Metrics::Lite::Analysis::Util::is_ref( $found_subs, 'ARRAY' )
        );

    my @subs = ();
    foreach my $sub ( @{$found_subs} ) {
        my $metrics = $self->measure_sub_metrics($sub);
        $self->add_basic_sub_info( $sub, $metrics );
        push @subs, $metrics;
    }
    return \@subs;
}

sub measure_sub_metrics {
    my ( $self, $sub ) = @_;
    my $metrics = {};
    foreach my $plugin ( $self->sub_plugins ) {
        $plugin->init;
        next unless $plugin->can('init');
        next unless $plugin->can('measure');
        my $metric = $plugin->measure( $self, $sub );
        my $metric_name = $self->metric_name($plugin);
        $metrics->{$metric_name} = $metric;
    }
    return $metrics;
}

sub add_basic_sub_info {
    my ( $self, $sub, $metrics ) = @_;
    $metrics->{path} = $self->path;
    $metrics->{name} = $sub->name;
}

1;

__END__