X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCluster.pm;h=8338cccb5a511c3da8e0d1096a5679d6520424fe;hb=2b58ccdf81685a1167a43c38705a0d84b9d8d661;hp=205c30fb65552f2deaaef61997eed660e11d828d;hpb=30dbf70f84b53174005810f64f546d2181e1a8c6;p=spider.git diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 205c30fb..8338cccb 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -14,11 +14,8 @@ package DXCluster; -use Exporter; -@ISA = qw(Exporter); use DXDebug; use DXUtil; -use Carp; use strict; use vars qw(%cluster %valid); @@ -26,16 +23,22 @@ use vars qw(%cluster %valid); %cluster = (); # this is where we store the dxcluster database %valid = ( - mynode => '0,Parent Node,DXCluster::showcall', + mynode => '0,Parent Node', call => '0,Callsign', confmode => '0,Conference Mode,yesno', here => '0,Here?,yesno', - dxchan => '5,Channel ref,DXCluster::showcall', + 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) = @_; @@ -44,7 +47,7 @@ sub alloc $self->{call} = $call; $self->{confmode} = $confmode; $self->{here} = $here; - $self->{dxchan} = $dxchan; + $self->{dxchancall} = $dxchan->call; $cluster{$call} = bless $self, $pkg; return $self; @@ -146,6 +149,42 @@ sub cluster 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 { @@ -156,6 +195,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} ; } @@ -178,9 +220,9 @@ sub new 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->{mynode} = $node->call; $node->add_user($call, $self); - dbg('cluster', "allocating user $call to $node->{call} in cluster\n"); + dbg("allocating user $call to $node->{call} in cluster\n") if isdbg('cluster'); return $self; } @@ -188,10 +230,10 @@ sub del { my $self = shift; my $call = $self->{call}; - my $node = $self->{mynode}; + my $node = $self->mynode; $node->del_user($call); - dbg('cluster', "deleting user $call from $node->{call} in cluster\n"); + dbg("deleting user $call from $node->{call} in cluster\n") if isdbg('cluster'); } sub count @@ -225,10 +267,10 @@ sub new my $self = $pkg->alloc($dxchan, $call, $confmode, $here); $self->{pcversion} = $pcversion; $self->{list} = { } ; - $self->{mynode} = $self; # for sh/station + $self->{mynode} = $self->call; # for sh/station $self->{users} = 0; $nodes++; - dbg('cluster', "allocating node $call to cluster\n"); + dbg("allocating node $call to cluster\n") if isdbg('cluster'); return $self; } @@ -254,7 +296,7 @@ sub del $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"); + 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--;