X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=fc2dab5c7a64106a7a30e1262fbcb7466b2b58bc;hb=89ab02190d47c949e48b303260055f00591e3cdd;hp=9ebc31d934c9bea25a55aaa49b2b7318a1844929;hpb=1728c7c7a64eaf2852c490629f022c7e70bc46e2;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 9ebc31d9..fc2dab5c 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -11,6 +11,7 @@ package DXUser; require Exporter; @ISA = qw(Exporter); +use DXLog; use DB_File; use Fcntl; use Carp; @@ -49,6 +50,12 @@ $filename = undef; hmsgno => '0,Highest Msgno', group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other isolate => '9,Isolate network,yesno', + wantbeep => '0,Rec Beep,yesno', + wantann => '0,Rec Announce,yesno', + wantwwv => '0,Rec WWV,yesno', + wanttalk => '0,Rec Talk,yesno', + wantwx => '0,Rec WX,yesno', + wantdx => '0,Rec DX Spots,yesno', ); no strict; @@ -63,7 +70,6 @@ sub AUTOLOAD confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; if (@_) { $self->{$name} = shift; - # $self->put(); } return $self->{$name}; } @@ -76,7 +82,7 @@ sub init my ($pkg, $fn, $mode) = @_; confess "need a filename in User" if !$fn; - $fn .= ".new"; + $fn .= ".v2"; if ($mode) { $dbm = tie (%u, 'DB_File', $fn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!)"; } else { @@ -94,6 +100,7 @@ use strict; sub finish { + undef $dbm; untie %u; } @@ -107,7 +114,7 @@ sub new my $call = uc shift; # $call =~ s/-\d+$//o; - confess "can't create existing call $call in User\n!" if $u{$call}; +# confess "can't create existing call $call in User\n!" if $u{$call}; my $self = bless {}, $pkg; $self->{call} = $call; @@ -211,7 +218,8 @@ sub decode my $ref; $s = '$ref = ' . $s; eval $s; - confess $@ if $@; + Log('DXUser', $@) if $@; + $ref = undef if $@; return $ref; } @@ -323,5 +331,41 @@ sub sort my $self = shift; @_ ? $self->{'sort'} = shift : $self->{'sort'} ; } + +# some accessors +sub _want +{ + my $n = shift; + my $self = shift; + my $s = "want$n"; + return $self->{$n} = shift if @_; + return defined $self->{$n} ? $self->{$n} : 1; +} + +sub wantbeep +{ + return _want('beep', @_); +} + +sub wantann +{ + return _want('ann', @_); +} + +sub wantwwv +{ + return _want('wwv', @_); +} + +sub wantwx +{ + return _want('wx', @_); +} + +sub wantdx +{ + return _want('dx', @_); +} + 1; __END__