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