wip
authorminima <minima>
Mon, 5 Jul 2004 17:21:27 +0000 (17:21 +0000)
committerminima <minima>
Mon, 5 Jul 2004 17:21:27 +0000 (17:21 +0000)
Changes
data/bands.pl
perl/DXChannel.pm
perl/DXProt.pm
perl/DXProtout.pm
perl/Route.pm
perl/Route/Node.pm
perl/Route/User.pm

diff --git a/Changes b/Changes
index 4792fdc0d1af8aa600298ec05a5119b07640e513..dff781ad69ea5d6839ed44be779980fcee536e04 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 05Jul04=======================================================================
 1. fix rspfcheck on pc27
+24Jun04=======================================================================
+1. reduced lower limit of 13cm band to 2304Mhz
 23Jun04=======================================================================
 1. Add zone, by_zone, itu, by_itu, state and by_state searches to sh/dx
 2. Update manuals for CVS and new commands
index 9d98a173262696a5d2490f3753d8149afd98b301..60d2896ed50c3547d272984b52b34e0ba546719b 100644 (file)
                                                         ssb => [1296150, 1296800],
                                                   }, 'Bands'),
 
-                 '13cm' => bless( { band => [2310000, 2450000],
+                 '13cm' => bless( { band => [2304000, 2450000],
                                                         cw => [2320100, 2320150],
                                                         ssb => [2320150, 2320800],
                                                   }, 'Bands'),
index 3b3ac62f13b84e193c0ff661981d3ba3a7981616..3ae6afd601dd54bc8a1930223affabf4b31bf391 100644 (file)
@@ -113,6 +113,7 @@ $count = 0;
                  version => '1,Node Version',
                  build => '1,Node Build',
                  verified => '9,Verified?,yesno',
+                 newroute => '1,New Style Routing,yesno',
                 );
 
 use vars qw($VERSION $BRANCH);
@@ -637,7 +638,7 @@ sub AUTOLOAD
        # 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}};
-        goto &$AUTOLOAD;
+       goto &$AUTOLOAD;
 }
 
 
index 0d222859178ef07e06bed935b40cd9fc0d83741b..fb09e99df8e0f32a27b7f0ebcbf1716a2d4fb55e 100644 (file)
@@ -887,6 +887,7 @@ sub handle_18
                $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/;
                $self->user->version($self->version);
        }
+       $self->newroute( $_[1] =~ /NewRoute/ );
 
        # first clear out any nodes on this dxchannel
        my $parent = Route::Node::get($self->{call});
@@ -931,7 +932,7 @@ sub handle_19
                        my $user = DXUser->get_current($origin);
                        if (!$user) {
                                $user = DXUser->new($origin);
-                               $user->sort('S');
+                               $user->sort('A');
                                $user->priv(1);         # I have relented and defaulted nodes
                                $user->lockout(1);
                                $user->homenode($origin);
@@ -1498,6 +1499,116 @@ sub handle_51
        }
 }
 
