Version 1.3, with ability to suck down fresh data from the FCC site if you have an Internet connection. Uses a separate data file rather than the __END__ technique, for maximum PAR compatibility. To create your first data file, just request the data from the FCC; the program saves it automatically as the separate data file now required (stations.dat).
#!/usr/bin/perl
use strict;
use warnings;
use Fcntl qw( :flock );
use LWP::Simple;
# stations.pl
# version 1.3, Dec. 22, 2005
# by David Rhett Baker, davebaker@benefitslink.com
# This script (with a large appended DATA section) was written in 2005
+ for my
# 11-year-old son, who enjoys listening to AM radio late at night in b
+ed. He
# finds "DX" stations, meaning long-distance stations that are capable
+ of being
# received at night due to the "skip" off of the ionosphere.
#
# This program shows which stations in the U.S. and Canada are broadca
+sting on a
# given frequency, and conversely shows which frequency and how much p
+ower a given
# station uses. It's about 5 megs in size due to the large database fr
+om the FCC.
#
# This program does not use every field of the data; it could be impro
+ved to show
# the direction in degrees to a particular broadcasting station from t
+he reception
# point, for example, or to show the distance between the broadcasting
+ station and
# the reception point, if one were to take advantage of all the fields
+ of data.
# History
# 1.0 - initial release
# 1.2 - added ability to enter c or f even when at prompt asking for u
+pward or
# downward adjustment of frequency to the next channel (10 kHz u
+p or down),
# so Joey will be able to get used to entering c to input a call
+sign no matter
# where in the program he is (and same for f to input a frequenc
+y).
#
# 1.2d - Optional version using external stations.dat file rather than
+ inline data;
# PAR packager seems to need data in separate file.
#
# 1.3 - Ability to request refresh of data from the FCC site; data now
+ stored in an
# external file (stations.dat) in same directory as executable.
+If no stations.dat
# file came with your distribution of version 1.3, this version
+allows you to
# automatically create one by requesting data data from the FCC
+site. Thanks to
# jdporter on perlmonks.org for the idea!
my @data_array;
my @data_lines;
print "Christmas 2005: loading program for Joseph Rhett Baker... \n";
my $data_choice;
DATA_PROMPT: print "\nUse <l>ocally-stored data, or <d>ownload fresh d
+ata from the FCC server?\n(press l or d, then the ENTER key): ";
$data_choice = <>;
chomp $data_choice;
unless ($data_choice eq 'l'
|| $data_choice eq 'L'
|| $data_choice eq 'd'
|| $data_choice eq 'D'
) {
goto DATA_PROMPT;
}
if ($data_choice eq 'l' || $data_choice eq 'L') {
open my $fh, '<', 'stations.dat'
or die "Trouble opening stations.dat; is it in same directory
+as stations.exe? Stopped: $!";
flock $fh, LOCK_SH
or die "Trouble getting file lock for stations.dat; is it in u
+se by another program? Stopped: $!";
@data_lines = <$fh>;
}
else {
print "\nNow requesting data from the FCC server; this will take a
+ minute or two, even with a high-speed internet connection...\n";
my $stations_data = get( 'http://www.fcc.gov/fcc-bin/amq?state=&ca
+ll=&arn=&city=&freq=530&fre2=1700&type=0&facid=&class=&list=4&dist=&d
+lat2=&mlat2=&slat2=&NS=N&dlon2=&mlon2=&slon2=&EW=W&size=9' );
open my $fh, '>', 'stations.dat'
or warn "Trouble opening stations.dat to save new FCC data; is
+ hard drive full? Stopped: $!";
flock $fh, LOCK_EX
or die "Trouble getting file lock for stations.dat; is it in u
+se by another program? Stopped: $!";
print {$fh} $stations_data;
close $fh
or warn "Trouble closing file lock for stations.dat";
@data_lines = split /\n/, $stations_data;
}
print "\nParsing data for AM station callsigns, frequencies, locations
+, output power and broadcast times... \n";
LINE: foreach my $line (@data_lines) {
next LINE unless ($line =~ /\|/);
# Spinning bar in column 1, over the C in 'Christmas' <g>
print "\r/";
print "\r-";
print "\r\\";
print "\r|";
print "\r/";
print "\r-";
print "\r\\";
print "\r|";
#TS print "\nLine is $line\n";
my @values = split /\|/, $line;
foreach my $value (@values) {
$value =~ s/^\s+//;
$value =~ s/\s+$//;
#TS print "\$value is $value\n";
}
# Chop spaces and kHz following the numeric frequency...
$values[2] =~ s/ //gi;
$values[2] =~ s/khz//gi;
# Chop extra spaces in the power column...
$values[14] =~ tr/ //s;
my $data_hashref = { callsign => $values[1],
freq => $values[2],
time => $values[6],
town => $values[10],
state => $values[11],
country => $values[12],
kw => $values[14],
};
#TS print "Callsign is $values[1], freq is $values[2], time is $va
+lues[6], town is $values[10], state is $values[11], kw is $values[14]
+.\n";
push @data_array, $data_hashref;
}
PROMPT: while (1) {
print "\nJoey, <c>allsign, <f>requency or <q>uit? (c, f or q): ";
my $choice = <>;
chomp $choice;
unless ($choice eq 'c'
|| $choice eq 'C'
|| $choice eq 'f'
|| $choice eq 'F'
|| $choice eq 'q'
|| $choice eq 'Q'
) {
next PROMPT;
}
if ($choice eq 'c' || $choice eq 'C') {
CALLSIGN_PROMPT: print "\nWhat callsign? ";
my $callsign = <>;
chomp $callsign;
$callsign = uc( $callsign );
foreach my $hashref (@data_array) {
if ($hashref->{callsign} eq $callsign) {
print $hashref->{callsign}, " broadcasts on ", $hashre
+f->{freq}, " kHz (",
$hashref->{time}, ") from ", $hashref->{town}, ",
+", $hashref->{state},
", running ", $hashref->{kw}, ".\n\n";
}
}
}
elsif ($choice eq 'f' || $choice eq 'F') {
FREQ_PROMPT: print "\nWhich frequency? ";
my $frequency = <>;
chomp $frequency;
my %printed_already;
FREQ_OUT: print "\nHere are the U.S. and Canada stations on $f
+requency kHz:\n";
# Initialize or re-initialize, in the case of a freq adjustmen
+t ordered later in the script...
%printed_already = ();
foreach my $hashref (@data_array) {
if ( $hashref->{freq} == $frequency
&&
( $hashref->{country} eq 'US'
|| $hashref->{country} eq 'CA'
)
) {
my $station = $hashref->{callsign};
unless ($printed_already{$station} ) {
print "\n ", $hashref->{callsign}, ' in ', $hash
+ref->{town}, ', ', $hashref->{state};
}
# Instantiate and increment to non-zero value...
$printed_already{$station}++;
}
}
CHOICE: print "\n\n<u>p or <d>own to next frequency, or <q>uit
+? ";
my $choice = <>;
chomp $choice;
goto CHOICE unless ( $choice eq 'u' || $choice eq 'U' || $ch
+oice eq 'd' || $choice eq 'D'
|| $choice eq 'q' || $choice eq 'Q' || $ch
+oice eq 'c' || $choice eq 'C'
|| $choice eq 'f' || $choice eq 'F'
);
if ($choice eq 'u' || $choice eq 'U') {
$frequency += 10;
goto FREQ_OUT;
}
elsif ($choice eq 'd' || $choice eq 'D') {
$frequency -= 10;
goto FREQ_OUT;
}
elsif ($choice eq 'c' || $choice eq 'C') {
goto CALLSIGN_PROMPT;
}
elsif ($choice eq 'f' || $choice eq 'F') {
goto FREQ_PROMPT;
}
else {
next PROMPT;
}
}
else {
print "\n\nI love you, son! --Dad\n\n";
sleep 5;
last;
}
}