X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXLog.pm;h=287b766e8bdf95ad72614e49b6d997939eebb8ff;hb=refs%2Fheads%2Fnewdisc;hp=17559b36fe62577d2b53cef0c8f9f810d225c5ba;hpb=9da1742219a27b1c02fd57794412088e4d7b3d1d;p=spider.git diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 17559b36..287b766e 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -20,24 +20,25 @@ # # Copyright (c) - 1998 Dirk Koopman G1TLH # -# $Id$ +# # package DXLog; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(Log Logclose); +@EXPORT = qw(Log LogDbg Logclose); use IO::File; use DXVars; -# use DXDebug (); use DXUtil; use Julian; + use Carp; use strict; -use vars qw($log); + +use vars qw($log %logs); $log = new('log', 'dat', 'm'); @@ -47,113 +48,133 @@ $log = new('log', 'dat', 'm'); sub new { my ($prefix, $suffix, $sort) = @_; - my $ref = {}; - $ref->{prefix} = "$main::data/$prefix"; + my $ref = bless {}, __PACKAGE__; + localdata_mv($prefix); + $ref->{prefix} = "$main::local_data/$prefix"; $ref->{suffix} = $suffix if $suffix; - $ref->{'sort'} = $sort; - + $ref->{sort} = $sort; + # make sure the directory exists mkdir($ref->{prefix}, 0777) unless -e $ref->{prefix}; - return bless $ref; + $logs{$ref} = $ref; + + return $ref; +} + +sub _genfn +{ + my ($self, $jdate) = @_; + my $year = $jdate->year; + my $thing = $jdate->thing; + + my $fn = sprintf "$self->{prefix}/$year/%02d", $thing if $jdate->isa('Julian::Month'); + $fn = sprintf "$self->{prefix}/$year/%03d", $thing if $jdate->isa('Julian::Day'); + $fn .= ".$self->{suffix}" if $self->{suffix}; + return $fn; } # open the appropriate data file sub open { - my ($self, $year, $thing, $mode) = @_; + my ($self, $jdate, $mode) = @_; # if we are writing, check that the directory exists if (defined $mode) { + my $year = $jdate->year; my $dir = "$self->{prefix}/$year"; mkdir($dir, 0777) if ! -e $dir; } - - $self->{fn} = sprintf "$self->{prefix}/$year/%02d", $thing if $self->{'sort'} eq 'm'; - $self->{fn} = sprintf "$self->{prefix}/$year/%03d", $thing if $self->{'sort'} eq 'd'; - $self->{fn} .= ".$self->{suffix}" if $self->{suffix}; + + $self->{fn} = $self->_genfn($jdate); $mode = 'r' if !$mode; $self->{mode} = $mode; + $self->{jdate} = $jdate; my $fh = new IO::File $self->{fn}, $mode, 0666; return undef if !$fh; - $fh->autoflush(1) if $mode ne 'r'; # make it autoflushing if writable + $fh->autoflush(0); # autofluahing off $self->{fh} = $fh; - $self->{year} = $year; - $self->{thing} = $thing; - -# DXDebug::dbg("dxlog", "opening $self->{fn}\n"); +# print "opening $self->{fn}\n"; return $self->{fh}; } +sub delete($$) +{ + my ($self, $jdate) = @_; + my $fn = $self->_genfn($jdate); + unlink $fn; +} + +sub mtime($$) +{ + my ($self, $jdate) = @_; + + my $fn = $self->_genfn($jdate); + return (stat $fn)[9]; +} + # open the previous log file in sequence -sub openprev +sub openprev($$) { my $self = shift; - if ($self->{'sort'} eq 'm') { - ($self->{year}, $self->{thing}) = Julian::subm($self->{year}, $self->{thing}, 1); - } elsif ($self->{'sort'} eq 'd') { - ($self->{year}, $self->{thing}) = Julian::sub($self->{year}, $self->{thing}, 1); - } - return $self->open($self->{year}, $self->{thing}, @_); + my $jdate = $self->{jdate}->sub(1); + return $self->open($jdate, @_); } # open the next log file in sequence -sub opennext +sub opennext($$) { my $self = shift; - if ($self->{'sort'} eq 'm') { - ($self->{year}, $self->{thing}) = Julian::addm($self->{year}, $self->{thing}, 1); - } elsif ($self->{'sort'} eq 'd') { - ($self->{year}, $self->{thing}) = Julian::add($self->{year}, $self->{thing}, 1); - } - return $self->open($self->{year}, $self->{thing}, @_); + my $jdate = $self->{jdate}->add(1); + return $self->open($jdate, @_); } # convert a date into the correct format from a unix date depending on its sort -sub unixtoj +sub unixtoj($$) { my $self = shift; if ($self->{'sort'} eq 'm') { - return Julian::unixtojm(shift); + return Julian::Month->new(shift); } elsif ($self->{'sort'} eq 'd') { - return Julian::unixtoj(shift); + return Julian::Day->new(shift); } confess "shouldn't get here"; } # write (actually append) to a file, opening new files as required -sub write +sub write($$$) { - my ($self, $year, $thing, $line) = @_; + my ($self, $jdate, $line) = @_; + return unless $self && $jdate; if (!$self->{fh} || $self->{mode} ne ">>" || - $year != $self->{year} || - $thing != $self->{thing}) { - $self->open($year, $thing, ">>") or confess "can't open $self->{fn} $!"; + $jdate->year != $self->{jdate}->year || + $jdate->thing != $self->{jdate}->thing) { + $self->open($jdate, ">>") or confess "can't open $self->{fn} $!"; } return $self->{fh}->print("$line\n"); } # write (actually append) using the current date to a file, opening new files as required -sub writenow +sub writenow($$) { my ($self, $line) = @_; my $t = time; - my @date = $self->unixtoj($t); - return $self->write(@date, $line); + my $date = $self->unixtoj($t); + return $self->write($date, $line); } # write (actually append) using a unix time to a file, opening new files as required -sub writeunix +sub writeunix($$$) { my ($self, $t, $line) = @_; - my @date = $self->unixtoj($t); - return $self->write(@date, $line); + my $date = $self->unixtoj($t); + return $self->write($date, $line); } # close the log file handle @@ -167,10 +188,18 @@ sub close sub DESTROY { my $self = shift; + delete $logs{$self}; undef $self->{fh}; # close the filehandle delete $self->{fh} if $self->{fh}; } +sub flushall +{ + foreach my $l (values %logs) { + $l->{fh}->flush if exists $l->{fh}; + } +} + # log something in the system log # this routine is exported to any module that declares DXLog # it takes all its args and joins them together with the unixtime writes them out as one line @@ -181,6 +210,13 @@ sub Log $log->writeunix($t, join('^', $t, @_) ); } +sub LogDbg +{ + my $cat = shift; + DXDebug::dbg($_) for @_; + Log($cat, @_); +} + sub Logclose { $log->close();