X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2FDXMsg.pm;h=f9ede90c4c167f9445019e243dc346d7bd565cfc;hb=8f391050421dd665bbf5fdcb3279a6074d97a74e;hp=65577607be6d30635f2053e417df6b98b3de7fa0;hpb=c3c5abeef9492faf2759af04df966311fab43302;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 65577607..f9ede90c 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 @@ -211,6 +212,7 @@ sub process if ($pcno == 29) { # incoming text my $ref = $work{"$f[2]$f[3]"}; if ($ref) { + $f[4] =~ s/\%5E/^/g; push @{$ref->{lines}}, $f[4]; $ref->{count}++; if ($ref->{count} >= $ref->{linesreq}) { @@ -512,6 +514,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) { @@ -594,12 +601,12 @@ sub queue_msg my $call = shift; my $ref; my $clref; - my @nodelist = DXChannel::get_all_ak1a(); # bat down the message list looking for one that needs to go off site and whose # nearest node is not busy. dbg('msg', "queue msg ($sort)\n"); + my @nodelist = DXChannel::get_all_nodes; foreach $ref (@msg) { # firstly, is it private and unread? if so can I find the recipient # in my cluster node list offsite? @@ -616,7 +623,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 +762,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 +1247,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} ; }