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($VERSION $BRANCH);
  17 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  18 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  19 $main::build += $VERSION;
  20 $main::branch += $BRANCH;
  21
  22 use vars qw(%list %valid @ISA $max $filterdef);
  23 @ISA = qw(Route);
  24
  25 %valid = (
  26                   dxchan => '0,Dxchan List,parray',
  27                   nodes => '0,On Node(s),parray',
  28 );
  29
  30 $filterdef = $Route::filterdef;
  31 %list = ();
  32 $max = 0;
  33
  34 sub count
  35 {
  36         my $n = scalar(keys %list);
  37         $max = $n if $n > $max;
  38         return $n;
  39 }
  40
  41 sub max
  42 {
  43         count();
  44         return $max;
  45 }
  46
  47 sub new
  48 {
  49         my $pkg = shift;
  50         my $call = uc shift;
  51         my $ncall = uc shift;
  52         my $flags = shift || Route::here(1);
  53         confess "already have $call in $pkg" if $list{$call};
  54
  55         my $self = $pkg->SUPER::new($call);
  56         $self->{nodes} = [ ];
  57         $self->{flags} = $flags;
  58         $list{$call} = $self;
  59         dbg("creating Route::User $self->{call}") if isdbg('routelow');
  60
  61         return $self;
  62 }
  63
  64 sub delete
  65 {
  66         my $self = shift;
  67         dbg("deleting Route::User $self->{call}") if isdbg('routelow');
  68         delete $list{$self->{call}};
  69 }
  70
  71 sub get_all
  72 {
  73         return values %list;
  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 # add a user to this node
  86 # returns Route::User if it is a new user;
  87 sub add_node
  88 {
  89         my ($self, $nref) = @_;
  90         my $r = $self->is_empty('nodes');
  91         $self->_addlist('nodes', $nref);
  92         $nref->_addlist('users', $self);
  93         $nref->{usercount} = scalar @{$nref->{users}};
  94         return $r ? ($self) : ();
  95 }
  96
  97 # delete a user from this node
  98 sub del_user
  99 {
 100         my ($self, $nref) = @_;
 101
 102         $self->_dellist('nodes', $nref);
 103         $nref->_dellist('users', $self);
 104         $nref->{usercount} = scalar @{$nref->{users}};
 105         return $self->is_empty('nodes') ? ($self) : ();
 106 }
 107
 108 sub nodes
 109 {
 110         my $self = shift;
 111         return @{$self->{nodes}};
 112 }
 113
 114 #
 115 # generic AUTOLOAD for accessors
 116 #
 117
 118 sub AUTOLOAD
 119 {
 120         no strict;
 121         my ($pkg,$name) = $AUTOLOAD =~ /^(.*)::(\w+)$/;
 122         return if $name eq 'DESTROY';
 123
 124         confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name};
 125
 126         # this clever line of code creates a subroutine which takes over from autoload
 127         # from OO Perl - Conway
 128         *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}};
 129         goto &$AUTOLOAD;
 130 #       *{"${pkg}::$name"} = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}};
 131 #       goto &{"${pkg}::$name"};
 132 }
 133
 134 1;