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