2 # Node routing routines
4 # Copyright (c) 2001 Dirk Koopman G1TLH
17 use vars qw($VERSION $BRANCH);
18 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /:\s+(\d+)\.(\d+)/ );
19 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /:\s+\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
20 $main::build += $VERSION;
21 $main::branch += $BRANCH;
23 use vars qw(%list %valid @ISA $max $filterdef);
27 dxchan => '0,DXChannel List,parray',
28 nodes => '0,Node List,parray',
29 users => '0,User List,parray',
30 usercount => '0,User Count',
31 version => '0,Version',
32 newroute => '0,New Routing?,yesno',
33 pingtime => '0,Ping Time',
36 $filterdef = $Route::filterdef;
42 my $n = scalar (keys %list);
43 $max = $n if $n > $max;
53 # link a node to this node and mark the route as available thru
54 # this dxchan, any users must be linked separately
56 # call as $node->link_node($neighbour, $dxchan);
61 my ($self, $neighbour, $dxchan) = @_;
63 my $r = $neighbour->is_empty('dxchan');
64 $self->_addlist('nodes', $neighbour);
65 $neighbour->_addlist('nodes', $self);
66 $neighbour->_addlist('dxchan', $dxchan);
67 return $r ? ($neighbour) : ();
70 # unlink a node from a neighbour and remove any
71 # routes, if this node becomes orphaned (no routes
72 # and no nodes) then return it
77 my ($self, $neighbour, $dxchan) = @_;
78 $self->_dellist('nodes', $neighbour);
79 $neighbour->_dellist('nodes', $self);
80 $neighbour->_dellist('dxchan', $dxchan) if $dxchan;
81 return $neighbour->is_empty('dxchan') ? ($neighbour) : ();
86 my ($self, $neighbour, $dxchan) = @_;
91 push @rout, $self->link_node($neighbour, $dxchan);
92 dbg("Adding $neighbour->{call}") if isdbg('routelow');
94 # then run down the tree removing this dxchan link from
95 # all the referenced nodes that use this interface
97 my @in = map { Route::Node::get($_) } $neighbour->nodes;
100 next if $visited{$r->call};
101 next if $r->{call} eq $main::mycall;
102 next if $r->{call} eq $self->{call};
103 my ($o) = $r->add_dxchan($dxchan);
105 dbg("Connecting new node $o->{call}") if isdbg('routelow');
108 push @in, map{ Route::Node::get($_) } $r->nodes;
109 $visited{$r->call} = $r;
112 # @rout should contain any nodes that have now been de-orphaned
113 # ie have had their first dxchan added.
119 my ($self, $neighbour, $dxchan) = @_;
121 # cut the dxchan link
124 push @rout, $self->unlink_node($neighbour, $dxchan);
125 dbg("Orphanning $neighbour->{call}") if isdbg('routelow');
127 # then run down the tree removing this dxchan link from
128 # all the referenced nodes that use this interface
130 my @in = map { Route::Node::get($_) } $neighbour->nodes;
131 foreach my $r (@in) {
133 next if $visited{$r->call};
134 next if $r->{call} eq $main::mycall;
135 next if $r->{call} eq $self->{call};
136 my ($o) = $r->del_dxchan($dxchan);
138 dbg("Orphanning $o->{call}") if isdbg('routelow');
141 push @in, map{ Route::Node::get($_) } $r->nodes;
142 $visited{$r->call} = $r;
145 # in @rout there should be a list of orphaned (in dxchan terms)
146 # nodes. Now go thru and make sure that all their links are
147 # broken (they should be, but this is to check).
149 foreach my $r (@rout) {
150 my @nodes = map { Route::Node::get($_)} $r->nodes;
153 dbg("Orphaned node $_->{call}: breaking link to $_->{call}") if isdbg('routelow');
160 # add a user to this node
161 # returns Route::User if it is a new user;
164 my ($self, $uref) = @_;
165 my $r = $uref->is_empty('nodes');
166 $self->_addlist('users', $uref);
167 $uref->_addlist('nodes', $self);
168 $self->{usercount} = scalar @{$self->{users}};
169 return $r ? ($uref) : ();
172 # delete a user from this node
175 my ($self, $uref) = @_;
177 $self->_dellist('users', $uref);
178 $uref->_dellist('nodes', $self);
179 $self->{usercount} = scalar @{$self->{users}};
180 return $uref->is_empty('nodes') ? ($uref) : ();
183 # add a single dxchan link
186 my ($self, $dxchan) = @_;
187 return $self->_addlist('dxchan', $dxchan);
190 # remove a single dxchan link
193 my ($self, $dxchan) = @_;
194 $self->_dellist('dxchan', $dxchan);
195 return $self->is_empty('dxchan') ? ($self) : ();
201 if (@_ && @{$self->{users}} == 0) {
202 $self->{usercount} = shift;
204 return $self->{usercount};
210 return @{$self->{users}};
216 return @{$self->{nodes}};
223 foreach my $u (@{$self->{users}}) {
224 my $uref = Route::User::get($u);
225 push @rout, $self->del_user($uref) if $uref;
235 confess "already have $call in $pkg" if $list{$call};
237 my $self = $pkg->SUPER::new($call);
238 $self->{dxchan} = [ ];
239 $self->{version} = shift || 5000;
240 $self->{flags} = shift || Route::here(1);
244 $list{$call} = $self;
252 dbg("Deleting Route::Node $self->{call}") if isdbg('routelow');
253 for ($self->unlink_all_users) {
256 delete $list{$self->{call}};
262 $call = shift if ref $call;
263 my $ref = $list{uc $call};
264 dbg("Failed to get Node $call" ) if !$ref && isdbg('routerr');
277 my $call = $self->{call} || "Unknown";
279 dbg("destroying $pkg with $call") if isdbg('routelow');
280 $self->unlink_all_users if @{$self->{users}};
284 # generic AUTOLOAD for accessors
290 my $name = $AUTOLOAD;
291 return if $name =~ /::DESTROY$/;
294 confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name};
296 # this clever line of code creates a subroutine which takes over from autoload
297 # from OO Perl - Conway
298 *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}};