メソッドの引数形式について

その１

my $result = $object->method($piyo, $foo);

普通の渡し方。
受け取るときは、

sub method {
    my($self, $piyo, $foo) = @_;
}

こう。
連想配列が配列と同じ（`=>'と`,'が同じトークン）なのを利用して、

my $result = $object->method(PIYO => $foo);

とすることもある。
たとえば、HTTP::Requestのコンストラクタに、

my $req = HTTP::Request->new(GET => $uri);

とか。これは、

$req = HTTP::Request->new('GET', $uri);

と同じ結果になる。

その２

my $result = $object->method(piyo => $piyo, foo => $foo);

ちょっとめんどいけど、引数の順番に制約がないので、設定項目の受け渡しなど『指定しない項目』がたくさんある場合に便利な形式。
実際は、連想配列を引数として渡す。
受け取るときは、

sub method {
    my ($self, %cnf) = @_;
}

のような感じ。$cnf{piyo}、$cnf{foo}を使う。
でもこれだと、なにを受け取るのかパっとみで謎なので、

sub method {
    my ($self, %cnf) = @_;
    my $piyo = delete $cnf{piyo};
    my $foo = delete $cnf{foo};
   
    if ($cnf && $^W) {
       carp("@{[sort keys %cnf]} 謎の引数を発見しますた");
    }
    if (defined($piyo) {

    }
    if (defined($foo) {

    }
}

と先頭のほうで使う変数名を宣言するのと、警告オプションがついているときは変な引数が来たときに警告を出すようにしてみたり。
でもこれってなんかめんどいしキモい。
ということで、どうせキモイなら簡単でしかもキモいほうがいいという考えのもと、こんなのを試した。

package ClassCnf;

use Carp qw(croak);
use base qw(Exporter);
use vars qw($VERSION @EXPORT @EXPORT_OK);

$VERSION = 1;
(@EXPORT, @EXPORT_OK) = (qw(get_cnf), qw(get_cnf));

sub get_cnf
{
    my($args, @keys) = @_;
    my($file, $line, $subroutine);
    my $self = shift @$args;
    my %cnf;
    
    if (@$args == 0) {
        return ($self, ());
    }
    if (@$args % 2 != 0 && $^W) {
        (undef, $file, $line, $subroutine) = caller(1);
        croak("$subroutine: Odd number of elements in hash assignment at $file line $line.");
    }
    my %arg_cnf = @$args;
    
    foreach my $key (@keys) {
        $cnf{$key} = delete $arg_cnf{$key};
    }
    if (%arg_cnf && $^W) {
        (undef, $file, $line, $subroutine) = caller(1);
        croak("$subroutine() Unrecognized options `@{[sort keys %arg_cnf]}' at $file line $line.");
    }
    
    return ($self, %cnf);
}

1;

こうやって使う。

package BBS2ch::Category;

use ClassCnf;

sub new 
{
    my($class, %cnf) = get_cnf(\@_, qw(name boards));
    
    return bless (
        {
            name => $cnf{name},
            boards => $cnf{boards} || []
        },
        $class
    );
}

呼び出し元

if ($line =~ m{<BR><BR><B>([^<]+)</B><BR>}) {
    $category = BBS2ch::Category->new(name => $1);
}

間違って、

if ($line =~ m{<BR><BR><B>([^<]+)</B><BR>}) {
    $category = BBS2ch::Category->new(mame => $1);
}

としたときに、

BBS2ch::Category::new() Unrecognized options `mame' at C:/Users/def/dev/piyo2ch/lib/BBS2ch/Request.pm line 63.

のようなメッセージが出る。