view release on metacpan or  search on metacpan

Hebrew.pm  view on Meta::CPAN

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) = @_;