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
  20 use strict;
  21
  22 my %cluster = ();            # this is where we store the dxcluster database
  23
  24 my %valid = (
  25   mynode => '0,Parent Node',
  26   call => '0,Callsign',
  27   confmode => '0,Conference Mode,yesno',
  28   here => '0,Here?,yesno',
  29   dxchan => '5,Channel ref',
  30   pcversion => '5,Node Version',
  31   list => '5,User List,dolist',
  32 );
  33
  34 sub alloc
  35 {
  36   my ($pkg, $call, $confmode, $here, $dxchan) = @_;
  37   die "$call is already alloced" if $cluster{$call};
  38   my $self = {};
  39   $self->{call} = $call;
  40   $self->{confmode} = $confmode;
  41   $self->{here} = $here;
  42   $self->{dxchan} = $dxchan;
  43
  44   $cluster{$call} = bless $self, $pkg;
  45   return $self;
  46 }
  47
  48 # search for a call in the cluster
  49 sub get
  50 {
  51   my ($pkg, $call) = @_;
  52   return $cluster{$call};
  53 }
  54
  55 # get all
  56 sub get_all
  57 {
  58   return values(%cluster);
  59 }
  60
  61 sub delcluster;
  62 {
  63   my $self = shift;
  64   delete $cluster{$self->{call}};
  65 }
  66
  67
  68 # return a prompt for a field
  69 sub field_prompt
  70 {
  71   my ($self, $ele) = @_;
  72   return $valid{$ele};
  73 }
  74
  75 sub dolist
  76 {
  77
  78 }
  79
  80 no strict;
  81 sub AUTOLOAD
  82 {
  83   my $self = shift;
  84   my $name = $AUTOLOAD;
  85
  86   return if $name =~ /::DESTROY$/;
  87   $name =~ s/.*:://o;
  88
  89   die "Non-existant field '$AUTOLOAD'" if !$valid{$name};
  90   @_ ? $self->{$name} = shift : $self->{$name} ;
  91 }
  92
  93 #
  94 # USER special routines
  95 #
  96
  97 package DXNodeuser;
  98
  99 @ISA = qw(DXCluster);
 100
 101 use strict;
 102 my %users = ();
 103
 104 sub new
 105 {
 106   my ($pkg, $mynode, $call, $confmode, $here, $dxchan) = @_;
 107   my $self = $pkg->alloc($call, $confmode, $here, $dxchan);
 108   $self->{mynode} = $mynode;
 109
 110   $users{$call} = $self;
 111   return $self;
 112 }
 113
 114 sub del
 115 {
 116   my $self = shift;
 117   $self->delcluster();              # out of the whole cluster table
 118   delete $users{$self->{call}};     # out of the users table
 119 }
 120
 121 sub count
 122 {
 123   return %users + 1;                 # + 1 for ME (naf eh!)
 124 }
 125
 126 no strict;
 127
 128 #
 129 # NODE special routines
 130 #
 131
 132 package DXNode;
 133
 134 @ISA = qw(DXCluster);
 135
 136 use strict;
 137 my %nodes = ();
 138
 139 sub new
 140 {
 141   my ($pkg, $call, $confmode, $here, $pcversion, $dxchan) = @_;
 142   my $self = $pkg->alloc($call, $confmode, $here, $dxchan);
 143   $self->{version} = $pcversion;
 144   $nodes{$call} = $self;
 145   return $self;
 146 }
 147
 148 # get a node
 149 sub get
 150 {
 151   my ($pkg, $call) = @_;
 152   return $nodes{$call};
 153 }
 154
 155 # get all the nodes
 156 sub get_all
 157 {
 158   my $list;
 159   my @out;
 160   foreach $list (values(%nodes)) {
 161     push @out, $list if $list->{pcversion};
 162   }
 163   return @out;
 164 }
 165
 166 sub del
 167 {
 168   my $self = shift;
 169   my $call = $self->call;
 170
 171   DXUser->delete($call);     # delete all the users on this node
 172   delete $nodes{$call};
 173 }
 174
 175 sub count
 176 {
 177   return %nodes + 1;           # + 1 for ME!
 178 }
 179
 180 sub dolist
 181 {
 182
 183 }
 184 1;
 185 __END__