Catalystでforwardするときは返り値に注意

今日はちょっと Catalyst で forward してみますー。forwardメソッドを呼び出して返り値を受け取るときにうまく値が受け取れない。。。そんな経験をしたことはありませんか？（僕はあります...orz

【追記ここから】

id:charsbarさんよりブクマコメントいただきました。

forwardの返り値はコントローラの処理を続行するかどうかの判別に使うものなので(C::Controller.pmの_DISPATCHなど参照)、有意なデータが要るならモデルから取るなりstashに入れておくなりした方がよろしいかと

な、なるほどΣ(･ω･ﾉ)ﾉ　・・そんなわけで、以下の内容は forward の返り値ってこんな風に処理されてるのか〜くらいの参考情報として見て頂けるといいかなと思います。

【追記ここまで】

というわけで、今回はテストを兼ねて、色々な値を返すメソッドに forward してみました。

# Controller

sub hoge : Local {
    my ($self, $c) = @_;
    my $value_a = $c->forward('method_a');
    my $value_b = $c->forward('method_b');
    my $value_c = $c->forward('method_c');
    my $value_d = $c->forward('method_d');
    my $value_e = $c->forward('method_e');
    my $value_f = $c->forward('method_f');
                       
    use Data::Dumper;
    warn Dumper $value_a; # 0
    warn Dumper $value_b; # 0
    warn Dumper $value_c; # foo
    warn Dumper $value_d; # 1
    warn Dumper $value_e; # 3
    warn Dumper $value_f; # 2/8
   
    $c->res->body(1);
}   
    
sub method_a : Private { # undef を返す場合
    my ($self, $c) = @_;
    return undef;
}

sub method_b : Private { # ''(空文字)を返す場合
    my ($self, $c) = @_;
    return '';
} 

sub method_c : Private { # リストを返す場合
    my ($self, $c) = @_;
    return ( qw/hoge fuga foo/ );
}

sub method_d : Private { # リストを返す場合_2
    my ($self, $c) = @_;
    return ( foo => 1, bar => 1 );
}

sub method_e : Private { # 配列を返す場合
    my ($self, $c) = @_;
    my @array = ( qw/hoge fuga foo/ ); 
    return @array;
}

sub method_f : Private { # ハッシュを返す場合
    my ($self, $c) = @_;
    my %hash = ( foo => 1, bar => 1 ); 
    return %hash; 
}

どうですか？予想通りの結果だったでしょうか？？

予想通りだった人はこの下の説明を読む必要はありません。予想外の結果だった人は、この下の説明を読んだら少しわかるかもしれません。ではいきますよー！！

まずは forwardメソッドの実装を見てみます。forward が実行されるときには、以下のようにdispatchメソッドが呼ばれます。

Catalyst/Dispatcher.pm

sub forward {
    my $self = shift;
    my ( $c, $command ) = @_;
    my ( $action, $args, $captures ) = $self->_command2action(@_);

    unless ($action) {
        my $error =
            qq/Couldn't forward to command "$command": /
          . qq/Invalid action or component./;
        $c->error($error);
        $c->log->debug($error) if $c->debug;
        return 0;
    }

    local $c->request->{arguments} = $args;
    $action->dispatch( $c ); # ココ

    return $c->state;
}

さらに、dispatchメソッドの中ではexecuteメソッドが呼ばれます。

Catalyst/Action.pm

sub dispatch {    # Execute ourselves against a context
    my ( $self, $c ) = @_;
    return $c->execute( $self->class, $self ); # ココ
}

executeメソッドは Catalyst.pm に定義されています。このメソッドでは（他にも色々やってますが）、eval文のところで forwardメソッドの返り値を受け取って、その値が真だったらその値を、偽だったら 0 を $c->state にセットします。そして、最終的には呼び出し元にこの $c->stash の値が返されます。

Catalyst.pm

sub execute {
    my ( $c, $class, $code ) = @_;

    #..snip..
     
    # &$code( $class, $c, @{ $c->req->args } ) でforwardメソッドを実行
    eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
     
    # ..snip..
     
    return $c->state;
}

