クラスデータをダンプしたい！

Class::Data::InheritableやClass::Data::Accessorとかでクラスデータを作成するのは凄く便利なんだけど、そのクラスにどれだけクラスデータが存在してるのかとがすぐには把握できないのがデメリットです。

なのでさくっとクラスデータをダンプするモジュールを作ってみました。

package Class::Data::Dumper;

use strict;
use warnings;

use Data::Dumper ();
use Class::Inspector;

our $VERSION = '0.01';

our %PACKAGE = map { $_ => 1 } qw/
    Class::Data::Inheritable
    Class::Data::Accessor
/;

sub target {
    shift;
    my $target_class  = shift;
    my $target_method = shift;
    if ( $target_class->can("_${target_method}_accessor") ) {
        require B;
        return $PACKAGE{ B::svref_2object($target_class->can($target_method))->GV->STASH->NAME };
    }
    return;
}

sub dumper {
    return Data::Dumper::Dumper( shift->class_value(@_) );
}

sub class_value {
    my $base  = shift;
    my $proto = shift;
    my $class = ref $proto || $proto;
    my %data;
    
    my $methods = Class::Inspector->methods( $class );
    for my $method ( @$methods ) {
        if ( $base->target($class,$method) ) {
            $data{$method} = $class->$method;
        }
    }
    
    return \%data;
}

1;

使い方はこんな感じ。

package Foo;
use base qw/Class::Data::Inheritable/;
__PACKAGE__->mk_classdata('method1','1');
__PACKAGE__->mk_classdata('method2','2');

package Bar;
use base qw/Foo Class::Data::Accessor/;
__PACKAGE__->mk_classaccessor('method3','3');
__PACKAGE__->mk_classaccessor('method4','4');
__PACKAGE__->method1('11');
__PACKAGE__->method2('22');

package main;
use Class::Data::Dumper;

print Class::Data::Dumper->dumper('Foo');
print Class::Data::Dumper->dumper('Bar');

__END__

$VAR1 = {
          'method2' => '2',
          'method1' => '1'
        };
$VAR1 = {
          'method2' => '22',
          'method4' => '4',
          'method3' => '3',
          'method1' => '11'
        };

Class::Data::Inheritable等で定義されたメソッドかどうかを判別するためにB::svref_2object関数を使ってます。

始めは「"_${target_method}_accessor"」だけ見てればいいかなーとも思ったんだけどClass::Accessorでも定義されるのでダメでした。
なんで結局B使う以外の良い方法を思い浮かびませんでした。

まーとにもかくにもコレでそのクラスにどんなクラスデータが保持されてるのかを表示できるので良かったですね！

以下CodeRepos予定リンク

http://coderepos.org/share/browser/lang/perl/Class-Data-Dumper