X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FUser.pm;h=3a6f4f327b030a628c9f9a0c8f6309f864de4566;hb=bb3889c1d4930e2ca96b47aea10ce5e803737043;hp=551b32e61dd512dc9fc445068a29b8ee2b45ee44;hpb=d7dbb7fe3680afb068ffc585b1f95690008a9a7d;p=spider.git diff --git a/perl/Route/User.pm b/perl/Route/User.pm index 551b32e6..3a6f4f32 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -3,7 +3,7 @@ # # Copyright (c) 2001 Dirk Koopman G1TLH # -# $Id$ +# # package Route::User; @@ -11,20 +11,20 @@ package Route::User; use DXDebug; use Route; use DXUtil; +use DXJSON; +use Time::HiRes qw(gettimeofday); use strict; use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); -%valid = ( - parent => '0,Parent Calls,parray', -); - $filterdef = $Route::filterdef; %list = (); $max = 0; +our $cachefn = localdata('route_user_cache'); + sub count { my $n = scalar(keys %list); @@ -44,12 +44,16 @@ sub new my $call = uc shift; my $ncall = uc shift; my $flags = shift; + my $ip = shift; + confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); $self->{parent} = [ $ncall ]; $self->{flags} = $flags || Route::here(1); + $self->{ip} = $ip if defined $ip; $list{$call} = $self; + dbg("CLUSTER: user $call added") if isdbg('cluster'); return $self; } @@ -63,9 +67,11 @@ sub del { my $self = shift; my $pref = shift; + my $call = $self->{call}; $self->delparent($pref); unless (@{$self->{parent}}) { - delete $list{$self->{call}}; + delete $list{$call}; + dbg("CLUSTER: user $call deleted") if isdbg('cluster'); return $self; } return undef; @@ -92,6 +98,53 @@ sub delparent return $self->_dellist('parent', @_); } +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 confess("writing $cachefn $!"); + print $fh $_ for (sort @s); + $fh->close; + } else { + dbg("Route::User::write_cache error '$@'"); + return; + } + my $diff = _diffms($ta); + dbg("Route::User::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 confess("reading $cachefn $!"); + while (my $l = <$fh>) { + chomp $l; + my ($k, $v) = split /:/, $l, 2; + $list{$k} = bless $json->decode($v) or confess("json error decoding '$v'"); + ++$count; + } + $fh->close; + + my $diff = _diffms($ta); + dbg("Route::User::read_cache time to read $count records from $cachefn : $diff mS"); +} + # # generic AUTOLOAD for accessors #