| 1 | #!/usr/bin/perl -w
|
|---|
| 2 |
|
|---|
| 3 | use strict;
|
|---|
| 4 |
|
|---|
| 5 | use Data::Dumper;
|
|---|
| 6 | use Getopt::Std;
|
|---|
| 7 | use LWP::Simple;
|
|---|
| 8 | use XML::Simple;
|
|---|
| 9 |
|
|---|
| 10 | our($opt_d, $opt_l, $opt_t, $opt_T, $opt_u, $opt_v);
|
|---|
| 11 |
|
|---|
| 12 | my $name = 'weathercomXML';
|
|---|
| 13 | my $version = 0.3;
|
|---|
| 14 | my $author = 'Simon Flood';
|
|---|
| 15 | my $email = 'simon@floodfamily.info';
|
|---|
| 16 | my $updateTimeout = 15*60; # how/where is this used?
|
|---|
| 17 | my $retrieveTimeout = 30; # how/where is this used?
|
|---|
| 18 | my @types = ('3dlocation', '6dlocation', 'appt', 'cclocation', 'cclogo',
|
|---|
| 19 | 'ccprovider', 'date-0', 'date-1', 'date-2', 'date-3', 'date-4',
|
|---|
| 20 | 'date-5', 'desc1', 'desc2', 'desc3', 'dewpoint', 'fclocation',
|
|---|
| 21 | 'fclogo', 'fcprovider', 'high-0', 'high-1', 'high-2', 'high-3',
|
|---|
| 22 | 'high-4', 'high-5', 'icon-0', 'icon-1', 'icon-2', 'icon-3',
|
|---|
| 23 | 'icon-4', 'icon-5', 'latitude', 'longitude', 'low-0', 'low-1',
|
|---|
| 24 | 'low-2', 'low-3', 'low-4', 'low-5', 'observation_time',
|
|---|
| 25 | 'pressure', 'relative_humidity', 'station_id', 'temp',
|
|---|
| 26 | 'updatetime', 'visibility', 'weather', 'weather_icon', 'wind_dir',
|
|---|
| 27 | 'wind_gust', 'wind_speed', 'wind_spdgst');
|
|---|
| 28 | #my $dir = './';
|
|---|
| 29 | my $dir = '.';
|
|---|
| 30 | my $unit;
|
|---|
| 31 |
|
|---|
| 32 | my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
|
|---|
| 33 |
|
|---|
| 34 | my $base_url = "http://xoap.weather.com/";
|
|---|
| 35 | my $weather_url = $base_url . "weather/local/";
|
|---|
| 36 | my $query_url = $base_url . "search/search";
|
|---|
| 37 |
|
|---|
| 38 | my $ccxmlcache = "cc-cache.xml";
|
|---|
| 39 | my $fcxmlcache = "fc-cache.xml";
|
|---|
| 40 | my $ccrefreshtime = 15*60; # 15 minutes
|
|---|
| 41 | my $fcrefreshtime = 2*60*60; # 2 hours
|
|---|
| 42 |
|
|---|
| 43 | my($response, $ccxml, $fcxml, $locid);
|
|---|
| 44 |
|
|---|
| 45 | getopts('d:l:tTu:v');
|
|---|
| 46 |
|
|---|
| 47 | if (defined $opt_d && ((defined $opt_u) && !(defined $opt_l || defined $opt_t || defined $opt_T || defined $opt_v)))
|
|---|
| 48 | {
|
|---|
| 49 | if (-d $opt_d)
|
|---|
| 50 | {
|
|---|
| 51 | ($dir) = ($opt_d =~ /(.*)[^\/]?$/);
|
|---|
| 52 | }
|
|---|
| 53 | else
|
|---|
| 54 | {
|
|---|
| 55 | print "invalid directory ($opt_d)\n";
|
|---|
| 56 | exit 1;
|
|---|
| 57 | }
|
|---|
| 58 | }
|
|---|
| 59 |
|
|---|
| 60 | if (defined $opt_l && !(defined $opt_d || defined $opt_t || defined $opt_T || defined $opt_u || defined $opt_v))
|
|---|
| 61 | {
|
|---|
| 62 | my $search = get($query_url . "?where=" . $opt_l);
|
|---|
| 63 | my $searchxml = XMLin($search);
|
|---|
| 64 | if (defined $searchxml->{'loc'}->{'id'})
|
|---|
| 65 | {
|
|---|
| 66 | print $searchxml->{'loc'}->{'id'} . "::" . $searchxml->{'loc'}->{'content'} . "\n";
|
|---|
| 67 | }
|
|---|
| 68 | else
|
|---|
| 69 | {
|
|---|
| 70 | foreach my $locid (sort keys %{$searchxml->{'loc'}})
|
|---|
| 71 | {
|
|---|
| 72 | print $locid . "::" . $searchxml->{'loc'}->{$locid}->{'content'} . "\n";
|
|---|
| 73 | }
|
|---|
| 74 | }
|
|---|
| 75 | exit 0;
|
|---|
| 76 | }
|
|---|
| 77 |
|
|---|
| 78 | if (defined $opt_t && !(defined $opt_d || defined $opt_l || defined $opt_T || defined $opt_u || defined $opt_v))
|
|---|
| 79 | {
|
|---|
| 80 | foreach (@types)
|
|---|
| 81 | {
|
|---|
| 82 | print; print "\n";
|
|---|
| 83 | }
|
|---|
| 84 | exit 0;
|
|---|
| 85 | }
|
|---|
| 86 |
|
|---|
| 87 | if (defined $opt_T && !(defined $opt_d || defined $opt_l || defined $opt_t || defined $opt_u || defined $opt_v))
|
|---|
| 88 | {
|
|---|
| 89 | print "$updateTimeout,$retrieveTimeout\n"; # do these get used? where/how?
|
|---|
| 90 | exit 0;
|
|---|
| 91 | }
|
|---|
| 92 |
|
|---|
| 93 | if (defined $opt_u && !(defined $opt_l || defined $opt_t || defined $opt_T || defined $opt_v))
|
|---|
| 94 | {
|
|---|
| 95 | if ($opt_u eq "ENG")
|
|---|
| 96 | {
|
|---|
| 97 | $unit = "s";
|
|---|
| 98 | }
|
|---|
| 99 | elsif ($opt_u eq "SI")
|
|---|
| 100 | {
|
|---|
| 101 | $unit = "m";
|
|---|
| 102 | }
|
|---|
| 103 | }
|
|---|
| 104 |
|
|---|
| 105 | if (defined $opt_v && !(defined $opt_d || defined $opt_l || defined $opt_t || defined $opt_T || defined $opt_u))
|
|---|
| 106 | {
|
|---|
| 107 | print "$name,$version,$author,$email\n";
|
|---|
| 108 | exit 0;
|
|---|
| 109 | }
|
|---|
| 110 |
|
|---|
| 111 | $locid = shift;
|
|---|
| 112 |
|
|---|
| 113 | if (!(defined $unit && defined $locid))
|
|---|
| 114 | {
|
|---|
| 115 | print "Usage: $0 -l <location>\n";
|
|---|
| 116 | print " $0 -t\n";
|
|---|
| 117 | print " $0 -T\n";
|
|---|
| 118 | print " $0 -u <units> [-d <directory>] <location_id>\n";
|
|---|
| 119 | print " $0 -v\n";
|
|---|
| 120 | print "Options:\n";
|
|---|
| 121 | print " -d <directory> use <directory> to store data (must have write permissions!)\n";
|
|---|
| 122 | print " -l <location> return list of location ids matching <location>\n";
|
|---|
| 123 | print " -t return list of data items supported by script\n";
|
|---|
| 124 | print " -T return default timeout values (updateTimeout,retrieveTimeout)\n";
|
|---|
| 125 | print " -u <units> specify the units desired in the output, either \"ENG\"\n";
|
|---|
| 126 | print " (imperial) or \"SI\" (metric)\n";
|
|---|
| 127 | print " -v return information about script (name,version,author,email)\n";
|
|---|
| 128 | exit 0;
|
|---|
| 129 | }
|
|---|
| 130 |
|
|---|
| 131 | sub read_XML_from_cache
|
|---|
| 132 | {
|
|---|
| 133 | my($filename) = @_;
|
|---|
| 134 | my($result);
|
|---|
| 135 | open(CACHE, $filename);
|
|---|
| 136 | no strict "vars";
|
|---|
| 137 | $result = eval <CACHE>;
|
|---|
| 138 | close(CACHE);
|
|---|
| 139 | return($result);
|
|---|
| 140 | }
|
|---|
| 141 |
|
|---|
| 142 | sub fetch_XML_and_write_to_cache
|
|---|
| 143 | {
|
|---|
| 144 | my($url, $filename) = @_;
|
|---|
| 145 | my($response, $result);
|
|---|
| 146 | $response = get $url;
|
|---|
| 147 | $result = XMLin($response);
|
|---|
| 148 | open(CACHE, ">$filename") ||
|
|---|
| 149 | die "cannot open cache ($filename) for writing";
|
|---|
| 150 | $Data::Dumper::Indent = 0;
|
|---|
| 151 | $Data::Dumper::Purity = 1;
|
|---|
| 152 | $Data::Dumper::Sortkeys = 1;
|
|---|
| 153 | print CACHE Dumper($result);
|
|---|
| 154 | close(CACHE);
|
|---|
| 155 | return($result);
|
|---|
| 156 | }
|
|---|
| 157 |
|
|---|
| 158 | my $time = time;
|
|---|
| 159 | my($lastmod);
|
|---|
| 160 |
|
|---|
| 161 | if (-e "$dir/$ccxmlcache")
|
|---|
| 162 | {
|
|---|
| 163 | $lastmod = (stat("$dir/$ccxmlcache"))[9];
|
|---|
| 164 | if (($time - $lastmod) >= $ccrefreshtime)
|
|---|
| 165 | {
|
|---|
| 166 | $ccxml = &fetch_XML_and_write_to_cache("$weather_url$locid?cc=*&unit=$unit", "$dir/$ccxmlcache");
|
|---|
| 167 | }
|
|---|
| 168 | else
|
|---|
| 169 | {
|
|---|
| 170 | $ccxml = &read_XML_from_cache("$dir/$ccxmlcache");
|
|---|
| 171 | }
|
|---|
| 172 | }
|
|---|
| 173 | else
|
|---|
| 174 | {
|
|---|
| 175 | $ccxml = &fetch_XML_and_write_to_cache("$weather_url$locid?cc=*&unit=$unit", "$dir/$ccxmlcache");
|
|---|
| 176 | }
|
|---|
| 177 |
|
|---|
| 178 | #print Dumper($ccxml); exit;
|
|---|
| 179 |
|
|---|
| 180 | if (-e "$dir/$fcxmlcache")
|
|---|
| 181 | {
|
|---|
| 182 | $lastmod = (stat("$dir/$fcxmlcache"))[9];
|
|---|
| 183 | if (($time - $lastmod) >= $fcrefreshtime)
|
|---|
| 184 | {
|
|---|
| 185 | $fcxml = &fetch_XML_and_write_to_cache("$weather_url$locid?dayf=10&unit=$unit", "$dir/$fcxmlcache");
|
|---|
| 186 | }
|
|---|
| 187 | else
|
|---|
| 188 | {
|
|---|
| 189 | $fcxml = &read_XML_from_cache("$dir/$fcxmlcache");
|
|---|
| 190 | }
|
|---|
| 191 | }
|
|---|
| 192 | else
|
|---|
| 193 | {
|
|---|
| 194 | $fcxml = &fetch_XML_and_write_to_cache("$weather_url$locid?dayf=10&unit=$unit", "$dir/$fcxmlcache");
|
|---|
| 195 | }
|
|---|
| 196 |
|
|---|
| 197 | #print Dumper($fcxml); exit;
|
|---|
| 198 |
|
|---|
| 199 | my($label, $value);
|
|---|
| 200 |
|
|---|
| 201 | if (!(defined $ccxml->{'err'} || defined $fcxml->{'err'}))
|
|---|
| 202 | {
|
|---|
| 203 | foreach (@types)
|
|---|
| 204 | {
|
|---|
| 205 | $label = $_;
|
|---|
| 206 |
|
|---|
| 207 | if (/[36]dlocation/ || /fclocation/)
|
|---|
| 208 | {
|
|---|
| 209 | $value = $fcxml->{'loc'}->{'dnam'};
|
|---|
| 210 | }
|
|---|
| 211 | elsif (/appt/)
|
|---|
| 212 | {
|
|---|
| 213 | # $value = $ccxml->{'cc'}->{'flik'} . chr(176) . $ccxml->{'head'}->{'ut'};
|
|---|
| 214 | $value = $ccxml->{'cc'}->{'flik'} . chr(176);
|
|---|
| 215 | }
|
|---|
| 216 | elsif (/cclocation/)
|
|---|
| 217 | {
|
|---|
| 218 | $value = $ccxml->{'cc'}->{'obst'};
|
|---|
| 219 | }
|
|---|
| 220 | elsif (/[cf]clogo/)
|
|---|
| 221 | {
|
|---|
| 222 | $value = "TWClogo_64px.png";
|
|---|
| 223 | }
|
|---|
| 224 | elsif (/[cf]cprovider/)
|
|---|
| 225 | {
|
|---|
| 226 | $value = "Weather data provided by weather.com" . chr(174);
|
|---|
| 227 | }
|
|---|
| 228 | elsif (/date-0/)
|
|---|
| 229 | {
|
|---|
| 230 | if ($fcxml->{'dayf'}->{'day'}->[0]->{'hi'} eq "N/A")
|
|---|
| 231 | {
|
|---|
| 232 | $value = "Tonight";
|
|---|
| 233 | }
|
|---|
| 234 | else
|
|---|
| 235 | {
|
|---|
| 236 | $value = "Today";
|
|---|
| 237 | }
|
|---|
| 238 | }
|
|---|
| 239 | elsif (/date-1/)
|
|---|
| 240 | {
|
|---|
| 241 | $value = "Tomorrow";
|
|---|
| 242 | }
|
|---|
| 243 | elsif (/date-([2-5])/)
|
|---|
| 244 | {
|
|---|
| 245 | $value = $fcxml->{'dayf'}->{'day'}->[$1]->{'t'};
|
|---|
| 246 | }
|
|---|
| 247 | elsif (/desc1/)
|
|---|
| 248 | {
|
|---|
| 249 | if ($fcxml->{'dayf'}->{'day'}->[0]->{'hi'} eq "N/A")
|
|---|
| 250 | {
|
|---|
| 251 | $value = $fcxml->{'dayf'}->{'day'}->[0]->{'part'}->[1]->{'t'};
|
|---|
| 252 | }
|
|---|
| 253 | else
|
|---|
| 254 | {
|
|---|
| 255 | $value = $fcxml->{'dayf'}->{'day'}->[0]->{'part'}->[0]->{'t'};
|
|---|
| 256 | }
|
|---|
| 257 | }
|
|---|
| 258 | elsif (/desc([23])/)
|
|---|
| 259 | {
|
|---|
| 260 | $value = $fcxml->{'dayf'}->{'day'}->[$1-1]->{'part'}->[0]->{'t'};
|
|---|
| 261 | }
|
|---|
| 262 | elsif (/dewpoint/)
|
|---|
| 263 | {
|
|---|
| 264 | # $value = $ccxml->{'cc'}->{'dewp'} . chr(176) . $ccxml->{'head'}->{'ut'};
|
|---|
| 265 | $value = $ccxml->{'cc'}->{'dewp'} . chr(176);
|
|---|
| 266 | }
|
|---|
| 267 | elsif (/high-([0-5])/) {
|
|---|
| 268 | $value = $fcxml->{'dayf'}->{'day'}->[$1]->{'hi'};
|
|---|
| 269 | }
|
|---|
| 270 | elsif (/icon-0/)
|
|---|
| 271 | {
|
|---|
| 272 | if ($fcxml->{'dayf'}->{'day'}->[0]->{'hi'} eq "N/A")
|
|---|
| 273 | {
|
|---|
| 274 | $value = $fcxml->{'dayf'}->{'day'}->[0]->{'part'}->[1]->{'icon'} . '.png';
|
|---|
| 275 | }
|
|---|
| 276 | else
|
|---|
| 277 | {
|
|---|
| 278 | $value = $fcxml->{'dayf'}->{'day'}->[0]->{'part'}->[0]->{'icon'} . '.png';
|
|---|
| 279 | }
|
|---|
| 280 | }
|
|---|
| 281 | elsif (/icon-([1-5])/)
|
|---|
| 282 | {
|
|---|
| 283 | $value = $fcxml->{'dayf'}->{'day'}->[$1]->{'part'}->[0]->{'icon'} . '.png';
|
|---|
| 284 | }
|
|---|
| 285 | elsif (/latitude/)
|
|---|
| 286 | {
|
|---|
| 287 | $value = $fcxml->{'loc'}->{'lat'};
|
|---|
| 288 | }
|
|---|
| 289 | elsif (/longitude/)
|
|---|
| 290 | {
|
|---|
| 291 | $value = $fcxml->{'loc'}->{'lon'};
|
|---|
| 292 | }
|
|---|
| 293 | elsif (/low-([0-5])/)
|
|---|
| 294 | {
|
|---|
| 295 | $value = $fcxml->{'dayf'}->{'day'}->[$1]->{'low'};
|
|---|
| 296 | }
|
|---|
| 297 | elsif (/observation_time/)
|
|---|
| 298 | {
|
|---|
| 299 | $ccxml->{'cc'}->{'lsup'} =~ /^(\d{1,2})\/(\d{1,2})\/\d{2}\s(\d{1,2})(:\d{2}.*)$/;
|
|---|
| 300 | $value = "$months[$1-1] $2, ";
|
|---|
| 301 | if ($3 < 10)
|
|---|
| 302 | {
|
|---|
| 303 | $value .= "0";
|
|---|
| 304 | }
|
|---|
| 305 | $value .= "$3$4";
|
|---|
| 306 | }
|
|---|
| 307 | elsif (/pressure/)
|
|---|
| 308 | {
|
|---|
| 309 | # $value = $ccxml->{'cc'}->{'bar'}->{'r'} . ' ' . $ccxml->{'head'}->{'up'} . ' (' . $ccxml->{'cc'}->{'bar'}->{'d'} . ')';
|
|---|
| 310 | # $value = $ccxml->{'cc'}->{'bar'}->{'r'} . ' (' . $ccxml->{'cc'}->{'bar'}->{'d'} . ')';
|
|---|
| 311 | $value = $ccxml->{'cc'}->{'bar'}->{'r'} . ' ';
|
|---|
| 312 | if ($ccxml->{'cc'}->{'bar'}->{'d'} =~ /rising/)
|
|---|
| 313 | {
|
|---|
| 314 | $value .= '+';
|
|---|
| 315 | }
|
|---|
| 316 | elsif ($ccxml->{'cc'}->{'bar'}->{'d'} =~ /steady/)
|
|---|
| 317 | {
|
|---|
| 318 | $value .= '=';
|
|---|
| 319 | }
|
|---|
| 320 | elsif ($ccxml->{'cc'}->{'bar'}->{'d'} =~ /falling/)
|
|---|
| 321 | {
|
|---|
| 322 | $value .= '-';
|
|---|
| 323 | }
|
|---|
| 324 | else
|
|---|
| 325 | {
|
|---|
| 326 | $value .= '?';
|
|---|
| 327 | }
|
|---|
| 328 | }
|
|---|
| 329 | elsif (/station_id/)
|
|---|
| 330 | {
|
|---|
| 331 | $value = $locid;
|
|---|
| 332 | }
|
|---|
| 333 | elsif (/temp/)
|
|---|
| 334 | {
|
|---|
| 335 | # $value = $ccxml->{'cc'}->{'tmp'} . chr(176) . $ccxml->{'head'}->{'ut'};
|
|---|
| 336 | $value = $ccxml->{'cc'}->{'tmp'} . chr(176);
|
|---|
| 337 | }
|
|---|
| 338 | elsif (/relative_humidity/)
|
|---|
| 339 | {
|
|---|
| 340 | # $value = $ccxml->{'cc'}->{'hmid'} . "%";
|
|---|
| 341 | $value = $ccxml->{'cc'}->{'hmid'};
|
|---|
| 342 | }
|
|---|
| 343 | elsif (/updatetime/)
|
|---|
| 344 | {
|
|---|
| 345 | $fcxml->{'dayf'}->{'lsup'} =~ /^(\d{1,2})\/(\d{1,2})\/\d{2}\s(\d{1,2})(:\d{2}.*)$/;
|
|---|
| 346 | $value = "$months[$1-1] $2, ";
|
|---|
| 347 | if ($3 < 10)
|
|---|
| 348 | {
|
|---|
| 349 | $value .= "0";
|
|---|
| 350 | }
|
|---|
| 351 | $value .= "$3$4";
|
|---|
| 352 | }
|
|---|
| 353 | elsif (/visibility/)
|
|---|
| 354 | {
|
|---|
| 355 | $value = $ccxml->{'cc'}->{'vis'};
|
|---|
| 356 | }
|
|---|
| 357 | elsif (/wind_dir/)
|
|---|
| 358 | {
|
|---|
| 359 | $value = $ccxml->{'cc'}->{'wind'}->{'t'};
|
|---|
| 360 | }
|
|---|
| 361 | elsif (/weather$/)
|
|---|
| 362 | {
|
|---|
| 363 | $value = $ccxml->{'cc'}->{'t'};
|
|---|
| 364 | }
|
|---|
| 365 | elsif (/weather_icon/)
|
|---|
| 366 | {
|
|---|
| 367 | $value = $ccxml->{'cc'}->{'icon'} . '.png';
|
|---|
| 368 | }
|
|---|
| 369 | elsif (/wind_gust/)
|
|---|
| 370 | {
|
|---|
| 371 | $value = $ccxml->{'cc'}->{'wind'}->{'gust'};
|
|---|
| 372 | if ($value ne "N/A")
|
|---|
| 373 | {
|
|---|
| 374 | $value .= ' ' . $ccxml->{'head'}->{'us'};
|
|---|
| 375 | }
|
|---|
| 376 | }
|
|---|
| 377 | elsif (/wind_spdgst/)
|
|---|
| 378 | {
|
|---|
| 379 | $value = "$ccxml->{'cc'}->{'wind'}->{'s'} ($ccxml->{'cc'}->{'wind'}->{'gust'}) $ccxml->{'head'}->{'us'}";
|
|---|
| 380 | }
|
|---|
| 381 | elsif (/wind_speed/)
|
|---|
| 382 | {
|
|---|
| 383 | $value = $ccxml->{'cc'}->{'wind'}->{'s'} . ' ' . $ccxml->{'head'}->{'us'};
|
|---|
| 384 | }
|
|---|
| 385 |
|
|---|
| 386 | print $label . "::" . $value . "\n";
|
|---|
| 387 | }
|
|---|
| 388 |
|
|---|
| 389 | }
|
|---|
| 390 | else
|
|---|
| 391 | {
|
|---|
| 392 |
|
|---|
| 393 | foreach (@types)
|
|---|
| 394 | {
|
|---|
| 395 | $label = $_;
|
|---|
| 396 | if (/icon/)
|
|---|
| 397 | {
|
|---|
| 398 | $value = "unknown.png";
|
|---|
| 399 | }
|
|---|
| 400 | else
|
|---|
| 401 | {
|
|---|
| 402 | $value = "N/A";
|
|---|
| 403 | }
|
|---|
| 404 | print $_ . "::" . $value . "\n";
|
|---|
| 405 | }
|
|---|
| 406 |
|
|---|
| 407 | } |
|---|
