Catalyst::Plugin::ModuleRefresh

いま開発している Catalyst のアプリケーションはクラスが 450 個以上!!もあるので、テストサーバーを起動するだけで30〜40秒もかかってしまいます。一行修正するたびにテストサーバーを再起動しなければいけないので、ちょっと変えてすぐ実行するスクリプト言語のよさが全く生かせません。というわけで、Jifty で使っている Module::Refresh というのがよさそうなので、プラグイン化してみました。ちょっと試した感じでは動いているようです。ただし、完全にリロードできるかどうかわかないので、開発時のみ有効にし、本番で使うことはお勧めしません。

package Catalyst::Plugin::ModuleRefresh;

use strict;
use warnings;
use DateTime;
use Date::Parse;
use Date::Calc;
use Module::Refresh;

our $VERSION = '0.01';

=head1 NAME

Catalyst::Plugin::ModuleRefresh - 更新されたモジュールを自動的にリロードするプラグイン

=head1 SYNOPSIS

use Catalyst qw/ModuleRefresh/

=head1 DESCRIPTION

最終アクセス時間より最終更新時間のほうが新しいファイルをリロードします。
Catalyst のような起動しっぱなしのアプリケーションでは特に有用です。

=head1 METHODS

=head2 check_modules_update

最終アクセス時間より最終更新時間のほうが新しいファイルをリロードします。

=cut

sub check_modules_update {
    my($c) = @_;
    unless (exists $c->session->{last_access_date}) {
        $c->session->{last_access_date} = $c->_date_time_now();
    }
    my @list = $c->_reload_module($c->config->{home} . 'lib');
    $c->log->info("++++++ check_modules_update ++++++");
    for my $item (@list) {
        $c->log->info("+ refresh: " . $item);
    }
    $c->log->info("++++++++++++++++++++++++++++++++++");
    $c->session->{last_access_date} = $c->_date_time_now();
}

=head1 PRIVATE METHODS

=head2 _timestamp_compare

指定した2つのタイムスタンプの大小を返します
引数:
 $date1 - タイムスタンプ1
 $date2 - タイムスタンプ2
戻り値:
   -1 - $date1 < $dat32
    0 - $date1 = $date2
    1 - $date1 > $date2
undef - $date1 または $date2 が無効

=cut

sub _timestamp_compare {
    my($self, $date1, $date2) = @_;

    # $sec, $min, $hour, $day, $month, $year, $zone
    my(@array1) = Date::Parse::strptime($date1);
    my(@array2) = Date::Parse::strptime($date2);
    return undef if (scalar(@array1) == 0 || scalar(@array2) == 0);

    my $dt1;
    eval {
        $dt1 = DateTime->new(
                            year   => $array1[5] + 1900,
                            month  => $array1[4] + 1,
                            day    => $array1[3],
                            hour   => ($array1[2] == 0) ? '0' : $array1[2],
                            minute => ($array1[1] == 0) ? '0' : $array1[1],
                            second => ($array1[0] == 0) ? '0' : $array1[0]
                          );
    };
    return undef if ($@);
    
    my $dt2;
    eval {
        $dt2 = DateTime->new(
                            year   => $array2[5] + 1900,
                            month  => $array2[4] + 1,
                            day    => $array2[3],
                            hour   => ($array2[2] == 0) ? '0' : $array2[2],
                            minute => ($array2[1] == 0) ? '0' : $array2[1],
                            second => ($array2[0] == 0) ? '0' : $array2[0]
                          );
    };
    return undef if ($@);

    my $duration = $dt1 - $dt2;
    if ($duration->is_positive()) {
        return 1;
    } elsif ($duration->is_zero()) {
        return 0;
    } elsif ($duration->is_negative()) {
        return -1;
    } else {
        return undef;
    }
}

=head2 _date_time_now

現在の時間を YYYY-MM-DD HH:MM:SS+09 形式で返します。

=cut

sub _date_time_now {
    my($c, $time) = @_;
    if ($time) {
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) 
            = localtime($time);
        my $date_time = sprintf("%04d-%02d-%02d %02d:%02d:%02d+09",
            1900 + $year, 1 + $mon, $mday, $hour, $min, $sec);
        return $date_time;
    } else {
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) 
            = localtime();
        my $date_time = sprintf("%04d-%02d-%02d %02d:%02d:%02d+09",
            1900 + $year, 1 + $mon, $mday, $hour, $min, $sec);
        return $date_time;
    }
}

=head2 _reload_module

更新されているモジュールを片っ端からリロードします。
check_modules_update から呼ばれる内部関数です。

=cut

sub _reload_module {
    my($c, $base) = @_;
    my @list;
    my $lib_dir = $c->config->{home} . 'lib';
    for my $dir (glob($base.'*')) {
        if(-d $dir) {
            push(@list, $c->_reload_module($dir . '/'));
        } else {
            my $file_name = $dir;
            unless ($file_name =~ /CVS/) {
                $file_name =~ m/$lib_dir\/(.+)$/xms;
                my $load_file = $1;
                my $last_update = $c->_date_time_now((stat($file_name))[10]);
                if ($c->_timestamp_compare($c->session->{last_access_date}, $last_update) <= 0) {
                    push(@list, $load_file);
                    Module::Refresh->new->refresh_module($load_file);
                }
            }
        }
    }
    return @list;
}

1;