From c83b1ca22765fc07e5adcdc8dac24cbd066c9b95 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sat, 13 Nov 2021 23:08:22 +0000 Subject: [PATCH] experimental branch to improve spot query This includes some SQLite changes as well as spot searching --- cmd/show/dx.pl | 10 +++---- perl/DXCommandmode.pm | 7 ++++- perl/DXSql.pm | 57 +++++++++++++++++++++------------------ perl/DXSql/SQLite.pm | 6 ++++- perl/Spot.pm | 63 ++++++++++++++++++++++++++++++++++++++----- perl/cluster.pl | 19 +++++-------- 6 files changed, 108 insertions(+), 54 deletions(-) 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"); } -- 2.34.1