package DateTime::Date;
# $Id: Date.pm,v 1.24 2001/01/03 08:20:37 tom Exp $
################################################################

=head1 NAME

DateTime::Date - Date class 日付クラス

=head1 SYNOPSIS

 my $d = new DateTime::Date;
 $d->Set(1999, 10, 20);

=cut

################################################################
use strict;
use Exporter;
use vars qw(@ISA @EXPORT $AUTOLOAD
	    @Days_Month %MonthString %MonthHash %WeekString
	    $WeekHolydayTemplate $WeekSaturdayTemplate
	    @Holydays @HappyMonday $HappyMondayStartYear);

use ObjectTemplate;
use Template;

@ISA = qw(ObjectTemplate);
@EXPORT = qw(attributes DaysMonth);

attributes qw(year month day);

use Time::Local;

use overload
    "+=" => "Increment",
    "-=" => "Decrement",
    "-" => "Subtract",
    "<=>"=> "Compare"
    ;

my @digit_array = ('０', '１', '２', '３', '４', 
		   '５', '６', '７', '８', '９');

################################################################
# static variable

{
    @Days_Month = (0, 31, 28, 31, 30, 31, 30,
		   31, 31, 30, 31, 30, 31);

    %MonthString =
	('ABBR' => ['', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
		    'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'],
	 'FULL' => ['', 'January', 'February', 'March', 'April', 'May', 'June',
		    'July', 'August', 'September', 'October', 
		    'November', 'December']);

    for ('ABBR', 'FULL'){
	my $type = $_;
	my $i = 0;
	for (@{$MonthString{$type}}){
	    $MonthHash{$type}{$_} = $i;
	    $i++;
	}
    }

    %WeekString =
	('ABBR' => ['Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'],
	 'FULL' => ['Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday',
		    'Friday', 'Saturday'],
	 'JAPANESE' => ['日', '月', '火', '水', '木', '金', '土']);

    @Holydays = ([1,1], [1,2], [1,3],
		 [2,11], [4,29], [5,3], [5,4], [5,5],
		 [7.20], [9,15],
		 [11,3], [11,23], [12,23]);

    $WeekHolydayTemplate = qq(<span style="color: red"><font color="#FF0000">%w</font></span>) unless defined $WeekHolydayTemplate;
    $WeekSaturdayTemplate = qq(<span style="color: blue"><font color="#0000FF">%w</font></span>) unless defined $WeekSaturdayTemplate;

    @HappyMonday = ([1, 15, 2], [10, 10, 2]);   # [月, 日, 第何週]
    $HappyMondayStartYear = 2000                # 未定義だと適用せず
	unless defined $HappyMondayStartYear;
}

################################################################
# auto loading

use AutoLoader;
#no strict;

sub AUTOLOAD {
    $AutoLoader::AUTOLOAD = $AUTOLOAD;
    goto &AutoLoader::AUTOLOAD;
}

package DateTime::Date;
1;

################################################################
__END__

sub initialize($)
{
    my $self = shift;
    $self->year(1970) unless $self->year;
    $self->month(0) unless defined $self->month;
    $self->day(1) unless $self->day;
    $self->SUPER::initialize;
}



=head2 $d->SetTime($tm, $TZ);

$tm にセット。
$TZ は省略可。

=cut

sub SetTime ($$;$)
{
    my ($self, $time, $tz) = @_;

    require DateTime::Zone;
    $tz = $ENV{'TZ'} || 'GMT' unless defined $tz;
    my ($d, $m, $y) = (gmtime($time + DateTime::Zone::tz_offset($tz)))[3..5];
    $self->Set($y+1900, $m+1, $d);
}

=head2 $d->Set($year, $month, $day);

年月日をセット

=cut

sub Set($$$$)
{
    my ($self, $y, $m, $d) = @_;
    $self->year($y);
    $self->month($m);
    $self->day($d);
#    unless ($self->IsValid){
#	die "invalid: $y/$m/$d, ", caller;
#    }
    $self;
}

=head2 $d->GetTime($TZ);

tm を得る

=cut

sub GetTime($;$)
{
    my ($self, $tz) = @_;

    require DateTime::Zone;
    $tz ||= 'GMT';
#    die "invalid time data: ", $self->Dump
#	unless $self->IsValid;
    return timegm(0, 0, 0,
		  $self->day, $self->month-1, $self->year-1900)
	- DateTime::Zone::tz_offset($tz);

}

sub Dup($)
{
    my $self = shift;

    my $class = ref $self;
    my $dup = new $class;
    $dup->year($self->year);
    $dup->month($self->month);
    $dup->day($self->day);
    return $dup;
}

sub Dump($)
{
    my $self = shift;
    return sprintf("%04d/%02d/%02d",
		   $self->year, $self->month, $self->day);
}
################################################################

=head2 $d->IsValid

日付として正しいか

=cut

sub IsValid ($)
{
    my $self = shift;
    return 0 unless $self->year;
    return 0 if $self->month <= 0 || $self->month > 12;
    return 0 if $self->day <= 0;
    return 0 if $self->day > $self->DaysMonth;
    return 1;
}

=head2 $d->IsHolyday

