Class::Sniff で継承木をかく

2009-02-11 08:04

Class hierarchy of Remedie

「Look for class composition code smells」をうたう Class::Sniff で継承木を書いてみた。

Class::Sniff

以下のスクリプトは引数にクラスをとり、その情報を表示する。

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

my $sniffer = Class::Sniff->new({ class => shift });
print $sniffer->graph->as_ascii, "\n", $sniffer->report;

この記事用にクラスをつくってもあんまり面白くないと思ったので、今回は Remedie を使ってみた。Remedie::Server::RPC::Player を引数に与えてみる。

% ls
Changes         MANIFEST        Makefile.PL     bin/            lib/            t/
HACKING         MANIFEST.SKIP   README          extlib/         root/           xt/
% perl -I lib -MRemedie::Server::RPC::Player ~/1.pl Remedie::Server::RPC::Player
+------------------------------+
|        Moose::Object         |
+------------------------------+
  ^
  |
  |
+------------------------------+
|     Remedie::Server::RPC     |
+------------------------------+
  ^
  |
  |
+------------------------------+
| Remedie::Server::RPC::Player |
+------------------------------+
Report for class: Remedie::Server::RPC::Player

Overridden Methods
.---------+-------------------------------------------------------------------.
| Method  | Class                                                             |
+---------+-------------------------------------------------------------------+
| blessed | Remedie::Server::RPC::Player                                      |
|         | Remedie::Server::RPC                                              |
| confess | Remedie::Server::RPC::Player                                      |
|         | Remedie::Server::RPC                                              |
| meta    | Remedie::Server::RPC::Player                                      |
|         | Remedie::Server::RPC                                              |
|         | Moose::Object                                                     |
| new     | Remedie::Server::RPC::Player                                      |
|         | Remedie::Server::RPC                                              |
|         | Moose::Object                                                     |
'---------+-------------------------------------------------------------------'
Exported Subroutines
.-------------------------+-----------+---------------------------------------.
| Class                   | Method    | Exported From Package                 |
+-------------------------+-----------+---------------------------------------+
| Remedie::Server::RPC    | blessed   | Scalar::Util                          |
|                         | class_has | MooseX::ClassAttribute                |
|                         | confess   | Carp                                  |
| Remedie::Server::RPC::- | SEEK_CUR  | Fcntl                                 |
| Player                  | SEEK_END  | Fcntl                                 |
|                         | SEEK_SET  | Fcntl                                 |
|                         | blessed   | Scalar::Util                          |
|                         | confess   | Carp                                  |
|                         | dir       | Path::Class                           |
|                         | file      | Path::Class                           |
|                         | mkdtemp   | File::Temp                            |
|                         | mkstemp   | File::Temp                            |
|                         | mkstemps  | File::Temp                            |
|                         | mktemp    | File::Temp                            |
|                         | tmpfile   | File::Temp                            |
|                         | tmpnam    | File::Temp                            |
'-------------------------+-----------+---------------------------------------'
Duplicate Methods (Experimental)
.--------------------------------------+--------------------------------------.
| Method                               | Duplicated In                        |
+--------------------------------------+--------------------------------------+
| Remedie::Server::RPC::Player::play_- | Remedie::Server::RPC::Player::play   |
| inline                               |                                      |
| Remedie::Server::RPC::blessed        | Remedie::Server::RPC::Player::bless- |
|                                      | ed                                   |
| Remedie::Server::RPC::meta           | Remedie::Server::RPC::Player::meta   |
| Remedie::Server::RPC::Player::SEEK_- | Remedie::Server::RPC::Player::SEEK_- |
| CUR                                  | SET                                  |
|                                      | Remedie::Server::RPC::Player::SEEK_- |
|                                      | END                                  |
| Remedie::Server::RPC::confess        | Remedie::Server::RPC::Player::confe- |
|                                      | ss                                   |
'--------------------------------------+--------------------------------------'
Long Methods (experimental)
.------------------------------------+----------------------------------------.
| Method                             | Approximate Length                     |
+------------------------------------+----------------------------------------+
| Moose::Object::BUILDARGS           | 166                                    |
| Moose::Object::meta                | 602                                    |
| Remedie::Server::RPC::Player::meta | 417                                    |
| Remedie::Server::RPC::Player::new  | 651                                    |
| Remedie::Server::RPC::attr_cache   | 650                                    |
| Remedie::Server::RPC::conf         | 645                                    |
| Remedie::Server::RPC::meta         | 417                                    |
| Remedie::Server::RPC::new          | 651                                    |
'------------------------------------+----------------------------------------'
%

前半の継承を Moose::Object まで辿ったものを graph メソッドが、後半の上書きしているメソッドのリストから長いメソッドのリストまでを report が出力している。Moose に対応しきれていないのがすこし気になるけど、ここでは深追いしない。

