X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=af01a1d22d47ce199478c7ac9e394c7783b2c55c;hb=e84886994919a824161f95f0bd0f0e0cae0c5050;hp=d2105f8f6b6bcf57aea77391344f243c7af3681e;hpb=fb9c2ab04977b4e685b0eca3b2a2d04a77f65f4b;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index d2105f8f..af01a1d2 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -12,6 +12,8 @@ use DXDebug; use Route; use Route::User; use DXUtil; +use DXJSON; +use Time::HiRes qw(gettimeofday); use strict; @@ -19,26 +21,27 @@ use vars qw(%list %valid @ISA $max $filterdef $obscount); @ISA = qw(Route); %valid = ( - parent => '0,Parent Calls,parray', - nodes => '0,Nodes,parray', - users => '0,Users,parray', - usercount => '0,User Count', - version => '0,Version', + K => '9,Seen on PC92K,yesno', + PC92C_dxchan => '9,PC92C hops,phash', build => '0,Build', + do_pc9x => '0,Uses pc9x,yesno', handle_xml => '0,Using XML,yesno', - lastmsg => '0,Last Route Msg,atime', + last_PC92C => '9,Last PC92C', lastid => '0,Last Route MsgID', - do_pc9x => '0,Uses pc9x,yesno', - via_pc92 => '0,Came in via pc92,yesno', + lastmsg => '0,Last Route Msg,atime', + nodes => '0,Nodes,parray', obscount => '0,Obscount', - last_PC92C => '9,Last PC92C', - PC92C_dxchan => '9,Channel of PC92C', + usercount => '0,User Count', + users => '0,Users,parray', + version => '0,Version', + via_pc92 => '0,In via pc92?,yesno', ); $filterdef = $Route::filterdef; %list = (); $max = 0; $obscount = 3; +our $cachefn = localdata('route_node_cache'); sub count { @@ -78,6 +81,7 @@ sub add } $self = $parent->new($call, @_); $parent->_addnode($self); + dbg("CLUSTER: node $call added") if isdbg('cluster'); return $self; } @@ -109,6 +113,7 @@ sub del $self->_del_users; delete $list{$ncall}; push @nodes, $self; + dbg("CLUSTER: node $ncall deleted") if isdbg('cluster'); } return @nodes; } @@ -166,6 +171,8 @@ sub add_user { my $self = shift; my $ucall = shift; + my $here = shift; + my $ip = shift; confess "Trying to add NULL User call to routing tables" unless $ucall; @@ -174,7 +181,7 @@ sub add_user if ($uref) { @out = $uref->addparent($self); } else { - $uref = Route::User->new($ucall, $self->{call}, @_); + $uref = Route::User->new($ucall, $self->{call}, $here, $ip); @out = $uref; } $self->_adduser($uref); @@ -200,6 +207,14 @@ sub del_user return @out; } +# is a user on this node +sub is_user +{ + my $self = shift; + my $call = shift; + return scalar grep {$_ eq $call} @{$self->{users}}; +} + sub usercount { my $self = shift; @@ -221,12 +236,6 @@ sub nodes return @{$self->{nodes}}; } -sub parents -{ - my $self = shift; - return @{$self->{parent}}; -} - sub rnodes { my $self = shift; @@ -273,6 +282,7 @@ sub calc_config_changes return (\@dnodes, \@dusers, \@nnodes, \@nusers); } + sub new { my $pkg = shift; @@ -286,8 +296,9 @@ sub new $self->{flags} = shift || Route::here(1); $self->{users} = []; $self->{nodes} = []; - $self->{lastid} = {}; - $self->{PC92C_dxchan} = ''; + $self->{PC92C_dxchan} = {}; + my $ip = shift; + $self->{ip} = $ip if defined $ip; $self->reset_obs; # by definition $list{$call} = $self; @@ -300,7 +311,7 @@ sub get my $call = shift; $call = shift if ref $call; my $ref = $list{uc $call}; - dbg("Failed to get Node $call" ) if !$ref && isdbg('routerr'); + dbg("ROUTE: Failed to get Node $call" ) if !$ref && isdbg('routerr'); return $ref; } @@ -360,13 +371,86 @@ 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 PC92C_dxchan +{ + my $parent = shift; + my $call = shift; + my $hops = shift; + if ($call && $hops) { + $hops =~ s/^H//; + $parent->{PC92C_dxchan}->{$call} = $hops; + return; + } + return (%{$parent->{PC92C_dxchan}}); +} + +sub TO_JSON { return { %{ shift() } }; } + +sub write_cache +{ + my $json = DXJSON->new; + $json->canonical(isdbg('routecache')); + + my $ta = [ gettimeofday ]; + my @s; + eval { + while (my ($k, $v) = each %list) { + push @s, "$k:" . $json->encode($v) . "\n"; + } + }; + if (!$@ && @s) { + my $fh = IO::File->new(">$cachefn") or dbg("Route::Node: Error writing $cachefn $!"), return; + print $fh "$_" for (sort @s); + $fh->close; + } else { + dbg("Route::Node::write_cache error '$@'"); + return; + } + $json->indent(0)->canonical(0); + my $diff = _diffms($ta); + dbg("Route::Node::write_cache time to write: $diff mS"); +} + +sub read_cache +{ + my $json = DXJSON->new; + $json->canonical(isdbg('routecache')); + + my $ta = [ gettimeofday ]; + my $count; + + my $fh = IO::File->new("$cachefn") or dbg("Route::Node ERROR reading $cachefn $!"), return; + while (my $l = <$fh>) { + chomp $l; + my ($k, $v) = split /:/, $l, 2; + $list{$k} = bless $json->decode($v) or carp("Route::Node json error $! decoding '$v'"), next; + ++$count; + } + $fh->close if $fh;; + + my $diff = _diffms($ta); + dbg("Route::Node::read_cache time to read $count records from $cachefn : $diff mS"); +} + sub DESTROY { my $self = shift; my $pkg = ref $self; my $call = $self->{call} || "Unknown"; - dbg("destroying $pkg with $call") if isdbg('routelow'); + dbg("ROUTE: destroying $pkg with $call") if isdbg('routelow'); } #