X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FUser.pm;h=df74346236e9372de3739742d15869fdde6bfb36;hb=aff3103d753ce167d1a056eb982391bd4fcbb5cb;hp=bcd98a00ed3e591c86a995ad3f8c8be1abebd794;hpb=412fb1b9e4070d7791f4e986b55bbc0c06f612ea;p=spider.git diff --git a/perl/Route/User.pm b/perl/Route/User.pm index bcd98a00..df743462 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -15,7 +15,7 @@ use strict; use vars qw($VERSION $BRANCH); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); $main::build += $VERSION; $main::branch += $BRANCH; @@ -23,7 +23,7 @@ use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( - parent => '0,Parent Calls,parray', + links => '0,Parent Calls,parray', ); $filterdef = $Route::filterdef; @@ -52,7 +52,7 @@ sub new confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); - $self->{parent} = [ $ncall ]; + $self->{links} = [ $ncall ]; $self->{flags} = $flags; $list{$call} = $self; @@ -69,7 +69,7 @@ sub del my $self = shift; my $pref = shift; $self->delparent($pref); - unless (@{$self->{parent}}) { + unless (@{$self->{links}}) { delete $list{$self->{call}}; return $self; } @@ -87,14 +87,18 @@ sub get sub addparent { - my $self = shift; - return $self->_addlist('parent', @_); + goto &Route::_addlink; } sub delparent +{ + goto &Route::_dellink; +} + +sub parents { my $self = shift; - return $self->_dellist('parent', @_); + return @{$self->{links}}; } # @@ -104,18 +108,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;