空気を読まずにDate::Class(仮)のコンポーネントを考えてみた

まずは日付系の処理を集約してくれるDate::Class(仮)を考えてみた - Unknown::Programmingの記事に対していくつか突っ込みがあったので回答。

 2007年03月26日 charsbar perl  それPla(gger::Dateのようなのをひとつ挟めば済むんでないかと)

コレなんですが、継承してメソッド定義すればいいってのは確かにそうなんですが、これはこれでそういう継承したモジュールが増えてしまって同じような処理するメソッドが出てくるのが問題でして。

たとえばあるHogeサイト用にHoge::DateTime作ってメソッドを定義する。

でまたあるMugeサイト用にMuge::DateTime作ってメソッドを定義する。

となるとHogeでもMugeでも使うメソッドがあった場合は処理の二重化になっちゃう。

Hoge用とかMuge用とか分けなきゃいいじゃんって考えたんだけど、そうすると今度はHogeのサイトでしか使わないメソッドはMugeには必要ないしとかになって無駄にクラスの巨大化に繋がってやっぱり微妙ということに。

だったら初めから別のモジュールとして切り分けておいてその時々に応じてMIXINさせるのがいいんじゃないかなぁと思った次第です。

 2007年03月27日 miyagawa  それなんてDateTime::Calendar

これなんですが、ちょっとあれは僕の例が悪かったですね。

あの記事を見る限りでは確かにカレンダーを作るときのように見えたと思うんですけど本質はそうじゃなくて処理の二重化を防ぎつつ再利用しやすい日付モジュールがほしいなぁという動機から考えたわけでして。

そういう意味ではDateTime::Calenderでは僕が考えているようなことはできないのかなぁと。

というわけで前回の記事では例があまりよくなかったので今回はちゃんと考えてみました。

・・・まぁ微妙な空気のまま空気を読まずにいくつかのコンポーネント案をば以下に。

TimeZoneのデフォ値設定

例えばTimeZoneなんかはデフォ値設定しておきたいんで、

 package Date::Class::Component::DefaultTimeZone;
 use strict;
 use warnings;
 use base qw/Class::Data::Accessor/;
 __PACKAGE__->mk_classaccessor('default_time_zone','local');
 
 sub new {
     my ($proto,%opt) = @_;
     $opt{time_zone} ||= $proto->default_time_zone;
     $proto->next::method(%opt);
 }

 sub now {
     my ($proto,%opt) = @_;
     $opt{time_zone} ||= $proto->default_time_zone;
     $proto->next::method(%opt);
 }

 sub today {
     my ($proto,%opt) = @_;
     $opt{time_zone} ||= $proto->default_time_zone;
     $proto->next::method(%opt);
 }

 1;

 package MyDateClass;
 use strict;
 use warnings;
 use base qw/Date::Class/;
 __PACKAGE__->load_components(qw/DefaultTimeZone Core/);
 __PACKAGE__->default_time_zone('Asia/Tokyo');
 1;
 
 # TimeZoneはAsia/Tokyoが設定される。
 my $dt = MyDateClass->new( year => 1980, month => 12 , day => 22 );

といったような感じで処理できるようになる。

さらにAsia/Tokyoがデフォ値になるようにJapanese::DafaultTimeZoneなんてのもありかもしれない。

 package Date::Class::Component::Japanese::DefaultTimeZone;
 use strict;
 use warnings;
 use base qw/Date::Class::Base/;
 __PACKAGE__->load_components(qw/DefaultTimeZone/);
 __PACKAGE__->default_time_zone('Asia/Tokyo');
 1;


 package MyDateClass;
 use strict;
 use warnings;
 use base qw/Date::Class/;
 __PACKAGE__->load_components(qw/Japanese::DefaultTimeZone Core/);
 1;
 
 # TimeZoneはAsia/Tokyoが設定される。
 my $dt = MyDateClass->new( year => 1980, month => 12 , day => 22 );

オブジェクトの生成をnewで一元管理

次の案としてオブジェクトの生成をnewで一元管理するコンポーネントとか。

