From 07d281a1a976f136e00a541d9d157bb750ac4cb5 Mon Sep 17 00:00:00 2001 From: minima Date: Sat, 15 Sep 2001 13:09:05 +0000 Subject: [PATCH] remove references to DXCluster.pm --- cmd/stat/cluster.pl | 24 --- perl/DXCluster.pm | 361 -------------------------------------------- 2 files changed, 385 deletions(-) delete mode 100644 cmd/stat/cluster.pl delete mode 100644 perl/DXCluster.pm diff --git a/cmd/stat/cluster.pl b/cmd/stat/cluster.pl deleted file mode 100644 index 539a1136..00000000 --- a/cmd/stat/cluster.pl +++ /dev/null @@ -1,24 +0,0 @@ -# -# show a cluster thingy -# -# $Id$ -# - -my ($self, $line) = @_; -my @list = split /\s+/, $line; # generate a list of callsigns -@list = ($self->call) if !@list; # my channel if no callsigns - -my $call; -my @out; -foreach $call (@list) { - $call = uc $call; - my $ref = DXCluster->get_exact($call); - if ($ref) { - @out = print_all_fields($self, $ref, "Cluster Information $call"); - } else { - push @out, "Cluster: $call not found"; - } - push @out, "" if @list > 1; -} - -return (1, @out); diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm deleted file mode 100644 index 8338cccb..00000000 --- a/perl/DXCluster.pm +++ /dev/null @@ -1,361 +0,0 @@ -# -# DX database control routines -# -# This manages the on-line cluster user 'database' -# -# This should all be pretty trees and things, but for now I -# just can't be bothered. If it becomes an issue I shall -# address it. -# -# Copyright (c) 1998 - Dirk Koopman G1TLH -# -# $Id$ -# - -package DXCluster; - -use DXDebug; -use DXUtil; - -use strict; -use vars qw(%cluster %valid); - -%cluster = (); # this is where we store the dxcluster database - -%valid = ( - mynode => '0,Parent Node', - call => '0,Callsign', - confmode => '0,Conference Mode,yesno', - here => '0,Here?,yesno', - dxchancall => '5,Channel Call', - pcversion => '5,Node Version', - list => '5,User List,DXCluster::dolist', - users => '0,No of Users', - ); - -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; -$main::build += $VERSION; -$main::branch += $BRANCH; - -sub alloc -{ - 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->{dxchancall} = $dxchan->call; - - $cluster{$call} = bless $self, $pkg; - 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) = @_; - - # 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 a prompt for a field -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 -{ - my $self = shift; - my $out; - my $ref; - - foreach my $call (keys %{$self}) { - $ref = $$self{$call}; - my $s = $ref->{call}; - $s = "($s)" if !$ref->{here}; - $out .= "$s "; - } - chop $out; - return $out; -} - -# this expects a reference to a node -sub showcall -{ - my $self = shift; - return $self->{call}; -} - -# 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"; -} - -sub mynode -{ - my $self = shift; - my $noderef = shift; - - if ($noderef) { - $self->{mynode} = $noderef->call; - } else { - $noderef = DXCluster->get_exact($self->{mynode}); - unless ($noderef) { - my $mynode = $self->{mynode}; - my $call = $self->{call}; - dbg("parent node $mynode has disappeared from $call") if isdbg('err'); - } - } - return $noderef; -} - -sub dxchan -{ - my $self = shift; - my $dxchan = shift; - - if ($dxchan) { - $self->{dxchancall} = $dxchan->call; - } else { - $dxchan = DXChannel->get($self->{dxchancall}); - unless ($dxchan) { - my $dxcall = $self->{dxchancall}; - my $call = $self->{call}; - dbg("parent dxchan $dxcall has disappeared from $call") if isdbg('err'); - } - } - return $dxchan; -} - -no strict; -sub AUTOLOAD -{ - my $self = shift; - my $name = $AUTOLOAD; - - return if $name =~ /::DESTROY$/; - $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} ; -} - -# -# USER special routines -# - -package DXNodeuser; - -@ISA = qw(DXCluster); - -use DXDebug; - -use strict; - -sub new -{ - my ($pkg, $dxchan, $node, $call, $confmode, $here) = @_; - - 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->call; - $node->add_user($call, $self); - dbg("allocating user $call to $node->{call} in cluster\n") if isdbg('cluster'); - return $self; -} - -sub del -{ - my $self = shift; - my $call = $self->{call}; - my $node = $self->mynode; - - $node->del_user($call); - dbg("deleting user $call from $node->{call} in cluster\n") if isdbg('cluster'); -} - -sub count -{ - return $DXNode::users; # + 1 for ME (naf eh!) -} - -no strict; - -# -# NODE special routines -# - -package DXNode; - -@ISA = qw(DXCluster); - -use DXDebug; - -use strict; -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->{pcversion} = $pcversion; - $self->{list} = { } ; - $self->{mynode} = $self->call; # for sh/station - $self->{users} = 0; - $nodes++; - dbg("allocating node $call to cluster\n") if isdbg('cluster'); - return $self; -} - -# get all the nodes -sub get_all -{ - my $list; - my @out; - foreach $list (values(%DXCluster::cluster)) { - push @out, $list if $list->{pcversion}; - } - return @out; -} - -sub del -{ - 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("deleting node $call from cluster\n") if isdbg('cluster'); - $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 -{ - 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 for ME! -} - -sub dolist -{ - -} - -sub DESTROY -{ - my $self = shift; - undef $self->{list} if $self->{list}; -} - - -1; -__END__ -- 2.34.1