perl/Route/User.pm

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