From 6f566611af29f5c7af653abf8cec2760a0c25b6e Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 13 Jul 1998 00:55:51 +0000 Subject: [PATCH] started the spotting code. Got most of the utilities working. --- perl/DXCluster.pm | 17 +++++- perl/DXProt.pm | 29 +++++++--- perl/DXUtil.pm | 3 +- perl/DXdata.pm | 5 ++ perl/create_prefix.pl | 21 +++++++ perl/dxoldtonew.pl | 29 ++++++++++ perl/gdx.pl | 81 ++++++++++++++++++++++++++ perl/julian.pm | 117 ++++++++++++++++++++++++++++++++++++++ perl/spot.pm | 129 ++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 418 insertions(+), 13 deletions(-) create mode 100644 perl/DXdata.pm create mode 100755 perl/create_prefix.pl create mode 100755 perl/dxoldtonew.pl create mode 100755 perl/gdx.pl create mode 100644 perl/julian.pm create mode 100644 perl/spot.pm diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 920a33fb..b61cb341 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -28,6 +28,7 @@ my %valid = ( here => '0,Here?,yesno', dxchan => '5,Channel ref', pcversion => '5,Node Version', + list => '5,User List,dolist', ); sub alloc @@ -71,6 +72,11 @@ sub field_prompt return $valid{$ele}; } +sub dolist +{ + +} + no strict; sub AUTOLOAD { @@ -105,7 +111,7 @@ sub new return $self; } -sub delete +sub del { my $self = shift; $self->delcluster(); # out of the whole cluster table @@ -157,12 +163,12 @@ sub get_all 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}; } @@ -170,5 +176,10 @@ sub count { return %nodes + 1; # + 1 for ME! } + +sub dolist +{ + +} 1; __END__ diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 3b7bc514..ab023866 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -70,7 +70,10 @@ sub normal 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;} @@ -95,7 +98,10 @@ sub normal $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;} @@ -153,11 +159,11 @@ sub normal 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 } } @@ -234,11 +240,16 @@ sub delnode # # 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] diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 44ef7312..c82705b7 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -11,7 +11,7 @@ package DXUtil; 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); @@ -123,3 +123,4 @@ sub print_all_fields } return @out; } + diff --git a/perl/DXdata.pm b/perl/DXdata.pm new file mode 100644 index 00000000..e121fa09 --- /dev/null +++ b/perl/DXdata.pm @@ -0,0 +1,5 @@ +# +# +# main fairly static data area for the cluster +# +# diff --git a/perl/create_prefix.pl b/perl/create_prefix.pl new file mode 100755 index 00000000..2c94bdb1 --- /dev/null +++ b/perl/create_prefix.pl @@ -0,0 +1,21 @@ +# +# 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 () { + next if /^\!/; # ignore comment lines + chomp; + @f = split; # get each 'word' + @pre = split /\,/, $f[0]; # split the callsigns +} diff --git a/perl/dxoldtonew.pl b/perl/dxoldtonew.pl new file mode 100755 index 00000000..d5cb4c6e --- /dev/null +++ b/perl/dxoldtonew.pl @@ -0,0 +1,29 @@ +#!/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); diff --git a/perl/gdx.pl b/perl/gdx.pl new file mode 100755 index 00000000..8f6f2065 --- /dev/null +++ b/perl/gdx.pl @@ -0,0 +1,81 @@ +# +# 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 = ; + last if $field =~ /^q/i; + print "expr: "; + $expr = ; + + 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 () { + 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"; + } + } +} + diff --git a/perl/julian.pm b/perl/julian.pm new file mode 100644 index 00000000..c5cf43c8 --- /dev/null +++ b/perl/julian.pm @@ -0,0 +1,117 @@ +# +# 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; diff --git a/perl/spot.pm b/perl/spot.pm new file mode 100644 index 00000000..811a7080 --- /dev/null +++ b/perl/spot.pm @@ -0,0 +1,129 @@ +# +# 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; -- 2.43.0