X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=6e7d931541c89d48722085be2c8363848e640b93;hb=93292dcd622b1505d2cbab334277c89e7c8afd27;hp=4b08de3b09d1852c29af2fdb4db03580b7a171b1;hpb=7b9256ceade8b18b48f848c9ac659c2de7322b0b;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 4b08de3b..6e7d9315 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -3,8 +3,8 @@ # # Copyright (c) 2001 Dirk Koopman G1TLH # -# $Id$ -# +# +# package Route::Node; @@ -24,12 +24,15 @@ use vars qw(%list %valid @ISA $max $filterdef $obscount); users => '0,Users,parray', usercount => '0,User Count', version => '0,Version', + build => '0,Build', handle_xml => '0,Using XML,yesno', lastmsg => '0,Last Route Msg,atime', lastid => '0,Last Route MsgID', do_pc9x => '0,Uses pc9x,yesno', via_pc92 => '0,Came in via pc92,yesno', obscount => '0,Obscount', + last_PC92C => '9,Last PC92C', + PC92C_dxchan => '9,Channel of PC92C', ); $filterdef = $Route::filterdef; @@ -59,7 +62,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, dxchan, version, flags) # sub add @@ -95,7 +98,7 @@ sub del $self->_delparent($pref); my @nodes; my $ncall = $self->{call}; - + # is this the last connection, I have no parents anymore? unless (@{$self->{parent}}) { foreach my $rcall (@{$self->{nodes}}) { @@ -104,23 +107,35 @@ sub del push @nodes, $r->del($self, $ncall, @_) if $r; } $self->_del_users; - delete $list{$self->{call}}; + delete $list{$ncall}; push @nodes, $self; } return @nodes; } # this deletes this node completely by grabbing the parents -# and deleting me from them +# and deleting me from them, then deleting me from all the +# dependent nodes. sub delete { my $self = shift; my @out; - + my $ncall = $self->{call}; + + # get rid of users and parents $self->_del_users; - foreach my $call (@{$self->{parent}}) { - my $parent = Route::Node::get($call); - push @out, $parent->del($self) if $parent; + if (@{$self->{parent}}) { + foreach my $call (@{$self->{parent}}) { + my $parent = Route::Node::get($call); + push @out, $parent->del($self) if $parent; + } + } + # get rid of my nodes + push @out, $self->del_nodes; + # this only happens if we a orphan with no parents + if ($list{$ncall}) { + push @out, $self; + delete $list{$ncall}; } return @out; } @@ -174,7 +189,7 @@ sub del_user my $self = shift; my $ref = shift; my @out; - + if ($ref) { @out = $self->_deluser($ref); $ref->del($self); @@ -225,10 +240,10 @@ sub rnodes return @out; } -# this takes in a list of node and user calls (not references) from +# this takes in a list of node and user calls (not references) from # a config type update for a node and returns # the differences as lists of things that have gone away -# and things that have been added. +# and things that have been added. sub calc_config_changes { my $self = shift; @@ -262,20 +277,21 @@ sub new { my $pkg = shift; my $call = uc shift; - + confess "already have $call in $pkg" if $list{$call}; - + my $self = $pkg->SUPER::new($call); $self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ]; $self->{version} = shift || 5401; $self->{flags} = shift || Route::here(1); $self->{users} = []; $self->{nodes} = []; - $self->{lastid} = {}; + $self->{lastid} = 0; + $self->{PC92C_dxchan} = ''; $self->reset_obs; # by definition - + $list{$call} = $self; - + return $self; } @@ -344,12 +360,24 @@ sub reset_obs $self->{obscount} = $obscount; } +sub measure_pc9x_t +{ + my $parent = shift; + my $t = shift; + my $lastid = $parent->{lastid}; + if ($lastid) { + return ($t < $lastid) ? $t+86400-$lastid : $t - $lastid; + } else { + return 86400; + } +} + sub DESTROY { my $self = shift; my $pkg = ref $self; my $call = $self->{call} || "Unknown"; - + dbg("destroying $pkg with $call") if isdbg('routelow'); } @@ -363,7 +391,7 @@ sub AUTOLOAD my $name = $AUTOLOAD; return if $name =~ /::DESTROY$/; $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