'."\n");?> 2007年7月30日 Archive - 勤務先と無関係なことを書く日記

Home > Archives > 2007年7月30日 Archive

2007年7月30日 Archive

フレームワーク (6) - lvalue で validation もしたい

header_type というメソッドを実装していた時のこと。

package CGI::Minimal::App;
sub header_type :lvalue {
  my $self = shift;
  $self->{__HEADER_TYPE};
}

これで

  • $self->header_type('redirect');
  • $self->header_type = 'redirect';

どちらの書き方でも setter として動作し、$self->header_type は getter にもなる。が、header_type に set できる値は制限したいので、

package CGI::Minimal::App;
sub header_type :lvalue {
  my $self = shift;
  my $type = shift;

  die 'Invalid header type: '.$type
    unless ( $type eq 'header' or $type eq 'redirect' );

  $self->{__HEADER_TYPE} = $type;

  $self->{__HEADER_TYPE};
}

というようなコードを書くと、

$self->header_type('dummy');

はエラーになるが

$self->header_type = 'dummy';

はエラーにならない

lvalue の時も validation のロジックを通したいので、しばし思案。結果、tie を使うことにした。動いてるけど。。。もっとスマートな実装方法はないものか

package CGI::Minimal::App;
sub header_type :lvalue {
  my $self = shift;
  my $header_type = shift;

  # First use? Create new __HEADER_TYPE!
  $self->{__HEADER_TYPE} = 'header' unless exists $self->{__HEADER_TYPE};

  # tie getter and setter to CGI::Minima::App::Magic (to validate)
  tie $self->{__HEADER_TYPE}, 'CGI::Minimal::App::Magic', $self,
    sub {
      my $self = shift;
      $self->{__HEADER_TYPE};
    },
    sub {
      my $self = shift;
      my $value = shift;

      # check allowed header
      die 'Invalid header type: '.$value
        unless ( grep {$_ eq lc($value)} ('header', 'redirect', 'not_found', 'not_modified', 'none') );
      $self->{__HEADER_TYPE} = lc($value);
    };

  $self->{__HEADER_TYPE} = $header_type if defined $header_type;
  $self->{__HEADER_TYPE};
}
1;

package CGI::Minimal::App::Magic;
sub TIESCALAR {
  my $class = shift;
  my $self = shift;
  my $getter = shift;
  my $setter = shift;

  $class = ref $class || $class || __PACKAGE__;
  bless({obj => $self, getter => $getter, setter => $setter}, $class);
}

sub FETCH {
  my $self = shift;
  $self->{getter}->($self->{obj});
}

sub STORE {
  my $self = shift;
  my $value = shift;

  $self->{setter}->($self->{obj}, $value);
}
1;
  • Comments (Close): 0
  • TrackBack (Close): 0

フレームワーク (7) - lvalue で validation もしたい - その2 -

もっとスマートな実装方法はないものか

って、絶対あるはず。Class::Accessor::Lvalue とかあるんじゃね? と思ったら、やっぱりあった。速度比較とかしているこんなサイトも見つけた

楽々アクセサ生成だけならどれでもできそうだが、今回の要件を満たすかどうかはわからないので、後日勉強するということで。つうか、lvalue やめればシンプルになりますな

  • Comments (Close): 0
  • TrackBack (Close): 0

カール・ゴッチ氏死去

機材を使ったウェイト・トレを行わず、自然に身につく筋肉を愛す、ってあたりが直球ど真ん中でワシ好みなカール・ゴッチ氏が亡くなった。彼がいなければ新日本は別の道を歩んだかもしれないし、UWF はなかった気がするし、リングス、パンクラスもなく、昨今の格闘技ブームもなかったのではないか

ゴッチを招いて新日本プロレスを興した猪木は、新しい団体を作ろうとしている。そこにストロングスタイルがあるのかどうかはわからないが、ゴッチ魂は無我だけにまかせたりしないでほしいな

。。。と、最近の格闘技ブームはイマイチ萌えない、「プロレス」好きな髭野郎が申しております。見たいのは極限の「技」や「肉体」であって、スポーツでもケンカでもないのだよ

  • Comments (Close): 0
  • TrackBack (Close): 0

Home > Archives > 2007年7月30日 Archive

Feeds

Return to page top