JulianDay.pm 5.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224
  1. package Time::JulianDay;
  2. require 5.000;
  3. use Carp;
  4. use Time::Timezone;
  5. @ISA = qw(Exporter);
  6. @EXPORT = qw(julian_day inverse_julian_day day_of_week
  7. jd_secondsgm jd_secondslocal
  8. jd_timegm jd_timelocal
  9. gm_julian_day local_julian_day
  10. );
  11. @EXPORT_OK = qw($brit_jd);
  12. use strict;
  13. use integer;
  14. # constants
  15. use vars qw($brit_jd $jd_epoch $jd_epoch_remainder $VERSION);
  16. $VERSION = 2011.0505;
  17. # calculate the julian day, given $year, $month and $day
  18. sub julian_day
  19. {
  20. my($year, $month, $day) = @_;
  21. my($tmp);
  22. use Carp;
  23. # confess() unless defined $day;
  24. $tmp = $day - 32075
  25. + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 )/4
  26. + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12
  27. - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4
  28. ;
  29. return($tmp);
  30. }
  31. sub gm_julian_day
  32. {
  33. my($secs) = @_;
  34. my($sec, $min, $hour, $mon, $year, $day, $month);
  35. ($sec, $min, $hour, $day, $mon, $year) = gmtime($secs);
  36. $month = $mon + 1;
  37. $year += 1900;
  38. return julian_day($year, $month, $day)
  39. }
  40. sub local_julian_day
  41. {
  42. my($secs) = @_;
  43. my($sec, $min, $hour, $mon, $year, $day, $month);
  44. ($sec, $min, $hour, $day, $mon, $year) = localtime($secs);
  45. $month = $mon + 1;
  46. $year += 1900;
  47. return julian_day($year, $month, $day)
  48. }
  49. sub day_of_week
  50. {
  51. my ($jd) = @_;
  52. return (($jd + 1) % 7); # calculate weekday (0=Sun,6=Sat)
  53. }
  54. # The following defines the first day that the Gregorian calendar was used
  55. # in the British Empire (Sep 14, 1752). The previous day was Sep 2, 1752
  56. # by the Julian Calendar. The year began at March 25th before this date.
  57. $brit_jd = 2361222;
  58. # Usage: ($year,$month,$day) = &inverse_julian_day($julian_day)
  59. sub inverse_julian_day
  60. {
  61. my($jd) = @_;
  62. my($jdate_tmp);
  63. my($m,$d,$y);
  64. carp("warning: julian date $jd pre-dates British use of Gregorian calendar\n")
  65. if ($jd < $brit_jd);
  66. $jdate_tmp = $jd - 1721119;
  67. $y = (4 * $jdate_tmp - 1)/146097;
  68. $jdate_tmp = 4 * $jdate_tmp - 1 - 146097 * $y;
  69. $d = $jdate_tmp/4;
  70. $jdate_tmp = (4 * $d + 3)/1461;
  71. $d = 4 * $d + 3 - 1461 * $jdate_tmp;
  72. $d = ($d + 4)/4;
  73. $m = (5 * $d - 3)/153;
  74. $d = 5 * $d - 3 - 153 * $m;
  75. $d = ($d + 5) / 5;
  76. $y = 100 * $y + $jdate_tmp;
  77. if($m < 10) {
  78. $m += 3;
  79. } else {
  80. $m -= 9;
  81. ++$y;
  82. }
  83. return ($y, $m, $d);
  84. }
  85. {
  86. my($sec, $min, $hour, $day, $mon, $year) = gmtime(0);
  87. $year += 1900;
  88. if ($year == 1970 && $mon == 0 && $day == 1) {
  89. # standard unix time format
  90. $jd_epoch = 2440588;
  91. } else {
  92. $jd_epoch = julian_day($year, $mon+1, $day);
  93. }
  94. $jd_epoch_remainder = $hour*3600 + $min*60 + $sec;
  95. }
  96. sub jd_secondsgm
  97. {
  98. my($jd, $hr, $min, $sec) = @_;
  99. my($r) = (($jd - $jd_epoch) * 86400
  100. + $hr * 3600 + $min * 60
  101. - $jd_epoch_remainder);
  102. no integer;
  103. return ($r + $sec);
  104. use integer;
  105. }
  106. sub jd_secondslocal
  107. {
  108. my($jd, $hr, $min, $sec) = @_;
  109. my $jds = jd_secondsgm($jd, $hr, $min, $sec);
  110. return $jds - tz_local_offset($jds);
  111. }
  112. # this uses a 0-11 month to correctly reverse localtime()
  113. sub jd_timelocal
  114. {
  115. my ($sec,$min,$hours,$mday,$mon,$year) = @_;
  116. $year += 1900 unless $year > 1000;
  117. my $jd = julian_day($year, $mon+1, $mday);
  118. my $jds = jd_secondsgm($jd, $hours, $min, $sec);
  119. return $jds - tz_local_offset($jds);
  120. }
  121. # this uses a 0-11 month to correctly reverse gmtime()
  122. sub jd_timegm
  123. {
  124. my ($sec,$min,$hours,$mday,$mon,$year) = @_;
  125. $year += 1900 unless $year > 1000;
  126. my $jd = julian_day($year, $mon+1, $mday);
  127. return jd_secondsgm($jd, $hours, $min, $sec);
  128. }
  129. 1;
  130. __END__
  131. =head1 NAME
  132. Time::JulianDay -- Julian calendar manipulations
  133. =head1 SYNOPSIS
  134. use Time::JulianDay
  135. $jd = julian_day($year, $month_1_to_12, $day)
  136. $jd = local_julian_day($seconds_since_1970);
  137. $jd = gm_julian_day($seconds_since_1970);
  138. ($year, $month_1_to_12, $day) = inverse_julian_day($jd)
  139. $dow = day_of_week($jd)
  140. print (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$dow];
  141. $seconds_since_jan_1_1970 = jd_secondslocal($jd, $hour, $min, $sec)
  142. $seconds_since_jan_1_1970 = jd_secondsgm($jd, $hour, $min, $sec)
  143. $seconds_since_jan_1_1970 = jd_timelocal($sec,$min,$hours,$mday,$month_0_to_11,$year)
  144. $seconds_since_jan_1_1970 = jd_timegm($sec,$min,$hours,$mday,$month_0_to_11,$year)
  145. =head1 DESCRIPTION
  146. JulianDay is a package that manipulates dates as number of days since
  147. some time a long time ago. It's easy to add and subtract time
  148. using julian days...
  149. The day_of_week returned by day_of_week() is 0 for Sunday, and 6 for
  150. Saturday and everything else is in between.
  151. =head1 ERRATA
  152. Time::JulianDay is not a correct implementation. There are two
  153. problems. The first problem is that Time::JulianDay only works
  154. with integers. Julian Day can be fractional to represent time
  155. within a day. If you call inverse_julian_day() with a non-integer
  156. time, it will often give you an incorrect result.
  157. The second problem is that Julian Days start at noon rather than
  158. midnight. The julian_day() function returns results that are too
  159. large by 0.5.
  160. What to do about these problems is currently open for debate. I'm
  161. tempted to leave the current functions alone and add a second set
  162. with more accurate behavior.
  163. There is another implementation in Astro::Time that may be more accurate.
  164. =head1 GENESIS
  165. Written by David Muir Sharnoff <[email protected]> with help from
  166. previous work by
  167. Kurt Jaeger aka PI <[email protected]>
  168. based on postings from: Ian Miller <[email protected]>;
  169. Gary Puckering <garyp%[email protected]>
  170. based on Collected Algorithms of the ACM ?;
  171. and the unknown-to-me author of Time::Local.
  172. =head1 LICENSE
  173. Copyright (C) 1996-1999 David Muir Sharnoff. License hereby
  174. granted for anyone to use, modify or redistribute this module at
  175. their own risk. Please feed useful changes back to [email protected].