X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=5773c7e966b463b6f43397f525a2d3ad828f1e42;hb=7b616aeabce92e3cb416a5fe6640a288adfe5410;hp=3ea3211542a9cd80e4c1956833730b67a680d5de;hpb=dbf7523a9b228dbdf1d03109afde351b8b194fab;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 3ea32115..5773c7e9 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -125,7 +125,8 @@ sub alloc $self->{'read'} = shift; $self->{rrreq} = shift; $self->{delete} = shift; - $self->{deletetime} = shift; + $self->{deletetime} = shift || ($self->{t} + $maxage); + $self->{keep} = shift; $self->{gotit} = []; # $self->{lastt} = $main::systime; $self->{lines} = []; @@ -155,6 +156,15 @@ sub process # clean the message queue clean_old() if $main::systime - $last_clean > 3600 ; + + # actual remove all the 'deleted' messages in one hit. + # this has to be delayed until here otherwise it only does one at + # a time because @msg is rewritten everytime del_msg is called. + my @del = grep {!$_->{tonode} && $_->{delete} && !$_->{keep} && $_->{deletetime} < $main::systime} @msg; + for (@del) { + $_->del_msg; + } + $last_clean = $main::systime; return; } @@ -512,8 +522,9 @@ sub store my $rr = $ref->{rrreq} ? '1' : '0'; my $priv = $ref->{private} ? '1': '0'; my $del = $ref->{delete} ? '1' : '0'; - my $delt = $ref->{deletetime} || '0'; - print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{'read'}^$rr^$del^$delt\n"; + my $delt = $ref->{deletetime} || ($ref->{t} + $maxage); + my $keep = $ref->{keep} || '0'; + print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{'read'}^$rr^$del^$delt^$keep\n"; print $fh "=== ", join('^', @{$ref->{gotit}}), "\n"; my $line; $ref->{size} = 0; @@ -530,13 +541,6 @@ sub store } } - # actual remove all the 'deleted' messages in one hit. - # this has to be delayed until here otherwise it only does one at - # a time because @msg is rewritten everytime del_msg is called. - my @del = grep {!$_->{tonode} && $_->{delete} && $_->{deletetime} < $main::systime} @msg; - for (@del) { - $_->del_msg; - } } # delete a message @@ -567,6 +571,9 @@ sub mark_delete { my $ref = shift; my $t = shift; + + return if $ref->{keep}; + $t = $main::systime + $residencetime unless defined $t; $ref->{delete}++; @@ -578,8 +585,8 @@ sub unmark_delete { my $ref = shift; my $t = shift; - delete $ref->{delete}; - delete $ref->{deletetime}; + $ref->{delete} = 0; + $ref->{deletetime} = 0; } # clean out old messages from the message queue @@ -589,7 +596,7 @@ sub clean_old # mark old messages for deletion foreach $ref (@msg) { - if (ref($ref) && !$ref->{keep} && $ref->{t} < $main::systime - $maxage) { + if (ref($ref) && !$ref->{keep} && $ref->{deletetime} < $main::systime) { # this is for IMMEDIATE destruction $ref->{delete}++; @@ -1140,7 +1147,9 @@ sub dir { my $ref = shift; my $flag = $ref->{private} && $ref->{read} ? '-' : ' '; - if ($ref->{delete}) { + if ($ref->{keep}) { + $flag = '!'; + } elsif ($ref->{delete}) { $flag = $ref->{deletetime} > $main::systime ? 'D' : 'E'; } return sprintf("%6d%s%s%5d %8.8s %8.8s %-6.6s %5.5s %-30.30s", @@ -1506,19 +1515,19 @@ sub import_one return @out; } -no strict; +#no strict; sub AUTOLOAD { - my $self = shift; + no strict; my $name = $AUTOLOAD; return if $name =~ /::DESTROY$/; - $name =~ s/.*:://o; + $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} ; + *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; + goto &$AUTOLOAD; } 1;