attributes

てきとーなんで信用しないでください。アトリビュートについて、調べてみました。
暇ができたら、perldoc attributesでも訳します。

アトリビュートというのは、

sub index : Private{
   ...
}

というように、サブルーチンの横にくっついている、: の横のもの、
上の例では、Privateになります。

Catalystでよく使われているのですが、Catalystでは、Private とか、Global とか、Regexとか色々あります。
何もしない状態だと、組み込みのアトリビュート以外のものを使うと、エラーになってしまいます。

組み込みのアトリビュートというのは、lvalue、method、locked などなど。

で、どうやったら、Catalystみたいなのできるのかなぁ、と調べてみました。
ちなみに、ここに書いているのは、package-specifiedなアトリビュートな話であって、他のは知らない。

package Hoge

sub hoge :XXX{
  
}

とするためには、このサブルーチンの前にMODIFY_CODE_ATTRIBUTEというサブルーチンを定義します。
このサブルーチンは、サブルーチンの宣言中に処理されるそうです。

my %Attribute;

sub MODIFY_CODE_ATTRIBUTES {
  my($class, $code_ref, @attribute) = @_;
  $Attribute{$code_ref} = \@attribute;
  return;
}

上のとおり、クラス名、サブルーチンのコードリファレンス、アトリビュートが引数
として渡ってきます。上の例だと、"Hoge", \&Hoge::hoge, "XXX"ですね。
で、この中では、%Attributeハッシュ内に、コードリファレンスに対するアトリビュートを保存しています。

このアトリビュートを取り出すために、FETCH_CODE_ATTRIBUTESというサブルーチンを定義します。

sub FETCH_CODE_ATTRIBUTES {
  my($class, $code_ref) = @_;
  return @{$Attribute{$code_ref} || []};
}

こちらは、クラス名、コードリファレンスが引数になり、
%Attributeにそのコードリファレンスを渡して、その値(さっき、MODIFY_CODE_ATTRIBUTESで保存したやつ)を返します。

このサブルーチンは、attributes::get が呼ばれたときに使われます(組み込みのアトリビュートは別)。
attributes::get は、コードリファレンスを引数にとり、それについてる、アトリビュートを返します。

下記、サンプルスクリプト。

#!/usr/bin/perl

package Hoge;

use attributes;
use strict;

my %Attribute;

sub MODIFY_CODE_ATTRIBUTES {
  my($class, $code_ref, @attribute) = @_;
  $Attribute{$code_ref} = \@attribute;
  return;
}

sub FETCH_CODE_ATTRIBUTES {
  my($class, $code_ref) = @_;
  return @{$Attribute{$code_ref} || []};
}

sub hoge : xxxx {
  my $self = shift;
  print "\nget:", attributes::get(\&Hoge::hoge);
}

sub hogehoge : locked{
  my $self = shift;
  print "\nget:", attributes::get(\&Hoge::hogehoge);
}

Hoge->hoge();
Hoge->hogehoge();
print "\n\n";

実行結果。

get:xxxx
get:locked

hogehoge の方は、組み込みのアトリビュートlockedなので、
FETCH_CODE_ATTRIBUTESを定義しなくても、取り出せます。
hogeの方は、FETCH_CODE_ATTRIBUTESを定義しないと取り出せません。

そんな感じ。