# $Id$ ############################################################################## # # 59_WWO.pm # Copyright by Andreas Vogt # e-mail: sourceforge at baumrasen dot de # # get current weather condition and forecast from worldweatheronline.com # # based / modified from 59_Weather.pm written by Dr. Boris Neubert # e-mail: omega at online dot de # # This file is part of fhem. # # Fhem is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # Fhem is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with fhem. If not, see . # ############################################################################## package main; use strict; use warnings; use Time::HiRes qw(gettimeofday); use HttpUtils; # use Date::Calc qw(Day_of_Week Day_of_Week_to_Text); # # uses the Free Weather API: http://developer.worldweatheronline.com # # Mapping of current supported encodings my %DEFAULT_ENCODINGS = ( en => 'latin1', da => 'latin1', de => 'latin1', es => 'latin1', fi => 'latin1', fr => 'latin1', it => 'latin1', ja => 'utf-8', ko => 'utf-8', nl => 'latin1', no => 'latin1', 'pt-BR' => 'latin1', ru => 'utf-8', sv => 'latin1', 'zh-CN' => 'utf-8', 'zh-TW' => 'utf-8', ); ##################################### sub WWO_Initialize($) { my ($hash) = @_; # Provider # $hash->{Clients} = undef; # Consumer $hash->{DefFn} = "WWO_Define"; $hash->{UndefFn} = "WWO_Undef"; $hash->{GetFn} = "WWO_Get"; $hash->{SetFn} = "WWO_Set"; #$hash->{AttrFn} = "WWO_Attr"; #$hash->{AttrList}= "days:0,1,2,3,4,5 loglevel:0,1,2,3,4,5 localicons event-on-update-reading event-on-change-reading"; #$hash->{AttrList}= "loglevel:0,1,2,3,4,5 localicons event-on-update-reading event-on-change-reading"; $hash->{AttrList}= "localicons ". $readingFnAttributes; } ################################### sub latin1_to_utf8($) { # http://perldoc.perl.org/perluniintro.html, UNICODE IN OLDER PERLS my ($s)= @_; $s =~ s/([\x80-\xFF])/chr(0xC0|ord($1)>>6).chr(0x80|ord($1)&0x3F)/eg; return $s; } ################################### #sub temperature_in_c { # my ($temperature, $unitsystem)= @_; # return $unitsystem ne "SI" ? int(($temperature-32)*5/9+0.5) : $temperature; #} #sub wind_in_km_per_h { # my ($wind, $unitsystem)= @_; # return $unitsystem ne "SI" ? int(1.609344*$wind+0.5) : $wind; #} ################################### sub WWO_UpdateReading($$$$) { my ($hash,$prefix,$key,$value)= @_; #Debug "WWO: $prefix $key $value"; #my $unitsystem= $hash->{READINGS}{unit_system}{VAL}; #not needed if($key eq "date") { my @da = split("-", $value); $value = sprintf("%02d.%02d.",$da[2],$da[1]); $value= $value; } # elsif($key eq "tempMaxC") { # $key= "tempMaxC"; # #$value= temperature_in_c($value,$unitsystem); # $value= $value; # } elsif($key eq "humidity") { # # standardize reading - allow generic logging of humidity. # $value=~ s/.*?(\d+).*/$1/; # extract numeric # } #Debug "WWO: $prefix $key $value"; my $reading= $prefix . $key; readingsBulkUpdate($hash,$reading,$value); if($key eq "temp_C") { readingsBulkUpdate($hash,"temperature",$value); # additional entry for compatibility } # if($key eq "date") { # $reading = $prefix . "shortdate"; # my @da = split("-", $value); # $value = left(Day_of_Week_to_Text(Day_of_Week($da[0], $da[1], $da[2]), 3),2); # readingsBulkUpdate($hash,$reading,$value); # additional entry # } if($key eq "weatherIconUrl") { # $value =~ s/.*\/([^.\/]*)\.*/$1/; $value =~ s/.*\/([^\/]+\.[^\.]+)/$1/; $reading= $prefix . "icon"; readingsBulkUpdate($hash,$reading,$value); # additional entry for icon name } if($reading eq "windspeedKmph") { #$value=~ s/.*?(\d+).*/$1/; # extract numeric # readingsBulkUpdate($hash,"wind",wind_in_km_per_h($value,$unitsystem)); # additional entry for compatibility readingsBulkUpdate($hash,"wind",$value); # additional entry for compatibility } return 1; } ################################### sub WWO_RetrieveDataDirectly($) { my ($hash)= @_; my $location= $hash->{LOCATION}; my $apikey = $hash->{APIKEY}; my $days = $hash->{DAYS}; $days = 5; #$location =~ s/([^\w()’*~!.-])/sprintf '%%%02x', ord $1/eg; my $lang= $hash->{LANG}; my $fc = 0; my $fd = 0; my $days_addon = "&fx=no"; if ($days > 0) {$days_addon = "&num_of_days=" . $days;} my $theurl = "http://api2.worldweatheronline.com/free/v1/weather.ashx?q=" . $location . "&extra=localObsTime&format=xml" . $days_addon . "&key=" . $apikey; #Debug "WWO: fecht url: $theurl"; # my $xml = GetFileFromURL("http://free.worldweatheronline.com/feed/weather.ashx?q=" . $location . "&extra=localObsTime&format=xml" . $days_addon . "&key=" . $apikey); # my $xml = GetFileFromURL($theurl); my $xml = CustomGetFileFromURL(0, $theurl); #Debug "WWO: xml file content: $xml"; # return 0 if( ! defined $xml || $xml eq ""); if( ! defined $xml || $xml eq "") { # Log-Entry if nothing is returned Log3 $hash, 1, "WWO The API returns nothing. Look for an output of CustomGetFileFromURL above"; return 0; } if ($xml eq "

