#!/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 bed. 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 broadcasting on a
# given frequency, and conversely shows which frequency and how much power a given
# station uses. It's about 5 megs in size due to the large database from the FCC.
#
# This program does not use every field of the data; it could be improved to show
# the direction in degrees to a particular broadcasting station from the 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 upward or
#       downward adjustment of frequency to the next channel (10 kHz up or down),
#       so Joey will be able to get used to entering c to input a callsign no matter
#       where in the program he is (and same for f to input a frequency).
#
# 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 data 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 use 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=&call=&arn=&city=&freq=530&fre2=1700&type=0&facid=&class=&list=4&dist=&dlat2=&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 use 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 $values[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 ", $hashref->{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 $frequency kHz:\n";

        # Initialize or re-initialize, in the case of a freq adjustment 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 ', $hashref->{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' || $choice eq 'd' || $choice eq 'D'
                            || $choice eq 'q' || $choice eq 'Q' || $choice 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;
    }
}