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 5387b7f407657ee5591711a0ae6a040abc5bf04b..7e4d3a3587e8d7c655820f5c560dd1d5979130d3 100644 (file)
--- 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 ce3c2d1f285202291e3fd8667fadcff62817b05f..bcf1bf075b9beda9f40279bb70b59fbcf4f5e008 100644 (file)
--- 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 842e30054fc1a8c00db5f483d8593ef02b25e10b..242ab0a8d54dbb3120b33ae5af6570f106a563e3 100644 (file)
--- 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 2330837f41cd4b2192dc2821f926ff917c00653b..36bcc46da72554ae53721a85b147f8f6868b0e6b 100644 (file)
--- 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 2205cc5bce1e127226599e66a866e9928d571688..bed8bd20297372fbca7e14233942e1c68029fb77 100644 (file)
--- 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 c9b49182d09f9965c7174e295bd833649f514525..4c0f374c3eca9bfc54304b4826bef353bb851bab 100755 (executable)
--- 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");
 }