The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::Perl::Metrics::Lite;
use strict;
our $VERSION = '0.2';

use List::MoreUtils qw(any);
use Perl::Metrics::Lite;
use Test::More ();
use Test::Builder;

my %METRICS_ARGS;

my $TEST = Test::Builder->new;

sub import {
    my ( $self, %args ) = @_;

    my $caller = caller;
    {
        no strict 'refs';    ## no critic qw(ProhibitNoStrict)
        *{ $caller . '::all_metrics_ok' } = \&all_metrics_ok;
    }

    $TEST->exported_to($caller);

    %METRICS_ARGS = %args;
    $METRICS_ARGS{-mccabe_complexity} ||= 10;
    $METRICS_ARGS{-loc}               ||= 60;

    return 1;
}

sub all_code_files {
    my @exceptions = @{ $METRICS_ARGS{-except_dir} || [] };
    my @dirs = @_;
    if ( not @dirs ) {
        @dirs = _starting_points();
    }
    @dirs = grep { !is_excluded( $_, @exceptions ) } @dirs;
    return \@dirs;
}

sub is_excluded {
    my ( $path, @exceptions ) = @_;
    any { $path eq $_ || $path =~ /$_/ } @exceptions;
}

sub _starting_points {
    return -e 'blib' ? 'blib' : 'lib';
}

sub all_metrics_ok {
    my @dirs = @_;

    Test::More::plan('no_plan');

    if ( not @dirs ) {
        @dirs = _starting_points();
    }
    my $files = all_code_files(@dirs);

    my $analysis = _analyze_metrics($files);
    my $ok       = _all_files_metric_ok( $analysis->sub_stats );
    return $ok;
}

sub _analyze_metrics {
    my $libs     = shift;
    my $analzyer = Perl::Metrics::Lite->new;
    my $analysis = $analzyer->analyze_files(@$libs);
    return $analysis;
}

sub _all_files_metric_ok {
    my $sub_stats = shift;
    my $ok        = 0;
    foreach my $file_path ( keys %{$sub_stats} ) {
        my @except_files = @{ $METRICS_ARGS{-except_file} || [] };
        next if is_excluded( $file_path, @except_files );

        my $sub_metrics = $sub_stats->{$file_path};
        $ok = $ok or _all_sub_metrics_ok($sub_metrics);
    }
    return $ok;
}

sub _all_sub_metrics_ok {
    my $sub_metrics = shift;
    my @rows        = ();
    my $ok          = 0;
    foreach my $sub_metric ( @{$sub_metrics} ) {
        $ok = $ok or _sub_metric_ok($sub_metric);
    }
    return $ok;
}

sub _sub_metric_ok {
    my $sub_metric = shift;

    my $ok = 0;
    $ok = $ok or _sub_loc_ok($sub_metric);
    $ok = $ok or _sub_cc_ok($sub_metric);
    return $ok;
}

sub _sub_cc_ok {
    my $sub_metric = shift;

    my $cc = $sub_metric->{mccabe_complexity};
    if ( $cc < $METRICS_ARGS{-mccabe_complexity} ) {
        $TEST->ok( 1, $sub_metric->{name} . " cc is ok" );
        return 0;
    }
    else {
        $TEST->ok( 0,
            "The method is to complex! Detail: Path: $sub_metric->{path}, Method: $sub_metric->{name}, CC: ${cc}"
        );
        return 1;
    }
}

sub _sub_loc_ok {
    my $sub_metric = shift;

    my $sloc = $sub_metric->{lines};
    if ( $sloc < $METRICS_ARGS{-loc} ) {
        $TEST->ok( 1, $sub_metric->{name} . " sloc is ok" );
        return 0;
    }
    else {
        $TEST->ok( 0,
            "The method is too long! Detail: Path: $sub_metric->{path} ,Method: $sub_metric->{name}, SLOC: ${sloc}"
        );
        return 1;
    }
}

1;
__END__

=encoding utf-8

=head1 NAME

Test::Perl::Metrics::Lite - Use Perl::Metrics::Lite in test programs

=head1 SYNOPSIS

Basic usage.

  use Test::Perl::Metrics::Lite;
  all_metrics_ok();

You can change the metrics threshold.

  use Test::Perl::Metrics::Lite (-mccabe_complexity => 20, -loc => 100);
  all_metrics_ok();

Exclude some files with except_file option

  use Test::Perl::Metrics::Lite (
      -except_file => [
          'lib/SomeClass.pm',
          'lib/SomeDir/SomeClass.pm'
       ]
  );
  all_metrics_ok();


=head1 DESCRIPTION

Test::Perl::Metrics::Lite wraps the Perl::Metrics::Lite 
engine in a convenient subroutine suitable for test programs 
written using the Test::More framework

This makes it easy to integrate metrics enforcement into the build process. 

Mccabe complexity theshold is 10 and the lines of code theshold is 60.
all_metrics_ok() test is failed when metrics exceed threshold values 
relative to the baseline.

=head1 SOURCE AVAILABILITY


This source is in Github:

  http://github.com/dann/p5-test-perl-metrics-lite

=head1 AUTHOR

Dann E<lt>techmemo@gmail.comE<gt>

=head1 SEE ALSO

=head1 LICENSE

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

=cut