started the spotting code. Got most of the utilities working.
authordjk <djk>
Mon, 13 Jul 1998 00:55:51 +0000 (00:55 +0000)
committerdjk <djk>
Mon, 13 Jul 1998 00:55:51 +0000 (00:55 +0000)
perl/DXCluster.pm
perl/DXProt.pm
perl/DXUtil.pm
perl/DXdata.pm [new file with mode: 0644]
perl/create_prefix.pl [new file with mode: 0755]
perl/dxoldtonew.pl [new file with mode: 0755]
perl/gdx.pl [new file with mode: 0755]
perl/julian.pm [new file with mode: 0644]
perl/spot.pm [new file with mode: 0644]

index 920a33fbe79edea5c007e0e429c6056419cef270..b61cb3411da12f62ace223e5da883fc40116f917 100644 (file)
@@ -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__
index 3b7bc514fa6f77c4bf1e9a68736f3d07450bc4db..ab023866cc96c322b918711a86b1d976e52d3861 100644 (file)
@@ -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]
index 44ef7312fdad8c7fd7a0293dcf63f6e3840a5cea..c82705b7bb68507cb0725f69f7dafc03df5b08ef 100644 (file)
@@ -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 (file)
index 0000000..e121fa0
--- /dev/null
@@ -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 (executable)
index 0000000..2c94bdb
--- /dev/null
@@ -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 (<IN>) {
+  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 (executable)
index 0000000..d5cb4c6
--- /dev/null
@@ -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 (executable)
index 0000000..8f6f206
--- /dev/null
@@ -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 = <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";
+       }
+  }
+}
+
diff --git a/perl/julian.pm b/perl/julian.pm
new file mode 100644 (file)
index 0000000..c5cf43c
--- /dev/null
@@ -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 (file)
index 0000000..811a708
--- /dev/null
@@ -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;