そのため、返り値が undef や ''(空文字)の場合には 0 が返され、リストや配列、ハッシュの場合にはスカラコンテキストで評価された値が返されます。スカラコンテキストで評価した場合、リストは最後の要素が、配列は個数が、ハッシュの場合は特殊な値が？返されるので注意です。どちらにせよ、本当に返したい値は返せていません。この部分の実装がなんかイマイチな気が・・。（＾＾；

実際にこれらの値をやりとりしたいのであれば、多少面倒ですがリファレンスにするか、もしくはforwardメソッド内で値を stash に入れてしまうか、ですね。もっとスマートな解決策があればいいんですが＞＜

最近のCatalystアプリケーションの構成

最近のCatalystアプリケーションの構成はこんな感じっていうのがある程度固まってきたので公開してみます。 Role が使いたくて Moose も取り入れたりしてます。.｡ﾟ+.(･∀･)ﾟ+.ﾟ

MyApp
|-- bin
|   |-- cron
|   `-- script
|-- conf
|-- lib
|   |-- MyApp
|   |   |-- Controller
|   |   |-- Logic         # そのクラスだけのロジックはここ
|   |   |-- LogicBase.pm  # CRUD操作はここ
|   |   |-- Model
|   |   |-- Plugin        # オレオレプラグインはここ(屮ﾟДﾟ)屮
|   |   |-- Role          # 共通して使えるロジックはここ
|   |   |-- Schema
|   |   `-- View
|   |-- MyApp.pm
|   `-- FormValidator
|       `-- Simple
|           `-- Plugin
|               `-- MyApp # MyApp用validationモジュール
|-- root
|   |-- static
|   |   |-- css
|   |   |-- images
|   |   |-- js
|   `-- template
|-- script
`-- t

Catalystっていうと普通はMVC(Model, View, Controller)という感じですが、普通に使ってるとCLI用のロジックを別に書かなきゃいけなかったり、$c ぺったりだったりであまりよろしくありません。。。で、僕の場合は、最近の「モデル分離」という流れもあって Catalyst::Model::MultiAdaptor を使ったMVLC(Model, View, Logic, Controller)という構成にしています。 Controller と Model の橋渡し（とほとんどの処理）を Logic がやっているイメージです。

例えば、http://localhost:3000/foo にアクセスが来た場合を考えてみます。まず、コントローラでLogicクラスのインスタンスを作って、get_hoge_dataメソッドを呼んでいます。

MyApp/Controller/Root.pm

sub foo : Local {
    my ($self, $c) = @_;

    my $data = $c->model('Logic::Hoge')->get_hoge_data(
        $c->model('DBIC::Hoge'),
        { 
            hoge_id => $id,
        },
        {},
    );
}

Logicクラスではsearchメソッドを呼んでいます。

MyApp/Logic/Hoge.pm

package MyApp::Logic::Hoge;
  
use Any::Moose;
extends 'MyApp::LogicBase'; # LogicBase を親に持つ
with 'MyApp::Role::Memcached'; # Memcached の Role を持たせたり
  
__PACKAGE__->meta->make_immutable;
  
no Any::Moose;
  
sub get_hoge_data {
    my $self = shift;
    $self->search(@_);

    # 適当な処理を行う
} 

1;

しかし、searchメソッドはLogicクラスにはありません。CRUD操作を行うメソッドは各Logicクラスには実装せず、LogicBaseクラスにまとめて実装しています（各LogicクラスはLogicBaseクラスを親に持ちます）。

MyApp/LogicBase.pm

package MyApp::LogicBase;
 
use Any::Moose;
use Any::Moose '::Util::TypeConstraints';
with 'MyApp::Role::Utils';
 
subtype 'MyApp::RSObject'
    => as 'Object'
    => where {       
        $_->isa('DBIx::Class::ResultSet') or       
        (ref $_) =~ /^MyApp::(?:Model|Schema)/
    };
 
has 'rs'   => ( is  => 'rw', isa => 'MyApp::RSObject' );
has 'args' => ( is  => 'rw', isa => 'HashRef' );
has 'cond' => ( is  => 'rw', isa => 'HashRef' );
 
