fix filter error handling and error counting

diff --git a/Changes b/Changes
index 65575f39b20526151405229e1cef51fb242b4c6d..9fcdc27af5fb6c5459965113db5b4e0167511e32 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+06Mar23=======================================================================
+1. Fix filter error reporting, including incrementing concurrent error count 
+   if there are actually any detected parse errors.
+2. Fix warnings on difft.
+3. Add the origin of any incoming SP if it is emailed to the recipient.
 04Mar23=======================================================================
 1. Fixed regression caused by too many command errors in (startup) script
    files. This is caused by much stricter checking of commands entered both 

diff --git a/cmd/accept/announce.pl b/cmd/accept/announce.pl
index de956ed476de5b45d8a5d6efe34bf423e150e950..9ea20a7617a6e64f43093064fe625444fb4e883a 100644 (file)
--- a/cmd/accept/announce.pl
+++ b/cmd/accept/announce.pl
@@ -11,4 +11,5 @@ my $type = 'accept';
 my $sort  = 'ann';
 
 my ($r, $filter, $fno) = $AnnTalk::filterdef->cmd($self, $sort, $type, $line);
-return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/accept/rbn.pl b/cmd/accept/rbn.pl
index 69b39e6beb2d44ae44e9401dad9e9f77a6fc9b1b..40173762320899669f8eec856e0613f48ad57fcd 100644 (file)
--- a/cmd/accept/rbn.pl
+++ b/cmd/accept/rbn.pl
@@ -11,4 +11,5 @@ my $type = 'accept';
 my $sort  = 'rbn';
 
 my ($r, $filter, $fno) = $RBN::filterdef->cmd($self, $sort, $type, $line);
