[ViewVC] Annotation of: cvs/aor/aorscan

#!/opt/bin/perl

# http://www.beepworld.de/members81/frequenzen/flughaefen.htm
# http://www.dia.unisa.it/professori/ads/corso-security/www/CORSO-9900/a5/Netsec/netsec.html
# http://www.scnt01426.pwp.blueyonder.co.uk/Articles/RS-232/AR-8000.htm

use List::Util;
use Array::Heap2;

use Fcntl;
use POSIX;
use Time::HiRes;

use Event;

use Coro;
use Coro::Event;
use Coro::Timer qw(sleep);
use Coro::Signal;

use PDL ();
#use PDL::FFTW;
#use PDL::Audio;
#use PDL::IO::Pic;

use PApp::SQL;

use strict;

sub BAUD()       { 9600 }
sub RESOLUTION() { 50 } # in Hz
sub round($)     { int ($_[0] / RESOLUTION + 0.5) * RESOLUTION }

sub AFT_INTERVAL_MIN()    { 3333 }

$PApp::SQL::DBH = PApp::SQL::connect_cached __FILE__, "DBI:mysql:database=aor;mysql_read_default_file=/root/.my.cnf"
   or die "unable to open mysql database aor";

my $tty = $ARGV[0] || "/dev/ttyS0";

sub AGC_MAX() { 26000 }

my $record_rate  = 48000;
my $record_init  = "amixer sset Mic cap";
my $record_set   = "amixer sset Capture {}%";
my $record_cmd   = "arecord -traw -c1 -fS16_LE -r$record_rate 2>/dev/null";
my $playback_on  = "amixer sset Mic unmute";
my $playback_off = "amixer sset Mic mute";
my $playback_set = "amixer sset Mic {}%";

sub imag($) {
   my ($pdl) = @_;
   wpic $pdl, "/tmp/aor.pgm";
   system "cv", "/tmp/aor.pgm";
}

sub acmd($;$) {
   my ($cmd, $arg) = @_;

   $cmd =~ s/\{\}/$arg/g;
   system "$cmd >/dev/null";
}

my $record_buf;
my $record_vol = 100;

sub record($$) {
   my ($data_cb, $done_cb) = @_;

   $record_buf = "";

   open my $fh, "-|", $record_cmd
      or die "$record_cmd: $!";

   Event->io (fd => $fh, poll => 'r', cb => sub {
      if (sysread $fh, $record_buf, 65536, length $record_buf) {
         if (4096 < length $record_buf) {
            # do the agc adjustment
            my $pdl = PDL::short (unpack "v*", substr $record_buf, -4096);
            if (AGC_MAX < $pdl->abs->max) {
               acmd $record_set, --$record_vol;
#               printf "AGC %d $record_vol\n", max abs $pdl;
            }
         }

         unless ($data_cb->()) {
            $_[0]->w->cancel;
            $done_cb->();
         }
      } else {
         $_[0]->w->cancel;
         $done_cb->();
      }
   });
}

sub record_nsamples($) {
   my $bytes = $_[0] * 2;

   my $done = new Coro::Signal;

   record sub {
      $bytes > length $record_buf
   }, sub {
      $done->send;
   };

   $done->wait;

   substr $record_buf, -$bytes
}

if ($ARGV[0] eq "--addrange") {
   my (undef, $mode, $lo, $hi, $step, $level) = @ARGV;

   my $cnt;
   while () {
      my $f = $lo + $cnt++ * $step;

      last if $f > $hi;

      eval {
         sql_exec "insert into freq (mode, freq, width, activity_level) values (?, ?, ?, ?)",
                  $mode, round $f, $step, $level;
      };
   }

   exit;
} elsif ($ARGV[0] eq "--daemon") {
   # nop
} else {
   # exit
}

my $NOW = time;

Event->timer (after => 0, interval => 1, hard => 1, prio => 3, cb => sub { $NOW = time });

open my $aor, "+<:raw", $tty
   or die "$tty: $!";

{
   my $tio = new POSIX::Termios;

   $tio->getattr (fileno $aor);

   $tio->setiflag (POSIX::IXOFF | POSIX::IXON);
   $tio->setoflag (0);
   $tio->setcflag (POSIX::CLOCAL | POSIX::CREAD | POSIX::CSTOPB | POSIX::CS8);
   $tio->setlflag (0);
   $tio->setispeed (&POSIX::B9600);
   $tio->setospeed (&POSIX::B9600);

   $tio->setattr (fileno $aor);
}

