X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=2350f86f062dacbd0218e8f4a2c53f67a00df042;hb=eb2a2eb1aa8e7c743c23ec5e0dc5aa40a8708e79;hp=1fbd8f71a291a1cddab0b6c71430bea16c1610cb;hpb=dbf7523a9b228dbdf1d03109afde351b8b194fab;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 1fbd8f71..2350f86f 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,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; @@ -210,6 +209,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 +252,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 +286,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 +347,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;