]> www.dxcluster.org Git - spider.git/blob - perl/Route/User.pm
tidy up Route, add argument to sh/ver
[spider.git] / perl / Route / User.pm
1 #
2 # User routing routines
3 #
4 # Copyright (c) 2001 Dirk Koopman G1TLH
5 #
6 #
7
8
9 package Route::User;
10
11 use DXDebug;
12 use Route;
13 use DXUtil;
14
15 use strict;
16
17 use vars qw(%list %valid @ISA $max $filterdef);
18 @ISA = qw(Route);
19
20 $filterdef = $Route::filterdef;
21 %list = ();
22 $max = 0;
23
24 sub count
25 {
26         my $n = scalar(keys %list);
27         $max = $n if $n > $max;
28         return $n;
29 }
30
31 sub max
32 {
33         count();
34         return $max;
35 }
36
37 sub new
38 {
39         my $pkg = shift;
40         my $call = uc shift;
41         my $ncall = uc shift;
42         my $flags = shift;
43         my $ip = shift;
44
45         confess "already have $call in $pkg" if $list{$call};
46         
47         my $self = $pkg->SUPER::new($call);
48         $self->{parent} = [ $ncall ];
49         $self->{flags} = $flags || Route::here(1);
50         $self->{ip} = $ip if defined $ip;
51         $list{$call} = $self;
52         dbg("CLUSTER: user $call added") if isdbg('cluster');
53
54         return $self;
55 }
56
57 sub get_all
58 {
59         return values %list;
60 }
61
62 sub del
63 {
64         my $self = shift;
65         my $pref = shift;
66         my $call = $self->{call};
67         $self->delparent($pref);
68         unless (@{$self->{parent}}) {
69                 delete $list{$call};
70                 dbg("CLUSTER: user $call deleted") if isdbg('cluster');
71                 return $self;
72         }
73         return undef;
74 }
75
76 sub get
77 {
78         my $call = shift;
79         $call = shift if ref $call;
80         my $ref = $list{uc $call};
81         dbg("Failed to get User $call" ) if !$ref && isdbg('routerr');
82         return $ref;
83 }
84
85 sub addparent
86 {
87         my $self = shift;
88     return $self->_addlist('parent', @_);
89 }
90
91 sub delparent
92 {
93         my $self = shift;
94     return $self->_dellist('parent', @_);
95 }
96
97
98
99 #
100 # generic AUTOLOAD for accessors
101 #
102
103 sub AUTOLOAD
104 {
105         no strict;
106         my ($pkg,$name) = $AUTOLOAD =~ /^(.*)::(\w+)$/;
107         return if $name eq 'DESTROY';
108   
109         confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name};
110
111         # this clever line of code creates a subroutine which takes over from autoload
112         # from OO Perl - Conway
113         *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}};
114         goto &$AUTOLOAD;        
115 #       *{"${pkg}::$name"} = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}};
116 #       goto &{"${pkg}::$name"};        
117 }
118
119 1;