perl/Thingy/Rt.pm

   1 #
   2 # Route Thingy handling
   3 #
   4 # Note that this is a generator of pc(16|17|19|21)n and pc(16|17)u
   5 # and a consumer of the fpc versions of the above
   6 #
   7 # $Id$
   8 #
   9 # Copyright (c) 2005 Dirk Koopman G1TLH
  10 #
  11
  12 use strict;
  13
  14 package Thingy::Rt;
  15
  16 use vars qw($VERSION $BRANCH);
  17
  18 main::mkver($VERSION = q$Revision$);
  19
  20 use DXChannel;
  21 use DXDebug;
  22 use DXUtil;
  23 use Thingy;
  24 use Thingy::RouteFilter;
  25 use Spot;
  26
  27 use vars qw(@ISA);
  28 @ISA = qw(Thingy Thingy::RouteFilter);
  29
  30 sub gen_Aranea
  31 {
  32         my $thing = shift;
  33         unless ($thing->{Aranea}) {
  34                 my $ref;
  35                 if ($ref = $thing->{anodes}) {
  36                         $thing->{n} = join(':', map {"$_->{flags}$_->{call}"} @$ref);
  37                 }
  38                 if ($ref = $thing->{ausers}) {
  39                         $thing->{u} = join(':', map {"$_->{flags}$_->{call}"} @$ref);
  40                 }
  41                 $thing->{Aranea} = Aranea::genmsg($thing, [qw(s n u)]);
  42         }
  43         return $thing->{Aranea};
  44 }
  45
  46 sub from_Aranea
  47 {
  48         my $thing = shift;
  49         return unless $thing;
  50         return $thing;
  51 }
  52
  53 sub handle
  54 {
  55         my $thing = shift;
  56         my $dxchan = shift;
  57
  58         if ($thing->{'s'}) {
  59                 my $sub = "handle_$thing->{s}";
  60                 if ($thing->can($sub)) {
  61                         no strict 'refs';
  62                         $thing = $thing->$sub($dxchan);
  63                 }
  64
  65                 $thing->broadcast($dxchan) if $thing;
  66         }
  67 }
  68
  69 # this handles the standard local configuration, it
  70 # will reset all the config, make / break links and
  71 # will generate pc sentences as required for nodes and users
  72 sub handle_lcf
  73 {
  74         my $thing = shift;
  75         my $dxchan = shift;
  76         my $origin = $thing->{origin};
  77         my $chan_call = $dxchan->{call};
  78
  79         my $parent = Route::Node::get($origin);
  80         unless ($parent) {
  81                 dbg("Thingy::Rt::lcf: received from $origin on $chan_call unknown") if isdbg('chanerr');
  82                 return;
  83         }
  84
  85         # do nodes
  86         if ($thing->{n}) {
  87                 my %in = (map {my ($here, $call) = unpack "A1 A*", $_; ($call, $here)} split /:/, $thing->{n});
  88                 my ($del, $add) = $parent->diff_nodes(keys %in);
  89
  90                 my $call;
  91
  92                 my @pc21;
  93                 foreach $call (@$del) {
  94                         RouteDB::delete($call, $chan_call);
  95                         my $ref = Route::Node::get($call);
  96                         push @pc21, $ref->del($parent) if $ref;
  97                 }
  98                 $thing->{pc21n} = \@pc21 if @pc21;
  99
 100                 my @pc19;
 101                 foreach $call (@$add) {
 102                         RouteDB::update($call, $chan_call);
 103                         my $ref = Route::Node::get($call);
 104                         push @pc19, $parent->add($call, 0, $in{$call}) unless $ref;
 105                 }
 106                 $thing->{pc19n} = \@pc19 if @pc19;
 107         }
 108
 109         # now users
 110         if ($thing->{u}) {
 111                 my %in = (map {my ($here, $call) = unpack "A1 A*", $_; ($call, $here)} split /:/, $thing->{u});
 112                 my ($del, $add) = $parent->diff_users(keys %in);
 113
 114                 my $call;
 115
 116                 my @pc17;
 117                 foreach $call (@$del) {
 118                         RouteDB::delete($call, $chan_call);
 119                         my $ref = Route::User::get($call);
 120                         if ($ref) {
 121                                 $parent->del_user($ref);
 122                                 push @pc17, $ref;
 123                         } else {
 124                                 dbg("Thingy::Rt::lcf: del user $call not known, ignored") if isdbg('chanerr');
 125                                 next;
 126                         }
 127                 }
 128                 if (@pc17) {
 129                         $thing->{pc17n} = $parent;
 130                         $thing->{pc17u} = \@pc17;
 131                 }
 132
 133                 my @pc16;
 134                 foreach $call (@$add) {
 135                         RouteDB::update($call, $chan_call);
 136                         push @pc16, _add_user($parent, $call, $in{$call});
 137                 }
 138                 if (@pc16) {
 139                         $thing->{pc16n} = $parent;
 140                         $thing->{pc16u} = \@pc16;
 141                 }
 142         }
 143
 144         return $thing;
 145 }
 146
 147 sub _add_user
 148 {
 149         my $node = shift;
 150         my $user = shift;
 151         my $flag = shift;
 152
 153         my @out = $node->add_user($user, $flag);
 154         my $ur = _upd_user_rec($user, $node);
 155         $ur->put;
 156         return @out;
 157 }
 158
 159 sub _upd_user_rec
 160 {
 161         my $call = shift;
 162         my $parentcall = shift;
 163
 164         # add this station to the user database, if required
 165         $call =~ s/-\d+$//o;    # remove ssid for users
 166         my $user = DXUser->get_current($call);
 167         $user = DXUser->new($call) if !$user;
 168         $user->homenode($parentcall) if !$user->homenode;
 169         $user->node($parentcall);
 170         $user->lastin($main::systime) unless DXChannel::get($call);
 171         return $user;
 172 }
 173
 174 #
 175 # Generate a configuration for onward broadcast
 176 #
 177 # Basically, this creates a thingy with list of nodes and users that
 178 # are on this node. This the normal method of spreading this
 179 # info whenever a node connects and also periodically.
 180 #
 181
 182 sub new_lcf
 183 {
 184         my $pkg = shift;
 185         my $thing = $pkg->SUPER::new(@_);
 186
 187         $thing->{'s'} = 'lcf';
 188
 189         my @nodes;
 190         my @users;
 191
 192         foreach my $dxchan (DXChannel::get_all()) {
 193                 if ($dxchan->is_node || $dxchan->is_aranea) {
 194                         my $ref = Route::Node::get($dxchan->{call});
 195                         push @nodes, $ref if $ref;
 196                 } else {
 197                         my $ref = Route::User::get($dxchan->{call});
 198                         push @users, $ref if $ref;
 199                 }
 200         }
 201         $thing->{anodes} = \@nodes if @nodes;
 202         $thing->{ausers} = \@users if @users;
 203         return $thing;
 204 }
 205
 206
 207
 208
 209 1;