#################################################################################################### # # 77_UWZ.pm # # (c) 2015 Tobias D. Oestreicher # # Special thanks goes to comitters: # - Marko Oldenburg (leongaultier at gmail dot com) # # Storm warnings from unwetterzentrale.de # inspired by 59_PROPLANTA.pm # # Copyright notice # # This script 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. # # The GNU General Public License can be found at # http://www.gnu.org/copyleft/gpl.html. # A copy is found in the text file GPL.txt and important notices to the license # from the author is found in LICENSE.txt distributed with these scripts. # # This script 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. # # This copyright notice MUST APPEAR in all copies of the script! # # # # $Id$ # #################################################################################################### # also a thanks goes to hexenmeister ############################################## package main; use strict; use feature qw/say switch/; use warnings; no if $] >= 5.017011, warnings => 'experimental::lexical_subs','experimental::smartmatch'; my $missingModul; eval "use LWP::UserAgent;1" or $missingModul .= "LWP::UserAgent "; eval "use LWP::Simple;1" or $missingModul .= "LWP::Simple "; eval "use HTTP::Request;1" or $missingModul .= "HTTP::Request "; eval "use HTML::Parser;1" or $missingModul .= "HTML::Parser "; eval "use JSON;1" or $missingModul .= "JSON "; eval "use Encode::Guess;1" or $missingModul .= "Encode::Guess "; eval "use Text::Iconv;1" or $missingModul .= "Text::Iconv "; require 'Blocking.pm'; require 'HttpUtils.pm'; use vars qw($readingFnAttributes); use vars qw(%defs); my $MODUL = "UWZ"; my $version = "1.4.6"; my $countrycode = "DE"; my $plz = "77777"; my $uwz_alert_url = "http://feed.alertspro.meteogroup.com/AlertsPro/AlertsProPollService.php?method=getWarning&language=de&areaID=UWZ" . $countrycode . $plz; ######################################## sub UWZ_Log($$$) { my ( $hash, $loglevel, $text ) = @_; my $xline = ( caller(0) )[2]; my $xsubroutine = ( caller(1) )[3]; my $sub = ( split( ':', $xsubroutine ) )[2]; $sub =~ s/UWZ_//; my $instName = ( ref($hash) eq "HASH" ) ? $hash->{NAME} : $hash; Log3 $instName, $loglevel, "$MODUL $instName: $sub.$xline " . $text; } ######################################## sub UWZ_Map2Movie($$) { my $uwz_movie_url = "http://www.meteocentrale.ch/uploads/media/"; my ( $hash, $smap ) = @_; my $lmap; $smap=lc($smap); ## Euro $lmap->{'niederschlag-wolken'}=$uwz_movie_url.'UWZ_EUROPE_COMPLETE_niwofi.mp4'; $lmap->{'stroemung'}=$uwz_movie_url.'UWZ_EUROPE_COMPLETE_stfi.mp4'; $lmap->{'temperatur'}=$uwz_movie_url.'UWZ_EUROPE_COMPLETE_theta_E.mp4'; ## DE $lmap->{'niederschlag-wolken-de'}=$uwz_movie_url.'UWZ_EUROPE_GERMANY_COMPLETE_niwofi.mp4'; $lmap->{'stroemung-de'}=$uwz_movie_url.'UWZ_EUROPE_GERMANY_COMPLETE_stfi.mp4'; ## CH $lmap->{'niederschlag-wolken-ch'}=$uwz_movie_url.'UWZ_EUROPE_SWITZERLAND_COMPLETE_niwofi.mp4'; $lmap->{'stroemung-ch'}=$uwz_movie_url.'UWZ_EUROPE_SWITZERLAND_COMPLETE_stfi.mp4'; ## AT $lmap->{'niederschlag-wolken-at'}=$uwz_movie_url.'UWZ_EUROPE_AUSTRIA_COMPLETE_niwofi.mp4'; $lmap->{'stroemung-at'}=$uwz_movie_url.'UWZ_EUROPE_AUSTRIA_COMPLETE_stfi.mp4'; ## UK $lmap->{'clouds-precipitation-uk'}=$uwz_movie_url.'UWZ_EUROPE_GREATBRITAIN_COMPLETE_niwofi.mp4'; $lmap->{'currents-uk'}=$uwz_movie_url.'UWZ_EUROPE_GREATBRITAIN_COMPLETE_stfi.mp4'; return $lmap->{$smap}; } ######################################## sub UWZ_Map2Image($$) { my $uwz_de_url = "http://www.unwetterzentrale.de/images/map/"; my $uwz_at_url = "http://unwetter.wetteralarm.at/images/map/"; my $uwz_ch_url = "http://alarm.meteocentrale.ch/images/map/"; my $uwz_en_url = "http://warnings.severe-weather-centre.co.uk/images/map/"; my $uwz_li_url = "http://alarm.meteocentrale.li/images/map/"; my $uwz_be_url = "http://alarm.meteo-info.be/images/map/"; my $uwz_dk_url = "http://alarm.vejrcentral.dk/images/map/"; my $uwz_fi_url = "http://vaaratasot.saa-varoitukset.fi/images/map/"; my $uwz_fr_url = "http://alerte.vigilance-meteo.fr/images/map/"; my $uwz_lu_url = "http://alarm.meteozentral.lu/images/map/"; my $uwz_nl_url = "http://alarm.noodweercentrale.nl/images/map/"; my $uwz_no_url = "http://advarsler.vaer-sentral.no/images/map/"; my $uwz_pt_url = "http://avisos.centrometeo.pt/images/map/"; my $uwz_se_url = "http://varningar.vader-alarm.se/images/map/"; my $uwz_es_url = "http://avisos.alertas-tiempo.es/images/map/"; my ( $hash, $smap ) = @_; my $lmap; $smap=lc($smap); ## Euro $lmap->{'europa'}=$uwz_de_url.'europe_index.png'; ## DE $lmap->{'deutschland'}=$uwz_de_url.'deutschland_index.png'; $lmap->{'deutschland-small'}=$uwz_de_url.'deutschland_preview.png'; $lmap->{'niedersachsen'}=$uwz_de_url.'niedersachsen_index.png'; $lmap->{'bremen'}=$uwz_de_url.'niedersachsen_index.png'; $lmap->{'bayern'}=$uwz_de_url.'bayern_index.png'; $lmap->{'schleswig-holstein'}=$uwz_de_url.'schleswig_index.png'; $lmap->{'hamburg'}=$uwz_de_url.'schleswig_index.png'; $lmap->{'mecklenburg-vorpommern'}=$uwz_de_url.'meckpom_index.png'; $lmap->{'sachsen'}=$uwz_de_url.'sachsen_index.png'; $lmap->{'sachsen-anhalt'}=$uwz_de_url.'sachsenanhalt_index.png'; $lmap->{'nordrhein-westfalen'}=$uwz_de_url.'nrw_index.png'; $lmap->{'thueringen'}=$uwz_de_url.'thueringen_index.png'; $lmap->{'rheinland-pfalz'}=$uwz_de_url.'rlp_index.png'; $lmap->{'saarland'}=$uwz_de_url.'rlp_index.png'; $lmap->{'baden-wuerttemberg'}=$uwz_de_url.'badenwuerttemberg_index.png'; $lmap->{'hessen'}=$uwz_de_url.'hessen_index.png'; $lmap->{'brandenburg'}=$uwz_de_url.'brandenburg_index.png'; $lmap->{'berlin'}=$uwz_de_url.'brandenburg_index.png'; ## AT $lmap->{'oesterreich'}=$uwz_at_url.'oesterreich_index.png'; $lmap->{'burgenland'}=$uwz_at_url.'burgenland_index.png'; $lmap->{'kaernten'}=$uwz_at_url.'kaernten_index.png'; $lmap->{'niederoesterreich'}=$uwz_at_url.'niederoesterreich_index.png'; $lmap->{'oberoesterreich'}=$uwz_at_url.'oberoesterreich_index.png'; $lmap->{'salzburg'}=$uwz_at_url.'salzburg_index.png'; $lmap->{'steiermark'}=$uwz_at_url.'steiermark_index.png'; $lmap->{'tirol'}=$uwz_at_url.'tirol_index.png'; $lmap->{'vorarlberg'}=$uwz_at_url.'vorarlberg_index.png'; $lmap->{'wien'}=$uwz_at_url.'wien_index.png'; ## CH $lmap->{'schweiz'}=$uwz_ch_url.'schweiz_index.png'; $lmap->{'aargau'}=$uwz_ch_url.'aargau_index.png'; $lmap->{'appenzell_ausserrhoden'}=$uwz_ch_url.'appenzell_ausserrhoden_index.png'; $lmap->{'appenzell_innerrhoden'}=$uwz_ch_url.'appenzell_innerrhoden_index.png'; $lmap->{'basel_landschaft'}=$uwz_ch_url.'basel_landschaft_index.png'; $lmap->{'basel_stadt'}=$uwz_ch_url.'basel_stadt_index.png'; $lmap->{'bern'}=$uwz_ch_url.'bern_index.png'; $lmap->{'fribourg'}=$uwz_ch_url.'fribourg_index.png'; $lmap->{'geneve'}=$uwz_ch_url.'geneve_index.png'; $lmap->{'glarus'}=$uwz_ch_url.'glarus_index.png'; $lmap->{'graubuenden'}=$uwz_ch_url.'graubuenden_index.png'; $lmap->{'jura'}=$uwz_ch_url.'jura_index.png'; $lmap->{'luzern'}=$uwz_ch_url.'luzern_index.png'; $lmap->{'neuchatel'}=$uwz_ch_url.'neuchatel_index.png'; $lmap->{'nidwalden'}=$uwz_ch_url.'nidwalden_index.png'; $lmap->{'obwalden'}=$uwz_ch_url.'obwalden_index.png'; $lmap->{'schaffhausen'}=$uwz_ch_url.'schaffhausen_index.png'; $lmap->{'schwyz'}=$uwz_ch_url.'schwyz_index.png'; $lmap->{'solothurn'}=$uwz_ch_url.'solothurn_index.png'; $lmap->{'stgallen'}=$uwz_ch_url.'stgallen_index.png'; $lmap->{'ticino'}=$uwz_ch_url.'ticino_index.png'; $lmap->{'thurgau'}=$uwz_ch_url.'thurgau_index.png'; $lmap->{'uri'}=$uwz_ch_url.'uri_index.png'; $lmap->{'waadt'}=$uwz_ch_url.'waadt_index.png'; $lmap->{'wallis'}=$uwz_ch_url.'wallis_index.png'; $lmap->{'zug'}=$uwz_ch_url.'zug_index.png'; $lmap->{'zuerich'}=$uwz_ch_url.'zuerich_index.png'; ## LI $lmap->{'liechtenstein'}=$uwz_li_url.'liechtenstein_index.png'; ## UK $lmap->{'unitedkingdom'}=$uwz_en_url.'unitedkingdom_index.png'; $lmap->{'eastofengland'}=$uwz_en_url.'eastofengland_index.png'; $lmap->{'eastmidlands'}=$uwz_en_url.'eastmidlands-index.png'; $lmap->{'london'}=$uwz_en_url.'london-index.png'; $lmap->{'northeastengland'}=$uwz_en_url.'northeastengland-index.png'; $lmap->{'northernireland'}=$uwz_en_url.'northernireland-index.png'; $lmap->{'northwestengland'}=$uwz_en_url.'northwestengland-index.png'; $lmap->{'scotland'}=$uwz_en_url.'scotland-index.png'; $lmap->{'southeastengland'}=$uwz_en_url.'southeastengland-index.png'; $lmap->{'southwestengland'}=$uwz_en_url.'southwestengland-index.png'; $lmap->{'wales'}=$uwz_en_url.'wales-index.png'; $lmap->{'westmidlands'}=$uwz_en_url.'westmidlands-index.png'; $lmap->{'yorkshireandthehumber'}=$uwz_en_url.'yorkshireandthehumber-index.png'; ## BE $lmap->{'belgique'}=$uwz_be_url.'belgique_index.png'; ## DK $lmap->{'denmark'}=$uwz_dk_url.'denmark_index.png'; ## FI $lmap->{'finnland'}=$uwz_fi_url.'finnland_index.png'; ## FR $lmap->{'france'}=$uwz_fr_url.'france_index.png'; ## LU $lmap->{'letzebuerg'}=$uwz_lu_url.'letzebuerg_index.png'; ## NL $lmap->{'nederland'}=$uwz_nl_url.'nederland_index.png'; ## NO $lmap->{'norwegen'}=$uwz_no_url.'norwegen_index.png'; ## PT $lmap->{'portugal'}=$uwz_pt_url.'portugal_index.png'; ## SE $lmap->{'sverige'}=$uwz_se_url.'sverige_index.png'; ## ES $lmap->{'espana'}=$uwz_es_url.'espana_index.png'; ## Isobaren $lmap->{'isobaren1'}="http://www.unwetterzentrale.de/images/icons/UWZ_ISO_00.jpg"; $lmap->{'isobaren2'}="http://www.wetteralarm.at/uploads/pics/UWZ_EURO_ISO_GER_00.jpg"; $lmap->{'isobaren3'}="http://www.severe-weather-centre.co.uk/uploads/pics/UWZ_EURO_ISO_ENG_00.jpg"; return $lmap->{$smap}; } ################################### sub UWZ_Initialize($) { my ($hash) = @_; $hash->{DefFn} = "UWZ_Define"; $hash->{UndefFn} = "UWZ_Undef"; $hash->{SetFn} = "UWZ_Set"; $hash->{GetFn} = "UWZ_Get"; $hash->{AttrList} = "download:0,1 ". "savepath ". "maps ". "humanreadable:0,1 ". "htmlattr ". "htmlsequence:ascending,descending ". "lang ". "sort_readings_by:severity,start ". "localiconbase ". $readingFnAttributes; foreach my $d(sort keys %{$modules{UWZ}{defptr}}) { my $hash = $modules{UWZ}{defptr}{$d}; $hash->{VERSION} = $version; } } ################################### sub UWZ_Define($$) { my ( $hash, $def ) = @_; my $name = $hash->{NAME}; my $lang = ""; my @a = split( "[ \t][ \t]*", $def ); return "Error: Perl moduls ".$missingModul."are missing on this system" if( $missingModul ); return "Wrong syntax: use define UWZ [CountryCode] [PLZ] [Interval] " if (int(@a) != 5 and ((lc $a[2]) ne "search")); if ((lc $a[2]) ne "search") { $hash->{STATE} = "Initializing"; $hash->{CountryCode} = $a[2]; $hash->{PLZ} = $a[3]; ## URL by CountryCode my $URL_language="en"; if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $URL_language="de"; } $hash->{URL} = "http://feed.alertspro.meteogroup.com/AlertsPro/AlertsProPollService.php?method=getWarning&language=" . $URL_language . "&areaID=UWZ" . $a[2] . $a[3]; $hash->{fhem}{LOCAL} = 0; $hash->{INTERVAL} = $a[4]; $hash->{VERSION} = $version; RemoveInternalTimer($hash); #Get first data after 12 seconds InternalTimer( gettimeofday() + 12, "UWZ_Start", $hash, 0 ) if ((lc $hash->{CountryCode}) ne "search"); } else { $hash->{STATE} = "Search-Mode"; $hash->{CountryCode} = uc $a[2]; $hash->{VERSION} = $version; } return undef; } ##################################### sub UWZ_Undef($$) { my ( $hash, $arg ) = @_; RemoveInternalTimer( $hash ); BlockingKill( $hash->{helper}{RUNNING_PID} ) if ( defined( $hash->{helper}{RUNNING_PID} ) ); return undef; } ##################################### sub UWZ_Set($@) { my ( $hash, @a ) = @_; my $name = $hash->{NAME}; my $reUINT = '^([\\+]?\\d+)$'; my $usage = "Unknown argument $a[1], choose one of update:noArg " if ( (lc $hash->{CountryCode}) ne "search" ); return $usage if ( @a < 2 ); my $cmd = lc( $a[1] ); given ($cmd) { when ("?") { return $usage; } when ("update") { UWZ_Log $hash, 4, "set command: " . $a[1]; $hash->{fhem}{LOCAL} = 1; UWZ_Start($hash); $hash->{fhem}{LOCAL} = 0; } default { return $usage; } } return; } sub UWZ_Get($@) { my ( $hash, @a ) = @_; my $name = $hash->{NAME}; if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { my $usage = "Unknown argument $a[1], choose one of Sturm:noArg Schneefall:noArg Regen:noArg Extremfrost:noArg Waldbrand:noArg Gewitter:noArg Glaette:noArg Hitze:noArg Glatteisregen:noArg Bodenfrost:noArg Hagel:noArg "; return $usage if ( @a < 2 ); if ($a[1] =~ /^Sturm/) { UWZ_GetCurrent($hash,2); } elsif ($a[1] =~ /^Schneefall/) { UWZ_GetCurrent($hash,3); } elsif ($a[1] =~ /^Regen/) { UWZ_GetCurrent($hash,4); } elsif ($a[1] =~ /^Extremfrost/) { UWZ_GetCurrent($hash,5); } elsif ($a[1] =~ /^Waldbrand/) { UWZ_GetCurrent($hash,6); } elsif ($a[1] =~ /^Gewitter/) { UWZ_GetCurrent($hash,7); } elsif ($a[1] =~ /^Glaette/) { UWZ_GetCurrent($hash,8); } elsif ($a[1] =~ /^Hitze/) { UWZ_GetCurrent($hash,9); } elsif ($a[1] =~ /^Glatteisregen/) { UWZ_GetCurrent($hash,10); } elsif ($a[1] =~ /^Bodenfrost/) { UWZ_GetCurrent($hash,11); } elsif ($a[1] =~ /^Hagel/) { UWZ_GetCurrentHail($hash); } else { return $usage; } } elsif ( (lc $hash->{CountryCode}) eq 'search' ) { my $usage = "Unknown argument $a[1], choose one of SearchAreaID "; return $usage if ( @a < 3 ); if ($a[1] =~ /^SearchAreaID/) { UWZSearchLatLon($name, $a[2]); } elsif ($a[1] =~ /^AreaID/) { my @splitparam = split(/,/,$a[2]); UWZSearchAreaID($splitparam[0],$splitparam[1]); } else { return $usage; } } else { my $usage = "Unknown argument $a[1], choose one of storm:noArg snow:noArg rain:noArg extremfrost:noArg forest-fire:noArg thunderstorms:noArg glaze:noArg heat:noArg glazed-rain:noArg soil-frost:noArg hail:noArg "; return $usage if ( @a < 2 ); if ($a[1] =~ /^storm/) { UWZ_GetCurrent($hash,2); } elsif ($a[1] =~ /^snow/) { UWZ_GetCurrent($hash,3); } elsif ($a[1] =~ /^rain/) { UWZ_GetCurrent($hash,4); } elsif ($a[1] =~ /^extremfrost/) { UWZ_GetCurrent($hash,5); } elsif ($a[1] =~ /^forest-fire/) { UWZ_GetCurrent($hash,6); } elsif ($a[1] =~ /^thunderstorms/) { UWZ_GetCurrent($hash,7); } elsif ($a[1] =~ /^glaze/) { UWZ_GetCurrent($hash,8); } elsif ($a[1] =~ /^heat/) { UWZ_GetCurrent($hash,9); } elsif ($a[1] =~ /^glazed-rain/) { UWZ_GetCurrent($hash,10); } elsif ($a[1] =~ /^soil-frost/) { UWZ_GetCurrent($hash,11); } elsif ($a[1] =~ /^hail/) { UWZ_GetCurrentHail($hash); } else { return $usage; } } } ##################################### sub UWZ_GetCurrent($@) { my ( $hash, @a ) = @_; my $name = $hash->{NAME}; my $out; my $curTimestamp = time(); if ( ReadingsVal($name,"WarnCount", 0) eq 0 ) { $out = "inactive"; } else { for(my $i= 0;$i < ReadingsVal($name,"WarnCount", 0);$i++) { if ( (ReadingsVal($name,"Warn_".$i."_Start","") le $curTimestamp) && (ReadingsVal($name,"Warn_".$i."_End","") ge $curTimestamp) && (ReadingsVal($name,"Warn_".$i."_Type","") eq $a[0]) ) { $out= "active"; last; } else { $out = "inactive"; } } } return $out; } ##################################### sub UWZ_GetCurrentHail($) { my ( $hash ) = @_; my $name = $hash->{NAME}; my $out; my $curTimestamp = time(); if ( ReadingsVal($name,"WarnCount", 0) eq 0 ) { $out = "inactive"; } else { for(my $i= 0;$i < ReadingsVal($name,"WarnCount", 0);$i++) { if ( (ReadingsVal($name,"Warn_".$i."_Start","") le $curTimestamp) && (ReadingsVal($name,"Warn_".$i."_End","") ge $curTimestamp) && (ReadingsVal($name,"Warn_".$i."_Hail","") eq 1) ) { $out= "active"; last; } else { $out= "inactive"; } } } return $out; } ##################################### sub UWZ_JSONAcquire($$) { my ($hash, $URL) = @_; my $name = $hash->{NAME}; return unless (defined($hash->{NAME})); UWZ_Log $hash, 4, "Start capturing of $URL"; my $err_log = ""; my $agent = LWP::UserAgent->new( env_proxy => 1, keep_alive => 1, protocols_allowed => ['http'], timeout => 10 ); my $request = HTTP::Request->new( GET => $URL ); my $response = $agent->request($request); $err_log = "Can't get $URL -- " . $response->status_line unless( $response->is_success ); if ( $err_log ne "" ) { readingsSingleUpdate($hash, "lastConnection", $response->status_line, 1); UWZ_Log $hash, 1, "Error: $err_log"; return "Error|Error " . $response->status_line; } UWZ_Log $hash, 4, length($response->content)." characters captured"; return $response->content; } ##################################### sub UWZ_Start($) { my ($hash) = @_; my $name = $hash->{NAME}; return unless (defined($hash->{NAME})); if(!$hash->{fhem}{LOCAL} && $hash->{INTERVAL} > 0) { # set up timer if automatically call RemoveInternalTimer( $hash ); InternalTimer(gettimeofday() + $hash->{INTERVAL}, "UWZ_Start", $hash, 1 ); return undef if( AttrVal($name, "disable", 0 ) == 1 ); } ## URL by CountryCode my $URL_language="en"; if (AttrVal($hash->{NAME}, "lang", undef) ) { $URL_language=AttrVal($hash->{NAME}, "lang", ""); } else { if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $URL_language="de"; } } $hash->{URL} = "http://feed.alertspro.meteogroup.com/AlertsPro/AlertsProPollService.php?method=getWarning&language=" . $URL_language . "&areaID=UWZ" . $hash->{CountryCode} . $hash->{PLZ}; if ( not defined( $hash->{URL} ) ) { UWZ_Log $hash, 3, "missing URL"; return; } $hash->{helper}{RUNNING_PID} = BlockingCall( "UWZ_Run", # callback worker task $name, # name of the device "UWZ_Done", # callback result method 120, # timeout seconds "UWZ_Aborted", # callback for abortion $hash ); # parameter for abortion } ##################################### sub UWZ_Aborted($) { my ($hash) = @_; delete( $hash->{helper}{RUNNING_PID} ); } ##################################### # asyncronous callback by blocking sub UWZ_Done($) { my ($string) = @_; return unless ( defined($string) ); # all term are separated by "|" , the first is the name of the instance my ( $name, %values ) = split( "\\|", $string ); my $hash = $defs{$name}; return unless ( defined($hash->{NAME}) ); # delete the marker for RUNNING_PID process delete( $hash->{helper}{RUNNING_PID} ); UWZ_Log $hash, 4, "Delete old Readings"; #CommandDeleteReading(undef, "$hash->{NAME} Warn_?_.*"); # UnWetterdaten speichern readingsBeginUpdate($hash); if ( defined $values{Error} ) { readingsBulkUpdate( $hash, "lastConnection", $values{Error} ); } else { while (my ($rName, $rValue) = each(%values) ) { readingsBulkUpdate( $hash, $rName, $rValue ); UWZ_Log $hash, 5, "reading:$rName value:$rValue"; } if (keys %values > 0) { my $newState; for my $Counter ($values{WarnCount} .. 9) { CommandDeleteReading(undef, "$hash->{NAME} Warn_${Counter}_.*"); } if (defined $values{WarnCount}) { # Message by CountryCode $newState = "Warnings: " . $values{WarnCount}; $newState = "Warnungen: " . $values{WarnCount} if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ); # end Message by CountryCode } else { $newState = "Error: Could not capture all data. Please check CountryCode and PLZ."; } readingsBulkUpdate($hash, "state", $newState); readingsBulkUpdate( $hash, "lastConnection", keys( %values )." values captured in ".$values{durationFetchReadings}." s" ); UWZ_Log $hash, 4, keys( %values )." values captured"; } else { readingsBulkUpdate( $hash, "lastConnection", "no data found" ); UWZ_Log $hash, 1, "No data found. Check city name or URL."; } } readingsEndUpdate( $hash, 1 ); } ##################################### sub UWZ_Run($) { my ($name) = @_; my $ptext=$name; my $UWZ_download; my $UWZ_savepath; my $UWZ_humanreadable; return unless ( defined($name) ); my $hash = $defs{$name}; return unless (defined($hash->{NAME})); my $readingStartTime = time(); my $attrdownload = AttrVal( $name, 'download',''); my $attrsavepath = AttrVal( $name, 'savepath',''); my $maps2fetch = AttrVal( $name, 'maps',''); ## begin redundant Reading switch my $attrhumanreadable = AttrVal( $name, 'humanreadable',''); ## end redundant Reading switch # preset download if ($attrdownload eq "") { $UWZ_download = 0; } else { $UWZ_download = $attrdownload; } # preset savepath if ($attrsavepath eq "") { $UWZ_savepath = "/tmp/"; } else { $UWZ_savepath = $attrsavepath; } # preset humanreadable if ($attrhumanreadable eq "") { $UWZ_humanreadable = 0; } else { $UWZ_humanreadable = $attrhumanreadable; } if ( $UWZ_download == 1 ) { if ( ! defined($maps2fetch) ) { $maps2fetch = "deutschland"; } UWZ_Log $hash, 4, "Maps2Fetch : ".$maps2fetch; my @maps = split(' ', $maps2fetch); my $uwz_de_url = "http://www.unwetterzentrale.de/images/map/"; foreach my $smap (@maps) { UWZ_Log $hash, 4, "Download map : ".$smap; my $img = UWZ_Map2Image($hash,$smap); if (!defined($img) ) { $img=$uwz_de_url.'deutschland_index.png'; } my $code = getstore($img, $UWZ_savepath.$smap.".png"); if($code == 200) { UWZ_Log $hash, 4, "Successfully downloaded map ".$smap; } else { UWZ_Log $hash, 3, "Failed to download map (".$img.")"; } } } # acquire the json-response my $response = UWZ_JSONAcquire($hash,$hash->{URL}); UWZ_Log $hash, 5, length($response)." characters captured"; my $converter = Text::Iconv->new("windows-1252","UTF-8"); my $uwz_warnings = JSON->new->ascii->decode($response); my $enc = guess_encoding($uwz_warnings); my $uwz_warncount = scalar(@{ $uwz_warnings->{'results'} }); UWZ_Log $hash, 4, "There are ".$uwz_warncount." warnings active"; my $sortby = AttrVal( $name, 'sort_readings_by',"" ); my @sorted; if ( $sortby ne "severity" ) { UWZ_Log $hash, 4, "Sorting by dtgStart"; @sorted = sort { $a->{dtgStart} <=> $b->{dtgStart} } @{ $uwz_warnings->{'results'} }; } else { UWZ_Log $hash, 4, "Sorting by severity"; @sorted = sort { $a->{severity} <=> $b->{severity} } @{ $uwz_warnings->{'results'} }; } my $message; my $i=0; my %typenames = ( "1" => "unknown", # <===== FIX HERE "2" => "sturm", "3" => "schnee", "4" => "regen", "5" => "temperatur", "6" => "waldbrand", "7" => "gewitter", "8" => "strassenglaette", "9" => "temperatur", # 9 = hitzewarnung "10" => "glatteisregen", "11" => "temperatur" ); # 11 = bodenfrost my %typenames_de_str= ( "1" => "unknown", # <===== FIX HERE "2" => "Sturm", "3" => "Schnee", "4" => "Regen", "5" => "Temperatur", "6" => "Waldbrand", "7" => "Gewitter", "8" => "Strassenglaette", "9" => "Hitze", # 9 = hitzewarnung "10" => "Glatteisregen", "11" => "Bodenfrost" ); # 11 = bodenfrost my %typenames_en_str= ( "1" => "unknown", # <===== FIX HERE "2" => "storm", "3" => "snow", "4" => "rain", "5" => "temperatur", "6" => "forest fire", "7" => "thunderstorms", "8" => "slippery road", "9" => "heat", # 9 = hitzewarnung "10" => "black ice rain", "11" => "soil frost" ); # 11 = bodenfrost my %severitycolor = ( "0" => "green", "1" => "unknown", # <===== FIX HERE "2" => "unknown", # <===== FIX HERE "3" => "unknown", # <===== FIX HERE "4" => "orange", "5" => "unknown", # <===== FIX HERE "6" => "unknown", # <===== FIX HERE "7" => "orange", "8" => "gelb", "9" => "gelb", # <===== FIX HERE "10" => "orange", "11" => "rot", "12" => "violett" ); my @uwzmaxlevel; #foreach my $single_warning (@{ $uwz_warnings->{'results'} }) { foreach my $single_warning (@sorted) { push @uwzmaxlevel, UWZ_GetUWZLevel($hash,$single_warning->{'payload'}{'levelName'}); UWZ_Log $hash, 4, "Warn_".$i."_EventID: ".$single_warning->{'payload'}{'id'}; $message .= "Warn_".$i."_EventID|".$single_warning->{'payload'}{'id'}."|"; my $chopcreation = substr($single_warning->{'payload'}{'creation'},0,10); $chopcreation = $chopcreation; UWZ_Log $hash, 4, "Warn_".$i."_Creation: ".$chopcreation; $message .= "Warn_".$i."_Creation|".$chopcreation."|"; UWZ_Log $hash, 4, "Warn_".$i."_Type: ".$single_warning->{'type'}; $message .= "Warn_".$i."_Type|".$single_warning->{'type'}."|"; UWZ_Log $hash, 4, "Warn_".$i."_uwzLevel: ".UWZ_GetUWZLevel($hash,$single_warning->{'payload'}{'levelName'}); $message .= "Warn_".$i."_uwzLevel|".UWZ_GetUWZLevel($hash,$single_warning->{'payload'}{'levelName'})."|"; UWZ_Log $hash, 4, "Warn_".$i."_Severity: ".$single_warning->{'severity'}; $message .= "Warn_".$i."_Severity|".$single_warning->{'severity'}."|"; UWZ_Log $hash, 4, "Warn_".$i."_Start: ".$single_warning->{'dtgStart'}; $message .= "Warn_".$i."_Start|".$single_warning->{'dtgStart'}."|"; UWZ_Log $hash, 4, "Warn_".$i."_End: ".$single_warning->{'dtgEnd'}; $message .= "Warn_".$i."_End|".$single_warning->{'dtgEnd'}."|"; ## Begin of redundant Reading if ( $UWZ_humanreadable eq 1 ) { UWZ_Log $hash, 4, "Warn_".$i."_Start_Date: ".strftime("%d.%m.%Y", localtime($single_warning->{'dtgStart'})); $message .= "Warn_".$i."_Start_Date|".strftime("%d.%m.%Y", localtime($single_warning->{'dtgStart'}))."|"; UWZ_Log $hash, 4, "Warn_".$i."_Start_Time: ".strftime("%H:%M", localtime($single_warning->{'dtgStart'})); $message .= "Warn_".$i."_Start_Time|".strftime("%H:%M", localtime($single_warning->{'dtgStart'}))."|"; UWZ_Log $hash, 4, "Warn_".$i."_End_Date: ".strftime("%d.%m.%Y", localtime($single_warning->{'dtgEnd'})); $message .= "Warn_".$i."_End_Date|".strftime("%d.%m.%Y", localtime($single_warning->{'dtgEnd'}))."|"; UWZ_Log $hash, 4, "Warn_".$i."_End_Time: ".strftime("%H:%M", localtime($single_warning->{'dtgEnd'})); $message .= "Warn_".$i."_End_Time|".strftime("%H:%M", localtime($single_warning->{'dtgEnd'}))."|"; UWZ_Log $hash, 4, "Warn_".$i."_Creation_Date: ".strftime("%d.%m.%Y", localtime($chopcreation)); $message .= "Warn_".$i."_Creation_Date|".strftime("%d.%m.%Y", localtime($chopcreation))."|"; UWZ_Log $hash, 4, "Warn_".$i."_Creation_Time: ".strftime("%H:%M", localtime($chopcreation)); $message .= "Warn_".$i."_Creation_Time|".strftime("%H:%M", localtime($chopcreation))."|"; # Begin Language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { UWZ_Log $hash, 4, "Warn_".$i."_Type_Str: ".$typenames_de_str{ $single_warning->{'type'} }; $message .= "Warn_".$i."_Type_Str|".$typenames_de_str{ $single_warning->{'type'} }."|"; my %uwzlevelname = ( "0" => "Stufe Grün (keine Warnung)", "1" => "Stufe Dunkelgrün (Wetterhinweise)", "2" => "Stufe Gelb (Vorwarnung für Unwetterwarnung)", "3" => "Warnstufe Orange (Unwetterwarnung)", "4" => "Warnstufe Rot (Unwetterwarnung)", "5" => "Warnstufe Violett (Unwetterwarnung)"); UWZ_Log $hash, 4, "Warn_".$i."_uwzLevel_Str: ".$uwzlevelname{ UWZ_GetUWZLevel($hash,$single_warning->{'payload'}{'levelName'}) }; $message .= "Warn_".$i."_uwzLevel_Str|".$uwzlevelname{ UWZ_GetUWZLevel($hash,$single_warning->{'payload'}{'levelName'}) }."|"; } else { UWZ_Log $hash, 4, "Warn_".$i."_Type_Str: ".$typenames_en_str{ $single_warning->{'type'} }; $message .= "Warn_".$i."_Type_Str|".$typenames_en_str{ $single_warning->{'type'} }."|"; my %uwzlevelname = ( "0" => "level green (no warnings)", "1" => "level dark green (weather notice)", "2" => "level yellow (severe weather watch)", "3" => "Alert level Orange", "4" => "Alert level Red", "5" => "Alert level Violet"); UWZ_Log $hash, 4, "Warn_".$i."_uwzLevel_Str: ".$uwzlevelname{ UWZ_GetUWZLevel($hash,$single_warning->{'payload'}{'levelName'}) }; $message .= "Warn_".$i."_uwzLevel_Str|".$uwzlevelname{ UWZ_GetUWZLevel($hash,$single_warning->{'payload'}{'levelName'}) }."|"; } } ## End of redundant Reading UWZ_Log $hash, 4, "Warn_".$i."_levelName: ".$single_warning->{'payload'}{'levelName'}; $message .= "Warn_".$i."_levelName|".$single_warning->{'payload'}{'levelName'}."|"; UWZ_Log $hash, 4, "Warn_".$i."_AltitudeMin: ".$enc->decode($single_warning->{'payload'}{'altMin'}); $message .= "Warn_".$i."_AltitudeMin|".$converter->convert($single_warning->{'payload'}{'altMin'})."|"; UWZ_Log $hash, 4, "Warn_".$i."_AltitudeMax: ".$enc->decode($single_warning->{'payload'}{'altMax'}); $message .= "Warn_".$i."_AltitudeMax|".$converter->convert($single_warning->{'payload'}{'altMax'})."|"; my $uclang = "EN"; if (AttrVal( $name, 'lang',undef) ) { $uclang = uc AttrVal( $name, 'lang',''); } else { # Begin Language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $uclang = "DE"; } else { $uclang = "EN"; } } UWZ_Log $hash, 4, "Warn_".$i."_LongText: ".$enc->decode($single_warning->{'payload'}{'translationsLongText'}{$uclang}); $message .= "Warn_".$i."_LongText|".$converter->convert($single_warning->{'payload'}{'translationsLongText'}{$uclang})."|"; UWZ_Log $hash, 4, "Warn_".$i."_ShortText: ".$enc->decode($single_warning->{'payload'}{'translationsShortText'}{$uclang}); $message .= "Warn_".$i."_ShortText|".$converter->convert($single_warning->{'payload'}{'translationsShortText'}{$uclang})."|"; ### if (AttrVal( $name, 'localiconbase',undef) ) { UWZ_Log $hash, 4, "Warn_".$i."_IconURL: ".AttrVal( $name, 'localiconbase',undef).$typenames{ $single_warning->{'type'} }."-".$single_warning->{'severity'}.".png"; $message .= "Warn_".$i."_IconURL|".AttrVal( $name, 'localiconbase',undef).$typenames{ $single_warning->{'type'} }."-".UWZ_GetSeverityColor($hash, UWZ_GetUWZLevel($hash,$single_warning->{'payload'}{'levelName'} )).".png|"; } else { UWZ_Log $hash, 4, "Warn_".$i."_IconURL: http://www.unwetterzentrale.de/images/icons/".$typenames{ $single_warning->{'type'} }."-".$single_warning->{'severity'}.".gif"; $message .= "Warn_".$i."_IconURL|http://www.unwetterzentrale.de/images/icons/".$typenames{ $single_warning->{'type'} }."-".UWZ_GetSeverityColor($hash, UWZ_GetUWZLevel($hash,$single_warning->{'payload'}{'levelName'} )).".gif|"; } ### ## Hagel start my $hagelcount = 0; # Begin Language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $hagelcount = my @hagelmatch = $single_warning->{'payload'}{'translationsLongText'}{'DE'} =~ /Hagel/g; } else { $hagelcount = my @hagelmatch = $single_warning->{'payload'}{'translationsLongText'}{'EN'} =~ /Hail/g; } # end language by AttrVal if ( $hagelcount ne 0 ) { UWZ_Log $hash, 4, "Warn_".$i."_Hail: 1"; $message .= "Warn_".$i."_Hail|1|"; } else { UWZ_Log $hash, 4, "Warn_".$i."_Hail: 0"; $message .= "Warn_".$i."_Hail|0|"; } ## Hagel end $i++; } my $max=0; for (@uwzmaxlevel) { $max = $_ if !$max || $_ > $max }; $message .= "WarnUWZLevel|"; $message .= $max."|"; UWZ_Log $hash, 4, "WarnUWZLevel_Color: ".UWZ_GetSeverityColor($hash, $max); $message .= "WarnUWZLevel_Color|".UWZ_GetSeverityColor($hash, $max)."|"; ## Begin of redundant Reading if ( $UWZ_humanreadable eq 1 ) { if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { my %uwzlevelname = ( "0" => "Stufe Grün (keine Warnung)", "1" => "Stufe Dunkelgrün (Wetterhinweise)", "2" => "Stufe Gelb (Vorwarnung für Unwetterwarnung)", "3" => "Warnstufe Orange (Unwetterwarnung)", "4" => "Warnstufe Rot (Unwetterwarnung)", "5" => "Warnstufe Violett (Unwetterwarnung)"); UWZ_Log $hash, 4, "WarnUWZLevel_Str: ".$uwzlevelname{ $max }; $message .= "WarnUWZLevel_Str|".$uwzlevelname{ $max }."|"; } else { my %uwzlevelname = ( "0" => "level green (no warnings)", "1" => "level dark green (weather notice)", "2" => "level yellow (severe weather watch)", "3" => "Alert level Orange", "4" => "Alert level Red", "5" => "Alert level Violet"); UWZ_Log $hash, 4, "WarnUWZLevel_Str: ".$uwzlevelname{ $max }; $message .= "WarnUWZLevel_Str|".$uwzlevelname{ $max }."|"; } } $message .= "durationFetchReadings|"; $message .= sprintf "%.2f", time() - $readingStartTime; UWZ_Log $hash, 3, "Done fetching data"; UWZ_Log $hash, 4, "Will return : "."$name|$message|WarnCount|$uwz_warncount" ; return "$name|$message|WarnCount|$uwz_warncount" ; } ##################################### sub UWZAsHtml($;$) { my ($name,$items) = @_; my $ret = ''; my $hash = $defs{$name}; my $htmlsequence = AttrVal($name, "htmlsequence", "none"); my $attr; if (AttrVal($name, "htmlattr", "none") ne "none") { $attr = AttrVal($name, "htmlattr", ""); } else { $attr = 'width="100%"'; } if (ReadingsVal($name, "WarnCount", "") != 0 ) { $ret .= ''; $ret .= '
'; $ret .= ''; if ($htmlsequence eq "descending") { for ( my $i=ReadingsVal($name, "WarnCount", "")-1; $i>=0; $i--){ $ret .= ''; $ret .= ''; } } else { ### for ( my $i=0; $i'; $ret .= ''; } } ### $ret .= '
'.ReadingsVal($name, "Warn_".$i."_ShortText", "").'

