00001 #!/usr/bin/perl -w
00002 # MythWeather-revamp script to retreive weather information from Environment
00003 # Canada.
00004 #
00005 # Most of this code was taken directly from Lucien Dunning's
00006 # (ldunning@gmail.com) PERL scripts. Kudos to Lucien for doing all of the
00007 # hard work that I shamelessly stole.
00008 #
00009 # TODO Code clean up and organization
00010
00011 use strict;
00012 use LWP::Simple;
00013 use Date::Manip;
00014 use Getopt::Std;
00015 use ENVCANLocation;
00016 use ENVCANParser;
00017 use Data::Dumper;
00018
00019 our ($opt_v, $opt_t, $opt_T, $opt_l, $opt_u, $opt_d);
00020
00021 my $name = 'ENVCAN';
00022 my $version = 0.4;
00023 my $author = 'Joe Ripley';
00024 my $email = 'vitaminjoe@gmail.com';
00025 my $updateTimeout = 15*60;
00026 my $retrieveTimeout = 30;
00027 my @types = ('cclocation', 'station_id', 'copyright',
00028 'observation_time', 'observation_time_rfc822', 'weather',
00029 'temp', 'relative_humidity',
00030 'wind_dir', 'wind_degrees', 'wind_speed', 'wind_gust',
00031 'pressure', 'dewpoint', 'heat_index', 'windchill',
00032 'visibility', 'weather_icon', 'appt', 'wind_spdgst',
00033 '3dlocation', '6dlocation', 'date-0', 'icon-0', 'low-0', 'high-0',
00034 'date-1', 'icon-1', 'low-1', 'high-1',
00035 'date-2', 'icon-2', 'low-2', 'high-2', 'updatetime',
00036 'date-3', 'icon-3', 'low-3', 'high-3',
00037 'date-4', 'icon-4', 'low-4', 'high-4',
00038 'date-5', 'icon-5', 'low-5', 'high-5' );
00039
00040 my $dir = "./";
00041
00042 getopts('Tvtlu:d:');
00043
00044 if (defined $opt_v) {
00045 print "$name,$version,$author,$email\n";
00046 exit 0;
00047 }
00048
00049 if (defined $opt_T) {
00050 print "$updateTimeout,$retrieveTimeout\n";
00051 exit 0;
00052 }
00053 if (defined $opt_l) {
00054 my $search = shift;
00055 ENVCANLocation::AddStationIdSearch($search);
00056 ENVCANLocation::AddRegionIdSearch($search);
00057 ENVCANLocation::AddCitySearch($search);
00058 ENVCANLocation::AddProvinceSearch($search);
00059 my $results = doSearch();
00060 my $result;
00061 while($result = shift @$results) {
00062 if ($result->{station_id} ne "NA" ) {
00063 print "$result->{station_id}::";
00064 print "$result->{city}, $result->{region_id}\n";
00065 }
00066 }
00067 exit 0;
00068 }
00069
00070
00071 if (defined $opt_t) {
00072 foreach (@types) {print; print "\n";}
00073 exit 0;
00074 }
00075
00076 if (defined $opt_d) {
00077 $dir = $opt_d;
00078 }
00079
00080 # check variables for defined status
00081 my $loc = shift;
00082 if (!(defined $opt_u && defined $loc && !$loc eq "")) {
00083 die "Invalid usage";
00084 }
00085
00086 my $units = $opt_u;
00087
00088 # check for cached data
00089 my $creationdate;
00090 my $nextupdate;
00091 my %results;
00092 my $getData = 1;
00093 if (open(CACHE, "$dir/envcan_$loc")) {
00094 ($nextupdate, $creationdate) = split / /, <CACHE>;
00095 if (Date_Cmp($nextupdate, "today") > 0) { # use cache
00096 no strict "vars";
00097 %results = eval <CACHE>;
00098
00099 if (%results) { $getData = 0; }
00100 else { print STDERR "Error parsing cache $@\n"; }
00101 }
00102 }
00103 close(CACHE);
00104
00105 # no cache, grab from the web
00106 if ($getData) {
00107 my $base_url = 'http://www.weatheroffice.gc.ca/rss/city/';
00108 my $response = get $base_url . $loc .'_e.xml';
00109 die unless defined $response;
00110
00111 %results = ENVCANParser::doParse($response, @types);
00112 $results{'station_id'} = $loc;
00113
00114 # output cache
00115 open (CACHE, ">$dir/envcan_$loc") or
00116 die ("Cannot open cache ($dir/envcan_$loc) for writing.");
00117 $Data::Dumper::Purity = 1;
00118 $Data::Dumper::Indent = 0;
00119
00120 # cache is good for 15 minutes
00121 my $newmin = 15;
00122
00123 $nextupdate = DateCalc("today", "+ $newmin minutes");
00124 print CACHE UnixDate($nextupdate, "%O ") . UnixDate("today", "%O\n");
00125 print CACHE Data::Dumper->Dump([\%results], ['*results']);
00126 }
00127
00128 # do some quick conversions
00129 if ($units eq "ENG") {
00130 $results{'temp'} = int(((9/5) * $results{'temp'}) + 32);
00131 $results{'dewpoint'} = int(((9/5) * $results{'dewpoint'}) + 32);
00132 $results{'windchill'} = int(((9/5) * $results{'windchill'}) + 32);
00133 $results{'appt'} = int(((9/5) * $results{'appt'}) + 32);
00134 $results{'visibility'} = sprintf("%.1f", ($results{'visibility'} * 0.621371192));
00135 $results{'pressure'} = sprintf("%.2f", $results{'pressure'} * 0.0295301);
00136 $results{'wind_gust'} = sprintf("%.2f", $results{'wind_gust'} * 0.621371192);
00137 $results{'wind_speed'} = sprintf("%.2f", $results{'wind_speed'} * 0.621371192);
00138 $results{'wind_spdgst'} = sprintf("%.2f (%.2f)", $results{'wind_speed'}, $results{'wind_gust'});
00139
00140 for (my $i=0;$i<6;$i++) {
00141 if ($results{"high-$i"} =~ /\d*/) {
00142 $results{"high-$i"} = int(((9/5) * $results{"high-$i"}) + 32);
00143 }
00144 if ($results{"low-$i"} =~ /\d*/) {
00145 $results{"low-$i"} = int(((9/5) * $results{"low-$i"}) + 32);
00146 }
00147 }
00148 } else {
00149 $results{'wind_spdgst'} = sprintf("%.2f (%.2f)", $results{'wind_speed'}, $results{'wind_gust'});
00150 }
00151
00152
00153 foreach my $key (sort (keys %results)) {
00154 print "$key". "::";
00155 if (length($results{$key}) == 0) {
00156 print "NA\n";
00157 } else {
00158 print $results{$key} ."\n";
00159 }
00160 }
00161