Date-Object
view release on metacpan or search on metacpan
lib/Date/Object.pm view on Meta::CPAN
my $timelocal ;
my $time_day = 60*60*24 ;
my $time_year = $time_day * 365 ;
for my $y ($year_0..($year-1)) {
$timelocal += $time_year ;
if ( $this->is_leap_year($y) ) { $timelocal += $time_day ;}
}
for my $m (1..($mon-1)) {
my $month_days = &check($m) ;
$timelocal += $month_days * $time_day ;
}
if ($year_bisexto == 1 && $mon > 2) { $timelocal += $time_day ;}
$timelocal += $time_day * ($day-1) ;
$timelocal += 60*60 * $hour ;
$timelocal += 60 * $min ;
$timelocal += $sec ;
$timelocal += 60*60*($zone*-1) if $zone ;
return $timelocal ;
}
sub check {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
shift if $_[0] !~ /^\d+$/ ;
my ( $year , $month , $day ) ;
if ($#_ == 2) { ( $year , $month , $day ) = @_ ;}
if ($#_ == 1) { ( $month , $day ) = @_ ;}
if ($#_ == 0) { ( $month ) = @_ ;}
if ($#_ > 0) {
if ($year eq '') { $year = 1970 }
if ($month eq '') { $month = 1 }
if ($day eq '') { $day = 1 }
my @months_days = @MONTHS_DAYS ;
if ( $this->is_leap_year($year) ) { $months_days[2] = 29 ;}
if ($day <= $months_days[$month]) { return 1 ;}
else { return ;}
}
elsif ($#_ == 0) {
if ($month eq '') { return ; }
return $MONTHS_DAYS[$month] ;
}
return undef ;
}
# The Egyptians called it 365 and left it at that. But their calendar got out of step with the seasons, so that
# after around 750 years of this they were celebrating The Fourth of July in the middle of the winter.
#
# The Romans wised up and added the leap day every four years to get the 365.25 day Julian year. Much better,
# but notice that this time the year is longer than it ought to be. The small difference between this and the
# true length of the year caused the seasons to creep through the calendar once again, only slower and in the
# other direction. After about 23000 years of this, July Fourth would once again fall in mid-winter.
#
# Fortunately things never reached that sad state. By 1582 the calendar was about ten days out of whack, so
# Pope Gregory XIII included the correction that's still in use today.
#
# "If the year is divisible by 100, it's not a leap year UNLESS it is also divisible by 400."
#
# More recently, proposals for fixes have gotten even better than that. One suggested change is to add on "if
# the year is also divisible by 4000, it's not a leap year."
sub is_leap_year {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
my $year = shift(@_) ;
$year = $this->{year} if $year eq '' ;
if ($year == 0) { return 1 ;}
elsif (($year % 4000) == 0) { return 0 ;}
elsif (($year % 400) == 0) { return 1 ;}
elsif (($year % 100) == 0) { return 0 ;}
elsif (($year % 4) == 0) { return 1 ;}
return 0 ;
}
sub secs_from {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
my $time_0 = $this->time ;
my $time_1 = Date::Object->new(@_)->time ;
my $delay = $time_0 - $time_1 ;
return $delay ;
}
sub min_from {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
my $delay = $this->secs_from(@_) ;
my $min = int($delay / (60)) ;
return $min ;
}
sub hours_from {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
my $delay = $this->secs_from(@_) ;
my $hours = int($delay / (60*60)) ;
return $hours ;
}
sub days_from {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
my $delay = $this->secs_from(@_) ;
my $days = int($delay / (60*60*24)) ;
return $days ;
}
lib/Date/Object.pm view on Meta::CPAN
my $date = "$this->{hour}:$this->{min}:$this->{sec}" ;
return $date ;
}
sub hms { my $this = ref($_[0]) ? shift : undef ;my $CLASS = ref($this) || __PACKAGE__ ; $this->hour }
sub ymd {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
my $date = "$this->{year}-$this->{month}-$this->{day}" ;
return $date ;
}
sub mdy {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
my $date = "$this->{month}-$this->{day}-$this->{year}" ;
return $date ;
}
sub dmy {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
my $date = "$this->{day}-$this->{month}-$this->{year}" ;
return $date ;
}
sub STORABLE_freeze {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
my $cloning = shift(@_) ;
return $this->serial ;
}
sub STORABLE_thaw {
my $this = ref($_[0]) ? shift : undef ;
my $CLASS = ref($this) || __PACKAGE__ ;
my $cloning = shift(@_) ;
my $serial = shift(@_) ;
$this->set_serial($serial) ;
return ;
}
}
1;
__END__
=head1 NAME
Date::Object - Handles dates/calendars/timezones and it's representation/convertions using a single Date::Object.
=head1 DESCRIPTION
Date::Object is an alternative to the L<DateTime> modules, with the main pourpose
to handle dates using a single object or make multiple I<Date::Object>s work together
to calculate and handle dates.
Other main poupose of I<Date::Object> is to find a simple way to store dates
in a persistent enverioment (any database) using a simple INTEGER field.
The use of a INTEGER field for that make possible searches in the DB by ranges,
what is impossible with normal storages of dates, specially if they are saved as STRING,
generally in the comon format of "YYYY-MM-DD". Also an INTEGER field have all the informations
of a date, including I<year, month, day, hour, minute, second and timezone>. Other good
thing is that any DB supports INTEGER fields, what doesn't make our Perl code dependent
of the SQL nuances of each different way to handle dates of each DB.
See the method I<serial()> for DB usage.
=head1 USAGE
use Date::Object ;
...
my $date = new Date::Object( time() ) ;
my $date2 = new Date::Object( $date ) ;
...
my $date = new Date::Object( 2004 , 2 , 29 , 12 , 30 , 10 ) ;
print $date->date ; ## 2004-02-29 12:30:10
$date->set_local ;
...
$date->set_zone(-3) ;
print $date->date ; ## 2004-02-29 09:30:10
...
print $date->year ;
print $date->month ;
print $date->day ;
...
print "$date->{year}\n" ;
print "$date->{month}\n" ;
print "$date->{hour}\n" ;
...
print $date->hour ; ## hh:mm:ss
...
print $date->ymd ; ## yyyy-mm-dd
print $date->mdy ; ## mm-dd-yyyy
( run in 1.183 second using v1.01-cache-2.11-cpan-39bf76dae61 )