Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

initial commit

  • Loading branch information...
commit 46545af6c004fbc2a918d5fd4c436c4eed2968c0 0 parents
@dann authored
Showing with 1,983 additions and 0 deletions.
  1. +13 −0 .gitignore
  2. +3 −0  .shipit
  3. +4 −0 Changes
  4. +21 −0 MANIFEST.SKIP
  5. +33 −0 Makefile.PL
  6. +36 −0 README.mkdn
  7. +151 −0 lib/Perl/Metrics/Lite.pm
  8. +386 −0 lib/Perl/Metrics/Lite/Analysis.pm
  9. +306 −0 lib/Perl/Metrics/Lite/Analysis/File.pm
  10. +13 −0 lib/Perl/Metrics/Lite/Analysis/File/Plugin/Lines.pm
  11. +15 −0 lib/Perl/Metrics/Lite/Analysis/File/Plugin/NumberOfMethods.pm
  12. +15 −0 lib/Perl/Metrics/Lite/Analysis/Sub/Plugin/LineNumber.pm
  13. +14 −0 lib/Perl/Metrics/Lite/Analysis/Sub/Plugin/Lines.pm
  14. +128 −0 lib/Perl/Metrics/Lite/Analysis/Sub/Plugin/MccabeComplexity.pm
  15. +7 −0 t/0010_load_all.t
  16. +49 −0 t/0020_find_files.t
  17. +295 −0 t/0030_analyze.t
  18. +68 −0 t/0040_statistics.t
  19. +39 −0 t/0050_file.t
  20. +178 −0 t/lib/Perl/Metrics/Lite/TestData.pm
  21. +17 −0 t/more_test_files/end_token.pl
  22. +47 −0 t/more_test_files/main_subs_and_pod.pl
  23. +44 −0 t/test_files/Perl/Code/Analyze/Test/Module.pm
  24. 0  t/test_files/empty_file.pl
  25. +14 −0 t/test_files/no_packages_nor_subs
  26. +10 −0 t/test_files/not_a_perl_file
  27. +24 −0 t/test_files/package_no_subs.pl
  28. +22 −0 t/test_files/subs_no_package.pl
  29. +4 −0 xt/extra/dependency.t
  30. +10 −0 xt/extra/podspell.t
  31. +4 −0 xt/notab.t
  32. +5 −0 xt/perlcritic.t
  33. +4 −0 xt/perlcriticrc
  34. +4 −0 xt/pod.t
