File Coverage

blib/lib/DateTime/Calendar/Hebrew.pm

Criterion	Covered	Total	%
statement	266	294	90.4
branch	59	102	57.8
condition	57	75	76.0
subroutine	64	68	94.1
pod	30	33	90.9
total	476	572	83.2

package DateTime::Calendar::Hebrew;
use DateTime;
use Params::Validate qw/validate SCALAR OBJECT CODEREF/;

use vars qw($VERSION);
$VERSION = '0.05';
use 5.010_000;

use strict;
no strict 'refs';

use constant HEBREW_EPOCH => -1373429;

use overload
	fallback => 1,
	'<=>' => '_compare_overload',
	'cmp' => '_compare_overload',
	'+'   => '_add_overload',
	'-'   => '_subtract_overload';

sub new {
    my $class = shift;
    my %p = validate( @_,
                      { year       => { type => SCALAR },
                        month      => { type => SCALAR, default => 1,
									    callbacks => {
											'is between 1 and 13' =>
											sub { $_[0] >= 1 && $_[0] <= 13 }
									    }
									  },
                        day        => { type => SCALAR, default => 1,
									    callbacks => {
											'is between 1 and 30' =>
											sub { $_[0] >= 1 && $_[0] <= 30 }
									    }
									  },
						hour       => { type => SCALAR, default => 0,
									    callbacks => {
											'is between 0 and 23' =>
											sub { $_[0] >= 0 && $_[0] <= 23 }
									    }
									  },
						minute     => { type => SCALAR, default => 0,
									    callbacks => {
											'is between 0 and 59' =>
											sub { $_[0] >= 0 && $_[0] <= 59 }
									    }
									  },
						second     => { type => SCALAR, default => 0,
									    callbacks => {
											'is between 0 and 59' =>
											sub { $_[0] >= 0 && $_[0] <= 59 }
									    }
									  },
						nanosecond =>	{ type => SCALAR, default => 0,
									    callbacks => {
											'is between 0 and 999999999' =>
											sub { $_[0] >= 0 && $_[0] <= 999999999 }
									    }
									  },
						sunset     =>	{ type => OBJECT, optional => 1 },
						time_zone  =>	{ type => SCALAR, optional => 1 },
                      } );

    my $self = bless \%p, $class;

	$self->{rd_days} = &_to_rd(@p{ qw(year month day) });
	$self->{rd_secs} = $p{hour} * 60 * 60 + $p{minute} * 60 + $p{second};
	if($self->{nanosecond}) { $self->{rd_nanosecs} = delete $self->{nanosecond}; }

	if($self->{sunset} and $self->{time_zone}) {
		my $DT_Event_Sunrise = $self->{sunset};
		my $time_zone = $self->{time_zone};
		my $DT = DateTime->from_object(object => $self);

		my $sunset = $DT_Event_Sunrise->next($DT->clone->truncate(to => 'day'));
		$sunset->set_time_zone($time_zone);

		if($DT > $sunset) {
			$self->{after_sunset} = 1;
			@{$self}{qw/year month day/} = &_from_rd($self->{rd_days} + 1);
		}
	}

    return $self;
}

sub from_object {
    my ( $class ) = shift;
    my %p = validate( @_, {
            object => {
                type => OBJECT,
                can => 'utc_rd_values',
            },
	});

    my $object = $p{object}->clone();
    $object->set_time_zone('floating') if $object->can( 'set_time_zone' );

    my ($rd_days, $rd_secs, $rd_nanosecs) = $object->utc_rd_values();
	$rd_nanosecs ||= 0;

	my %args;
	@args{ qw( year month day ) } = &_from_rd($rd_days);

    my($h, $m, $s);
    $s = $rd_secs % 60;
    $m = int($rd_secs / 60);
    $h = int($m / 60);
    $m %= 60;
	@args{ qw(hour minute second) } = ($h, $m, $s);

	$args{nanosecond} = $rd_nanosecs || 0;

	my $new_object = $class->new(%args);

	return $new_object;
}

