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 DXDebug;
  20 use Carp;
  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 # the answer required by show/cluster
  96 sub cluster
  97 {
  98         my $users = DXCommandmode::get_all();
  99         my $uptime = main::uptime();
 100         my $tot = $DXNode::users + 1;
 101
 102         return " $DXNode::nodes nodes, $users local / $tot total users  Max users $DXNode::maxusers  Uptime $uptime";
 103 }
 104
 105 sub DESTROY
 106 {
 107   my $self = shift;
 108   dbg('cluster', "destroying $self->{call}\n");
 109 }
 110
 111 no strict;
 112 sub AUTOLOAD
 113 {
 114   my $self = shift;
 115   my $name = $AUTOLOAD;
 116
 117   return if $name =~ /::DESTROY$/;
 118   $name =~ s/.*:://o;
 119
 120   confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
 121   @_ ? $self->{$name} = shift : $self->{$name} ;
 122 }
 123
 124 #
 125 # USER special routines
 126 #
 127
 128 package DXNodeuser;
 129
 130 @ISA = qw(DXCluster);
 131
 132 use DXDebug;
 133
 134 use strict;
 135
 136 sub new
 137 {
 138   my ($pkg, $dxchan, $node, $call, $confmode, $here) = @_;
 139
 140   die "tried to add $call when it already exists" if DXCluster->get($call);
 141
 142   my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
 143   $self->{mynode} = $node;
 144   $node->{list}->{$call} = $self;     # add this user to the list on this node
 145   dbg('cluster', "allocating user $call to $node->{call} in cluster\n");
 146   $node->update_users;
 147   return $self;
 148 }
 149
 150 sub del
 151 {
 152   my $self = shift;
 153   my $call = $self->{call};
 154   my $node = $self->{mynode};
 155
 156   delete $node->{list}->{$call};
 157   delete $DXCluster::cluster{$call};     # remove me from the cluster table
 158   dbg('cluster', "deleting user $call from $node->{call} in cluster\n");
 159   $node->update_users;
 160 }
 161
 162 sub count
 163 {
 164   return $DXNode::users;                 # + 1 for ME (naf eh!)
 165 }
 166
 167 no strict;
 168
 169 #
 170 # NODE special routines
 171 #
 172
 173 package DXNode;
 174
 175 @ISA = qw(DXCluster);
 176
 177 use DXDebug;
 178
 179 use strict;
 180 use vars qw($nodes $users $maxusers);
 181
 182 $nodes = 0;
 183 $users = 0;
 184 $maxusers = 0;
 185
 186
 187 sub new
 188 {
 189   my ($pkg, $dxchan, $call, $confmode, $here, $pcversion) = @_;
 190   my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
 191   $self->{pcversion} = $pcversion;
 192   $self->{list} = { } ;
 193   $nodes++;
 194   dbg('cluster', "allocating node $call to cluster\n");
 195   return $self;
 196 }
 197
 198 # get all the nodes
 199 sub get_all
 200 {
 201   my $list;
 202   my @out;
 203   foreach $list (values(%DXCluster::cluster)) {
 204     push @out, $list if $list->{pcversion};
 205   }
 206   return @out;
 207 }
 208
 209 sub del
 210 {
 211   my $self = shift;
 212   my $call = $self->{call};
 213   my $ref;
 214
 215   # delete all the listed calls
 216   foreach $ref (values %{$self->{list}}) {
 217     $ref->del();      # this also takes them out of this list
 218   }
 219   delete $DXCluster::cluster{$call};     # remove me from the cluster table
 220   dbg('cluster', "deleting node $call from cluster\n");
 221   $nodes-- if $nodes > 0;
 222 }
 223
 224 sub update_users
 225 {
 226   my $self = shift;
 227   my $count = shift;
 228   $users -= $self->{users};
 229   if ((keys %{$self->{list}})) {
 230     $self->{users} = (keys %{$self->{list}});
 231   } else {
 232     $self->{users} = $count;
 233   }
 234   $users += $self->{users};
 235   $maxusers = $users+$nodes if $users+$nodes > $maxusers;
 236 }
 237
 238 sub count
 239 {
 240   return $nodes;           # + 1 for ME!
 241 }
 242
 243 sub dolist
 244 {
 245
 246 }
 247 1;
 248 __END__