2 # DX database control routines
4 # This manages the on-line cluster user 'database'
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
10 # Copyright (c) 1998 - Dirk Koopman G1TLH
24 my %cluster = (); # this is where we store the dxcluster database
27 mynode => '0,Parent Node,showcall',
29 confmode => '0,Conference Mode,yesno',
30 here => '0,Here?,yesno',
31 dxchan => '5,Channel ref',
32 pcversion => '5,Node Version',
33 list => '5,User List,dolist',
34 users => '0,No of Users',
39 my ($pkg, $dxchan, $call, $confmode, $here) = @_;
40 die "$call is already alloced" if $cluster{$call};
42 $self->{call} = $call;
43 $self->{confmode} = $confmode;
44 $self->{here} = $here;
45 $self->{dxchan} = $dxchan;
47 $cluster{$call} = bless $self, $pkg;
51 # search for a call in the cluster
54 my ($pkg, $call) = @_;
55 return $cluster{$call};
61 return values(%cluster);
67 delete $cluster{$self->{call}};
71 # return a prompt for a field
74 my ($self, $ele) = @_;
78 # this expects a reference to a list in a node NOT a ref to a node
85 foreach $ref (@{$self}) {
87 $s = "($s)" if !$ref->{here};
94 # this expects a reference to a node
104 dbg('cluster', "destroying $self->{call}\n");
111 my $name = $AUTOLOAD;
113 return if $name =~ /::DESTROY$/;
116 confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
117 @_ ? $self->{$name} = shift : $self->{$name} ;
121 # USER special routines
126 @ISA = qw(DXCluster);
135 my ($pkg, $dxchan, $node, $call, $confmode, $here) = @_;
137 die "tried to add $call when it already exists" if DXCluster->get($call);
139 my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
140 $self->{mynode} = $node;
141 $self->{list}->{$call} = $self; # add this user to the list on this node
143 dbg('cluster', "allocating user $self->{call}\n");
150 my $call = $self->{call};
151 my $node = $self->{mynode};
153 delete $node->{list}->{$call};
154 delete $cluster{$call}; # remove me from the cluster table
155 $users-- if $users > 0;
160 return $users; # + 1 for ME (naf eh!)
166 # NODE special routines
171 @ISA = qw(DXCluster);
180 my ($pkg, $dxchan, $call, $confmode, $here, $pcversion) = @_;
181 my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
182 $self->{version} = $pcversion;
183 $self->{list} = { } ;
185 dbg('cluster', "allocating node $self->{call}\n");
194 foreach $list (values(%cluster)) {
195 push @out, $list if $list->{pcversion};
203 my $call = $self->{call};
206 # delete all the listed calls
207 foreach $ref (values %{$self->{list}}) {
208 $ref->del(); # this also takes them out of this list
210 $nodes-- if $nodes > 0;
216 if (%{$self->{list}}) {
217 $self->{users} = scalar %{$self->{list}};
219 $self->{users} = shift;
225 return $nodes; # + 1 for ME!