-return (1, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/accept/route.pl b/cmd/accept/route.pl
index 94a91396a2c3de3f013c89c37a65399b92f816f2..fd335fa4bc3563f74f77dec46ea1fa8d9d1b9629 100644 (file)
--- a/cmd/accept/route.pl
+++ b/cmd/accept/route.pl
@@ -11,4 +11,5 @@ my $type = 'accept';
 my $sort  = 'route';
 
 my ($r, $filter, $fno) = $Route::filterdef->cmd($self, $sort, $type, $line);
-return (1, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/accept/spots.pl b/cmd/accept/spots.pl
index b7920d3fdfe8b6195e107635081b58e585329aad..eb0a010a347995445407fe31b9389d441aa81d0b 100644 (file)
--- a/cmd/accept/spots.pl
+++ b/cmd/accept/spots.pl
@@ -11,4 +11,5 @@ my $type = 'accept';
 my $sort  = 'spots';
 
 my ($r, $filter, $fno) = $Spot::filterdef->cmd($self, $sort, $type, $line);
-return (1, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/accept/wcy.pl b/cmd/accept/wcy.pl
index 013c1e751ede2beee6d71f0d3547c93d0ddf4be5..00309727e19c36ef7ec91422eca7d0d1dd30bc96 100644 (file)
--- a/cmd/accept/wcy.pl
+++ b/cmd/accept/wcy.pl
@@ -11,4 +11,5 @@ my $type = 'accept';
 my $sort  = 'wcy';
 
 my ($r, $filter, $fno) = $WCY::filterdef->cmd($self, $sort, $type, $line);
-return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/accept/wwv.pl b/cmd/accept/wwv.pl
index ff9906ed91c06f9bd61fa0b0f9e7cfb7811f3188..00c0dc443db33b491e7f258135c6ac1845716a3c 100644 (file)
--- a/cmd/accept/wwv.pl
+++ b/cmd/accept/wwv.pl
@@ -11,4 +11,5 @@ my $type = 'accept';
 my $sort  = 'wwv';
 
 my ($r, $filter, $fno) = $Geomag::filterdef->cmd($self, $sort, $type, $line);
-return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/reject/announce.pl b/cmd/reject/announce.pl
index 7cbe9905c2e465dc13cd32dc2eda32052c9f7f96..e56720b4a59b6026c0015b36e03f86cb974391a4 100644 (file)
--- a/cmd/reject/announce.pl
+++ b/cmd/reject/announce.pl
@@ -11,4 +11,5 @@ my $type = 'reject';
 my $sort  = 'ann';
 
 my ($r, $filter, $fno) = $AnnTalk::filterdef->cmd($self, $sort, $type, $line);
-return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/reject/rbn.pl b/cmd/reject/rbn.pl
index de1ebd20d3c4e1c4bd802f480d09a6b3e3cbb04a..36b36a8a8249814ec302624ef1db50b8d9488b80 100644 (file)
--- a/cmd/reject/rbn.pl
+++ b/cmd/reject/rbn.pl
@@ -11,4 +11,5 @@ my $type = 'reject';
 my $sort  = 'rbn';
 
 my ($r, $filter, $fno) = $RBN::filterdef->cmd($self, $sort, $type, $line);
-return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/reject/route.pl b/cmd/reject/route.pl
index 3d0873de033f097c00d0c9dd1ee323b59d208093..f7ddc7868bc655366e22a8e5e41efc93e1795015 100644 (file)
--- a/cmd/reject/route.pl
+++ b/cmd/reject/route.pl
@@ -11,4 +11,5 @@ my $type = 'reject';
 my $sort  = 'route';
 
 my ($r, $filter, $fno) = $Route::filterdef->cmd($self, $sort, $type, $line);
-return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/reject/spots.pl b/cmd/reject/spots.pl
index 55abdbb7ab77bfac6bd2f0935189c7e1d48cbf56..6ef988f3765064915b6780df779326e85403e5aa 100644 (file)
--- a/cmd/reject/spots.pl
+++ b/cmd/reject/spots.pl
@@ -11,4 +11,5 @@ my $type = 'reject';
 my $sort  = 'spots';
 
 my ($r, $filter, $fno) = $Spot::filterdef->cmd($self, $sort, $type, $line);
-return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/reject/wcy.pl b/cmd/reject/wcy.pl
index 90a4b8b65fce02d3d356a75504fe1fe72ca07991..ed94a752dbeb83e2901b75256c5ab47f7a8fc9a2 100644 (file)
--- a/cmd/reject/wcy.pl
+++ b/cmd/reject/wcy.pl
@@ -11,4 +11,5 @@ my $type = 'reject';
 my $sort  = 'wcy';
 
 my ($r, $filter, $fno) = $WCY::filterdef->cmd($self, $sort, $type, $line);
-return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/reject/wwv.pl b/cmd/reject/wwv.pl
index 23a30a3d6e27e42aabba7d00ec8e361fab75c5b0..a01d28ec815d97af0c9992a846976c04ffd8a2a7 100644 (file)
--- a/cmd/reject/wwv.pl
+++ b/cmd/reject/wwv.pl
@@ -11,4 +11,5 @@ my $type = 'reject';
 my $sort  = 'wwv';
 
 my ($r, $filter, $fno) = $Geomag::filterdef->cmd($self, $sort, $type, $line);
-return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+my $ok = $r ? 0 : 1;
+return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 8720e940ac016e4ec5e8da04346f106d80722787..c4d2b1478943f4506af037ecca5fb57127d1fcee 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -598,7 +598,11 @@ sub run_cmd
        if ($ok) {
                delete $self->{errors};
        } else {
-               return $self->_error_out('e26');
+               if (++$self->{errors} > $DXChannel::maxerrors) {
+                       $self->send($self->msg('e26'));
+                       $self->disconnect;
+                       return ();
+               }
        }
        return map {s/([^\s])\s+$/$1/; $_} @ans;
 }

diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index a3b5e983586ed9a9fdab49eac489323660813646..bf7494a7ef53a20c91dbecd695e01c3724b1f4ee 100644 (file)
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -485,7 +485,7 @@ sub notify
                        my $fromaddr = $email_from || $main::myemail;
                        my @headers = ("To: $ref->{to}", 
                                                   "From: $fromaddr",
-                                                  "Subject: [DXSpider: $ref->{from}] $ref->{subject}", 
+                                                  "Subject: [DXSpider: $ref->{from}\@$ref->{origin}] $ref->{subject}", 
                                                   "X-DXSpider-To: $ref->{to}",
                                                   "X-DXSpider-From: $ref->{from}\@$ref->{origin}", 
                                                   "X-DXSpider-Gateway: $main::mycall"

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 30f12733216915cd13105b923e6528b2694150f7..207d27711e002e017ee72bcd5dcd5fede0273a82 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -578,7 +578,7 @@ sub difft
        $t -= $h * 3600;
        $m = int $t / 60;
        $out .= sprintf ("%s${m}m", $adds?' ':'') if $m;
-       if ($d == 0 && $adds || $adds == 2) {
+       if (($d == 0 && $adds) || (int $adds && $adds == 2)) {
                $s = int $t % 60;
                $out .= sprintf ("%s${s}s", $adds?' ':'') if $s;
                $out ||= sprintf ("%s0s", $adds?' ':'');

diff --git a/perl/Filter.pm b/perl/Filter.pm
index 7119ed13e113a5ca84b05d0c6831a8e1e4b83a61..10021a4eada0e886660e65b44e699451bd8fb452 100644 (file)
--- a/perl/Filter.pm
+++ b/perl/Filter.pm
@@ -559,7 +559,7 @@ sub parse
                                }
                                return (1, $dxchan->msg('e20', $lasttok)) unless $found;
                        } else {
-                               my $s = '{' . decode_regex($tok) . '}' if $tok =~ /^{.*}$/;
+                               $s = $tok =~ /^{.*}$/ ? '{' . decode_regex($tok) . '}' : $tok;
                                return (1, $dxchan->msg('filter2', $s));
                        }
                        $lasttok = $tok;
@@ -606,8 +606,8 @@ sub cmd
 
        $filter->{$fn}->{$type}->{user} = $user;
        $filter->{$fn}->{$type}->{asc} = $s;
-       $r = $filter->compile($fn, $type);
-       return (1,$r) if $r;
+       $r = $filter->compile($fn, $type);   # NOTE: returns an ERROR, therefore 0 = success
+       return (0,$r) if $r;
        
        $r = $filter->write;
        return (1,$r) if $r;

diff --git a/perl/Messages b/perl/Messages
index f10cb5e7b68d35953600850b058e985bdfa286a7..a78e09552bababe7850ba1dd4085b244ce57356c 100644 (file)
--- a/perl/Messages
+++ b/perl/Messages
@@ -127,7 +127,7 @@ package DXM;
                                export2 => q{$_[3] has error exporting msg $_[0] to $_[1] ($_[2])},
                                export3 => q{$_[2 ] exported msg $_[0] to $_[1]},
                                filter1 => q{Filter $_[0] updated for $_[1]},
-                               filter2 => q{Unknown filter keyword $_[0]},
+                               filter2 => q{Parse error on '$_[0]'},
                                filter3 => q{No filters defined for $_[0]},
                                filter4 => q{$_[0]$_[1] Filter $_[2] deleted for $_[3]},
                                filter5 => q{need some filter commands...},