X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=9ebc31d934c9bea25a55aaa49b2b7318a1844929;hb=1728c7c7a64eaf2852c490629f022c7e70bc46e2;hp=c84598afad795680582b5fab55d9ccbff9a99567;hpb=28adf81497391e90c2c46201f7f3bc23986251fb;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index c84598af..9ebc31d9 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -11,7 +11,7 @@ package DXUser; require Exporter; @ISA = qw(Exporter); -use MLDBM qw(DB_File); +use DB_File; use Fcntl; use Carp; @@ -76,10 +76,11 @@ sub init my ($pkg, $fn, $mode) = @_; confess "need a filename in User" if !$fn; + $fn .= ".new"; if ($mode) { - $dbm = tie (%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666) or confess "can't open user file: $fn ($!)"; + $dbm = tie (%u, 'DB_File', $fn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!)"; } else { - $dbm = tie (%u, MLDBM, $fn, O_RDONLY) or confess "can't open user file: $fn ($!)"; + $dbm = tie (%u, 'DB_File', $fn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!)"; } $filename = $fn; @@ -93,7 +94,6 @@ use strict; sub finish { - $dbm = undef; untie %u; } @@ -115,7 +115,7 @@ sub new $self->{dxok} = 1; $self->{annok} = 1; $self->{lang} = $main::lang; - $u{call} = $self; + $u{call} = $self->encode(); return $self; } @@ -129,7 +129,8 @@ sub get my $pkg = shift; my $call = uc shift; # $call =~ s/-\d+$//o; # strip ssid - return $u{$call}; + my $s = $u{$call}; + return $s ? decode($s) : undef; } # @@ -157,7 +158,8 @@ sub get_current my $dxchan = DXChannel->get($call); return $dxchan->user if $dxchan; - return $u{$call}; + my $s = $u{$call}; + return $s ? decode($s) : undef; } # @@ -168,7 +170,49 @@ sub put { my $self = shift; my $call = $self->{call}; - $u{$call} = $self; + $u{$call} = $self->encode(); +} + +# +# create a string from a user reference +# +sub encode +{ + my $self = shift; + my $out; + my $f; + + $out = "bless( { "; + for $f (sort keys %$self) { + my $val = $$self{$f}; + if (ref $val) { # it's an array (we think) + $out .= "'$f'=>[ "; + foreach (@$val) { + my $s = $_; + $out .= "'$s',"; + } + $out .= " ],"; + } else { + $val =~ s/'/\\'/og; + $val =~ s/\@/\\@/og; + $out .= "'$f'=>q{$val},"; + } + } + $out .= " }, 'DXUser')"; + return $out; +} + +# +# create a hash from a string +# +sub decode +{ + my $s = shift; + my $ref; + $s = '$ref = ' . $s; + eval $s; + confess $@ if $@; + return $ref; } #