perl/DXCluster.pm

   1 #
   2 # DX database control routines
   3 #
   4 # This manages the on-line cluster user 'database'
   5 #
   6 # This should all be pretty trees and things, but for now I
   7 # just can't be bothered. If it becomes an issue I shall
   8 # address it.
   9 #
  10 # Copyright (c) 1998 - Dirk Koopman G1TLH
  11 #
  12 # $Id$
  13 #
  14
  15 package DXCluster;
  16
  17 use Exporter;
  18 @ISA = qw(Exporter);
  19 use Carp;
  20 use DXDebug;
  21
  22 use strict;
  23 use vars qw(%cluster %valid);
  24
  25 %cluster = ();            # this is where we store the dxcluster database
  26
  27 %valid = (
  28   mynode => '0,Parent Node,showcall',
  29   call => '0,Callsign',
  30   confmode => '0,Conference Mode,yesno',
  31   here => '0,Here?,yesno',
  32   dxchan => '5,Channel ref',
  33   pcversion => '5,Node Version',
  34   list => '5,User List,dolist',
  35   users => '0,No of Users',
  36 );
  37
  38 sub alloc
  39 {
  40   my ($pkg, $dxchan, $call, $confmode, $here) = @_;
  41   die "$call is already alloced" if $cluster{$call};
  42   my $self = {};
  43   $self->{call} = $call;
  44   $self->{confmode} = $confmode;
  45   $self->{here} = $here;
  46   $self->{dxchan} = $dxchan;
  47
  48   $cluster{$call} = bless $self, $pkg;
  49   return $self;
  50 }
  51
  52 # search for a call in the cluster
  53 sub get
  54 {
  55   my ($pkg, $call) = @_;
  56   return $cluster{$call};
  57 }
  58
  59 # get all
  60 sub get_all
  61 {
  62   return values(%cluster);
  63 }
  64
  65 # return a prompt for a field
  66 sub field_prompt
  67 {
  68   my ($self, $ele) = @_;
  69   return $valid{$ele};
  70 }
  71
  72 # this expects a reference to a list in a node NOT a ref to a node
  73 sub dolist
  74 {
  75   my $self = shift;
  76   my $out;
  77   my $ref;
  78
  79   foreach $ref (@{$self}) {
  80     my $s = $ref->{call};
  81         $s = "($s)" if !$ref->{here};
  82         $out .= "$s ";
  83   }
  84   chop $out;
  85   return $out;
  86 }
  87
  88 # this expects a reference to a node
  89 sub showcall
  90 {
  91   my $self = shift;
  92   return $self->{call};
  93 }
  94
  95 sub DESTROY
  96 {
  97   my $self = shift;
  98   dbg('cluster', "destroying $self->{call}\n");
  99 }
 100
 101 no strict;
 102 sub AUTOLOAD
 103 {
 104   my $self = shift;
 105   my $name = $AUTOLOAD;
 106
 107   return if $name =~ /::DESTROY$/;
 108   $name =~ s/.*:://o;
 109
 110   confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
 111   @_ ? $self->{$name} = shift : $self->{$name} ;
 112 }
 113
 114 #
 115 # USER special routines
 116 #
 117
 118 package DXNodeuser;
 119
 120 @ISA = qw(DXCluster);
 121
 122 use DXDebug;
 123
 124 use strict;
 125 use vars qw($users);
 126
 127 $users = 0;
 128
 129 sub new
 130 {
 131   my ($pkg, $dxchan, $node, $call, $confmode, $here) = @_;
 132
 133   die "tried to add $call when it already exists" if DXCluster->get($call);
 134
 135   my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
 136   $self->{mynode} = $node;
 137   $node->{list}->{$call} = $self;     # add this user to the list on this node
 138   $users++;
 139   dbg('cluster', "allocating user $call to $node->{call} in cluster\n");
 140   $node->update_users;
 141   return $self;
 142 }
 143
 144 sub del
 145 {
 146   my $self = shift;
 147   my $call = $self->{call};
 148   my $node = $self->{mynode};
 149
 150   delete $node->{list}->{$call};
 151   delete $DXCluster::cluster{$call};     # remove me from the cluster table
 152   dbg('cluster', "deleting user $call from $node->{call} in cluster\n");
 153   $node->update_users;
 154   $users-- if $users > 0;
 155 }
 156
 157 sub count
 158 {
 159   return $users;                 # + 1 for ME (naf eh!)
 160 }
 161
 162 no strict;
 163
 164 #
 165 # NODE special routines
 166 #
 167
 168 package DXNode;
 169
 170 @ISA = qw(DXCluster);
 171
 172 use DXDebug;
 173
 174 use strict;
 175 use vars qw($nodes);
 176
 177 $nodes = 0;
 178
 179 sub new
 180 {
 181   my ($pkg, $dxchan, $call, $confmode, $here, $pcversion) = @_;
 182   my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
 183   $self->{pcversion} = $pcversion;
 184   $self->{list} = { } ;
 185   $nodes++;
 186   dbg('cluster', "allocating node $call to cluster\n");
 187   return $self;
 188 }
 189
 190 # get all the nodes
 191 sub get_all
 192 {
 193   my $list;
 194   my @out;
 195   foreach $list (values(%DXCluster::cluster)) {
 196     push @out, $list if $list->{pcversion};
 197   }
 198   return @out;
 199 }
 200
 201 sub del
 202 {
 203   my $self = shift;
 204   my $call = $self->{call};
 205   my $ref;
 206
 207   # delete all the listed calls
 208   foreach $ref (values %{$self->{list}}) {
 209     $ref->del();      # this also takes them out of this list
 210   }
 211   delete $DXCluster::cluster{$call};     # remove me from the cluster table
 212   dbg('cluster', "deleting node $call from cluster\n");
 213   $nodes-- if $nodes > 0;
 214 }
 215
 216 sub update_users
 217 {
 218   my $self = shift;
 219   my $count = shift;
 220   if ((keys %{$self->{list}})) {
 221     $self->{users} = (keys %{$self->{list}});
 222   } else {
 223     $self->{users} = $count;
 224   }
 225 }
 226
 227 sub count
 228 {
 229   return $nodes;           # + 1 for ME!
 230 }
 231
 232 sub dolist
 233 {
 234
 235 }
 236 1;
 237 __END__