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