00001 #! /usr/bin/perl
00002
00003 #TODO the icons aren't very meaningful, the server gives them to us for 3 or 6
00004 # hr intervals, but since we're parsing for 12 hour, that seem a little useless
00005
00006 use English;
00007 use strict;
00008 use warnings;
00009
00010 use File::Basename;
00011 use Cwd 'abs_path';
00012 use lib dirname(abs_path($0 or $PROGRAM_NAME)),
00013 '/usr/share/mythtv/mythweather/scripts/us_nws',
00014 '/usr/local/share/mythtv/mythweather/scripts/us_nws';
00015
00016 use Data::Dumper;
00017 use NDFDParser;
00018 use NWSLocation;
00019 use Date::Manip;
00020 use Getopt::Std;
00021
00022 our ($opt_v, $opt_t, $opt_T, $opt_l, $opt_u, $opt_d);
00023
00024 my $name = 'NDFD-6_day';
00025 my $version = 0.3;
00026 my $author = 'Lucien Dunning';
00027 my $email = 'ldunning@gmail.com';
00028 my $updateTimeout = 15*60;
00029 my $retrieveTimeout = 30;
00030 my @types = ('3dlocation', '6dlocation', 'updatetime',
00031 'high-0', 'high-1', 'high-2', 'high-3', 'high-4', 'high-5',
00032 'low-0', 'low-1', 'low-2', 'low-3', 'low-4', 'low-5',
00033 'icon-0', 'icon-1', 'icon-2', 'icon-3', 'icon-4', 'icon-5',
00034 'date-0', 'date-1', 'date-2', 'date-3', 'date-4', 'date-5', 'copyright');
00035 my $dir = './';
00036 my $icon_file = dirname(abs_path($0 or $PROGRAM_NAME)) . "/icons";
00037
00038 getopts('Tvtlu:d:');
00039
00040 if (defined $opt_v) {
00041 print "$name,$version,$author,$email\n";
00042 exit 0;
00043 }
00044
00045 if (defined $opt_T) {
00046 print "$updateTimeout,$retrieveTimeout\n";
00047 exit 0;
00048 }
00049 if (defined $opt_l) {
00050 my $search = shift;
00051 NWSLocation::AddLocSearch($search);
00052 NWSLocation::AddStateSearch($search);
00053 NWSLocation::AddStationIdSearch($search);
00054 my $results = doSearch();
00055 my $result;
00056 while($result = shift @$results) {
00057 if ($result->{latitude} ne "NA" && $result->{longitude} ne "NA") {
00058 print "$result->{latitude},$result->{longitude}::";
00059 print "$result->{station_name}, $result->{state}\n";
00060 }
00061 }
00062 exit 0;
00063 }
00064
00065 if (defined $opt_t) {
00066 foreach (@types) {print; print "\n";}
00067 exit 0;
00068 }
00069
00070 if (defined $opt_d) {
00071 $dir = $opt_d;
00072 }
00073
00074 my $locstr = shift;
00075 my $units = $opt_u;
00076 my ($latitude, $longitude) = getLocation($locstr);
00077 if (!(defined $opt_u && defined $latitude && defined $longitude
00078 && $latitude ne "" && $longitude ne "")) {
00079 die "Invalid Usage";
00080 }
00081
00082 my $param = { maxt => 1,
00083 mint =>1,
00084 temp =>0,
00085 dew=>0,
00086 pop12=>0,
00087 qpf=>0,
00088 sky=>0,
00089 snow=>0,
00090 wspd=>0,
00091 wdir=>0,
00092 wx=>0,
00093 waveh=>0,
00094 icons=>1,
00095 rh=>0,
00096 appt=>0 };
00097
00098 my $d1 = UnixDate("today at 8:00am", "%O");
00099 my $d2 = UnixDate(DateCalc($d1, "+ 168 hours"), "%O");
00100 my $result;
00101 my $creationdate;
00102 my $nextupdate;
00103 my $getData = 1;
00104 if (open (CACHE, "$dir/ndfd_cache_${latitude}_${longitude}")) {
00105 ($nextupdate, $creationdate) = split / /, <CACHE>;
00106 # We don't have to check the start/end dates, since we get the same chunk
00107 # every time, and we update the cache atleast every hour, which is how often the
00108 # data is updated by the NWS.
00109 if (Date_Cmp($nextupdate, "now") > 0) { # use cache
00110 no strict "vars"; # because eval doesn't scope var correctly
00111 $result = eval <CACHE>;
00112 if ($result) {
00113 $getData = 0;
00114 } else {
00115 print STDERR "Error parsing cache $@\n";
00116 };
00117 }
00118
00119 }
00120
00121 if ($getData) {
00122 ($result, $creationdate) = NDFDParser::doParse($latitude, $longitude, $d1, $d2, $param);
00123 # output cache
00124 open(CACHE, ">$dir/ndfd_cache_${latitude}_${longitude}") or
00125 die "cannot open cache ($dir/ndfd_cache_${latitude}_${longitude}) for writing";
00126 $Data::Dumper::Purity = 1;
00127 $Data::Dumper::Sortkeys = 1;
00128 $Data::Dumper::Indent = 0;
00129 # NDFD is updated by 45 minutes after the hour, we'll give them until 50 to
00130 # make sure
00131 my $min = UnixDate("now", "%M");
00132 my $newmin;
00133 if ($min < 50) {
00134 $newmin = 50-$min;
00135 } else {
00136 $newmin = 60-($min-50);
00137 }
00138 $nextupdate = DateCalc("now", "+ $newmin minutes");
00139 print CACHE UnixDate($nextupdate, "%O ") . UnixDate("now", "%O\n");
00140 print CACHE Dumper($result);
00141 }
00142
00143 my $lowindex = 0;
00144 my $hiindex = 0;
00145 my $dateindex = 0;
00146 my $iconindex = 0;
00147 my @dates;
00148 my $time;
00149 my $date;
00150
00151 printf "updatetime::Last Updated on %s\n",
00152 UnixDate($creationdate, "%b %d, %I:%M %p %Z");
00153
00154 printf "copyright::National Digital Forecast Database\n";
00155
00156 foreach $time (sort(keys(%$result))) {
00157 my $date;
00158 if ($time =~ m/,/) {
00159 ($date) = split /,/, $time;
00160 } else {
00161 $date = $time;
00162 }
00163
00164 if (Date_Cmp($date, $d1) < 0) {
00165 next;
00166 }
00167
00168 my $numdate = UnixDate($date, "%Q");
00169 if (!grep /$numdate/, @dates) {
00170 push @dates, $numdate;
00171 }
00172 my $geticon = 0;
00173 if ($lowindex <= 5 && $result->{$time}->{temperature_minimum}) {
00174 if ($units eq 'SI') {
00175 $result->{$time}->{temperature_minimum} =
00176 int ( (5/9) * ($result->{$time}->{temperature_minimum}-32));
00177 }
00178 print "low-${lowindex}::$result->{$time}->{temperature_minimum}\n";
00179 $lowindex++;
00180 } elsif ($hiindex <= 5 && $result->{$time}->{temperature_maximum}) {
00181 if ($units eq 'SI') {
00182 $result->{$time}->{temperature_maximum} =
00183 int ( (5/9) * ($result->{$time}->{temperature_maximum}-32));
00184 }
00185 print "high-${hiindex}::$result->{$time}->{temperature_maximum}\n";
00186 $hiindex++;
00187 $geticon = 1;
00188 }
00189 if ($geticon) {
00190 my $tz = $time;
00191 $tz =~ s/^.*([+-]\d{4})$/$1/;
00192 my $iconkey = $date;
00193 my $i = 0;
00194 my $icon;
00195 until ($result->{$iconkey}->{'conditions-icon_forecast-NWS'}
00196 || $i++ > 8) {
00197 $iconkey = UnixDate(DateCalc($iconkey, "+ 1 hour"), "%O").$tz;
00198 }
00199 if ($i >= 8) {
00200 $icon = "unknown.png";
00201 } else {
00202 $icon = $result->{$iconkey}->{'conditions-icon_forecast-NWS'};
00203 $icon =~ s/.*\/([a-z0-9_]+[.][j][p][g])/$1/;
00204 local *FH;
00205 open(FH, $icon_file) or die "Cannot open icons";
00206 while(my $line = <FH>) {
00207 if ($line =~ /${icon}::/) {
00208 $line =~ s/.*::
00209 print "icon-${iconindex}::$line";
00210 $iconindex++;
00211 last;
00212 }
00213 }
00214 }
00215 }
00216 }
00217 print "high-${hiindex}::NA\n" and $hiindex++ while ($hiindex <= 5);
00218 print "low-${lowindex}::NA\n" and $lowindex++ while ($lowindex <= 5);
00219 print "icon-${iconindex}::unknown.png\n" and $iconindex++ while ($iconindex<= 5);
00220
00221 foreach $date (sort(@dates)) {
00222 print "date-${dateindex}::" . UnixDate($date, "%A") . "\n"
00223 if ($dateindex <= 5);
00224 $dateindex++;
00225 }
00226
00227
00228
00229 # This script will accept locations that are either station ids, or latitude
00230 # longitude. This is because I haven't decided which to use yet :)
00231 sub getLocation {
00232 my $str = shift;
00233
00234 $str =~ tr/[a-z]/[A-Z]/;
00235 my $lat;
00236 my $lon;
00237
00238 if ($str =~ m/[A-Z]{4,4}/) { # station id form
00239 NWSLocation::AddStationIdSearch($str);
00240
00241 } else { # hopefully lat/lon
00242 ($lat, $lon) = split /,/, $str;
00243 $lat =~ s/(\d{1,3}([.]\d{1,3})?)([.]\d{1,3})?[N]/+$1/ or
00244 $lat =~ s/(\d{1,3}([.]\d{1,3})?)([.]\d{1,3})?[S]/-$1/;
00245 $lon =~ s/(\d{1,3}[.](\d{1,3})?)([.]\d{1,3})?[E]/+$1/ or
00246 $lon =~ s/(\d{1,3}([.]\d{1,3})?)([.]\d{1,3})?[W]/-$1/;
00247 NWSLocation::AddLatLonSearch($lat, $lon);
00248 }
00249
00250 my $results = NWSLocation::doSearch($str);
00251 if ($lat && $lon && !$results) {
00252 # didn't find a matching station
00253 print "location::$lat,$lon\n";
00254 return ($lat, $lon);
00255 }
00256
00257 # Should be one result in array
00258 my $location = $results->[0];
00259 $lat = $location->{latitude};
00260 $lon = $location->{longitude};
00261 if ($lat eq 'NA' || $lon eq 'NA') {
00262 # maybe scrape them from website, since they are there, annoying that
00263 # they aren't all in the XML file, gotta love the U.S. Gov :)
00264 die "Latitude and Longitude do not exist for $str";
00265 }
00266 print "3dlocation::$location->{station_name}, $location->{state}\n";
00267 print "6dlocation::$location->{station_name}, $location->{state}\n";
00268
00269 return ($lat, $lon);
00270 }