mangavalk/lcdproc
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Almost complete rewrite of the METAR perl client.

Browse Source
This commit is contained in:
gfk
2002-01-02 20:05:20 +00:00
parent e85dbde5f7
commit 41fe669e9a
1 changed files with 183 additions and 106 deletions
Download Patch File Download Diff File Expand all files Collapse all files
clients/metar/lcdmetar.pl
+183 -106
View File
@@ -1,35 +1,104 @@
#!/usr/bin/perl -w #!/usr/bin/perl -w
# $Id$ # $Id$
#
# LICENSE: # Following is the POD documentation, type perldoc lcdmetar.pl to read it.
# GPL - GNU Public License
# =head1 NAME
# Brief Description
# ================= lcdMetar - Fetches METAR Weather information and send it to LCDproc.
#
# lcdmetar.pl is a program to fetch METAR Weather information (e.g. =head1 SYNOPSIS
# temperature) from a nearby (or not) airport using Geo::METAR and the
# LWP modules. B<lcdmetar.pl> [I<METAR-Code>]
#
# Given an airport site code on the command line, lcdmetar.pl =head1 DESCRIPTION
# fetches the current temperature, wind and clound information,
# and displays it via lcdproc (http://lcdproc.omnipotent.net) B<lcdMetar> is a program to fetch METAR Weather information (e.g.
# For fun, here are some example airports: temperature) from a nearby (or not) airport using Geo::METAR and the
# LWP modules.
# LA : KLAX
# Dallas : KDFW Given an airport site code on the command line, lcdMetar
# Detroit: KDTW fetches the current weather observations,
# Chicago: KMDW and displays them via LCDproc (http://lcdproc.omnipotent.net/)
# Graz/Austria (Thalerhof) : LOWG
# =head1 OPTIONS
# More can be found at http://weather.noaa.gov
# =item B<METAR-Code>
# no warranty - use at your own risc.
# DO NOT PLAN FLIGHTS ETC ON THIS INFORMATION!!!! 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 IO::Socket;
use Fcntl; use Fcntl;
@@ -37,49 +106,42 @@ use Fcntl;
# Configurable part. Set it according your setup. # 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 which runs lcdproc daemon (LCDd)
$HOST = "localhost"; my $host = "localhost";
# Port on which LCDd listens to requests # Port on which LCDd listens to requests
$PORT = "13666"; my $port = "13666";
# URL returning weather conditions for specified station code. # Metric or English data system?
# Note that $site_code gets replaced by the actual site code, # Can be either "metric", "nautical" or "english"
# hence the URL must be in single quotes my $datasystem = "metric";
$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;
############################################################ ############################################################
# End of user configurable parts # End of user configurable parts
############################################################ ############################################################
$SIG{INT} = \&grace;
$SIG{TERM} = \&grace;
# Get the site code. # Get the site code.
$site_code = shift @ARGV || $site_code;
my $site_code = shift @ARGV; die "Usage: $0 <site_code>\n" unless $site_code;
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;
# Connect to the server... # 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", Proto => "tcp",
PeerAddr => $HOST, PeerAddr => $host,
PeerPort => $PORT, PeerPort => $port,
) ) or die "Cannot connect to LCDproc port\n";
|| die "Cannot connect to LCDproc port\n";
# Make sure our messages get there right away # Make sure our messages get there right away
$remote->autoflush(1); $remote->autoflush(1);
@@ -88,8 +150,11 @@ sleep 1; # Give server plenty of time to notice us...
print $remote "hello\n"; print $remote "hello\n";
my $lcdconnect = <$remote>; 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... # Turn off blocking mode...
fcntl($remote, F_SETFL, O_NONBLOCK); 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_add metar title title\n";
print $remote "widget_set metar title {Weather $site_code}\n"; print $remote "widget_set metar title {Weather $site_code}\n";
print $remote "widget_add metar temp string\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 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 while (1) {
my $ua = new LWP::UserAgent; # fetch weather information
print "Fetching weather information\n" if ($verbose >= 5);
my $req = new HTTP::Request GET => $URL; my $data = get("http://weather.noaa.gov/cgi-bin/mgetmetar.pl?cccc=$site_code");
# 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";
if (not $data) {
warn "Can't connect to METAR source." if ($verbose >= 1);
} else { } else {
# Yep, get the data and find the METAR. # Yep, get the data and find the METAR.
my $m = new Geo::METAR; my $m = new Geo::METAR;
my $data;
$data = $response->as_string; # grap response
$data =~ s/\n//go; # remove newlines $data =~ s/\n//go; # remove newlines
$data =~ m/($site_code\s\d+Z.*?)</go; # find the METAR string $data =~ m/($site_code\s\d+Z.*?)</go; # find the METAR string
my $metar = $1; # keep it my $metar = $1; # keep it
# Sanity check # Sanity check
die "METAR is too short! Something went wrong." if (length($metar)<1);
if (length($metar)<$MIN_METAR_SIZE) {
die "METAR is too short! Something went wrong.";
}
# pass the data to the METAR module. # pass the data to the METAR module.
# print("$metar\n"); # print("$metar\n");
$m->metar($metar); $m->metar($metar);
# ask for the temperature(s) # 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 $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 $sky = $m->SKY;
my $time = localtime(time); my $visibility = $m->VISIBILITY;
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 sprintf("widget_set metar title {Weather %s %s}\n", $site_code, $metartime);
print $remote "widget_set metar wind 1 3 {Wind ${wind_dir_eng}, ${wind_mph}mph}\n"; 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 "widget_set metar cloud 1 4 {Sky " . join(',', @{$m->{sky}}) . "}\n"; 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 "The temperature at $site_code is $c_temp C as of $time.\n"; print $remote sprintf("widget_set metar visib 1 %i %i %i h 3 {Visibility %s}\n", $lcdheight, $lcdwidth, $lcdheight, $visibility ) if ($visibility);
# print "The wind blows to $wind_dir_eng, speed $wind_mph mph\n"; print $remote sprintf("widget_set metar cloud 1 4 {Sky %s}\n", join(',', @{$m->{sky}}) ) if ($m->{sky} and ($lcdheight>4));
} # end else } # end else
# eat all input from LCDd # eat all input from LCDd
while(defined($input = <$remote>)) { while(defined(my $input = <$remote>)) { }
next if ( $input =~ /^success$/ );
#print $input; print "Sleeping for 15 minutes.\n" if ($verbose >= 5);
} sleep 900;
print "Sleeping " . int ($DELAY / 60) . " minutes.\n"; }
sleep $DELAY; # 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__ __END__