Perl::Metrics - The Perl Code Metrics System

  # Load or create the metrics database
  use Perl::Metrics '/var/cache/perl/metrics.sqlite';

  # Index and process a directory of code
  Perl::Metrics->process_directory( '/home/adam/code/mycpan' );

package Perl::Metrics;

use 5.00503;
use strict;
use Carp                   ();
use DBI                    ();
use File::Spec             ();
use PPI::Util              ();
use File::Find::Rule       ();
use File::Find::Rule::Perl ();
use Module::Pluggable;

use vars qw{$VERSION $TRACE};
BEGIN {
	$VERSION = '0.09';
	
	# Enable the trace flag to show trace messages during the
	# main processing loops in this class
	$TRACE = 0 unless defined $TRACE;
}

# The database structure
my $SQLITE_CREATE = <<'END_SQL';
CREATE TABLE files (
	path    TEXT    NOT NULL,
	checked INTEGER NOT NULL,
	hex_id  TEXT    NOT NULL,
	PRIMARY KEY (path)
);
CREATE TABLE metrics (
	hex_id  TEXT    NOT NULL,
	package TEXT    NOT NULL,
	version NUMERIC,
	name    TEXT    NOT NULL,
	value   TEXT,
	PRIMARY KEY (hex_id, package, name)
)
END_SQL

# Load the components
use Perl::Metrics::CDBI   ();
use Perl::Metrics::File   ();
use Perl::Metrics::Metric ();
use Perl::Metrics::Plugin ();





#####################################################################
# Setup Methods

sub import {
	my $class = shift;
	my $file  = shift or Carp::croak(
		"Did not provide a database location when loading Perl::Metrics"
		);

	# Do we already have a DSN defined?
	if ( $Perl::Metrics::CDBI::DSN ) {
		Carp::croak("Perl::Metrics has already been initialised with database $Perl::Metrics::CDBI::DSN");
	}

	# Set the file
	$Perl::Metrics::CDBI::DSN = "dbi:SQLite:dbname=$file";

	# Does the file already exist?
	# If not we'll need to create the tables now
	my $create = ! -f $file;

	# Do a test connection to the database
	my $dbh = Perl::Metrics::CDBI->db_Main;

	# Create the database if needed
	if ( $create ) {
		foreach my $sql_create_table ( split /;/, $SQLITE_CREATE ) {
			# Execute the table creation SQL
			$dbh->do( $sql_create_table ) or Carp::croak(
				"Error creating database table",
				$dbh->errstr,
				);
		}
	}

	1;
}





#####################################################################
# Perl::Metrics Methods

sub index_file {
	my $class = shift;

	# Get and check the filename
	my $path = File::Spec->canonpath(shift);
	unless ( defined $path and ! ref $path and $path ne '' ) {
		Carp::croak("Did not pass a file name to index_file");
	}
	unless ( File::Spec->file_name_is_absolute($path) ) {
		Carp::croak("Cannot index relative path '$path'. Must be absolute");
	}
	Carp::croak("Cannot index '$path'. File does not exist") unless -f $path;
	Carp::croak("Cannot index '$path'. No read permissions") unless -r _;
	my @f = stat(_);

	$class->_trace("Indexing $path... ");

	# Get the current record, if it exists
	my $file = Perl::Metrics::File->retrieve( $path );

	# If we already have a record, and it's checked time
	# is higher than the mtime of the file, the existing
	# hex_id is corrent and we can shortcut.
	if ( $file and $file->checked > $f[9] ) {
		$class->_trace("unchanged.\n");
		return $file;
	}

	# At this point we know we'll need to go to the expense of
	# generating the MD5hex value.
	my $md5hex = PPI::Util::md5hex_file( $path )
		or Carp::croak("Cannot index '$path'. Failed to generate hex_id");

	if ( $file ) {
		# Update the record to the new values
		$class->_trace("updating.\n");
		$file->checked(time);
		$file->hex_id($md5hex);
		$file->update;
	} else {
		# Create a new record
		$class->_trace("inserting.\n");
		$file = Perl::Metrics::File->insert( {
			path    => $path,
			checked => time,
			hex_id  => $md5hex,
			} );
	}

	$file;
}

sub index_directory {
	my $class = shift;

	# Get and check the directory name
	my $path = shift;
	unless ( defined $path and ! ref $path and $path ne '' ) {
		Carp::croak("Did not pass a directory name to index_directory");
	}
	unless ( File::Spec->file_name_is_absolute($path) ) {
		Carp::croak("Cannot index relative path '$path'. Must be absolute");
	}
	Carp::croak("Cannot index '$path'. Directory does not exist") unless -d $path;
	Carp::croak("Cannot index '$path'. No read permissions")      unless -r _;
	Carp::croak("Cannot index '$path'. No enter permissions")     unless -x _;

	# Search for all the applicable files in the directory
	$class->_trace("Search for files in $path...\n");
	my @files = File::Find::Rule->perl_file->in( $path );
	$class->_trace("Found " . scalar(@files) . " file(s).\n");

	# Sort the files so we index in deterministic order
	$class->_trace("Sorting files...\n");
	@files = sort @files;

	# Index the files
	$class->_trace("Indexing files...\n");
	foreach my $file ( @files ) {
		$class->index_file( $file );
	}

	scalar(@files);
}

sub process_index {
	my $class = shift;

	# Create the plugin objects
	foreach my $plugin ( $class->plugins ) {
		$class->_trace("STARTING PLUGIN $plugin...\n");
		eval "require $plugin";
		die $@ if $@;
		$plugin->new->process_index;
	}

	1;
}

sub process_directory {
	my $class = shift;
	$class->index_directory( $_[0] );
	$class->process_index;
}





#####################################################################
# Support Methods

sub _trace {
	my $class = shift;
	return 1 unless $TRACE;
	print @_;
}

1;