before 'create', 'find', 'search', 'update', 'delete', 'update_or_create' => sub {
    my ($self, $rs, $args, $cond) = @_;   
    $args = {} if !defined $args;
    $cond = {} if !defined $cond;
 
    # 型チェック
    $self->rs($rs);
    $self->args($args);
    $self->cond($cond);
};
 
__PACKAGE__->meta->make_immutable;
 
no Any::Moose;
no Any::Moose '::Util::TypeConstraints';
 
# ..snip..

# create する前に自動で created_at や updated_at に現在時刻を代入
sub create {
    my ($self, $rs, $args, $cond) = @_;
    my $now = $self->get_dt();
    $args->{created_at} = $now if !defined $args->{created_at};
    $args->{updated_at} = $now if !defined $args->{updated_at};
    $rs->create($args, $cond);
}
  
sub search {
    my ($self, $rs, $args, $cond) = @_;
  
    # prefetchとかjoinされたテーブルの delete_flag = 0 を自動で利用する
    for my $name (qw/join prefetch/) {
        if ( defined $cond->{$name} ) {
            for my $relation ( @{ $cond->{$name} } ) {
                my $other_args = { "$relation.delete_flag" => 0 };
                $args = $self->merge_hash($args, $other_args);
            }
        }
    }
  
    return $rs->search($args, $cond);
}

# search した結果を配列リファレンスで返す
sub search_with_hashref {
    my ($self, $rs, $args, $cond) = @_;
    my $data = $rs->search($args, $cond);
  
    my @result;
    while ( my $d = $data->next ) {
        my $tmp_hash = +{ map { $_ => $d->$_ } $rs->result_source->columns };
        push @result, $tmp_hash;
    }
  
    return \@result;
}

# 通常は slave から行う search を master から行うためのメソッド
sub search_from_master {
    my $self = shift;
  
    my $schema = $_[0]->result_source->schema;
    local $schema->storage->{read_source} = $schema->storage->{write_source};
  
    $self->search(@_);
}
 
# ..snip..
 
1;

そして、LogicBaseクラスから実際に処理を行うDBIx::Class::ResultSetクラスへと処理が渡されるわけです（ $rs->search($args, $cond) の部分 ）。

このようにLogicクラスをコントローラと実際の処理との間に挟むことで様々なメリットがあります。例えば、、

1. ロジック部分を分離することで全体がすっきり！
2. created_at や updated_at といったカラムに自動的に値を追加するのも簡単
3. 結果をハッシュリファレンスにして返すことも可能
4. search を slave からではなく master から行うためのおまじないを隠蔽ｗ

例えば cron からだってLogicクラスを利用することが出来ます（コードの再利用！！）。こんな感じです。

#!usr/bin/perl

use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin/../../lib";
use MyApp::Schema;
use MyApp::Logic::Hoge;
use Getopt::Long;

$ENV{DBIC_TRACE}                = 1;
$ENV{MYAPP_CONFIG_LOCAL_SUFFIX} = 'devel';

# 引数受け取ったりとか

my $logic_hoge   = MyApp::Logic::Hoge->new;
my $connect_info = $logic_hoge->get_connect_info();
my $schema       = MyApp::Schema->connect(@$connect_info);

my $data = $logic_hoge->get_hoge_data(
    $schema->resultset('Hoge'),
    {
        hoge_id => $id,
    },
    {},
);

# その他の処理を行う

あと気を付けてることは、、なるべくコントローラに処理を書かないように（コントローラではディスパッチとバリデーションくらい）ってところですかね。コントローラはなるべく薄く！ですよ。

イメージはこんな感じかなぁ。



