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',
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)]
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',
return values(%cluster);
}
-sub delcluster;
-{
- my $self = shift;
- delete $cluster{$self->{call}};
-}
-
-
# return a prompt for a field
sub field_prompt
{
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;
}
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;
}
$self->{version} = $pcversion;
$self->{list} = { } ;
$nodes++;
- dbg('cluster', "allocating node $self->{call}\n");
+ dbg('cluster', "allocating node $call to cluster\n");
return $self;
}
{
my $list;
my @out;
- foreach $list (values(%cluster)) {
+ foreach $list (values(%DXCluster::cluster)) {
push @out, $list if $list->{pcversion};
}
return @out;
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;
}
# set some necessary flags on the user if they are connecting
$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);
}
#
#
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;
}
#
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
}
#
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;
{
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;
}
# 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) {
@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
{
# 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 (;;) {
#!/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
#
#
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;
}
projects / spider.git / commitdiff