ちなみに僕が自作で作って使ってた日付クラスはnewに色々なタイプの引数を渡すことでオブジェクトを生成できるようになってました。DateTimeのnewをそーゆー感じで動くようにしてみたいと思います。

 package Date::Class::Component::New;
 use strict;
 use warnings;
 use base qw/Date::Class::Base/;
 use List::MoreUtils qw/zip/;
 use DateTime::Format::Strptime;
 
 # さっそくさっき作ったDafaultTimeZoneを使う
 __PACKAGE__->load_components(qw/DefaultTimeZone/);
 
 our @KEYLIST = qw/year month day hour minute second nanosecond/;
 
 sub new {
     my $proto = shift;
     if(@_==1){
         my $type = shift;
         if ( ref $type eq 'HASH' ) {
             # ハッシュならそのまま投げる
             return $proto->next::method(%$type);
         }
         elsif ( ref $type eq 'ARRAY' ) {
             # 配列はハッシュに置き換えて投げる
             my @tmp = @KEYLIST[0..@$type-1];
             return $proto->next::method( zip(@tmp,@$type) );
         }
         elsif ( ref $type eq '' ) {
             # 文字列だったらYYYYMMDDHH24MISS
             my $len = length $type;
             my $pattern = 
                 ($len == 14) ? '%Y%m%d%H%M%S' :
                 ($len == 12) ? '%Y%m%d%H%M'   :
                 ($len == 10) ? '%Y%m%d%H'     :
                 ($len == 8 ) ? '%Y%m%d'       :
                 ($len == 6 ) ? '%Y%m'         :
                                '%Y%m%d';
             my $dt = DateTime::Format::Strptime->new(
                 pattern   => $pattern,
                 time_zone => $proto->default_time_zone,
             )->parse_datetime($type);
             return $proto->from_object( object => $dt );
         }
         elsif ( ref $type eq 'SCALAR' ) {
             # スカラリファレンスならepoch。これは微妙かなぁ・・・
             return $proto->from_epoch( epoch => $$type );
         }
         elsif ( $type->isa('DateTime') ) {
             # DateTimeオブジェクトだったら
             return $proto->from_object( object => $type );
         }
         elsif ( $type->isa('Date::Simple') ) {
             # なんとなくDate::Simpleにも対応
             return $proto->new(
                 year  => $type->year,
                 month => $type->month,
                 day   => $type->day,
             );
         }
         else {
             # よくわからない引数が渡されてるのでそのままnewに投げる
             return $proto->next::method(@_);
         }
     }
     elsif (@_) {
         # 普通の呼び出し
         return $proto->next::method(@_);
     }
     
     # 引数が何も渡されなかったら現在の時間を返す
     return $proto->now();
 }
 
 1;

パッと作ったからちょっと実装汚いけどまぁスルー力ってことで。で使い方は、

 package MyDateClass;
 use strict;
 use warnings;
 use base qw/Date::Class/;
 __PACKAGE__->load_components(qw/New Core/);
 __PACKAGE__->default_time_zone('Asia/Tokyo');
 1;

 my $dt;
 
 print $dt = MyDateClass->new( year => 1980, month => 12 , day => 22 );

 print $dt = MyDateClass->new({ year => 2000, month => 5 , day => 10 });
 
 print $dt = MyDateClass->new([2010,3,21,0]);
 
 print $dt = MyDateClass->new('20090101235155');
 
 print $dt = MyDateClass->new(\100000000);
 
 print $dt = MyDateClass->new($dt->add(days => 10 ));
 
 print $dt = MyDateClass->new();

実行結果

 1980-12-22T00:00:00
 2000-05-10T00:00:00
 2010-03-21T00:00:00
 2009-01-01T23:51:55
 1973-03-03T09:46:40
 1973-03-13T09:46:40
 2007-03-29T17:58:03

とまあこんな感じでnewだけで色々な方法でオブジェクトが生成できるようになったナリ。

差分日数を簡単に

次に差分日数。ちょっと調べてみたら結構メンドクサイみたいなんで簡単に取得するやつを考えてみた。

 package Date::Class::Component::DiffCount;
 use strict;
 use warnings;
 
 sub diff_day_count {
     my $self = shift;
     my $dt   = shift;
     $self->delta_days($dt)->in_units('days');
 }
 1;
 

 package MyDateClass;
 use strict;
 use warnings;
 use base qw/Date::Class/;
 __PACKAGE__->load_components(qw/DiffCount Japanese::DefaultTimeZone Core/);
 1;

 my $dt = MyDateClass->new( year => 1980, month => 12 , day => 22 );

 # 「8」と表示される
 print $dt->diff_day_count(MyDateClass->new( year => 1980, month => 12 , day => 30 )); 

これにさらに引数を楽に渡せるようにNewコンポーネントを使って拡張してみるとこうなる

 package Date::Class::Component::DiffCount;
 use strict;
 use warnings;
 use base qw/Date::Class::Base/;
 __PACKAGE__->load_components(qw/New/);
 
 sub diff_day_count {
     my ($self,@opt) = @_;
     $self->delta_days(ref($self)->new(@opt))->in_units('days');
 }
 1;


 package MyDateClass;
 use strict;
 use warnings;
 use base qw/Date::Class/;
 __PACKAGE__->load_components(qw/DiffCount Japanese::DefaultTimeZone Core/);
 1;

 my $dt = MyDateClass->new( year => 1980, month => 12 , day => 22 );

 # かなりスッキリした
 print $dt->diff_day_count([1980,12,30]); 

