MythTV  master
envcan.pl
Go to the documentation of this file.
1 #!/usr/bin/perl
2 # MythWeather-revamp script to retreive weather information from Environment
3 # Canada.
4 #
5 # Most of this code was taken directly from Lucien Dunning's
6 # (ldunning@gmail.com) PERL scripts. Kudos to Lucien for doing all of the
7 # hard work that I shamelessly stole.
8 #
9 
10 use strict;
11 use warnings;
12 
13 use English;
14 use File::Basename;
15 use Cwd 'abs_path';
16 use lib dirname(abs_path($0 or $PROGRAM_NAME)),
17  '/usr/share/mythtv/mythweather/scripts/ca_envcan',
18  '/usr/local/share/mythtv/mythweather/scripts/ca_envcan';
19 
20 use LWP::Simple;
21 use Date::Manip;
22 use Getopt::Std;
23 use ENVCANLocation;
24 use ENVCANParser;
25 use Data::Dumper;
26 
27 our ($opt_v, $opt_t, $opt_T, $opt_l, $opt_u, $opt_d);
28 
29 my $name = 'ENVCAN';
30 my $version = 0.5;
31 my $author = 'Joe Ripley / Gavin Hurlbut';
32 my $email = 'vitaminjoe@gmail.com / gjhurlbu@gmail.com';
33 my $updateTimeout = 15*60;
34 my $retrieveTimeout = 30;
35 my @types = ('cclocation', 'station_id', 'copyright',
36  'observation_time', 'observation_time_rfc822', 'weather',
37  'temp', 'relative_humidity',
38  'wind_dir', 'wind_degrees', 'wind_speed', 'wind_gust',
39  'pressure', 'dewpoint', 'heat_index', 'windchill',
40  'visibility', 'weather_icon', 'appt', 'wind_spdgst',
41  '3dlocation', '6dlocation', 'date-0', 'icon-0', 'low-0', 'high-0',
42  'date-1', 'icon-1', 'low-1', 'high-1',
43  'date-2', 'icon-2', 'low-2', 'high-2', 'updatetime',
44  'date-3', 'icon-3', 'low-3', 'high-3',
45  'date-4', 'icon-4', 'low-4', 'high-4',
46  'date-5', 'icon-5', 'low-5', 'high-5', 'copyrightlogo' );
47 
48 my $dir = "./";
49 
50 getopts('Tvtlu:d:');
51 
52 if (defined $opt_v) {
53  print "$name,$version,$author,$email\n";
54  exit 0;
55 }
56 
57 if (defined $opt_T) {
58  print "$updateTimeout,$retrieveTimeout\n";
59  exit 0;
60 }
61 if (defined $opt_l) {
62  my $search = shift;
63  ENVCANLocation::AddStationIdSearch($search);
64  ENVCANLocation::AddRegionIdSearch($search);
65  ENVCANLocation::AddCitySearch($search);
66  ENVCANLocation::AddProvinceSearch($search);
67  my $results = doSearch();
68  my $result;
69  while($result = shift @$results) {
70  if ($result->{station_id} ne "NA" ) {
71  print "$result->{station_id}::";
72  print "$result->{city}, $result->{region_id}\n";
73  }
74  }
75  exit 0;
76 }
77 
78 
79 if (defined $opt_t) {
80  foreach (@types) {print; print "\n";}
81  exit 0;
82 }
83 
84 if (defined $opt_d) {
85  $dir = $opt_d;
86 }
87 
88 # check variables for defined status
89 my $loc = shift;
90 if (!(defined $opt_u && defined $loc && !$loc eq "")) {
91  die "Invalid usage";
92 }
93 
94 my $units = $opt_u;
95 
96 # check for cached data
97 my $creationdate;
98 my $nextupdate;
99 my %results;
100 my $getData = 1;
101 if (open(CACHE, "$dir/envcan_$loc")) {
102  ($nextupdate, $creationdate) = split / /, <CACHE>;
103  if (Date_Cmp($nextupdate, "now") > 0) { # use cache
104  no strict "vars";
105  %results = eval <CACHE>;
106 
107  if (%results) { $getData = 0; }
108  else { print STDERR "Error parsing cache $@\n"; }
109  }
110 }
111 close(CACHE);
112 
113 # no cache, grab from the web
114 if ($getData) {
115  my $base_url = 'http://www.weatheroffice.gc.ca/rss/city/';
116  my $response = get $base_url . $loc .'_e.xml';
117  die unless defined $response;
118 
119  %results = ENVCANParser::doParse($response, @types);
120  $results{'station_id'} = $loc;
121 
122  # output cache
123  open (CACHE, ">$dir/envcan_$loc") or
124  die ("Cannot open cache ($dir/envcan_$loc) for writing.");
125  $Data::Dumper::Purity = 1;
126  $Data::Dumper::Indent = 0;
127 
128  # cache is good for 15 minutes
129  my $newmin = 15;
130 
131  $nextupdate = DateCalc("now", "+ $newmin minutes");
132  print CACHE UnixDate($nextupdate, "%O ") . UnixDate("now", "%O\n");
133  print CACHE Data::Dumper->Dump([\%results], ['*results']);
134 }
135 
136 $results{'copyrightlogo'} = "none";
137 
138 # do some quick conversions
139 if ($units eq "ENG") {
140  $results{'temp'} = int(((9/5) * $results{'temp'}) + 32);
141  $results{'dewpoint'} = int(((9/5) * $results{'dewpoint'}) + 32);
142  $results{'windchill'} = int(((9/5) * $results{'windchill'}) + 32);
143  $results{'appt'} = int(((9/5) * $results{'appt'}) + 32);
144  $results{'visibility'} = sprintf("%.1f", ($results{'visibility'} * 0.621371192));
145  $results{'pressure'} = sprintf("%.2f", $results{'pressure'} * 0.0295301);
146  $results{'wind_gust'} = sprintf("%.2f", $results{'wind_gust'} * 0.621371192);
147  $results{'wind_speed'} = sprintf("%.2f", $results{'wind_speed'} * 0.621371192);
148  $results{'wind_spdgst'} = sprintf("%.2f (%.2f)", $results{'wind_speed'}, $results{'wind_gust'});
149 
150  for (my $i=0;$i<6;$i++) {
151  if ($results{"high-$i"} =~ /\d*/) {
152  $results{"high-$i"} = int(((9/5) * $results{"high-$i"}) + 32);
153  }
154  if ($results{"low-$i"} =~ /\d*/) {
155  $results{"low-$i"} = int(((9/5) * $results{"low-$i"}) + 32);
156  }
157  }
158 } else {
159  $results{'wind_spdgst'} = sprintf("%.2f (%.2f)", $results{'wind_speed'}, $results{'wind_gust'});
160 }
161 
162 foreach my $key (sort (keys %results)) {
163  print "$key". "::";
164  if (length($results{$key}) == 0) {
165  print "NA\n";
166  } else {
167  print $results{$key} ."\n";
168  }
169 }