sub set {
    my $self = shift;
    my %p = validate( @_,
                      { year     => { type => SCALAR, optional => 1 },
                        month    => { type => SCALAR, optional => 1,
									  callbacks => {
										'is between 1 and 13' =>
										sub { $_[0] >= 1 && $_[0] <= 13 }
									  }
									},
                        day      => { type => SCALAR, optional => 1,
									  callbacks => {
										'is between 1 and 30' =>
										sub { $_[0] >= 1 && $_[0] <= 30 }
									  }
									},
						hour     => { type => SCALAR, optional => 1,
									  callbacks => {
										'is between 0 and 23' =>
										sub { $_[0] >= 0 && $_[0] <= 23 }
									  }
									},
						minute   => { type => SCALAR, optional => 1,
									  callbacks => {
										'is between 0 and 59' =>
										sub { $_[0] >= 0 && $_[0] <= 59 }
									  }
									},
						second   => { type => SCALAR, optional => 1,
									  callbacks => {
										'is between 0 and 59' =>
										sub { $_[0] >= 0 && $_[0] <= 59 }
									  }
									},
						nanosecond =>	{ type => SCALAR, optional => 1,
									      callbacks => {
											'is between 0 and 999999999' =>
											sub { $_[0] >= 0 && $_[0] <= 999999999 }
										}
									},
						sunset =>		{ type => OBJECT, optional => 1 },
						time_zone =>	{ type => SCALAR, optional => 1 },
                      } );

    $self->{$_} = $p{$_} for keys %p;

	$self->{rd_days} = &_to_rd($self->{year}, $self->{month}, $self->{day});
    $self->{rd_secs} = $self->{hour} * 60 * 60 + $self->{minute} * 60 + $self->{second};
	if($self->{nanosecond}) { $self->{rd_nanosecs} = delete $self->{nanosecond}; }

	if($self->{sunset} and $self->{time_zone}) {
		my $DT_Event_Sunrise = $self->{sunset};
		my $time_zone = $self->{time_zone};
		my $DT = DateTime->from_object(object => $self);

		my $sunset = $DT_Event_Sunrise->next($DT->clone->truncate(to => 'day'));
		$sunset->set_time_zone($time_zone);

		if($DT > $sunset) {
			$self->{after_sunset} = 1;
			@{$self}{qw/year month day/} = &_from_rd($self->{rd_days} + 1);
		}
	}

    return $self;
}

sub utc_rd_values {
	my $self = shift;
	my @res = @{$self}{ qw/rd_days rd_secs rd_nanosecs/ };
	# Protect against undef
	$res[2] ||= 0;
	return @res;
}

sub utc_rd_as_seconds {
    my $self = shift;
    my ($rd_days, $rd_secs, $rd_nanosecs) = $self->utc_rd_values;

	return $rd_days*24*60*60 + $rd_secs;
}

sub clone {
    my $self = shift;
	my $clone = {%$self};
    bless $clone, ref $self;
	return $clone;
}

sub _compare_overload {
    return $_[2] ? - $_[0]->_compare($_[1]) : $_[0]->_compare($_[1]);
}

sub _compare {
	my($a, $b) = @_;

	return undef unless defined $b;

	unless($a->can('utc_rd_values') and $b->can('utc_rd_values')) {
		die "Cannot compare a datetime to a regular scalar";
	}

    my @a = $a->utc_rd_values;
    my @b = $b->utc_rd_values;

    foreach my $i (0..2) {
		return ($a[$i] <=> $b[$i]) if($a[$i] != $b[$i]);
    }

    return 0;
}

sub _add_overload {
    my($dt, $dur, $reversed) = @_;
    ($dur,$dt) = ($dt,$dur) if $reversed;
	return $dt->clone->add_duration($dur);
}

sub _subtract_overload {
    my($dt, $dur, $reversed) = @_;
    ($dur,$dt) = ($dt,$dur) if $reversed;
	return $dt->clone->subtract_duration($dur);
}

