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;