X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCluster.pm;h=2160846547e9e542b5c80413c3bc8c1201e46ccf;hb=4e5b3de7a26563d94678fb790b8a1e2c4daaac8d;hp=91c43a7880a8944d7fdbb0754bc7d8c1e58d0b35;hpb=1994ae9ca216a19bf373948c5e8d79a9d58369d6;p=spider.git diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 91c43a78..21608465 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -14,10 +14,8 @@ package DXCluster; -use Exporter; -@ISA = qw(Exporter); use DXDebug; -use Carp; +use DXUtil; use strict; use vars qw(%cluster %valid); @@ -25,13 +23,13 @@ use vars qw(%cluster %valid); %cluster = (); # this is where we store the dxcluster database %valid = ( - mynode => '0,Parent Node,showcall', + mynode => '0,Parent Node,DXCluster::showcall', call => '0,Callsign', confmode => '0,Conference Mode,yesno', here => '0,Here?,yesno', - dxchan => '5,Channel ref', + dxchan => '5,Channel ref,DXCluster::showcall', pcversion => '5,Node Version', - list => '5,User List,dolist', + list => '5,User List,DXCluster::dolist', users => '0,No of Users', ); @@ -102,6 +100,14 @@ sub field_prompt my ($self, $ele) = @_; return $valid{$ele}; } +# +# return a list of valid elements +# + +sub fields +{ + return keys(%valid); +} # this expects a reference to a list in a node NOT a ref to a node sub dolist @@ -110,7 +116,8 @@ sub dolist my $out; my $ref; - foreach $ref (@{$self}) { + foreach my $call (keys %{$self}) { + $ref = $$self{$call}; my $s = $ref->{call}; $s = "($s)" if !$ref->{here}; $out .= "$s "; @@ -131,17 +138,11 @@ sub cluster { my $users = DXCommandmode::get_all(); my $uptime = main::uptime(); - my $tot = $DXNode::users + 1; + my $tot = $DXNode::users; return " $DXNode::nodes nodes, $users local / $tot total users Max users $DXNode::maxusers Uptime $uptime"; } -sub DESTROY -{ - my $self = shift; - dbg('cluster', "destroying $self->{call}\n"); -} - no strict; sub AUTOLOAD { @@ -152,6 +153,9 @@ sub AUTOLOAD $name =~ s/.*:://o; confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; + # this clever line of code creates a subroutine which takes over from autoload + # from OO Perl - Conway + *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ; @_ ? $self->{$name} = shift : $self->{$name} ; } @@ -175,9 +179,8 @@ sub new my $self = $pkg->alloc($dxchan, $call, $confmode, $here); $self->{mynode} = $node; - $node->{list}->{$call} = $self; # add this user to the list on this node + $node->add_user($call, $self); dbg('cluster', "allocating user $call to $node->{call} in cluster\n"); - $node->update_users(); return $self; } @@ -187,10 +190,8 @@ sub del my $call = $self->{call}; my $node = $self->{mynode}; - delete $node->{list}->{$call}; - delete $DXCluster::cluster{$call}; # remove me from the cluster table + $node->del_user($call); dbg('cluster', "deleting user $call from $node->{call} in cluster\n"); - $node->update_users(); } sub count @@ -254,7 +255,35 @@ sub del } delete $DXCluster::cluster{$call}; # remove me from the cluster table dbg('cluster', "deleting node $call from cluster\n"); - $nodes-- if $nodes > 0; + $users -= $self->{users}; # it may be PC50 updated only therefore > 0 + $users = 0 if $users < 0; + $nodes--; + $nodes = 0 if $nodes < 0; +} + +sub add_user +{ + my $self = shift; + my $call = shift; + my $ref = shift; + + $self->{list}->{$call} = $ref; # add this user to the list on this node + $self->{users} = keys %{$self->{list}}; + $users++; + $maxusers = $users+$nodes if $users+$nodes > $maxusers; +} + +sub del_user +{ + my $self = shift; + my $call = shift; + + delete $self->{list}->{$call}; + delete $DXCluster::cluster{$call}; # remove me from the cluster table + $self->{users} = keys %{$self->{list}}; + $users--; + $users = 0, warn "\$users gone neg, reset" if $users < 0; + $maxusers = $users+$nodes if $users+$nodes > $maxusers; } sub update_users @@ -262,14 +291,10 @@ sub update_users my $self = shift; my $count = shift; $count = 0 unless $count; - - $users -= $self->{users} if $self->{users}; - if ((keys %{$self->{list}})) { - $self->{users} = (keys %{$self->{list}}); - } else { - $self->{users} = $count; - } - $users += $self->{users} if $self->{users}; + + $users -= $self->{users}; + $self->{users} = $count unless keys %{$self->{list}}; + $users += $self->{users}; $maxusers = $users+$nodes if $users+$nodes > $maxusers; } @@ -282,5 +307,13 @@ sub dolist { } + +sub DESTROY +{ + my $self = shift; + undef $self->{list} if $self->{list}; +} + + 1; __END__