X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=cf847bc897778748295e61aa41d15962a8ef83a3;hb=266e6533b7197dd4887fa77b4a62282191539279;hp=80a9b64167fd767aa5997f8c7ae4ac8113701222;hpb=f87323c2926605792ee02b84783d8f3d4dbd605f;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 80a9b641..cf847bc8 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -32,7 +32,7 @@ $dbm = undef; $filename = undef; $lastoperinterval = 60*24*60*60; $lasttime = 0; -$lrusize = 500; +$lrusize = 2000; # hash of valid elements and a simple prompt %valid = ( @@ -78,6 +78,8 @@ $lrusize = 500; wantann_talk => '0,Talklike Anns,yesno', wantpc90 => '1,Req PC90,yesno', wantnp => '1,Req New Protocol,yesno', + wantpc16 => '9,Want Users from node,yesno', + wantsendpc16 => '9,Send users to node,yesno', lastoper => '9,Last for/oper,cldatetime', nothere => '0,Not Here Text', registered => '9,Registered?,yesno', @@ -86,26 +88,29 @@ $lrusize = 500; build => '1,Build', ); -no strict; +#no strict; sub AUTOLOAD { my $self = shift; + no strict; my $name = $AUTOLOAD; return if $name =~ /::DESTROY$/; - $name =~ s/.*:://o; + $name =~ s/^.*:://o; confess "Non-existant field '$AUTOLOAD'" if !$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}} ; - if (@_) { - $self->{$name} = shift; - } - return $self->{$name}; + *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; + &$AUTOLOAD($self, @_); +# *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ; +# if (@_) { +# $self->{$name} = shift; +# } +# return $self->{$name}; } -use strict; +#use strict; # # initialise the system @@ -117,9 +122,9 @@ sub init confess "need a filename in User" if !$fn; $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 ($!)"; + $dbm = tie (%u, 'DB_File', $fn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]"; } else { - $dbm = tie (%u, 'DB_File', $fn, O_RDONLY, 0666, $DB_BTREE) 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 ($!) [rebuild it from user_asc?]"; } $filename = $fn; @@ -580,6 +585,16 @@ sub wantann_talk return _want('ann_talk', @_); } +sub wantpc16 +{ + return _want('pc16', @_); +} + +sub wantsendpc16 +{ + return _want('sendpc16', @_); +} + sub wantlogininfo { my $self = shift;