Almost complete rewrite of the METAR perl client.
This commit is contained in:
gfk
+183
-106
@@ -1,35 +1,104 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
# $Id$
|
||||
#
|
||||
# LICENSE:
|
||||
# GPL - GNU Public License
|
||||
#
|
||||
# Brief Description
|
||||
# =================
|
||||
#
|
||||
# lcdmetar.pl is a program to fetch METAR Weather information (e.g.
|
||||
# temperature) from a nearby (or not) airport using Geo::METAR and the
|
||||
# LWP modules.
|
||||
#
|
||||
# Given an airport site code on the command line, lcdmetar.pl
|
||||
# fetches the current temperature, wind and clound information,
|
||||
# and displays it via lcdproc (http://lcdproc.omnipotent.net)
|
||||
# For fun, here are some example airports:
|
||||
#
|
||||
# LA : KLAX
|
||||
# Dallas : KDFW
|
||||
# Detroit: KDTW
|
||||
# Chicago: KMDW
|
||||
# Graz/Austria (Thalerhof) : LOWG
|
||||
#
|
||||
# More can be found at http://weather.noaa.gov
|
||||
#
|
||||
# no warranty - use at your own risc.
|
||||
# DO NOT PLAN FLIGHTS ETC ON THIS INFORMATION!!!!
|
||||
#
|
||||
|
||||
# Following is the POD documentation, type perldoc lcdmetar.pl to read it.
|
||||
|
||||
=head1 NAME
|
||||
|
||||
lcdMetar - Fetches METAR Weather information and send it to LCDproc.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
B<lcdmetar.pl> [I<METAR-Code>]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
B<lcdMetar> is a program to fetch METAR Weather information (e.g.
|
||||
temperature) from a nearby (or not) airport using Geo::METAR and the
|
||||
LWP modules.
|
||||
|
||||
Given an airport site code on the command line, lcdMetar
|
||||
fetches the current weather observations,
|
||||
and displays them via LCDproc (http://lcdproc.omnipotent.net/)
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
=item B<METAR-Code>
|
||||
|
||||
The METAR code related of the city you want weather observations.
|
||||
|
||||
For fun, here are some example METAR codes:
|
||||
LA : KLAX
|
||||
Dallas : KDFW
|
||||
Detroit: KDTW
|
||||
Chicago: KMDW
|
||||
Graz/Austria (Thalerhof) : LOWG
|
||||
Quebec City: CYQB
|
||||
|
||||
More informations about METAR codes is available at:
|
||||
http://www.nws.noaa.gov/oso/oso1/oso12/metar.htm
|
||||
|
||||
=head1 DIAGNOSTICS
|
||||
|
||||
=item Cannot connect to LCDproc port
|
||||
|
||||
By default, lcdMetar tries to connect to localhost port 13666. If you get this
|
||||
error, that means that this is not possible to connect to this port. You can change
|
||||
the port lcdMetar connects to by modifying the script's variables $host and $port.
|
||||
|
||||
=item METAR is too short! Something went wrong.
|
||||
|
||||
The METAR data we received is not what we expected, check out NOOA's web site
|
||||
(http://weather.noaa.gov/) to see if something has changed.
|
||||
|
||||
=item Can't connect to METAR source
|
||||
|
||||
lcdMetar tried to fetch weather observations from NOAA's web site and failed. It
|
||||
will retry in 15 minutes.
|
||||
|
||||
=head1 REQUIRES
|
||||
|
||||
Perl 5.004, Geo::METAR, LWP::Simple;
|
||||
|
||||
These are all available on CPAN: http://www.cpan.org/
|
||||
|
||||
=head1 DISCLAMER
|
||||
|
||||
Data distribution via the Internet is not considered an operational
|
||||
delivery mechanism by the NWS due to our inability to insure access
|
||||
to this service, therefore, the information available here shall not
|
||||
be used for flight planning or other operational purposes.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License version 2 as
|
||||
published by the Free Software Foundation.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License along
|
||||
with this program; if not, write to the Free Software Foundation, Inc.,
|
||||
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Yes, there might be some. Please report any one you find to LCDproc's mailing list.
|
||||
See the website for more informations.
|
||||
|
||||
=head1 WEBSITE
|
||||
|
||||
Visit B<http://lcdproc.omnipotent.net/> for more infos and the lastest version.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
use strict;
|
||||
use Geo::METAR;
|
||||
use LWP::Simple;
|
||||
use IO::Socket;
|
||||
use Fcntl;
|
||||
|
||||
@@ -37,49 +106,42 @@ use Fcntl;
|
||||
# Configurable part. Set it according your setup.
|
||||
############################################################
|
||||
|
||||
# Verbose
|
||||
# 0 : None (only fatal errors)
|
||||
# 1 : Warnings
|
||||
# 5 : Explain every step.
|
||||
my $verbose = 1;
|
||||
|
||||
# METAR Code for your city/region.
|
||||
my $site_code;
|
||||
|
||||
# Host which runs lcdproc daemon (LCDd)
|
||||
$HOST = "localhost";
|
||||
my $host = "localhost";
|
||||
|
||||
# Port on which LCDd listens to requests
|
||||
$PORT = "13666";
|
||||
my $port = "13666";
|
||||
|
||||
# URL returning weather conditions for specified station code.
|
||||
# Note that $site_code gets replaced by the actual site code,
|
||||
# hence the URL must be in single quotes
|
||||
$URL = 'http://weather.noaa.gov/cgi-bin/mgetmetar.pl?cccc=$site_code';
|
||||
|
||||
# Delay (in seconds) between subsequent checks of metar
|
||||
$DELAY = 900;
|
||||
|
||||
# Minimum valid size of metar response
|
||||
$MIN_METAR_SIZE = 10;
|
||||
# Metric or English data system?
|
||||
# Can be either "metric", "nautical" or "english"
|
||||
my $datasystem = "metric";
|
||||
|
||||
############################################################
|
||||
# End of user configurable parts
|
||||
############################################################
|
||||
$SIG{INT} = \&grace;
|
||||
$SIG{TERM} = \&grace;
|
||||
|
||||
# Get the site code.
|
||||
|
||||
my $site_code = shift @ARGV;
|
||||
|
||||
die "Usage: $0 <site_code>\n Learn about site codes at http://weather.noaa.gov\n" unless $site_code;
|
||||
|
||||
# replace the string '$site_code' in URL with actual site code
|
||||
$URL =~ s/\$site_code/$site_code/;
|
||||
|
||||
# Get the modules we need.
|
||||
|
||||
use Geo::METAR;
|
||||
use LWP::UserAgent;
|
||||
# use strict;
|
||||
$site_code = shift @ARGV || $site_code;
|
||||
die "Usage: $0 <site_code>\n" unless $site_code;
|
||||
|
||||
# Connect to the server...
|
||||
$remote = IO::Socket::INET->new(
|
||||
print "Connecting to LCDproc at $host\n" if ($verbose >= 5);
|
||||
my $remote = IO::Socket::INET->new(
|
||||
Proto => "tcp",
|
||||
PeerAddr => $HOST,
|
||||
PeerPort => $PORT,
|
||||
)
|
||||
|| die "Cannot connect to LCDproc port\n";
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
) or die "Cannot connect to LCDproc port\n";
|
||||
|
||||
# Make sure our messages get there right away
|
||||
$remote->autoflush(1);
|
||||
@@ -88,8 +150,11 @@ sleep 1; # Give server plenty of time to notice us...
|
||||
|
||||
print $remote "hello\n";
|
||||
my $lcdconnect = <$remote>;
|
||||
print $lcdconnect;
|
||||
|
||||
print $lcdconnect if ($verbose >= 5);
|
||||
# connect LCDproc 0.4.2 protocol 0.3 lcd wid 20 hgt 4 cellwid 5 cellhgt 8
|
||||
($lcdconnect =~ /lcd.+wid\s+(\d+)\s+hgt\s+(\d+)/);
|
||||
my $lcdwidth = $1; my $lcdheight= $2;
|
||||
print "Detected LCD size of $lcdwidth x $lcdheight\n" if ($verbose >= 5);
|
||||
|
||||
# Turn off blocking mode...
|
||||
fcntl($remote, F_SETFL, O_NONBLOCK);
|
||||
@@ -101,76 +166,88 @@ print $remote "screen_set metar name {Metar}\n";
|
||||
print $remote "widget_add metar title title\n";
|
||||
print $remote "widget_set metar title {Weather $site_code}\n";
|
||||
print $remote "widget_add metar temp string\n";
|
||||
print $remote "widget_add metar cloud string\n";
|
||||
print $remote "widget_add metar wind string\n";
|
||||
print $remote "widget_add metar visib scroller\n";
|
||||
print $remote "widget_add metar cloud string\n" if ($lcdheight > 4);
|
||||
|
||||
# set metar source
|
||||
my $ua = new LWP::UserAgent;
|
||||
|
||||
my $req = new HTTP::Request GET => $URL;
|
||||
|
||||
# fetch weather information
|
||||
while (1==1) {
|
||||
|
||||
print "Fetching weather information\n";
|
||||
my $response = $ua->request($req);
|
||||
|
||||
if (!$response->is_success) {
|
||||
|
||||
print $response->error_as_HTML;
|
||||
my $err_msg = $response->error_as_HTML;
|
||||
warn "$err_msg\n\n";
|
||||
while (1) {
|
||||
# fetch weather information
|
||||
print "Fetching weather information\n" if ($verbose >= 5);
|
||||
my $data = get("http://weather.noaa.gov/cgi-bin/mgetmetar.pl?cccc=$site_code");
|
||||
|
||||
if (not $data) {
|
||||
warn "Can't connect to METAR source." if ($verbose >= 1);
|
||||
} else {
|
||||
|
||||
# Yep, get the data and find the METAR.
|
||||
|
||||
my $m = new Geo::METAR;
|
||||
my $data;
|
||||
$data = $response->as_string; # grap response
|
||||
$data =~ s/\n//go; # remove newlines
|
||||
$data =~ m/($site_code\s\d+Z.*?)</go; # find the METAR string
|
||||
my $metar = $1; # keep it
|
||||
|
||||
# Sanity check
|
||||
|
||||
if (length($metar)<$MIN_METAR_SIZE) {
|
||||
die "METAR is too short! Something went wrong.";
|
||||
}
|
||||
die "METAR is too short! Something went wrong." if (length($metar)<1);
|
||||
|
||||
# pass the data to the METAR module.
|
||||
# print("$metar\n");
|
||||
$m->metar($metar);
|
||||
|
||||
# ask for the temperature(s)
|
||||
my $c_temp = $m->C_TEMP;
|
||||
my $temp; my $temp_u; my $dew; my $dew_u; my $wind; my $wind_u; my $wind_dir;
|
||||
|
||||
if ($datasystem eq "nautical") {
|
||||
$temp = $m->C_TEMP;
|
||||
$temp_u = "C";
|
||||
$dew = $m->C_DEW;
|
||||
$dew_u = "C";
|
||||
$wind = $m->WIND_KTS;
|
||||
$wind_u = " Knots";
|
||||
$wind_dir = $m->WIND_DIR_DEG ."deg";
|
||||
} elsif ($datasystem eq "english") {
|
||||
$temp = $m->F_TEMP;
|
||||
$temp_u = "F";
|
||||
$dew = $m->F_DEW;
|
||||
$dew_u = "F";
|
||||
$wind = $m->WIND_MPH;
|
||||
$wind_u = "mph";
|
||||
$wind_dir = $m->WIND_DIR_ENG;
|
||||
} else {
|
||||
# Default: metric system (aka: international system)
|
||||
$temp = $m->C_TEMP;
|
||||
$temp_u = "C";
|
||||
$dew = $m->C_DEW;
|
||||
$dew_u = "C";
|
||||
$wind = $m->WIND_MPH * 1.609344;
|
||||
$wind_u = "km/h";
|
||||
$wind_dir = $m->WIND_DIR_ENG;
|
||||
}
|
||||
|
||||
my $metartime = $m->TIME;
|
||||
my $c_dew = $m->C_DEW;
|
||||
my $f_temp = $m->F_TEMP;
|
||||
my $wind_dir_eng = $m->WIND_DIR_ENG;
|
||||
my $wind_mph = int($m->WIND_MPH);
|
||||
my $sky = $m->SKY;
|
||||
my $time = localtime(time);
|
||||
print $remote "widget_set metar title {Weather $site_code $metartime}\n";
|
||||
print $remote "widget_set metar temp 1 2 {Temp ${c_temp}C (${c_dew}C Dew)}\n";
|
||||
print $remote "widget_set metar wind 1 3 {Wind ${wind_dir_eng}, ${wind_mph}mph}\n";
|
||||
print $remote "widget_set metar cloud 1 4 {Sky " . join(',', @{$m->{sky}}) . "}\n";
|
||||
# print "The temperature at $site_code is $c_temp C as of $time.\n";
|
||||
# print "The wind blows to $wind_dir_eng, speed $wind_mph mph\n";
|
||||
|
||||
my $visibility = $m->VISIBILITY;
|
||||
|
||||
print $remote sprintf("widget_set metar title {Weather %s %s}\n", $site_code, $metartime);
|
||||
print $remote sprintf("widget_set metar temp 1 2 {Temp %i%s (%i%s Dew)}\n", $temp, $temp_u, $dew, $dew_u) if ($temp and $dew);
|
||||
print $remote sprintf("widget_set metar wind 1 3 {Wind %i%s, %s}\n", $wind, $wind_u, $wind_dir) if ($wind_dir and $wind);
|
||||
print $remote sprintf("widget_set metar visib 1 %i %i %i h 3 {Visibility %s}\n", $lcdheight, $lcdwidth, $lcdheight, $visibility ) if ($visibility);
|
||||
print $remote sprintf("widget_set metar cloud 1 4 {Sky %s}\n", join(',', @{$m->{sky}}) ) if ($m->{sky} and ($lcdheight>4));
|
||||
} # end else
|
||||
|
||||
# eat all input from LCDd
|
||||
while(defined($input = <$remote>)) {
|
||||
next if ( $input =~ /^success$/ );
|
||||
#print $input;
|
||||
}
|
||||
print "Sleeping " . int ($DELAY / 60) . " minutes.\n";
|
||||
sleep $DELAY;
|
||||
while(defined(my $input = <$remote>)) { }
|
||||
|
||||
print "Sleeping for 15 minutes.\n" if ($verbose >= 5);
|
||||
sleep 900;
|
||||
}
|
||||
# Should never go there since above is an infinite loop,
|
||||
# send a SIGINT or SIGTERM to exit nicely.
|
||||
|
||||
# To be called on exit and on SIGINT or SIGTERM.
|
||||
sub grace() {
|
||||
print "Exiting...\n" if ($verbose >= 5);
|
||||
close($remote);
|
||||
exit;
|
||||
}
|
||||
|
||||
close($remote);
|
||||
exit;
|
||||
|
||||
__END__
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user