#!/usr/bin/perl -w
#
# Yet another semi-quick script to get weather from a server on the
# Internet and print it out on the terminal. This one uses weather.gov
# which for the moment provides everything in one URL, with none of
# this crap about web APIs, keys to send, limited number of uses, and
# so on.
#
# So we retrieve the page, then parse it out. Handle the cases where the
# location name is ambiguous (parse out the list of possible matches) or
# simply doesn't match anything. And then it extracts the current conditions
# and the longer form forecast.
#
# Options include printing the current conditions only, a shortened version
# of the forecast (looking ahead just a couple days), and saving the HTML
# file so that when they change the format, I can adjust this script,
# assuming they don't change the server so that everything has to be
# requested one at a time, passing in an ID token from a registered
# account. I think they're looking to move to that in their "improved"
# (i.e., worse) interface, fairly soon.
#
# I was also interested in playing with perl again, since it's been some
# time. It's been a number of years and I still dislike Python's formatting
# and lack of explicit begin and end tags.
#
# Created by FNA 2018-01-12.
use strict;
use warnings;
use Getopt::Std;
use LWP::Simple;
use Text::Wrap;
use Term::ANSIColor qw(:constants); # used for UNDERLINE, BOLD, and RESET
my $VERSION = '1.1';
my %opts;
getopts('cd:hHsv', \%opts);
handle_args(%opts);
my $location = shift || "ITH";
#print "location is $location";
my $url = 'http://forecast.weather.gov/zipcity.php?inputstring=';
my $content = get($url . $location);
die "Couldn't get it!" unless defined $content;
if (exists($opts{'d'})) {
# write the URL content to a command-line specified file and exit
open DUMP, ">$opts{'d'}" or die "can't open file $opts{'d'} for write!";
print DUMP $content;
close DUMP;
exit 0;
}
my $get_forecast = 0;
my $get_searches = 0;
my $get_wx = 0;
my $forecast = '';
my @wx;
my $wx_count = 0;
my $is_search_page = 0;
for (split(/\n/, $content)) {
if ($get_wx) {
# add another line to the current weather count
push @wx, $_;
$wx_count++;
if ($wx_count >40) {
$get_wx = 0;
}
}
if ($get_forecast) {
# grab the 10-day forecast line (all one line)
$forecast = $_;
$get_forecast = 0;
}
if ($get_searches) {
# print out the options that matched and quit
print "Ambiguous search ($location), possible matches:\n";
print format_searches($_);
print "\n";
exit 2;
}
if ($is_search_page && m#
#) {
# enable flag, next line lists possible search matches
$get_searches = 1;
}
if (//) {
$get_wx = 1;
}
if (/detailed-forecast-body/) {
$get_forecast = 1;
}
if (m#City State & Zipcode Search Page#) {
# search page...the name was ambiguous
$is_search_page = 1;
}
}
if ($is_search_page) {
# if it got here, that meant it was a search page but with no suggestions
# for near matches. So just print an error message and quit.
print "Can't find location $location. Perhaps it's misspelled. ";
print "Try again.\n";
exit -2;
}
print format_wx(@wx);
print "\n\n";
my $forecast_time = '';
my $count = 0;
for (split(/row-forecast/, $forecast)) {
# each "element" currently consists of 2 divisions, the time and the text
# note: first time through loop pattern doesn't match and is skipped
if (m#([^<]+)#) {
$forecast_time = $1;
print BRIGHT_BLUE, $forecast_time . "\n", RESET;
}
if (/.*#$1#;
print wrap("\t", "", $_) . "\n\n";
}
$count++;
if ((exists($opts{'s'}) and $count >= 6) or
(exists($opts{'c'}) and $count >= 2)) {
# short version of forecast, quit after 5 entries
# or current forecast, quit after 1st entry
exit 0;
}
}
exit 0;
# If there's no match, the web page should have a list
# of possible locations as links in one line. Extract
# the text from any links on the current line and return
# them as a single string (with newlines separating entries).
sub format_searches {
my ($line) = @_;
my $entries = '';
my $stop = 0;
do {
if ($line =~ m#([^<]+)#) {
$entries .= "$1\n";
$line = $';
} else {
$stop = 1;
}
} until ($stop);
return $entries;
}
# This is a bit of a kludge. We're pulling the data from the raw HTML
# web page, so it's fragile. And formating fields for non-single-byte
# characters (like the degree sign and the ANSI terminal codes seems
# to cause problems, so we do it in a semi-quick, and somewhat dirty way.
#
sub format_wx {
my (@wx) = @_;
my $degree_symbol = '°';
#my $degree_symbol = "";
# get location
my $location = $wx[3];
$location =~ s#.*]+>(.+)#$1#;
# get current temperature (in F and C)
my $degF = $wx[12];
$degF =~ s#.*]+>(-?\d+)°F #$1#;
my $degC = $wx[13];
$degC =~ s#.*]+>(-?\d+)°C #$1#;
# relative humidity
my $rh = $wx[19];
$rh =~ s#.* | (\d+)% | #$1#;
# wind
my $wind = $wx[23];
$wind =~ s#.*(.+) | #$1#;
# barometer
my $baro = $wx[27];
$baro =~ s#.*(.+) | #$1#;
# visibility
my $vis = $wx[35];
$vis =~ s#.*(.+) | #$1#;
# last update time
my $update = $wx[40];
$update =~ s#\s*(.+)#$1#;
$update =~ s#\s*$##;
my $format = '%-4s %-9s %-9s %-8s';
my $on = BRIGHT_BLUE . UNDERLINE;
my $off = RESET;
print "$location ($update)\n";
print " ", BRIGHT_BLUE, UNDERLINE, "Temp", RESET, " ";
print $on, "RH", $off, " ", $on, "Wind", $off, " ";
print $on, "Vis", $off, " ", $on, "Pres", $off;
printf RESET . "\n";
my $temp = "$degF${degree_symbol}F $degC${degree_symbol}C";
my $size = length $temp;
# note: compensate for the degree symbol (2 bytes, 1 character)
print $temp . ' ' x int(12 - $size + 2);
printf $format, "${rh}%", "${wind}", "${vis}", "${baro}";
return;
}
sub handle_args {
my (%opts) = @_;
my $short_help = <<"EOM";
Usage: $0 [-cdhsv] [location]
Use $0 -H for detailed help message.
EOM
my $long_help = <<"EOM";
$0 [-cdhHsv] [location]
-c
print only current conditions
-d=FILE
dump the raw HTML file to FILE
-h
print short help message and exit
-H
print detailed help message and exit
-s
print short version of forecast (5 days)
-v
print version and exit
location
report the weather for this location. It can be
any string, including zipcode, city, state (full name
or 2 letter abbreviation), city and state (with a comma),
or airport code (3 or 4 letter).
EOM
if (exists($opts{'h'})) {
# print help message
print $short_help;
exit 0;
} elsif (exists($opts{'H'})) {
print $long_help;
exit 0;
} elsif (exists($opts{'v'})) {
# print version message
print "$0 version $VERSION\n";
exit 0;
}
}