Slash Boxes
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)

  (email not shown publicly)
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)

Thursday April 09, 2009
09:24 AM

Before and After Graphs (Role Application)

[ #38785 ]

I've finished the first pass at reorganizing some of our code with roles. Take a look at our inheritance hierarchy before we switched to roles.

Now look at it after we switched to roles.

Nice and flat, eh? Which would you rather work on?

Of course, it's been pointed out (an annoyingly fair critique, I might add), that the latter graph doesn't show as much information. So here's the same graph with every class showing which roles it uses.

We have 10 roles. None of them are very large and most have fairly descriptive names. Learn those 10 roles and you can instantly get an idea of what each and every class does.

To generate the latter graph, I used a modification of kzys's code to list methods for each class.

#!/usr/bin/env perl

use strict;
use warnings;
use Class::Sniff;

sub package_of {
    my ($path) = @_;

    if ($path !~ m|/?lib/(.*)\.pm$|) {

    my $result = $1;
    $result =~ s|/|::|g;
    return $result;

sub new_roles {
    my ($sniffer) = @_;

    my $klass = $sniffer->target_class;
    my @roles = $klass->meta->calculate_all_roles;
    shift @roles;
    @roles = map { $_->identifier } @roles;
    @roles = 'No roles implemented' unless @roles;
    return @roles;

my @sniffs = map {
    my $package = package_of($_);
    eval "use $package";

        class  => $package,
        ignore => qr/^(::DBIx|Class)/,
} @ARGV;

my $labels = join "\n", map {
    my @roles = new_roles($_);

    my $label = '{\N\n|' . join('\l', sort @roles) . '\l}';
    $label =~ s/"/\\"/g;

    sprintf('"%s" [label="%s"]', $_->target_class, $label);
} @sniffs;

my $sniff    = pop @sniffs;
my $graphviz = $sniff->combine_graphs(@sniffs)->as_graphviz;

# it's dirty...
$graphviz =~ s/}/$labels }/g;
$graphviz =~ s/shape=box/shape=record/g;

print $graphviz;

And you can run it with this:

find lib/PIPs/ResultSet/ -name '*pm'|egrep -v 'Role' |xargs perl > role_sniff.viz

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
More | Login | Reply
Loading... please wait.
  • Ovid, I regularly read and enjoy your blog posts. I think your latest series on roles has sold me on moving more in that direction in my own work. I agree it seems like a cleaner, clearer organizational model than focusing on inheritance.
  • Very cool post, thanks