X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2FRoute%2FUser.pm;h=88d2aa2a0d0fb5a8e1e8986614a5ef33d9afec07;hb=598233c22daef138cd7b0a653d3165b4a16905e2;hp=d492c27bf7769050d20878c7279f9ef4f7d90512;hpb=6624dcdf07d628e8d6a16fc6549edf40be25b7b2;p=spider.git diff --git a/perl/Route/User.pm b/perl/Route/User.pm index d492c27b..88d2aa2a 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -13,11 +13,17 @@ use Route; 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', + dxchan => '0,Dxchan Calls,parray', ); $filterdef = $Route::filterdef; @@ -33,6 +39,7 @@ sub count sub max { + count(); return $max; } @@ -45,21 +52,28 @@ sub new confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); - $self->{parent} = [ $ncall ]; + $self->{nodes} = [ $ncall ]; $self->{flags} = $flags; $list{$call} = $self; return $self; } +sub get_all +{ + return values %list; +} + sub del { my $self = shift; my $pref = shift; - my $ref = $self->delparent($pref->{call}); - return () if @$ref; - my @out = delete $list{$self->{call}}; - return @out; + $self->deldxchan($pref); + unless (@{$self->{dxchan}}) { + delete $list{$self->{call}}; + return $self; + } + return undef; } sub get @@ -71,18 +85,6 @@ sub get return $ref; } -sub addparent -{ - my $self = shift; - return $self->_addlist('parent', @_); -} - -sub delparent -{ - my $self = shift; - return $self->_dellist('parent', @_); -} - # # generic AUTOLOAD for accessors # @@ -90,18 +92,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;