X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FUser.pm;h=3a6f4f327b030a628c9f9a0c8f6309f864de4566;hb=bb3889c1d4930e2ca96b47aea10ce5e803737043;hp=bc28dbef511053f809ce75171775d88a8e20feb9;hpb=2b58ccdf81685a1167a43c38705a0d84b9d8d661;p=spider.git diff --git a/perl/Route/User.pm b/perl/Route/User.pm index bc28dbef..3a6f4f32 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -3,33 +3,28 @@ # # Copyright (c) 2001 Dirk Koopman G1TLH # -# $Id$ +# # package Route::User; use DXDebug; use Route; +use DXUtil; +use DXJSON; +use Time::HiRes qw(gettimeofday); 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; - 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); @@ -39,6 +34,7 @@ sub count sub max { + count(); return $max; } @@ -48,24 +44,37 @@ 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; + $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; } +sub get_all +{ + return values %list; +} + sub del { my $self = shift; my $pref = shift; - my $ref = $self->delparent($pref->{call}); - return () if @$ref; - my @out = delete $list{$self->{call}}; - return @out; + my $call = $self->{call}; + $self->delparent($pref); + unless (@{$self->{parent}}) { + delete $list{$call}; + dbg("CLUSTER: user $call deleted") if isdbg('cluster'); + return $self; + } + return undef; } sub get @@ -89,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 # @@ -96,18 +152,17 @@ sub delparent sub AUTOLOAD { no strict; - - my $self = shift; - $name = $AUTOLOAD; - return if $name =~ /::DESTROY$/; - $name =~ s/.*:://o; + my ($pkg,$name) = $AUTOLOAD =~ /^(.*)::(\w+)$/; + return if $name eq 'DESTROY'; 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 -# *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ; - @_ ? $self->{$name} = shift : $self->{$name} ; + *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}}; + goto &$AUTOLOAD; +# *{"${pkg}::$name"} = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}}; +# goto &{"${pkg}::$name"}; } 1;