alter disconnect slightly

[spider.git] / perl / cluster.pl

diff --git a/perl/cluster.pl b/perl/cluster.pl
index fc0a6a04a429c22cbee00fa6598847eb7489065e..fb8753e24fd45782e85f351e1e233d7b457b8f8d 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -61,7 +61,6 @@ use DXProtVars;
 use DXProtout;
 use DXProt;
 use DXMsg;
-use DXCluster;
 use DXCron;
 use DXConnect;
 use DXBearing;
@@ -145,24 +144,9 @@ sub new_channel
                return;
        }
        
-       # is there one already connected elsewhere in the cluster?
        if ($user) {
-               if (($user->is_node || $call eq $myalias) && !DXCluster->get_exact($call)) {
-                       ;
-               } else {
-                       if (my $ref = DXCluster->get_exact($call)) {
-                               my $mess = DXM::msg($lang, 'concluster', $call, $ref->mynode->dxchancall);
-                               already_conn($conn, $call, $mess);
-                               return;
-                       }
-               }
                $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems
        } else {
-               if (my $ref = DXCluster->get_exact($call)) {
-                       my $mess = DXM::msg($lang, 'concluster', $call, $ref->mynode->dxchancall);
-                       already_conn($conn, $call, $mess);
-                       return;
-               }
                $user = DXUser->new($call);
        }
        
@@ -347,16 +331,20 @@ while (<CL>) {
        push @fn, $1;
 }
 close CL;
+my $subbuild;
 foreach my $fn (@fn) {
+       $fn =~ s|::|/|g;
        open(CL, "$main::root/perl/${fn}.pm") or next;
        while (<CL>) {
-               if (/^#\s+\$Id:\s+[\w\._]+,v\s+(\d+\.\d+)/ ) {
+               if (/^#\s+\$Id:\s+[\w\._]+,v\s+(\d+\.\d+)\.?(\d+.\d+)?/ ) {
                        $build += $1;
+                       $subbuild += $2 if $2;
                        last;
                }
        }
        close CL;
 }
+$build = "$build.$subbuild" if $subbuild;
 
 Log('cluster', "DXSpider V$version, build $build started");
 
@@ -436,8 +424,13 @@ dbg('err', "reading in duplicate spot and WWV info ...");
 DXProt->init();
 
 # put in a DXCluster node for us here so we can add users and take them away
-DXNode->new($DXProt::me, $mycall, 0, 1, $DXProt::myprot_version); 
-$routeroot = Route::Node->new($mycall, $version, Route::here($DXProt::me->here)|Route::conf($DXProt::me->confmode));
+$routeroot = Route::Node->new($mycall, $version*100+5300, Route::here($DXProt::me->here)|Route::conf($DXProt::me->conf));
+
+# make sure that there is a routing OUTPUT node default file
+unless (Filter::read_in('route', 'node_default', 0)) {
+       my $dxcc = $DXProt::me->dxcc;
+       $Route::filterdef->cmd($DXProt::me, 'route', 'accept', "node_default call_dxcc $dxcc" );
+}
 
 # read in any existing message headers and clean out old crap
 dbg('err', "reading existing message headers ...");