]> scm.dxcluster.org Git - spider.git/blob - perl/DXCluster.pm
added ping and rcmd commands
[spider.git] / 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 # get an entry exactly as it is
53 sub get_exact
54 {
55   my ($pkg, $call) = @_;
56
57   # belt and braces
58   $call = uc $call;
59   
60   # search for 'as is' only
61   return $cluster{$call}; 
62 }
63
64 #
65 # search for a call in the cluster
66 # taking into account SSIDs
67 #
68 sub get
69 {
70   my ($pkg, $call) = @_;
71
72   # belt and braces
73   $call = uc $call;
74   
75   # search for 'as is'
76   my $ref = $cluster{$call}; 
77   return $ref if $ref;
78
79   # search for the unSSIDed one
80   $call =~ s/-\d+$//o;
81   $ref = $cluster{$call};
82   return $ref if $ref;
83   
84   # search for the SSIDed one
85   my $i;
86   for ($i = 1; $i < 17; $i++) {
87           $ref = $cluster{"$call-$i"};
88           return $ref if $ref;
89   }
90   return undef;
91 }
92
93 # get all 
94 sub get_all
95 {
96   return values(%cluster);
97 }
98
99 # return a prompt for a field
100 sub field_prompt
101
102   my ($self, $ele) = @_;
103   return $valid{$ele};
104 }
105
106 # this expects a reference to a list in a node NOT a ref to a node 
107 sub dolist
108 {
109   my $self = shift;
110   my $out;
111   my $ref;
112   
113   foreach $ref (@{$self}) {
114     my $s = $ref->{call};
115         $s = "($s)" if !$ref->{here};
116         $out .= "$s ";
117   }
118   chop $out;
119   return $out;
120 }
121
122 # this expects a reference to a node 
123 sub showcall
124 {
125   my $self = shift;
126   return $self->{call};
127 }
128
129 # the answer required by show/cluster
130 sub cluster
131 {
132         my $users = DXCommandmode::get_all();
133         my $uptime = main::uptime();
134         my $tot = $DXNode::users + 1;
135                 
136         return " $DXNode::nodes nodes, $users local / $tot total users  Max users $DXNode::maxusers  Uptime $uptime";
137 }
138
139 sub DESTROY
140 {
141   my $self = shift;
142   dbg('cluster', "destroying $self->{call}\n");
143 }
144
145 no strict;
146 sub AUTOLOAD
147 {
148   my $self = shift;
149   my $name = $AUTOLOAD;
150   
151   return if $name =~ /::DESTROY$/;
152   $name =~ s/.*:://o;
153   
154   confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
155   @_ ? $self->{$name} = shift : $self->{$name} ;
156 }
157
158 #
159 # USER special routines
160 #
161
162 package DXNodeuser;
163
164 @ISA = qw(DXCluster);
165
166 use DXDebug;
167
168 use strict;
169
170 sub new 
171 {
172   my ($pkg, $dxchan, $node, $call, $confmode, $here) = @_;
173
174   die "tried to add $call when it already exists" if DXCluster->get_exact($call);
175   
176   my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
177   $self->{mynode} = $node;
178   $node->{list}->{$call} = $self;     # add this user to the list on this node
179   dbg('cluster', "allocating user $call to $node->{call} in cluster\n");
180   $node->update_users;
181   return $self;
182 }
183
184 sub del
185 {
186   my $self = shift;
187   my $call = $self->{call};
188   my $node = $self->{mynode};
189
190   delete $node->{list}->{$call};
191   delete $DXCluster::cluster{$call};     # remove me from the cluster table
192   dbg('cluster', "deleting user $call from $node->{call} in cluster\n");
193   $node->update_users;
194 }
195
196 sub count
197 {
198   return $DXNode::users;                 # + 1 for ME (naf eh!)
199 }
200
201 no strict;
202
203 #
204 # NODE special routines
205 #
206
207 package DXNode;
208
209 @ISA = qw(DXCluster);
210
211 use DXDebug;
212
213 use strict;
214 use vars qw($nodes $users $maxusers);
215
216 $nodes = 0;
217 $users = 0;
218 $maxusers = 0;
219
220
221 sub new 
222 {
223   my ($pkg, $dxchan, $call, $confmode, $here, $pcversion) = @_;
224   my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
225   $self->{pcversion} = $pcversion;
226   $self->{list} = { } ;
227   $nodes++;
228   dbg('cluster', "allocating node $call to cluster\n");
229   return $self;
230 }
231
232 # get all the nodes
233 sub get_all
234 {
235   my $list;
236   my @out;
237   foreach $list (values(%DXCluster::cluster)) {
238     push @out, $list if $list->{pcversion};
239   }
240   return @out;
241 }
242
243 sub del
244 {
245   my $self = shift;
246   my $call = $self->{call};
247   my $ref;
248
249   # delete all the listed calls
250   foreach $ref (values %{$self->{list}}) {
251     $ref->del();      # this also takes them out of this list
252   }
253   delete $DXCluster::cluster{$call};     # remove me from the cluster table
254   dbg('cluster', "deleting node $call from cluster\n"); 
255   $nodes-- if $nodes > 0;
256 }
257
258 sub update_users
259 {
260   my $self = shift;
261   my $count = shift;
262   $users -= $self->{users};
263   if ((keys %{$self->{list}})) {
264     $self->{users} = (keys %{$self->{list}});
265   } else {
266     $self->{users} = $count;
267   }
268   $users += $self->{users};
269   $maxusers = $users+$nodes if $users+$nodes > $maxusers;
270 }
271
272 sub count
273 {
274   return $nodes;           # + 1 for ME!
275 }
276
277 sub dolist
278 {
279
280 }
281 1;
282 __END__