Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

Ovid (2709)

Ovid
  (email not shown publicly)
http://publius-ovidius.livejournal.com/
AOL IM: ovidperl (Add Buddy, Send Message)

Stuff with the Perl Foundation. A couple of patches in the Perl core. A few CPAN modules. That about sums it up.

Journal of Ovid (2709)

Friday January 30, 2009
07:13 AM

Class::Sniff

[ #38368 ]

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.

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.