+# New style routing handler
+sub handle_59
+{
+       my $self = shift;
+       my $pcno = shift;
+       my $line = shift;
+       my $origin = shift;
+
+       return unless eph_dup($line);
+
+       my ($sort, $hextime, $ncall) = @_[1,2,3];
+       if ($ncall eq $main::mycall) {
+               dbg("PCPROT: ignoring PC59 for me") if isdbg('chan');
+               return;
+       }
+
+       # mark myself as NewRoute if I get a PC59
+       $self->{newroute} = 1 if $ncall eq $self->{call};
+
+       # do this once for filtering with a throwaway routing entry if a new node
+       my $fnode = Route::Node::get($ncall) || Route::new($ncall);
+       return unless $self->in_filter_route($fnode);
+
+       # now do it properly for actions
+       my $node = Route::Node::get($ncall) || Route::Node::new($ncall);
+
+       # find each of the entries (or create new ones)
+       my @refs;
+       for my $ent (@_[4..-1]) {
+               my ($esort, $ehere, $ecall) = unpack "A A A*", $ent;
+               my $ref;
+               
+               # create user, if required
+               my $user = DXUser->get_current($ecall);
+               unless ($user) {
+                       $user = DXUser->new($ecall);
+                       $user->sort();
+                       $user->priv(1);         # I have relented and defaulted nodes
+                       $user->lockout(1);
+                       $user->homenode($call);
+                       $user->node($call);
+               }
+               if ($esort eq 'U') {
+                       $ref = Route::User::get($ecall);
+                       unless ($ref) {
+                               # create user, if required
+                               my $user = DXUser->get_current($ecall);
+                               unless ($user) {
+                                       $user = DXUser->new($ecall);
+                                       $user->sort('U');
+                                       $user->homenode($ncall);
+                                       $user->node($ncall);
+                                       $user->put;
+                               }
+                               $ref = Route::User::new($ecall, 0); 
+                       }
+               } elsif ($esort eq 'N') {
+                       $ref = Route::Node::get($ecall);
+                       unless ($ref) {
+                               # create user, if required
+                               my $user = DXUser->get_current($ecall);
+                               unless ($user) {
+                                       $user = DXUser->new($ecall);
+                                       $user->priv(1);         # I have relented and defaulted nodes
+                                       $user->lockout(1);
+                                       $user->sort('A');
+                                       $user->homenode($ncall);
+                                       $user->node($ncall);
+                                       $user->put;
+                               }
+                               $ref = Route::Node::new($ecall, 0); 
+                       } 
+               } else {
+                       dbg("DXPROT: unknown entity type '$esort' on $ecall for node $ncall") if isdbg('chan');
+                       next;
+               }
+               $ref->here($here);              # might as well set this here
+               push @refs, $ref;
+       }
+
+       # if it is a delete or a configure, disconnect all the entries mentioned
+       # from this node (which is a parent in this context).
+       my @del;
+       if ($sort eq 'D' || $sort eq 'C') {
+               for my $ref (@refs) {
+                       next if $ref->call eq $ncall;
+                       if ($ref->isa('Route::Node')) {
+                               push @del, $ref->del($node);
+                       } elsif ($ref->isa('Route::User')) {
+                               push @del, $node->del_user($ref);
+                       }
+               }
+       }
+
+       # if it is an add or a configure, connect all the entries
+       my @add;
+       if ($sort eq 'A' || $sort eq 'C') {
+               for my $ref (@refs) {
+                       next if $ref->call eq $ncall;
+                       if ($ref->isa('Route::Node')) {
+                               my $new = $node->add($ref->call);
+                               push @add, $new if $new;
+                       } elsif ($ref->isa('Route::User')) {
+                               push @add, $node->add_user($ref->call);
+                       }
+               }
+       }
+}
+       
+
 # dunno but route it
 sub handle_75
 {
@@ -1921,42 +2032,48 @@ sub send_local_config
        my @remotenodes;
 
        dbg('DXProt::send_local_config') if isdbg('trace');
-       
-       # send our nodes
-       if ($self->{isolate}) {
-               @localnodes = ( $main::routeroot );
-               $self->send_route($main::mycall, \&pc19, 1, $main::routeroot);
+
+       if ($self->{newroute}) {
+               my @nodes = $self->{isolate} ? ($main::routeroot) : grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes();
+               my @users = DXChannel::get_all_users();
+               $self->send_route($main::mycall, \&pc59c, @nodes+@users+1, (grep { Route::get($_) } $main::routeroot, @nodes, @users));
        } else {
-               # create a list of all the nodes that are not connected to this connection
-               # and are not themselves isolated, this to make sure that isolated nodes
-        # don't appear outside of this node
-
-               # send locally connected nodes
-               my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes();
-               @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan;
-               $self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes);
-
-               my $node;
-               my @rawintcalls = map { $_->nodes } @localnodes if @localnodes;
-               my @intcalls;
-               for $node (@rawintcalls) {
-                       push @intcalls, $node unless grep $node eq $_, @intcalls; 
-               }
-               my $ref = Route::Node::get($self->{call});
-               my @rnodes = $ref->nodes;
-               for $node (@intcalls) {
-                       push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes;
-               }
-               $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes);
-       }
-       
-       # get all the users connected on the above nodes and send them out
-       foreach $node ($main::routeroot, @localnodes, @remotenodes) {
-               if ($node) {
-                       my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users;
-                       $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
+               # send our nodes
+               if ($self->{isolate}) {
+                       @localnodes = ( $main::routeroot );
+                       $self->send_route($main::mycall, \&pc19, 1, $main::routeroot);
                } else {
-                       dbg("sent a null value") if isdbg('chanerr');
+                       # create a list of all the nodes that are not connected to this connection
+                       # and are not themselves isolated, this to make sure that isolated nodes
+                       # don't appear outside of this node
+                       
+                       # send locally connected nodes
+                       my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes();
+                       @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan;
+                       $self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes);
+                       
+                       my $node;
+                       my @rawintcalls = map { $_->nodes } @localnodes if @localnodes;
+                       my @intcalls;
+                       for $node (@rawintcalls) {
+                               push @intcalls, $node unless grep $node eq $_, @intcalls; 
+                       }
+                       my $ref = Route::Node::get($self->{call});
+                       my @rnodes = $ref->nodes;
+                       for $node (@intcalls) {
+                               push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes;
+                       }
+                       $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes);
+               }
+               
+               # get all the users connected on the above nodes and send them out
+               foreach $node ($main::routeroot, @localnodes, @remotenodes) {
+                       if ($node) {
+                               my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users;
+                               $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
+                       } else {
+                               dbg("sent a null value") if isdbg('chanerr');
+                       }
                }
        }
 }
