fix $BRANCH auto revisioning code

[spider.git] / perl / DXProt.pm

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index e1d4fb28647bc854325538a418033766bb32cc37..db5bfabee03c93fc8cf9645a6192add3a064803f 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -38,7 +38,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,0));
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/,(0,0));
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
@@ -326,32 +326,6 @@ sub send
        }
 }
 
-my $pc90msgid = 0;
-
-sub nextpc90
-{
-       $pc90msgid = 0 if $pc90msgid > 9999;
-       return $pc90msgid++;
-}
-
-sub mungepc90
-{
-       unless ($_[0] =~ /^PC9\d/) {
-               my $id = nextpc90();
-               return "PC90^$main::mycall^$id^" . $_[0]; 
-       } 
-       return $_[0];
-}
-
-sub mungepc91
-{
-       unless ($_[1] =~ /^PC9\d/) {
-               my $id = nextpc90();
-               return "PC91^$main::mycall^$id^$_[0]^" . $_[1]; 
-       } 
-       return $_[1];
-}
-
 #
 # This is the normal pcxx despatcher
 #
@@ -380,68 +354,8 @@ sub normal
                return;
        }
 
-       # handle PC90 frames in a special way.
-    # 
-       # PC90 frames are normal frames that that are wrapped in inside a PC90 
-    # The extra fields are "originating node" and a sequence number.
-    # The sequence number is checked against the nodes 'last one' to see if
-       # it is a duplicate and, if so, is dropped at this stage; before any
-       # other processing.
-       #
-       # This is done here simply for efficiency. Adding another function would
-       # add more copying and so on.
-       #
-
        my $origin = $self->{call};
        
-       if ($pcno >= 90) {
-               $origin = $field[1];
-               if ($origin eq $main::mycall) {
-                       dbg("PCPROT: loop dupe") if isdbg('chanerr');
-                       return;
-               }
-               $self->user->wantpc90(1) unless $self->user->wantpc90 || $origin ne $self->{call};
-               my $seq = $field[2];
-               my $node = Route::Node::get($origin);
-               if ($node) {
-                       if (my $lid = $node->lid) {
-                               my $cmp = $seq >= $lid ? $seq : $seq + 9999;
-                               if ($cmp <= $lid) {
-                                       dbg("PCPROT: sequence dupe $seq ($cmp) <= $lid") if isdbg('chanerr');
-                                       return;
-                               }
-                       }
-                       $node->lid($seq);
-               }
-
-               # do a recheck on the contents of the PC90
-               if ($pcno >= 90) {
-                       shift @field;
-                       shift @field;
-                       shift @field;
-                       $origin = shift @field if $pcno == 91;
-
-                       ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
-                       unless (defined $pcno && $pcno >= 10 && $pcno <= 89) {
-                               dbg("PCPROT: unknown protocol") if isdbg('chanerr');
-                               return;
-                       }
-                       
-                       # check for and dump bad protocol messages
-                       my $n = check($pcno, @field);
-                       if ($n) {
-                               dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr');
-                               return;
-                       }
-               }
-       } else {
-               if ($pcno == 16 || $pcno == 17 || $pcno == 19 || $pcno == 21) {
-                       $line = mungepc91($origin, $line);
-               } else {
-                       $line = mungepc90($line);
-               }
-       }
-
        no strict 'subs';
        my $sub = "handle_$pcno";
 
@@ -1005,6 +919,8 @@ sub handle_19
 
        # new routing list
        my @rout;
+
+       # first get the INTERFACE node
        my $parent = Route::Node::get($self->{call});
        unless ($parent) {
                dbg("DXPROT: my parent $self->{call} has disappeared");
@@ -1012,6 +928,27 @@ sub handle_19
                return;
        }
 
+       # if the origin isn't the same as the INTERFACE, then reparent, creating nodes as necessary
+       if ($origin ne $self->call) {
+               my $op = Route::Node::get($origin);
+               unless ($op) {
+                       $op = $parent->add($origin, 5000, Route::here(1));
+                       my $user = DXUser->get_current($origin);
+                       if (!$user) {
+                               $user = DXUser->new($origin);
+                               $user->sort('S');
+                               $user->priv(1);         # I have relented and defaulted nodes
+                               $user->lockout(1);
+                               $user->homenode($origin);
+                               $user->node($origin);
+                               $user->wantroutepc19(1);
+                               $user->wantpc90(1);
+                       }
+                       $user->put;
+               }
+               $parent = $op;
+       }
+
        # parse the PC19
        for ($i = 1; $i < $#_-1; $i += 4) {
                my $here = $_[$i];
@@ -1349,7 +1286,13 @@ sub handle_37
        my $pcno = shift;
        my $line = shift;
        my $origin = shift;
-       DXDb::process($self, $line);
+       if ($_[1] eq $main::mycall) {
+               no strict 'refs';
+               my $sub = "DXDb::handle_$pcno";
+               &$sub($self, @_);
+       } else {
+               $self->route($_[1], $line) unless $self->is_clx;
+       }
 }
 
 # node connected list from neighbour