X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FJulian.pm;h=78dd8d29d0ed29179c49fdff8e39dc88436bcb6a;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=17a020ec69dc96b1a5026ec094e7ce1390b7f2e5;hpb=57b5e464bc44ae8eee23ab94c1f499f527595dc9;p=spider.git diff --git a/perl/Julian.pm b/perl/Julian.pm index 17a020ec..78dd8d29 100644 --- a/perl/Julian.pm +++ b/perl/Julian.pm @@ -6,115 +6,157 @@ # $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;