X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FUser.pm;h=8c1c824de5f58d4bf5e389aee4b40d675f259c65;hb=4b207544da78b182bd12e94eab01451694749012;hp=bf72bbb52eb2c7c0d74dc0b963070fb25dcaaf8e;hpb=dbf7523a9b228dbdf1d03109afde351b8b194fab;p=spider.git diff --git a/perl/Route/User.pm b/perl/Route/User.pm index bf72bbb5..8c1c824d 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -3,29 +3,20 @@ # # Copyright (c) 2001 Dirk Koopman G1TLH # -# $Id$ +# # package Route::User; use DXDebug; use Route; +use DXUtil; 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,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; @@ -49,12 +40,16 @@ sub new my $call = uc shift; my $ncall = uc shift; my $flags = shift; + my $ip = shift; + confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); $self->{parent} = [ $ncall ]; - $self->{flags} = $flags; + $self->{flags} = $flags || Route::here(1); + $self->{ip} = $ip if defined $ip; $list{$call} = $self; + dbg("CLUSTER: user $call added") if isdbg('cluster'); return $self; } @@ -68,9 +63,11 @@ sub del { my $self = shift; my $pref = shift; + my $call = $self->{call}; $self->delparent($pref); unless (@{$self->{parent}}) { - delete $list{$self->{call}}; + delete $list{$call}; + dbg("CLUSTER: user $call deleted") if isdbg('cluster'); return $self; } return undef; @@ -104,18 +101,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;