File Coverage

blib/lib/Time/JulianDay.pm
Criterion Covered Total %
statement 72 78 92.3
branch 4 8 50.0
condition n/a
subroutine 16 17 94.1
pod 0 9 0.0
total 92 112 82.1


line stmt bran cond sub pod time code
1             package Time::JulianDay;
2              
3             require 5.000;
4              
5 4     4   579 use Carp;
  4         7  
  4         224  
6 4     4   20 use Time::Timezone;
  4         5  
  4         332  
7              
8             @ISA = qw(Exporter);
9             @EXPORT = qw(julian_day inverse_julian_day day_of_week
10             jd_secondsgm jd_secondslocal
11             jd_timegm jd_timelocal
12             gm_julian_day local_julian_day
13             );
14             @EXPORT_OK = qw($brit_jd);
15              
16 4     4   20 use strict;
  4         8  
  4         85  
17 4     4   3096 use integer;
  4         71  
  4         21  
18              
19             # constants
20 4     4   126 use vars qw($brit_jd $jd_epoch $jd_epoch_remainder $VERSION);
  4         7  
  4         350  
21              
22             $VERSION = 2011.0505;
23              
24             # calculate the julian day, given $year, $month and $day
25             sub julian_day
26             {
27 239     239 0 542 my($year, $month, $day) = @_;
28 239         293 my($tmp);
29              
30 4     4   20 use Carp;
  4         7  
  4         2114  
31             # confess() unless defined $day;
32              
33 239         767 $tmp = $day - 32075
34             + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 )/4
35             + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12
36             - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4
37             ;
38              
39 239         604 return($tmp);
40              
41             }
42              
43             sub gm_julian_day
44             {
45 3     3 0 6 my($secs) = @_;
46 3         4 my($sec, $min, $hour, $mon, $year, $day, $month);
47 3         13 ($sec, $min, $hour, $day, $mon, $year) = gmtime($secs);
48 3         4 $month = $mon + 1;
49 3         6 $year += 1900;
50 3         9 return julian_day($year, $month, $day)
51             }
52              
53             sub local_julian_day
54             {
55 18     18 0 29 my($secs) = @_;
56 18         23 my($sec, $min, $hour, $mon, $year, $day, $month);
57 18         61 ($sec, $min, $hour, $day, $mon, $year) = localtime($secs);
58 18         26 $month = $mon + 1;
59 18         27 $year += 1900;
60 18         40 return julian_day($year, $month, $day)
61             }
62              
63             sub day_of_week
64             {
65 1     1 0 9 my ($jd) = @_;
66 1         3 return (($jd + 1) % 7); # calculate weekday (0=Sun,6=Sat)
67             }
68              
69              
70             # The following defines the first day that the Gregorian calendar was used
71             # in the British Empire (Sep 14, 1752). The previous day was Sep 2, 1752
72             # by the Julian Calendar. The year began at March 25th before this date.
73              
74             $brit_jd = 2361222;
75              
76             # Usage: ($year,$month,$day) = &inverse_julian_day($julian_day)
77             sub inverse_julian_day
78             {
79 1     1 0 6 my($jd) = @_;
80 1         3 my($jdate_tmp);
81 1         2 my($m,$d,$y);
82              
83 1 50       4 carp("warning: julian date $jd pre-dates British use of Gregorian calendar\n")
84             if ($jd < $brit_jd);
85              
86 1         1 $jdate_tmp = $jd - 1721119;
87 1         2 $y = (4 * $jdate_tmp - 1)/146097;
88 1         2 $jdate_tmp = 4 * $jdate_tmp - 1 - 146097 * $y;
89 1         2 $d = $jdate_tmp/4;
90 1         2 $jdate_tmp = (4 * $d + 3)/1461;
91 1         3 $d = 4 * $d + 3 - 1461 * $jdate_tmp;
92 1         2 $d = ($d + 4)/4;
93 1         2 $m = (5 * $d - 3)/153;
94 1         3 $d = 5 * $d - 3 - 153 * $m;
95 1         1 $d = ($d + 5) / 5;
96 1         2 $y = 100 * $y + $jdate_tmp;
97 1 50       3 if($m < 10) {
98 1         2 $m += 3;
99             } else {
100 0         0 $m -= 9;
101 0         0 ++$y;
102             }
103 1         4 return ($y, $m, $d);
104             }
105              
106             {
107             my($sec, $min, $hour, $day, $mon, $year) = gmtime(0);
108             $year += 1900;
109             if ($year == 1970 && $mon == 0 && $day == 1) {
110             # standard unix time format
111             $jd_epoch = 2440588;
112             } else {
113             $jd_epoch = julian_day($year, $mon+1, $day);
114             }
115             $jd_epoch_remainder = $hour*3600 + $min*60 + $sec;
116             }
117              
118             sub jd_secondsgm
119 0         0 {
120 236     236 0 489 my($jd, $hr, $min, $sec) = @_;
121              
122 236         543 my($r) = (($jd - $jd_epoch) * 86400
123             + $hr * 3600 + $min * 60
124             - $jd_epoch_remainder);
125              
126 4     4   24 no integer;
  4         7  
  4         15  
127 236         725 return ($r + $sec);
128 4     4   120 use integer;
  4         8  
  4         12  
129             }
130              
131             sub jd_secondslocal
132             {
133 0     0 0 0 my($jd, $hr, $min, $sec) = @_;
134 0         0 my $jds = jd_secondsgm($jd, $hr, $min, $sec);
135 0         0 return $jds - tz_local_offset($jds);
136             }
137              
138             # this uses a 0-11 month to correctly reverse localtime()
139             sub jd_timelocal
140             {
141 1     1 0 6 my ($sec,$min,$hours,$mday,$mon,$year) = @_;
142 1 50       4 $year += 1900 unless $year > 1000;
143 1         3 my $jd = julian_day($year, $mon+1, $mday);
144 1         3 my $jds = jd_secondsgm($jd, $hours, $min, $sec);
145 1         5 return $jds - tz_local_offset($jds);
146             }
147              
148             # this uses a 0-11 month to correctly reverse gmtime()
149             sub jd_timegm
150             {
151 1     1 0 34 my ($sec,$min,$hours,$mday,$mon,$year) = @_;
152 1 50       3 $year += 1900 unless $year > 1000;
153 1         3 my $jd = julian_day($year, $mon+1, $mday);
154 1         4 return jd_secondsgm($jd, $hours, $min, $sec);
155             }
156              
157             1;
158              
159             __END__