]> www.dxcluster.org Git - spider.git/blob - perl/Julian.pm
alter index adding dbg statement order
[spider.git] / perl / Julian.pm
1 #
2 # various julian date calculations
3 #
4 # Copyright (c) - 1998 Dirk Koopman G1TLH
5 #
6 #
7 #
8
9 use strict;
10
11 package Julian;
12
13
14 use vars qw(@days @ldays @month);
15 @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
16 @ldays = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
17 @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
18
19 sub alloc($$$)
20 {
21         my ($pkg, $year, $thing) = @_;
22         return bless [$year, $thing], ref($pkg)||$pkg;
23 }
24
25 sub copy
26 {
27         my $old = shift;
28         return $old->alloc(@$old);
29 }
30
31 sub cmp($$)
32 {
33         my ($a, $b) = @_;
34         return $a->[1] - $b->[1] if ($a->[0] == $b->[0]);
35         return $a->[0] - $b->[0];
36 }
37
38 sub year
39 {
40         return $_[0]->[0];
41 }
42
43 sub thing
44 {
45         return $_[0]->[1];
46 }
47
48 package Julian::Day;
49
50 use vars qw(@ISA);
51 @ISA = qw(Julian);
52
53 # is it a leap year?
54 sub _isleap
55 {
56         my $year = shift;
57         return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0; 
58 }
59
60 sub new($$)
61 {
62         my $pkg = shift;
63         my $t = shift;
64         my ($year, $day) = (gmtime($t))[5,7];
65         $year += 1900;
66         return $pkg->SUPER::alloc($year, $day+1);
67 }
68
69 # take a julian date and subtract a number of days from it, returning the julian date
70 sub sub($$)
71 {
72         my ($old, $amount) = @_;
73         my $self = $old->copy;
74         my $diny = _isleap($self->[0]) ? 366 : 365;
75         $self->[1] -= $amount;
76         while ($self->[1] <= 0) {
77                 $self->[0] -= 1;
78                 $diny = _isleap($self->[0]) ? 366 : 365;
79                 $self->[1] += $diny;
80         }
81         return $self;
82 }
83
84 sub add($$)
85 {
86         my ($old, $amount) = @_;
87         my $self = $old->copy;
88         my $diny = _isleap($self->[0]) ? 366 : 365;
89         $self->[1] += $amount;
90         while ($self->[1] > $diny) {
91                 $self->[1] -= $diny;
92                 $self->[0] += 1;
93                 $diny = _isleap($self->[0]) ? 366 : 365;
94         }
95         return $self;
96
97
98 sub as_string
99 {
100         my $self = shift;
101         my $days = $self->[1];
102         my $mon = 0;
103         for (_isleap($self->[0]) ? @Julian::ldays : @Julian::days) {
104                 if ($_ < $days) {
105                         $days -= $_;
106                         $mon++;
107                 } else {
108                         last;
109                 }
110         }
111         return "$days-$Julian::month[$mon]-$self->[0]";
112 }
113
114 package Julian::Month;
115
116 use vars qw(@ISA);
117 @ISA = qw(Julian);
118
119 sub new($$)
120 {
121         my $pkg = shift;
122         my $t = shift;
123         my ($mon, $year) = (gmtime($t))[4,5];
124         $year += 1900;
125         return $pkg->SUPER::alloc($year, $mon+1);
126 }
127
128 # take a julian month and subtract a number of months from it, returning the julian month
129 sub sub($$)
130 {
131         my ($old, $amount) = @_;
132         my $self = $old->copy;
133         
134         $self->[1] -= $amount;
135         while ($self->[1] <= 0) {
136                 $self->[1] += 12;
137                 $self->[0] -= 1;
138         }
139         return $self;
140 }
141
142 sub add($$)
143 {
144         my ($old, $amount) = @_;
145         my $self = $old->copy;
146
147         $self->[1] += $amount;
148         while ($self->[1] > 12) {
149                 $self->[1] -= 12;
150                 $self->[0] += 1;
151         }
152         return $self;
153
154
155 sub as_string
156 {
157         my $self = shift;
158         return "$Julian::month[$self->[1]]-$self->[0]";
159 }
160
161
162 1;