X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FUser.pm;h=eb9958dcff28999b25e3023f596a174aa643396f;hb=942cdc8c6434db4e2cf77b43ec26c0059768f853;hp=4e3e59cf7f7ccae64502c5a566653ba7750318a1;hpb=b67b50de92dbf61ce939b42f7c74e30dc58eba41;p=spider.git diff --git a/perl/Route/User.pm b/perl/Route/User.pm index 4e3e59cf..eb9958dc 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -13,25 +13,33 @@ use Route; use strict; -use vars qw(%list %valid @ISA $max); +use vars qw($VERSION $BRANCH); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); +$main::build += $VERSION; +$main::branch += $BRANCH; + +use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( parent => '0,Parent Calls,parray', ); +$filterdef = $Route::filterdef; %list = (); $max = 0; sub count { - my $n = scalar %list; + my $n = scalar(keys %list); $max = $n if $n > $max; return $n; } sub max { + count(); return $max; } @@ -41,31 +49,47 @@ sub new 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->{parent} = [ $ncall ]; $self->{flags} = $flags; - $list{$call} = $self; return $self; } +sub register +{ + my $self = shift; + + confess "already have $call in $pkg" if $list{$self->{call}}; + + $list{$call} = $self; +} + +sub get_all +{ + return values %list; +} + sub del { my $self = shift; my $pref = shift; - my $ref = $self->delparent($pref->{call}); - return () if @$ref; - delete $list{$self->{call}}; - return ($ref); + $self->delparent($pref); + unless (@{$self->{parent}}) { + delete $list{$self->{call}}; + return $self; + } + return undef; } sub get { my $call = shift; $call = shift if ref $call; - return $list{uc $call}; + my $ref = $list{uc $call}; + dbg("Failed to get User $call" ) if !$ref && isdbg('routerr'); + return $ref; } sub addparent @@ -95,10 +119,8 @@ sub AUTOLOAD 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 {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; + &$AUTOLOAD($self, @_); } 1;