'; $ret .= ReadingsVal($name, "Warn_".$i."_LongText", "").'

'; $ret .= ''; # language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $ret .= ''; } else { $ret .= ''; } # end language by AttrVal $ret .= '
Start:'.localtime(ReadingsVal($name, "Warn_".$i."_Start", "")).'Ende:'.localtime(ReadingsVal($name, "Warn_".$i."_End", "")).'End:'.localtime(ReadingsVal($name, "Warn_".$i."_End", "")).'
'; $ret .= '
'.ReadingsVal($name, "Warn_".$i."_ShortText", "").'

'; $ret .= ReadingsVal($name, "Warn_".$i."_LongText", "").'

'; $ret .= ''; # language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $ret .= ''; } else { $ret .= ''; } # end language by AttrVal $ret .= '
Start:'.localtime(ReadingsVal($name, "Warn_".$i."_Start", "")).'Ende:'.localtime(ReadingsVal($name, "Warn_".$i."_End", "")).'End:'.localtime(ReadingsVal($name, "Warn_".$i."_End", "")).'
'; $ret .= '
'; $ret .= '
'; } else { $ret .= ''; $ret .= '
'; $ret .= ''; $ret .= ''; $ret .= '
'; # language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $ret .='Keine Warnungen'; } else { $ret .='No Warnings'; } # end language by AttrVal $ret .= '
'; $ret .= '
'; } return $ret; } ##################################### sub UWZAsHtmlLite($;$) { my ($name,$items) = @_; my $ret = ''; my $hash = $defs{$name}; my $htmlsequence = AttrVal($name, "htmlsequence", "none"); my $attr; if (AttrVal($name, "htmlattr", "none") ne "none") { $attr = AttrVal($name, "htmlattr", ""); } else { $attr = 'width="100%"'; } if (ReadingsVal($name, "WarnCount", "") != 0 ) { $ret .= ''; $ret .= '
'; $ret .= ''; if ($htmlsequence eq "descending") { for ( my $i=ReadingsVal($name, "WarnCount", "")-1; $i>=0; $i--){ $ret .= ''; $ret .= ''; } } else { for ( my $i=0; $i'; $ret .= ''; } } $ret .= '
'.ReadingsVal($name, "Warn_".$i."_ShortText", "").'