sub add_duration {
    my ($self, $dur) = @_;
	my %deltas = $dur->deltas;

	if($deltas{days})    { $self->{rd_days} += $deltas{days}; }
    if($deltas{hours})   { $self->{rd_secs} += $deltas{hours} * 60 * 60; }
    if($deltas{minutes}) { $self->{rd_secs} += $deltas{minutes} * 60; }
    if($deltas{seconds}) { $self->{rd_secs} += $deltas{seconds}; }
    if($deltas{nanoseconds}) { $self->{rd_nanosecs} += $deltas{nanoseconds}; }

	while($self->{rd_secs} < 0) {
		$self->{rd_days}--;
		$self->{rd_secs} += (24 * 60 * 60);
	}

    return $self->_normalize;
}

sub subtract_duration {
	my ($self, $dur) = @_;
	return $self->add_duration($dur->inverse);
}

sub _normalize {
	my($self) = shift;

	my($h, $m, $s, $d);
	$s = $self->{rd_secs} % 60;
	$m = int($self->{rd_secs} / 60);
	$h = int($m / 60);
	$m %= 60;
	$d = int($h / 24);
	$h %= 24;

	$self->{rd_days} += $d;
	$self->{rd_secs} = ($h * 60 * 60) + ($m * 60) + $s;

	@{$self}{qw/year month day/} = &_from_rd($self->{rd_days});
	@{$self}{qw/hour minute second/} = ($h, $m, $s);

	return $self;
}

sub now {
    my $class = shift;
    $class = ref($class) || $class;

    my $dt = DateTime->now;
    my $ht = $class->from_object(object => $dt);
    return($ht);
}

sub today {
    my $class = shift;
    $class = ref($class) || $class;

    my $dt = DateTime->today;
    my $ht = $class->from_object(object => $dt);
    return($ht);
}

sub _from_rd {
    my $rd = shift;

    my ($year, $month, $day);
    $year = int(($rd - HEBREW_EPOCH) / 366);
    while ($rd >= &_to_rd($year + 1, 7, 1)) { $year++; }
    if ($rd < &_to_rd($year, 1, 1)) { $month = 7; }
    else { $month = 1; }
    while ($rd > &_to_rd($year, $month, (&_LastDayOfMonth($year, $month)))) { $month++; }
    $day = $rd - &_to_rd($year, $month, 1) + 1;

	return $year, $month, $day;
}

sub _to_rd {
    my ($year, $month, $day) = @_;
	if(scalar @_) {
		($year, $month, $day) = @_;
	}

    my($m, $DayInYear);

    $DayInYear = $day;
    if ($month < 7) {
		$m = 7;
		while ($m <= (&_LastMonthOfYear($year))) {
			$DayInYear += &_LastDayOfMonth($year, $m++);
		}
		$m = 1;
		while ($m < $month) {
			$DayInYear += &_LastDayOfMonth($year, $m);
			$m++;
		}
    }
    else {
		$m = 7;
		while ($m < $month) {
			$DayInYear += &_LastDayOfMonth($year, $m);
			$m++;
		}
    }

    return($DayInYear + (&_CalendarElapsedDays($year) + HEBREW_EPOCH));
}

sub _leap_year {
    my $year = shift;

	if ((((7 * $year) + 1) % 19) < 7) { return 1; }
    else { return 0; }
}

sub _LastMonthOfYear {
    my $year = shift;

    if (&_leap_year($year)) { return 13; }
    else { return 12; }
}

