File: JulianDay.pm

package info (click to toggle)
psp 0.5.5-1
  • links: PTS
  • area: main
  • in suites: woody
  • size: 4,768 kB
  • ctags: 2,248
  • sloc: perl: 20,959; ansic: 4,553; sh: 2,376; makefile: 460; php: 11; pascal: 6
file content (200 lines) | stat: -rw-r--r-- 5,020 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
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 = 99.061501;

# calculate the julian day, given $year, $month and $day
sub julian_day
{
    my($year, $month, $day) = @_;
    my($tmp);
    my($secs);

    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;

__DATA__

=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 GENESIS

Written by David Muir Sharnoff <muir@idiom.com> with help from
previous work by 
Kurt Jaeger aka PI <zrzr0111@helpdesk.rus.uni-stuttgart.de>
 	based on postings from: Ian Miller <ian_m@cix.compulink.co.uk>;
Gary Puckering <garyp%cognos.uucp@uunet.uu.net>
	based on Collected Algorithms of the ACM ?;
and the unknown-to-me author of Time::Local.