my %mode = (
   0 => "WFM",
   1 => "NFM",
   2 => "AM",
   3 => "USB",
   4 => "LSB",
   5 => "CW",
);

sub cmd($) {
#   print ">$_[0]<\n";#d#
#   fcntl $aor, F_SETFL, 0;
   syswrite $aor, "$_[0]\015\012";
}

sub delay($) {
   my $bytes = int ($_[0] * (BAUD / 11)) - 2;

   " " x ($bytes - 2)
}

cmd "MC1";   # mic off (0 = on, 1 = off, 2 = squelch)
cmd "ST000050"; # minimum stepsize
acmd $record_init;
acmd $record_set, $record_vol;
acmd $playback_off;

my @send_jobs;
my $send_requeue;
my ($curfreq, $curmode);
my $pipeline = 4;

my $rbuf;
my @resp_jobs;

sub send_scheduler {
   while (@send_jobs
          && @resp_jobs < $pipeline
          && (!@resp_jobs || !$resp_jobs[-1]{exclusive})
   ) {
      if ($send_requeue) {
         # re-sort queue
         $send_requeue = 0;

         @send_jobs = sort {
            $b->{nice} <=> $a->{nice}
            || $b->{mode} <=> $a->{mode}
            || $b->{freq} <=> $a->{freq};
         } @send_jobs;
      }

      my $job = pop @send_jobs;

      my ($cmd, @exp);

      if ($curmode != $job->{mode}) {
         $cmd .= "MD$job->{mode}\015\012";
         $curmode = $job->{mode};
      }

      if ($curfreq != $job->{freq}) {
         $cmd .= "RF$job->{freq}\015\012";
         $curfreq = $job->{freq};
      }

      printf "\r%d:%010d %4d %4d         ", $curmode, $curfreq, $job->{nice}, scalar @send_jobs;

      $job->{exp} = [];
      $job->{res} = [];

      for (@{ $job->{cmd} }) {
         push @exp, $1 if s/^(..)=//;
         $cmd .= "$_\015\012";
      }

      $job->{exp} = \@exp;
      $job->{res} = [];

      syswrite $aor, $cmd;

      if (@exp) {
         push @resp_jobs, $job;
      } else {
         $job->{done}->send;
      }
   }
}

Event->io (fd => $aor, prio => 1, poll => 'r', cb => sub {
   sysread $aor, $rbuf, 4096, length $rbuf;

   while ($rbuf =~ s/^([^\015\012]*)[\012\015]+//s) {
      my $line = $1;
      $line =~ s/[\012\015]//g;

      next unless $line =~ /^\S/;

      @resp_jobs or die "out of sync: expected nothing, but got '$line'\n";

      my $exp = shift @{ $resp_jobs[0]{exp} };

      $exp eq substr $line, 0, 2
         or die "sync error: expected '$exp', got '$line'\n";

      push @{ $resp_jobs[0]{res} }, $line;

      unless (@{ $resp_jobs[0]{exp} }) {
         my $job = shift @resp_jobs;

         $job->{exclusive}->() if $job->{exclusive};
         $job->{done}->send;

         send_scheduler;
      }

      next;
   }
});

sub job::result {
   my ($self) = @_;

   $self->{done}->wait;

   wantarray ? @{ $self->{res} } : $self->{res}[0]
}

sub job {
   my ($nice, $mode, $freq, @cmd) = @_;

   my $job = bless {
      freq => round $freq,
      mode => $mode,
      cmd  => \@cmd,
      done => new Coro::Signal,
      nice => $nice,
   }, job::;

   if (@cmd && ref $cmd[-1]) {
      $job->{exclusive} = pop @cmd;
   }

   push @send_jobs, $job;
   $send_requeue = 1;

   send_scheduler;

   $job
}

sub lm {
   map +(hex substr $_, 2) & 0x7f, @_
}

