C::M::App Archive

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;

• 参考
  • Tie::Scalar
  • perltie

最低限の実装は完了した。。。が、このまま作り続けていくと「CGI::Application じゃあかんの？　自分用のラッパ書いたらええやん」ということになりそうな香りがプンプンと。。。そんだけ CGI::Application がよくできてるってことだなぁ

シンプルなものが欲しいはずなのに、なぜ欲張ってしまうかというと「公開」と「汎用性」が気になるから。そして、書き始めるといろんなこと試したくなるから。趣味でやってると欲にキリがなくなるので、ひとまず「融通きかなくて俺しか使えないぜベイベー」仕様を意識

大枠できた。簡単なコマンドラインアプリは作れるレベル

• PATH_INFO or QUERY_STRING で実行するメソッド振り分ける部分できた
• REQUEST_METHOD で実行するメソッド振り分ける部分できた
• TT 使う部分は未実装だが、構想はまとまった
• HTTP header をあつかう部分を構想中
• CGI::Minimal の全機能使いたいかなぁ。。。と思案中
• mod_perl とか fcgi とかについて思案中

package CGI::Minimal::App;

use strict;
use warnings;

use UNIVERSAL::require;

sub query {
    my $self = shift;
    my $query = shift;

    # If query object is not exist, set a new query object.
    unless ( exists $self->{__QUERY_OBJ} ) {
        if ( defined $query ) {
            $self->{__QUERY_OBJ} = $query;
        }
        else {
            my $module = 'CGI::Minimal';
            unless ( exists $INC{$module} ) {
                $module->require or die $!;
            }
            $self->{__QUERY_OBJ} = $module->new();
        }
    }
    return $self->{__QUERY_OBJ};
}

sub param : lvalue {
    my $self = shift;
    my @data = @_;

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

    if ( ref($data[0]) eq 'HASH' ) {
        # param($hash_ref)
        %{$self->{__PARAMS}} = (%{$self->{__PARAMS}}, %{$data[0]});
    }
    elsif ( scalar(@data) % 2 == 0 ) {
        # param(@array)
        %{$self->{__PARAMS}} = (%{$self->{__PARAMS}}, @data);
    }
    scalar(@data) == 1 ? $self->{__PARAMS}->{$data[0]} : $self->{__PARAMS};
}

C::A::P::Stash 的に param を使いたかった & lvalue 使ってみたかった

$obj->param->{'hoge'} = 'fuga'; # OK
$obj->param('hoge','fuga');     # OK
$obj->param('hoge') = 'fuga'    # OK
$obj->param({hoge => 'fuga'});  # OK
$obj->param(hoge => 'fuga');    # OK
$obj->param = {hoge => 'fuga'}  # OK

print $obj->param->{'hoge'};    # fuga
print $obj->param('hoge');      # fuga

「HikiDoc を使った WEB アプリケーション」の時にはしりきれとんぼだったので、今回はちょっと続けてみようかと思う。今のところは

• 名称は CGI::Minimal::App (仮)
• ロジックは CGI::Application をほぼそのまま頂く
  • 使い方が変わると、自分自身が使いづらくなるので
  • 細かいあたりは、コーディングを楽しめるように自分流で
• CGI::Minimal の perldocに「warnings と vars は重て！」とか書いてあるが、どうするかは作ってから考える
• CGI::Application::Plugin で、いつも使っているものは最初からいれてしまう

お昼過ぎ、ふと思い立ってフレームワークを作り始めたので、記録残し

CGI::Simple か CGI::Minimal を使って、機能を減らして、もうちっとシンプルな俺仕様 CGI::Application が欲しい。CGI::Application 使ってると、いろんなことを覚えることができないワシはコピペが増えて困る
↓
イチから必要な機能だけ実装した方が楽かも。自分で実装したら覚えること減りそうだし
↓
CGI::Simple よさげだけど、どうせなら CGI::Minimal 使った方が極端で楽しいかも。これで CGI::Application より重くなったら、自分の実装が悪いということで
↓
CGI::Application のマネをするため、コード斜め読み

とりあえずここまで