X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FUser.pm;h=ebccba9b722b2c7ee3a7f2d0e2d2fc6c0ffe92e9;hb=05a7fdd4a58c51e21b55b0509b054b625839290c;hp=bf72bbb52eb2c7c0d74dc0b963070fb25dcaaf8e;hpb=dbf7523a9b228dbdf1d03109afde351b8b194fab;p=spider.git diff --git a/perl/Route/User.pm b/perl/Route/User.pm index bf72bbb5..ebccba9b 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -23,7 +23,7 @@ use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( - parent => '0,Parent Calls,parray', + dxchan => '0,Dxchan Calls,parray', ); $filterdef = $Route::filterdef; @@ -52,28 +52,24 @@ sub new confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); - $self->{parent} = [ $ncall ]; + $self->{nodes} = [ ]; $self->{flags} = $flags; $list{$call} = $self; + dbg("creating Route::User $self->{call}") if isdbg('routelow'); return $self; } -sub get_all +sub delete { - return values %list; + my $self = shift; + dbg("deleting Route::User $self->{call}") if isdbg('routelow'); + delete $list{$self->{call}}; } -sub del +sub get_all { - my $self = shift; - my $pref = shift; - $self->delparent($pref); - unless (@{$self->{parent}}) { - delete $list{$self->{call}}; - return $self; - } - return undef; + return values %list; } sub get @@ -85,16 +81,33 @@ sub get return $ref; } -sub addparent +# add a user to this node +# returns Route::User if it is a new user; +sub add_node { - my $self = shift; - return $self->_addlist('parent', @_); + my ($self, $nref) = @_; + my $r = $self->is_empty('nodes'); + $self->_addlist('nodes', $nref); + $nref->_addlist('users', $self); + $nref->{usercount} = scalar @{$nref->{users}}; + return $r ? ($self) : (); } -sub delparent +# delete a user from this node +sub del_user +{ + my ($self, $nref) = @_; + + $self->_dellist('nodes', $nref); + $nref->_dellist('users', $self); + $nref->{usercount} = scalar @{$nref->{users}}; + return $self->is_empty('nodes') ? ($self) : (); +} + +sub nodes { my $self = shift; - return $self->_dellist('parent', @_); + return @{$self->{nodes}}; } # @@ -104,18 +117,17 @@ sub delparent sub AUTOLOAD { no strict; - - my $self = shift; - $name = $AUTOLOAD; - return if $name =~ /::DESTROY$/; - $name =~ s/.*:://o; + my ($pkg,$name) = $AUTOLOAD =~ /^(.*)::(\w+)$/; + return if $name eq 'DESTROY'; confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::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}} ; - @_ ? $self->{$name} = shift : $self->{$name} ; + *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}}; + goto &$AUTOLOAD; +# *{"${pkg}::$name"} = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}}; +# goto &{"${pkg}::$name"}; } 1;