X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=e7b18772eadeb0bc91fb99066de18ea40161ceb4;hb=5def24d66561e13e76b7af3109810be21deeeffb;hp=e29fe3caefb1eeb393dd1322ff21f99ee3428888;hpb=6624dcdf07d628e8d6a16fc6549edf40be25b7b2;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index e29fe3ca..e7b18772 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -14,6 +14,10 @@ use Route::User; use strict; +use vars qw($VERSION $BRANCH); + +main::mkver($VERSION = q$Revision$); + use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); @@ -23,6 +27,9 @@ use vars qw(%list %valid @ISA $max $filterdef); users => '0,Users,parray', usercount => '0,User Count', version => '0,Version', + build => '0,Build', + sw => '0,Software', + np => '0,Using New Prot,yesno', ); $filterdef = $Route::filterdef; @@ -38,6 +45,7 @@ sub count sub max { + count(); return $max; } @@ -50,7 +58,7 @@ 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 $parent->add(call, version, flags) # sub add @@ -58,14 +66,22 @@ sub add my $parent = shift; my $call = uc shift; confess "Route::add trying to add $call to myself" if $call eq $parent->{call}; + my $version = shift; + my $here = shift; + my $self = get($call); if ($self) { - $self->_addparent($parent->{call}); - $parent->_addnode($call); + $self->_addparent($parent); + $parent->_addnode($self); + if ($self->{version} != $version || $self->{flags} != $here) { + $self->{version} = $version; + $self->{flags} = $here; + return $self; + } return undef; } - $parent->_addnode($call); - $self = $parent->new($call, @_); + $self = $parent->new($call, $version, $here); + $parent->_addnode($self); return $self; } @@ -82,14 +98,13 @@ sub del 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); + $pref->_delnode($self); + $self->_delparent($pref); my @nodes; + my $ncall = $self->{call}; # is this the last connection, I have no parents anymore? - unless (@$ref) { + unless (@{$self->{parent}}) { foreach my $rcall (@{$self->{nodes}}) { next if grep $rcall eq $_, @_; my $r = Route::Node::get($rcall); @@ -131,16 +146,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}); + push @out, $uref->addparent($self); } else { - @out = Route::User->new($ucall, $self->{call}, @_); + $uref = Route::User->new($ucall, $self->{call}, @_); + push @out, $uref; } + $self->_adduser($uref); + $self->{usercount} = scalar @{$self->{users}}; + return @out; } @@ -148,10 +164,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; } @@ -176,6 +198,31 @@ sub nodes return @{$self->{nodes}}; } +sub parents +{ + my $self = shift; + return @{$self->{parent}}; +} + +sub has_user +{ + my $self = shift; + return $self->_haslist('users', shift); +} + +sub has_node +{ + my $self = shift; + return $self->_haslist('nodes', shift); +} + +sub has_parent +{ + my $self = shift; + return $self->_haslist('parent', shift); +} + + sub rnodes { my $self = shift; @@ -189,6 +236,39 @@ sub rnodes return @out; } +# return the differences in nodes between what we currently have and +# the list proffered. Returns two refs one to a list of nodes to remove and +# the other a list of nodes to add +# +# input is a list of callsigns (not refs) +sub diff_nodes +{ + my $self = shift; + my $in = ref $_[0] ? shift : \@_; + my %del = map {($_, 1)} nodes($self); + my %in = map {($_, 1)} @$in; + + # remove all the calls that are in both lists + for (@$in) { + delete $in{$_} if delete $del{$_}; + } + return ([keys %del], [keys %in]); +} + +# same as above but for users +sub diff_users +{ + my $self = shift; + my $in = ref $_[0] ? shift : \@_; + my %del = map {($_, 1)} users($self); + my %in = map {($_, 1)} @$in; + + # remove all the calls that are in both lists + for (@$in) { + delete $in{$_} if delete $del{$_}; + } + return ([keys %del], [keys %in]); +} sub new { @@ -199,10 +279,11 @@ sub new my $self = $pkg->SUPER::new($call); $self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ]; - $self->{version} = shift; - $self->{flags} = shift; + $self->{version} = 0 || shift; + $self->{flags} = 0 || shift; $self->{users} = []; $self->{nodes} = []; + $self->{lid} = 0; $list{$call} = $self; @@ -223,6 +304,22 @@ sub get_all return values %list; } +sub newid +{ + my $self = shift; + my $id = shift; + + return 0 if $id == $self->{lid}; + if ($id > $self->{lid}) { + $self->{lid} = $id; + return 1; + } elsif ($self->{lid} - $id > 500) { + $self->{id} = $id; + return 1; + } + return 0; +} + sub _addparent { my $self = shift; @@ -261,15 +358,6 @@ sub _deluser return $self->_dellist('users', @_); } -sub DESTROY -{ - my $self = shift; - my $pkg = ref $self; - my $call = $self->{call} || "Unknown"; - - dbg("destroying $pkg with $call") if isdbg('routelow'); -} - # # generic AUTOLOAD for accessors # @@ -277,19 +365,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;