X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=e90a6bb170b89f9a12587fc7fcc3b730ce7dd16e;hb=218a6c34b28e608ee0dd1b2af76360826d7e31ce;hp=8db35b9df78c29c1721d549084ac77f8e5b2a458;hpb=e18c9b8b9a003bfb56416ab1d2aee0f232146d25;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 8db35b9d..e90a6bb1 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -34,7 +34,7 @@ use strict; use vars qw($VERSION $BRANCH); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); $main::build += $VERSION; $main::branch += $BRANCH; @@ -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; } @@ -435,7 +445,7 @@ sub notify { my $ref = shift; my $to = $ref->{to}; - my $uref = DXUser->get($to); + my $uref = DXUser->get_current($to); my $dxchan = DXChannel->get($to); if (((*Net::SMTP && $email_server) || $email_prog) && $uref && $uref->wantemail) { my $email = $uref->email; @@ -512,13 +522,14 @@ 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; foreach $line (@{$lines}) { - $line =~ s/[\x00-\x08\x0a-\x1f\xf0-\xff]/./g; + $line =~ s/[\x00-\x08\x0a-\x1f\x80-\x9f]/./g; $ref->{size} += (length $line) + 1; print $fh "$line\n"; } @@ -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,22 @@ 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}}; + &$AUTOLOAD($self, @_); +# *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ; +# @_ ? $self->{$name} = shift : $self->{$name} ; } 1;