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',
35 $filterdef = $Route::filterdef;
41 my $n = scalar (keys %list);
42 $max = $n if $n > $max;
52 # link a node to this node and mark the route as available thru
53 # this dxchan, any users must be linked separately
55 # call as $node->link_node($neighbour, $dxchan);
60 my ($self, $neighbour, $dxchan) = @_;
62 my $r = $neighbour->is_empty('dxchan');
63 $self->_addlist('nodes', $neighbour);
64 $neighbour->_addlist('nodes', $self);
65 $neighbour->_addlist('dxchan', $dxchan);
66 return $r ? ($neighbour) : ();
69 # unlink a node from a neighbour and remove any
70 # routes, if this node becomes orphaned (no routes
71 # and no nodes) then return it
76 my ($self, $neighbour, $dxchan) = @_;
77 $self->_dellist('nodes', $neighbour);
78 $neighbour->_dellist('nodes', $self);
79 $neighbour->_dellist('dxchan', $dxchan) if $dxchan;
80 return $neighbour->is_empty('dxchan') ? ($neighbour) : ();
85 my ($self, $neighbour, $dxchan) = @_;
90 push @rout, $self->unlink_node($neighbour, $dxchan);
91 dbg("Orphanning $neighbour->{call}") if isdbg('routelow');
93 # then run down the tree removing this dxchan link from
94 # all the referenced nodes that use this interface
96 my @in = map { Route::Node::get($_) } $neighbour->nodes;
99 next if $visited{$r->call};
100 my ($o) = $r->del_dxchan($dxchan);
102 dbg("Orphanning $o->{call}") if isdbg('routelow');
105 push @in, map{ Route::Node::get($_) } $r->nodes;
106 $visited{$r->call} = $r;
109 # in @rout there should be a list of orphaned (in dxchan terms)
110 # nodes. Now go thru and make sure that all their links are
111 # broken (they should be, but this is to check).
113 foreach my $r (@rout) {
114 my @nodes = map { Route::Node::get($_)} $r->nodes;
117 dbg("Orphaned node $_->{call}: breaking link to $_->{call}") if isdbg('routelow');
124 # add a user to this node
125 # returns Route::User if it is a new user;
128 my ($self, $uref) = @_;
129 my $r = $uref->is_empty('nodes');
130 $self->_addlist('users', $uref);
131 $uref->_addlist('nodes', $self);
132 $self->{usercount} = scalar @{$self->{users}};
133 return $r ? ($uref) : ();
136 # delete a user from this node
139 my ($self, $uref) = @_;
141 $self->_dellist('users', $uref);
142 $uref->_dellist('nodes', $self);
143 $self->{usercount} = scalar @{$self->{users}};
144 return $uref->is_empty('nodes') ? ($uref) : ();
147 # add a single dxchan link
150 my ($self, $dxchan) = @_;
151 return $self->_addlist('dxchan', $dxchan);
154 # remove a single dxchan link
157 my ($self, $dxchan) = @_;
158 $self->_dellist('dxchan', $dxchan);
159 return $self->is_empty('dxchan') ? ($self) : ();
165 if (@_ && @{$self->{users}} == 0) {
166 $self->{usercount} = shift;
168 return $self->{usercount};
174 return @{$self->{users}};
180 return @{$self->{nodes}};
187 foreach my $u (@{$self->{users}}) {
188 my $uref = Route::User::get($u);
189 push @rout, $self->del_user($uref) if $uref;
199 confess "already have $call in $pkg" if $list{$call};
201 my $self = $pkg->SUPER::new($call);
202 $self->{dxchan} = [ ];
203 $self->{version} = shift || 5000;
204 $self->{flags} = shift || Route::here(1);
208 $list{$call} = $self;
209 dbg("creating Route::Node $self->{call}") if isdbg('routelow');
217 dbg("Deleting Route::Node $self->{call}") if isdbg('routelow');
218 for ($self->unlink_all_users) {
221 delete $list{$self->{call}};
227 $call = shift if ref $call;
228 my $ref = $list{uc $call};
229 dbg("Failed to get Node $call" ) if !$ref && isdbg('routerr');
242 my $call = $self->{call} || "Unknown";
244 dbg("destroying $pkg with $call") if isdbg('routelow');
245 $self->unlink_all_users if @{$self->{users}};
249 # generic AUTOLOAD for accessors
255 my $name = $AUTOLOAD;
256 return if $name =~ /::DESTROY$/;
259 confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name};
261 # this clever line of code creates a subroutine which takes over from autoload
262 # from OO Perl - Conway
263 *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}};