Prepare for git repository
[spider.git] / perl / Julian.pm
index 17a020ec69dc96b1a5026ec094e7ce1390b7f2e5..78dd8d29d0ed29179c49fdff8e39dc88436bcb6a 100644 (file)
 # $Id$
 #
 
+use strict;
+
 package Julian;
 
-use FileHandle;
-use DXDebug;
-use Carp;
 
-use strict;
+use vars qw(@days @ldays @month);
+@days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+@ldays = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+@month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 
-my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+sub alloc($$$)
+{
+       my ($pkg, $year, $thing) = @_;
+       return bless [$year, $thing], ref($pkg)||$pkg;
+}
 
-# take a unix date and transform it into a julian day (ie (1998, 13) = 13th day of 1998)
-sub unixtoj
+sub copy
 {
-  my ($t) = @_;
-  my ($day, $mon, $year) = (gmtime($t))[3..5];
-  my $jday;
-  
-  # set the correct no of days for february
-  if ($year < 100) {
-    $year += ($year < 50) ? 2000 : 1900;
-  }
-  $days[1] = isleap($year) ? 29 : 28;
-  for (my $i = 0, $jday = 0; $i < $mon; $i++) {
-    $jday += $days[$i];
-  }
-  $jday += $day;
-  return ($year, $jday);
+       my $old = shift;
+       return $old->alloc(@$old);
 }
 
-# take a julian date and subtract a number of days from it, returning the julian date
-sub sub
+sub cmp($$)
 {
-  my ($year, $day, $amount) = @_;
-  my $diny = isleap($year) ? 366 : 365;
-  $day -= $amount;
-  while ($day <= 0) {
-    $day += $diny;
-       $year -= 1;
-       $diny = isleap($year) ? 366 : 365;
-  }
-  return ($year, $day);
+       my ($a, $b) = @_;
+       return $a->[1] - $b->[1] if ($a->[0] == $b->[0]);
+       return $a->[0] - $b->[0];
 }
 
-sub add
+sub year
 {
-  my ($year, $day, $amount) = @_;
-  my $diny = isleap($year) ? 366 : 365;
-  $day += $amount;
-  while ($day > $diny) {
-    $day -= $diny;
-       $year += 1;
-       $diny = isleap($year) ? 366 : 365;
-  }
-  return ($year, $day);
-} 
+       return $_[0]->[0];
+}
 
-sub cmp
+sub thing
 {
-  my ($y1, $d1, $y2, $d2) = @_;
-  return $d1 - $d2 if ($y1 == $y2);
-  return $y1 - $y2;
+       return $_[0]->[1];
 }
 
+package Julian::Day;
+
+use vars qw(@ISA);
+@ISA = qw(Julian);
+
 # is it a leap year?
-sub isleap
+sub _isleap
 {
-  my $year = shift;
-  return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0; 
+       my $year = shift;
+       return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0; 
 }
 
-# this section deals with files that are julian date based
+sub new($$)
+{
+       my $pkg = shift;
+       my $t = shift;
+       my ($year, $day) = (gmtime($t))[5,7];
+       $year += 1900;
+       return $pkg->SUPER::alloc($year, $day+1);
+}
 
-# open a data file with prefix $fn/$year/$day.dat and return an object to it
-sub open
+# take a julian date and subtract a number of days from it, returning the julian date
+sub sub($$)
 {
-  my ($pkg, $fn, $year, $day, $mode) = @_;
-
-  # if we are writing, check that the directory exists
-  if (defined $mode) {
-    my $dir = "$fn/$year";
-       mkdir($dir, 0777) if ! -e $dir;
-  }
-  my $self = {};
-  $self->{fn} = sprintf "$fn/$year/%03d.dat", $day;
-  $mode = 'r' if !$mode;
-  my $fh = new FileHandle $self->{fn}, $mode;
-  return undef if !$fh;
-  $fh->autoflush(1) if $mode ne 'r';         # make it autoflushing if writable
-  $self->{fh} = $fh;
-  $self->{year} = $year;
-  $self->{day} = $day;
-  dbg("julian", "opening $self->{fn}\n");
-  
-  return bless $self, $pkg;
+       my ($old, $amount) = @_;
+       my $self = $old->copy;
+       my $diny = _isleap($self->[0]) ? 366 : 365;
+       $self->[1] -= $amount;
+       while ($self->[1] <= 0) {
+               $self->[0] -= 1;
+               $diny = _isleap($self->[0]) ? 366 : 365;
+               $self->[1] += $diny;
+       }
+       return $self;
 }
 
-# close the data file
-sub close
+sub add($$)
 {
-  my $self = shift;
-  undef $self->{fh};      # close the filehandle
-  delete $self->{fh};
+       my ($old, $amount) = @_;
+       my $self = $old->copy;
+       my $diny = _isleap($self->[0]) ? 366 : 365;
+       $self->[1] += $amount;
+       while ($self->[1] > $diny) {
+               $self->[1] -= $diny;
+               $self->[0] += 1;
+               $diny = _isleap($self->[0]) ? 366 : 365;
+       }
+       return $self;
+} 
+
+sub as_string
+{
+       my $self = shift;
+       my $days = $self->[1];
+       my $mon = 0;
+       for (_isleap($self->[0]) ? @Julian::ldays : @Julian::days) {
+               if ($_ < $days) {
+                       $days -= $_;
+                       $mon++;
+               } else {
+                       last;
+               }
+       }
+       return "$days-$Julian::month[$mon]-$self->[0]";
+}
+
+package Julian::Month;
+
+use vars qw(@ISA);
+@ISA = qw(Julian);
+
+sub new($$)
+{
+       my $pkg = shift;
+       my $t = shift;
+       my ($mon, $year) = (gmtime($t))[4,5];
+       $year += 1900;
+       return $pkg->SUPER::alloc($year, $mon+1);
+}
+
+# take a julian month and subtract a number of months from it, returning the julian month
+sub sub($$)
+{
+       my ($old, $amount) = @_;
+       my $self = $old->copy;
+       
+       $self->[1] -= $amount;
+       while ($self->[1] <= 0) {
+               $self->[1] += 12;
+               $self->[0] -= 1;
+       }
+       return $self;
 }
 
-sub DESTROY               # catch undefs and do what is required further do the tree
+sub add($$)
 {
-  my $self = shift;
-  dbg("julian", "closing $self->{fn}\n");
-  undef $self->{fh} if defined $self->{fh};
+       my ($old, $amount) = @_;
+       my $self = $old->copy;
+
+       $self->[1] += $amount;
+       while ($self->[1] > 12) {
+               $self->[1] -= 12;
+               $self->[0] += 1;
+       }
+       return $self;
 } 
 
+sub as_string
+{
+       my $self = shift;
+       return "$Julian::month[$self->[1]]-$self->[0]";
+}
+
+
 1;