############################################## # $Id$$$ # # 60_allergy.pm # # 2017 Markus Moises < vorname at nachname . de > # # This module provides allergy forecast data # # http://forum.fhem.de/index.php/topic,37194.0.html # # ############################################################################## # # define allergy # ############################################################################## package main; use strict; use warnings; use Time::Local; use Encode; use XML::Simple; use utf8; my %pollen_types = ( 0 => "Unknown", 1 => "Ahorn", 2 => "Ambrosia", 3 => "Beifuss", 4 => "Birke", 5 => "Brennnessel", 6 => "Buche", 7 => "Eiche", 8 => "Erle", 9 => "Esche", 10 => "Fichte", 11 => "Flieder", 12 => "Gaensefuss", 13 => "Gerste", 14 => "Graeser", 15 => "Hafer", 16 => "Hasel", 17 => "Holunder", 18 => "Hopfen", 19 => "Kiefer", 20 => "Linde", 21 => "Loewenzahn", 22 => "Mais", 23 => "Nessel", 24 => "Pappel", 25 => "Platane", 26 => "Raps", 27 => "Roggen", 28 => "Rotbuche", 29 => "Spitzwegerich", 30 => "Tanne", 31 => "Ulme", 32 => "Weide", 33 => "Weizen", ); ############################################################################## sub allergy_Initialize($) { my ($hash) = @_; my $name = $hash->{NAME}; $hash->{DefFn} = "allergy_Define"; $hash->{UndefFn} = "allergy_Undefine"; $hash->{GetFn} = "allergy_Get"; $hash->{AttrFn} = "allergy_Attr"; $hash->{AttrList} = "disable:0,1 ". "ignoreList ". "updateIgnored:1,0 ". "updateEmpty:1,0 ". "levelsFormat ". "weekdaysFormat ". "extended5Day:1,0 ". $readingFnAttributes; } sub allergy_Define($$$) { my ($hash, $def) = @_; my @a = split("[ \t][ \t]*", $def); my ($found, $dummy); return "syntax: define allergy " if(int(@a) != 3 ); my $name = $hash->{NAME}; $hash->{helper}{ZIPCODE} = $a[2]; $hash->{helper}{INTERVAL} = 10800; $hash->{ERROR} = 0; my $req = eval { require XML::Simple; XML::Simple->import(); require JSON; JSON->import(); 1; }; if($req) { InternalTimer( gettimeofday() + 60, "allergy_GetUpdate", $hash, 0); if (!defined($attr{$name}{stateFormat})) { $attr{$name}{stateFormat} = 'fc1_maximum'; } } else { $hash->{STATE} = "XML::Simple and JSON is required!"; $attr{$name}{disable} = "1"; return undef; } #$hash->{STATE} = "Initialized"; return undef; } sub allergy_Undefine($$) { my ($hash, $arg) = @_; my $name = $hash->{NAME}; RemoveInternalTimer($hash); #fhem("deletereading $name fc.*", 1); return undef; } sub allergy_Get($@) { my ($hash, @a) = @_; my $command = $a[1]; my $parameter = $a[2] if(defined($a[2])); my $name = $hash->{NAME}; my $usage = "Unknown argument $command, choose one of data:noArg "; return $usage if $command eq '?'; RemoveInternalTimer($hash); if(AttrVal($name, "disable", 0) eq 1) { $hash->{STATE} = "disabled"; return "allergy $name is disabled. Aborting..."; } allergy_GetUpdate($hash); return undef; } sub allergy_GetUpdate($) { my ($hash) = @_; my $name = $hash->{NAME}; if(AttrVal($name, "disable", 0) eq 1) { $hash->{STATE} = "disabled"; Log3 ($name, 2, "allergy $name is disabled, data update cancelled."); return undef; } my $url="http://www.allergie.hexal.de/pollenflug/xml-interface-neu/pollen_de_7tage.php?plz=".$hash->{helper}{ZIPCODE}; if(AttrVal($name, "extended5Day", 0) eq 1) { $url="https://pollenwarner-live.herokuapp.com/pollen/".$hash->{helper}{ZIPCODE}; Log3 ($name, 4, "Getting URL $url"); HttpUtils_NonblockingGet({ url => $url, noshutdown => 1, hash => $hash, type => 'allergydata', callback => \&allergy_ParseExtended, }); return undef; } Log3 ($name, 4, "Getting URL $url"); HttpUtils_NonblockingGet({ url => $url, noshutdown => 1, hash => $hash, type => 'allergydata', callback => \&allergy_Parse, }); return undef; } sub allergy_Parse($$$) { my ($param, $err, $data) = @_; my $hash = $param->{hash}; my $name = $hash->{NAME}; if( $err ) { Log3 $name, 1, "$name: URL error (".($hash->{ERROR}+1)."): ".$err; my $nextupdate = gettimeofday()+( (900*$hash->{ERROR}) + 90 ); InternalTimer($nextupdate, "allergy_GetUpdate", $hash, 1); $hash->{STATE} = "error" if($hash->{ERROR} > 1); $hash->{ERROR} = $hash->{ERROR}+1; return undef; } $hash->{ERROR} = 0; Log3 $name, 5, "Received XML data ".$data; my $xml = new XML::Simple(); #my $xmldata = $xml->XMLin($data,forcearray => [qw( pollenbelastungen pollen )],keyattr => {pollen => 'name'}); my $xmldata = eval { $xml->XMLin($data,forcearray => [qw( pollenbelastungen pollen )],keyattr => {pollen => 'name'}) }; if($@) { Log3 $name, 2, "$name: XML error ".$@; my $nextupdate = gettimeofday()+$hash->{helper}{INTERVAL}; InternalTimer($nextupdate, "allergy_GetUpdate", $hash, 1); return undef; } my @wdays = split(',',AttrVal($hash->{NAME}, "weekdaysFormat", "Sun,Mon,Tue,Wed,Thu,Fri,Sat" )); my @levels = split(',',AttrVal($hash->{NAME}, "levelsFormat", "-,low,moderate,high,extreme" )); readingsBeginUpdate($hash); # Start update readings my $city = $xmldata->{'pollendaten'}->{'ort'}; readingsBulkUpdate($hash, "city", allergy_utf8clean($city)); Log3 $name, 4, "Received data for postcode ".$xmldata->{'pollendaten'}->{'plz'}; foreach my $day (@{$xmldata->{'pollendaten'}{'pollenbelastungen'}}) { my $daycode = $day->{'tag'}+1; my @daydata = $day->{'pollen'}; my $daymax = 0; my $pollenkey=''; my $pollenvalue=''; my $pollendata=0; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time+($day->{'tag'}*86400)); readingsBulkUpdate($hash, "fc".$daycode."_day_of_week", $wdays[$wday]); foreach my $pollenhash (@daydata) { while(($pollenkey, $pollenvalue) = each(%$pollenhash)) { $pollenkey = allergy_utf8clean($pollenkey); $pollendata = $pollenvalue->{'belastung'}; if (( AttrVal($hash->{NAME}, "updateEmpty", 0 ) gt 0 or $pollendata gt 0) and ( AttrVal($hash->{NAME}, "updateIgnored", 0 ) gt 0 or ( index(AttrVal($hash->{NAME}, "ignoreList", ""), $pollenkey ) == -1 ))) { readingsBulkUpdate($hash, "fc".$daycode."_".$pollenkey, $levels[$pollendata]); $daymax = $pollendata if($pollendata gt $daymax); Log3 $name, 4, "Received pollen level for ".$pollenkey.": day".$daycode." level ".$pollendata; } else { fhem( "deletereading $name fc".$daycode."_".$pollenkey, 1 ); Log3 $name, 5, "Received pollen level for ".$pollenkey.": day".$daycode." level ".$pollendata." (ignored)"; } } } readingsBulkUpdate($hash, "fc".$daycode."_maximum", $levels[$daymax]); } readingsEndUpdate($hash, 1); $hash->{UPDATED} = FmtDateTime(time()); my $nextupdate = gettimeofday()+$hash->{helper}{INTERVAL}; InternalTimer($nextupdate, "allergy_GetUpdate", $hash, 1); return undef; } sub allergy_ParseExtended($$$) { my ($param, $err, $data) = @_; my $hash = $param->{hash}; my $name = $hash->{NAME}; if( $err ) { Log3 $name, 1, "$name: URL error (".($hash->{ERROR}+1)."): ".$err; my $nextupdate = gettimeofday()+( (900*$hash->{ERROR}) + 90 ); InternalTimer($nextupdate, "allergy_GetUpdate", $hash, 1); $hash->{STATE} = "error" if($hash->{ERROR} > 1); $hash->{ERROR} = $hash->{ERROR}+1; return undef; } $hash->{ERROR} = 0; Log3 $name, 5, "Received data ".$data; my $json = eval { JSON::decode_json($data) }; if($@) { Log3 $name, 2, "$name: JSON error ".$@; my $nextupdate = gettimeofday()+$hash->{helper}{INTERVAL}; InternalTimer($nextupdate, "allergy_GetUpdate", $hash, 1); return undef; } Log3 $name, 5, "$name: parse json\n".Dumper($json); my @wdays = split(',',AttrVal($hash->{NAME}, "weekdaysFormat", "Sun,Mon,Tue,Wed,Thu,Fri,Sat" )); my @levels = split(',',AttrVal($hash->{NAME}, "levelsFormat", "-,low,moderate,high,extreme" )); readingsBeginUpdate($hash); # Start update readings my $city = $json->{region}; readingsBulkUpdate($hash, "city", allergy_utf8clean($city)) if($json->{region}); my $day = $json->{date}; readingsBulkUpdate($hash, "date", $day) if($json->{date}); Log3 $name, 4, "Received data for postcode ".$json->{region}; my @daymax; return undef if(!defined($json->{polls})); #Log3 $name, 1, "found polls ".ref($json->{polls}); foreach my $pollenid ( keys %{$json->{polls}}) { my $pollenid = $json->{polls}->{$pollenid}->{id}; #Log3 $name, 1, "polls step ".$pollenid; my $pollenkey = 'Unknown'; $pollenkey = $pollen_types{$pollenid} if( defined($pollen_types{$pollenid}) ); return undef if(!defined($json->{polls}->{$pollenid}->{forecast})); #Log3 $name, 1, "forecast "; return undef if(ref($json->{polls}->{$pollenid}->{forecast}) ne "ARRAY"); #my @forecast = $json->{polls}->{$pollenid}->{forecast}; my $daycode = 0; while(defined($json->{polls}->{$pollenid}->{forecast}[$daycode])) { my $pollendata = int($json->{polls}->{$pollenid}->{forecast}[$daycode]); #Log3 $name, 1, "forecast array".ref($pollendata); if (( AttrVal($hash->{NAME}, "updateEmpty", 0 ) gt 0 or $pollendata gt 0) and ( AttrVal($hash->{NAME}, "updateIgnored", 0 ) gt 0 or ( index(AttrVal($hash->{NAME}, "ignoreList", ""), $pollenkey ) == -1 ))) { readingsBulkUpdate($hash, "fc".($daycode+1)."_".$pollenkey, $levels[$pollendata]); $daymax[$daycode] = $pollendata if(!defined($daymax[$daycode]) || $pollendata gt $daymax[$daycode]); Log3 $name, 4, "Received pollen level for ".$pollenkey.": day".($daycode+1)." level ".$pollendata; } else { fhem( "deletereading $name fc".($daycode+1)."_".$pollenkey, 1 ); Log3 $name, 5, "Received pollen level for ".$pollenkey.": day".($daycode+1)." level ".$pollendata." (ignored)"; } $daymax[$daycode] = 0 if(!defined($daymax[$daycode])); $daycode++; } } my $daycode = 0; while(defined($daymax[$daycode])) { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time+($daycode*86400)); readingsBulkUpdate($hash, "fc".($daycode+1)."_day_of_week", $wdays[$wday]); readingsBulkUpdate($hash, "fc".($daycode+1)."_maximum", $levels[$daymax[$daycode]]); $daycode++; } readingsEndUpdate($hash, 1); $hash->{UPDATED} = FmtDateTime(time()); my $nextupdate = gettimeofday()+$hash->{helper}{INTERVAL}; InternalTimer($nextupdate, "allergy_GetUpdate", $hash, 1); return undef; } sub allergy_Attr($$$) { my ($cmd, $name, $attrName, $attrVal) = @_; my $orig = $attrVal; if( $attrName eq "disable" ) { my $hash = $defs{$name}; RemoveInternalTimer($hash); if( $cmd eq "set" && $attrVal ne "0" ) { $attrVal = 1; } else { $attr{$name}{$attrName} = 0; allergy_GetUpdate($hash); } } elsif ($attrName eq "extended5Day") { fhem("deletereading $name fc.*", 1); fhem("deletereading $name date", 1); my $hash = $defs{$name}; allergy_GetUpdate($hash); } if( $cmd eq "set" ) { if( !defined($orig) || $orig ne $attrVal ) { $attr{$name}{$attrName} = $attrVal; return $attrName ." set to ". $attrVal; } } return; } sub allergy_utf8clean($) { my ($string) = @_; my $log = ""; if($string !~ m/^[A-Za-z\d_\.-]+$/) { $log .= $string."(standard) "; $string =~ s/Ä/Ae/g; $string =~ s/Ö/Oe/g; $string =~ s/Ü/Ue/g; $string =~ s/ä/ae/g; $string =~ s/ö/oe/g; $string =~ s/ü/ue/g; $string =~ s/ß/ss/g; } if($string !~ m/^[A-Za-z\d_\.-]+$/) { $log .= $string."(single) "; $string =~ s/Ä/Ae/g; $string =~ s/Ö/Oe/g; $string =~ s/Ãœ/Ue/g; $string =~ s/ä/ae/g; $string =~ s/ö/oe/g; $string =~ s/ü/ue/g; $string =~ s/ß/ss/g; } if($string !~ m/^[A-Za-z\d_\.-]+$/) { $log .= $string."(double) "; $string =~ s/Ä/Ae/g; $string =~ s/Ö/Oe/g; $string =~ s/Ãœ/Ue/g; $string =~ s/ä/ae/g; $string =~ s/ö/oe/g; $string =~ s/ü/ue/g; $string =~ s/ß/ss/g; } if($string !~ m/^[A-Za-z\d_\.-]+$/) { $log .= $string."(unknown)"; #$string =~ s/[^!-~\s]//g; $string =~ s/[^A-Za-z\d_\.-]//g; } Log3 "utf8clean", 5, "Cleaned $string // $log" if($log ne ""); return $string; } ########################## 1; =pod =item device =item summary Allergy forecast data for Germany =begin html

