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         return $max;
  37 }
  38
  39 sub new
  40 {
  41         my $pkg = shift;
  42         my $call = uc shift;
  43         my $ncall = uc shift;
  44         my $flags = shift;
  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;
  50         $list{$call} = $self;
  51
  52         return $self;
  53 }
  54
  55 sub del
  56 {
  57         my $self = shift;
  58         my $pref = shift;
  59         my $ref = $self->delparent($pref->{call});
  60         return () if @$ref;
  61         my @out = delete $list{$self->{call}};
  62         return @out;
  63 }
  64
  65 sub get
  66 {
  67         my $call = shift;
  68         $call = shift if ref $call;
  69         my $ref = $list{uc $call};
  70         dbg("Failed to get User $call" ) if !$ref && isdbg('routerr');
  71         return $ref;
  72 }
  73
  74 sub addparent
  75 {
  76         my $self = shift;
  77     return $self->_addlist('parent', @_);
  78 }
  79
  80 sub delparent
  81 {
  82         my $self = shift;
  83     return $self->_dellist('parent', @_);
  84 }
  85
  86 #
  87 # generic AUTOLOAD for accessors
  88 #
  89
  90 sub AUTOLOAD
  91 {
  92         no strict;
  93
  94         my $self = shift;
  95         $name = $AUTOLOAD;
  96         return if $name =~ /::DESTROY$/;
  97         $name =~ s/.*:://o;
  98
  99         confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name};
 100
 101         # this clever line of code creates a subroutine which takes over from autoload
 102         # from OO Perl - Conway
 103 #       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
 104     @_ ? $self->{$name} = shift : $self->{$name} ;
 105 }
 106
 107 1;