mirror of
git://scm.dxcluster.org/scm/spider
synced 2024-09-21 07:47:10 +00:00
did some work on the cluster database related things
This commit is contained in:
parent
e5b0e3dee5
commit
7432cb12ce
@ -32,10 +32,11 @@ use DXDebug;
|
||||
use Carp;
|
||||
|
||||
use strict;
|
||||
use vars qw(%channels %valid);
|
||||
|
||||
my %channels = undef;
|
||||
%channels = undef;
|
||||
|
||||
my %valid = (
|
||||
%valid = (
|
||||
call => '0,Callsign',
|
||||
conn => '9,Msg Conn ref',
|
||||
user => '9,DXUser ref',
|
||||
@ -55,6 +56,7 @@ my %valid = (
|
||||
here => '0,Here?,yesno',
|
||||
confmode => '0,In Conference?,yesno',
|
||||
dx => '0,DX Spots,yesno',
|
||||
redirect => '0,Redirect messages to',
|
||||
);
|
||||
|
||||
# create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
|
||||
|
@ -20,10 +20,11 @@ use Carp;
|
||||
use DXDebug;
|
||||
|
||||
use strict;
|
||||
use vars qw(%cluster %valid);
|
||||
|
||||
my %cluster = (); # this is where we store the dxcluster database
|
||||
%cluster = (); # this is where we store the dxcluster database
|
||||
|
||||
my %valid = (
|
||||
%valid = (
|
||||
mynode => '0,Parent Node,showcall',
|
||||
call => '0,Callsign',
|
||||
confmode => '0,Conference Mode,yesno',
|
||||
@ -61,13 +62,6 @@ sub get_all
|
||||
return values(%cluster);
|
||||
}
|
||||
|
||||
sub delcluster;
|
||||
{
|
||||
my $self = shift;
|
||||
delete $cluster{$self->{call}};
|
||||
}
|
||||
|
||||
|
||||
# return a prompt for a field
|
||||
sub field_prompt
|
||||
{
|
||||
@ -138,9 +132,9 @@ sub new
|
||||
|
||||
my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
|
||||
$self->{mynode} = $node;
|
||||
$self->{list}->{$call} = $self; # add this user to the list on this node
|
||||
$node->{list}->{$call} = $self; # add this user to the list on this node
|
||||
$users++;
|
||||
dbg('cluster', "allocating user $self->{call}\n");
|
||||
dbg('cluster', "allocating user $call to $node->{call} in cluster\n");
|
||||
return $self;
|
||||
}
|
||||
|
||||
@ -151,7 +145,8 @@ sub del
|
||||
my $node = $self->{mynode};
|
||||
|
||||
delete $node->{list}->{$call};
|
||||
delete $cluster{$call}; # remove me from the cluster table
|
||||
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;
|
||||
}
|
||||
|
||||
@ -182,7 +177,7 @@ sub new
|
||||
$self->{version} = $pcversion;
|
||||
$self->{list} = { } ;
|
||||
$nodes++;
|
||||
dbg('cluster', "allocating node $self->{call}\n");
|
||||
dbg('cluster', "allocating node $call to cluster\n");
|
||||
return $self;
|
||||
}
|
||||
|
||||
@ -191,7 +186,7 @@ sub get_all
|
||||
{
|
||||
my $list;
|
||||
my @out;
|
||||
foreach $list (values(%cluster)) {
|
||||
foreach $list (values(%DXCluster::cluster)) {
|
||||
push @out, $list if $list->{pcversion};
|
||||
}
|
||||
return @out;
|
||||
@ -207,6 +202,7 @@ sub del
|
||||
foreach $ref (values %{$self->{list}}) {
|
||||
$ref->del(); # this also takes them out of this list
|
||||
}
|
||||
dbg('cluster', "deleting node $call from cluster\n");
|
||||
$nodes-- if $nodes > 0;
|
||||
}
|
||||
|
||||
|
@ -60,6 +60,15 @@ sub start
|
||||
$self->{wwv} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1;
|
||||
$self->prompt() if $self->{state} =~ /^prompt/o;
|
||||
|
||||
# add yourself to the database
|
||||
my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database";
|
||||
my $cuser = DXNodeuser->new($self, $node, $call, 0, 1);
|
||||
$node->dxchan($self) if $call eq $main::myalias; # send all output for mycall to myalias
|
||||
|
||||
# issue a pc16 to everybody interested
|
||||
my $nchan = DXChannel->get($main::mycall);
|
||||
my $pc16 = $nchan->pc16($cuser);
|
||||
DXProt::broadcast_ak1a($pc16);
|
||||
}
|
||||
|
||||
#
|
||||
@ -133,7 +142,21 @@ sub process
|
||||
#
|
||||
sub finish
|
||||
{
|
||||
my $self = shift;
|
||||
my $call = $self->call;
|
||||
|
||||
if ($call eq $main::myalias) { # unset the channel if it is us really
|
||||
my $node = DXNode->get($main::mycall);
|
||||
$node->{dxchan} = 0;
|
||||
}
|
||||
my $ref = DXNodeuser->get($call);
|
||||
|
||||
# issue a pc17 to everybody interested
|
||||
my $nchan = DXChannel->get($main::mycall);
|
||||
my $pc17 = $nchan->pc17($ref);
|
||||
DXProt::broadcast_ak1a($pc17);
|
||||
|
||||
$ref->del() if $ref;
|
||||
}
|
||||
|
||||
#
|
||||
|
@ -23,14 +23,15 @@ use Date::Parse;
|
||||
use DXProtout;
|
||||
|
||||
use strict;
|
||||
use vars qw($me);
|
||||
|
||||
my $me; # the channel id for this cluster
|
||||
$me = undef; # the channel id for this cluster
|
||||
|
||||
sub init
|
||||
{
|
||||
my $user = DXUser->get($main::mycall);
|
||||
$me = DXChannel::alloc('DXProt', $main::mycall, undef, $user);
|
||||
$me->{sort} = 'M'; # M for me
|
||||
$me = DXProt->new($main::mycall, undef, $user);
|
||||
# $me->{sort} = 'M'; # M for me
|
||||
}
|
||||
|
||||
#
|
||||
@ -157,7 +158,7 @@ sub normal
|
||||
last SWITCH if !$node; # ignore if havn't seen a PC19 for this one yet
|
||||
my $i;
|
||||
|
||||
for ($i = 2; $i < $#field-1; $i++) {
|
||||
for ($i = 2; $i < $#field; $i++) {
|
||||
my ($call, $confmode, $here) = $field[$i] =~ /^(\w+) (-) (\d)/o;
|
||||
next if length $call < 3;
|
||||
next if !$confmode;
|
||||
@ -324,44 +325,6 @@ sub finish
|
||||
{
|
||||
my $self = shift;
|
||||
broadcast_ak1a($self->pc21('Gone.'));
|
||||
$self->delnode();
|
||||
}
|
||||
|
||||
#
|
||||
# add a (local) user to the cluster
|
||||
#
|
||||
|
||||
sub adduser
|
||||
{
|
||||
DXNodeuser->add(@_);
|
||||
}
|
||||
|
||||
#
|
||||
# delete a (local) user to the cluster
|
||||
#
|
||||
|
||||
sub deluser
|
||||
{
|
||||
my $self = shift;
|
||||
my $ref = DXCluster->get($self->call);
|
||||
$ref->del() if $ref;
|
||||
}
|
||||
|
||||
#
|
||||
# add a (locally connected) node to the cluster
|
||||
#
|
||||
|
||||
sub addnode
|
||||
{
|
||||
DXNode->new(@_);
|
||||
}
|
||||
|
||||
#
|
||||
# delete a (locally connected) node to the cluster
|
||||
#
|
||||
sub delnode
|
||||
{
|
||||
my $self = shift;
|
||||
my $ref = DXCluster->get($self->call);
|
||||
$ref->del() if $ref;
|
||||
}
|
||||
|
@ -145,9 +145,9 @@ sub extract
|
||||
# remove any /0-9 /P /A /M /MM /AM suffixes etc
|
||||
if (@parts > 1) {
|
||||
$p = $parts[$#parts];
|
||||
pop @parts if $p =~ /^\d+|[PABM]|AM|MM|BCN|SIX$/o;
|
||||
pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX)$/o;
|
||||
$p = $parts[$#parts];
|
||||
pop @parts if $p =~ /^\d+|[PABM]|AM|MM|BCN|SIX$/o;
|
||||
pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX)$/o;
|
||||
|
||||
# can we resolve them by direct lookup
|
||||
foreach $p (@parts) {
|
||||
|
11
perl/Spot.pm
11
perl/Spot.pm
@ -18,12 +18,13 @@ use Carp;
|
||||
@ISA = qw(Julian);
|
||||
|
||||
use strict;
|
||||
use vars qw($fp $maxspots $defaultspots $maxdays $dirprefix);
|
||||
|
||||
my $fp;
|
||||
my $maxspots = 50; # maximum spots to return
|
||||
my $defaultspots = 10; # normal number of spots to return
|
||||
my $maxdays = 35; # normal maximum no of days to go back
|
||||
my $dirprefix = "$main::data/spots";
|
||||
$fp = undef;
|
||||
$maxspots = 50; # maximum spots to return
|
||||
$defaultspots = 10; # normal number of spots to return
|
||||
$maxdays = 35; # normal maximum no of days to go back
|
||||
$dirprefix = "$main::data/spots";
|
||||
|
||||
sub prefix
|
||||
{
|
||||
|
@ -185,6 +185,9 @@ $SIG{'HUP'} = 'IGNORE';
|
||||
# initialise the protocol engine
|
||||
DXProt->init();
|
||||
|
||||
# put in a DXCluster node for us here so we can add users and take them away
|
||||
DXNode->new(0, $mycall, 0, 1, $DXProtvars::myprot_version);
|
||||
|
||||
# this, such as it is, is the main loop!
|
||||
print "orft we jolly well go ...\n";
|
||||
for (;;) {
|
||||
|
13
perl/dxcc.pl
13
perl/dxcc.pl
@ -1,6 +1,7 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# convert an Ak1a DX.DAT file to comma delimited form
|
||||
# Analyse the dxcc info in the prefix database, listing the 'official' country and its number
|
||||
# and also looking for duplicates and missing numbers
|
||||
#
|
||||
#
|
||||
|
||||
@ -15,8 +16,16 @@ sub comp
|
||||
return ($a->dxcc()-0) <=> ($b->dxcc()-0);
|
||||
}
|
||||
|
||||
$lastdxcc = 0;
|
||||
foreach $ref (sort {$a->dxcc() <=> $b->dxcc()} values %Prefix::prefix_loc) {
|
||||
$name = $ref->name();
|
||||
$dxcc = $ref->dxcc();
|
||||
print "dxcc: $dxcc name: $name\n";
|
||||
while ($lastdxcc < $dxcc - 1) {
|
||||
++$lastdxcc;
|
||||
print "dxcc: $lastdxcc name: ** MISSING\n";
|
||||
}
|
||||
$dup = "";
|
||||
$dup = "** DUPLICATE" if $dxcc == $lastdxcc;
|
||||
print "dxcc: $dxcc name: $name $dup\n";
|
||||
$lastdxcc = $dxcc;
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user