X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FUser.pm;fp=perl%2FRoute%2FUser.pm;h=4e3e59cf7f7ccae64502c5a566653ba7750318a1;hb=b67b50de92dbf61ce939b42f7c74e30dc58eba41;hp=274b26fee0e45fde0ed1a82a7fec8e931964bb18;hpb=c33a59698b9c2a7c319200620765d37706e12c5f;p=spider.git diff --git a/perl/Route/User.pm b/perl/Route/User.pm index 274b26fe..4e3e59cf 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -13,28 +13,54 @@ use Route; use strict; -use vars qw(%list %valid @ISA); +use vars qw(%list %valid @ISA $max); @ISA = qw(Route); %valid = ( - node => '0,Node Calls,parray', + parent => '0,Parent Calls,parray', ); %list = (); +$max = 0; + +sub count +{ + my $n = scalar %list; + $max = $n if $n > $max; + return $n; +} + +sub max +{ + return $max; +} sub new { my $pkg = shift; my $call = uc shift; + my $ncall = uc shift; + my $flags = shift; confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); - $self->{node} = [ ]; + $self->{parent} = [ $ncall ]; + $self->{flags} = $flags; $list{$call} = $self; - + return $self; } +sub del +{ + my $self = shift; + my $pref = shift; + my $ref = $self->delparent($pref->{call}); + return () if @$ref; + delete $list{$self->{call}}; + return ($ref); +} + sub get { my $call = shift; @@ -42,16 +68,37 @@ sub get return $list{uc $call}; } -sub addnode +sub addparent +{ + my $self = shift; + return $self->_addlist('parent', @_); +} + +sub delparent { my $self = shift; - $self->_addlist('node', @_); + return $self->_dellist('parent', @_); } -sub delnode +# +# generic AUTOLOAD for accessors +# + +sub AUTOLOAD { + no strict; + my $self = shift; - $self->_dellist('node', @_); + $name = $AUTOLOAD; + return if $name =~ /::DESTROY$/; + $name =~ s/.*:://o; + + 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} ; } 1;