sub aft($$$$) {
   my ($nice, $mode, $center, $radius) = @_;

   $radius = List::Util::max RESOLUTION, $radius * 0.1;

   my @level = map [$_->{freq}, (List::Util::sum lm $_->result) / 5],
                  map +(job $nice, $mode, $center + $radius * $_, (delay 0.002, "LM=LM") x 5),
                     -10 .. 10;

   my ($tune, $weight);
   for (@level) {
      my ($f, $w) = @$_;

      $w **= 8;

      $tune   += $f * $w;
      $weight += $w;
   }

   my $lm = ($weight / @level) ** (1/8);

   (int ($tune / $weight / RESOLUTION) * RESOLUTION, $lm * 100)
}

sub sweep {
   my ($nice, $freqs, $cb) = @_;

   my @jobs = map {
      job $nice, $_->[0], $_->[1], "LM=LM";
   } @$freqs;

   $cb->($freqs->[$_], lm $jobs[$_]->result)
      for 0 .. $#jobs;
}

#############################################################################
# raw search

async {
   my $nice = 1000;

   while () {
      my @info = sql_fetchall "select mode, freq, activity_level from freq
                               where search_level < activity_level
                               order by search_time, mode, freq
                               limit 1000";

      if (@info) {
         sweep $nice, \@info, sub {
            my ($info, $lm) = @_;

            print "found new frequency $info->[0]:$info->[1] $lm>=$info->[2]\n"
               if $lm >= $info->[2];

            sql_exec "update freq set search_time = ?, search_level = ?
                      where mode = ? and freq = ?",
                     $NOW, $lm,
                     $info->[0], $info->[1];
         };
      } else {
         Coro::Timer::sleep 60;
      }
   }
};

#############################################################################
# aft of active freqs

async {
   my $nice = 500;

   while () {
      my @info = sql_fetchall
                        "select mode, freq, width, activity_level
                         from freq
                         where (search_level >= activity_level
                                or aft_time > 0)
                           and aft_time < ?
                         order by mode, freq
                         limit 100",
                        $NOW;

      if (@info) {
         sweep $nice, \@info, sub {
            my ($info, $lm) = @_;
            my ($mode, $freq, $width, $activity_level) = @$info;

            if ($lm >= $activity_level) {
               my ($tune, $weight) = aft $nice, $mode, $freq, $width * 0.9;

               print "$mode:$tune($freq) $lm>=$activity_level $weight ";

               if ($freq - 0.5 * $width <= $tune && $tune <= $freq + 0.5 * $width) {
                  print "tuned\n";
                  sql_exec "update freq set aft_time = ?, aft_freq = ?, aft_level = ?
                            where mode = ? and freq = ?",
                           $NOW + 86400*5 - (rand 86400), $tune, $weight,
                           $mode, $freq;
               } else {
                  # outlier
                  print "outlier\n";
                  sql_exec "update freq set aft_time = ?, aft_level = 0
                            where mode = ? and freq = ?",
                           $NOW + 86400*7 - (rand 86400),
                           $mode, $freq;
               }
            } else {
               # currently inactive
               sql_exec "update freq set aft_time = ?
                         where mode = ? and freq = ?",
                        $NOW + 10,
                        $mode, $freq;
            }
         };
         Coro::Timer::sleep 1;
      } else {
         Coro::Timer::sleep 10;
      }
   }
};

#############################################################################
# scan active freqs

async {
   return;
   my $nice = 100;

   while () {
      my $st = sql_exec \my ($mode, $freq, $width, $activity_level),
                        "select mode, aft_freq, width, activity_level
                         from freq
                         where aft_level > 0 and aft_freq > 0
                         order by freq, mode";

      if ($st->rows) {
         my @jobs;

         while ($st->fetch) {
            push @jobs, [$activity_level, job $nice, $mode, $freq, delay 0.040, "LM=LM"];
         }

         for (@jobs) {
            my ($activity_level, $job) = @$_;

            my @lm = lm $job->result;
            
            if ($lm[0] >= $activity_level) {
               warn "scan $job->{mode} $job->{freq} @lm\n";
               (job $nice-1, $mode, $job->{freq}, "LM=LM", sub {
#               (job $nice-1, 0, 98400000, "LM=LM", sub {
                  acmd $playback_on;
                  Coro::Timer::sleep 1;
#                  my $data = 0.5 + (1 / 65536) * float unpack "v*", record_nsamples $record_rate * 0.1;
                  acmd $playback_off;
                  #$data = sin +(1/480) * xvals zeroes 48000;
#                  $data->reshape (100, $record_rate / 100);
                  #
#                  my $spectrum = 120 + cat map spectrum ($data->slice ("($_),"), "dB", "KAISER"), 0..99;
#                  printf "%s %s\n", (min $spectrum), (max $spectrum);
#                  imag short $spectrum;
               })->result;
            }
         }

         Coro::Timer::sleep 60;
      } else {
         Coro::Timer::sleep 60;
      }
   }
};

