]> scm.dxcluster.org Git - spider.git/blob - perl/DXCluster.pm
*** empty log message ***
[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 DXDebug;
18 use DXUtil;
19
20 use strict;
21 use vars qw(%cluster %valid);
22
23 %cluster = ();                                  # this is where we store the dxcluster database
24
25 %valid = (
26                   mynode => '0,Parent Node,DXCluster::showcall',
27                   call => '0,Callsign',
28                   confmode => '0,Conference Mode,yesno',
29                   here => '0,Here?,yesno',
30                   dxchan => '5,Channel ref,DXCluster::showcall',
31                   pcversion => '5,Node Version',
32                   list => '5,User List,DXCluster::dolist',
33                   users => '0,No of Users',
34                  );
35
36 sub alloc
37 {
38         my ($pkg, $dxchan, $call, $confmode, $here) = @_;
39         die "$call is already alloced" if $cluster{$call};
40         my $self = {};
41         $self->{call} = $call;
42         $self->{confmode} = $confmode;
43         $self->{here} = $here;
44         $self->{dxchan} = $dxchan;
45
46         $cluster{$call} = bless $self, $pkg;
47         return $self;
48 }
49
50 # get an entry exactly as it is
51 sub get_exact
52 {
53         my ($pkg, $call) = @_;
54
55         # belt and braces
56         $call = uc $call;
57   
58         # search for 'as is' only
59         return $cluster{$call}; 
60 }
61
62 #
63 # search for a call in the cluster
64 # taking into account SSIDs
65 #
66 sub get
67 {
68         my ($pkg, $call) = @_;
69
70         # belt and braces
71         $call = uc $call;
72   
73         # search for 'as is'
74         my $ref = $cluster{$call}; 
75         return $ref if $ref;
76
77         # search for the unSSIDed one
78         $call =~ s/-\d+$//o;
79         $ref = $cluster{$call};
80         return $ref if $ref;
81   
82         # search for the SSIDed one
83         my $i;
84         for ($i = 1; $i < 17; $i++) {
85                 $ref = $cluster{"$call-$i"};
86                 return $ref if $ref;
87         }
88         return undef;
89 }
90
91 # get all 
92 sub get_all
93 {
94         return values(%cluster);
95 }
96
97 # return a prompt for a field
98 sub field_prompt
99
100         my ($self, $ele) = @_;
101         return $valid{$ele};
102 }
103 #
104 # return a list of valid elements 
105
106
107 sub fields
108 {
109         return keys(%valid);
110 }
111
112 # this expects a reference to a list in a node NOT a ref to a node 
113 sub dolist
114 {
115         my $self = shift;
116         my $out;
117         my $ref;
118   
119         foreach my $call (keys %{$self}) {
120                 $ref = $$self{$call};
121                 my $s = $ref->{call};
122                 $s = "($s)" if !$ref->{here};
123                 $out .= "$s ";
124         }
125         chop $out;
126         return $out;
127 }
128
129 # this expects a reference to a node 
130 sub showcall
131 {
132         my $self = shift;
133         return $self->{call};
134 }
135
136 # the answer required by show/cluster
137 sub cluster
138 {
139         my $users = DXCommandmode::get_all();
140         my $uptime = main::uptime();
141         my $tot = $DXNode::users;
142                 
143         return " $DXNode::nodes nodes, $users local / $tot total users  Max users $DXNode::maxusers  Uptime $uptime";
144 }
145
146 no strict;
147 sub AUTOLOAD
148 {
149         my $self = shift;
150         my $name = $AUTOLOAD;
151   
152         return if $name =~ /::DESTROY$/;
153         $name =~ s/.*:://o;
154   
155         confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
156         @_ ? $self->{$name} = shift : $self->{$name} ;
157 }
158
159 #
160 # USER special routines
161 #
162
163 package DXNodeuser;
164
165 @ISA = qw(DXCluster);
166
167 use DXDebug;
168
169 use strict;
170
171 sub new 
172 {
173         my ($pkg, $dxchan, $node, $call, $confmode, $here) = @_;
174
175         die "tried to add $call when it already exists" if DXCluster->get_exact($call);
176   
177         my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
178         $self->{mynode} = $node;
179         $node->add_user($call, $self);
180         dbg('cluster', "allocating user $call to $node->{call} in cluster\n");
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         $node->del_user($call);
191         dbg('cluster', "deleting user $call from $node->{call} in cluster\n");
192 }
193
194 sub count
195 {
196         return $DXNode::users;          # + 1 for ME (naf eh!)
197 }
198
199 no strict;
200
201 #
202 # NODE special routines
203 #
204
205 package DXNode;
206
207 @ISA = qw(DXCluster);
208
209 use DXDebug;
210
211 use strict;
212 use vars qw($nodes $users $maxusers);
213
214 $nodes = 0;
215 $users = 0;
216 $maxusers = 0;
217
218
219 sub new 
220 {
221         my ($pkg, $dxchan, $call, $confmode, $here, $pcversion) = @_;
222         my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
223         $self->{pcversion} = $pcversion;
224         $self->{list} = { } ;
225         $self->{mynode} = $self;        # for sh/station
226         $self->{users} = 0;
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         $users -= $self->{users};    # it may be PC50 updated only therefore > 0
256         $users = 0 if $users < 0;
257         $nodes--;
258         $nodes = 0 if $nodes < 0;
259 }
260
261 sub add_user
262 {
263         my $self = shift;
264         my $call = shift;
265         my $ref = shift;
266         
267         $self->{list}->{$call} = $ref; # add this user to the list on this node
268         $self->{users} = keys %{$self->{list}};
269         $users++;
270         $maxusers = $users+$nodes if $users+$nodes > $maxusers;
271 }
272
273 sub del_user
274 {
275         my $self = shift;
276         my $call = shift;
277
278         delete $self->{list}->{$call};
279         delete $DXCluster::cluster{$call}; # remove me from the cluster table
280         $self->{users} = keys %{$self->{list}};
281         $users--;
282         $users = 0, warn "\$users gone neg, reset" if $users < 0;
283         $maxusers = $users+$nodes if $users+$nodes > $maxusers;
284 }
285
286 sub update_users
287 {
288         my $self = shift;
289         my $count = shift;
290         $count = 0 unless $count;
291         
292         $users -= $self->{users};
293         $self->{users} = $count unless keys %{$self->{list}};
294         $users += $self->{users};
295         $maxusers = $users+$nodes if $users+$nodes > $maxusers;
296 }
297
298 sub count
299 {
300         return $nodes;                          # + 1 for ME!
301 }
302
303 sub dolist
304 {
305
306 }
307
308 sub DESTROY
309 {
310         my $self = shift;
311         undef $self->{list} if $self->{list};
312 }
313
314
315 1;
316 __END__