[ViewVC] Contents 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 SEARCH_INTERVAL_MIN() {  555 }
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 ($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})
   ) {
      my $job = (pop_heap @send_jobs)->[1];

      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};
      }

      $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,
   }, job::;

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

   push_heap @send_jobs, [$nice, $job];

   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.0020, "LM=LM") x 5),
                     -10 .. 10;

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

      $w **= 8;

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

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

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

   my $job;

   for (@$freqs, undef) {
      my ($mode, $freq, $width) = $_ ? @$_ : ();

      my $next_job = $freq && job $nice, $mode, $freq, delay 0.050, "LM=LM";

      $cb->($mode, $freq, $width, lm $job->result)
         if $job;

      $job = $next_job;
   }
}

#############################################################################
# raw aearch

async {
   my $nice = 1000;

   while () {
      my @freq = sql_fetchall "select mode, freq, width from freq
                               where search_time < ?
                               order by search_time, mode, freq
                               limit 1000",
                              $NOW - SEARCH_INTERVAL_MIN;

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

            sql_exec "update freq set search_time = ?, search_level = ?
                      where mode = ? and freq = ?",
                     $NOW, $lm,
                     $mode, $freq;
         };
      } else {
         Coro::Timer::sleep 60;
      }
   }
};

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

async {
   my $nice = 500;

   while () {
      my $st = sql_exec \my ($aft_time, $mode, $freq, $width, $activity_level),
                        "select aft_time, mode, freq, width, activity_level
                         from freq
                         where (search_level >= activity_level
                                or aft_time > 0)
                           and aft_time < ?
                         order by aft_time, mode, freq
                         limit 10",
                        $NOW;

      if ($st->rows) {
         while ($st->fetch) {
            my @lm = lm +(job $nice, $mode, $freq, delay 0.050, "LM=LM")->result;

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

               if ($freq - 0.5 * $width <= $tune && $tune <= $freq + 0.5 * $width) {
                  sql_exec "update freq set aft_time = ?, aft_freq = ?, aft_level = ?
                            where mode = ? and freq = ?",
                           $NOW + 86400 - 3600, $tune, $weight,
                           $mode, $freq;
               } else {
                  sql_exec "update freq set aft_time = ?, aft_level = 0
                            where mode = ? and freq = ?",
                           $NOW + 86400 + 3600,
                           $mode, $freq;
               }
            } else {
               # currently inactive
               sql_exec "update freq set aft_time = ?
                         where mode = ? and freq = ?",
                        $NOW + 3600,
                        $mode, $freq;
            }
         }
      } else {
         Coro::Timer::sleep 60;
      }
   }
};

#############################################################################
# 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.030, "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 0.5;
#                  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;
      }
   }
};

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

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