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