|
|
AccuWeather.pl
#!
#-------------------------------------------------------------------------------------------
# AccuWeather.pl - This PERL script will extract weather data
# into a text file that may be read by HAL.
#
# It will also set and reset flags in HAL to reflect current
# weather conditions. Flags are:
#
# WEATHER CLEAR , WEATHER SUNNY , WEATHER PARTLY CLEAR , WEATHER MOSTLY CLEAR
# WEATHER MOSTLY SUNNY , WEATHER CLOUDY , WEATHER HOT , WEATHER COLD
# WEATHER PARTLY SUNNY , WEATHER PARTLY CLOUDY , WEATHER MOSTLY CLOUDY
# WEATHER RAIN , WEATHER LIGHT RAIN , WEATHER HEAVY RAIN , WEATHER WINDY
# WEATHER FOG , WEATHER SNOW , WEATHER LIGHT SNOW , WEATHER SNOW FLURRIES
#
# We can easily add additional flags as all logic merely looks for flags named
# WEATHER followed by one or two words. There are 19 flags currently and we
# may add more as ideas occur and we figure ways to determine them
#
# This PERL script was designed for educational purposes, as a shell program
# for others to adapt to their own uses.
#
# For this script to function, PERL must be installed.
# ActivePerl can be obtained from www.activestate.com
#
# In addition, mechanize.pm must be downloaded to the
# perl directory tree \perl\lib\WWW
#
# At the time of this writing mechanize.pm can be downloaded from:
# http://search.cpan.org/author/PETDANCE/WWW-Mechanize-0.33/lib/WWW/Mechanize.pm
#
# This script also uses the HAL_Interface program available from:
# http://www.james.lipsit.com/hal_interface.htm to write to the HAL DB
#
# The shareware tool CDBFlite is used to extract data from the HAL DB.
# CDBFlite is available from www.whitetown.com
#
# For more details on the installation and use of PERL and mechanize.pm with HAL
# see the www.oocities.org/wa4otj/HAL-Web.pdf link prepared by the Deco group.
#
# Based on a script originally written by Todd Garfield 05/26/2003
# Updated by Nathan Gregory to add the capabilities of passing the
# weather data into HAL using the external tools
#
# 4:10 PM 6/19/2003 Update: Added perl code to set WEATHER HOT and WEATHER
# COLD based on AccuWeather's temperature reports
#
#--------------------------------------------------------------------------------------------
# External libraries
use WWW::Mechanize;
# Create local instances
my $agent = WWW::Mechanize->new();
###############################################################################################
# Check the Weather Flags and set any that are TRUE to FALSE prior to calling AccuWeather
# Note: This means that if the call to Accuweather fails, the previous weather information is
# lost. An improvement might be to store the data and restore it if the web fails, on the
# theory that stale data is better than no data. I'm not sure I believe that right now.
######
#
###############################################################################################
# First we must execute a dos cmdline program to retrieve the weather related flags in HAL
# Any flags that are currently true are changed to false.
# It is necessary to look at each flag and change only the true ones because HAL_Interface
# is very slow. If we just globally set all 19 flags to false, the script would run slowly
######
open(EZ,"cdbflite\\cdbflite device.dbf /f:WHAT=FLAG /f:NAME=WEATHER /S:NAME;VALUE|" );
while() { # Check each flag's value, if true then set to false
$Flag = $_; # Output of CDBFlite is a group of strings
$pos = index($Flag,"|"); # each time we loop thru the while loop we grab one
$Value = substr($Flag,$pos+1,5); # until they are all gone and we hit EOF
$Flag = substr($Flag,0,$pos-1);
removeTrailingSpaces(*Flag);
print $Flag;print " = ";print $Value;print "\n";
if (($pos = index($Value,"rue",0)) > -1 ) {
print "setting $Flag to false\n";
open (EP,"C:/Perl/HAL_Interface.exe $Flag,FALSE |");
close(EP);
} # if
} # While
close(EZ);
open(EX, ">AccuWeather.TXT") || die "ERROR! Problem opening TXT file. It may be in use.";
# prep your zip code here
my $zip = "94552";
# Go grab the web page into content
$agent->get("http://wwwa.accuweather.com/adcbin/public/
curcon_local.asp?partner=accuweather&zipcode=$zip");
# Find the string 'Most Recent Data:' and grab the timestamp following it
# match the string 'Most Recent Data: nn:nn a|pm '
$agent->{content} =~ m/Most Recent Data:\s\Sfont color=\S\S\d\d\d\d\d\d\S\S\d{1,2}:\d\d\s\w\w/;
$t = $&;
$t =~ s/Most Recent Data: /As of /;
$t =~ s///;
print (EX $t);
$agent->{content} =~ m/CLEAR /;
$agent->{content} =~ m/MOSTLY CLEAR/;
$agent->{content} =~ m/PARTLY CLEAR/;
$agent->{content} =~ m/MOSTLY SUNNY/;
$agent->{content} =~ m/SUNNY/;
$agent->{content} =~ m/PARTLY SUNNY/;
$agent->{content} =~ m/CLOUDY/;
$agent->{content} =~ m/PARTLY CLOUDY/;
$agent->{content} =~ m/MOSTLY CLOUDY/;
$agent->{content} =~ m/RAIN/;
$agent->{content} =~ m/LIGHT RAIN/;
$agent->{content} =~ m/HEAVY RAIN/;
$agent->{content} =~ m/WINDY/;
$agent->{content} =~ m/SNOW/;
$agent->{content} =~ m/LIGHT SNOW/;
$agent->{content} =~ m/SNOW FLURRIES/;
$agent->{content} =~ m/FOG/;
$t = $&;
$t =~ s// the sky is /;
if (length($t) > 1){
print (EX $t);
$t =~ s/ the sky is /Weather /;
print "C:/Perl/HAL_Interface.exe $t,TRUE |";
open (EP,"C:/Perl/HAL_Interface.exe $t,TRUE |");
close(EP);
}
#-----------------------------------------------------------------------
# Find the end of the line and grab the temperature
#-----------------------------------------------------------------------
$agent->{content} =~ m/Temp: \d{1,3}/;
$t = $&;
$t =~ s/Temp: /. And the temperature is /;
print (EX $t);
############################################################################################
# Set the flags HOT and COLD if temp is outside our favored range
######
$t = substr($t,25);
# If temperature is above 80, declare it to be hot
if ($t > 80 ) {
print "setting Weather HOT to true\n";
open (EP,"C:/Perl/HAL_Interface.exe WEATHER Hot,TRUE |"); # Use Jim Lipsit's program
close(EP);
} # if
# If temperature is below 60, declare it to be COLD
if ($t < 60 ) {
print "setting Weather COLD to true\n";
open (EP,"C:/Perl/HAL_Interface.exe WEATHER COLD,TRUE |"); # Use Jim Lipsit's program
close(EP);
} # if
print (EX " degrees.");
# Peel out the wind chill or heat index and assign to u
$agent->{content} =~ m/RealFeel<\Sa>: \d{1,3}/;
$u = $&;
$u =~ s/RealFeel<\Sa>: //;
if ($t ^= $u) { # if Actual temp not equal Feels Like print Feels Like
print (EX " but, it feels like ");
print (EX $u);
print (EX " degrees.");
}
#------------------------------------------------------------------------
# Find the Wind Speed
#------------------------------------------------------------------------
$agent->{content} =~ m/Wind Speed: \d{1,3}mph/;
$t = $&;
$pos = index($t,"d: ");
$s = substr($t,$pos+6,6);
$s =~ s/mph//;
# If wind speed is above 14, declare it to be windy
if ($s > 14 ) {
print "setting Weather WINDY to true\n";
open (EP,"C:/Perl/HAL_Interface.exe WEATHER Windy,TRUE |"); # Use Jim Lipsit's program
close(EP);
} # if
$t =~ s/Wind Speed: /.\n The Wind Speed is /;
$t =~ s/mph/ miles per hour/;
print (EX $t);
#------------------------------------------------------------------------
# Find the Wind Direction
#------------------------------------------------------------------------
$agent->{content} =~ m/Wind Direction: \D{1,3}/;
$t = $&;
$t =~ s/Wind Direction: / from the /;
$t =~ s/from the W /from the West./;
$t =~ s/from the N /from the North./;
$t =~ s/from the E /from the East./;
$t =~ s/from the S /from the South./;
$t =~ s/from the WSW/from the West South West./;
$t =~ s/from the SSW/from the South South West./;
$t =~ s/from the SSE/from the South South East./;
$t =~ s/from the ESE/from the East South East./;
$t =~ s/from the NNW/from the North North West./;
$t =~ s/from the NNE/from the North North East./;
$t =~ s/from the WNW/from the West North West./;
$t =~ s/from the CLM/./;
$t =~ s/from the SW/from the South West./;
$t =~ s/from the NW/from the North West./;
$t =~ s/from the SE/from the South East./;
$t =~ s/from the NE/from the North East./;
print (EX $t);
close(EX);
#########################################################################
sub removeTrailingSpaces {
# remove trailing whitespace.
#########################################################################
local(*Flag)=@_;
my ($poc,$c);
$c = substr($Flag,(length($Flag)-1),1);
while ($c eq " ") { # Remove trailing spaces
chop($Flag);
$c = substr($Flag,(length($Flag)-1),1);
}# while
while ($c eq chr(9)) { # Remove trailing tab
chop($Flag);
$c = substr($Flag,(length($Flag)-1),1);
}# while
}
|
|
