Perl::Metrics::Plugin - Base class for Perl::Metrics Plugins

  # Implement a simple metrics package which counts up the
  # use of each type of magic variable.
  package Perl::Metrics::Plugin::Magic;

  use base 'Perl::Metrics::Plugin';

  # Creates the metric 'all_magic'.
  # The total number of magic variables. 
  sub metric_all_magic {
      my ($self, $Document) = @_;
      return scalar grep { $_->isa('PPI::Token::Magic') }
                    $Document->tokens;
  }

  # The number of $_ "scalar_it" magic vars
  sub metric_scalar_it {
      my ($self, $Document) = @_;
      return scalar grep { $_->content eq '$_' }
                    grep { $_->isa('PPI::Token::Magic') }
                    $Document->tokens;
  }

  # ... and so on, and so forth.

  1;

package Perl::Metrics::Plugin;

use strict;
use Carp             ();
use Class::Inspector ();
use Params::Util     '_IDENTIFIER',
                     '_INSTANCE';

use vars qw{$VERSION};
BEGIN {
	$VERSION = '0.09';
}





#####################################################################
# Constructor

sub new {
	my $class = ref $_[0] ? ref shift : shift;
	my $self  = bless {}, $class;
	$self;
}

sub class { ref $_[0] || $_[0] }





#####################################################################
# Perl::Metrics::Plugin API

sub metrics {
	my $self = shift;
	$self->{_metrics} or
	$self->{_metrics} = $self->_metrics;	
}

sub _metrics {
	my $self    = shift;
	my $class   = ref $self;
	my $funcs   = Class::Inspector->functions($class)
		or Carp::croak("Failed to get method list for '$class'");
	my %metrics = map  { $_ => undef     }
	              grep { _IDENTIFIER($_) }
	              grep { s/^metric_//s   }
	              @$funcs;
	\%metrics;
}

sub _metric {
	my ($self, $Document, $name) = @_;
	my $method = "metric_$name";
	$self->can($method) or Carp::croak("Bad metric name '$name'");
	scalar($self->$method($Document));
}

sub process_index {
	my $self  = shift;
	my @files = Perl::Metrics::File->retrieve_all;
	@files = sort { $a->path cmp $b->path } @files;
	while ( my $file = shift @files ) {
		Perl::Metrics->_trace("Processing $file... ");
		if ( $self->process_file($file) ) {
			Perl::Metrics->_trace("done.\n");
		} else {
			Perl::Metrics->_trace("error.\n");
		}
	}
	1;
}

sub process_file {
	my $self = shift;
	my $file = _INSTANCE(shift, 'Perl::Metrics::File')
		or Carp::croak("Did not pass a Perl::Metrics::File to process_file");

	# Has the file been removed since the last run
	unless ( -f $file->path ) {
		# Delete the file entry
		$file->delete;
		return 1;
	}

	# Get the metric list for the plugin, and the
	# database Metric data for this file.
	my %metrics = %{$self->metrics}; # Copy so we can destroy
	my @objects = $file->metrics(
		'package' => $self->class,
		);

	# Deal with the existing metrics objects that do not
	# require the Document in order to be processed.
	my @todo = ();
	foreach my $object ( @objects ) {
		my $name = $object->name;

		# Remove any redundant metrics
		if ( ! exists $metrics{$name} ) {
			$object->delete;
			delete $metrics{$name};
			next;
		}

		# If the metric is unversioned, we don't need to rerun
		if ( ! defined $metrics{$name} and
		     ! defined $object->version
		) {
			delete $metrics{$name};
			next;
		}

		# Must be versioned. If plugin equals stored version,
		# then no need to rerun the metric.
		if ( defined $metrics{$name}  and
		     defined $object->version and
		     $object->version == $metrics{$name}
		) {
			delete $metrics{$name};
			next;
		}

		# To do in the next pass
		push @todo, $object;
	}

	# Shortcut return now if nothing left to do
	unless ( @todo or keys %metrics ) {
		return 1;
	}

	# Any further metrics will need the document
	my $Document = eval { $file->Document };
	if ( $@ or ! $Document ) {
		# The document has gone unparsable. If this
		# is due to a PPI upgrade breaking something, we 
		# need to flush out any existing metrics for the
		# document, then skip on to the next file
		$file->metrics->delete_all;
		return 0;
	}

	# Now we have the document, update the remaining metrics
	foreach my $object ( @todo ) {
		my $name = $object->name;

		# Versions differ, or it has changed from defined to
		# not, or back the front.
		$object->version($metrics{$name});
		my $value = $self->_metric($Document, $name);
		$object->value($value);
		$object->update;
		delete $metrics{$name};
	}

	# With the existing ones out the way, generate the new ones
	foreach my $name ( sort keys %metrics ) {
		my $value = $self->_metric($Document, $name);
		Perl::Metrics::Metric->insert( {
			hex_id  => $file->hex_id,
			package => $self->class,
			name    => $name,
			version => $metrics{$name},
			value   => $value,
			} );
	}

	1;
}

1;