From: Dirk Koopman <djk@tobit.co.uk>
Date: Sat, 13 Nov 2021 23:08:22 +0000 (+0000)
Subject: experimental branch to improve spot query
X-Git-Url: http://dxspider.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=c83b1ca22765fc07e5adcdc8dac24cbd066c9b95;p=spider.git
experimental branch to improve spot query
This includes some SQLite changes as well as spot searching
---
diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl
index 5387b7f4..7e4d3a35 100644
--- a/cmd/show/dx.pl
+++ b/cmd/show/dx.pl
@@ -143,11 +143,7 @@ sub handle
} else {
$pre .= '*' unless $pre =~ /[\*\?\[]$/o;
$pre = shellregex($pre);
- if ($usesql) {
- $pre =~ s/\.\*/%/g;
- } else {
- $pre =~ s/\.\*\$$//;
- }
+ $pre =~ s/\.\*\$$//;
$pre .= '$' if $exact;
$pre =~ s/\^//;
push @flist, 'call', $pre;
@@ -167,7 +163,7 @@ sub handle
# now do the search
if ($self->{_nospawn}) {
- my @res = Spot::search($expr, $fromday, $today, $from, $to, $user, $dofilter ? $self : undef);
+ my @res = Spot::search($expr, $fromday, $today, $from, $to, $user, $dofilter, $self);
my $ref;
my @dx;
foreach $ref (@res) {
@@ -186,7 +182,7 @@ sub handle
}
else {
push @out, $self->spawn_cmd("sh/dx $line", \&Spot::search,
- args => [$expr, $fromday, $today, $from, $to, $filter, $dofilter ? $self : undef],
+ args => [$expr, $fromday, $today, $from, $to, $filter, $dofilter, $self],
cb => sub {
my ($dxchan, @res) = @_;
my $ref;
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index ce3c2d1f..bcf1bf07 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -1339,7 +1339,12 @@ sub spawn_cmd
$s .= ", args: " . join(', ', map { defined $_ ? qq{'$_'} : q{'undef'} } @$args) if $args && @$args;
dbg($s);
}
- eval { @out = $cmdref->(@$args); };
+ eval {
+ ++$self->{_in_sub_process};
+ dbg "\$self->{_in_sub_process} = $self->{_in_sub_process}";
+ @out = $cmdref->(@$args);
+ --$self->{_in_sub_process} if $self->{_in_sub_process} > 0;
+ };
if ($@) {
DXDebug::dbgprintring(25);
push @out, DXDebug::shortmess($@);
diff --git a/perl/DXSql.pm b/perl/DXSql.pm
index 842e3005..242ab0a8 100644
--- a/perl/DXSql.pm
+++ b/perl/DXSql.pm
@@ -60,7 +60,8 @@ sub connect
my $dbh;
eval {
no strict 'refs';
- $dbh = DBI->connect($dsn, $user, $passwd);
+ $dbh = DBI->connect($dsn, $user, $passwd);
+ dbg "DXSql $dsn " . $dbh? "connected" : "NOT connected" if isdbg('dxsql');
};
unless ($dbh) {
$active = 0;
@@ -149,33 +150,37 @@ sub spot_insert
sub spot_search
{
my $self = shift;
- my $expr = shift;
- my $dayfrom = shift;
- my $dayto = shift;
- my $n = shift;
- my $dxchan = shift;
+ my ($expr, $dayfrom, $dayto, $from, $to, $hint, $dofilter, $dxchan) = @_;
+ $dayfrom = 0 if !$dayfrom;
+ $dayto = $Spot::maxdays unless $dayto;
+ $dayto = $dayfrom + $Spot::maxdays if $dayto < $dayfrom;
+ my $today = Julian::Day->new(time());
+ my $fromdate = $today->sub($dayfrom);
+ my $todate = $fromdate->sub($dayto);
+ $from = 0 unless $from;
+ $to = $Spot::defaultspots unless $to;
- dbg("expr: $expr") if isdbg('search');
- if ($expr =~ /\$f/) {
+ dbg("DXSql expr: $expr") if isdbg('search');
+ if ($expr =~ /\$r->/) {
$expr =~ s/(?:==|eq)/ = /g;
- $expr =~ s/\$f10/spotteritu/g;
- $expr =~ s/\$f11/spottercq/g;
- $expr =~ s/\$f12/spotstate/g;
- $expr =~ s/\$f13/spotterstate/g;
- $expr =~ s/\$f14/ipaddr/g;
- $expr =~ s/\$f0/freq/g;
- $expr =~ s/\$f1/spotcall/g;
- $expr =~ s/\$f2/time/g;
- $expr =~ s/\$f3/comment/g;
- $expr =~ s/\$f4/spotter/g;
- $expr =~ s/\$f5/spotdxcc/g;
- $expr =~ s/\$f6/spotterdxcc/g;
- $expr =~ s/\$f7/origin/g;
- $expr =~ s/\$f8/spotitu/g;
- $expr =~ s/\$f9/spotcq/g;
+ $expr =~ s/\$r->\[10\]/spotteritu/g;
+ $expr =~ s/\$r->\[11\]/spottercq/g;
+ $expr =~ s/\$r->\[12\]/spotstate/g;
+ $expr =~ s/\$r->\[13\]/spotterstate/g;
+ $expr =~ s/\$r->\[14\]/ipaddr/g;
+ $expr =~ s/\$r->\[0\]/freq/g;
+ $expr =~ s/\$r->\[1\]/spotcall/g;
+ $expr =~ s/\$r->\[2\]/time/g;
+ $expr =~ s/\$r->\[3\]/comment/g;
+ $expr =~ s/\$r->\[4\]/spotter/g;
+ $expr =~ s/\$r->\[5\]/spotdxcc/g;
+ $expr =~ s/\$r->\[6\]/spotterdxcc/g;
+ $expr =~ s/\$r->\[7\]/origin/g;
+ $expr =~ s/\$r->\[8\]/spotitu/g;
+ $expr =~ s/\$r->\[9\]/spotcq/g;
$expr =~ s/\|\|/ or /g;
$expr =~ s/\&\&/ and /g;
- $expr =~ s/=~\s+m\{\^([%\w]+)[^\}]*\}/ like '$1'/g;
+ $expr =~ s/=~\s*m\{\^([%\w]+)[^\}]*\}/ like '$1\%'/g;
} else {
$expr = '';
}
@@ -185,8 +190,8 @@ sub spot_search
$expr .= $expr ? " and $trange" : $trange;
my $s = qq{select freq,spotcall,time,comment,spotter,spotdxcc,spotterdxcc,
origin,spotitu,spotcq,spotteritu,spottercq,spotstate,spotterstate,ipaddr from spot
-where $expr order by time desc limit $n};
- dbg("sql expr: $s") if isdbg('search');
+where $expr limit $to};
+ dbg("DXSql expr: $s") if isdbg('search');
my $ref = $self->{dbh}->selectall_arrayref($s);
return @$ref;
}
diff --git a/perl/DXSql/SQLite.pm b/perl/DXSql/SQLite.pm
index 2330837f..36bcc46d 100644
--- a/perl/DXSql/SQLite.pm
+++ b/perl/DXSql/SQLite.pm
@@ -80,9 +80,13 @@ sub spot_add_indexes
{
my $self = shift;
dbg('adding spot index ix1');
- $self->do('create index spot_ix1 on spot(time desc)');
+ $self->do('create index spot_ix1 on spot(time asc)');
dbg('adding spot index ix2');
$self->do('create index spot_ix2 on spot(spotcall asc)');
+ dbg('adding spot index ix3');
+ $self->do('create index spot_ix3 on spot(freq asc)');
+ dbg('adding spot index ix4');
+ $self->do('create index spot_ix4 on spot(spotter asc)');
}
diff --git a/perl/Spot.pm b/perl/Spot.pm
index 2205cc5b..bed8bd20 100644
--- a/perl/Spot.pm
+++ b/perl/Spot.pm
@@ -18,6 +18,8 @@ use Prefix;
use DXDupe;
use Data::Dumper;
use QSL;
+use DXSql;
+use Julian;
use strict;
@@ -66,6 +68,10 @@ $filterdef = bless ([
$totalspots = $hfspots = $vhfspots = 0;
$use_db_for_search = 0;
+our %spotcache; # the cache of data within the last $spotcachedays 0 or 2+ days
+our $spotcachedays = 0;
+
+
our $readback = 1;
if ($readback) {
@@ -124,6 +130,7 @@ sub init
mkdir "$dirprefix", 0777 if !-e "$dirprefix";
$fp = DXLog::new($dirprefix, "dat", 'd');
$statp = DXLog::new($dirprefix, "dys", 'd');
+ my $today = Julian::Day->new(time);
# load up any old spots
if ($main::dbh) {
@@ -134,7 +141,6 @@ sub init
$main::dbh->spot_create_table;
my $now = Julian::Day->alloc(1995, 0);
- my $today = Julian::Day->new(time);
my $sth = $main::dbh->spot_insert_prepare;
while ($now->cmp($today) <= 0) {
my $fh = $fp->open($now);
@@ -177,6 +183,34 @@ sub init
dbg("added ipaddr field to spot table");
}
}
+
+ # initialise the cache if required
+ if ($spotcachedays) {
+ $spotcachedays = 2 if $spotcachedays < 2;
+ my $now = $today->sub($spotcachedays);
+ while ($now->cmp($today) >= 0) {
+ my $fh = $fp->open($now);
+ if ($fh) {
+ my @in;
+ while (<$fh>) {
+ chomp;
+ my @s = split /\^/;
+ if (@s < 14) {
+ my @a = (Prefix::cty_data($s[1]))[1..3];
+ my @b = (Prefix::cty_data($s[4]))[1..3];
+ push @s, $b[1] if @s < 7;
+ push @s, '' if @s < 8;
+ push @s, @a[0,1], @b[0,1] if @s < 12;
+ push @s, $a[2], $b[2] if @s < 14;
+ }
+ push @in, \@s;
+ }
+ $fh->close;
+ $spotcache{"$now->[0]|$now->[1]"} = \@in;
+ }
+ $now->add(1);
+ }
+ }
}
sub prefix
@@ -220,6 +254,19 @@ sub add
{
my $buf = join('^', @_);
$fp->writeunix($_[2], $buf);
+ if ($spotcachedays) {
+ my $now = Julian::Day->new($_[2]);
+ my $day = "$now->[0]|$now->[1]";
+ my $r = exists $spotcache{$day} ? $spotcache{$day} : $spotcache{$day} = [];
+ unshift @$r, @_;
+
+ # remove old days
+ while (keys %spotcache > $spotcachedays+1) {
+ while (sort keys %spotcache > $spotcachedays+1) {
+ delete $spotcache{$_};
+ }
+ }
+ }
if ($main::dbh) {
$main::dbh->begin_work;
$main::dbh->spot_insert(\@_);
@@ -270,7 +317,7 @@ sub add
sub search
{
- my ($expr, $dayfrom, $dayto, $from, $to, $hint, $dxchan) = @_;
+ my ($expr, $dayfrom, $dayto, $from, $to, $hint, $dofilter, $dxchan) = @_;
my @out;
my $ref;
my $i;
@@ -292,7 +339,7 @@ sub search
$to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0;
if ($main::dbh && $use_db_for_search) {
- return $main::dbh->spot_search($hint, $dayfrom, $dayto, $to-$from, $dxchan);
+ return $main::dbh->spot_search($expr, $dayfrom, $dayto, $from, $to, $hint, $dofilter, $dxchan);
}
# $expr =~ s/\$f(\d\d?)/\$ref->[$1]/g; # swap the letter n for the correct field name
@@ -312,12 +359,14 @@ sub search
my $fh;
my $now = $fromdate;
- my @spots;
- my $recs;
+ my $today = Julian::Day->new($main::systime);
for ($i = $count = 0; $count < $to && $i < $maxdays; ++$i) { # look thru $maxdays worth of files only
last if $now->cmp($todate) <= 0;
-
+
+ if ($spotcachedays) {
+
+ }
my $fn = $fp->fn($now->sub($i));
if ($readback) {
dbg("Spot::search search using tac fn: $fn $i") if isdbg('search');
@@ -334,7 +383,7 @@ sub search
chomp;
my @r = split /\^/;
++$rec;
- if ($dxchan) {
+ if ($dofilter && $dxchan && $dxchan->{spotsfilter}) {
my ($gotone, undef) = $dxchan->{spotsfilter}->it(@r);
next unless $gotone;
}
diff --git a/perl/cluster.pl b/perl/cluster.pl
index c9b49182..4c0f374c 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -660,26 +660,23 @@ sub setup_start
dbg("Start WCY");
WCY->init();
- # initial the Spot stuff
- dbg("Starting DX Spot system");
- Spot->init();
-
# initialise the protocol engine
dbg("Start Protocol Engines ...");
DXProt->init();
- # put in a DXCluster node for us here so we can add users and take them away
- $routeroot = Route::Node->new($mycall, $version*100+5300, Route::here($main::me->here)|Route::conf($main::me->conf));
- $routeroot->do_pc9x(1);
- $routeroot->via_pc92(1);
-
# make sure that there is a routing OUTPUT node default file
#unless (Filter::read_in('route', 'node_default', 0)) {
# my $dxcc = $main::me->dxcc;
# $Route::filterdef->cmd($main::me, 'route', 'accept', "node_default call $mycall" );
#}
- # read in any existing message headers and clean out old crap
+ my $script = new Script "startup";
+ $script->run($main::me) if $script;
+
+ # initial the Spot stuff
+ dbg("Starting DX Spot system");
+ Spot->init(); #
+
dbg("reading existing message headers ...");
DXMsg->init();
DXMsg::clean_old();
@@ -708,8 +705,6 @@ sub setup_start
# this, such as it is, is the main loop!
dbg("orft we jolly well go ...");
- my $script = new Script "startup";
- $script->run($main::me) if $script;
#open(DB::OUT, "|tee /tmp/aa");
}