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