休日かどうか

 日曜 : 'S'
 祝日 : 'H'
 振替 : 'R'
 happy monday : 'M'

=cut

sub IsHolyday ($)
{
    my $self = shift;

 
    my ($year, $month, $day) = ($self->year, $self->month, $self->day);
    my $week = $self->week;
    
    # 祝日
    for (@Holydays){
	my ($m, $d) = @$_;
	if ($month == $m && $day == $d){
	    return 'H';
	}
    }
    # 春分、秋分
    if ($year >= 1900 && $year <= 2099){    # この間の簡易式を使う
	if ($month == 3){
	    my $s_day = int(0.24242 * $year -
			    int($year/4) + 35.84);
	    return 'H' if $day == $s_day;
	} elsif ($month == 9){
	    my $a_day = int(0.24204 * $year -
			    int($year/4) + 39.01);
	    return 'H' if $day == $a_day;
	}
    }

    # ハッピーマンデー
    if ($HappyMondayStartYear &&           # 定義してなきゃ適用せず
	$year >= $HappyMondayStartYear){
	if ($week == 1){
	    my $wn = $self->WeekNumber;
	    for (@HappyMonday){
		my ($m, $d, $n) = @$_;
		return 'M' if $month == $m && $wn == $n;
	    }
	}
    } else {              # 2000 年以前は普通
	for (@HappyMonday){
	    my ($m, $d, $n) = @$_;
	    return 'H' if $month == $m && $day == $d;
	}
    }
    return 'S' if $self->week == 0;    # 日曜は休み
    # 振り替え休日
    if ($week == 1){
	my $yesterday = new DateTime::Date(year=>$year,
					   month=>$month,
					   day=>$day);
	$yesterday--;
	if ($yesterday->IsHolyday eq 'H'){
	    return 'R';
	}
    }
    return undef;
}

=head2 $d->WeekNumber;

第何＊曜か

=cut

sub WeekNumber ($)
{
    my $self = shift;

    my $first_week = ($self->week - $self->day+1) % 7;

#    print "day: " . $self->day . "\n";
#    print "fw: $first_week\n";
    my $n = int(($self->day-1)/7)+1;
#    print "[$n]";
    return $n;
#    return int(($self->day+$first_week-1)/7 + 1);
}
    
sub part ($)
{
    my $self = shift;
    my $part;
    
    if ($self->day =~ /\d+/){
	$part = ('a', 'b', 'c', 'c')[int($self->day/10)];
    } elsif ($self->day =~ /[abc]/){
	$part = $self->day;
    }
    return $part;
}
sub part_span ($)
{
    my $self = shift;

    if ($self->part eq 'a'){
	return (1, 9);
    } elsif ($self->part eq 'b'){
	return (10, 19);
    } elsif ($self->part eq 'c'){
	return (20, $self->DaysMonth);
    } else {
	return (1, $self->DaysMonth);
    }
}

################################################################

=head2 $d->GetParams($params);

パラメータ取得。
$params には無名ハッシュを渡す。

=cut

sub GetParams($$)
{
    my ($self, $params) = @_;
    $params->{year} = $params->{Year} = $params->{'y'} = $params->{'Y'} =
	sprintf("%d", $self->year);
    $params->{month} = $params->{Month} = $params->{'m'} = $params->{'M'} =
	sprintf("%d", $self->month);
    $params->{day} = $params->{Day} = $params->{'d'} = $params->{'D'} = 
	sprintf("%d", $self->day);
    $params->{month_abbr} = $MonthString{'ABBR'}->[$self->month];
    
    $params->{'part'} = $self->part;
    $params->{week} = $params->{w} = $WeekString{'ABBR'}->[$self->week];
    $params->{Week} = $params->{W} = $WeekString{'JAPANESE'}->[$self->week];
    if ($self->IsHolyday){
	$params->{week_holy} = Expand($WeekHolydayTemplate,
				      {w=>$params->{week}});

	$params->{Week_holy} = Expand($WeekHolydayTemplate,
				      {w=>$params->{Week}});
    } elsif ($self->week == 6){    # Saturday
	$params->{week_holy} = Expand($WeekSaturdayTemplate,
				      {w=>$params->{week}});
	
	$params->{Week_holy} = Expand($WeekSaturdayTemplate,
				      {w=>$params->{Week}});
    } else {
	$params->{week_holy} = $params->{week};
	$params->{Week_holy} = $params->{Week};
    }
    $params->{'0m'} = sprintf("%02d", $self->month);
    $params->{'0d'} = sprintf("%02d", $self->day);
    $params->{'high'} = sprintf("%1d", int($self->day/10));
    $params->{W} = $WeekString{'JAPANESE'}->[$self->week];

    if (1){
	$params->{Year} =~ s/(\d)/$digit_array[$1]/eg;
	$params->{Month} =~ s/(\d)/$digit_array[$1]/eg;
	$params->{Day} =~ s/(\d)/$digit_array[$1]/eg;

	$params->{Y} =~ s/(\d)/$digit_array[$1]/eg;
	$params->{M} =~ s/(\d)/$digit_array[$1]/eg;
	$params->{D} =~ s/(\d)/$digit_array[$1]/eg;

    } else {
	eval "require 'jcode.pl'";
	unless ($@){
	    &jcode::tr(\$params->{Year}, "0123456789", "０１２３４５６７８９");
	    &jcode::tr(\$params->{Month}, "0123456789", "０１２３４５６７８９");
	    &jcode::tr(\$params->{Day}, "0123456789", "０１２３４５６７８９");    
	    &jcode::tr(\$params->{Y}, "0123456789", "０１２３４５６７８９");
	    &jcode::tr(\$params->{M}, "0123456789", "０１２３４５６７８９");
	    &jcode::tr(\$params->{D}, "0123456789", "０１２３４５６７８９");
	}
    }
    return $params;
}
################################################################
# calc week by gregolian
# contributed by KKI <kki-s@geocities.co.jp>
sub week($)
{
    my $self = shift;
    my $y = $self->year;
    my $m = $self->month;
    $y = $y + 399 if ($m < 3);
    ($y + int($y/4) - int($y/100) + int($y/400) +
     (0, 0, 3, 2, 5, 0, 3, 5, 1, 4, 6, 2, 4)[$m] +
     $self->day
    ) % 7;
#    (localtime(timelocal(0,0,0,$self->day,$self->month-1,$self->year)))[6];
}
sub week_string($$)
{
    my ($self, $mode) = @_;

    return $WeekString{uc($mode)}[$self->week];
}
sub month_string ($$)
{
    my ($self, $mode) = @_;
    return $MonthString{uc($mode)}[$self->month];
}
	    
