Class::Sniff

Ovid on 2009-01-30T12:13:34

So I want a class inspector which will let me check for some common code smells in classes. As mentioned previously, I have a class with 255 methods spread across 27 packages. That's a bit unwieldy. My first pass, replicating what so many before me have done:

package Class::Sniff;

use Class::BuildMethods qw/ tree target /;
use Tree;

sub new {
    my ( $class, $target_class ) = @_;
    my $self = bless {} => $class;
    $self->target($target_class);
    $self->_initialize;
    return $self;
}

sub _initialize {
    my $self = shift;
    my $target_class = $self->target;
    $self->tree(Tree->new($target_class));
    $self->_add_parents($self->tree);
}

sub _add_parents {
    my ($self,@nodes) = @_;
    for my $node (@nodes) {
        my $class = $node->value;

        no strict 'refs';
        my @parent_classes = map { Tree->new($_) } @{"$class\::ISA"};

        # Oops.  Don't "return" here
        next unless @parent_classes;
        $node->add_child(@parent_classes);
        $self->_add_parents(@parent_classes);
    }
}

1;

And dumping out the inheritance hierarchy:

my $dump = Class::Sniff->new('PIPs::ResultSource::Clip');

for my $node ($dump->tree->traverse) {
    print '  ' x $node->depth;
    print $node->value, "\n";
}
__END__
PIPs::ResultSource::Clip
  PIPs::ResultSourceBase::ClipEpisode
    PIPs::ResultSourceBase::ContentObject
      PIPs::ResultSourceBase::AuditedObject
        PIPs::ResultSourceBase::Pips
          DBIx::Class::UndefToEmptyString
          DBIx::Class::UTF8Columns
          PIPs::DBIx::Class::RecordChange
          DBIx::Class::Core
          DBIx::Class
          Util::Class
      PIPs::ResultSourceBase::HaveIdentifiers
        PIPs::ResultSourceBase::Pips
          DBIx::Class::UndefToEmptyString
          DBIx::Class::UTF8Columns
          PIPs::DBIx::Class::RecordChange
          DBIx::Class::Core
          DBIx::Class
          Util::Class
    PIPs::ResultSourceBase::HasParentBrand

Hmm, not 27 classes there. Either the debugger is wrong or we have packages exporting things in a few places.

So it's clear that we have some issues with inheritance, but much of this is is DBIx::Class is designed (great module, by the way). I am reinventing the wheel but by using a tree for tracking inheritance, I think I can gain some wins in code simplicity for more things I want to do. We'll see.

Update: Oops. jplindstrom saw the output was wrong. Turns out that return unless @parent_classes; should be next unless @parent_classes;. That reveals a grand total of 33 classes, not counting UNIVERSAL.