sub _CalendarElapsedDays {
	my $year = shift;

    my($MonthsElapsed, $PartsElapsed, $HoursElapsed, $ConjunctionDay, $ConjunctionParts);
    my($AlternativeDay);

    $MonthsElapsed = (235 * int(($year - 1) / 19)) + (12 * (($year - 1) % 19)) + int((7 * (($year - 1) % 19) + 1) / 19);
    $PartsElapsed = 204 + 793 * ($MonthsElapsed % 1080);
    $HoursElapsed = 5 + 12 * $MonthsElapsed + 793 * int($MonthsElapsed / 1080) + int($PartsElapsed / 1080);
    $ConjunctionDay = 1 + 29 * $MonthsElapsed + int($HoursElapsed / 24);
    $ConjunctionParts = 1080 * ($HoursElapsed % 24) + $PartsElapsed % 1080;

    $AlternativeDay = 0;
    if (($ConjunctionParts >= 19440) ||
	((($ConjunctionDay % 7) == 2)
	 && ($ConjunctionParts >= 9924)
	 && (!&_leap_year($year))) ||
	((($ConjunctionDay % 7) == 1)
	 && ($ConjunctionParts >= 16789)
	 && (&_leap_year($year - 1))))
    { $AlternativeDay = $ConjunctionDay + 1; }
    else    { $AlternativeDay = $ConjunctionDay; }

    if ((($AlternativeDay % 7) == 0) ||
	(($AlternativeDay % 7) == 3) ||
	(($AlternativeDay % 7) == 5))
    { return (1 + $AlternativeDay); }
    else    { return $AlternativeDay; }
}

sub _DaysInYear {
	my $year = shift;
    return ((&_CalendarElapsedDays($year + 1)) - (&_CalendarElapsedDays($year)));
}

sub _LongCheshvan {
	my $year = shift;
    if ((&_DaysInYear($year) % 10) == 5) { return 1; }
    else { return 0; }
}

sub _ShortKislev {
	my $year = shift;
    if ((&_DaysInYear($year) % 10) == 3) { return 1; }
    else { return 0; }
}

sub _LastDayOfMonth {
    my ($year, $month) = @_;

    if (($month == 2) ||
	($month == 4) ||
	($month == 6) ||
	(($month == 8) && (! &_LongCheshvan($year))) ||
	(($month == 9) && &_ShortKislev($year)) ||
	($month == 10) ||
	(($month == 12) && (!&_leap_year($year))) ||
	($month == 13)) { return 29; }
    else { return 30; }
}

sub month_name {
	my $self = shift;
	my $month = $self->month;
	if(@_) { $month = shift; }

    return (qw/Nissan Iyar Sivan Tamuz Av Elul Tishrei Cheshvan Kislev Tevet Shevat AdarI AdarII/)[$month-1];
}

sub day_name {
	my $self = shift;
	my $day = $self->day_of_week;
	if(@_) { $day = shift; }

    return (qw/Sunday Monday Tuesday Wednesday Thursday Friday Shabbos/)[$day - 1];
}

use DateTime::TimeZone::Floating qw( );
sub time_zone { DateTime::TimeZone::Floating->new() }


sub year    { $_[0]->{year} }

sub month   { $_[0]->{month} }
*mon = \&month;

sub month_0   { $_[0]->month - 1 }
*mon_0 = \&month_0;

sub day_of_month { $_[0]->{day} }
*day  = \&day_of_month;
*mday = \&day_of_month;

sub day_of_month_0 { $_[0]->day - 1 }
*day_0  = \&day_of_month_0;
*mday_0 = \&day_of_month_0;

sub day_of_week {
	my $rd_days = $_[0]->{rd_days};
	if($_[0]->{after_sunset}) { $rd_days++; }
	return $rd_days % 7 + 1;
}
*wday = \&day_of_week;
*dow  = \&day_of_week;

sub day_of_week_0 {
	my $rd_days = $_[0]->{rd_days};
	if($_[0]->{after_sunset}) { $rd_days++; }
	return $rd_days % 7;
}
*wday_0 = \&day_of_week_0;
*dow_0  = \&day_of_week_0;

sub hour    { $_[0]->{hour} }
*hr = \&hour;

sub minute    { $_[0]->{minute} }
*min = \&minute;

sub second    { $_[0]->{second} }
*sec = \&second;

sub day_of_year {
	my $self = shift;
    my ($year, $month, $day) = @{$self}{qw/year month day/};

	my $m = 1;
	while ($m < $month) {
		$day += &_LastDayOfMonth($year, $m);
		$m++;
	}
	return $day;
}
*doy = \&day_of_year;

sub week_number {
    my $self = shift;

	my $day_of_year = $self->day_of_year;
	my $start_of_year = &_to_rd($self->year, 1, 1);
	my $first_week_started_on = $start_of_year % 7 + 1;

	return (($day_of_year + (7 - $first_week_started_on)) / 7) + 1;
}

