X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=e859808596b7c8fb3542f1a63723f4e06bc40a45;hb=6af9f2685f27610ff519df7da4ce3934f6ca1d85;hp=ff9d45aaeb57ffbafe96d22effcb6c0a697fc69c;hpb=aac4d7dbc1d3c34bf73147a679673d346894984f;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index ff9d45aa..e8598085 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,7 @@ sub alloc $self->{'read'} = shift; $self->{rrreq} = shift; $self->{delete} = shift; - $self->{deletetime} = shift; + $self->{deletetime} = shift || $self->{delete} ? 0 : ($self->{t} + $maxage); $self->{gotit} = []; # $self->{lastt} = $main::systime; $self->{lines} = []; @@ -155,6 +155,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} && $_->{deletetime} < $main::systime} @msg; + for (@del) { + $_->del_msg; + } + $last_clean = $main::systime; return; } @@ -435,7 +444,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 +521,13 @@ 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'; + my $delt = $ref->{deletetime} || $ref->{t} + $maxage; print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{'read'}^$rr^$del^$delt\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 +539,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 @@ -589,7 +591,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}++; @@ -1086,6 +1088,24 @@ sub do_send_stuff delete $self->{loc}; $self->func(undef); $self->state('prompt'); + } elsif ($line =~ m|^/+\w+|) { + # this is a command that you want display for your own reference + # or if it has TWO slashes is a command + $line =~ s|^/||; + my $store = $line =~ s|^/+||; + my @in = $self->run_cmd($line); + push @out, @in; + if ($store) { + foreach my $l (@in) { + if (my @ans = BadWords::check($l)) { + $self->{badcount} += @ans; + Log('msg', $self->call . " used badwords: @ans to @{$loc->{to}} subject: '$loc->{subject}' in msg") unless $loc->{reject}; + Log('msg', "line: $l"); + $loc->{reject}++; + } + push @{$loc->{lines}}, length($l) > 0 ? $l : " "; + } + } } else { if (my @ans = BadWords::check($line)) { $self->{badcount} += @ans; @@ -1488,19 +1508,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;