#############################################################################

$| = 1;

Coro::Event::loop;

__END__
mysql -e "delete from freq" aor
./aorscan --addrange 1   26565000   27405000 10000               25
./aorscan --addrange 1   34360000   35800000 20000               25
./aorscan --addrange 1   38460000   39840000 20000               25
./aorscan --addrange 1   74215000   77455000 20000               25
./aorscan --addrange 1   84015000   87255000 20000               24
./aorscan --addrange 2  108000000  144000000 25000               20
./aorscan --addrange 1  118000000  136000000  8333.3333333333333 24
./aorscan --addrange 1  108000000  144000000 25000               24
./aorscan --addrange 4  165210000  169380000 20000               24
./aorscan --addrange 3  169810000  173980000 20000               24
./aorscan --addrange 1  230000000  328000000  8333.3333333333333 10
./aorscan --addrange 2  230000000  328000000 50000               20
./aorscan --addrange 1  438650000  439425000 25000               10
./aorscan --addrange 4  443600000  444962500 12500               10
./aorscan --addrange 3  448600000  449962500 12500               10
./aorscan --addrange 1 1270200000 1270700000 25000               10
./aorscan --addrange 1 1298200000 1298700000 25000               10

./aorscan --addrange 3    2690000    2690000 25000               10
./aorscan --addrange 3    3413000    3413000 25000               10
./aorscan --addrange 4    3413000    3413000 25000               10
./aorscan --addrange 3    5640000    5640000 25000               10
./aorscan --addrange 4    5640000    5640000 25000               10
./aorscan --addrange 3    8957000    8957000 25000               10
./aorscan --addrange 4    8957000    8957000 25000               10
./aorscan --addrange 3   13264000   13264000 25000               10
./aorscan --addrange 4   13264000   13264000 25000               10

