Hatena::ブログ(Diary)

Yet Another Hackadelic

2007-07-27

メソッド名一覧の表示

と言う訳でつたないコードですけど投稿してみたお!

CPANに頼りまくる系

#!/usr/bin/perl

package Foo;

{
    no strict 'refs';

    for my $method (qw/foo bar baz test_foo test_bar test_baz/) {
        *{"Foo::$method"} = sub {
            print $method . "\n";
        };
    }
}

sub new {
    bless {} => shift;
}

package main;

use strict;
use warnings;

use Scalar::Util qw(blessed);
use Class::Inspector;

sub call_methods_by_regex {
    my ($target, $regex) = @_;

    return unless (my $class = blessed($target));
    return unless (ref $regex eq 'Regexp');

    my @methods = grep { /$regex/o } @{Class::Inspector->methods($class, 'public')};

    for my $method (@methods) {
        $target->$method();
    }
}

call_methods_by_regex(Foo->new, qr/^test_/);

CPANには頼らない系

#!/usr/bin/perl

package Foo;

{
    no strict 'refs';

    for my $method (qw/foo bar baz test_foo test_bar test_baz/) {
        *{"Foo::$method"} = sub {
            print $method . "\n";
        };
    }
}

sub new {
    bless {} => shift;
}

package main;

use strict;
use warnings;

{
    no strict 'refs';
    sub call_methods_by_regex {
        my ($target, $regex) = @_;
        my $class = ref $target;

        return if (!$class || $class =~ /^(SCALAR|ARRAY|HASH|CODE|GLOB|LVALUE)$/);
        return unless (ref $regex eq 'Regexp');

        my @methods = 
            grep { *{${$class . "::"}{$_}}{CODE} } 
            grep { /$regex/o } 
                keys %{$class . "::"};
        
        for my $method (@methods) {
            $target->$method();
        }
    }
}

call_methods_by_regex(Foo->new, qr/^test_/);