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 @days @ldays @month);
  15 main::mkver($VERSION = q$Revision$) if main->can('mkver');
  16
  17 @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  18 @ldays = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  19 @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  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 # is it a leap year?
  56 sub _isleap
  57 {
  58         my $year = shift;
  59         return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0;
  60 }
  61
  62 sub new($$)
  63 {
  64         my $pkg = shift;
  65         my $t = shift;
  66         my ($year, $day) = (gmtime($t))[5,7];
  67         $year += 1900;
  68         return $pkg->SUPER::alloc($year, $day+1);
  69 }
  70
  71 # take a julian date and subtract a number of days from it, returning the julian date
  72 sub sub($$)
  73 {
  74         my ($old, $amount) = @_;
  75         my $self = $old->copy;
  76         my $diny = _isleap($self->[0]) ? 366 : 365;
  77         $self->[1] -= $amount;
  78         while ($self->[1] <= 0) {
  79                 $self->[0] -= 1;
  80                 $diny = _isleap($self->[0]) ? 366 : 365;
  81                 $self->[1] += $diny;
  82         }
  83         return $self;
  84 }
  85
  86 sub add($$)
  87 {
  88         my ($old, $amount) = @_;
  89         my $self = $old->copy;
  90         my $diny = _isleap($self->[0]) ? 366 : 365;
  91         $self->[1] += $amount;
  92         while ($self->[1] > $diny) {
  93                 $self->[1] -= $diny;
  94                 $self->[0] += 1;
  95                 $diny = _isleap($self->[0]) ? 366 : 365;
  96         }
  97         return $self;
  98 }
  99
 100 sub as_string
 101 {
 102         my $self = shift;
 103         my $days = $self->[1];
 104         my $mon = 0;
 105         for (_isleap($self->[0]) ? @Julian::ldays : @Julian::days) {
 106                 if ($_ < $days) {
 107                         $days -= $_;
 108                         $mon++;
 109                 } else {
 110                         last;
 111                 }
 112         }
 113         return "$days-$Julian::month[$mon]-$self->[0]";
 114 }
 115
 116 package Julian::Month;
 117
 118 use vars qw(@ISA);
 119 @ISA = qw(Julian);
 120
 121 sub new($$)
 122 {
 123         my $pkg = shift;
 124         my $t = shift;
 125         my ($mon, $year) = (gmtime($t))[4,5];
 126         $year += 1900;
 127         return $pkg->SUPER::alloc($year, $mon+1);
 128 }
 129
 130 # take a julian month and subtract a number of months from it, returning the julian month
 131 sub sub($$)
 132 {
 133         my ($old, $amount) = @_;
 134         my $self = $old->copy;
 135
 136         $self->[1] -= $amount;
 137         while ($self->[1] <= 0) {
 138                 $self->[1] += 12;
 139                 $self->[0] -= 1;
 140         }
 141         return $self;
 142 }
 143
 144 sub add($$)
 145 {
 146         my ($old, $amount) = @_;
 147         my $self = $old->copy;
 148
 149         $self->[1] += $amount;
 150         while ($self->[1] > 12) {
 151                 $self->[1] -= 12;
 152                 $self->[0] += 1;
 153         }
 154         return $self;
 155 }
 156
 157 sub as_string
 158 {
 159         my $self = shift;
 160         return "$Julian::month[$self->[1]]-$self->[0]";
 161 }
 162
 163
 164 1;