diff_day_countのほかにもdiff_month_countやdiff_second_countとかも用意しておくといい感じかもね。

set系の簡易メソッド

日だけ変更する場合はset_dayでいけるけど、月と日だけ変更したい場合って良くあるのでそーゆーのが欲しい。あと日を月末に変更するとかも。

 package Date::Class::Component::SetHelper;
 use strict;
 use warnings;
 
 sub set_year_month { shift->set( year => shift, month => shift ) }
 sub set_month_day  { shift->set( month => shift, day => shift )  }
 
 sub set_last_day_of_month {
     my $self = shift;
     
     # _month_lengthって使ってもいいのかなぁ・・・。
     my $day  = ref($self)->_month_length( $self->year, $self->month );
     $self->set_day($day);
 }
 
 *set_lday_of_month = \&set_last_day_of_month; # エイリアス
 
 1;
 
 
 package MyDateClass;
 use strict;
 use warnings;
 use base qw/Date::Class/;
 __PACKAGE__->load_components(qw/SetHelper Japanese::DefaultTimeZone Core/);
 1;

 my $dt = MyDateClass->new( year => 1980, month => 10 , day => 5 );
 
 $dt->set_month_day(12,22);
 print $dt; # 1980-12-22

 $dt->set_last_day_of_month();
 print $dt; # 1980-12-31

一月分のリストを取得

ある月のリストを返したりとか。例えば2007年3月なら2007年3月1日〜2007年3月31日までをリストで取得するみたいな

 package Date::Class::Component::MonthList;
 use strict;
 use warnings;
 use base qw/Date::Class::Base/;
 
 # 先日の記事の時に作ったIteratorコンポーネントとさっきのSetHelper
 __PACKAGE__->load_components(qw/Iterator SetHelper/);
 
 sub month_list {
     my $self     = shift;
     my $start_dt = $self->clone->set_day(1);
     my $end_dt   = $self->clone->set_last_day_of_month;
     $start_dt->list_or_iterator($end_dt);
 }
 
 1;
 
 
 package MyDateClass;
 use strict;
 use warnings;
 use base qw/Date::Class/;
 __PACKAGE__->load_components(qw/MonthList Japanese::DefaultTimeZone Core/);
 1;

 my $dt = MyDateClass->new( year => 1980, month => 12 );

 my @month = $dt->month_list;
 print qq{$_\n} for @month;

実行結果

 1980-12-01T00:00:00
 1980-12-02T00:00:00 
 1980-12-03T00:00:00
      :
      : (中略)
      :
 1980-12-29T00:00:00
 1980-12-30T00:00:00
 1980-12-31T00:00:00

こんな感じです。

先日の記事の時に作ったIteratorコンポーネントが大活躍ですね。returnでかえしているlist_or_iteratorメソッドはwantarrayを利用しているのでリストで受け取ればDate::Classオブジェクトのリストが得られ、スカラで受け取ればイテレーターオブジェクトがかえってくるので好きなほうを選んでくださいって感じで。

年月日をハッシュで取得する

日付のデータだけ欲しい場合とかに便利かと。

 package Date::Class::Component::ReturnHash;
 use strict;
 use warnings;
 
 sub date_hash {
     my $self = shift;
     map { ($_ => $self->$_) } qw/year month day/;
 }
 
 sub time_hash {
     my $self = shift;
     map { ($_ => $self->$_) } qw/hour minute second/;
 }
 
 sub datetime_hash {
     my $self = shift;
     map { ($_ => $self->$_) } qw/year month day hour minute second/;
 }
 
 1;

テンプレートエンジンに渡す場合とかそーゆー用途かな。戻り値はハッシュよりもハッシュのリファレンスの方がいいかもね。

以上、コンポーネント案でした。

ほかにもym()メソッドやmd()メソッドとか欲しいのもはいっぱいあるけど長くなりすぎるんでここら辺でいったんおしまいで。




おまけ:今日は何の日♪

