perl/Thingy/Rt.pm

   1 #
   2 # Route Thingy handling
   3 #
   4 # $Id$
   5 #
   6 # Copyright (c) 2005 Dirk Koopman G1TLH
   7 #
   8
   9 use strict;
  10
  11 package Thingy::Rt;
  12
  13 use vars qw($VERSION $BRANCH);
  14
  15 main::mkver($VERSION = q$Revision$);
  16
  17 use DXChannel;
  18 use DXDebug;
  19 use DXUtil;
  20 use Thingy;
  21 use Thingy::RouteFilter;
  22 use Spot;
  23
  24 use vars qw(@ISA);
  25 @ISA = qw(Thingy Thingy::RouteFilter);
  26
  27 sub gen_Aranea
  28 {
  29         my $thing = shift;
  30         unless ($thing->{Aranea}) {
  31                 my $ref;
  32                 if ($ref = $thing->{anodes}) {
  33                         $thing->{n} = join(':', map {$_->{call}} @$ref);
  34                 }
  35                 if ($ref = $thing->{ausers}) {
  36                         $thing->{u} = join(':', map {$_->{call}} @$ref);
  37                 }
  38                 $thing->{Aranea} = Aranea::genmsg($thing, [qw(s n u)]);
  39         }
  40         return $thing->{Aranea};
  41 }
  42
  43 sub from_Aranea
  44 {
  45         my $thing = shift;
  46         return unless $thing;
  47         return $thing;
  48 }
  49
  50 sub handle
  51 {
  52         my $thing = shift;
  53         my $dxchan = shift;
  54
  55         if ($thing->{'s'}) {
  56                 my $sub = "handle_$thing->{s}";
  57                 if ($thing->can($sub)) {
  58                         no strict 'refs';
  59                         $thing = $thing->$sub($dxchan);
  60                 }
  61
  62                 $thing->broadcast($dxchan) if $thing;
  63         }
  64 }
  65
  66
  67 sub add_user
  68 {
  69         my $node = shift;
  70         my $user = shift;
  71         my $flag = shift;
  72
  73         $node->add_user($user, $flag);
  74         my $ur = upd_user_rec($user, $node);
  75         $ur->put;
  76 }
  77
  78 sub upd_user_rec
  79 {
  80         my $call = shift;
  81         my $parentcall = shift;
  82
  83         # add this station to the user database, if required
  84         $call =~ s/-\d+$//o;    # remove ssid for users
  85         my $user = DXUser->get_current($call);
  86         $user = DXUser->new($call) if !$user;
  87         $user->homenode($parentcall) if !$user->homenode;
  88         $user->node($parentcall);
  89         $user->lastin($main::systime) unless DXChannel::get($call);
  90         return $user;
  91 }
  92
  93 #
  94 # Generate a configuration for onward broadcast
  95 #
  96 # Basically, this creates a thingy with list of nodes and users that
  97 # are on this node. This the normal method of spreading this
  98 # info whenever a node connects and also periodically.
  99 #
 100
 101 sub new_lcf
 102 {
 103         my $pkg = shift;
 104         my $thing = $pkg->SUPER::new(@_);
 105
 106         $thing->{'s'} = 'lcf';
 107
 108         my @nodes;
 109         my @users;
 110
 111         foreach my $dxchan (DXChannel::get_all()) {
 112                 if ($dxchan->is_node || $dxchan->is_aranea) {
 113                         my $ref = Route::Node::get($dxchan->{call});
 114                         push @nodes, $ref if $ref;
 115                 } else {
 116                         my $ref = Route::User::get($dxchan->{call});
 117                         push @users, $ref if $ref;
 118                 }
 119         }
 120         $thing->{anodes} = \@nodes if @nodes;
 121         $thing->{ausers} = \@users if @users;
 122         return $thing;
 123 }
 124
 125
 126
 127
 128 1;