| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224 |
- package Time::JulianDay;
- require 5.000;
- use Carp;
- use Time::Timezone;
- @ISA = qw(Exporter);
- @EXPORT = qw(julian_day inverse_julian_day day_of_week
- jd_secondsgm jd_secondslocal
- jd_timegm jd_timelocal
- gm_julian_day local_julian_day
- );
- @EXPORT_OK = qw($brit_jd);
- use strict;
- use integer;
- # constants
- use vars qw($brit_jd $jd_epoch $jd_epoch_remainder $VERSION);
- $VERSION = 2011.0505;
- # calculate the julian day, given $year, $month and $day
- sub julian_day
- {
- my($year, $month, $day) = @_;
- my($tmp);
- use Carp;
- # confess() unless defined $day;
- $tmp = $day - 32075
- + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 )/4
- + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12
- - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4
- ;
- return($tmp);
- }
- sub gm_julian_day
- {
- my($secs) = @_;
- my($sec, $min, $hour, $mon, $year, $day, $month);
- ($sec, $min, $hour, $day, $mon, $year) = gmtime($secs);
- $month = $mon + 1;
- $year += 1900;
- return julian_day($year, $month, $day)
- }
- sub local_julian_day
- {
- my($secs) = @_;
- my($sec, $min, $hour, $mon, $year, $day, $month);
- ($sec, $min, $hour, $day, $mon, $year) = localtime($secs);
- $month = $mon + 1;
- $year += 1900;
- return julian_day($year, $month, $day)
- }
- sub day_of_week
- {
- my ($jd) = @_;
- return (($jd + 1) % 7); # calculate weekday (0=Sun,6=Sat)
- }
- # The following defines the first day that the Gregorian calendar was used
- # in the British Empire (Sep 14, 1752). The previous day was Sep 2, 1752
- # by the Julian Calendar. The year began at March 25th before this date.
- $brit_jd = 2361222;
- # Usage: ($year,$month,$day) = &inverse_julian_day($julian_day)
- sub inverse_julian_day
- {
- my($jd) = @_;
- my($jdate_tmp);
- my($m,$d,$y);
- carp("warning: julian date $jd pre-dates British use of Gregorian calendar\n")
- if ($jd < $brit_jd);
- $jdate_tmp = $jd - 1721119;
- $y = (4 * $jdate_tmp - 1)/146097;
- $jdate_tmp = 4 * $jdate_tmp - 1 - 146097 * $y;
- $d = $jdate_tmp/4;
- $jdate_tmp = (4 * $d + 3)/1461;
- $d = 4 * $d + 3 - 1461 * $jdate_tmp;
- $d = ($d + 4)/4;
- $m = (5 * $d - 3)/153;
- $d = 5 * $d - 3 - 153 * $m;
- $d = ($d + 5) / 5;
- $y = 100 * $y + $jdate_tmp;
- if($m < 10) {
- $m += 3;
- } else {
- $m -= 9;
- ++$y;
- }
- return ($y, $m, $d);
- }
- {
- my($sec, $min, $hour, $day, $mon, $year) = gmtime(0);
- $year += 1900;
- if ($year == 1970 && $mon == 0 && $day == 1) {
- # standard unix time format
- $jd_epoch = 2440588;
- } else {
- $jd_epoch = julian_day($year, $mon+1, $day);
- }
- $jd_epoch_remainder = $hour*3600 + $min*60 + $sec;
- }
- sub jd_secondsgm
- {
- my($jd, $hr, $min, $sec) = @_;
- my($r) = (($jd - $jd_epoch) * 86400
- + $hr * 3600 + $min * 60
- - $jd_epoch_remainder);
- no integer;
- return ($r + $sec);
- use integer;
- }
- sub jd_secondslocal
- {
- my($jd, $hr, $min, $sec) = @_;
- my $jds = jd_secondsgm($jd, $hr, $min, $sec);
- return $jds - tz_local_offset($jds);
- }
- # this uses a 0-11 month to correctly reverse localtime()
- sub jd_timelocal
- {
- my ($sec,$min,$hours,$mday,$mon,$year) = @_;
- $year += 1900 unless $year > 1000;
- my $jd = julian_day($year, $mon+1, $mday);
- my $jds = jd_secondsgm($jd, $hours, $min, $sec);
- return $jds - tz_local_offset($jds);
- }
- # this uses a 0-11 month to correctly reverse gmtime()
- sub jd_timegm
- {
- my ($sec,$min,$hours,$mday,$mon,$year) = @_;
- $year += 1900 unless $year > 1000;
- my $jd = julian_day($year, $mon+1, $mday);
- return jd_secondsgm($jd, $hours, $min, $sec);
- }
- 1;
- __END__
- =head1 NAME
- Time::JulianDay -- Julian calendar manipulations
- =head1 SYNOPSIS
- use Time::JulianDay
- $jd = julian_day($year, $month_1_to_12, $day)
- $jd = local_julian_day($seconds_since_1970);
- $jd = gm_julian_day($seconds_since_1970);
- ($year, $month_1_to_12, $day) = inverse_julian_day($jd)
- $dow = day_of_week($jd)
- print (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$dow];
- $seconds_since_jan_1_1970 = jd_secondslocal($jd, $hour, $min, $sec)
- $seconds_since_jan_1_1970 = jd_secondsgm($jd, $hour, $min, $sec)
- $seconds_since_jan_1_1970 = jd_timelocal($sec,$min,$hours,$mday,$month_0_to_11,$year)
- $seconds_since_jan_1_1970 = jd_timegm($sec,$min,$hours,$mday,$month_0_to_11,$year)
- =head1 DESCRIPTION
- JulianDay is a package that manipulates dates as number of days since
- some time a long time ago. It's easy to add and subtract time
- using julian days...
- The day_of_week returned by day_of_week() is 0 for Sunday, and 6 for
- Saturday and everything else is in between.
- =head1 ERRATA
- Time::JulianDay is not a correct implementation. There are two
- problems. The first problem is that Time::JulianDay only works
- with integers. Julian Day can be fractional to represent time
- within a day. If you call inverse_julian_day() with a non-integer
- time, it will often give you an incorrect result.
- The second problem is that Julian Days start at noon rather than
- midnight. The julian_day() function returns results that are too
- large by 0.5.
- What to do about these problems is currently open for debate. I'm
- tempted to leave the current functions alone and add a second set
- with more accurate behavior.
- There is another implementation in Astro::Time that may be more accurate.
- =head1 GENESIS
- Written by David Muir Sharnoff <[email protected]> with help from
- previous work by
- Kurt Jaeger aka PI <[email protected]>
- based on postings from: Ian Miller <[email protected]>;
- Gary Puckering <garyp%[email protected]>
- based on Collected Algorithms of the ACM ?;
- and the unknown-to-me author of Time::Local.
- =head1 LICENSE
- Copyright (C) 1996-1999 David Muir Sharnoff. License hereby
- granted for anyone to use, modify or redistribute this module at
- their own risk. Please feed useful changes back to [email protected].
|