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