2 # Node routing routines
4 # Copyright (c) 2001 Dirk Koopman G1TLH
17 use vars qw($VERSION $BRANCH);
18 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
19 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\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->unlink_node($neighbour, $dxchan);
92 dbg("Orphanning $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 my ($o) = $r->del_dxchan($dxchan);
103 dbg("Orphanning $o->{call}") if isdbg('routelow');
106 push @in, map{ Route::Node::get($_) } $r->nodes;
107 $visited{$r->call} = $r;
110 # in @rout there should be a list of orphaned (in dxchan terms)
111 # nodes. Now go thru and make sure that all their links are
112 # broken (they should be, but this is to check).
114 foreach my $r (@rout) {
115 my @nodes = map { Route::Node::get($_)} $r->nodes;
118 dbg("Orphaned node $_->{call}: breaking link to $_->{call}") if isdbg('routelow');
125 # add a user to this node
126 # returns Route::User if it is a new user;
129 my ($self, $uref) = @_;
130 my $r = $uref->is_empty('nodes');
131 $self->_addlist('users', $uref);
132 $uref->_addlist('nodes', $self);
133 $self->{usercount} = scalar @{$self->{users}};
134 return $r ? ($uref) : ();
137 # delete a user from this node
140 my ($self, $uref) = @_;
142 $self->_dellist('users', $uref);
143 $uref->_dellist('nodes', $self);
144 $self->{usercount} = scalar @{$self->{users}};
145 return $uref->is_empty('nodes') ? ($uref) : ();
148 # add a single dxchan link
151 my ($self, $dxchan) = @_;
152 return $self->_addlist('dxchan', $dxchan);
155 # remove a single dxchan link
158 my ($self, $dxchan) = @_;
159 $self->_dellist('dxchan', $dxchan);
160 return $self->is_empty('dxchan') ? ($self) : ();
166 if (@_ && @{$self->{users}} == 0) {
167 $self->{usercount} = shift;
169 return $self->{usercount};
175 return @{$self->{users}};
181 return @{$self->{nodes}};
188 foreach my $u (@{$self->{users}}) {
189 my $uref = Route::User::get($u);
190 push @rout, $self->del_user($uref) if $uref;
200 confess "already have $call in $pkg" if $list{$call};
202 my $self = $pkg->SUPER::new($call);
203 $self->{dxchan} = [ ];
204 $self->{version} = shift || 5000;
205 $self->{flags} = shift || Route::here(1);
209 $list{$call} = $self;
210 dbg("creating Route::Node $self->{call}") if isdbg('routelow');
218 dbg("Deleting Route::Node $self->{call}") if isdbg('routelow');
219 for ($self->unlink_all_users) {
222 delete $list{$self->{call}};
228 $call = shift if ref $call;
229 my $ref = $list{uc $call};
230 dbg("Failed to get Node $call" ) if !$ref && isdbg('routerr');
243 my $call = $self->{call} || "Unknown";
245 dbg("destroying $pkg with $call") if isdbg('routelow');
246 $self->unlink_all_users if @{$self->{users}};
250 # generic AUTOLOAD for accessors
256 my $name = $AUTOLOAD;
257 return if $name =~ /::DESTROY$/;
260 confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name};
262 # this clever line of code creates a subroutine which takes over from autoload
263 # from OO Perl - Conway
264 *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}};