X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCluster.pm;h=09001b2070c10a613aa5c68886457b9def4c6a86;hb=fa57f72c26032aae4c1a20358e829ba9afbf460c;hp=2ddd2358648f28616c2c8f2f197bce61303e9d4a;hpb=7432cb12ce865030c8b0315a30764e0088a59102;p=spider.git diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 2ddd2358..09001b20 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -16,8 +16,8 @@ package DXCluster; use Exporter; @ISA = qw(Exporter); -use Carp; use DXDebug; +use Carp; use strict; use vars qw(%cluster %valid); @@ -49,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' only + 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 @@ -92,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; @@ -122,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; $node->{list}->{$call} = $self; # add this user to the list on this node - $users++; dbg('cluster', "allocating user $call to $node->{call} in cluster\n"); + $node->update_users; return $self; } @@ -143,16 +186,16 @@ sub del my $self = shift; my $call = $self->{call}; my $node = $self->{mynode}; - + delete $node->{list}->{$call}; delete $DXCluster::cluster{$call}; # remove me from the cluster table dbg('cluster', "deleting user $call from $node->{call} in cluster\n"); - $users-- if $users > 0; + $node->update_users; } sub count { - return $users; # + 1 for ME (naf eh!) + return $DXNode::users; # + 1 for ME (naf eh!) } no strict; @@ -168,13 +211,18 @@ 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 $call to cluster\n"); @@ -202,6 +250,7 @@ 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; } @@ -209,11 +258,15 @@ sub del 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