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