Graph::Easy のグラフをまとめる

Class::Sniff は個々のクラスに焦点をあわせているけど、次は個々のクラスに関する情報をまとめてシステム全体の継承木を書いてみる。

Class::Sniff の graph メソッドは Graph::Easy のインスタンスを返している。Graph::Easy はノードとエッジをもったふつうのグラフで、さらに GraphViz 形式での出力もある。Graph::Easy のインスタンス同士をつないで、ひとつのグラフを作ってみた。

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

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

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

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

sub merge_graph {
    my ($result, $graph) = @_;

    my @edges = $graph->edges;
    foreach my $edge (@edges) {
        my ($source, $target) = $edge->nodes;
        $result->add_edge_once($source->name, $target->name);
    }
}

my $graph;

for my $path (@ARGV) {
    my $package = package_of($path);
    eval "use $package";

    my $sniffer = Class::Sniff->new({ class => $package });

    if ($graph) {
        merge_graph($graph, $sniffer->graph);
    } else {
        $graph = $sniffer->graph;
    }
}

print $graph->as_graphviz;

引数はひとつのクラスではなく複数のファイル名にした。パスからクラス名を作りそれを use してから Class::Sniff にまわしている。

% perl -I lib ~/2.pl lib/**/*.pm | dot -Tpng -o ~/remedie-2.png
Deep recursion on subroutine "B::Concise::sequence" at /System/Library/Perl/5.8.8/darwin-thread-multi-2level/B/Concise.pm line 501.
Deep recursion on subroutine "B::Concise::sequence" at /System/Library/Perl/5.8.8/darwin-thread-multi-2level/B/Concise.pm line 504.
Deep recursion on subroutine "B::Concise::sequence" at /System/Library/Perl/5.8.8/darwin-thread-multi-2level/B/Concise.pm line 507.
Deep recursion on subroutine "B::Concise::sequence" at /System/Library/Perl/5.8.8/darwin-thread-multi-2level/B/Concise.pm line 497.
Deep recursion on subroutine "B::Concise::sequence" at /System/Library/Perl/5.8.8/darwin-thread-multi-2level/B/Concise.pm line 497.
Deep recursion on subroutine "B::Concise::sequence" at /System/Library/Perl/5.8.8/darwin-thread-multi-2level/B/Concise.pm line 497.
Deep recursion on subroutine "B::Concise::sequence" at /System/Library/Perl/5.8.8/darwin-thread-multi-2level/B/Concise.pm line 497.
%

生成した Remedie の継承木 の PNG は 8692×443px の巨大なものだけど、ソースを地道に読むより、全体の見通しという意味では良いと思う。

メソッドも表示する

ここまでくるとメソッドも表示したくなってくる。クラス名とメソッドのリストとを水平線で区切るとか、そういう凝ったことを GraphViz でやるには node の shape を record に指定する。

Node Shapes

These are specified by shape values of “record” and “Mrecord”. The structure of a record-based node is determined by its label, which has the following schema: (snip)

ただ、これを Graph::Easy から指定する方法がわからなかったので、Graph::Easy をあきらめて直接 .dot ファイルを生成してしまった。

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

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

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

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

sub new_methods {
    my ($sniffer) = @_;
    my %count_of;

    for my $method ($sniffer->methods) {
        $count_of{$method}++;
    }

    my $klass = $sniffer->target_class;
    for my $method (keys %{ $sniffer->exported->{ $klass } }) {
        $count_of{$method}--;
    }

    grep { $_ } map {
        my $method = $_;

        ($count_of{$method} > 0)? $method : undef;
    } (keys %count_of);
}

my $graph;

print <<END;
digraph GRAPH_0 {
  node [ shape=record ];
END

for my $path (@ARGV) {
    my $package = package_of($path);
    eval "use $package";

    my $sniffer = Class::Sniff->new({ class => $package });

    my @methods = new_methods($sniffer);
    my $label = "{$package|" . join('\l', sort @methods)  . '\l}';
    $label =~ s/"/\\"/g;
    print qq["$package" [label="$label"]\n];

    my @parents = $sniffer->parents;
    foreach my $c (@parents) {
        print qq["$package" -> "$c"\n];
    }
}

print <<END;
}
END

Remedie の継承木 + メソッド はさらに大きく 15024×1483px になった。このスクリプトはなにかに使えそうなので Gist に置いてみました。

参考と関連

GraphvizでER図を書く方法
GraphViz の使い方を参考にしました
UMLシーケンス図の自動生成(UML::Sequence)
UMLクラス図の自動生成(UML::Class::Simple)
この記事をかいている途中に知りました。まだ試していません。
miyagawa’s Friends’ Journals
Class::Sniff の存在はこの RSS を読んでいて知りました。Journal of miyagawa (1653) から discovery できます。

Leave a Reply