ってことで、まだまだな部分も多いですが、今のところはこの構成で結構満足しています。(*´Д`)

Catalyst::Plugin::FormValidator::Simple::Auto の使用例

Catalyst で form の validation をするとき、僕は Catalyst::Plugin::FormValidator::Simple::Auto を使ってます。(｀･ω･´)

これは、Controllerで明示的に validation を行わなくても、設定ファイルに書いておけば、アクション実行前に自動で validation してくれるというものです。実装はこんな風になってます。

Catalyst::Plugin::FormValidator::Simple::Auto.pm

sub prepare {
    my $c = shift->NEXT::prepare(@_);

    my $url = $c->action->reverse;
    if ( my $profile = $c->config->{validator}{profiles}{$url} ) {
        $c->validator_profile( $c->action->reverse );
        $c->form(%$profile);
    }

    $c
}

prepare時に自動で validation が走ってくれるんですね。楽チンです。設定ファイルは以下の2つ（ profiles.yml と messages.yml ）　(=ﾟωﾟ)ﾉ

conf/profiles.yml

edit: # validation する PATH
  email:
    - NOT_BLANK
    - EMAIL
    - [ 'DBIC_UNIQUE', __model(DBIC::User)__, 'email' ]
  dupcheck:
    - [ 'DUPLICATION_EMAIL_CHECK', 'email', 're_email' ]

conf/messages.yml

edit:
  email:
    NOT_BLANK: email が入力されていません。
    EMAIL: email が不正です。
    DBIC_UNIQUE: 入力された email は既に登録されています。
  dupcheck:
    DUPLICATION_EMAIL_CHECK: email と email(確認用) が一致しません。

ちなみに、組み込みの validation に加えて、自作の validation を追加したければ、MyApp/lib 以下に FormValidator/Simple/Plugin/MyApp/Validation.pm とかを作って、myapp.yml にこのように指定してあげればOKです。

myapp.yml

validator:
  profiles: __path_to(conf/profiles.yml)__
  messages: __path_to(conf/messages.yml)__
  message_format: '
%s
'
  plugins:
    - Japanese
    - DBIC::Unique
    - MyApp::Validation # コレ

FormValidator::Simple::Plugin::MyApp::Validation.pmの例

package FormValidator::Simple::Plugin::MyApp::Validation;

use strict;
use warnings;
use FormValidator::Simple::Exception;
use FormValidator::Simple::Constants;
use Encode;

# email と email(確認用) が一致するかどうか
sub DUPLICATION_EMAIL_CHECK {
    my ($self, $params, $args) = @_;

    unless ( scalar @$args == 2 ) {
        FormValidator::Simple::Exception->throw(
            q!/two arguments are required./
        );
    }

    my $data = $params->[0];
    return $args->[0] eq $args->[1] ? TRUE : FALSE;
}

# 組み込みの LENGTH はバイト数で比較する
# この LENGTH_CHAR は文字数で比較する
sub LENGTH_CHAR {
    my ($self, $params, $args) = @_;

    unless ( scalar @$args == 2 ) {
        FormValidator::Simple::Exception->throw(
            q!/two arguments are required./
        );
    }

    my $decode_data = Encode::decode_utf8($params->[0]);
    my $length = length($decode_data);
    if ( $length ) {
        return ($length >= $args->[0] and $length <= $args->[1])
            ? TRUE : FALSE;
    }
}

1;

ただ、先ほどの DUPLICATION_EMAIL_CHECK は

[ 'DUPLICATION_EMAIL_CHECK', 'email', 're_email' ]

このように指定しています。ので、このまま validation しても 'email' と 're_email' を比較するため必ずチェックに引っかかります。。そこで、こんな感じのプラグインを作って 'email' と 're_email' に実際に form に入力された値を代入しています。

package MyApp::Plugin::YAML;

use strict;
use warnings;

# http://d.hatena.ne.jp/fbis/20070428/1177761342
sub setup_components {
    my $c = shift;
    $c->NEXT::setup_components(@_);
    
    if ( my $profile = $c->config->{validator}->{profiles} ) {
      for my $path ( keys %$profile ) {
        for my $name ( keys %{ $profile->{$path} } ) {
          for my $validate ( @{ $profile->{$path}->{$name} } ) {
            if ( ref $validate and 
                 $validate->[0] =~ /^(?:NOT_)?DBIC_UNIQUE$/ and 
                 $validate->[1] =~ /^__model\((.*)\)__$/ ) {
              my $model = $1;
              $validate->[1] = $c->model($model);
            }
          }
        }
      }
    }
}

{
    use Class::Method::Modifiers::Fast;
    use parent 'Catalyst';

    around 'prepare' => sub {
      my $orig = shift;
      my $c = $orig->(@_); # 元のCatalyst::Plugin::prepareの実行

      my $url = $c->action->reverse;
    
      if ( my $profile = $c->config->{validator}->{profiles} ) {
        for my $name ( keys %{ $profile->{$url} } ) {
          for my $validate ( @{ $profile->{$url}->{$name} } ) {
            if ( ref $validate and $validate->[0] =~ /^DUPLICATION_(.+)_CHECK$/ ) {
                 @$validate[1,2] = ( lc($1), 're_'.lc($1) );

              if ( $c->req->method eq 'POST' ) {
                $validate->[1] = $c->req->param( $validate->[1] );
                $validate->[2] = $c->req->param( $validate->[2] );
              }
            }
          }
        }
      }
    
      return $c;
    };
}

1;

最後に Controller と View のサンプルです。注意すべきは POST のときにだけ $c->form を VIew に渡していることです。GET のときにも validation は走ってますが、その結果は捨てています。

Controllerのサンプル

sub edit : Local {
    my ($self, $c) = @_;

    if ( $c->req->method eq 'POST' ) {

        if ( $c->form->has_error ) {
            $c->flash->{error} = $c->form;
        }
        else {
            # ..snip..

            # validation が問題ないときは redirect する
            $c->res->redirect( $c->uri_for('confirm') );
        }
    }
    elsif ( $c->req->method eq 'GET' ) {
        delete $c->flash->{error};
    }
}

Viewのサンプル

[% form = c.flash.error %]
 
[%- IF form.has_error %]
    [%- FOREACH msg IN form.messages('edit') %] # validation する PATH
        [% msg %]
    [%- END %]
[%- END %]

validation を plugin でやるのは良くないのかもしれないですが、validation 周りを一箇所に集められて凄いすっきりするからいいかな〜と思って使ってます。（・∀・）

あ、あと注意点としては profiles.yml とか messages.yml とか、あと View で form.messages('xxxx') って指定している PATH は ページの URL ではなくて、Catalyst 内部の PATH なのでそれだけ気をつけてください。以下の例だと、hoge ではなく、fuga を指定します。これは、内部で $c->action->reverse を使ってマッチングしているからです。

Controller/Root.pm

sub fuga : Path('hoge') {}

便利なので使うといいんじゃないかと思います〜。Catalyst::Plugin::FormValidator::Simple::Auto++

MySQLで "SQL_AUTO_IS_NULL = 0" じゃないと、IS NULLで検索されたときにエライ目に遭うという話

先日、Catalystアプリを作っていたとき、データの新規作成と編集を同じメソッドで処理していて、このようなコードを書きました。

my $rs = $c->model('DBIC::Hoge');
$rs->update_or_create(
    {   
        id   => $id, # primary key
        name => $name,
    },
    {},
);

hogeテーブルはこんな感じ。

+-------+--------------+------+-----+---------+----------------+
| Field | Type         | Null | Key | Default | Extra          |
+-------+--------------+------+-----+---------+----------------+
| id    | int(11)      | NO   | PRI | NULL    | auto_increment |
| name  | varchar(255) | NO   |     | NULL    |                |
+-------+--------------+------+-----+---------+----------------+

update_or_create メソッドを使っています。これは、primary key である id に対して、id = $id の条件を満たすデータが存在するかを検索します。そしてデータがあれば update 、データが無ければ、insert するという便利メソッドです。
※ちなみに、通常は primary key でデータが存在するかどうが検索しますが、add_unique_constraint制約を付ければ、任意のキーでデータを検索することが出来ます。
これについては、こことかこことかに詳しく書かれているので参考にどーぞ。

今回の場合、$id は数字が入っているときと undef のときがあります。数字が入っている場合（データ編集時）には select でデータが存在するので、そのデータの name カラムが update されます。

問題は $id が undef のとき（新規作成時）です。このときにはまず、以下のような select が走ります。

SELECT `me`.`id`, `me`.`name` FROM `hoge` `me` WHERE ( ( `me`.`id` IS NULL ) AND ( `me`.`delete_flag` = ? ) ): '0'

実はこれが曲者です！！ id が NULL のデータなんて無いから必ず insert するだろうと思っていました。思っていましたが実際に試してみると、、、

なんかときどき update してるんですけどー。

すいません、脱線しました。まぁ、、こういう謎な問題があってとても困っていたわけです。「なんか昔こんなの見たことあるなぁ...orz 」と思ってブックマークを漁った結果見つけました。こちらのサイトです。えらい、えらいぞ自分。よく頑張った(´Д⊂)

ちなみに、リファレンスにも載っていました。。

一番最近の AUTO_INCREMENT 値を含む行を、その値を生成した直後に、次のフォームのステートメントを発行することによって検索することができます :

SELECT * FROM tbl_name WHERE auto_col IS NULL

この動作は、SQL_AUTO_IS_NULL=0 を設定すると無効になります。項12.5.3. 「SET 構文」 を参照してください。

なんですかこの謎の仕様は！？こんなの知りませんよー｡･ﾟ･(ﾉД`)　なぜデフォルトで 0 じゃないのかと小一時間（ｒｙ　とりあえず yaml に指示通りに設定してみますた。