sub day_of_year_0 { $_[0]->day_of_year - 1; }
*doy_0 = \&day_of_year_0;

sub hms {
    my ($self, $sep) = @_;
    $sep = ':' unless defined $sep;

    return sprintf( "%02d%s%02d%s%02d",
                    $self->hour, $sep,
                    $self->minute, $sep,
                    $self->second );
}
*time = \&hms;

sub hm {
    my ($self, $sep) = @_;
    $sep = ':' unless defined $sep;

    return sprintf( "%02d%s%02d",
                    $self->hour, $sep,
                    $self->minute );
}

sub ymd {
    my ($self, $sep) = @_;
    $sep = '-' unless defined $sep;

    return sprintf( "%04d%s%02d%s%02d",
                    $self->year, $sep,
                    $self->month, $sep,
                    $self->day );
}
*date = \&ymd;

sub mdy {
    my ($self, $sep) = @_;
    $sep = '-' unless defined $sep;

    return sprintf( "%02d%s%02d%s%04d",
                    $self->month, $sep,
                    $self->day, $sep,
                    $self->year );
}

sub dmy {
    my ($self, $sep) = @_;
    $sep = '-' unless defined $sep;

    return sprintf( "%02d%s%02d%s%04d",
                    $self->day, $sep,
                    $self->month, $sep,
                    $self->year );
}

sub datetime {
	my $self = shift;
	return ($self->ymd('-') . "T" . $self->hms);
}

my %formats = (
      'A' => sub { $_[0]->day_name },
      'a' => sub { my $a = $_[0]->day_of_week_0; (qw/Sun Mon Tue Wed Thu Fri Shabbat/)[$a] },
      'B' => sub { $_[0]->month_name },
      'd' => sub { sprintf( '%02d', $_[0]->day) },
      'D' => sub { $_[0]->strftime( '%m/%d/%Y') },
      'e' => sub { sprintf( '%2d', $_[0]->day) },
      'F' => sub { $_[0]->ymd('-') },
      'j' => sub { sprintf('%03d', $_[0]->day_of_year) },
      'H' => sub { sprintf('%02d', $_[0]->hour) },
	  'I' => sub { ($_[0]->hour == 12) ? '12' : sprintf('%02d', ($_[0]->hour % 12)) },
      'k' => sub { sprintf('%2d', $_[0]->hour) },
	  'l' => sub { ($_[0]->hour == 12) ? '12' : sprintf('%2d', ($_[0]->hour % 12)) },
      'M' => sub { sprintf('%02d', $_[0]->minute) },
      'm' => sub { sprintf('%02d', $_[0]->month) },
      'n' => sub { "\n" },
	  'P' => sub { ($_[0]->hour >= 12) ? "PM" : "AM" },
	  'p' => sub { ($_[0]->hour >= 12) ? "pm" : "am" },
      'r' => sub { $_[0]->strftime( '%I:%M:%S %p') },
      'R' => sub { $_[0]->strftime( '%H:%M') },
      'S' => sub { sprintf('%02d', $_[0]->second) },
      'T' => sub { $_[0]->strftime( '%H:%M:%S') },
      't' => sub { "\t" },
	  'u' => sub { my $u = $_[0]->day_of_week_0; $u == 0 ? 7 : $u },
	  'U' => sub { my $w = $_[0]->week_number; defined $w ? sprintf('%02d', $w) : '  ' },
	  'w' => sub { $_[0]->day_of_week_0 },
	  'W' => sub { sprintf('%02d', $_[0]->week_number) },
      'y' => sub { sprintf('%02d', substr($_[0]->year, -2)) },
      'Y' => sub { return $_[0]->year },
      '%' => sub { '%' },
    );
$formats{W} = $formats{V} = $formats{U};

sub strftime {
    my ($self, @r) = @_;

    foreach (@r) {
        s/%([%*A-Za-z])/ $formats{$1} ? $formats{$1}->($self) : $1 /ge;
        return $_ unless wantarray;
    }
    return @r;
}



1;
__END__