allergy

    This modul provides allergy forecast data for Germany.
    It requires the Perl module XML::Simple to be installed

    Define
      define <name> allergy <zipcode>
      Example: define allergydata allergy 12345
       
    • zipcode
      German zipcode


    Get
    • data
      Manually trigger data update


    Readings
    • city
      Name of the city the forecast is read for

    • fcn_total
      Daily maximum levels for all allergens that are not being ignored due to ignoreList

    • fcn_day_of_week
      Weekday, can be localized through weekdaysFormat

    • fcn_allergen
      Daily levels for all allergens that are not being ignored due to ignoreList


    Attributes
    • ignoreList
      Comma-separated list of allergen names that are to be ignored during updates and for cumulated day levels calculation

    • updateEmpty
      Also update (and keep) level readings for inactive allergens that are otherwise removed

    • updateIgnored
      Also update (and keep) level readings for ignored allergens that are otherwise removed

    • levelsFormat
      Localize levels by adding them comma separated (default: -,low,moderate,high,extreme)

    • weekdaysFormat
      Localize Weekdays by adding them comma separated (default: Sun,Mon,Tue,Wed,Thu,Fr,Sat)

=end html =begin html_DE

allergy


    Dieses Modul prognostiziert Allergie Daten für Deutschland.
    Es erfordert dass das Perlmodul XML:: Simple installiert ist.

    Define
      define <name> allergy <Postleitzahl>
      Beispiel: define allergydata allergy 12345

    • Postleitzahl
      Deutsche Postleitzahl


    Get
    • data
      Manuelles Datenupdate


    Readings
    • city
      Name der Stadt, für die Prognosen gelesen werden.

    • fcn_total
      Täglicher Höchstwerte für alle Allergene, die nicht aufgrund der Ignoreliste (attr ignoreList) ignoriert werden

    • fcn_day_of_week
      Wochentag, kann durch weekdaysFormat lokalisiert werden.

    • fcn_allergen
      Tägliche Werte für alle Allergene, die nicht aufgrund der Ignoreliste (attr ignoreList) ignoriert werden.


    Attribute
    • ignoreList
      Kommagetrennte Liste von Allergen-Namen, die bei der Aktualisierung ignoriert werden sollen.

    • updateEmpty (Standard: 0|1)
      Aktualisierung von Allergenen.
      0 = nur Allergene mit Belastung.
      1 = auch Allergene die keine Belastung haben.

    • updateIgnored (1)
      Aktualisierung von Allergenen, die sonst durch die ignoreList entfernt werden.

    • extended5Days (1)
      Alternative Datenquelle mit 5 Tagen Vorhersage für mehr Allergene

    • levelsFormat (Standard: -,low,moderate,high,extreme)
      Lokalisierte Levels, durch Kommas getrennt.

    • weekdaysFormat (Standard: Sun,Mon,Tue,Wed,Thu,Fri,Sat)
      Lokalisierte Wochentage, durch Kommas getrennt.

=end html_DE =cut