]> scm.dxcluster.org Git - spider.git/blob - perl/Julian.pm
added even more colouration in an attempt to make it as clear as possible
[spider.git] / perl / Julian.pm
1 #
2 # various julian date calculations
3 #
4 # Copyright (c) - 1998 Dirk Koopman G1TLH
5 #
6 # $Id$
7 #
8
9 use strict;
10
11 package Julian;
12
13
14 use vars qw($VERSION $BRANCH);
15 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
16 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
17 $main::build += $VERSION;
18 $main::branch += $BRANCH;
19
20
21 sub alloc($$$)
22 {
23         my ($pkg, $year, $thing) = @_;
24         return bless [$year, $thing], ref($pkg)||$pkg;
25 }
26
27 sub copy
28 {
29         my $old = shift;
30         return $old->alloc(@$old);
31 }
32
33 sub cmp($$)
34 {
35         my ($a, $b) = @_;
36         return $a->[1] - $b->[1] if ($a->[0] == $b->[0]);
37         return $a->[0] - $b->[0];
38 }
39
40 sub year
41 {
42         return $_[0]->[0];
43 }
44
45 sub thing
46 {
47         return $_[0]->[1];
48 }
49
50 package Julian::Day;
51
52 use vars qw(@ISA);
53 @ISA = qw(Julian);
54
55 my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
56
57 # is it a leap year?
58 sub _isleap
59 {
60         my $year = shift;
61         return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0; 
62 }
63
64 sub new($$)
65 {
66         my $pkg = shift;
67         my $t = shift;
68         my ($year, $day) = (gmtime($t))[5,7];
69         $year += 1900;
70         return $pkg->SUPER::alloc($year, $day+1);
71 }
72
73 # take a julian date and subtract a number of days from it, returning the julian date
74 sub sub($$)
75 {
76         my ($old, $amount) = @_;
77         my $self = $old->copy;
78         my $diny = _isleap($self->[0]) ? 366 : 365;
79         $self->[1] -= $amount;
80         while ($self->[1] <= 0) {
81                 $self->[1] += $diny;
82                 $self->[0] -= 1;
83                 $diny = _isleap($self->[0]) ? 366 : 365;
84         }
85         return $self;
86 }
87
88 sub add($$)
89 {
90         my ($old, $amount) = @_;
91         my $self = $old->copy;
92         my $diny = _isleap($self->[0]) ? 366 : 365;
93         $self->[1] += $amount;
94         while ($self->[1] > $diny) {
95                 $self->[1] -= $diny;
96                 $self->[0] += 1;
97                 $diny = _isleap($self->[0]) ? 366 : 365;
98         }
99         return $self;
100
101
102 package Julian::Month;
103
104 use vars qw(@ISA);
105 @ISA = qw(Julian);
106
107 sub new($$)
108 {
109         my $pkg = shift;
110         my $t = shift;
111         my ($mon, $year) = (gmtime($t))[4,5];
112         $year += 1900;
113         return $pkg->SUPER::alloc($year, $mon+1);
114 }
115
116 # take a julian month and subtract a number of months from it, returning the julian month
117 sub sub($$)
118 {
119         my ($old, $amount) = @_;
120         my $self = $old->copy;
121         
122         $self->[1] -= $amount;
123         while ($self->[1] <= 0) {
124                 $self->[1] += 12;
125                 $self->[0] -= 1;
126         }
127         return $self;
128 }
129
130 sub add($$)
131 {
132         my ($old, $amount) = @_;
133         my $self = $old->copy;
134
135         $self->[1] += $amount;
136         while ($self->[1] > 12) {
137                 $self->[1] -= 12;
138                 $self->[0] += 1;
139         }
140         return $self;
141
142
143
144 1;