X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCluster.pm;h=aee8fe4d94a0c6a0e1c192fb1d94d836b705edd1;hb=3eb9538d135d9ff21d8ce7c0e0c6b3e6d7fb59a9;hp=2dad1cb61ffb42c87b74149827ca45e93a05cdd6;hpb=07ea293f3919d2da76220b5fbc55b734008ed44c;p=spider.git diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 2dad1cb6..aee8fe4d 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -16,102 +16,181 @@ package DXCluster; use Exporter; @ISA = qw(Exporter); +use DXDebug; +use Carp; -%cluster = (); # this is where we store the dxcluster database +use strict; +use vars qw(%cluster %valid); + +%cluster = (); # this is where we store the dxcluster database + +%valid = ( + mynode => '0,Parent Node,showcall', + call => '0,Callsign', + confmode => '0,Conference Mode,yesno', + here => '0,Here?,yesno', + dxchan => '5,Channel ref', + pcversion => '5,Node Version', + list => '5,User List,dolist', + users => '0,No of Users', + ); sub alloc { - my ($pkg, $call, $confmode, $here, $dxprot) = @_; - die "$call is already alloced" if $cluster{$call}; - my $self = {}; - $self->{call} = $call; - $self->{confmode} = $confmode; - $self->{here} = $here; - $self->{dxprot} = $dxprot; + my ($pkg, $dxchan, $call, $confmode, $here) = @_; + die "$call is already alloced" if $cluster{$call}; + my $self = {}; + $self->{call} = $call; + $self->{confmode} = $confmode; + $self->{here} = $here; + $self->{dxchan} = $dxchan; + + $cluster{$call} = bless $self, $pkg; + return $self; +} + +# get an entry exactly as it is +sub get_exact +{ + my ($pkg, $call) = @_; - $cluster{$call} = bless $self, $pkg; - return $self; + # 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}; + my ($pkg, $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 sub get_all { - return values(%cluster); + return values(%cluster); } -sub delcluster; +# return a prompt for a field +sub field_prompt +{ + my ($self, $ele) = @_; + return $valid{$ele}; +} + +# this expects a reference to a list in a node NOT a ref to a node +sub dolist { - my $self = shift; - delete $cluster{$self->{call}}; + my $self = shift; + my $out; + my $ref; + + foreach $ref (@{$self}) { + my $s = $ref->{call}; + $s = "($s)" if !$ref->{here}; + $out .= "$s "; + } + chop $out; + return $out; } -%valid = ( - mynode => '0,Parent Node', - call => '0,Callsign', - confmode => '5,Conference Mode,yesno', - here => '5,Here?,yesno', - dxprot => '5,Channel ref', - version => '5,Node Version', -); +# this expects a reference to a node +sub showcall +{ + my $self = shift; + return $self->{call}; +} -# return a prompt for a field -sub field_prompt -{ - my ($self, $ele) = @_; - return $valid{$ele}; +# the answer required by show/cluster +sub cluster +{ + my $users = DXCommandmode::get_all(); + my $uptime = main::uptime(); + my $tot = $DXNode::users; + + return " $DXNode::nodes nodes, $users local / $tot total users Max users $DXNode::maxusers Uptime $uptime"; } +no strict; sub AUTOLOAD { - my $self = shift; - my $name = $AUTOLOAD; + my $self = shift; + my $name = $AUTOLOAD; - return if $name =~ /::DESTROY$/; - $name =~ s/.*:://o; + return if $name =~ /::DESTROY$/; + $name =~ s/.*:://o; - die "Non-existant field '$AUTOLOAD'" if !$valid{$name}; - @_ ? $self->{$name} = shift : $self->{$name} ; + confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; + @_ ? $self->{$name} = shift : $self->{$name} ; } # # USER special routines # -package DXUser; +package DXNodeuser; @ISA = qw(DXCluster); -%users = (); +use DXDebug; + +use strict; sub new { - my ($pkg, $mynode, $call, $confmode, $here, $dxprot) = @_; - my $self = $pkg->alloc($call, $confmode, $here, $dxprot); - $self->{mynode} = $mynode; + my ($pkg, $dxchan, $node, $call, $confmode, $here) = @_; - $users{$call} = $self; - return $self; + 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->add_user($call, $self); + dbg('cluster', "allocating user $call to $node->{call} in cluster\n"); + return $self; } -sub delete +sub del { - my $self = shift; - $self->delcluster(); # out of the whole cluster table - delete $users{$self->{call}}; # out of the users table + my $self = shift; + my $call = $self->{call}; + my $node = $self->{mynode}; + + $node->del_user($call); + dbg('cluster', "deleting user $call from $node->{call} in cluster\n"); } sub count { - return %users + 1; # + 1 for ME (naf eh!) + return $DXNode::users; # + 1 for ME (naf eh!) } +no strict; + # # NODE special routines # @@ -120,47 +199,111 @@ package DXNode; @ISA = qw(DXCluster); -%nodes = (); +use DXDebug; + +use strict; +use vars qw($nodes $users $maxusers); + +$nodes = 0; +$users = 0; +$maxusers = 0; + sub new { - my ($pkg, $call, $confmode, $here, $version, $dxprot) = @_; - my $self = $pkg->alloc($call, $confmode, $here, $dxprot); - $self->{version} = $version; - $nodes{$call} = $self; - return $self; + my ($pkg, $dxchan, $call, $confmode, $here, $pcversion) = @_; + my $self = $pkg->alloc($dxchan, $call, $confmode, $here); + $self->{pcversion} = $pcversion; + $self->{list} = { } ; + $self->{mynode} = $self; # for sh/station + $self->{users} = 0; + $nodes++; + dbg('cluster', "allocating node $call to cluster\n"); + return $self; } -# get a node -sub get +# get all the nodes +sub get_all { - my ($pkg, $call) = @_; - return $nodes{$call}; + my $list; + my @out; + foreach $list (values(%DXCluster::cluster)) { + push @out, $list if $list->{pcversion}; + } + return @out; } -# get all the nodes -sub get_all +sub del { - my $list; - my @out; - foreach $list (values(%nodes)) { - push @out, $list if $list->{version}; - } - return @out; + my $self = shift; + my $call = $self->{call}; + my $ref; + + # delete all the listed calls + 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"); + $users -= $self->{users}; # it may be PC50 updated only therefore > 0 + $users = 0 if $users < 0; + $nodes--; + $nodes = 0 if $nodes < 0; } -sub delete +sub add_user { - my $self = shift; - my $call = $self->call; - - DXUser->delete($call); # delete all the users one this node - delete $nodes{$call}; + 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 +{ + my $self = shift; + my $count = shift; + $count = 0 unless $count; + + $users -= $self->{users}; + $self->{users} = $count unless keys %{$self->{list}}; + $users += $self->{users}; + $maxusers = $users+$nodes if $users+$nodes > $maxusers; } sub count { - return %nodes + 1; # + 1 for ME! + return $nodes; # + 1 for ME! +} + +sub dolist +{ + } + +sub DESTROY +{ + my $self = shift; + undef $self->{list} if $self->{list}; +} + + 1; __END__