'; $ret .= ''; # language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $ret .= ''; } else { $ret .= ''; } # end language by AttrVal $ret .= '
Start:'.localtime(ReadingsVal($name, "Warn_".$i."_Start", "")).'Ende:'.localtime(ReadingsVal($name, "Warn_".$i."_End", "")).'End:'.localtime(ReadingsVal($name, "Warn_".$i."_End", "")).'
'; $ret .= '
'.ReadingsVal($name, "Warn_".$i."_ShortText", "").'

'; $ret .= ''; # language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $ret .= ''; } else { $ret .= ''; } # end language by AttrVal $ret .= '
Start:'.localtime(ReadingsVal($name, "Warn_".$i."_Start", "")).'Ende:'.localtime(ReadingsVal($name, "Warn_".$i."_End", "")).'End:'.localtime(ReadingsVal($name, "Warn_".$i."_End", "")).'
'; $ret .= '
'; $ret .= '
'; } else { $ret .= ''; $ret .= '
'; $ret .= ''; $ret .= ''; $ret .= '
'; # language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $ret .='Keine Warnungen'; } else { $ret .='No Warnings'; } # end language by AttrVal $ret .= '
'; $ret .= '
'; } return $ret; } ##################################### sub UWZAsHtmlFP($;$) { my ($name,$items) = @_; my $tablewidth = ReadingsVal($name, "WarnCount", "") * 80; my $htmlsequence = AttrVal($name, "htmlsequence", "none"); my $ret = ''; $ret .= ''; $ret .= ""; if ($htmlsequence eq "descending") { for ( my $i=ReadingsVal($name, "WarnCount", "")-1; $i>=0; $i--){ $ret .= ''; } } else { for ( my $i=0; $i'; } } $ret .= ""; $ret .= '
'; return $ret; } ##################################### sub UWZAsHtmlMovie($$) { my ($name,$land) = @_; my $url = UWZ_Map2Movie($name,$land); my $hash = $defs{$name}; my $ret = ''; $ret .= '
'; $ret .= ''; $ret .= '
'; if(defined($url)) { $ret .= ''; } else { # language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $ret .= 'unbekannte Landbezeichnung'; } else { $ret .='unknown movie setting'; } # end language by AttrVal } $ret .= '
'; return $ret; } ##################################### sub UWZAsHtmlKarteLand($$) { my ($name,$land) = @_; my $url = UWZ_Map2Image($name,$land); my $hash = $defs{$name}; my $ret = ''; $ret .= '
'; $ret .= ''; $ret .= '
'; if(defined($url)) { $ret .= ''; } else { # language by AttrVal if ( $hash->{CountryCode} ~~ [ 'DE', 'AT', 'CH' ] ) { $ret .= 'unbekannte Landbezeichnung'; } else { $ret .='unknown map setting'; } # end language by AttrVal } $ret .= '
'; return $ret; } ##################################### sub UWZ_GetSeverityColor($$) { my ($name,$uwzlevel) = @_; my $alertcolor = ""; my %UWZSeverity = ( "0" => "gruen", "1" => "orange", "2" => "gelb", "3" => "orange", "4" => "rot", "5" => "violett"); return $UWZSeverity{$uwzlevel}; } ##################################### sub UWZ_GetUWZLevel($$) { my ($name,$warnname) = @_; my @alert = split(/_/,$warnname); if ( $alert[0] eq "notice" ) { return "1"; } elsif ( $alert[1] eq "forewarn" ) { return "2"; } else { my %UWZSeverity = ( "green" => "0", "yellow" => "2", "orange" => "3", "red" => "4", "violet" => "5"); return $UWZSeverity{$alert[2]}; } } ##################################### ## ## UWZ Helper Functions ## ##################################### sub UWZSearchLatLon($$) { my ($name,$loc) = @_; my $url = "http://alertspro.geoservice.meteogroup.de/weatherpro/SearchFeed.php?search=".$loc; my $agent = LWP::UserAgent->new( env_proxy => 1, keep_alive => 1, protocols_allowed => ['http'], timeout => 10 ); my $request = HTTP::Request->new( GET => $url ); my $response = $agent->request($request); my $err_log = "Can't get $url -- " . $response->status_line unless( $response->is_success ); if ( $err_log ne "" ) { print "Error|Error " . $response->status_line; } use XML::Simple qw(:strict); use Data::Dumper; use Encode qw(decode encode); my $uwzxmlparser = XML::Simple->new(); #my $xmlres = $parser->XMLin( my $search = $uwzxmlparser->XMLin($response->content, KeyAttr => { city => 'id' }, ForceArray => [ 'city' ]); my $ret = ''; $ret .= '
'; $ret .= ''; $ret .= ''; $ret .= ""; $ret .= ""; $ret .= ""; $ret .= ""; $ret .= ''; foreach my $locres ($search->{cities}->{city}) { my $linecount=1; while ( my ($key, $value) = each(%$locres) ) { if ( $linecount % 2 == 0 ) { $ret .= ''; } else { $ret .= ''; } $ret .= ""; $ret .= ""; $ret .= ""; $ret .= ""; my @headerHost = grep /Host/, @FW_httpheader; $headerHost[0] =~ s/Host: //g; my $aHref="{'latitude'}.",".$value->{'longitude'}."\">Get AreaID"; $ret .= ""; $ret .= ''; $linecount++; } } $ret .= '
citycountrylatitudelongitude
".encode('utf-8',$value->{'name'})."$value->{'country-name'}$value->{'latitude'}$value->{'longitude'}".$aHref."
'; return $ret; } ##################################### sub UWZSearchAreaID($$) { my ($lat,$lon) = @_; my $url = "http://feed.alertspro.meteogroup.com/AlertsPro/AlertsProPollService.php?method=lookupCoord&lat=".$lat."&lon=".$lon; my $agent = LWP::UserAgent->new( env_proxy => 1, keep_alive => 1, protocols_allowed => ['http'], timeout => 10 ); my $request = HTTP::Request->new( GET => $url ); my $response = $agent->request($request); my $err_log = "Can't get $url -- " . $response->status_line unless( $response->is_success ); if ( $err_log ne "" ) { print "Error|Error " . $response->status_line; } use JSON; my @perl_scalar = @{JSON->new->utf8->decode($response->content)}; my $AreaType = $perl_scalar[0]->{'AREA_TYPE'}; my $CC = substr $perl_scalar[0]->{'AREA_ID'}, 3, 2; my $AreaID = substr $perl_scalar[0]->{'AREA_ID'}, 5, 5; if ( $AreaType eq "UWZ" ) { my $ret = 'Please use the following statement to define Unwetterzentrale for your location:

'; $ret .= '
'; $ret .= ''; $ret .= ''; $ret .= ""; $ret .= ''; $ret .= '
define Unwetterzentrale UWZ $CC $AreaID 3600
'; $ret .= '
'; $ret .= '
'; $ret .= 'You can also use weblinks to add weathermaps. For a list of possible Weblinks see Commandref. For example to add the Europe Map use:
'; $ret .= '
'; $ret .= ''; $ret .= ''; $ret .= ""; $ret .= ''; $ret .= '
define UWZ_Map_Europe weblink htmlCode { UWZAsHtmlKarteLand('Unwetterzentrale','europa') }
'; $ret .= '
'; $ret .= ''; return $ret; } else { return "Sorry, nothing found or not implemented"; } } ##################################### 1; =pod =begin html

UWZ

=end html =begin html_DE

UWZ

=end html_DE =cut