X-Git-Url: http://scm.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2FDXMsg.pm;h=0ef242352a28cb1e4c8532e584396600418df09b;hb=66f3d6d287eaf6ca0dbe9cc12dac023309383924;hp=65577607be6d30635f2053e417df6b98b3de7fa0;hpb=c3c5abeef9492faf2759af04df966311fab43302;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 65577607..0ef24235 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -136,7 +136,7 @@ sub process # this is periodic processing if (!$self || !$line) { - if ($main::systime > $lastq + $queueinterval) { + if ($main::systime >= $lastq + $queueinterval) { # wander down the work queue stopping any messages that have timed out for (keys %busy) { @@ -183,6 +183,7 @@ sub process my $t = cltounix($f[5], $f[6]); my $stream = next_transno($f[2]); + $f[13] = $self->call unless $f[13] && $f[13] gt ' '; my $ref = DXMsg->alloc($stream, uc $f[3], $f[4], $t, $f[7], $f[8], $f[13], '0', $f[11]); # fill in various forwarding state variables @@ -512,6 +513,11 @@ sub read_msg_header } $size = -s $fn; $line = <$file>; # first line + if ($size == 0 || !$line) { + dbg('err', "Empty $fn $!"); + Log('err', "Empty $fn $!"); + return undef; + } chomp $line; $size -= length $line; if (! $line =~ /^===/o) { @@ -616,7 +622,7 @@ sub queue_msg next if $ref->{'read'}; # if it is read, it is stuck here $clref = DXCluster->get_exact($ref->{to}); unless ($clref) { # otherwise look for a homenode - my $uref = DXUser->get($ref->{to}); + my $uref = DXUser->get_current($ref->{to}); my $hnode = $uref->homenode if $uref; $clref = DXCluster->get_exact($hnode) if $hnode; } @@ -755,10 +761,15 @@ sub init @msg = (); for (sort @dir) { - next unless /^m\d+$/o; + next unless /^m\d\d\d\d\d\d$/; $ref = read_msg_header("$msgdir/$_"); - next unless $ref; + unless ($ref) { + dbg('err', "Deleting $_"); + Log('err', "Deleting $_"); + unlink "$msgdir/$_"; + next; + } # delete any messages to 'badmsg.pl' places if (grep $ref->{to} eq $_, @badmsg) { @@ -1235,6 +1246,9 @@ sub AUTOLOAD $name =~ s/.*:://o; confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; + # this clever line of code creates a subroutine which takes over from autoload + # from OO Perl - Conway + *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ; @_ ? $self->{$name} = shift : $self->{$name} ; }