X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FUser.pm;h=bbd289d292755a0bf89cf3041b0d152d68f21bcf;hb=b55a5be0062fb96613a2f42c25de550d69283b7a;hp=e99def158bcedfa087028790ae74882160c4ed44;hpb=cfa6a715412c7c4972ec85034bd2d945751317cb;p=spider.git diff --git a/perl/Route/User.pm b/perl/Route/User.pm index e99def15..bbd289d2 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -11,6 +11,8 @@ package Route::User; use DXDebug; use Route; use DXUtil; +use DXJSON; +use Time::HiRes qw(gettimeofday); use strict; @@ -21,6 +23,8 @@ $filterdef = $Route::filterdef; %list = (); $max = 0; +our $cachefn = localdata('route_user_cache'); + sub count { my $n = scalar(keys %list); @@ -94,7 +98,36 @@ 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 $!"); + if (isdbg("routecache")) { + $fh->print(sort @s); + } + else { + $fh->print(@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"); +} # # generic AUTOLOAD for accessors