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         return $list{uc $call};
  70 }
  71
  72 sub addparent
  73 {
  74         my $self = shift;
  75     return $self->_addlist('parent', @_);
  76 }
  77
  78 sub delparent
  79 {
  80         my $self = shift;
  81     return $self->_dellist('parent', @_);
  82 }
  83
  84 #
  85 # generic AUTOLOAD for accessors
  86 #
  87
  88 sub AUTOLOAD
  89 {
  90         no strict;
  91
  92         my $self = shift;
  93         $name = $AUTOLOAD;
  94         return if $name =~ /::DESTROY$/;
  95         $name =~ s/.*:://o;
  96
  97         confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name};
  98
  99         # this clever line of code creates a subroutine which takes over from autoload
 100         # from OO Perl - Conway
 101 #       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
 102     @_ ? $self->{$name} = shift : $self->{$name} ;
 103 }
 104
 105 1;