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 sub alloc($$$)
  14 {
  15         my ($pkg, $year, $thing) = @_;
  16         return bless [$year, $thing], ref($pkg)||$pkg;
  17 }
  18
  19 sub copy
  20 {
  21         my $old = shift;
  22         return $old->alloc(@$old);
  23 }
  24
  25 sub cmp($$)
  26 {
  27         my ($a, $b) = @_;
  28         return $a->[1] - $b->[1] if ($a->[0] == $b->[0]);
  29         return $a->[0] - $b->[0];
  30 }
  31
  32 sub year
  33 {
  34         return $_[0]->[0];
  35 }
  36
  37 sub thing
  38 {
  39         return $_[0]->[1];
  40 }
  41
  42 package Julian::Day;
  43
  44 use vars qw(@ISA);
  45 @ISA = qw(Julian);
  46
  47 my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  48
  49 # is it a leap year?
  50 sub _isleap
  51 {
  52         my $year = shift;
  53         return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0;
  54 }
  55
  56 sub new($$)
  57 {
  58         my $pkg = shift;
  59         my $t = shift;
  60         my ($year, $day) = (gmtime($t))[5,7];
  61         $year += 1900;
  62         return $pkg->SUPER::alloc($year, $day+1);
  63 }
  64
  65 # take a julian date and subtract a number of days from it, returning the julian date
  66 sub sub($$)
  67 {
  68         my ($old, $amount) = @_;
  69         my $self = $old->copy;
  70         my $diny = _isleap($self->[0]) ? 366 : 365;
  71         $self->[1] -= $amount;
  72         while ($self->[1] <= 0) {
  73                 $self->[1] += $diny;
  74                 $self->[0] -= 1;
  75                 $diny = _isleap($self->[0]) ? 366 : 365;
  76         }
  77         return $self;
  78 }
  79
  80 sub add($$)
  81 {
  82         my ($old, $amount) = @_;
  83         my $self = $old->copy;
  84         my $diny = _isleap($self->[0]) ? 366 : 365;
  85         $self->[1] += $amount;
  86         while ($self->[1] > $diny) {
  87                 $self->[1] -= $diny;
  88                 $self->[0] += 1;
  89                 $diny = _isleap($self->[0]) ? 366 : 365;
  90         }
  91         return $self;
  92 }
  93
  94 package Julian::Month;
  95
  96 use vars qw(@ISA);
  97 @ISA = qw(Julian);
  98
  99 sub new($$)
 100 {
 101         my $pkg = shift;
 102         my $t = shift;
 103         my ($mon, $year) = (gmtime($t))[4,5];
 104         $year += 1900;
 105         return $pkg->SUPER::alloc($year, $mon+1);
 106 }
 107
 108 # take a julian month and subtract a number of months from it, returning the julian month
 109 sub sub($$)
 110 {
 111         my ($old, $amount) = @_;
 112         my $self = $old->copy;
 113
 114         $self->[1] -= $amount;
 115         while ($self->[1] <= 0) {
 116                 $self->[1] += 12;
 117                 $self->[0] -= 1;
 118         }
 119         return $self;
 120 }
 121
 122 sub add($$)
 123 {
 124         my ($old, $amount) = @_;
 125         my $self = $old->copy;
 126
 127         $self->[1] += $amount;
 128         while ($self->[1] > 12) {
 129                 $self->[1] -= 12;
 130                 $self->[0] += 1;
 131         }
 132         return $self;
 133 }
 134
 135
 136 1;