今日が何の記念日か取得するコンポーネント

 package Date::Class::Component::Japanese::Anniversary;
 use strict;
 use warnings;
 use LWP::Simple ();
 use Encode;
 
 our $VERSION = '0.01';
 
 # 日本記念日協会 2007/03/29 現在
 our $KINENBI_URL = 'http://www.kinenbi.gr.jp/cgi-local/whatday.cgi?M=%s&D=%s';
 
 our %CACHE = (
     official   => {},
     unofficial => {}
 );
 
 sub _get_anniversary {
     my $self = shift;
     my $key  = shift;
     
     my $md = $self->strftime('%m%d');
     
     return $CACHE{$key}->{$md} if exists $CACHE{$key}->{$md};
     my $contents = LWP::Simple::get(sprintf $KINENBI_URL , $self->month , $self->day );
     return [] unless defined $contents;
     
     my @offical   = $contents =~ m|<TD nowarp><FONT size="4" color="#666666">..(.+)</FONT><FONT size="2"></FONT></TD>|g;
     my @unoffical = $contents =~ m|<TD nowarp><FONT size="3" color="#666666">..(.+)</FONT><FONT size="2"></FONT></TD>|g;
     
     $CACHE{official}->{$md}   = [ map { decode('eucjp',$_) } @offical   ];
     $CACHE{unofficial}->{$md} = [ map { decode('eucjp',$_) } @unoffical ];
     
     return $CACHE{$key}->{$md};
 }
 
 sub anniversary {
     my $self = shift;
     return
         $self->official_anniversary,
         $self->unofficial_anniversary;
 }
 
 sub official_anniversary {
     my $self = shift;
     @{_get_anniversary($self,'official')};
 }
 
 sub unofficial_anniversary {
     my $self = shift;
     @{_get_anniversary($self,'unofficial')};
 }
 
 1;

って感じ。日本記念日協会API的なものが用意されてたら嬉しいんだけどなぁ。

以下実行サンプル

 package MyDateClass;
 use strict;
 use warnings;
 use base qw/Date::Class/;
 MyDateClass->load_components(qw/
     Japanese::Anniversary
     Japanese::DefaultTimeZone
     Core
 /);
 
 my $dt = MyDateClass->new( year => '2007', month => '11', day => '11' );
 
 print qq{協会認定の記念日\n};
 print qq{  $_\n} for $dt->official_anniversary;
 
 print qq{\nその他の記念日\n};
 print qq{  $_\n} for $dt->unofficial_anniversary;

実行結果

 協会認定の記念日
   鏡の日
   長野県きのこの日
   鮭の日
   おりがみの日
   きりたんぽの日
   サッカーの日
   磁気の日
   ポッキー&プリッツの日
   ジュエリーデー
   めんの日

 その他の記念日
   チーズの日
   ピーナツの日
   電池の日

ってか記念日多すぎw

誰がどういう基準で認定してんだコレ・・・。

さらにおまけ:ざ・わーるど

 
 package Date::Class::Component::Acme::JoJo::TheWorld;
 use strict;
 use warnings;
 
 our $VERSION  = '0.01';
 our $TIMESTOP = 'Date::Class::Component::Acme::JoJo::TheWorld::__TimeStop__';
 
 sub the_world_time_stop {
     my $self = shift;
     for my $t (
         $self->{local_rd_days},
         $self->{local_rd_secs},
         $self->{utc_year},
         $self->{utc_rd_days},
         $self->{utc_rd_secs},
     ) {
         tie $t , $TIMESTOP , $t;
     }
     $self;
 }
 
 sub the_world_time_restart {
     my $self = shift;
     for my $t (
         $self->{local_rd_days},
         $self->{local_rd_secs},
         $self->{utc_year},
         $self->{utc_rd_days},
         $self->{utc_rd_secs},
     ) {
         untie $t;
     }
     $self;
 }
 
 package Date::Class::Component::Acme::JoJo::TheWorld::__TimeStop__;
 use Tie::Scalar;
 use base qw/Tie::StdScalar/;
 
 sub STORE {}
 sub FETCH {
     defined ${$_[0]} ? ${$_[0]} : 0;
 }
 
 1;

時よ止まれ!

 package MyDateClass;
 use strict;
 use warnings;
 use base qw/Date::Class/;
 __PACKAGE__->load_components(qw/Acme::JoJo::TheWorld Japanese::DefaultTimeZone Core/);
 1;
 
 my $dt = MyDateClass->new( year => 1980, month => 12 , day => 22 );
 
 $dt->the_world_time_stop(); # 時よ止まれ!
 $dt->add( 'seconds' => 5 );
 print $dt; # 1980-12-22T00:00:00
 
 $dt->the_world_time_restart(); # 時は動き出す
 $dt->add( 'seconds' => 5 );
 print $dt; # 1980-12-22T00:00:05

くだらねぇw