################################################################

=head2 $d->Increment($quantity);

日付を増やす。
$quantity には増やす量：'1Y', '2M', '30D' など

$d += '1M'; とも書ける。    

=cut

sub Increment ($$$)
{
    my ($self, $quantity) = @_;
    my ($num, $unit) = $quantity =~ /^(\d+)([YMD])$/;

    if ($quantity eq '1'){
	$num = 1;
	$unit = 'D';
    }

#    print "date:$quantity, ($num, $unit)\n";
    if ($unit eq 'D'){
	for (1..$num){
	    if ($self->day < $self->DaysMonth($self->month)){
		$self->day($self->day+1);
	    } else {
		$self->day(1);
		$self->Increment("1M");
	    }
	}
    } elsif ($unit eq 'M'){
	for (1..$num){
	    if ($self->month < 12){
		$self->month($self->month+1);
	    } else{
		$self->month(1);
		$self->year($self->year+1);
	    }
	}
    } elsif ($unit eq 'Y'){
	$self->year($self->year+$num);
    } else {
	die "illegal operator $quantity";
    }
    return $self;
}

=head2 $d->Decrement($quantity);

日付を減らす

=cut

sub Decrement ($;$)
{
    my ($self, $quantity) = @_;
    my ($num, $unit) = $quantity =~ /^(\d+)([YMD])$/;

    if ($quantity eq '1'){
	$num = 1;
	$unit = 'D';
    }
    if ($unit eq 'D'){
	for (1..$num){
	    if ($self->day > 1){
		$self->day($self->day-1);
	    } else {
		$self->Decrement("1M");
		$self->day($self->DaysMonth($self->month));
	    }
	}
    } elsif ($unit eq 'M'){
	for (1..$num){
	    if ($self->month > 1){
		$self->month($self->month-1);
	    } else{
		$self->month(12);
		$self->year($self->year-1);
	    }
	}
    } elsif ($unit eq 'Y'){
	$self->year($self->year-$num);
    } else {
	die "illegal operator $quantity";
    }
    return $self;
}

sub Subtract($$$)
{
    my ($self, $obj, $info) = @_;

    if ($info){
	return $obj->GetTime() - $self->GetTime();
    } else {
	return $self->GetTime() - $obj->GetTime();
    }
}
    

=head2 $d->Compare;

比較

=cut

sub Compare ($$)
{
    my ($self, $obj) = @_;

    my $s_ymd = sprintf("%04d%02d%02d", $self->year, $self->month, $self->day);
    my $o_ymd = sprintf("%04d%02d%02d", $obj->year, $obj->month, $obj->day);

#    die "$s_ymd <=> $o_ymd";
    return $s_ymd <=> $o_ymd;
}
################################################################

=head2 $d->DaysMonth;

現在の年、月の日数

    $dt->DaysMonth;

or
    DaysMonth($year, $month);


=cut

sub DaysMonth ($;$)
{
    my $self = shift;
    my ($y, $m);

    if (ref $self){      # $dt->DaysMonth;
	$y = $self->year;
	$m = $self->month;
    } else {             # DaysMonth($year, $month);
	$y = $self;
	$m = shift;
    }
	
    if ($m == 2 && (($y%4==0 && $y%100) || ($y%400==0))){  # leap year
	return 29;
    } else {
	return $Days_Month[$m];
    }
}
sub GetMonthNumber($$)
{
    my ($type, $str) = @_;

    return $MonthHash{$type}{$str};
}
sub GetWeekString($$)
{
    my ($type, $num) = @_;

    return $WeekString{$type}[$num];
}
1;