index b31eacdfe111942ded8607bc9759d85e1179a56c..f08fef492bbfff7afd364cf1cf2c290593380494 100644 (file)
@@ -123,7 +123,7 @@ sub pc17
 # Request init string
 sub pc18
 {
-       return "PC18^DXSpider Version: $main::version Build: $main::build^$DXProt::myprot_version^";
+       return "PC18^DXSpider Version: $main::version Build: $main::build NewRoute^$DXProt::myprot_version^";
 }
 
 #
@@ -358,6 +358,68 @@ sub pc51
        return "PC51^$to^$from^$val^";
 }
 
+my $hexlasttime = 0;
+my $hexlastlet = 'A';
+
+sub hexstamp
+{
+       my $t = shift || $main::systime;
+       if ($t ne $hexlasttime) {
+               $hexlasttime = $t;
+               $hexlastlet = 'A';
+       } else {
+               do {
+                       $hexlastlet = chr(ord($hexlastlet) + 1);
+               } while ($hexlastlet eq '^');
+       }
+       return sprintf "%c%08X", $hexlastlet, $hexlasttime;
+}
+
+sub pc58
+{
+       my $sort = shift;
+       my $hexstamp = shift || hexstamp();
+       my $from = shift;
+       my $to = shift;
+       my $text = unpad(shift);
+       $text = ' ' if !$text;
+       $text =~ s/\^/%5E/g;
+       return "PC58^$sort^$hexstamp^$from^$to^$text" . sprintf "^%s^", get_hops(58);
+}
+
+sub pc59
+{
+       my @out;
+       my $sort = shift;
+       my $hexstamp = shift || hexstamp();
+       
+       my $node = $_[0]->call;
+       for (@_) {
+               next unless $_;
+               my $ref = $_;
+               my $call = $ref->call;
+               my $here = $ref->here;
+               $s .= $ref->isa('Route::Node') ? "^N$here$call" : "^U$here$call";
+       }
+       push @out, "PC59^$sort^$hexstamp^$node^$s" . sprintf "^%s^", get_hops(59);
+       return @out;
+}
+
+sub PC59c
+{
+       return PC59('C', @_);
+}
+
+sub PC59a
+{
+       return PC59('A', @_);
+}
+
+sub PC59d
+{
+       return PC59('D', @_);
+}
+
 # clx remote cmd send
 sub pc84
 {
index 0f52e39b4023285ad994ad533feb18d66ad11f19..0e9b61395da39891f3bcf0a1957e7a6e8abdd87a 100644 (file)
@@ -37,6 +37,7 @@ use vars qw(%list %valid $filterdef);
                  cq => '0,CQ Zone',
                  state => '0,State',
                  city => '0,City',
+                 lastseen => 'Last Seen,atime',
                 );
 
 $filterdef = bless ([
@@ -165,12 +166,6 @@ sub conf
        return $r ? 1 : 0;
 }
 
-sub parents
-{
-       my $self = shift;
-       return @{$self->{parent}};
-}
-
 # 
 # display routines
 #
@@ -287,8 +282,8 @@ sub alldxchan
        # it isn't, build up a list of dxchannels and possible ping times 
        # for all the candidates.
        unless (@dxchan) {
-               foreach my $p (@{$self->{parent}}) {
-#                      dbg("Trying parent $p") if isdbg('routech');
+               foreach my $p (@{$self->{dxchan}}) {
+#                      dbg("Trying dxchan $p") if isdbg('routech');
                        next if $p eq $main::mycall; # the root
                        my $dxchan = DXChannel->get($p);
                        if ($dxchan) {
@@ -305,7 +300,7 @@ sub alldxchan
        return @dxchan;
 }
 
-sub dxchan
+sub bestdxchan
 {
        my $self = shift;
        
@@ -329,6 +324,29 @@ sub dxchan
        return $dxchan;
 }
 
+sub _adddxchan
+{
+       my $self = shift;
+    return $self->_addlist('dxchan', @_);
+}
+
+sub _deldxchan
+{
+       my $self = shift;
+    return $self->_dellist('dxchan', @_);
+}
+
+sub _addnode
+{
+       my $self = shift;
+    return $self->_addlist('nodes', @_);
+}
+
+sub _delnode
+{
+       my $self = shift;
+    return $self->_dellist('nodes', @_);
+}
 
 
 #
index 3c4addd01c841ab41d54c45c63e779c0cb734128..92ceba22577940c41cbba51faa732bd29834d1ef 100644 (file)
@@ -24,7 +24,7 @@ use vars qw(%list %valid @ISA $max $filterdef);
 @ISA = qw(Route);
 
 %valid = (
-                 parent => '0,Parent Calls,parray',
+                 dxchan => '0,Visible on DXChans,parray',
                  nodes => '0,Nodes,parray',
                  users => '0,Users,parray',
                  usercount => '0,User Count',
@@ -59,22 +59,22 @@ sub max
 # object with that callsign. The upper layers are expected to do something
 # sensible with this!
 #
-# called as $parent->add(call, dxchan, version, flags) 
+# called as $dxchan->add(call, dxchan, version, flags) 
 #
 
 sub add
 {
-       my $parent = shift;
+       my $dxchan = shift;
        my $call = uc shift;
-       confess "Route::add trying to add $call to myself" if $call eq $parent->{call};
+       confess "Route::add trying to add $call to myself" if $call eq $dxchan->{call};
        my $self = get($call);
        if ($self) {
-               $self->_addparent($parent);
-               $parent->_addnode($self);
+               $self->_adddxchan($dxchan);
+               $dxchan->_addnode($self);
                return undef;
        }
-       $self = $parent->new($call, @_);
-       $parent->_addnode($self);
+       $self = $dxchan->new($call, @_);
+       $dxchan->_addnode($self);
        return $self;
 }
 
@@ -90,14 +90,14 @@ sub del
        my $self = shift;
        my $pref = shift;
 
-       # delete parent from this call's parent list
+       # delete dxchan from this call's dxchan list
        $pref->_delnode($self);
-    $self->_delparent($pref);
+    $self->_deldxchan($pref);
        my @nodes;
        my $ncall = $self->{call};
        
-       # is this the last connection, I have no parents anymore?
-       unless (@{$self->{parent}}) {
+       # is this the last connection, I have no dxchan anymore?
+       unless (@{$self->{dxchan}}) {
                foreach my $rcall (@{$self->{nodes}}) {
                        next if grep $rcall eq $_, @_;
                        my $r = Route::Node::get($rcall);
@@ -112,11 +112,11 @@ sub del
 
 sub del_nodes
 {
-       my $parent = shift;
+       my $dxchan = shift;
        my @out;
-       foreach my $rcall (@{$parent->{nodes}}) {
+       foreach my $rcall (@{$dxchan->{nodes}}) {
                my $r = get($rcall);
-               push @out, $r->del($parent, $parent->{call}, @_) if $r;
+               push @out, $r->del($dxchan, $dxchan->{call}, @_) if $r;
        }
        return @out;
 }
@@ -142,7 +142,7 @@ sub add_user
        my $uref = Route::User::get($ucall);
        my @out;
        if ($uref) {
-               @out = $uref->addparent($self);
+               @out = $uref->adddxchan($self);
        } else {
                $uref = Route::User->new($ucall, $self->{call}, @_);
                @out = $uref;
@@ -191,12 +191,6 @@ sub nodes
        return @{$self->{nodes}};
 }
 
-sub parents
-{
-       my $self = shift;
-       return @{$self->{parent}};
-}
-
 sub rnodes
 {
        my $self = shift;
@@ -219,7 +213,7 @@ sub new
        confess "already have $call in $pkg" if $list{$call};
        
        my $self = $pkg->SUPER::new($call);
-       $self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ];
+       $self->{dxchan} = ref $pkg ? [ $pkg->{call} ] : [ ];
        $self->{version} = shift;
        $self->{flags} = shift;
        $self->{users} = [];
@@ -245,47 +239,6 @@ sub get_all
        return values %list;
 }
 
-sub newid
-{
-       my $self = shift;
-       my $id = shift;
-       
-       return 0 if $id == $self->{lid};
-       if ($id > $self->{lid}) {
-               $self->{lid} = $id;
-               return 1;
-       } elsif ($self->{lid} - $id > 500) {
-               $self->{id} = $id;
-               return 1;
-       }
-       return 0;
-}
-
-sub _addparent
-{
-       my $self = shift;
-    return $self->_addlist('parent', @_);
-}
-
-sub _delparent
-{
-       my $self = shift;
-    return $self->_dellist('parent', @_);
-}
-
-
-sub _addnode
-{
-       my $self = shift;
-    return $self->_addlist('nodes', @_);
-}
-
-sub _delnode
-{
-       my $self = shift;
-    return $self->_dellist('nodes', @_);
-}
-
 
 sub _adduser
 {
index b9862e6de5f0b847a627a4af0279e2043cc85660..88d2aa2a0d0fb5a8e1e8986614a5ef33d9afec07 100644 (file)
@@ -23,7 +23,7 @@ use vars qw(%list %valid @ISA $max $filterdef);
 @ISA = qw(Route);
 
 %valid = (
-                 parent => '0,Parent Calls,parray',
+                 dxchan => '0,Dxchan Calls,parray',
 );
 
 $filterdef = $Route::filterdef;
@@ -52,7 +52,7 @@ sub new
        confess "already have $call in $pkg" if $list{$call};
        
        my $self = $pkg->SUPER::new($call);
-       $self->{parent} = [ $ncall ];
+       $self->{nodes} = [ $ncall ];
        $self->{flags} = $flags;
        $list{$call} = $self;
 
@@ -68,8 +68,8 @@ sub del
 {
        my $self = shift;
        my $pref = shift;
-       $self->delparent($pref);
-       unless (@{$self->{parent}}) {
+       $self->deldxchan($pref);
+       unless (@{$self->{dxchan}}) {
                delete $list{$self->{call}};
                return $self;
        }
@@ -85,18 +85,6 @@ sub get
        return $ref;
 }
 
-sub addparent
-{
-       my $self = shift;
-    return $self->_addlist('parent', @_);
-}
-
-sub delparent
-{
-       my $self = shift;
-    return $self->_dellist('parent', @_);
-}
-
 #
 # generic AUTOLOAD for accessors
 #