日向夏特殊応援部隊

俺様向けメモ

warningsプラグマで使えるキーワード一覧

perl -Mwarnings -e '$\ = "\n"; print for keys %warnings::Offsets;'
inplace
ambiguous
semicolon
pipe
substr
closure
redefine
parenthesis
bareword
prototype
syntax
io
unopened
newline
exec
recursion
once
debugging
portable
layer
deprecated
misc
pack
reserved
malloc
y2k
digit
taint
untie
void
unpack
all
exiting
uninitialized
printf
glob
overflow
internal
qw
closed
severe
threads
utf8
precedence
signal
regexp
numeric

メソッド名一覧の表示

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

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_/);