X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=49745722ffd29ae51badd4e665a9f192853a8d00;hb=91cb091ed723c5650202345ae9c4f0277e36f0a8;hp=2bd140348cf1994163ace77be621310475c0c0fd;hpb=6c38bca91e6b75002e15cce29c45a894f675e22e;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 2bd14034..49745722 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -19,11 +19,13 @@ use IO::File; use DXDebug; use strict; -use vars qw(%u $dbm $filename %valid); +use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime); %u = (); $dbm = undef; $filename = undef; +$lastoperinterval = 30*24*60*60; +$lasttime = 0; # hash of valid elements and a simple prompt %valid = ( @@ -104,6 +106,17 @@ sub init use strict; +# +# periodic processing +# +sub process +{ + if ($main::systime > $lasttime + 15) { + $dbm->sync; + $lasttime = $main::systime; + } +} + # # close the system # @@ -142,18 +155,11 @@ sub get { my $pkg = shift; my $call = uc shift; - # $call =~ s/-\d+$//o; # strip ssid - my $s = $u{$call}; - return $s ? decode($s) : undef; -} - -# -# get all callsigns in the database -# - -sub get_all_calls -{ - return (sort keys %u); + my $data; + unless ($dbm->get($call, $data)) { + return decode($data); + } + return undef; } # @@ -168,11 +174,23 @@ sub get_current { my $pkg = shift; my $call = uc shift; - # $call =~ s/-\d+$//o; # strip ssid my $dxchan = DXChannel->get($call); return $dxchan->user if $dxchan; - return get($pkg, $call); + my $data; + unless ($dbm->get($call, $data)) { + return decode($data); + } + return undef; +} + +# +# get all callsigns in the database +# + +sub get_all_calls +{ + return (sort keys %u); } # @@ -190,8 +208,7 @@ sub put } delete $self->{annok} if $self->{annok}; delete $self->{dxok} if $self->{dxok}; - $u{$call} = $self->encode(); - $dbm->sync; + $dbm->put($call, $self->encode); } # @@ -214,10 +231,12 @@ sub decode { my $s = shift; my $ref; - $s = '$ref = ' . $s; - eval $s; - Log('DXUser', $@) if $@; - $ref = undef if $@; + eval '$ref = ' . $s; + if ($@) { + dbg('err', $@) if $@; + Log('err', $@) if $@; + $ref = undef; + } return $ref; } @@ -233,7 +252,6 @@ sub del for ($dbm->get_dup($call)) { $dbm->del_dup($call, $_); } - $dbm->sync; } # @@ -247,6 +265,15 @@ sub close $self->put(); } +# +# sync the database +# + +sub sync +{ + $dbm->sync; +} + # # return a list of valid elements #