[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 MD_DELAY()   { 0.0010 } # delay after mode switch
sub RF_DELAY()   { 0.0040 } # delay after freq change

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 {}%";

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
}

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 = 7; # 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 && $record_vol) {
#            # do the agc adjustment
#            my $pdl = PDL::Core::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
}

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",
);

my %parse_resp = (
   LM => sub { 0x7f & hex substr $_, 2 },
);

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

# seconds, overhead
sub delay($;$) {
   my $bytes = int $_[0] * (BAUD / 11) - $_[1];

   " " x ($bytes - 2)
}

sub tune($$) {
   (
      "MD$_[0]" . (delay MD_DELAY, 4),
      "RF" . (round $_[1]) . (delay RF_DELAY, 4),
   )
}

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 $resp_buf;
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);

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

      for (@{ $job->{cmd} }) {
         if (/^MD/) {
            next if $curmode eq $_;
            $curmode = $_;
         } elsif (/^RF/) {
            next if $curfreq eq $_;
            $curfreq = $_;
         }

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

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

      $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, $resp_buf, 4096, length $resp_buf;

   while ($resp_buf =~ s/^([^\015\012]*)[\012\015]+//s) {
      local $_ = $1;
      s/[\012\015]//g;

      next unless /^\S/;

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

      my $job = $resp_jobs[0];

      my $exp = shift @{ $job->{exp} };

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

      push @{ $job->{res} }, $parse_resp{$exp}->();

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

         shift @resp_jobs;

         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 {
      mode => $mode,
      freq => round $freq,
      cmd  => \@cmd,
      done => new Coro::Signal,
      nice => $nice,
   }, job::;

   unshift @cmd, tune $mode, $freq;

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

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

   send_scheduler;

   $job
}

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

   (List::Util::sum +(job $nice, $mode, $freq, ((delay 0.010, 4), "LM=LM") x 4)->result) / 4
}

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

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

   my @level = map [$_->{freq}, (List::Util::sum $_->result) / 5],
                  map +(job $nice, $mode, $center + $radius * $_, ((delay 0.002, 4), "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,
      int 0.5 + List::Util::max map $_->[1], @level,
   )
}

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

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

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

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

async {
   my $nice = 1000;

   while () {
      my @info = sql_fetchall "select mode, freq, width, activity_level from freq
                               where check_level < activity_level
                                 and check_time < ?
                               order by check_time, mode, freq
                               limit 1000",
                              $NOW;

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

            eval {
               $pre_lm >= $activity_level
                  or die "pre_lm too low";

               my $avg_lm = avg_lm 0, $mode, $freq;

               warn "$mode:$freq plm $pre_lm alm $avg_lm\n";#d#

               $avg_lm >= $activity_level
                  or die "avg_lm too low";

               my ($aft_freq, $aft_lm) = aft 0, $mode, $freq, $width * 0.9;

               $aft_lm >= $activity_level
                  or die "aft_lm too low";

               print "$mode:$aft_freq($freq) $activity_level<= $pre_lm,$aft_lm ";

               if ($freq - 0.5 * $width <= $aft_freq && $aft_freq <= $freq + 0.5 * $width) {
                  print "tuned\n";
                  sql_exec "update freq set check_time = ?, check_freq = ?, check_level = ?
                            where mode = ? and freq = ?",
                           $NOW + 86400*5 - (rand 86400), $aft_freq, $aft_lm,
                           $mode, $freq;
               } else {
                  # outlier
                  print "outlier\n";
                  sql_exec "update freq set check_time = ?, check_freq = 0, check_level = 0
                            where mode = ? and freq = ?",
                           $NOW + 86400*7 - (rand 86400),
                           $mode, $freq;
               }
            };
            
            if ($@) {
               # currently inactive
               sql_exec "update freq set check_time = ?
                         where mode = ? and freq = ?",
                        $NOW,
                        $mode, $freq;
            }
         };
      } else {
         Coro::Timer::sleep 60;
      }
   }
};

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

async {
   my $nice = 100;

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

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

         while ($st->fetch) {
            next if -e "/root/aor/$mode,$freq";

            push @jobs, [$mode, $freq, $activity_level,
                         job $nice, $mode, $aft_freq, "LM=LM"]
         }

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

            my $lm = $job->result;
            
            $lm >= $activity_level
               or next;

            (avg_lm 0, $nice-1, $mode, $freq) >= $activity_level
               or next;

            warn "record $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;
               my $data = record_nsamples $record_rate * 10;
               acmd $playback_off;

               open my $fh, ">:raw", "/root/aor/$mode,$freq"
                  or die "/root/aor/$mode,$freq: $!";
               print $fh $data;
               close $fh;

#                  my $data = 0.5 + (1 / 65536) * float unpack "v*", record_nsamples $record_rate * 0.1;
               #$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 1;
         }

         Coro::Timer::sleep 5;
      } else {
         Coro::Timer::sleep 300;
      }
   }
};

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

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