Developer Inactive

") { # Log-Entry if API-Key not valid Log3 $hash, 1, "WWO The API returns, that the Developer is Inactive. Maybe the API-Key is not valid."; return 0; } if (index($xml, "error") != -1) { # check for an error-tag in the returned xml file Log3 $hash, 1, "WWO The API returns an error: $xml"; return 0; } foreach my $llll (split("\/request>",$xml)) { #Debug "WWO: llll=\"$llll\""; foreach my $lll (split("\/current_condition>",$llll)) { #Debug "WWO: lll=\"$lll\""; $fc++; foreach my $ll (split("\/weather>",$lll)) { $fd++; # fc/fd = 1/1 > City/Type # fc/fd = 2/2 > current_condition # fc/fd = 3/3..5 > today, and following days #Debug "WWO: ll=\"$ll\""; foreach my $l (split(/<\/[\w]*>/,$ll)) { # with closing tag #Debug "WWO: all_line fc=\"$fc\" line=\"$l\""; next if($l eq ""); # skip empty lines next if($l =~ m/\/[\w]*>/); # skip closing tag lines next if($l =~ m/\?xml/); # skip xml declaration $l =~ s///; # strip of [[> #$l =~ s//$1/; # strip of [[> #Debug "WWO: clean1 fc=\"$fc\" line=\"$l\""; #Debug "WWO: 1fc=\"$fc\" fd=\"$fd\" line=\"$l\""; $l =~ s/(<[\w]*>)(<[\w]*>)/$2/; # remove first tag in case of two tags in line #Debug "WWO: 2fc=\"$fc\" fd=\"$fd\" line=\"$l\""; #$l =~ s/(\/|\?)?>$//; # strip off /> and > $l =~ s/ and > my ($tag,$value)= split(">", $l, 2); # split tag data=..... at the first blank #Debug "WWO: 3tag=\"$tag\" value=\"$value\""; #$fc= 0 if($tag eq "current_condition"); #$fc++ if($tag eq "weather"); #next if((!defined($value)) || ($value == "")); next if((!defined($value)) || (!defined($tag)) || ($tag eq "") || ($value eq "")); #Debug "WWO: CHECKED tag=\"$tag\" value=\"$value\""; my $prefix = ""; if ($fc == 3) { $prefix= $fd ? "fc" . ($fd-3) ."_" : ""; } else { $prefix= ""; # may be it would be helpfull to set to 'now_' or so } my $key= $tag; #$value=~ s/^data=\"(.*)\"$/$1/; # extract DATA from data="DATA" # if($DEFAULT_ENCODINGS{$lang} eq "latin1") { # $value= latin1_to_utf8($value); # latin1 -> UTF-8 # } #Debug "WWO: prefix=\"$prefix\" tag=\"$tag\" value=\"$value\""; WWO_UpdateReading($hash,$prefix,$key,$value); } } } } return 1; } ################################### sub WWO_GetUpdate($) { my ($hash) = @_; if(!$hash->{LOCAL}) { InternalTimer(gettimeofday()+$hash->{INTERVAL}, "WWO_GetUpdate", $hash, 1); } readingsBeginUpdate($hash); WWO_RetrieveDataDirectly($hash); my $temperature= $hash->{READINGS}{temperature}{VAL}; my $humidity= $hash->{READINGS}{humidity}{VAL}; my $pressure= $hash->{READINGS}{pressure}{VAL}; my $wind= $hash->{READINGS}{wind}{VAL}; my $val= "T: $temperature H: $humidity W: $wind P: $pressure"; #Log GetLogLevel($hash->{NAME},4), "WWO: Log-->". $hash->{NAME} . ": $val"; Log3 $hash, 4, "WWO ". $hash->{NAME} . ": $val"; #Debug "Now i will push the changed notify"; #$hash->{CHANGED}[0]= $val; #push @{$hash->{CHANGED}}, "$val"; #$hash->{STATE}= $val; ##$hash->{STATE} = $val; # List overview ##$hash->{READINGS}{state}{VAL} = $val; ##$hash->{CHANGED}[0] = $val; # For notify ##Log 1, "WWO $val"; ##addEvent($hash, $val); ##readingsEndUpdate($hash, defined($hash->{LOCAL} ? 0 : 1)); # DoTrigger, because sub is called by a timer instead of dispatch readingsBulkUpdate($hash, "state", $val); readingsEndUpdate($hash, defined($hash->{LOCAL} ? 0 : 1)); # DoTrigger, because sub is called by a timer instead of dispatch return 1; } # Perl Special: { $defs{WWO}{READINGS}{condition}{VAL} } # conditions: Mostly Cloudy, Overcast, Clear, Chance of Rain ################################### sub WWO_Get($@) { my ($hash, @a) = @_; return "argument is missing" if(int(@a) != 2); $hash->{LOCAL} = 1; WWO_GetUpdate($hash); delete $hash->{LOCAL}; my $reading= $a[1]; my $value; if(defined($hash->{READINGS}{$reading})) { $value= $hash->{READINGS}{$reading}{VAL}; } else { return "no such reading: $reading"; } return "$a[0] $reading => $value"; } ################################### sub WWO_Set($@) { my ($hash, @a) = @_; my $cmd= $a[1]; # usage check if((@a == 2) && ($a[1] eq "update")) { RemoveInternalTimer($hash); WWO_GetUpdate($hash); return undef; } else { return "Unknown argument $cmd, only update is valid"; } } ##################################### sub WWO_Define($$) { my ($hash, $def) = @_; # define WWO # define MyWWO WWO Berlin,Germany xxxxxxxxxxxxxxxxxxxx 3600 my @a = split("[ \t][ \t]*", $def); #return "syntax: define WWO [interval]" return "syntax: define WWO [interval]" # interval option not acitve #if(int(@a) < 3 && int(@a) > 4); if(int(@a) < 3 && int(@a) > 3); # interval option not acitve $hash->{STATE} = "Initialized"; $hash->{fhem}{interfaces}= "temperature;humidity;wind"; my $name = $a[0]; my $location = $a[2]; my $apikey = $a[3]; my $interval = 3600; my $lang = "en"; # if(int(@a)>=5) { $interval= $a[4]; } my $days = 5; # fixed to 5 days, right values are a number from 0-5 $hash->{LOCATION} = $location; $hash->{INTERVAL} = $interval; $hash->{APIKEY} = $apikey; $hash->{LANG} = $lang; $hash->{DAYS} = $days; $hash->{READINGS}{current_date_time}{TIME}= TimeNow(); $hash->{READINGS}{current_date_time}{VAL}= "none"; $hash->{LOCAL} = 1; WWO_GetUpdate($hash); delete $hash->{LOCAL}; InternalTimer(gettimeofday()+$hash->{INTERVAL}, "WWO_GetUpdate", $hash, 0); return undef; } ##################################### sub WWO_Undef($$) { my ($hash, $arg) = @_; RemoveInternalTimer($hash); return undef; } ###################################### # sub # WWO_Attr(@) # { # my @a = @_; # my $attr= $a[2]; # # if($a[0] eq "set") { # set attribute # if($attr eq "days") { # } # } # elsif($a[0] eq "del") { # delete attribute # if($attr eq "days") { # } # } # # return undef; # # } ##################################### sub WWOIconIMGTag($$$) { use constant WWOURL => "http://www.worldweatheronline.com/images/wsymbols01_png_64/"; use constant SIZE => "50%"; my ($icon,$uselocal,$isday)= @_; my $url; my $style= ""; if($uselocal) { # strip off path and extension $icon =~ s,^/images/wsymbols01_png_64/(.*)\.png$,$1,; if($isday) { $icon= "weather/${icon}" } else { $icon= "weather/${icon}_night" } $url= "fhem/icons/$icon"; $style= " height=".SIZE." width=".SIZE; } else { $url= WWOURL . $icon; } return ""; } ##################################### sub WWOAsHtml($) { my ($d) = @_; $d = "" if(!$d); return "$d is not a WWO instance
" if(!$defs{$d} || $defs{$d}{TYPE} ne "WWO"); my $uselocal= AttrVal($d,"localicons",0); my $isday; if(exists &isday) { $isday = isday(); } else { $isday = 1; #($hour>6 && $hour<19); } my $ret = ""; $ret .= sprintf('', ReadingsVal($d, "query", "")); $ret .= sprintf('', WWOIconIMGTag(ReadingsVal($d, "icon", ""),$uselocal,$isday), ReadingsVal($d, "localObsDateTime", ""),ReadingsVal($d, "weatherDesc", ""), ReadingsVal($d, "temp_C", ""), ReadingsVal($d, "humidity", ""), ReadingsVal($d, "windspeedKmph", ""), ReadingsVal($d, "winddir16Point", ""), ReadingsVal($d, "pressure", ""),ReadingsVal($d, "visibility", "")); for(my $i=0; $i<=4; $i++) { $ret .= sprintf('', WWOIconIMGTag(ReadingsVal($d, "fc${i}_icon", ""),$uselocal,$isday), ReadingsVal($d, "fc${i}_date", ""), ReadingsVal($d, "fc${i}_weatherDesc", ""), ReadingsVal($d, "fc${i}_tempMinC", ""), ReadingsVal($d, "fc${i}_tempMaxC", ""), ReadingsVal($d, "fc${i}_windspeedKmph", ""), ReadingsVal($d, "fc${i}_winddir16Point", ""), ReadingsVal($d, "fc${i}_precipMM", "")); } $ret .= "
%s
%s%s %s
temp: %s °C, hum %s
wind: %s km/h %s
pressure: %s bar visibility: %s km
%s%s: %s
min %s °C max %s °C
wind: %s km/h %s
precip: %s mm
"; $ret .= "
Powered by World Weather Online "; return $ret; } ##################################### sub right{ my ($string,$nr) = @_; return substr $string, -$nr, $nr; } ##################################### sub left{ my ($string,$nr) = @_; return substr $string, 0, $nr; } ##################################### 1; =pod =begin html

WWO


    Define
      define <name> WWO <location> <apikey>

      Defines a virtual device for WWO forecasts.

      A WWO device periodically gathers current and forecast weather conditions from worldweatheronline.com (the free api version)
      You need to signup at http://developer.worldweatheronline.com to get an apikey)

      The parameter location is the WOEID (WHERE-ON-EARTH-ID), go to http://www.worldweatheronline.com to find it out for your valid location.

      The natural language in which the forecast information appears is english.

      The interval is set to update the values every hour.

      Examples:
            define MyWeather WWO Berlin,Germany
           
      The module provides one additional function WWOAsHtml. The function return the HTML code for a vertically arranged weather forecast.

      Example:
            define MyWeatherWeblink weblink htmlCode { WWOAsHtml("MyWeather") }
          

    Set
      set <name> update

      Forces the retrieval of the weather data. The next automatic retrieval is scheduled to occur interval seconds later.


    Get
      get <name> <reading>

      Valid readings and their meaning (? can be one of 0, 1, 2, 3, 4, 5 and stands for today, tomorrow, etc. - with 'fc?_' or without! - without is meaning 'current condition'):
      cloudcovercloudcover in percent
      current_date_timelast update of forecast on server
      fc?_datedate of the forecast condition - not valid without 'fc?'
      fc?_iconname of the forecasticon
      fc?_precipMMpreciption for day
      fc?_tempMaxCforecasted daily high in degrees centigrade
      fc?_tempMaxFforecasted daily high in degrees fahrenheit
      fc?_tempMinCforecasted daily low in degrees centigrade
      fc?_tempMinFforecasted daily low in degrees fahrenheit
      fc?_weatherCodeweathercode
      fc?_weatherDescshort weather desciption
      fc?_weatherIconUrlfull url to the weathericonfile
      fc?_winddir16Pointwinddirection with 16 points
      fc?_winddirDegreewindirection in degrees
      fc?_winddirectionwinddirection
      fc?_windspeedKmphwindspeed in km/h
      fc?_windspeedMileswindspeed in miles/h
      humiditycurrent humidity in %
      localObsDateTimelocal time of observation
      observation_timetime of observation
      pressureair pressure in hPa
      queryreturns the queried location
      temperaturecurrent temperature in degrees centigrade
      visibilitycurrent visibilit in km

    Attributes
=end html =cut