perl/Julian.pm

   1 #
   2 # various julian date calculations
   3 #
   4 # Copyright (c) - 1998 Dirk Koopman G1TLH
   5 #
   6 # $Id$
   7 #
   8
   9 package Julian;
  10
  11 use strict;
  12
  13 my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  14
  15 # take a unix date and transform it into a julian day (ie (1998, 13) = 13th day of 1998)
  16 sub unixtoj
  17 {
  18         my $t = shift;
  19         my ($year, $day) = (gmtime($t))[5,7];
  20
  21         $year += 1900;
  22         return ($year, $day+1);
  23 }
  24
  25 # take a unix and return a julian month from it
  26 sub unixtojm
  27 {
  28         my $t = shift;
  29         my ($mon, $year) = (gmtime($t))[4..5];
  30
  31         $year += 1900;
  32         return ($year, $mon + 1);
  33 }
  34
  35 # take a julian date and subtract a number of days from it, returning the julian date
  36 sub sub
  37 {
  38         my ($year, $day, $amount) = @_;
  39         my $diny = isleap($year) ? 366 : 365;
  40         $day -= $amount;
  41         while ($day <= 0) {
  42                 $day += $diny;
  43                 $year -= 1;
  44                 $diny = isleap($year) ? 366 : 365;
  45         }
  46         return ($year, $day);
  47 }
  48
  49 sub add
  50 {
  51         my ($year, $day, $amount) = @_;
  52         my $diny = isleap($year) ? 366 : 365;
  53         $day += $amount;
  54         while ($day > $diny) {
  55                 $day -= $diny;
  56                 $year += 1;
  57                 $diny = isleap($year) ? 366 : 365;
  58         }
  59         return ($year, $day);
  60 }
  61
  62 # take a julian month and subtract a number of months from it, returning the julian month
  63 sub subm
  64 {
  65         my ($year, $mon, $amount) = @_;
  66         $mon -= $amount;
  67         while ($mon <= 0) {
  68                 $mon += 12;
  69                 $year -= 1;
  70         }
  71         return ($year, $mon);
  72 }
  73
  74 sub addm
  75 {
  76         my ($year, $mon, $amount) = @_;
  77         $mon += $amount;
  78         while ($mon > 12) {
  79                 $mon -= 12;
  80                 $year += 1;
  81         }
  82         return ($year, $mon);
  83 }
  84
  85 sub cmp
  86 {
  87         my ($y1, $d1, $y2, $d2) = @_;
  88         return $d1 - $d2 if ($y1 == $y2);
  89         return $y1 - $y2;
  90 }
  91
  92 # is it a leap year?
  93 sub isleap
  94 {
  95         my $year = shift;
  96         return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0;
  97 }
  98
  99
 100 1;