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 ($pkg, $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 ($pkg, $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 ($pkg, $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 ($pkg, $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 # open a data file with prefix $fn/$year/$day.dat and return an object to it
  79 sub open
  80 {
  81   my ($name, $pkg, $fn, $year, $day, $mode) = @_;
  82
  83   # if we are writing, check that the directory exists
  84   if (defined $mode) {
  85     my $dir = "$fn/$year";
  86         mkdir($dir, 0777) if ! -e $dir;
  87   }
  88   my $self = {};
  89   $self->{fn} = sprintf "$fn/$year/%03d.dat", $day;
  90   $mode = 'r' if !$mode;
  91   my $fh = new FileHandle $self->{fn}, $mode;
  92   return undef if !$fh;
  93   $fh->autoflush(1) if $mode ne 'r';         # make it autoflushing if writable
  94   $self->{fh} = $fh;
  95   $self->{year} = $year;
  96   $self->{day} = $day;
  97   dbg("julian", "opening $self->{fn}\n");
  98
  99   return bless $self, $pkg;
 100 }
 101
 102 # close the data file
 103 sub close
 104 {
 105   my $self = shift;
 106   undef $self->{fh};      # close the filehandle
 107   delete $self->{fh};
 108 }
 109
 110 sub DESTROY               # catch undefs and do what is required further do the tree
 111 {
 112   my $self = shift;
 113   dbg("julian", "closing $self->{fn}\n");
 114   undef $self->{fh} if defined $self->{fh};
 115 }
 116
 117 1;