---
Model::DBIC:
  schema_class: MyApp::Schema
  connect_info:
    - dbi:mysql:db_test
    - user
    - pass
    - quote_char: '`' # テーブル名をバッククォートで囲む（予約語回避のため）
      name_sep: '.'
      on_connect_do:
        - 'SET SQL_AUTO_IS_NULL = 0'

とりあえず解決しました！！ヾ(oﾟωﾟo)ﾉﾞ

ちなみに on_connect_do には問題があるようですね。。詳しくはこちらのサイトに書かれています。
DBD::mysqlのmysql_auto_reconnectが真だとDB再接続時にDBICのon_connect_doが実行されない件

この設定もしといた方がいいのかなー。とか考えていたんですが、ふとこんなアイディアが・・・

my $rs = $c->model('DBIC::Hoge');

if ( $id ) {
    $rs->find( $id )->update(
        {   
            name => $name,
        },
        {},
    );
}
else {
    $rs->create(
        {   
            id   => $id,
            name => $name,
        },
        {},
    );
}

そもそも $id の値が真かどうかで、update するか create するかは決まりますからね。ちょっとコードは長くなりますけど安全な気がします。じゃあここまでの話はなんだったのかと。（＾＾；　にしても、この仕様は危険すぎるので、MySQLを使う人だったら知らないとはまる可能性が高いんじゃないでしょうか？

