MythTV  master
ndfd.pl
Go to the documentation of this file.
1 #! /usr/bin/perl
2 
3 #TODO the icons aren't very meaningful, the server gives them to us for 3 or 6
4 # hr intervals, but since we're parsing for 12 hour, that seem a little useless
5 
6 use English;
7 use strict;
8 use warnings;
9 
10 use File::Basename;
11 use Cwd 'abs_path';
12 use lib dirname(abs_path($0 or $PROGRAM_NAME)),
13  '/usr/share/mythtv/mythweather/scripts/us_nws',
14  '/usr/local/share/mythtv/mythweather/scripts/us_nws';
15 
16 use Data::Dumper;
17 use NDFDParser;
18 use NWSLocation;
19 use Date::Manip;
20 use Getopt::Std;
21 
22 our ($opt_v, $opt_t, $opt_T, $opt_l, $opt_u, $opt_d);
23 
24 my $name = 'NDFD-6_day';
25 my $version = 0.6;
26 my $author = 'Gavin Hurlbut / Lucien Dunning';
27 my $email = 'gjhurlbu@gmail.com / ldunning@gmail.com';
28 my $updateTimeout = 15*60;
29 my $retrieveTimeout = 30;
30 my @types = ('3dlocation', '6dlocation', 'updatetime',
31  'high-0', 'high-1', 'high-2', 'high-3', 'high-4', 'high-5',
32  'low-0', 'low-1', 'low-2', 'low-3', 'low-4', 'low-5',
33  'icon-0', 'icon-1', 'icon-2', 'icon-3', 'icon-4', 'icon-5',
34  'date-0', 'date-1', 'date-2', 'date-3', 'date-4', 'date-5',
35  'copyright', 'copyrightlogo');
36 my $dir = './';
37 my $icon_file = dirname(abs_path($0 or $PROGRAM_NAME)) . "/icons";
38 
39 getopts('Tvtlu:d:');
40 
41 if (defined $opt_v) {
42  print "$name,$version,$author,$email\n";
43  exit 0;
44 }
45 
46 if (defined $opt_T) {
47  print "$updateTimeout,$retrieveTimeout\n";
48  exit 0;
49 }
50 if (defined $opt_l) {
51  my $search = shift;
52  NWSLocation::AddLocSearch($search);
53  NWSLocation::AddStateSearch($search);
54  NWSLocation::AddStationIdSearch($search);
55  my $results = doSearch();
56  my $result;
57  while($result = shift @$results) {
58  if ($result->{latitude} ne "NA" && $result->{longitude} ne "NA") {
59  print "$result->{latitude},$result->{longitude}::";
60  print "$result->{station_name}, $result->{state}\n";
61  }
62  }
63  exit 0;
64 }
65 
66 if (defined $opt_t) {
67  foreach (@types) {print; print "\n";}
68  exit 0;
69 }
70 
71 if (defined $opt_d) {
72  $dir = $opt_d;
73 }
74 
75 my $locstr = shift;
76 my $units = $opt_u;
77 my ($latitude, $longitude) = getLocation($locstr);
78 if (!(defined $opt_u && defined $latitude && defined $longitude
79  && $latitude ne "" && $longitude ne "")) {
80  die "Invalid Usage";
81 }
82 
83 my $param = { maxt => 1,
84  mint =>1,
85  temp =>0,
86  dew=>0,
87  pop12=>0,
88  qpf=>0,
89  sky=>0,
90  snow=>0,
91  wspd=>0,
92  wdir=>0,
93  wx=>0,
94  waveh=>0,
95  icons=>1,
96  rh=>0,
97  appt=>0 };
98 
99 my $d1 = UnixDate("today at 8:00am", "%O");
100 my $d2 = UnixDate(DateCalc($d1, "+ 168 hours"), "%O");
101 my $result;
102 my $creationdate;
103 my $nextupdate;
104 my $getData = 1;
105 if (open (CACHE, "$dir/ndfd_cache_${latitude}_${longitude}")) {
106  ($nextupdate, $creationdate) = split / /, <CACHE>;
107  # We don't have to check the start/end dates, since we get the same chunk
108  # every time, and we update the cache atleast every hour, which is how often the
109  # data is updated by the NWS.
110  if (Date_Cmp($nextupdate, "now") > 0) { # use cache
111  no strict "vars"; # because eval doesn't scope var correctly
112  $result = eval <CACHE>;
113  if ($result) {
114  $getData = 0;
115  } else {
116  print STDERR "Error parsing cache $@\n";
117  };
118  }
119 
120 }
121 
122 if ($getData) {
123  my $unit = ($units eq "SI" ? "m" : "e");
124  ($result, $creationdate) = NDFDParser::doParse($latitude, $longitude, $d1, $d2, $unit, $param);
125  # output cache
126  open(CACHE, ">$dir/ndfd_cache_${latitude}_${longitude}") or
127  die "cannot open cache ($dir/ndfd_cache_${latitude}_${longitude}) for writing";
128  $Data::Dumper::Purity = 1;
129  $Data::Dumper::Sortkeys = 1;
130  $Data::Dumper::Indent = 0;
131  # NDFD is updated by 45 minutes after the hour, we'll give them until 50 to
132  # make sure
133  my $min = UnixDate("now", "%M");
134  my $newmin;
135  if ($min < 50) {
136  $newmin = 50-$min;
137  } else {
138  $newmin = 60-($min-50);
139  }
140  $nextupdate = DateCalc("now", "+ $newmin minutes");
141  print CACHE UnixDate($nextupdate, "%O ") . UnixDate("now", "%O\n");
142  print CACHE Dumper($result);
143 }
144 
145 my $lowindex = 0;
146 my $hiindex = 0;
147 my $dateindex = 0;
148 my $iconindex = 0;
149 my @dates;
150 my $time;
151 my $date;
152 
153 printf "updatetime::Last Updated on %s\n",
154  UnixDate($creationdate, "%b %d, %I:%M %p %Z");
155 print "copyright::National Digital Forecast Database\n";
156 print "copyrightlogo::none\n";
157 
158 foreach $time (sort(keys(%$result))) {
159  my $date;
160  if ($time =~ m/,/) {
161  ($date) = split /,/, $time;
162  } else {
163  $date = $time;
164  }
165 
166  if (Date_Cmp($date, $d1) < 0) {
167  next;
168  }
169 
170  my $numdate = UnixDate($date, "%Q");
171  if (!grep /$numdate/, @dates) {
172  push @dates, $numdate;
173  }
174  my $geticon = 0;
175  if ($lowindex <= 5 && $result->{$time}->{temperature_minimum}) {
176  print "low-${lowindex}::$result->{$time}->{temperature_minimum}\n";
177  $lowindex++;
178  } elsif ($hiindex <= 5 && $result->{$time}->{temperature_maximum}) {
179  print "high-${hiindex}::$result->{$time}->{temperature_maximum}\n";
180  $hiindex++;
181  $geticon = 1;
182  }
183  if ($geticon) {
184  my $tz = $time;
185  $tz =~ s/^.*([+-]\d{4})$/$1/;
186  my $iconkey = $date;
187  my $i = 0;
188  my $icon;
189  until ($result->{$iconkey}->{'conditions-icon_forecast-NWS'}
190  || $i++ > 8) {
191  $iconkey = UnixDate(DateCalc($iconkey, "+ 1 hour"), "%O").$tz;
192  }
193  if ($i >= 8) {
194  $icon = "unknown.png";
195  } else {
196  $icon = $result->{$iconkey}->{'conditions-icon_forecast-NWS'};
197  $icon =~ s/.*\/([a-z0-9_]+[.][j][p][g])/$1/;
198  local *FH;
199  open(FH, $icon_file) or die "Cannot open icons";
200  while(my $line = <FH>) {
201  if ($line =~ /${icon}::/) {
202  $line =~ s/.*:://;
203  print "icon-${iconindex}::$line";
204  $iconindex++;
205  last;
206  }
207  }
208  }
209  }
210 }
211 print "high-${hiindex}::NA\n" and $hiindex++ while ($hiindex <= 5);
212 print "low-${lowindex}::NA\n" and $lowindex++ while ($lowindex <= 5);
213 print "icon-${iconindex}::unknown.png\n" and $iconindex++ while ($iconindex<= 5);
214 
215 foreach $date (sort(@dates)) {
216  print "date-${dateindex}::" . UnixDate($date, "%A") . "\n"
217  if ($dateindex <= 5);
218  $dateindex++;
219 }
220 
221 
222 
223 # This script will accept locations that are either station ids, or latitude
224 # longitude. This is because I haven't decided which to use yet :)
225 sub getLocation {
226  my $str = shift;
227 
228  $str =~ tr/[a-z]/[A-Z]/;
229  my $lat;
230  my $lon;
231 
232  if ($str =~ m/[A-Z]{4,4}/) { # station id form
233  NWSLocation::AddStationIdSearch($str);
234 
235  } else { # hopefully lat/lon
236  ($lat, $lon) = split /,/, $str;
237  $lat =~ s/(\d{1,3}([.]\d{1,3})?)([.]\d{1,3})?[N]/+$1/ or
238  $lat =~ s/(\d{1,3}([.]\d{1,3})?)([.]\d{1,3})?[S]/-$1/;
239  $lon =~ s/(\d{1,3}[.](\d{1,3})?)([.]\d{1,3})?[E]/+$1/ or
240  $lon =~ s/(\d{1,3}([.]\d{1,3})?)([.]\d{1,3})?[W]/-$1/;
241  NWSLocation::AddLatLonSearch($lat, $lon);
242  }
243 
244  my $results = NWSLocation::doSearch($str);
245  if ($lat && $lon && !$results) {
246  # didn't find a matching station
247  print "location::$lat,$lon\n";
248  return ($lat, $lon);
249  }
250 
251  # Should be one result in array
252  my $location = $results->[0];
253  $lat = $location->{latitude};
254  $lon = $location->{longitude};
255  if ($lat eq 'NA' || $lon eq 'NA') {
256  # maybe scrape them from website, since they are there, annoying that
257  # they aren't all in the XML file, gotta love the U.S. Gov :)
258  die "Latitude and Longitude do not exist for $str";
259  }
260  print "3dlocation::$location->{station_name}, $location->{state}\n";
261  print "6dlocation::$location->{station_name}, $location->{state}\n";
262 
263  return ($lat, $lon);
264 }