fixed duplicate spot, always make clean ending

Try to make sure that the user file is always close regardless of
what happens to cause the program to end/stop/crash.

diff --git a/Changes b/Changes
index 9c47b5bae63958250c6af2ff891cb2aef9b1e2a3..20462e085bedaae544ebb711d6049aac81573f82 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+28Jan22=======================================================================
+1. Fixed duplicate spot display.
 25Jan22=======================================================================
 1. Fixed grepdbg so that it does what -help says it does.
 2. Replaced all " characters with ' in Messages. For some reason things in "

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 9c29464083476f9adb922ed46bd88ac41e8b3581..60b36331df668ac1ec10f6e3dcaf4c57e7310241 100644 (file)
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -137,17 +137,17 @@ $count = 0;
 $maxerrors = 20;                               # the maximum number of concurrent errors allowed before disconnection
 
 # object destruction
-sub DESTROY
-{
-       my $self = shift;
-       for (keys %$self) {
-               if (ref($self->{$_})) {
-                       delete $self->{$_};
-               }
-       }
-       dbg("DXChannel $self->{call} destroyed ($count)") if isdbg('chan');
-       $count--;
-}
+# sub DESTROY
+# {
+#      my $self = shift;
+#      for (keys %$self) {
+#              if (ref($self->{$_})) {
+#                      delete $self->{$_};
+#              }
+#      }
+#      dbg("DXChannel $self->{call} destroyed ($count)") if isdbg('chan');
+#      $count--;
+# }
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
 sub alloc
@@ -257,7 +257,7 @@ sub get_all_node_calls
        my $ref;
        my @out;
        foreach $ref (values %channels) {
-               push @out, $ref->{call} if $ref->is_node;
+               push @out, $ref->{call} if $ref && $ref->is_node;
        }
        return @out;
 }
@@ -268,7 +268,7 @@ sub get_all_users
        my $ref;
        my @out;
        foreach $ref (values %channels) {
-               push @out, $ref if $ref->is_user;
+               push @out, $ref if $ref &&  $ref->is_user;
        }
        return @out;
 }

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index cd15057d56fe40c8b42c6ea8943a6177f32bdd78..e6432b850d2dc979d0708663ded53d1dae6dca56 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -100,6 +100,7 @@ sub start
 
        $self->{name} = $name ? $name : $call;
        $self->send($self->msg('l2',$self->{name}));
+       $self->send("Capabilities: ve7cc");
        $self->state('prompt');         # a bit of room for further expansion, passwords etc
        $self->{priv} = $user->priv || 0;
        $self->{lang} = $user->lang || $main::lang || 'en';

diff --git a/perl/DXDupe.pm b/perl/DXDupe.pm
index 5b288d1f87b1b3f1d04f8f99caf8c485d3d0127f..9198aee6c050939b2d5852f81d089683938835da 100644 (file)
--- a/perl/DXDupe.pm
+++ b/perl/DXDupe.pm
@@ -34,6 +34,11 @@ sub finish
        unlink $fn;
 }
 
+sub active
+{
+       return $dbm;
+}
+
 sub check
 {
        my $s = shift;

diff --git a/perl/DXLog.pm b/perl/DXLog.pm
index ede817aa446fdae1dc89ae634488401206bc74d5..db7dffdd430a0977e306fa83d0afcff4ee671e95 100644 (file)
--- a/perl/DXLog.pm
+++ b/perl/DXLog.pm
@@ -34,7 +34,7 @@ use DXVars;
 use DXUtil;
 use Julian;
 
-use Carp;
+use Carp qw(confess cluck);
 
 use strict;
 
@@ -56,7 +56,8 @@ sub new
        # make sure the directory exists
        mkdir($ref->{prefix}, 0777) unless -e $ref->{prefix};
        $logs{$ref} = $ref;
-       
+       $ref->{jdate} = $ref->unixtoj($main::systime);
+
        return $ref;
 }
 
@@ -148,10 +149,14 @@ sub unixtoj($$)
 sub write($$$)
 {
        my ($self, $jdate, $line) = @_;
+       cluck("Log::write \$jdate undefined") unless $jdate;
+#      cluck("Log::write \$self->jdate undefined") unless $self->{jdate};
        if (!$self->{fh} || 
-               $self->{mode} ne ">>" || 
-               $jdate->year != $self->{jdate}->year || 
-               $jdate->thing != $self->{jdate}->thing) {
+               $self->{mode} ne ">>" ||
+               $jdate->year !=
+               $self->{jdate}->year ||
+               $jdate->thing
+               != $self->{jdate}->thing) {
                $self->open($jdate, ">>") or confess "can't open $self->{fn} $!";
        }
 
@@ -183,14 +188,6 @@ sub close
        delete $self->{fh};     
 }
 
