here => '0,Here?,yesno',
dxchan => '5,Channel ref',
pcversion => '5,Node Version',
+ list => '5,User List,dolist',
);
sub alloc
return $valid{$ele};
}
+sub dolist
+{
+
+}
+
no strict;
sub AUTOLOAD
{
return $self;
}
-sub delete
+sub del
{
my $self = shift;
$self->delcluster(); # out of the whole cluster table
return @out;
}
-sub delete
+sub del
{
my $self = shift;
my $call = $self->call;
- DXUser->delete($call); # delete all the users one this node
+ DXUser->delete($call); # delete all the users on this node
delete $nodes{$call};
}
{
return %nodes + 1; # + 1 for ME!
}
+
+sub dolist
+{
+
+}
1;
__END__
SWITCH: {
if ($pcno == 10) {last SWITCH;}
- if ($pcno == 11) {last SWITCH;}
+ if ($pcno == 11) { # dx spot
+
+ last SWITCH;
+ }
if ($pcno == 12) {last SWITCH;}
if ($pcno == 13) {last SWITCH;}
if ($pcno == 14) {last SWITCH;}
$self->send($self->pc22());
return;
}
- if ($pcno == 21) {last SWITCH;}
+ if ($pcno == 21) { # delete a cluster from the list
+
+ last SWITCH;
+ }
if ($pcno == 22) {last SWITCH;}
if ($pcno == 23) {last SWITCH;}
if ($pcno == 24) {last SWITCH;}
my $hopfield = pop @field;
push @field, $hopfield;
- if ($hopfield =~ /H\d\d./o) {
- my ($hops) = $hopfield =~ /H(\d+)/o;
- $hops--;
- if ($hops > 0) {
- $line =~ s/\^H\d+(\^\~.)$/\^H$hops$1/; # change the hop count
+ my $hops;
+ if (($hops) = $hopfield =~ /H(\d+)\^\~?$/o) {
+ my $newhops = $hops - 1;
+ if ($newhops > 0) {
+ $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/; # change the hop count
DXProt->broadcast($line, $self); # send it to everyone but me
}
}
#
# route a message down an appropriate interface for a callsign
#
-# expects $self to indicate 'from' and is called $self->route(from, pcline);
+# expects $self to indicate 'from' and is called $self->route(to, pcline);
#
sub route
{
-
+ my ($self, $call, $line) = @_;
+ my $cl = DXCluster->get($call);
+ if ($cl) {
+ my $dxchan = $cl->{dxchan};
+ $cl->send($line) if $dxchan;
+ }
}
# broadcast a message to all clusters [except those mentioned after buffer]
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf
- print_all_fields
+ print_all_fields
);
@month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
}
return @out;
}
+
--- /dev/null
+#
+#
+# main fairly static data area for the cluster
+#
+#
--- /dev/null
+#
+# a program to create a prefix file from a wpxloc.raw file
+#
+# Copyright (c) - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+use DXVars;
+
+# open the input file
+$ifn = $ARGV[0] if $ARGV[0];
+$ifn = "$data/wpxloc.raw" if !$fn;
+open (IN, $ifn) or die "can't open $ifn ($!)";
+
+while (<IN>) {
+ next if /^\!/; # ignore comment lines
+ chomp;
+ @f = split; # get each 'word'
+ @pre = split /\,/, $f[0]; # split the callsigns
+}
--- /dev/null
+#!/usr/bin/perl
+#
+# convert an Ak1a DX.DAT file to comma delimited form
+#
+#
+
+use Date::Parse;
+use spot;
+
+sysopen(IN, "../data/DX.DAT", 0) or die "can't open DX.DAT ($!)";
+open(OUT, ">../data/dxcomma") or die "can't open dxcomma ($!)";
+
+spot->init();
+
+while (sysread(IN, $buf, 86)) {
+ ($freq,$call,$date,$time,$comment,$spotter) = unpack 'A10A13A12A6A31A14', $buf;
+ $date =~ s/^\s*(\d+)-(\w\w\w)-(19\d\d)$/$1 $2 $3/og;
+ $time =~ s/^(\d\d)(\d\d)Z$/$1:$2 +0000/;
+ $d = str2time("$date $time");
+ $comment =~ s/^\s+//o;
+ if ($d) {
+ spot->new($freq, $call, $d, $comment, $spotter);
+ } else {
+ print "$call $freq $date $time\n";
+ }
+}
+
+close(IN);
+close(OUT);
--- /dev/null
+#
+# grep for expressions in various fields of the dx file
+#
+
+use FileHandle;
+use DXUtil;
+use DXDebug;
+use spot;
+
+# initialise spots file
+$count = spot->init();
+
+dbgadd('spot');
+
+$field = $ARGV[0];
+$expr = $ARGV[1];
+$time = time;
+
+print "$count database records read in\n";
+
+STDOUT->autoflush(1);
+
+#loada();
+for (;;) {
+ print "field: ";
+ $field = <STDIN>;
+ last if $field =~ /^q/i;
+ print "expr: ";
+ $expr = <STDIN>;
+
+ chomp $field;
+ chomp $expr;
+
+ print "doing field $field with /$expr/\n";
+
+#a();
+ b();
+}
+
+sub b
+{
+ my @spots;
+ my @dx;
+ my $ref;
+ my $count;
+
+ @spots = spot->search($field, $expr);
+
+ foreach $ref (@spots) {
+ @dx = @$ref;
+ my $t = ztime($dx[2]);
+ my $d = cldate($dx[2]);
+ print "$dx[0] $dx[1] $d $t $dx[4] <$dx[3]>\n";
+ ++$count;
+ }
+ print "$count records found\n";
+}
+
+sub loada
+{
+ while (<IN>) {
+ chomp;
+ my @dx = split /\^/;
+ next if $time - $dx[2] > (84600 * 60);
+ unshift @spots, [ @dx ];
+ ++$count;
+ }
+}
+
+sub a
+{
+ foreach $ref (@spots) {
+ if ($$ref[$field] =~ /$expr/i) {
+ my @dx = @$ref;
+ my $t = ztime($dx[2]);
+ my $d = cldate($dx[2]);
+ print "$dx[0] $dx[1] $d $t $dx[4] <$dx[3]>\n";
+ }
+ }
+}
+
--- /dev/null
+#
+# various julian date calculations
+#
+# Copyright (c) - 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package julian;
+
+use FileHandle;
+use DXDebug;
+
+use strict;
+
+my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+
+# take a unix date and transform it into a julian day (ie (1998, 13) = 13th day of 1998)
+sub unixtoj
+{
+ my ($pkg, $t) = @_;
+ my ($day, $mon, $year) = (gmtime($t))[3..5];
+ my $jday;
+
+ # set the correct no of days for february
+ if ($year < 100) {
+ $year += ($year < 50) ? 2000 : 1900;
+ }
+ $days[1] = isleap($year) ? 29 : 28;
+ for (my $i = 0, $jday = 0; $i < $mon; $i++) {
+ $jday += $days[$i];
+ }
+ $jday += $day;
+ return ($year, $jday);
+}
+
+# take a julian date and subtract a number of days from it, returning the julian date
+sub sub
+{
+ my ($pkg, $year, $day, $amount) = @_;
+ my $diny = isleap($year) ? 366 : 365;
+ $day -= $amount;
+ while ($day <= 0) {
+ $day += $diny;
+ $year -= 1;
+ $diny = isleap($year) ? 366 : 365;
+ }
+ return ($year, $day);
+}
+
+sub add
+{
+ my ($pkg, $year, $day, $amount) = @_;
+ my $diny = isleap($year) ? 366 : 365;
+ $day += $amount;
+ while ($day > $diny) {
+ $day -= $diny;
+ $year += 1;
+ $diny = isleap($year) ? 366 : 365;
+ }
+ return ($year, $day);
+}
+
+sub cmp
+{
+ my ($pkg, $y1, $d1, $y2, $d2) = @_;
+ return $d1 - $d2 if ($y1 == $y2);
+ return $y1 - $y2;
+}
+
+# is it a leap year?
+sub isleap
+{
+ my $year = shift;
+ return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0;
+}
+
+# open a data file with prefix $fn/$year/$day.dat and return an object to it
+sub open
+{
+ my ($name, $pkg, $fn, $year, $day, $mode) = @_;
+
+ # if we are writing, check that the directory exists
+ if (defined $mode) {
+ my $dir = "$fn/$year";
+ mkdir($dir, 0777) if ! -e $dir;
+ }
+ my $self = {};
+ $self->{fn} = sprintf "$fn/$year/%03d.dat", $day;
+ $mode = 'r' if !$mode;
+ my $fh = new FileHandle $self->{fn}, $mode;
+ return undef if !$fh;
+ $fh->autoflush(1) if $mode ne 'r'; # make it autoflushing if writable
+ $self->{fh} = $fh;
+ $self->{year} = $year;
+ $self->{day} = $day;
+ dbg("julian", "opening $self->{fn}\n");
+
+ return bless $self, $pkg;
+}
+
+# close the data file
+sub close
+{
+ my $self = shift;
+ undef $self->{fh}; # close the filehandle
+ delete $self->{fh};
+}
+
+sub DESTROY # catch undefs and do what is required further do the tree
+{
+ my $self = shift;
+ dbg("julian", "closing $self->{fn}\n");
+ undef $self->{fh} if defined $self->{fh};
+}
+
+1;
--- /dev/null
+#
+# the dx spot handler
+#
+# Copyright (c) - 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package spot;
+
+use FileHandle;
+use DXVars;
+use DXDebug;
+use julian;
+
+@ISA = qw(julian);
+
+use strict;
+
+my $fp;
+my $maxdays = 60; # maximum no of days to store spots in the table
+my $prefix = "$main::data/spots";
+my @table = (); # the list of spots (held in reverse order)
+
+# read in n days worth of dx spots into memory
+sub init
+{
+ my @today = julian->unixtoj(time); # get the julian date now
+ my @first = julian->sub(@today, $maxdays); # get the date $maxdays ago
+ my $count;
+
+ mkdir($prefix, 0777) if ! -e $prefix; # create the base directory if required
+ for (my $i = 0; $i < $maxdays; ++$i) {
+ my $ref = spot->open(@first);
+ if ($ref) {
+ my $fh = $ref->{fh};
+ while (<$fh>) {
+ chomp;
+ my @ent = split /\^/;
+ unshift @spot::table, [ @ent ]; # stick this ref to anon list on the FRONT of the table
+ ++$count;
+ }
+ }
+ @first = julian->add(@first, 1);
+ }
+ return $count;
+}
+
+# create a new spot on the front of the list, add it to the data file
+sub new
+{
+ my $pkg = shift;
+ my @spot = @_; # $freq, $call, $t, $comment, $spotter = @_
+
+ # sure that the numeric things are numeric now (saves time later)
+ $spot[0] = 0 + $spot[0];
+ $spot[2] = 0 + $spot[2];
+
+ # save it on the front of the list
+ unshift @spot::table, [ @spot ];
+
+ # compare dates to see whether need to open a other save file
+ my @date = julian->unixtoj($spot[2]);
+ $fp = spot->open(@date, ">>") if (!$fp || julian->cmp(@date, $fp->{year}, $fp->{day}));
+ my $fh = $fp->{fh};
+ $fh->print(join("\^", @spot), "\n");
+}
+
+# purge all the spots older than $maxdays - this is fairly approximate
+# this should be done periodically from some cron task
+sub purge
+{
+ my $old = time - ($maxdays * 86400);
+ my $ref;
+
+ while (@spot::table) {
+ my $ref = pop @spot::table;
+ if (${$ref}[2] > $old) {
+ push @spot::table, $ref; # put it back
+ last; # and leave
+ }
+ }
+}
+
+# search the spot database for records based on the field no and an expression
+# this returns a set of references to the spots
+#
+# for string fields supply a pattern to match
+# for numeric fields supply a range of the format 'n > x && n < y' (the n will
+# changed to the correct field name) [ n is literally the letter 'n' ]
+#
+sub search
+{
+ my ($pkg, $field, $expr) = @_;
+ my $eval;
+ my @out;
+ my $ref;
+
+ dbg('spot', "input expr = $expr\n");
+ if ($field == 0 || $field == 2) { # numeric fields
+ $expr =~ s/n/\$ref->[$field]/g; # swap the letter n for the correct field name
+ } else {
+ $expr = qq(\$ref->[$field] =~ /$expr/oi); # alpha expressions
+ }
+ dbg('spot', "expr now = $expr\n");
+
+ # build up eval to execute
+ $eval = qq(foreach \$ref (\@spot::table) {
+ push \@out, \$ref if $expr;
+ });
+ dbg('spot', "eval = $eval\n");
+ eval $eval; # execute it
+ return @out;
+}
+
+# open a spot file of the julian day
+sub open
+{
+ my $pkg = shift;
+ return julian->open("spot", $prefix, @_);
+}
+
+# close a spot file
+sub close
+{
+ # do nothing, unreferencing or overwriting the $self will close it
+}
+
+1;