Revision:	1.5
Committed:	Sun Oct 2 10:05:28 2005 UTC (20 years, 7 months ago) by root
Branch:	MAIN
Changes since 1.4:	+14 -12 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#!/opt/bin/perl
2
3			# http://www.beepworld.de/members81/frequenzen/flughaefen.htm
4			# http://www.dia.unisa.it/professori/ads/corso-security/www/CORSO-9900/a5/Netsec/netsec.html
5			# http://www.scnt01426.pwp.blueyonder.co.uk/Articles/RS-232/AR-8000.htm
6
7			use List::Util;
8			use Array::Heap2;
9
10			use Fcntl;
11			use POSIX;
12			use Time::HiRes;
13
14			use Event;
15
16			use Coro;
17	root	1.2	use Coro::Event;
18	root	1.1	use Coro::Timer qw(sleep);
19			use Coro::Signal;
20
21	root	1.2	use PDL ();
22			#use PDL::FFTW;
23			#use PDL::Audio;
24			#use PDL::IO::Pic;
25
26	root	1.1	use PApp::SQL;
27
28	root	1.2	use strict;
29
30	root	1.1	sub BAUD() { 9600 }
31			sub RESOLUTION() { 50 } # in Hz
32			sub round($) { int ($_[0] / RESOLUTION + 0.5) * RESOLUTION }
33
34	root	1.2	sub AFT_INTERVAL_MIN() { 3333 }
35	root	1.1
36			$PApp::SQL::DBH = PApp::SQL::connect_cached __FILE__, "DBI:mysql:database=aor;mysql_read_default_file=/root/.my.cnf"
37			or die "unable to open mysql database aor";
38
39	root	1.2	my $tty = $ARGV[0] \|\| "/dev/ttyS0";
40
41			sub AGC_MAX() { 26000 }
42
43			my $record_rate = 48000;
44			my $record_init = "amixer sset Mic cap";
45			my $record_set = "amixer sset Capture {}%";
46			my $record_cmd = "arecord -traw -c1 -fS16_LE -r$record_rate 2>/dev/null";
47			my $playback_on = "amixer sset Mic unmute";
48			my $playback_off = "amixer sset Mic mute";
49			my $playback_set = "amixer sset Mic {}%";
50
51			sub imag($) {
52			my ($pdl) = @_;
53			wpic $pdl, "/tmp/aor.pgm";
54			system "cv", "/tmp/aor.pgm";
55			}
56
57			sub acmd($;$) {
58			my ($cmd, $arg) = @_;
59
60			$cmd =~ s/\{\}/$arg/g;
61			system "$cmd >/dev/null";
62			}
63
64			my $record_buf;
65			my $record_vol = 100;
66
67			sub record($$) {
68			my ($data_cb, $done_cb) = @_;
69
70			$record_buf = "";
71
72			open my $fh, "-\|", $record_cmd
73			or die "$record_cmd: $!";
74
75			Event->io (fd => $fh, poll => 'r', cb => sub {
76			if (sysread $fh, $record_buf, 65536, length $record_buf) {
77			if (4096 < length $record_buf) {
78			# do the agc adjustment
79			my $pdl = PDL::short (unpack "v*", substr $record_buf, -4096);
80			if (AGC_MAX < $pdl->abs->max) {
81			acmd $record_set, --$record_vol;
82			# printf "AGC %d $record_vol\n", max abs $pdl;
83			}
84			}
85
86			unless ($data_cb->()) {
87			$_[0]->w->cancel;
88			$done_cb->();
89			}
90			} else {
91			$_[0]->w->cancel;
92			$done_cb->();
93			}
94			});
95			}
96
97			sub record_nsamples($) {
98			my $bytes = $_[0] * 2;
99
100			my $done = new Coro::Signal;
101
102			record sub {
103			$bytes > length $record_buf
104			}, sub {
105			$done->send;
106			};
107
108			$done->wait;
109
110			substr $record_buf, -$bytes
111			}
112
113	root	1.1	if ($ARGV[0] eq "--addrange") {
114			my (undef, $mode, $lo, $hi, $step, $level) = @ARGV;
115
116			my $cnt;
117			while () {
118			my $f = $lo + $cnt++ * $step;
119
120			last if $f > $hi;
121
122			eval {
123			sql_exec "insert into freq (mode, freq, width, activity_level) values (?, ?, ?, ?)",
124			$mode, round $f, $step, $level;
125			};
126			}
127
128			exit;
129			} elsif ($ARGV[0] eq "--daemon") {
130			# nop
131			} else {
132			# exit
133			}
134
135	root	1.2	my $NOW = time;
136	root	1.1
137	root	1.2	Event->timer (after => 0, interval => 1, hard => 1, prio => 3, cb => sub { $NOW = time });
138	root	1.1
139			open my $aor, "+<:raw", $tty
140			or die "$tty: $!";
141
142			{
143			my $tio = new POSIX::Termios;
144
145			$tio->getattr (fileno $aor);
146
147			$tio->setiflag (POSIX::IXOFF \| POSIX::IXON);
148			$tio->setoflag (0);
149			$tio->setcflag (POSIX::CLOCAL \| POSIX::CREAD \| POSIX::CSTOPB \| POSIX::CS8);
150			$tio->setlflag (0);
151			$tio->setispeed (&POSIX::B9600);
152			$tio->setospeed (&POSIX::B9600);
153
154			$tio->setattr (fileno $aor);
155			}
156
157			my %mode = (
158			0 => "WFM",
159			1 => "NFM",
160			2 => "AM",
161			3 => "USB",
162			4 => "LSB",
163			5 => "CW",
164			);
165
166			sub cmd($) {
167			# print ">$_[0]<\n";#d#
168			# fcntl $aor, F_SETFL, 0;
169			syswrite $aor, "$_[0]\015\012";
170			}
171
172			sub delay($) {
173			my $bytes = int ($_[0] * (BAUD / 11)) - 2;
174
175			" " x ($bytes - 2)
176			}
177
178			cmd "MC1"; # mic off (0 = on, 1 = off, 2 = squelch)
179			cmd "ST000050"; # minimum stepsize
180	root	1.2	acmd $record_init;
181			acmd $record_set, $record_vol;
182			acmd $playback_off;
183	root	1.1
184			my @send_jobs;
185	root	1.4	my $send_requeue;
186	root	1.1	my ($curfreq, $curmode);
187	root	1.2	my $pipeline = 4;
188	root	1.1
189			my $rbuf;
190			my @resp_jobs;
191
192			sub send_scheduler {
193	root	1.2	while (@send_jobs
194			&& @resp_jobs < $pipeline
195			&& (!@resp_jobs \|\| !$resp_jobs[-1]{exclusive})
196			) {
197	root	1.4	if ($send_requeue) {
198			# re-sort queue
199			$send_requeue = 0;
200
201			@send_jobs = sort {
202			$b->{nice} <=> $a->{nice}
203			\|\| $b->{mode} <=> $a->{mode}
204			\|\| $b->{freq} <=> $a->{freq};
205			} @send_jobs;
206			}
207
208			my $job = pop @send_jobs;
209	root	1.1
210			my ($cmd, @exp);
211
212			if ($curmode != $job->{mode}) {
213			$cmd .= "MD$job->{mode}\015\012";
214			$curmode = $job->{mode};
215			}
216
217			if ($curfreq != $job->{freq}) {
218			$cmd .= "RF$job->{freq}\015\012";
219			$curfreq = $job->{freq};
220			}
221
222	root	1.5	printf "\r%d:%010d %4d %4d ", $curmode, $curfreq, $job->{nice}, scalar @send_jobs;
223	root	1.4
224	root	1.1	$job->{exp} = [];
225			$job->{res} = [];
226
227			for (@{ $job->{cmd} }) {
228			push @exp, $1 if s/^(..)=//;
229			$cmd .= "$_\015\012";
230			}
231
232			$job->{exp} = \@exp;
233			$job->{res} = [];
234
235	root	1.2	syswrite $aor, $cmd;
236
237	root	1.1	if (@exp) {
238			push @resp_jobs, $job;
239			} else {
240			$job->{done}->send;
241			}
242			}
243			}
244
245			Event->io (fd => $aor, prio => 1, poll => 'r', cb => sub {
246	root	1.2	sysread $aor, $rbuf, 4096, length $rbuf;
247	root	1.1
248			while ($rbuf =~ s/^([^\015\012]*)[\012\015]+//s) {
249			my $line = $1;
250			$line =~ s/[\012\015]//g;
251
252			next unless $line =~ /^\S/;
253
254			@resp_jobs or die "out of sync: expected nothing, but got '$line'\n";
255
256			my $exp = shift @{ $resp_jobs[0]{exp} };
257
258			$exp eq substr $line, 0, 2
259			or die "sync error: expected '$exp', got '$line'\n";
260
261			push @{ $resp_jobs[0]{res} }, $line;
262
263			unless (@{ $resp_jobs[0]{exp} }) {
264	root	1.2	my $job = shift @resp_jobs;
265
266			$job->{exclusive}->() if $job->{exclusive};
267			$job->{done}->send;
268
269	root	1.1	send_scheduler;
270			}
271
272			next;
273			}
274			});
275
276			sub job::result {
277			my ($self) = @_;
278
279			$self->{done}->wait;
280
281			wantarray ? @{ $self->{res} } : $self->{res}[0]
282			}
283
284			sub job {
285			my ($nice, $mode, $freq, @cmd) = @_;
286
287			my $job = bless {
288			freq => round $freq,
289			mode => $mode,
290			cmd => \@cmd,
291			done => new Coro::Signal,
292	root	1.4	nice => $nice,
293	root	1.1	}, job::;
294
295	root	1.2	if (@cmd && ref $cmd[-1]) {
296			$job->{exclusive} = pop @cmd;
297			}
298
299	root	1.4	push @send_jobs, $job;
300			$send_requeue = 1;
301	root	1.1
302			send_scheduler;
303
304			$job
305			}
306
307			sub lm {
308			map +(hex substr $_, 2) & 0x7f, @_
309			}
310
311	root	1.2	sub aft($$$$) {
312			my ($nice, $mode, $center, $radius) = @_;
313	root	1.1
314			$radius = List::Util::max RESOLUTION, $radius * 0.1;
315
316			my @level = map [$_->{freq}, (List::Util::sum lm $_->result) / 5],
317	root	1.5	map +(job $nice, $mode, $center + $radius * $_, (delay 0.002, "LM=LM") x 5),
318	root	1.1	-10 .. 10;
319
320			my ($tune, $weight);
321			for (@level) {
322			my ($f, $w) = @$_;
323
324			$w **= 8;
325
326			$tune += $f * $w;
327			$weight += $w;
328			}
329
330	root	1.4	my $lm = ($weight / @level) ** (1/8);
331
332			(int ($tune / $weight / RESOLUTION) * RESOLUTION, $lm * 100)
333	root	1.1	}
334
335			sub sweep {
336	root	1.2	my ($nice, $freqs, $cb) = @_;
337	root	1.1
338	root	1.4	my @jobs = map {
339			job $nice, $_->[0], $_->[1], "LM=LM";
340			} @$freqs;
341	root	1.1
342	root	1.4	$cb->($freqs->[$_], lm $jobs[$_]->result)
343			for 0 .. $#jobs;
344	root	1.2	}
345	root	1.1
346	root	1.2	#############################################################################
347	root	1.4	# raw search
348	root	1.2
349			async {
350			my $nice = 1000;
351	root	1.1
352	root	1.2	while () {
353	root	1.5	my @info = sql_fetchall "select mode, freq, activity_level from freq
354			where search_level < activity_level
355	root	1.2	order by search_time, mode, freq
356	root	1.5	limit 1000";
357	root	1.2
358	root	1.5	if (@info) {
359			sweep $nice, \@info, sub {
360	root	1.4	my ($info, $lm) = @_;
361	root	1.2
362	root	1.5	print "found new frequency $info->[0]:$info->[1] $lm>=$info->[2]\n"
363			if $lm >= $info->[2];
364
365	root	1.2	sql_exec "update freq set search_time = ?, search_level = ?
366			where mode = ? and freq = ?",
367			$NOW, $lm,
368	root	1.4	$info->[0], $info->[1];
369	root	1.2	};
370			} else {
371			Coro::Timer::sleep 60;
372	root	1.1	}
373	root	1.2	}
374			};
375
376			#############################################################################
377			# aft of active freqs
378
379			async {
380			my $nice = 500;
381	root	1.1
382	root	1.2	while () {
383	root	1.4	my @info = sql_fetchall
384			"select mode, freq, width, activity_level
385	root	1.2	from freq
386			where (search_level >= activity_level
387			or aft_time > 0)
388			and aft_time < ?
389	root	1.4	order by mode, freq
390			limit 100",
391	root	1.2	$NOW;
392
393	root	1.4	if (@info) {
394			sweep $nice, \@info, sub {
395			my ($info, $lm) = @_;
396			my ($mode, $freq, $width, $activity_level) = @$info;
397	root	1.2
398	root	1.4	if ($lm >= $activity_level) {
399	root	1.2	my ($tune, $weight) = aft $nice, $mode, $freq, $width * 0.9;
400
401	root	1.5	print "$mode:$tune($freq) $lm>=$activity_level $weight ";
402	root	1.4
403	root	1.2	if ($freq - 0.5 * $width <= $tune && $tune <= $freq + 0.5 * $width) {
404	root	1.4	print "tuned\n";
405	root	1.2	sql_exec "update freq set aft_time = ?, aft_freq = ?, aft_level = ?
406			where mode = ? and freq = ?",
407	root	1.4	$NOW + 86400*5 - (rand 86400), $tune, $weight,
408	root	1.2	$mode, $freq;
409			} else {
410	root	1.3	# outlier
411	root	1.4	print "outlier\n";
412	root	1.2	sql_exec "update freq set aft_time = ?, aft_level = 0
413			where mode = ? and freq = ?",
414	root	1.4	$NOW + 86400*7 - (rand 86400),
415	root	1.2	$mode, $freq;
416			}
417			} else {
418			# currently inactive
419			sql_exec "update freq set aft_time = ?
420			where mode = ? and freq = ?",
421	root	1.5	$NOW + 10,
422	root	1.2	$mode, $freq;
423			}
424	root	1.4	};
425	root	1.5	Coro::Timer::sleep 1;
426	root	1.2	} else {
427	root	1.4	Coro::Timer::sleep 10;
428	root	1.2	}
429	root	1.1	}
430	root	1.2	};
431
432			#############################################################################
433			# scan active freqs
434	root	1.1
435			async {
436	root	1.5	return;
437	root	1.2	my $nice = 100;
438
439	root	1.1	while () {
440	root	1.2	my $st = sql_exec \my ($mode, $freq, $width, $activity_level),
441			"select mode, aft_freq, width, activity_level
442			from freq
443			where aft_level > 0 and aft_freq > 0
444			order by freq, mode";
445
446			if ($st->rows) {
447			my @jobs;
448
449			while ($st->fetch) {
450	root	1.4	push @jobs, [$activity_level, job $nice, $mode, $freq, delay 0.040, "LM=LM"];
451	root	1.2	}
452
453			for (@jobs) {
454			my ($activity_level, $job) = @$_;
455
456			my @lm = lm $job->result;
457
458			if ($lm[0] >= $activity_level) {
459			warn "scan $job->{mode} $job->{freq} @lm\n";
460			(job $nice-1, $mode, $job->{freq}, "LM=LM", sub {
461			# (job $nice-1, 0, 98400000, "LM=LM", sub {
462			acmd $playback_on;
463	root	1.4	Coro::Timer::sleep 1;
464	root	1.2	# my $data = 0.5 + (1 / 65536) * float unpack "v", record_nsamples $record_rate 0.1;
465			acmd $playback_off;
466			#$data = sin +(1/480) * xvals zeroes 48000;
467			# $data->reshape (100, $record_rate / 100);
468			#
469			# my $spectrum = 120 + cat map spectrum ($data->slice ("($_),"), "dB", "KAISER"), 0..99;
470			# printf "%s %s\n", (min $spectrum), (max $spectrum);
471			# imag short $spectrum;
472			})->result;
473			}
474			}
475	root	1.1
476	root	1.2	Coro::Timer::sleep 60;
477			} else {
478			Coro::Timer::sleep 60;
479			}
480	root	1.1	}
481			};
482
483	root	1.2	#############################################################################
484
485	root	1.4	$\| = 1;
486
487	root	1.1	Coro::Event::loop;
488
489			__END__
490			mysql -e "delete from freq" aor
491	root	1.2	./aorscan --addrange 1 26565000 27405000 10000 25
492			./aorscan --addrange 1 34360000 35800000 20000 25
493			./aorscan --addrange 1 38460000 39840000 20000 25
494			./aorscan --addrange 1 74215000 77455000 20000 25
495			./aorscan --addrange 1 84015000 87255000 20000 24
496			./aorscan --addrange 2 108000000 144000000 25000 20
497			./aorscan --addrange 1 118000000 136000000 8333.3333333333333 24
498			./aorscan --addrange 1 108000000 144000000 25000 24
499			./aorscan --addrange 4 165210000 169380000 20000 24
500			./aorscan --addrange 3 169810000 173980000 20000 24
501			./aorscan --addrange 1 230000000 328000000 8333.3333333333333 10
502			./aorscan --addrange 2 230000000 328000000 50000 20
503			./aorscan --addrange 1 438650000 439425000 25000 10
504			./aorscan --addrange 4 443600000 444962500 12500 10
505			./aorscan --addrange 3 448600000 449962500 12500 10
506			./aorscan --addrange 1 1270200000 1270700000 25000 10
507			./aorscan --addrange 1 1298200000 1298700000 25000 10
508
509			./aorscan --addrange 3 2690000 2690000 25000 10
510			./aorscan --addrange 3 3413000 3413000 25000 10
511			./aorscan --addrange 4 3413000 3413000 25000 10
512			./aorscan --addrange 3 5640000 5640000 25000 10
513			./aorscan --addrange 4 5640000 5640000 25000 10
514			./aorscan --addrange 3 8957000 8957000 25000 10
515			./aorscan --addrange 4 8957000 8957000 25000 10
516			./aorscan --addrange 3 13264000 13264000 25000 10
517			./aorscan --addrange 4 13264000 13264000 25000 10
518	root	1.1