13 .gitignore
@@ -0,0 +1,13 @@
+cover_db
+META.yml
+Makefile
+blib
+inc
+pm_to_blib
+MANIFEST
+MANIFEST.bak
+Makefile.old
+tmon.out
+cover_db_view
+nytprof
+.DS_Store
3  .shipit
@@ -0,0 +1,3 @@
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
+git.tagpattern = release-%v
+git.push_to = origin
4 Changes
@@ -0,0 +1,4 @@
+Revision history for Perl extension Perl::Metrics::Lite
+
+0.01 Mon Dec 19 20:20:12 2011
+ * original version
21 MANIFEST.SKIP
@@ -0,0 +1,21 @@
+\bRCS\b
+\bCVS\b
+^MANIFEST\.
+^Makefile$
+~$
+^#
+\.old$
+^blib/
+^pm_to_blib
+^MakeMaker-\d
+\.gz$
+\.cvsignore
+^t/9\d_.*\.t
+^t/perlcritic
+^xt/
+^tools/
+\.svn/
+\.git/
+^[^/]+\.yaml$
+^[^/]+\.pl$
+^\.shipit$
33 Makefile.PL
@@ -0,0 +1,33 @@
+sub readme_markdown_from {
+ warn "You need to install Module::Install::ReadmeMarkdownFromPod to generate README";
+}
+
+sub author_requires {
+ warn
+ "You need to install Module::Install::AuthorRequires to install modules author requires";
+}
+sub author_tests { }
+sub auto_set_repository { }
+
+use inc::Module::Install;
+
+name 'Perl-Metrics-Lite';
+all_from 'lib/Perl/Metrics/Lite.pm';
+readme_markdown_from 'lib/Perl/Metrics/Lite.pm';
+
+requires(
+ 'Carp' => 0,
+ 'File::Basename' => 0,
+ 'File::Find' => 1.01,
+ 'File::Spec' => 0,
+ 'IO::File' => 1.14,
+ 'Readonly' => 1.03,
+ 'PPI' => 1.113,
+ 'Statistics::Basic::StdDev' => 0,
+ 'Statistics::Basic::Mean' => 0,
+ 'Statistics::Basic::Median' => 0,
+ 'Pod::Usage' => 0,
+);
+test_requires( 'Test::LoadAllModules' => 0.03 );
+auto_include;
+WriteAll;
36 README.mkdn
@@ -0,0 +1,36 @@
+# NAME
+
+Perl::Metrics::Lite -
+
+# SYNOPSIS
+
+ use Perl::Metrics::Lite;
+
+# DESCRIPTION
+
+Perl::Metrics::Lite is
+
+
+
+# SOURCE AVAILABILITY
+
+This source is in Github:
+
+ http://github.com/dann/
+
+# CONTRIBUTORS
+
+Many thanks to:
+
+
+
+# AUTHOR
+
+Dann <techmemo@gmail.com>
+
+# SEE ALSO
+
+# LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
151 lib/Perl/Metrics/Lite.pm
@@ -0,0 +1,151 @@
+package Perl::Metrics::Lite;
+use strict;
+use warnings;
+
+use Carp qw(cluck confess);
+use English qw(-no_match_vars);
+use File::Basename qw(fileparse);
+use File::Find qw(find);
+use IO::File;
+use PPI;
+use Perl::Metrics::Lite::Analysis;
+use Perl::Metrics::Lite::Analysis::File;
+use Readonly;
+
+our $VERSION = '0.01';
+
+Readonly::Scalar our $PERL_FILE_SUFFIXES => qr{ \. (:? pl | pm | t ) }sxmi;
+Readonly::Scalar our $SKIP_LIST_REGEX =>
+ qr{ \.svn | \. git | _darcs | CVS }sxmi;
+Readonly::Scalar my $PERL_SHEBANG_REGEX => qr/ \A [#] ! .* perl /sxm;
+Readonly::Scalar my $DOT_FILE_REGEX => qr/ \A [.] /sxm;
+
+sub new {
+ my ($class) = @_;
+ my $self = {};
+ bless $self, $class;
+ return $self;
+}
+
+sub analyze_files {
+ my ( $self, @dirs_and_files ) = @_;
+ my @results = ();
+ my @objects = grep { ref $_ } @dirs_and_files;
+ @dirs_and_files = grep { not ref $_ } @dirs_and_files;
+ foreach my $file (
+ ( scalar(@dirs_and_files)
+ ? @{ $self->find_files(@dirs_and_files) }
+ : ()
+ ),
+ @objects
+ )
+ {
+ my $file_analysis
+ = Perl::Metrics::Lite::Analysis::File->new( path => $file );
+ push @results, $file_analysis;
+ }
+ my $analysis = Perl::Metrics::Lite::Analysis->new( \@results );
+ return $analysis;
+}
+
+sub find_files {
+ my ( $self, @directories_and_files ) = @_;
+ foreach my $path (@directories_and_files) {
+ if ( !-r $path ) {
+ confess "Path '$path' is not readable!";
+ }
+ }
+ my @found = $self->list_perl_files(@directories_and_files);
+ return \@found;
+}
+
+sub list_perl_files {
+ my ( $self, @paths ) = @_;
+ my @files;
+
+ my $wanted = sub {
+ return if $self->should_be_skipped($File::Find::name);
+ if ( $self->is_perl_file($File::Find::name) ) {
+ push @files, $File::Find::name; ## no critic (ProhibitPackageVars)
+ }
+ };
+
+ File::Find::find( { wanted => $wanted, no_chdir => 1 }, @paths );
+
+ my @sorted_list = sort @files;
+ return @sorted_list;
+}
+
+sub should_be_skipped {
+ my ( $self, $fullpath ) = @_;
+ my ( $name, $path, $suffix ) = File::Basename::fileparse($fullpath);
+ return $path =~ $SKIP_LIST_REGEX;
+}
+
+sub is_perl_file {
+ my ( $self, $path ) = @_;
+ return if ( !-f $path );
+ my ( $name, $path_part, $suffix )
+ = File::Basename::fileparse( $path, $PERL_FILE_SUFFIXES );
+ return if $name =~ $DOT_FILE_REGEX;
+ if ( length $suffix ) {
+ return 1;
+ }
+ return _has_perl_shebang($path);
+}
+
+sub _has_perl_shebang {
+ my $path = shift;
+
+ my $fh = IO::File->new( $path, '<' );
+ if ( !-r $fh ) {
+ cluck "Could not open '$path' for reading: $OS_ERROR";
+ return;
+ }
+ my $first_line = <$fh>;
+ $fh->close();
+ return if ( !$first_line );
+ return $first_line =~ $PERL_SHEBANG_REGEX;
+}
+
+1;
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+Perl::Metrics::Lite - Pluggable Perl Code Metrics System
+
+=head1 SYNOPSIS
+
+ use Perl::Metrics::Lite;
+
+=head1 DESCRIPTION
+
+Perl::Metrics::Lite is
+
+=head1 SOURCE AVAILABILITY
+
+This source is in Github:
+
+ http://github.com/dann/p5-perl-metrics-lite
+
+=head1 CONTRIBUTORS
+
+Many thanks to:
+
+
+=head1 AUTHOR
+
+Dann E<lt>techmemo{at}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
386 lib/Perl/Metrics/Lite/Analysis.pm
@@ -0,0 +1,386 @@
+package Perl::Metrics::Lite::Analysis;
+use strict;
+use warnings;
+
+use Carp qw(confess);
+use English qw(-no_match_vars);
+use Readonly;
+use Statistics::Basic::StdDev;
+use Statistics::Basic::Mean;
+use Statistics::Basic::Median;
+
+our $VERSION = '0.01';
+
+my %_ANALYSIS_DATA = ();
+my %_FILES = ();
+my %_FILE_STATS = ();
+my %_LINES = ();
+my %_MAIN = ();
+my %_PACKAGES = ();
+my %_SUBS = ();
+my %_SUMMARY_STATS = ();
+
+sub new {
+ my ( $class, $analysis_data ) = @_;
+ if ( !is_ref( $analysis_data, 'ARRAY' ) ) {
+ confess 'Did not supply an arryref of analysis data.';
+ }
+ my $self = {};
+ bless $self, $class;
+ $self->_init($analysis_data); # Load object properties
+ return $self;
+}
+
+sub files {
+ my ($self) = @_;
+ return $_FILES{$self};
+}
+
+sub data {
+ my $self = shift;
+ return $_ANALYSIS_DATA{$self};
+}
+
+sub file_count {
+ my $self = shift;
+ return scalar @{ $self->files };
+}
+
+sub lines {
+ my $self = shift;
+ return $_LINES{$self};
+}
+
+sub packages {
+ my ($self) = @_;
+ return $_PACKAGES{$self};
+}
+
+sub package_count {
+ my $self = shift;
+ return scalar @{ $self->packages };
+}
+
+sub file_stats {
+ my $self = shift;
+ return $_FILE_STATS{$self};
+}
+
+sub main_stats {
+ my $self = shift;
+ return $_MAIN{$self};
+}
+
+sub summary_stats {
+ my $self = shift;
+ return $_SUMMARY_STATS{$self};
+}
+
+sub subs {
+ my ($self) = @_;
+ return $_SUBS{$self};
+}
+
+sub sub_count {
+ my $self = shift;
+ return scalar @{ $self->subs };
+}
+
+sub _get_min_max_values {
+ my $nodes = shift;
+ my $hash_key = shift;
+ if ( !is_ref( $nodes, 'ARRAY' ) ) {
+ confess("Didn't get an ARRAY ref, got '$nodes' instead");
+ }
+ my @sorted_values = sort _numerically map { $_->{$hash_key} } @{$nodes};
+ my $min = $sorted_values[0];
+ my $max = $sorted_values[-1];
+ return ( $min, $max, \@sorted_values );
+}
+
+sub _numerically {
+ return $a <=> $b;
+}
+
+sub _init {
+ my ( $self, $file_objects ) = @_;
+ $_ANALYSIS_DATA{$self} = $file_objects;
+
+ my @all_files = ();
+ my @packages = ();
+ my $lines = 0;
+ my @subs = ();
+ my @file_stats = ();
+ my %main_stats = ( lines => 0 );
+
+ foreach my $file ( @{ $self->data() } ) {
+ $lines += $file->lines();
+ $main_stats{lines} += $file->main_stats()->{lines};
+# $main_stats{mccabe_complexity}
+# += $file->main_stats()->{mccabe_complexity};
+ push @all_files, $file->path();
+ push @file_stats,
+ { path => $file->path, main_stats => $file->main_stats };
+ push @packages, @{ $file->packages };
+ push @subs, @{ $file->subs };
+ }
+
+ $_FILE_STATS{$self} = \@file_stats;
+ $_FILES{$self} = \@all_files;
+ $_MAIN{$self} = \%main_stats;
+ $_PACKAGES{$self} = \@packages;
+ $_LINES{$self} = $lines;
+ $_SUBS{$self} = \@subs;
+ $_SUMMARY_STATS{$self} = $self->_make_summary_stats();
+ return 1;
+}
+
+sub _make_summary_stats {
+ my $self = shift;
+ my $summary_stats = {
+ sub_length => $self->_summary_stats_sub_length,
+ sub_complexity => $self->_summary_stats_sub_complexity,
+ };
+ return $summary_stats;
+}
+
+sub _summary_stats_sub_length {
+ my $self = shift;
+
+ my %sub_length = ();
+
+ @sub_length{ 'min', 'max', 'sorted_values' }
+ = _get_min_max_values( $self->subs, 'lines' );
+
+ @sub_length{ 'mean', 'median', 'standard_deviation' }
+ = _get_mean_median_std_dev( $sub_length{sorted_values} );
+
+ return \%sub_length;
+}
+
+sub _summary_stats_sub_complexity {
+ my $self = shift;
+
+ my %sub_complexity = ();
+
+ @sub_complexity{ 'min', 'max', 'sorted_values' }
+ = _get_min_max_values( $self->subs, 'mccabe_complexity' );
+
+ @sub_complexity{ 'mean', 'median', 'standard_deviation' }
+ = _get_mean_median_std_dev( $sub_complexity{sorted_values} );
+
+ return \%sub_complexity;
+}
+
+sub is_ref {
+ my $thing = shift;
+ my $type = shift;
+ my $ref = ref $thing;
+ return if !$ref;
+ return if ( $ref ne $type );
+ return $ref;
+}
+
+sub _get_mean_median_std_dev {
+ my $values = shift;
+ my $count = scalar @{$values};
+ if ( $count < 1 ) {
+ return;
+ }
+ my $mean = sprintf '%.2f', Statistics::Basic::Mean->new($values)->query;
+
+ my $median = sprintf '%.2f',
+ Statistics::Basic::Median->new($values)->query;
+
+ my $standard_deviation = sprintf '%.2f',
+ Statistics::Basic::StdDev->new( $values, $count )->query;
+
+ return ( $mean, $median, $standard_deviation );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Perl::Metrics::Lite::Analysis - Contains anaylsis results.
+
+=head1 SYNOPSIS
+
+This is the class of objects returned by the I<analyze_files>
+method of the B<Perl::Metrics::Lite> class.
+
+Normally you would not create objects of this class directly, instead you
+get them by calling the I<analyze_files> method on a B<Perl::Metrics::Lite>
+object.
+
+=head1 VERSION
+
+This is VERSION 0.1
+
+=head1 DESCRIPTION
+
+
+=head1 USAGE
+
+=head2 new
+
+ $analysis = Perl::Metrics::Lite::Analsys->new( \@file_objects )
+
+Takes an arrayref of B<Perl::Metrics::Lite::Analysis::File> objects
+and returns a new Perl::Metrics::Lite::Analysis object.
+
+=head2 data
+
+The raw data for the analysis. This is the arrayref you passed
+as the argument to new();
+
+=head2 files
+
+Arrayref of file paths, in the order they were encountered.
+
+=head2 file_count
+
+How many Perl files were found.
+
+=head2 lines
+
+Total lines in all files, excluding comments and pod.
+
+=head2 main_stats
+
+Returns a hashref of data based the I<main> code in all files, that is,
+on the code minus all named subroutines.
+
+ {
+ lines => 723,
+ mccabe_complexity => 45
+ }
+
+=head2 file_stats
+
+Returns an arrayref of hashrefs, each entry is for one analyzed file,
+in the order they were encountered. The I<main_stats> slot in the hashref
+is for all the code in the file B<outside of> any named subroutines.
+
+ [
+ {
+ path => '/path/to/file',
+ main_stats => {
+ lines => 23,
+ path => '/path/to/file',
+ name => '{code not in named subroutines}',
+ },
+ },
+ ...
+ ]
+
+=head2 packages
+
+Arrayref of unique packages found in code.
+
+=head2 package_count
+
+How many unique packages found.
+
+=head2 subs
+
+Array ref containing hashrefs of all named subroutines,
+in the order encounted.
+
+Each hashref has the structure:
+
+ {
+ 'lines' => 19,
+ 'mccabe_complexity' => 6,
+ 'name' => 'databaseRecords',
+ 'path' => '../path/to/File.pm',
+ }
+
+=head2 sub_count
+
+How many subroutines found.
+
+=head2 summary_stats
+
+Returns a data structure of the summary counts for all the files examined:
+
+ {
+ sub_length => {
+ min => $min_sub_length,
+ max => $max_sub_length,
+ sorted_values => \@lengths_of_all_subs,
+ mean => $average_sub_length,
+ median => $median_sub_length,
+ standard_deviation => $std_dev_for_sub_lengths,
+ },
+ sub_complexity => {
+ min => $min_sub_complexity,
+ max => $max_sub_complexity,
+ sorted_values => \@complexities_of_all_subs,
+ mean => $average_sub_complexity,
+ median => $median_sub_complexity,
+ standard_deviation => $std_dev_for_sub_complexity,
+ },
+ main_complexity => {
+ min => $min_main_complexity,
+ max => $max_main_complexity,
+ sorted_values => \@complexities_of_all_subs,
+ mean => $average_main_complexity,
+ median => $median_main_complexity,
+ standard_deviation => $std_dev_for_main_complexity,
+ },
+ }
+
+
+=head1 STATIC PACKAGE SUBROUTINES
+
+Utility subs used internally, but no harm in exposing them for now.
+Call these with a fully-qualified package name, e.g.
+
+ Perl::Metrics::Lite::Analysis::is_ref($thing,'ARRAY')
+
+=head2 is_ref
+
+Takes a I<thing> and a I<type>. Returns true is I<thing> is a reference
+of type I<type>, otherwise returns false.
+
+=head1 BUGS AND LIMITATIONS
+
+None reported yet ;-)
+
+=head1 DEPENDENCIES
+
+=over 4
+
+=item L<Readonly>
+
+=item L<Statistics::Basic>
+
+=back
+
+=head1 SUPPORT
+
+Via github
+
+=head2 Disussion Forum
+
+http://www.cpanforum.com/dist/Perl-Metrics-Lite
+
+=head2 Bug Reports
+
+http://rt.cpan.org/NoAuth/Bugs.html?Dist=Perl-Metrics-Lite
+
+=head1 AUTHOR
+
+Dann
+
+=head1 SEE ALSO
+
+L<Perl::Metrics>
+L<Perl::Metrics::Simple>
+
+=cut
+
+
+
306 lib/Perl/Metrics/Lite/Analysis/File.pm
@@ -0,0 +1,306 @@
+package Perl::Metrics::Lite::Analysis::File;
+use strict;
+use warnings;
+
+use Carp qw(cluck confess);
+use English qw(-no_match_vars);
+use Perl::Metrics::Lite::Analysis;
+use PPI;
+use PPI::Document;
+use Readonly;
+
+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';
+
+our $VERSION = '0.01';
+
+Readonly::Scalar my $ALL_NEWLINES_REGEX =>
+ qr/ ( \Q$INPUT_RECORD_SEPARATOR\E ) /sxm;
+
+Readonly::Scalar my $LAST_CHARACTER => -1;
+
+# 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 = $self->_make_normalized_document($path);
+ if ( !defined $document ) {
+ cluck "Could not make a PPI document from '$path'";
+ return;
+ }
+
+ my $packages = _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, $sub_elements, \@sub_analysis );
+ $_SUBS{$self} = \@sub_analysis;
+ $_PACKAGES{$self} = $packages;
+ $_LINES{$self} = $self->get_node_length($document);
+
+ return $self;
+}
+
+sub _make_normalized_document {
+ my ($self, $path) = @_;
+
+ my $document;
+ if ( ref $path ) {
+ if ( ref $path eq 'SCALAR' ) {
+ $document = PPI::Document->new($path);
+ }
+ else {
+ $document = $path;
+ }
+ }
+ else {
+ if ( !-r $path ) {
+ Carp::confess "Path '$path' is missing or not readable!";
+ }
+ $document = _create_ppi_document($path);
+ }
+ $document = _make_pruned_document($document);
+
+ $document;
+}
+
+sub _create_ppi_document {
+ my $path = shift;
+ my $document;
+ if ( -s $path ) {
+ $document = PPI::Document->new($path);
+ }
+ else {
+
+ # The file is empty. Create a PPI document with a single whitespace
+ # chararacter. This makes sure that the PPI tokens() method
+ # returns something, so we avoid a warning from
+ # PPI::Document::index_locations() which expects tokens() to return
+ # something other than undef.
+ my $one_whitespace_character = q{ };
+ $document = PPI::Document->new( \$one_whitespace_character );
+ }
+ return $document;
+}
+
+sub _make_pruned_document {
+ my $document = shift;
+ $document = _prune_non_code_lines($document);
+ $document->index_locations();
+ $document->readonly(1);
+ return $document;
+}
+
+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 = shift;
+ my $document = shift;
+ my $sub_elements = shift;
+ my $sub_analysis = shift;
+
+ if ( !$document->isa('PPI::Document') ) {
+ Carp::confess('Did not supply a PPI::Document');
+ }
+
+ my $metrics = $self->measure_file_metrics($document);
+ $metrics->{name} = $self->{path};
+ $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('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 get_node_length {
+ my ( $self, $node ) = @_;
+ my $eval_result = eval { $node = _prune_non_code_lines($node); };
+ return 0 if not $eval_result;
+ return 0 if ( !defined $node );
+ my $string = $node->content;
+ return 0 if ( !length $string );
+
+ # Replace whitespace-newline with newline
+ $string
+ =~ s/ \s+ \Q$INPUT_RECORD_SEPARATOR\E /$INPUT_RECORD_SEPARATOR/smxg;
+ $string =~ s/\Q$INPUT_RECORD_SEPARATOR\E /$INPUT_RECORD_SEPARATOR/smxg;
+ $string =~ s/ \A \s+ //msx; # Remove leading whitespace
+ my @newlines = ( $string =~ /$ALL_NEWLINES_REGEX/smxg );
+ my $line_count = scalar @newlines;
+
+# if the string is not empty and the last character is not a newline then add 1
+ if ( length $string ) {
+ my $last_char = substr $string, $LAST_CHARACTER, 1;
+ if ( $last_char ne "$INPUT_RECORD_SEPARATOR" ) {
+ $line_count++;
+ }
+ }
+
+ return $line_count;
+}
+
+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 _get_packages {
+ my $document = shift;
+
+ my @unique_packages = ();
+ my $found_packages = $document->find('PPI::Statement::Package');
+
+ return \@unique_packages
+ if (
+ !Perl::Metrics::Lite::Analysis::is_ref( $found_packages, 'ARRAY' ) );
+
+ my %seen_packages = ();
+
+ foreach my $package ( @{$found_packages} ) {
+ $seen_packages{ $package->namespace() }++;
+ }
+
+ @unique_packages = sort keys %seen_packages;
+
+ return \@unique_packages;
+}
+
+sub analyze_subs {
+ my $self = shift;
+ my $found_subs = shift;
+
+ return []
+ if ( !Perl::Metrics::Lite::Analysis::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('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;
+}
+
+sub _prune_non_code_lines {
+ my $document = shift;
+ if ( !defined $document ) {
+ Carp::confess('Did not supply a document!');
+ }
+ $document->prune('PPI::Token::Comment');
+ $document->prune('PPI::Token::Pod');
+ $document->prune('PPI::Token::End');
+
+ return $document;
+}
+
+1;
+
+__END__
+
13 lib/Perl/Metrics/Lite/Analysis/File/Plugin/Lines.pm
@@ -0,0 +1,13 @@
+package Perl::Metrics::Lite::Analysis::File::Plugin::Lines;
+use strict;
+use warnings;
+
+sub init {}
+
+sub measure {
+ my ( $class, $context, $file ) = @_;
+ my $file_length = $context->get_node_length($file);
+ return $file_length;
+}
+
+1;
15 lib/Perl/Metrics/Lite/Analysis/File/Plugin/NumberOfMethods.pm
@@ -0,0 +1,15 @@
+package Perl::Metrics::Lite::Analysis::File::Plugin::NumberOfMethods;
+use strict;
+use warnings;
+
+sub init { }
+
+sub measure {
+ my ( $class, $context, $file ) = @_;
+ my $sub_elements = $file->find('PPI::Statement::Sub');
+ return 0 unless $sub_elements;
+ my $number_of_subs = scalar @{$sub_elements};
+ return $number_of_subs;
+}
+
+1;
15 lib/Perl/Metrics/Lite/Analysis/Sub/Plugin/LineNumber.pm
@@ -0,0 +1,15 @@
+package Perl::Metrics::Lite::Analysis::Sub::Plugin::LineNumber;
+use strict;
+use warnings;
+
+sub init {}
+
+sub measure {
+ my ( $class, $context, $sub ) = @_;
+
+ return $sub->line_number;
+}
+
+1;
+
+__END__
14 lib/Perl/Metrics/Lite/Analysis/Sub/Plugin/Lines.pm
@@ -0,0 +1,14 @@
+package Perl::Metrics::Lite::Analysis::Sub::Plugin::Lines;
+use strict;
+use warnings;
+
+sub init {
+}
+
+sub measure {
+ my ( $self, $context, $sub ) = @_;
+ my $sub_length = $context->get_node_length($sub);
+ return $sub_length;
+}
+
+1;
128 lib/Perl/Metrics/Lite/Analysis/Sub/Plugin/MccabeComplexity.pm
@@ -0,0 +1,128 @@
+package Perl::Metrics::Lite::Analysis::Sub::Plugin::MccabeComplexity;
+use strict;
+use warnings;
+
+use Readonly;
+Readonly::Array our @DEFAULT_LOGIC_OPERATORS => qw(
+ !
+ !~
+ &&
+ &&=
+ //
+ <
+ <<=
+ <=>
+ ==
+ =~
+ >
+ >>=
+ ?
+ and
+ cmp
+ eq
+ gt
+ lt
+ ne
+ not
+ or
+ xor
+ ||
+ ||=
+ ~~
+);
+
+Readonly::Array our @DEFAULT_LOGIC_KEYWORDS => qw(
+ else
+ elsif
+ for
+ foreach
+ goto
+ grep
+ if
+ last
+ map
+ next
+ unless
+ until
+ while
+);
+Readonly::Scalar my $LAST_CHARACTER => -1;
+
+our ( @LOGIC_KEYWORDS, @LOGIC_OPERATORS ); # For user-supplied values;
+
+our ( %LOGIC_KEYWORDS, %LOGIC_OPERATORS ); # Populated in _init()
+
+my %_LOGIC_KEYWORDS = ();
+my %_LOGIC_OPERATORS = ();
+
+sub init {
+ my $class = shift;
+ my @logic_keywords
+ = @LOGIC_KEYWORDS ? @LOGIC_KEYWORDS : @DEFAULT_LOGIC_KEYWORDS;
+ %LOGIC_KEYWORDS = hashify(@logic_keywords);
+ $_LOGIC_OPERATORS{$class} = \%LOGIC_KEYWORDS;
+
+ my @logic_operators
+ = @LOGIC_OPERATORS ? @LOGIC_OPERATORS : @DEFAULT_LOGIC_OPERATORS;
+ %LOGIC_OPERATORS = hashify(@logic_operators);
+ $_LOGIC_OPERATORS{$class} = \%LOGIC_OPERATORS;
+}
+
+sub measure {
+ my ( $class, $context, $elem ) = @_;
+
+ my $complexity_count = 0;
+ if ( $context->get_node_length($elem) == 0 ) {
+ return $complexity_count;
+ }
+
+ if ($elem) {
+ $complexity_count++;
+ }
+
+ # Count up all the logic keywords, weed out hash keys
+ my $keywords_ref = $elem->find('PPI::Token::Word') || [];
+ my @filtered = grep { !is_hash_key($_) } @{$keywords_ref};
+ $complexity_count += grep { exists $LOGIC_KEYWORDS{$_} } @filtered;
+
+ # Count up all the logic operators
+ my $operators_ref = $elem->find('PPI::Token::Operator');
+ if ($operators_ref) {
+ $complexity_count
+ += grep { exists $LOGIC_OPERATORS{$_} } @{$operators_ref};
+ }
+ return $complexity_count;
+}
+
+#-------------------------------------------------------------------------
+# Copied from
+# http://search.cpan.org/src/THALJEF/Perl-Critic-0.19/lib/Perl/Critic/Utils.pm
+sub hashify {
+ my @hash_keys = @_;
+ return map { $_ => 1 } @hash_keys;
+}
+
+#-------------------------------------------------------------------------
+# Copied and somehwat simplified from
+# http://search.cpan.org/src/THALJEF/Perl-Critic-0.19/lib/Perl/Critic/Utils.pm
+sub is_hash_key {
+ my $ppi_elem = shift;
+
+ my $is_hash_key = eval {
+ my $parent = $ppi_elem->parent();
+ my $grandparent = $parent->parent();
+ if ( $grandparent->isa('PPI::Structure::Subscript') ) {
+ return 1;
+ }
+ my $sib = $ppi_elem->snext_sibling();
+ if ( $sib->isa('PPI::Token::Operator') && $sib eq '=>' ) {
+ return 1;
+ }
+ return;
+ };
+
+ return $is_hash_key;
+}
+
+1;
+
7 t/0010_load_all.t
@@ -0,0 +1,7 @@
+use strict;
+use warnings;
+use Test::LoadAllModules;
+
+BEGIN {
+ all_uses_ok(search_path => 'Perl::Metrics::Lite');
+}
49 t/0020_find_files.t
@@ -0,0 +1,49 @@
+use strict;
+use warnings;
+use English qw(-no_match_vars);
+use FindBin qw($Bin);
+use Readonly;
+use Test::More tests => 6;
+
+Readonly::Scalar my $TEST_DIRECTORY => "$Bin/test_files";
+Readonly::Scalar my $EMPTY_STRING => q{};
+BEGIN { use_ok('Perl::Metrics::Lite'); }
+
+test_find_files();
+test_is_in_skip_list();
+
+exit;
+
+sub set_up {
+ my $analyzer = Perl::Metrics::Lite->new();
+}
+
+sub test_is_in_skip_list {
+ my $analyzer = set_up();
+ my @paths_to_skip = qw(
+ /foo/bar/.svn/hello.pl
+ /foo/bar/_darcs/hello.pl
+ /foo/bar/CVS/hello.pl
+ );
+ foreach my $path_to_skip ( @paths_to_skip ) {
+ ok($analyzer->should_be_skipped($path_to_skip), "is_in_skip_list($path_to_skip)");
+ }
+}
+
+sub test_find_files {
+ my $analyzer = set_up();
+ eval { $analyzer->find_files('non/existent/path'); };
+ isnt( $EVAL_ERROR, $EMPTY_STRING,
+ 'find_files() throws exception on missing path.' );
+
+ my $expected_list = [
+ "$TEST_DIRECTORY/Perl/Code/Analyze/Test/Module.pm",
+ "$TEST_DIRECTORY/empty_file.pl",
+ "$TEST_DIRECTORY/no_packages_nor_subs",
+ "$TEST_DIRECTORY/package_no_subs.pl",
+ "$TEST_DIRECTORY/subs_no_package.pl",
+ ];
+ my $found_files = $analyzer->find_files($TEST_DIRECTORY);
+ is_deeply( $found_files, $expected_list,
+ 'find_files() find expected files' );
+}
295 t/0030_analyze.t
@@ -0,0 +1,295 @@
+use strict;
+use warnings;
+use English qw(-no_match_vars);
+use Data::Dumper;
+use File::Spec qw();
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+use Perl::Metrics::Lite::TestData;
+use Readonly;
+use Test::More tests => 37;
+
+Readonly::Scalar my $TEST_DIRECTORY => "$Bin/test_files";
+Readonly::Scalar my $EMPTY_STRING => q{};
+
+BEGIN {
+ use_ok('Perl::Metrics::Lite')
+ || BAIL_OUT('Could not compile Perl::Metrics::Lite');
+ use_ok('Perl::Metrics::Lite::Analysis::File')
+ || BAIL_OUT('Could not compile Perl::Metrics::Lite::Analysis::File');
+}
+
+test_new();
+test_analyze_one_file();
+test_analyze_text_from_scalar_ref();
+test_analyze_files();
+test_analysis();
+test_is_ref();
+test_get_min_max_values();
+test_get_mean_median_std_dev();
+
+exit;
+
+sub set_up {
+ my $test_data_object = Perl::Metrics::Lite::TestData->new(
+ test_directory => $TEST_DIRECTORY );
+ return $test_data_object;
+}
+
+sub slurp {
+ my ($path) = @_;
+ open my $fh, '<', $path;
+ my $contents = do { local $INPUT_RECORD_SEPARATOR; <$fh> };
+ close $fh;
+ return \$contents;
+}
+
+sub test_analyze_one_file {
+ my $test_data_object = set_up();
+ my $test_data = $test_data_object->get_test_data;
+ my $no_package_no_sub_expected_result
+ = $test_data->{'no_packages_nor_subs'};
+ my $analysis = Perl::Metrics::Lite::Analysis::File->new(
+ path => $no_package_no_sub_expected_result->{'path'} );
+ is_deeply( $analysis->packages, [], 'Analysis of file with no packages.' );
+ is_deeply( $analysis->subs, [], 'Analysis of file with no subs.' );
+
+ my $has_package_no_subs_expected_result
+ = $test_data->{'package_no_subs.pl'};
+ my $new_analysis = Perl::Metrics::Lite::Analysis::File->new(
+ path => $has_package_no_subs_expected_result->{'path'} );
+ is_deeply(
+ $new_analysis->packages,
+ $has_package_no_subs_expected_result->{packages},
+ 'Analysis of file with one package.'
+ );
+ is_deeply( $new_analysis->subs, [],
+ 'Analysis of file with one package and no subs.' );
+
+ my $has_subs_expected_result = $test_data->{'subs_no_package.pl'};
+ my $has_subs_analysis = Perl::Metrics::Lite::Analysis::File->new(
+ path => $has_subs_expected_result->{'path'} );
+ is_deeply( $has_subs_analysis->all_counts,
+ $has_subs_expected_result, 'analyze_one_file() subs_no_package.pl' );
+
+ my $has_subs_and_package_expected_result = $test_data->{'Module.pm'};
+ my $subs_and_package_analysis = Perl::Metrics::Lite::Analysis::File->new(
+ path => $has_subs_and_package_expected_result->{'path'} );
+ is_deeply(
+ $subs_and_package_analysis->all_counts,
+ $has_subs_and_package_expected_result,
+ 'analyze_one_file() with packages and subs.'
+ );
+}
+
+sub test_analyze_text_from_scalar_ref {
+ my $test_data_object = set_up();
+ my $test_data = $test_data_object->get_test_data;
+ my $no_package_no_sub_expected_result
+ = $test_data->{'no_packages_nor_subs'};
+
+ my $ref_to_text = slurp( $no_package_no_sub_expected_result->{'path'} );
+
+ my $analysis
+ = Perl::Metrics::Lite::Analysis::File->new( path => $ref_to_text );
+ is_deeply( $analysis->packages, [], 'Analysis of file with no packages.' );
+ is_deeply( $analysis->subs, [], 'Analysis of file with no subs.' );
+
+ my $has_package_no_subs_expected_result
+ = $test_data->{'package_no_subs.pl'};
+ my $has_package_no_subs_contents
+ = slurp( $has_package_no_subs_expected_result->{'path'} );
+ my $new_analysis = Perl::Metrics::Lite::Analysis::File->new(
+ path => $has_package_no_subs_contents );
+ is_deeply(
+ $new_analysis->packages,
+ $has_package_no_subs_expected_result->{packages},
+ 'Analysis of file with one package.'
+ );
+ is_deeply( $new_analysis->subs, [],
+ 'Analysis of file with one package and no subs.' );
+
+ my $has_subs_expected_result = $test_data->{'subs_no_package.pl'};
+ $ref_to_text = slurp( $has_subs_expected_result->{'path'} );
+
+ $has_subs_expected_result->{'subs'}[0]{'path'} = $ref_to_text;
+ $has_subs_expected_result->{'subs'}[1]{'path'} = $ref_to_text;
+ $has_subs_expected_result->{'path'} = $ref_to_text;
+ $has_subs_expected_result->{'file_stats'}{'path'} = $ref_to_text;
+ my $has_subs_analysis
+ = Perl::Metrics::Lite::Analysis::File->new( path => $ref_to_text );
+ is_deeply( $has_subs_analysis->all_counts,
+ $has_subs_expected_result, 'analyze_one_file() subs_no_package.pl' );
+
+ my $has_subs_and_package_expected_result = $test_data->{'Module.pm'};
+ $ref_to_text = slurp( $has_subs_and_package_expected_result->{'path'} );
+ $has_subs_and_package_expected_result->{'path'} = $ref_to_text;
+ $has_subs_and_package_expected_result->{'subs'}[0]{'path'} = $ref_to_text;
+ $has_subs_and_package_expected_result->{'subs'}[1]{'path'} = $ref_to_text;
+ $has_subs_and_package_expected_result->{'subs'}[2]{'path'} = $ref_to_text;
+ $has_subs_and_package_expected_result->{'file_stats'}{'path'}
+ = $ref_to_text;
+ my $subs_and_package_analysis
+ = Perl::Metrics::Lite::Analysis::File->new( path => $ref_to_text );
+ is_deeply(
+ $subs_and_package_analysis->all_counts,
+ $has_subs_and_package_expected_result,
+ 'analyze_one_file() with packages and subs.'
+ );
+}
+
+sub test_analyze_files {
+ my $test_data_object = set_up();
+ my $test_data = $test_data_object->get_test_data;
+ my $analyzer = Perl::Metrics::Lite->new();
+ my $analysis_of_one_file
+ = $analyzer->analyze_files( $test_data->{'Module.pm'}->{path} );
+ isa_ok( $analysis_of_one_file, 'Perl::Metrics::Lite::Analysis' );
+ my $expected_from_one_file = $test_data->{'Module.pm'};
+ is( scalar @{ $analysis_of_one_file->data },
+ 1, 'Analysis has only 1 element.' );
+ isa_ok(
+ $analysis_of_one_file->data->[0],
+ 'Perl::Metrics::Lite::Analysis::File'
+ );
+ is_deeply( $analysis_of_one_file->data->[0]->all_counts,
+ $expected_from_one_file,
+ 'analyze_files() when given a single file path.' )
+ || diag Dumper $analysis_of_one_file->data;
+
+ my $analysis = $analyzer->analyze_files($TEST_DIRECTORY);
+ my @expected = (
+ $test_data->{'Module.pm'},
+ $test_data->{'empty_file.pl'},
+ $test_data->{'no_packages_nor_subs'},
+ $test_data->{'package_no_subs.pl'},
+ $test_data->{'subs_no_package.pl'},
+ );
+ is( scalar @{ $analysis->data },
+ scalar @expected,
+ 'analayze_files() gets right number of files.'
+ );
+
+ for my $i ( scalar @expected ) {
+ is_deeply( $analysis->data->[$i],
+ $expected[$i], 'Got expected results for test file.' );
+ }
+}
+
+sub test_analysis {
+ my $test_data_object = set_up();
+ my $test_data = $test_data_object->get_test_data;
+ my $analyzer = Perl::Metrics::Lite->new;
+ my $analysis = $analyzer->analyze_files($TEST_DIRECTORY);
+
+ my $expected_lines;
+ map { $expected_lines += $test_data->{$_}->{lines} }
+ keys %{$test_data};
+ is( $analysis->lines, $expected_lines,
+ 'analysis->lines() returns correct number' );
+
+ my @expected_files = (
+ $test_data->{'Module.pm'}->{path},
+ $test_data->{'empty_file.pl'}->{path},
+ $test_data->{'no_packages_nor_subs'}->{path},
+ $test_data->{'package_no_subs.pl'}->{path},
+ $test_data->{'subs_no_package.pl'}->{path},
+ );
+ is_deeply( $analysis->files, \@expected_files,
+ 'analysis->files() contains expected files.' );
+ is( $analysis->file_count,
+ scalar @expected_files,
+ 'file_count() returns correct number.'
+ );
+
+ my @expected_packages = (
+ 'Perl::Metrics::Lite::Test::Module',
+ 'Perl::Metrics::Lite::Test::Module::InnerClass',
+ 'Hello::Dolly',
+ );
+ is_deeply( $analysis->packages, \@expected_packages,
+ 'analysis->packages() returns expected list.' );
+ is( $analysis->package_count,
+ scalar @expected_packages,
+ 'analysis->package_count returns correct number.'
+ );
+
+ my @expected_subs = ();
+ foreach my $test_file ( sort keys %{$test_data} ) {
+ my @subs = @{ $test_data->{$test_file}->{subs} };
+ if ( scalar @subs ) {
+ push @expected_subs, @subs;
+ }
+ }
+
+ is_deeply( $analysis->subs, \@expected_subs,
+ 'analysis->subs() returns expected list.' );
+
+ is( $analysis->sub_count,
+ scalar @expected_subs,
+ 'analysis->subs_count returns correct number.'
+ );
+
+ my $expected_file_stats = $test_data_object->get_file_stats;
+ is_deeply( $analysis->file_stats, $expected_file_stats,
+ 'analysis->file_stats returns expected data.' );
+ return 1;
+}
+
+sub test_new {
+ eval { my $analysis = Perl::Metrics::Lite::Analysis->new() };
+ like(
+ $EVAL_ERROR,
+ qr/Did not supply an arryref of analysis data/,
+ 'new() throws exception when no data supplied.'
+ );
+
+ my $test_path_1 = File::Spec->join( $TEST_DIRECTORY, 'package_no_subs.pl' );
+ my $file_object_1
+ = Perl::Metrics::Lite::Analysis::File->new( path => $test_path_1 );
+ my $test_path_2 = File::Spec->join( $TEST_DIRECTORY, 'subs_no_package.pl' );
+ my $file_object_2
+ = Perl::Metrics::Lite::Analysis::File->new( path => $test_path_2 );
+ my $analysis = Perl::Metrics::Lite::Analysis->new(
+ [ $file_object_1, $file_object_2 ] );
+
+ isa_ok( $analysis, 'Perl::Metrics::Lite::Analysis' );
+
+ return 1;
+}
+
+sub test_is_ref {
+ my $not_a_ref = 'hello';
+ is( Perl::Metrics::Lite::Analysis::is_ref( $not_a_ref, 'ARRAY' ),
+ undef, 'is_ref() returns undef on a string.' );
+ my $array_ref = [];
+ ok( Perl::Metrics::Lite::Analysis::is_ref( $array_ref, 'ARRAY' ),
+ 'is_ref() returns true for ARRAY ref.' );
+ my $hash_ref = {};
+ ok( Perl::Metrics::Lite::Analysis::is_ref( $hash_ref, 'HASH' ),
+ 'is_ref() returns true for HASH ref.' );
+ is( Perl::Metrics::Lite::Analysis::is_ref( $array_ref, 'HASH' ),
+ undef, 'is_ref() knows an array ref is not a HASH' );
+ return 1;
+}
+
+sub test_get_min_max_values {
+ eval { Perl::Metrics::Lite::Analysis::_get_min_max_values('some-string') };
+ like(
+ $EVAL_ERROR,
+ qr/Didn't get an ARRAY ref/,
+ '_get_min_max_values() throws exception when no array ref passed.'
+ );
+ return 1;
+}
+
+sub test_get_mean_median_std_dev {
+ my @empty_array = ();
+ is( Perl::Metrics::Lite::Analysis::_get_mean_median_std_dev(
+ \@empty_array
+ ),
+ undef,
+ '_get_mean_median_std_dev() returns undef when passed empty array.'
+ );
+ return 1;
+}
68 t/0040_statistics.t
@@ -0,0 +1,68 @@
+use strict;
+use warnings;
+use File::Spec qw();
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+use Perl::Metrics::Lite;
+use Perl::Metrics::Lite::TestData;
+use Readonly;
+use Test::More tests => 12;
+
+Readonly::Scalar my $TEST_DIRECTORY => "$Bin/test_files";
+
+test_main_stats();
+test_summary_stats();
+
+exit;
+
+sub set_up {
+ my $counter = Perl::Metrics::Lite->new;
+ return $counter;
+}
+
+sub test_main_stats {
+ my $counter = set_up();
+
+ my @files_to_test = qw(main_subs_and_pod.pl end_token.pl);
+
+ foreach my $test_file (@files_to_test) {
+ my $path_to_test_file
+ = File::Spec->join( $Bin, 'more_test_files', $test_file );
+ require $path_to_test_file;
+ my ( $pkg_name, $suffix ) = split / \. /x, $test_file;
+ my $var_name = '$' . $pkg_name . '::' . 'EXPECTED_LOC';
+ my $expected_count = eval "$var_name";
+ if ( !$expected_count ) {
+ Test::More::BAIL_OUT(
+ "Could not get expected value from '$path_to_test_file'");
+ }
+ my $analysis = $counter->analyze_files($path_to_test_file);
+ Test::More::is( $analysis->main_stats()->{'lines'},
+ $expected_count, "main_stats() number of lines for '$test_file'" );
+ }
+
+ return 1;
+}
+
+sub test_summary_stats {
+ my $counter = set_up();
+ my $analysis = $counter->analyze_files($TEST_DIRECTORY);
+ my $sub_length = $analysis->summary_stats->{sub_length};
+ cmp_ok( $sub_length->{min}, '==', 1, 'minimum sub length.' );
+ cmp_ok( $sub_length->{max}, '==', 9, 'maximum sub length.' );
+ cmp_ok( $sub_length->{mean}, '==', 5.2, 'mean (average) sub length.' );
+ cmp_ok( $sub_length->{median}, '==', 5, 'median sub length.' );
+ cmp_ok( $sub_length->{standard_deviation},
+ '==', 3.37, 'standard deviation of sub length.' );
+
+ my $sub_complexity = $analysis->summary_stats->{sub_complexity};
+ cmp_ok( $sub_complexity->{min}, '==', 1, 'minimum sub complexity.' );
+ cmp_ok( $sub_complexity->{max}, '==', 8, 'maximum sub complexity.' );
+ cmp_ok( $sub_complexity->{mean},
+ '==', 3.2, 'mean (average) sub complexity.' );
+ cmp_ok( $sub_complexity->{median}, '==', 1, 'median sub complexity.' );
+ cmp_ok( $sub_complexity->{standard_deviation},
+ '==', 2.86, 'standard deviation of sub complexity.' );
+ return 1;
+}
+
39 t/0050_file.t
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+use English qw(-no_match_vars);
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+use PPI;
+use Perl::Metrics::Lite::Analysis::File;
+use Readonly;
+use Test::More tests => 2;
+
+Readonly::Scalar my $TEST_DIRECTORY => "$Bin/test_files";
+Readonly::Scalar my $EMPTY_STRING => q{};
+
+test_get_node_length();
+
+exit;
+
+sub test_get_node_length {
+ my $test_file = "$TEST_DIRECTORY/not_a_perl_file";
+ my $file_counter =
+ Perl::Metrics::Lite::Analysis::File->new( path => $test_file );
+ my $one_line_of_code = q{print "Hello world\n";};
+ my $one_line_node = PPI::Document->new( \$one_line_of_code );
+ is( $file_counter->get_node_length($one_line_node),
+ 1, 'get_node_length for one line of code.' );
+
+ my $four_lines_of_code = <<'EOS';
+ use Foo;
+ my $object = Foo->new;
+ # This is a comment.
+ my $result = $object->calculate();
+ return $result;
+EOS
+ my $four_line_node = PPI::Document->new( \$four_lines_of_code );
+ is( $file_counter->get_node_length($four_line_node),
+ 4, 'get_node_length for 4 lines of code.' ) ||diag $four_lines_of_code;
+ return 1;
+}
+
178 t/lib/Perl/Metrics/Lite/TestData.pm
@@ -0,0 +1,178 @@
+# $Header$
+# $Revision$
+# $Author$
+# $Source$
+# $Date$
+###############################################################################
+
+package Perl::Metrics::Lite::TestData;
+use strict;
+use warnings;
+
+use Carp qw(confess);
+use English qw(-no_match_vars);
+use Readonly;
+
+our $VERSION = '0.01';
+
+# Bad hack. Do this in the data instead!
+our @ORDER_OF_FILES = qw(
+ Module.pm
+ empty_file.pl
+ no_packages_nor_subs
+ package_no_subs.pl
+ subs_no_package.pl
+);
+
+my %TestData = ();
+
+sub new {
+ my ( $class, %parameters ) = @_;
+ my $self = {};
+ bless $self, ref $class || $class;
+ $TestData{$self} = $self->make_test_data( $parameters{test_directory} );
+ return $self;
+}
+
+sub get_test_data {
+ my $self = shift;
+ return $TestData{$self};
+}
+
+sub get_main_stats {
+ my $self = shift;
+ my $test_data = $self->get_test_data;
+ my $main_stats = {};
+
+ foreach my $file_name (@ORDER_OF_FILES) {
+ my $hash = $test_data->{$file_name};
+ $main_stats->{lines} += $hash->{main_stats}->{lines};
+ $main_stats->{mccabe_complexity} +=
+ $hash->{main_stats}->{mccabe_complexity};
+ }
+ return $main_stats;
+}
+
+sub get_file_stats {
+ my $self = shift;
+ my $test_data = $self->get_test_data;
+ my @file_stats = ();
+ foreach my $file_name (@ORDER_OF_FILES) {
+ my $hash = $test_data->{$file_name};
+ my $stats_hash_for_one_file = {
+ path => $hash->{path},
+ main_stats => $hash->{main_stats},
+ };
+ push @file_stats, $stats_hash_for_one_file;
+ }
+ return \@file_stats;
+}
+
+sub make_test_data {
+ my $self = shift;
+ my $test_directory = shift;
+ if ( !-d $test_directory ) {
+ confess "test_directory '$test_directory' not found! ";
+ }
+ my $test_data = bless {
+ 'no_packages_nor_subs' => {
+ path => "$test_directory/no_packages_nor_subs",
+ lines => 4,
+ main_stats => {
+ lines => 4,
+ name => '{code not in named subroutines}',
+ path => "$test_directory/no_packages_nor_subs",
+ },
+ subs => [],
+ packages => [],
+ },
+ 'empty_file.pl' => {
+ path => "$test_directory/empty_file.pl",
+ lines => 0,
+ main_stats => {
+ lines => 0,
+ name => '{code not in named subroutines}',
+ path => "$test_directory/empty_file.pl",
+ },
+ subs => [],
+ packages => [],
+ },
+ 'package_no_subs.pl' => {
+ path => "$test_directory/package_no_subs.pl",
+ lines => 12,
+ main_stats => {
+ lines => 12,
+ name => '{code not in named subroutines}',
+ path => "$test_directory/package_no_subs.pl",
+ },
+ subs => [
+
+ ],
+ packages => ['Hello::Dolly'],
+ },
+ 'subs_no_package.pl' => {
+ path => "$test_directory/subs_no_package.pl",
+ lines => 8,
+ main_stats => {
+ lines => 5,
+ name => '{code not in named subroutines}',
+ path => "$test_directory/subs_no_package.pl",
+ },
+ subs => [
+ {
+ name => 'foo',
+ lines => 1,
+ mccabe_complexity => 1,
+ path => "$test_directory/subs_no_package.pl",
+ },
+ {
+ name => 'bar',
+ lines => 2,
+ mccabe_complexity => 1,
+ path => "$test_directory/subs_no_package.pl",
+ }
+ ],
+ packages => [],
+ },
+ 'Module.pm' => {
+ path => "$test_directory/Perl/Code/Analyze/Test/Module.pm",
+ lines => 29,
+ main_stats => {
+ lines => 6,
+ name => '{code not in named subroutines}',
+ path => "$test_directory/Perl/Code/Analyze/Test/Module.pm",
+ },
+ subs => [
+ {
+ name => 'new',
+ lines => 5,
+ mccabe_complexity => 1,
+ path => "$test_directory/Perl/Code/Analyze/Test/Module.pm",
+ },
+ {
+ name => 'foo',
+ lines => 9,
+ mccabe_complexity => 8,
+ path => "$test_directory/Perl/Code/Analyze/Test/Module.pm",
+ },
+ {
+ name => 'say_hello',
+ lines => 9,
+ mccabe_complexity => 5,
+ path => "$test_directory/Perl/Code/Analyze/Test/Module.pm",
+ },
+ ],
+ packages => [
+ 'Perl::Metrics::Lite::Test::Module',
+ 'Perl::Metrics::Lite::Test::Module::InnerClass'
+ ],
+ },
+ },
+ 'Perl::Metrics::Lite::Analysis';
+ return $test_data;
+}
+1;
+__END__
+
+
+
17 t/more_test_files/end_token.pl
@@ -0,0 +1,17 @@
+# $Header: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/more_test_files/end_token.pl,v 1.1 2008/03/15 18:07:51 matisse Exp $
+# $Revision: 1.1 $
+# $Author: matisse $
+# $Source: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/more_test_files/end_token.pl,v $
+# $Date: 2008/03/15 18:07:51 $
+
+package end_token; # 1
+
+our $VERSION = '1.0'; # 2
+
+our $EXPECTED_LOC = 4; #3
+
+# the __END__ token also counts as a line of code
+__END__
+
+The idea here is that the count of lines for this file should
+not include anything after the __END__ token.
47 t/more_test_files/main_subs_and_pod.pl
@@ -0,0 +1,47 @@
+# $Header: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/more_test_files/main_subs_and_pod.pl,v 1.1 2008/03/15 18:07:51 matisse Exp $
+# $Revision: 1.1 $
+# $Author: matisse $
+# $Source: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/more_test_files/main_subs_and_pod.pl,v $
+# $Date: 2008/03/15 18:07:51 $
+
+package main_subs_and_pod; # 1
+
+use strict; # 2
+use warnings; # 3
+
+our $VERSION = '1.0'; # 4
+
+our $EXPECTED_LOC = 17; #5
+
+exit run(@ARGV) if not caller(); # 6
+
+sub run {
+ my @args = @_;
+ say( @args );
+ return 1;
+}
+
+sub say {
+ my @args = @_;
+ print "@args";
+}
+
+1; # 7 This line is in "main" and so counts as a non-subroutine line.
+
+# the __END__ token also counts as a line of code.s
+__END__
+
+bad_line of code
+
+=pod
+
+=head1 NAME
+
+Fake::Package::For::Testing
+
+=head1 DESCRIPTION
+
+Used to test counts of lines not in any subroutine. That count should NOT
+includes comments and pod.
+
+=cut
44 t/test_files/Perl/Code/Analyze/Test/Module.pm
@@ -0,0 +1,44 @@
+# $Header: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/test_files/Perl/Code/Analyze/Test/Module.pm,v 1.7 2006/11/23 22:25:48 matisse Exp $
+# $Revision: 1.7 $
+# $Author: matisse $
+# $Source: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/test_files/Perl/Code/Analyze/Test/Module.pm,v $
+# $Date: 2006/11/23 22:25:48 $
+###############################################################################
+
+# This is a comment. I love comments.
+
+package Perl::Metrics::Lite::Test::Module;
+
+use strict;
+use warnings;
+
+sub new {
+ my ( $class, @args ) = @_;
+ my $self = { _args => \@args, };
+ return bless $self, $class;
+}
+
+sub foo {
+ my ($self) = @_;
+ foreach my $thing ( @{ $self->{_args} } ) {
+ $self->say_hello($thing);
+ next if ( $thing eq 'goodbye' );
+ last if ( $thing eq 'bailout' );
+ }
+ return $self->{_args};
+}
+
+package Perl::Metrics::Lite::Test::Module::InnerClass;
+
+sub say_hello {
+ my ( $self, $name ) = @_;
+ if ( $name && $name ne 'Fred' ) {
+ return print "Hello $name\n";
+ }
+ else {
+ return print "Hello Kiddo\n";
+ }
+}
+
+package Perl::Metrics::Lite::Test::Module; # back to original package
+1;
0  t/test_files/empty_file.pl
No changes.
14 t/test_files/no_packages_nor_subs
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+# $Header: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/test_files/no_packages_nor_subs,v 1.2 2006/09/03 17:13:29 matisse Exp $
+# $Revision: 1.2 $
+# $Author: matisse $
+# $Source: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/test_files/no_packages_nor_subs,v $
+# $Date: 2006/09/03 17:13:29 $
+###############################################################################
+
+use strict;
+use warnings;
+
+print "Hello world.\n";
+
+exit;
10 t/test_files/not_a_perl_file
@@ -0,0 +1,10 @@
+# not a perl file
+# $Header: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/test_files/not_a_perl_file,v 1.2 2006/09/03 17:13:29 matisse Exp $
+# $Revision: 1.2 $
+# $Author: matisse $
+# $Source: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/test_files/not_a_perl_file,v $
+# $Date: 2006/09/03 17:13:29 $
+###############################################################################
+
+This file is not a Perl file. It is part of the test data, but should not
+be found in any analysis.
24 t/test_files/package_no_subs.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+# $Header: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/test_files/package_no_subs.pl,v 1.4 2006/11/23 22:25:48 matisse Exp $
+# $Revision: 1.4 $
+# $Author: matisse $
+# $Source: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/test_files/package_no_subs.pl,v $
+# $Date: 2006/11/23 22:25:48 $
+###############################################################################
+
+package Hello::Dolly;
+
+use strict;
+use warnings;
+
+START:
+print "Hello world.\n";
+print "I have a package.\n";
+print "I have no subs.\n";
+
+for ( 1..5 ) {
+ print "$_\n";
+}
+goto START;
+
+exit;
22 t/test_files/subs_no_package.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+# $Header: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/test_files/subs_no_package.pl,v 1.4 2006/09/24 19:18:06 matisse Exp $
+# $Revision: 1.4 $
+# $Author: matisse $
+# $Source: /Library/VersionControl/CVS/Perl-Metrics-Simple/t/test_files/subs_no_package.pl,v $
+# $Date: 2006/09/24 19:18:06 $
+###############################################################################
+
+use strict;
+use warnings;
+
+print "Hello world.\n" if ( @ARGV );
+
+my $code_ref = sub { print "Hi there\n"; }; # Will not be counted
+exit;
+
+sub foo {};
+sub bar {
+ # This is the second line of the sub
+
+ # This is the fourth line of the sub
+}
4 xt/extra/dependency.t
@@ -0,0 +1,4 @@
+use Test::Dependencies
+ exclude => [qw/Test::Dependencies Test::Base Test::Perl::Critic Perl::Metrics::Lite/],
+ style => 'light';
+ok_dependencies();
10 xt/extra/podspell.t
@@ -0,0 +1,10 @@
+use Test::More;
+eval q{ use Test::Spelling };
+plan skip_all => "Test::Spelling is not installed." if $@;
+add_stopwords(map { split /[\s\:\-]/ } <DATA>);
+$ENV{LANG} = 'C';
+set_spell_cmd("aspell list");
+all_pod_files_spelling_ok('lib');
+__DATA__
+Dann
+Perl::Metrics::Lite
4 xt/notab.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::NoTabs";
+plan skip_all => "Test::NoTabs required for testing POD" if $@;
+all_perl_files_ok();
5 xt/perlcritic.t
@@ -0,0 +1,5 @@
+use strict;
+use Test::More;
+eval { use Test::Perl::Critic -profile => 'xt/perlcriticrc' };
+plan skip_all => "Test::Perl::Critic is not installed." if $@;
+all_critic_ok('lib');
4 xt/perlcriticrc
@@ -0,0 +1,4 @@
+[TestingAndDebugging::ProhibitNoStrict]
+allow=refs
+[TestingAndDebugging::RequireUseStrict]
+equivalent_modules = Mouse Mouse::Role
4 xt/pod.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
Please sign in to comment.
Something went wrong with that request. Please try again.