ちなみに以下は検証してみた結果です。

mysql> insert into hoge values ( null, "name_1" );
Query OK, 1 row affected (0.06 sec)


-- 初回のみデータが返ってきます
mysql> select * from hoge where id is NULL;
+----+--------+
| id | name   |
+----+--------+
|  1 | name_1 |
+----+--------+
1 row in set (0.05 sec)


-- 2 回目はデータが返ってきません
mysql> select * from hoge where id is NULL;
Empty set (0.01 sec)


mysql> SET SQL_AUTO_IS_NULL = 0;
Query OK, 0 rows affected (0.00 sec)


mysql> insert into hoge values ( null, "name_2" );
Query OK, 1 row affected (0.02 sec)


-- SQL_AUTO_IS_NULLを 0 に設定したので、データが返ってきません
mysql> select * from hoge where id is NULL;
Empty set (0.00 sec)

Catalystでオートログイン機能の実装

【追記ここから】

vkgtaroさんのコメントで教えていただいたURLを参考に MyApp::Plugin::Session.pm と読込み順番を修正しました。ありがとうございます！！というか、MyApp::Plugin::Session.pm は hidek さんのコードが素晴らしすぎて、最終的にほぼ同じになってしまいました（汗
※一部変更しました(09/06/08)

coderepos に同じような plugin があるよ http://coderepos.org/share/browser/lang/perl/Catalyst-Plugin-Session-DynamicExpiry-Cookie/trunk

【追記ここまで】

先日、Catalystで作ったWebアプリケーションで、オートログイン機能（次回からログインを省略する、とかのチェックボックス）を実装する必要がありました。ので、以下のサイトを参考に実装してみました。

Catalyst でオートログインとブラウザを閉じるまで有効な Cookie を共存させる
C::P::Session::DynamicExpiryを使ってremember me

仕様はこちら。

1. オートログインが無効の場合、ブラウザを閉じたらログイン状態破棄（セッションは30分）
2. オートログインが有効の場合、ブラウザを閉じてもログイン状態維持（セッションは2週間）

