X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCluster.pm;h=25dafaed20d249cdafd994823d42dfdd068e9c2c;hb=ab568d677a2d2243eabee315b3e609c4ea4f73a0;hp=9560ba576a5b131132c9ef26a5ab455946449f2b;hpb=21e7642d216656c60b164d76208633a0c81cf5db;p=spider.git diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 9560ba57..25dafaed 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -16,14 +16,15 @@ package DXCluster; use Exporter; @ISA = qw(Exporter); -use Carp; use DXDebug; +use Carp; use strict; +use vars qw(%cluster %valid); -my %cluster = (); # this is where we store the dxcluster database +%cluster = (); # this is where we store the dxcluster database -my %valid = ( +%valid = ( mynode => '0,Parent Node,showcall', call => '0,Callsign', confmode => '0,Conference Mode,yesno', @@ -48,11 +49,45 @@ sub alloc return $self; } +# get an entry exactly as it is +sub get_exact +{ + my ($pkg, $call) = @_; + + # belt and braces + $call = uc $call; + + # search for 'as is' + return $cluster{$call}; +} + +# # search for a call in the cluster +# taking into account SSIDs +# sub get { my ($pkg, $call) = @_; - return $cluster{$call}; + + # belt and braces + $call = uc $call; + + # search for 'as is' + my $ref = $cluster{$call}; + return $ref if $ref; + + # search for the unSSIDed one + $call =~ s/-\d+$//o; + $ref = $cluster{$call}; + return $ref if $ref; + + # search for the SSIDed one + my $i; + for ($i = 1; $i < 17; $i++) { + $ref = $cluster{"$call-$i"}; + return $ref if $ref; + } + return undef; } # get all @@ -61,13 +96,6 @@ sub get_all return values(%cluster); } -sub delcluster; -{ - my $self = shift; - delete $cluster{$self->{call}}; -} - - # return a prompt for a field sub field_prompt { @@ -98,6 +126,16 @@ sub showcall return $self->{call}; } +# the answer required by show/cluster +sub cluster +{ + my $users = DXCommandmode::get_all(); + my $uptime = main::uptime(); + my $tot = $DXNode::users + 1; + + return " $DXNode::nodes nodes, $users local / $tot total users Max users $DXNode::maxusers Uptime $uptime"; +} + sub DESTROY { my $self = shift; @@ -128,19 +166,18 @@ package DXNodeuser; use DXDebug; use strict; -my $users = 0; sub new { my ($pkg, $dxchan, $node, $call, $confmode, $here) = @_; - die "tried to add $call when it already exists" if DXCluster->get($call); + die "tried to add $call when it already exists" if DXCluster->get_exact($call); my $self = $pkg->alloc($dxchan, $call, $confmode, $here); $self->{mynode} = $node; - $self->{list}->{$call} = $self; # add this user to the list on this node - $users++; - dbg('cluster', "allocating user $self->{call}\n"); + $node->{list}->{$call} = $self; # add this user to the list on this node + dbg('cluster', "allocating user $call to $node->{call} in cluster\n"); + $node->update_users; return $self; } @@ -149,15 +186,16 @@ sub del my $self = shift; my $call = $self->{call}; my $node = $self->{mynode}; - + delete $node->{list}->{$call}; - delete $cluster{$call}; # remove me from the cluster table - $users-- if $users > 0; + delete $DXCluster::cluster{$call}; # remove me from the cluster table + dbg('cluster', "deleting user $call from $node->{call} in cluster\n"); + $node->update_users; } sub count { - return $users; # + 1 for ME (naf eh!) + return $DXNode::users; # + 1 for ME (naf eh!) } no strict; @@ -173,16 +211,21 @@ package DXNode; use DXDebug; use strict; -my $nodes = 0; +use vars qw($nodes $users $maxusers); + +$nodes = 0; +$users = 0; +$maxusers = 0; + sub new { my ($pkg, $dxchan, $call, $confmode, $here, $pcversion) = @_; my $self = $pkg->alloc($dxchan, $call, $confmode, $here); - $self->{version} = $pcversion; + $self->{pcversion} = $pcversion; $self->{list} = { } ; $nodes++; - dbg('cluster', "allocating node $self->{call}\n"); + dbg('cluster', "allocating node $call to cluster\n"); return $self; } @@ -191,7 +234,7 @@ sub get_all { my $list; my @out; - foreach $list (values(%cluster)) { + foreach $list (values(%DXCluster::cluster)) { push @out, $list if $list->{pcversion}; } return @out; @@ -207,17 +250,23 @@ sub del foreach $ref (values %{$self->{list}}) { $ref->del(); # this also takes them out of this list } + delete $DXCluster::cluster{$call}; # remove me from the cluster table + dbg('cluster', "deleting node $call from cluster\n"); $nodes-- if $nodes > 0; } sub update_users { my $self = shift; - if (%{$self->{list}}) { - $self->{users} = scalar %{$self->{list}}; + my $count = shift; + $users -= $self->{users}; + if ((keys %{$self->{list}})) { + $self->{users} = (keys %{$self->{list}}); } else { - $self->{users} = shift; + $self->{users} = $count; } + $users += $self->{users}; + $maxusers = $users+$nodes if $users+$nodes > $maxusers; } sub count