X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=bd69d3d77290947af5089a73484ebc339cddbfe1;hb=9311d6940faf0e9952d6d65d9ead572b06a52434;hp=ff3351b3d6aaac0ea698b3e3ca3f12ec0dac7e65;hpb=148f4d43135748ba5aff985c50720b370ca1e336;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index ff3351b3..bd69d3d7 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -15,10 +15,8 @@ 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; -$main::build += $VERSION; -$main::branch += $BRANCH; + +main::mkver($VERSION = q$Revision$); use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); @@ -29,8 +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', - lid => '0,Last Msgid', ); $filterdef = $Route::filterdef; @@ -59,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 @@ -67,13 +66,21 @@ 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); $parent->_addnode($self); + if ($self->{version} != $version || $self->{flags} != $here) { + $self->{version} = $version; + $self->{flags} = $here; + return $self; + } return undef; } - $self = $parent->new($call, @_); + $self = $parent->new($call, $version, $here); $parent->_addnode($self); return $self; } @@ -142,10 +149,10 @@ sub add_user my $uref = Route::User::get($ucall); my @out; if ($uref) { - @out = $uref->addparent($self); + push @out, $uref->addparent($self); } else { $uref = Route::User->new($ucall, $self->{call}, @_); - @out = $uref; + push @out, $uref; } $self->_adduser($uref); $self->{usercount} = scalar @{$self->{users}}; @@ -210,6 +217,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 { @@ -220,8 +260,8 @@ 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; @@ -254,7 +294,7 @@ sub newid if ($id > $self->{lid}) { $self->{lid} = $id; return 1; - } elsif ($self->{lid} - $id > 60000) { + } elsif ($self->{lid} - $id > 500) { $self->{id} = $id; return 1; } @@ -315,19 +355,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;