この機能は Catalyst::Plugin::Session::DynamicExpiry を使って実現出来るようですね。

そもそも Catalyst::Plugin::Session::State::Cookie を利用する場合、expiresには2種類あります。session の expires と、cookie の expires です。今回は session cookie（ブラウザを閉じるまでのみ有効なcookie ）にしたかったので、cookie_expires を 0 としました。YAMLに書くとこんな感じになります。

session:
  expires: 1800 # 指定しなかった場合は 7200
  cookie_expires: 0 # 指定しなかった場合は expires の値が使われる

cookie の expire sは 0 （ブラウザを閉じるまで）、session の expires は30分です。ブラウザを閉じてから開きなおすと、cookie の中のセッションIDが変わるため、新たなセッションが開始されます。

では、ここからいよいよ本題　(*･ω･)ノ

まず、オートログインのチェックボックスがチェックされたとき、session_time_to_live メソッドを呼んであげます。もともと、session のexpires は 1800 でしたが、session_time_to_live メソッドの引数によって自由に変更可能です。

sub login : Local {
    my ($self, $c) = @_;   

    if ( $c->authenticate($userinfo) ) {

        if ( $c->req->param('remember_me') ) {
            $c->session->{autologin} = 1;
            $c->session_time_to_live( 60 * 60 * 24 * 14 ); # 2週間
        }
        
        # ..snip..
    }
}

ログアウトのときには、session_time_to_live メソッドに undef を渡します。これは、Catalyst::Plugin::Session::DynamicExpiry で、このような実装となっているためです。if条件の中に入らないようにしてあげなければいけません。（・∀・）

sub logout : Local {
    my ($self, $c) = @_;

    $c->logout();

    if ( $c->session->{autologin} ) {
        $c->session_time_to_live(undef);
        delete $c->session->{autologin};
        delete $c->session->{cookie_expires};
    }

    $c->res->redirect( $c->uri_for('/') );
}

Catalyst::Plugin::Session::DynamicExpiry.pm

sub calculate_extended_session_expires {
    my $c = shift;

    if ( defined(my $ttl = $c->session_time_to_live) ) {
        $c->log->debug("Overridden time to live: $ttl") if $c->debug;
        return time() + $ttl;
    }

    return $c->NEXT::calculate_extended_session_expires( @_ );
}

ただ、このままでは cookie の expires は 0 のままです。session は2週間の expires を持っていますが、ブラウザを閉じてしまったら結局新たなセッションとなってしまいます。。そこで、cookie の expires は自作のプラグインで変更可能にします。
※以前のものだと、アクセス毎に cookie の expires が伸びてしまうので、セキュリティ的に良くないかと思い、初回のみ cookie の expires が設定される（2週間後）ように変更しました

MyApp::Plugin::Session.pm

package MyApp::Plugin::Session;

use strict;
use warnings;
use parent 'Catalyst::Plugin::Session::DynamicExpiry';

sub calculate_session_cookie_expires {
    my $c = shift;

    if ( defined (my $ttl = $c->session_time_to_live) ) {
        $c->log->debug("Overridden session cookie time to live: $ttl") if $c->debug;
        $c->session->{cookie_expires} ||= ( time() + $ttl );
        return $c->session->{cookie_expires};
    }

    return $c->NEXT::calculate_session_cookie_expires(@_);
}

1;

ちなみに読み込む順番はこんな感じで。

use Catalyst qw/
    +MyApp::Plugin::Session
    Session
    Session::Store::DBIC
    Session::State::Cookie
/;

Catalyst::Plugin::Session::State::Cookie よりも先に 自作のプラグインを読込むので、calculate_session_cookie_expires メソッドが呼ばれたときには、MyApp::Plugin::Session のものが使われます。これで、cookie の expires が session と同じように変更されますね。

これで無事、この仕様を満たすことが出来ました。.｡ﾟ+.(･∀･)ﾟ+.ﾟ

1. オートログインが無効の場合、ブラウザを閉じたらログイン状態破棄（セッションは30分）
2. オートログインが有効の場合、ブラウザを閉じてもログイン状態維持（セッションは2週間）