-sub DESTROY
-{
-       my $self = shift;
-       delete $logs{$self};
-       undef $self->{fh};                      # close the filehandle
-       delete $self->{fh} if $self->{fh};
-}
-
 sub flushall
 {
        foreach my $l (values %logs) {
@@ -204,7 +201,7 @@ sub flushall
 # The user is responsible for making sense of this!
 sub Log
 {
-       my $t = time;
+       my $t = $main::systime;
        $log->writeunix($t, join('^', $t, @_) );
 }
 

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index b6e959e7ddc23b5dcc8109347ff5552fd00d3af0..3c4b49f3d7d344fc1dc83825402d45beeed06cfd 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -557,6 +557,8 @@ sub send_dx_spot
        foreach $dxchan (@dxchan) {
                next if $dxchan == $main::me;
                next if $dxchan == $self && $self->is_node;
+               next if $dxchan == $self;
+
                if ($line =~ /PC61/ && !($dxchan->is_spider || $dxchan->is_user)) {
                        unless ($pc11) {
                                my @f = split /\^/, $line;

diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 911f35bc99c7c778a0fba7529d262c07df0bf96c..51e6bb56aa7fc889cab17586bcc7adcd28fa9648 100644 (file)
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -188,6 +188,11 @@ sub init
        $filename = $ufn;
 }
 
+sub active
+{
+       return $dbm;
+}
+
 sub del_file
 {
        my ($pkg, $fn) = @_;
@@ -214,6 +219,7 @@ sub process
 
 sub finish
 {
+       print "DXUser Finishing\n";
        undef $dbm;
        untie %u;
 }
@@ -873,7 +879,10 @@ __DATA__
        
 }
 
-
+sub END
+{
+       finish() if $dbm;
+}
 1;
 __END__
 

diff --git a/perl/QSL.pm b/perl/QSL.pm
index d8a75c7f9d78441839642d79e89672b9d6defef9..3d228d39685992166ec292c8b42a3c221b362ec4 100644 (file)
--- a/perl/QSL.pm
+++ b/perl/QSL.pm
@@ -135,4 +135,9 @@ sub put
        $dbm->put($key, $value);
 }
 
+sub active
+{
+       return $dbm;
+}
+
 1;

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 466da70876fd6a30f0f8bbaa46c101891cf16d3b..cc96ac59b0bf065e2bff69cdd9aa5ba0db5825fa 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -272,10 +272,16 @@ sub login
 }
 
 # cease running this program, close down all the connections nicely
+our $is_ceasing;
+
 sub cease
 {
        my $dxchan;
 
+       cluck("ceasing") if $is_ceasing; 
+
+       return if $is_ceasing++;
+       
        unless ($is_win) {
                $SIG{'TERM'} = 'IGNORE';
                $SIG{'INT'} = 'IGNORE';
@@ -294,13 +300,14 @@ sub cease
        foreach $dxchan (DXChannel::get_all_nodes) {
            $dxchan->disconnect(2) unless $dxchan == $main::me;
        }
-       Msg->event_loop(100, 0.01);
 
        # disconnect users
        foreach $dxchan (DXChannel::get_all_users) {
                $dxchan->disconnect;
        }
 
+       Msg->event_loop(100, 0.01);
+
        # disconnect AGW
        AGWMsg::finish();
        BPQMsg::finish();
@@ -310,8 +317,9 @@ sub cease
 
        # end everything else
        Msg->event_loop(100, 0.01);
-       DXUser::finish();
        DXDupe::finish();
+       QSL::finish();
+       DXUser::finish();
 
        # close all databases
        DXDb::closeall;
@@ -321,12 +329,12 @@ sub cease
                $l->close_server;
        }
 
-       LogDbg('cluster', "DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O ended");
+       $dbh->finish if $dbh;
+
+       LogDbg("DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O ended");
        dbgclose();
        Logclose();
 
-       $dbh->finish if $dbh;
-
        unlink $lockfn;
 #      $SIG{__WARN__} = $SIG{__DIE__} =  sub {my $a = shift; cluck($a); };
        exit(0);
@@ -442,7 +450,8 @@ DXXml::init();
 my ($year) = (gmtime)[5];
 $year += 1900;
 LogDbg('cluster', "DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O started");
-dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH");
+LogDbg('cluster', "Copyright (c) 1998-$year Dirk Koopman G1TLH");
+LogDbg('cluster', "Capabilities: ve7cc rbn");
 
 # load Prefixes
 dbg("loading prefixes ...");
@@ -646,7 +655,12 @@ for (;;) {
                last if --$decease <= 0;
        }
 }
-cease(0);
+cease(0) unless $is_ceasing;
 exit(0);
 
 
+#
+sub END
+{
+       cease(0) unless $is_ceasing;
+}