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