X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=92ceba22577940c41cbba51faa732bd29834d1ef;hb=598233c22daef138cd7b0a653d3165b4a16905e2;hp=e29fe3caefb1eeb393dd1322ff21f99ee3428888;hpb=6624dcdf07d628e8d6a16fc6549edf40be25b7b2;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index e29fe3ca..92ceba22 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -14,15 +14,23 @@ use Route::User; use strict; +use vars qw($VERSION $BRANCH); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); +$main::build += $VERSION; +$main::branch += $BRANCH; + use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( - parent => '0,Parent Calls,parray', + dxchan => '0,Visible on DXChans,parray', nodes => '0,Nodes,parray', users => '0,Users,parray', usercount => '0,User Count', version => '0,Version', + np => '0,Using New Prot,yesno', + lid => '0,Last Msgid', ); $filterdef = $Route::filterdef; @@ -38,6 +46,7 @@ sub count sub max { + count(); return $max; } @@ -50,22 +59,22 @@ sub max # object with that callsign. The upper layers are expected to do something # sensible with this! # -# called as $parent->add(call, dxchan, version, flags) +# called as $dxchan->add(call, dxchan, version, flags) # sub add { - my $parent = shift; + my $dxchan = shift; my $call = uc shift; - confess "Route::add trying to add $call to myself" if $call eq $parent->{call}; + confess "Route::add trying to add $call to myself" if $call eq $dxchan->{call}; my $self = get($call); if ($self) { - $self->_addparent($parent->{call}); - $parent->_addnode($call); + $self->_adddxchan($dxchan); + $dxchan->_addnode($self); return undef; } - $parent->_addnode($call); - $self = $parent->new($call, @_); + $self = $dxchan->new($call, @_); + $dxchan->_addnode($self); return $self; } @@ -81,15 +90,14 @@ sub del my $self = shift; my $pref = shift; - # delete parent from this call's parent list - my $pcall = $pref->{call}; - my $ncall = $self->{call}; - $pref->_delnode($ncall);; - my $ref = $self->_delparent($pcall); + # delete dxchan from this call's dxchan list + $pref->_delnode($self); + $self->_deldxchan($pref); my @nodes; + my $ncall = $self->{call}; - # is this the last connection, I have no parents anymore? - unless (@$ref) { + # is this the last connection, I have no dxchan anymore? + unless (@{$self->{dxchan}}) { foreach my $rcall (@{$self->{nodes}}) { next if grep $rcall eq $_, @_; my $r = Route::Node::get($rcall); @@ -104,11 +112,11 @@ sub del sub del_nodes { - my $parent = shift; + my $dxchan = shift; my @out; - foreach my $rcall (@{$parent->{nodes}}) { + foreach my $rcall (@{$dxchan->{nodes}}) { my $r = get($rcall); - push @out, $r->del($parent, $parent->{call}, @_) if $r; + push @out, $r->del($dxchan, $dxchan->{call}, @_) if $r; } return @out; } @@ -131,16 +139,17 @@ sub add_user confess "Trying to add NULL User call to routing tables" unless $ucall; - $self->_adduser($ucall); - - $self->{usercount} = scalar @{$self->{users}}; my $uref = Route::User::get($ucall); my @out; if ($uref) { - $uref->addparent($self->{call}); + @out = $uref->adddxchan($self); } else { - @out = Route::User->new($ucall, $self->{call}, @_); + $uref = Route::User->new($ucall, $self->{call}, @_); + @out = $uref; } + $self->_adduser($uref); + $self->{usercount} = scalar @{$self->{users}}; + return @out; } @@ -148,10 +157,16 @@ sub add_user sub del_user { my $self = shift; - my $ucall = shift; - my $ref = Route::User::get($ucall); - $self->_deluser($ucall); - my @out = $ref->del($self) if $ref; + my $ref = shift; + my @out; + + if ($ref) { + @out = $self->_deluser($ref); + $ref->del($self); + } else { + confess "tried to delete non-existant $ref->{call} from $self->{call}"; + } + $self->{usercount} = scalar @{$self->{users}}; return @out; } @@ -198,11 +213,12 @@ sub new confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); - $self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ]; + $self->{dxchan} = ref $pkg ? [ $pkg->{call} ] : [ ]; $self->{version} = shift; $self->{flags} = shift; $self->{users} = []; $self->{nodes} = []; + $self->{lid} = 0; $list{$call} = $self; @@ -223,31 +239,6 @@ sub get_all return values %list; } -sub _addparent -{ - my $self = shift; - return $self->_addlist('parent', @_); -} - -sub _delparent -{ - my $self = shift; - return $self->_dellist('parent', @_); -} - - -sub _addnode -{ - my $self = shift; - return $self->_addlist('nodes', @_); -} - -sub _delnode -{ - my $self = shift; - return $self->_dellist('nodes', @_); -} - sub _adduser { @@ -277,19 +268,16 @@ sub DESTROY sub AUTOLOAD { no strict; - - my $self = shift; - $name = $AUTOLOAD; + my $name = $AUTOLOAD; return if $name =~ /::DESTROY$/; - $name =~ s/.*:://o; + $name =~ s/^.*:://o; confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name}; # this clever line of code creates a subroutine which takes over from autoload # from OO Perl - Conway -# print "AUTOLOAD: $AUTOLOAD\n"; -# *{$AUTOLOAD} = sub {my $self = shift; @_ ? $self->{$name} = shift : $self->{$name}} ; - @_ ? $self->{$name} = shift : $self->{$name} ; + *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}}; + goto &$AUTOLOAD; } 1;