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) = @_;
  23   my ($day, $mon, $year) = (gmtime($t))[3..5];
  24   my $jday;
  25
  26   # set the correct no of days for february
  27   if ($year < 100) {
  28     $year += ($year < 50) ? 2000 : 1900;
  29   }
  30   $days[1] = isleap($year) ? 29 : 28;
  31   for (my $i = 0, $jday = 0; $i < $mon; $i++) {
  32     $jday += $days[$i];
  33   }
  34   $jday += $day;
  35   return ($year, $jday);
  36 }
  37
  38 # take a julian date and subtract a number of days from it, returning the julian date
  39 sub sub
  40 {
  41   my ($year, $day, $amount) = @_;
  42   my $diny = isleap($year) ? 366 : 365;
  43   $day -= $amount;
  44   while ($day <= 0) {
  45     $day += $diny;
  46         $year -= 1;
  47         $diny = isleap($year) ? 366 : 365;
  48   }
  49   return ($year, $day);
  50 }
  51
  52 sub add
  53 {
  54   my ($year, $day, $amount) = @_;
  55   my $diny = isleap($year) ? 366 : 365;
  56   $day += $amount;
  57   while ($day > $diny) {
  58     $day -= $diny;
  59         $year += 1;
  60         $diny = isleap($year) ? 366 : 365;
  61   }
  62   return ($year, $day);
  63 }
  64
  65 sub cmp
  66 {
  67   my ($y1, $d1, $y2, $d2) = @_;
  68   return $d1 - $d2 if ($y1 == $y2);
  69   return $y1 - $y2;
  70 }
  71
  72 # is it a leap year?
  73 sub isleap
  74 {
  75   my $year = shift;
  76   return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0;
  77 }
  78
  79 # this section deals with files that are julian date based
  80
  81 # open a data file with prefix $fn/$year/$day.dat and return an object to it
  82 sub open
  83 {
  84   my ($pkg, $fn, $year, $day, $mode) = @_;
  85
  86   # if we are writing, check that the directory exists
  87   if (defined $mode) {
  88     my $dir = "$fn/$year";
  89         mkdir($dir, 0777) if ! -e $dir;
  90   }
  91   my $self = {};
  92   $self->{fn} = sprintf "$fn/$year/%03d.dat", $day;
  93   $mode = 'r' if !$mode;
  94   my $fh = new FileHandle $self->{fn}, $mode;
  95   return undef if !$fh;
  96   $fh->autoflush(1) if $mode ne 'r';         # make it autoflushing if writable
  97   $self->{fh} = $fh;
  98   $self->{year} = $year;
  99   $self->{day} = $day;
 100   dbg("julian", "opening $self->{fn}\n");
 101
 102   return bless $self, $pkg;
 103 }
 104
 105 # close the data file
 106 sub close
 107 {
 108   my $self = shift;
 109   undef $self->{fh};      # close the filehandle
 110   delete $self->{fh};
 111 }
 112
 113 sub DESTROY               # catch undefs and do what is required further do the tree
 114 {
 115   my $self = shift;
 116   dbg("julian", "closing $self->{fn}\n");
 117   undef $self->{fh} if defined $self->{fh};
 118 }
 119
 120 1;