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;