FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-05-05 02:19:31 +00:00
Code Issues Releases Wiki Activity

contrib/55_GDS.2015: retrieveFile() made nonblocking

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@9416 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
betateilchen 2015-10-09 18:25:18 +00:00
parent 2a88073730
commit 5a4e736e2b
1 changed files with 422 additions and 423 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

377
fhem/contrib/55_GDS.2015/55_GDS.pm
View File

@ -7,7 +7,7 @@
# #
# Copyright: betateilchen ® # Copyright: betateilchen ®
# #
# some patches provided by jensb # includes: some patches provided by jensb
# forecasts provided by jensb # forecasts provided by jensb
# weblinks provided by jensb # weblinks provided by jensb
# #
@ -33,6 +33,8 @@ package main;
use strict; use strict;
use warnings; use warnings;
use feature qw/say switch/; use feature qw/say switch/;
use Blocking;
use Text::CSV; use Text::CSV;
use Net::FTP; use Net::FTP;
use List::MoreUtils 'first_index'; use List::MoreUtils 'first_index';
@ -53,7 +55,7 @@ sub GDS_Initialize($) {
my ($hash) = @_; my ($hash) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
return "This module must not be used on micro... platforms!" if($^O eq "MSWin32"); return "This module must not be used on microso... platforms!" if($^O =~ m/Win/);
$hash->{DefFn} = "GDS_Define"; $hash->{DefFn} = "GDS_Define";
$hash->{UndefFn} = "GDS_Undef"; $hash->{UndefFn} = "GDS_Undef";
@ -122,8 +124,12 @@ sub GDS_Shutdown($) {
sub GDS_Set($@) { sub GDS_Set($@) {
my ($hash, @a) = @_; my ($hash, @a) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $usage = "Unknown argument, choose one of clear:alerts,conditions,forecasts,all help:noArg rereadcfg:noArg update:noArg ". my $usage = "Unknown argument, choose one of ".
"conditions:".$sList." forecasts:".$fList." "; "clear:alerts,conditions,forecasts,all ".
"conditions:$sList ".
"forecasts:$fList ".
"help:noArg ".
"update:noArg "; ;
readingsSingleUpdate($hash, '_tzOffset', _calctz(time,localtime(time))*3600, 0); readingsSingleUpdate($hash, '_tzOffset', _calctz(time,localtime(time))*3600, 0);
@ -160,21 +166,6 @@ sub GDS_Set($@) {
break; break;
} }
when("rereadcfg"){
eval {
retrieveFile($hash,"conditions");
$sList = getListStationsDropdown($hash);
};
eval {
retrieveFile($hash,"alerts");
($aList, undef) = buildCAPList($hash);
};
eval {
$fList = getListForecastStationsDropdown($hash);
};
break;
}
when("update"){ when("update"){
RemoveInternalTimer($hash); RemoveInternalTimer($hash);
GDS_GetUpdate($hash); GDS_GetUpdate($hash);
@ -182,17 +173,17 @@ sub GDS_Set($@) {
} }
when("conditions"){ when("conditions"){
readingsSingleUpdate($hash, "state", "active",1);
retrieveConditions($hash, "c", @a); retrieveConditions($hash, "c", @a);
$attr{$name}{gdsSetCond} = ReadingsVal($name,'c_stationName',undef); $attr{$name}{gdsSetCond} = ReadingsVal($name,'c_stationName',undef);
$next = gettimeofday()+$hash->{helper}{INTERVAL}; $next = gettimeofday()+$hash->{helper}{INTERVAL};
readingsSingleUpdate($hash, "c_nextUpdate", localtime($next), 1); readingsSingleUpdate($hash, "_nextUpdate", localtime($next), 1);
RemoveInternalTimer($hash); RemoveInternalTimer($hash);
InternalTimer($next, "GDS_GetUpdate", $hash, 1); InternalTimer($next, "GDS_GetUpdate", $hash, 1);
break; break;
} }
when("forecasts"){ when("forecasts"){
CommandDeleteReading(undef, "$name fc.?_.*") if($parameter ne AttrVal($name,'gdsSetForecast',''));
retrieveForecasts($hash, "fc", @a); retrieveForecasts($hash, "fc", @a);
my $station = ReadingsVal($name, 'fc_stationName', undef); my $station = ReadingsVal($name, 'fc_stationName', undef);
if (defined($station)) { if (defined($station)) {
@ -241,19 +232,19 @@ sub GDS_Get($@) {
when("conditionsmap"){ when("conditionsmap"){
# retrieve map: current conditions # retrieve map: current conditions
retrieveFile($hash,$command,$parameter); retrieveFile($hash,$command,$parameter,undef);
break; break;
} }
when("forecastsmap"){ when("forecastsmap"){
# retrieve map: forecasts # retrieve map: forecasts
retrieveFile($hash,$command,$parameter); retrieveFile($hash,$command,$parameter,undef);
break; break;
} }
when("warningsmap"){ when("warningsmap"){
# retrieve map: warnings # retrieve map: warnings
retrieveFile($hash,$command,$parameter); retrieveFile($hash,$command,$parameter,undef);
break; break;
} }
@ -272,8 +263,8 @@ sub GDS_Get($@) {
when("list"){ when("list"){
given($parameter){ given($parameter){
when("capstations") { $result = getListCapStations($hash,$parameter); break,} when("capstations") { $result = getListCapStations($hash,$parameter); break,}
when("data") { $result = getListData($hash); break; } when("data") { $result = retrieveText($hash,"conditions","\n"); break; }
when("stations") { $result = getListStationsText($hash); break; } when("stations") { $result = retrieveText($hash,"conditions2","\n"); break; }
default { $usage = "get <name> list <parameter>"; return $usage; } default { $usage = "get <name> list <parameter>"; return $usage; }
} }
break; break;
@ -317,16 +308,15 @@ sub GDS_Get($@) {
when("rereadcfg"){ when("rereadcfg"){
eval { eval {
retrieveFile($hash,"alerts"); retrieveFile($hash,"alerts",undef,undef);
}; };
eval { eval {
retrieveFile($hash,"conditions"); retrieveFile($hash,"conditions",undef,undef);
}; };
initDropdownLists($hash); initDropdownLists($hash);
eval { eval {
$fList = getListForecastStationsDropdown($hash); getListForecastStationsDropdown($hash);
}; };
break; break;
} }
@ -338,7 +328,7 @@ sub GDS_Get($@) {
for ($vhdl=30; $vhdl <=33; $vhdl++){ for ($vhdl=30; $vhdl <=33; $vhdl++){
(undef, $found) = retrieveFile($hash, $command, $parameter, $vhdl); (undef, $found) = retrieveFile($hash, $command, $parameter, $vhdl);
if($found){ if($found){
$result .= retrieveTextWarn($hash); $result .= retrieveText($hash, "warnings", "");
$result .= "\n".sepLine(70); $result .= "\n".sepLine(70);
} }
} }
@ -349,7 +339,7 @@ sub GDS_Get($@) {
when("forecasts"){ when("forecasts"){
$parameter = ucfirst($parameter); $parameter = ucfirst($parameter);
$result = sepLine(67)."\n"; $result = sepLine(67)."\n";
(undef, $found) = retrieveFile($hash,$command,$parameter); (undef, $found) = retrieveFile($hash,$command,$parameter,undef);
if($found){ if($found){
$result .= retrieveText($hash, $command, "\n"); $result .= retrieveText($hash, $command, "\n");
} }
@ -404,7 +394,7 @@ sub GDS_Notify ($$) {
GDS_Set($hash,undef,'conditions',$d) if(defined($d)); GDS_Set($hash,undef,'conditions',$d) if(defined($d));
$d = AttrVal($name,'gdsSetForecast',undef); $d = AttrVal($name,'gdsSetForecast',undef);
# GDS_Set($hash,undef,'forecasts',$d) if(defined($d); GDS_Set($hash,undef,'forecasts',$d) if(defined($d));
return undef; return undef;
} }
@ -412,53 +402,35 @@ sub GDS_Notify ($$) {
sub GDS_GetUpdate($) { sub GDS_GetUpdate($) {
my ($hash) = @_; my ($hash) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my (@a, $next); my $next;
my $interval = $hash->{helper}{INTERVAL}; my $interval = $hash->{helper}{INTERVAL};
my $forcastsStationName = ReadingsVal($name, "fc_stationName", undef); my $forcastsStationName = ReadingsVal($name, "fc_stationName", undef);
my $condStationName = ReadingsVal($name, "c_stationName", undef);
if(IsDisabled($name)) { if(IsDisabled($name)) {
readingsSingleUpdate($hash, 'state', 'disabled', 0); readingsSingleUpdate($hash, 'state', 'disabled', 0);
Log3 ($name, 2, "GDS $name is disabled, data update cancelled."); Log3 ($name, 2, "GDS $name is disabled, data update cancelled.");
} else { } else {
readingsSingleUpdate($hash, 'state', 'active', 0); readingsSingleUpdate($hash, 'state', 'active', 0);
if($condStationName) {
# schedule only one ftp fetch per update call to avoid blocking FHEM for extended periods my @a;
if (!defined($hash->{helper}{UPDATE_CYCLE}) || !defined($forcastsStationName)) {
$hash->{helper}{UPDATE_CYCLE} = 0;
} else {
$hash->{helper}{UPDATE_CYCLE} = ++$hash->{helper}{UPDATE_CYCLE}%11;
}
# perform one ftp fetch
if ($hash->{helper}{UPDATE_CYCLE} == 0) {
push @a, undef; push @a, undef;
push @a, undef; push @a, undef;
push @a, ReadingsVal($name, "c_stationName", ""); push @a, ReadingsVal($name, "c_stationName", "");
retrieveConditions($hash, "c", @a); retrieveConditions($hash, "c", @a);
} else { }
if($forcastsStationName) {
my @a;
push @a, undef; push @a, undef;
push @a, undef; push @a, undef;
push @a, $forcastsStationName; push @a, $forcastsStationName;
push @a, $hash->{helper}{UPDATE_CYCLE};
retrieveForecasts($hash, "fc", @a); retrieveForecasts($hash, "fc", @a);
} }
# vary interval for staggered fetching and waiting
if (defined($forcastsStationName)) {
if ($hash->{helper}{UPDATE_CYCLE} < 10) {
$interval = 1; # use short interval to get next forecast
} else {
$interval -= 16; # cut back approximate staggered retrieval time from interval
} }
}
}
# schedule next update # schedule next update
$next = gettimeofday() + $interval; $next = gettimeofday() + $interval;
if ($interval > 1) { readingsSingleUpdate($hash, "_nextUpdate", localtime($next), 1);
readingsSingleUpdate($hash, "c_nextUpdate", localtime($next), 1);
}
InternalTimer($next, "GDS_GetUpdate", $hash, 1); InternalTimer($next, "GDS_GetUpdate", $hash, 1);
return 1; return 1;
@ -555,6 +527,17 @@ sub GDS_getURL {
# #
#################################################################################################### ####################################################################################################
sub setHelp(){
return "Use one of the following commands:\n".
sepLine(35)."\n".
"set <name> clear alerts|all\n".
"set <name> conditions <stationName>\n".
"set <name> forecasts <regionName>/<stationName>\n".
"set <name> help\n".
"set <name> rereadcfg\n".
"set <name> update\n";
}
sub getHelp(){ sub getHelp(){
return "Use one of the following commands:\n". return "Use one of the following commands:\n".
sepLine(35)."\n". sepLine(35)."\n".
@ -567,38 +550,29 @@ sub getHelp(){
"get <name> warnings <region>\n"; "get <name> warnings <region>\n";
} }
sub getListData($){ sub retrieveText($$$) {
my ($hash) = @_; my ($hash, $fileName, $separator) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my ($err,@a);
my ($line, @a); given ($fileName) {
open WXDATA, $tempDir.$name."_conditions"; when ("conditions2") {
while (chomp($line = <WXDATA>)) { # get conditions stations list
push @a, latin1ToUtf8($line); $fileName = $tempDir.$name."_conditions";
} ($err,@a) = FileRead({FileName=>$fileName,ForceType=>"file" });
close WXDATA; return "GDS error reading $fileName" if($err);
@a = map (substr(latin1ToUtf8($_),0,19), @a);
return join("\n", @a);
}
sub getListStationsText($){
my ($hash) = @_;
my $name = $hash->{NAME};
my ($line, @a);
open WXDATA, $tempDir.$name."_conditions";
while (chomp($line = <WXDATA>)) {
push @a, substr(latin1ToUtf8($line),0,19);
}
close WXDATA;
splice(@a,0,6);
splice(@a,first_index { /Höhe/ } @a);
splice(@a,-1);
@a = sort(@a);
unshift(@a, "Use one of the following stations:", sepLine(40)); unshift(@a, "Use one of the following stations:", sepLine(40));
}
default {
$fileName = $tempDir.$name."_$fileName";
($err,@a) = FileRead({FileName=>$fileName,ForceType=>"file" });
return "GDS error reading $fileName" if($err);
@a = map (latin1ToUtf8($_), @a);
}
}
return join("\n", @a); return join($separator, @a);
} }
sub getListCapStations($$){ sub getListCapStations($$){
@ -613,7 +587,7 @@ sub getListCapStations($$){
# prüfen, ob CSV schon vorhanden, # prüfen, ob CSV schon vorhanden,
# falls nicht: vom Server holen # falls nicht: vom Server holen
if (!-e $tempDir."caplist.csv"){ if (!-e $tempDir."caplist.csv"){
(undef, $found) = retrieveFile($hash, $command); (undef, $found) = retrieveFile($hash, $command,undef,undef);
if(!$found){ if(!$found){
$cList = "Error: Unable to retrieve capstation list!"; $cList = "Error: Unable to retrieve capstation list!";
Log3($name, 2, "GDS $name: $cList"); Log3($name, 2, "GDS $name: $cList");
@ -647,17 +621,6 @@ sub getListCapStations($$){
return $cList; return $cList;
} }
sub setHelp(){
return "Use one of the following commands:\n".
sepLine(35)."\n".
"set <name> clear alerts|all\n".
"set <name> conditions <stationName>\n".
"set <name> forecasts <regionName>/<stationName>\n".
"set <name> help\n".
"set <name> rereadcfg\n".
"set <name> update\n";
}
sub buildCAPList($){ sub buildCAPList($){
my ($hash) = @_; my ($hash) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@ -803,9 +766,16 @@ sub decodeCAPData($$$){
readingsBeginUpdate($hash); readingsBeginUpdate($hash);
readingsBulkUpdate($hash, "_dataSource", "Quelle: Deutscher Wetterdienst"); readingsBulkUpdate($hash, "_dataSource", "Quelle: Deutscher Wetterdienst");
while(($k, $v) = each %readings){ while(($k, $v) = each %readings){
readingsBulkUpdate($hash, $k, latin1ToUtf8($v)) if(defined($v)); } # skip update if no valid data is available
next unless(defined($v));
readingsBulkUpdate($hash, $k, latin1ToUtf8($v));
}
# readingsEndUpdate($hash, 1);
# convert color value to hex
eval { readingsBulkUpdate($hash, 'a_'.$anum.'_eventCode_AREA_COLOR_hex',
_rgbd2h(ReadingsVal($name, 'a_'.$anum.'_eventCode_AREA_COLOR', '')));};
readingsEndUpdate($hash, 1); readingsEndUpdate($hash, 1);
eval {readingsSingleUpdate($hash, 'a_'.$anum.'_eventCode_AREA_COLOR_hex', _rgbd2h(ReadingsVal($name, 'a_'.$anum.'_eventCode_AREA_COLOR', '')),0);};
return; return;
} }
@ -854,49 +824,31 @@ sub findCAPWarnCellId($$){
} }
} }
sub retrieveText($$$) {
my ($hash, $fileName, $separator) = @_;
my $name = $hash->{NAME};
my ($line, @a);
open WXDATA, $tempDir.$name."_".$fileName;
while (chomp($line = <WXDATA>)) {
push @a, latin1ToUtf8($line); }
close WXDATA;
return join($separator, @a);
}
sub retrieveTextWarn($){
my ($hash) = @_;
return retrieveText($hash, "warnings", "");
}
sub retrieveConditions($$@){ sub retrieveConditions($$@){
my ($hash, $prefix, @a) = @_; my ($hash, $prefix, @a) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $user = $hash->{helper}{USER};
my $pass = $hash->{helper}{PASS};
(my $myStation = utf8ToLatin1($a[2])) =~ s/_/ /g; # replace underscore in stationName by space (my $myStation = utf8ToLatin1($a[2])) =~ s/_/ /g; # replace underscore in stationName by space
my $searchLen = length($myStation); my $searchLen = length($myStation);
my ($debug, $dataFile, $found, $line, $item, %pos, %alignment, %wx, %cread, $k, $v); my ($line, $item, %pos, %alignment, %wx, %cread, $k, $v);
$debug = AttrVal($name, "gdsDebug", 0);
Log3($name, 4, "GDS $name: Retrieving conditions data"); Log3($name, 4, "GDS $name: Retrieving conditions data");
retrieveFile($hash,"conditions",undef,undef);
($dataFile, $found) = retrieveFile($hash,"conditions",undef,undef); my $fileName = $tempDir.$name."_conditions";
open WXDATA, $tempDir.$name."_conditions"; my ($err,@file) = FileRead({FileName=>$fileName,ForceType=>"file" });
while (chomp($line = <WXDATA>)) { return "GDS error reading $fileName" if($err);
map {s/\r//g;} ($line);
if ($line =~ /Station/) { # Header line... find out data positions foreach my $l (@file) {
@a = split(/\s+/, $line); $line = $l; # save line for further use
if ($l =~ /Station/) { # Header line... find out data positions
@a = split(/\s+/, $l);
foreach $item (@a) { foreach $item (@a) {
$pos{$item} = index($line, $item); $pos{$item} = index($line, $item);
} }
} }
if (index(substr(lc($line),0,$searchLen), substr(lc($myStation),0,$searchLen)) != -1) { last; } if (index(substr(lc($line),0,$searchLen), substr(lc($myStation),0,$searchLen)) != -1) { last; }
} }
close WXDATA;
%alignment = ("Station" => "l", "H\xF6he" => "r", "Luftd." => "r", "TT" => "r", "Tn12" => "r", "Tx12" => "r", %alignment = ("Station" => "l", "H\xF6he" => "r", "Luftd." => "r", "TT" => "r", "Tn12" => "r", "Tx12" => "r",
"Tmin" => "r", "Tmax" => "r", "Tg24" => "r", "Tn24" => "r", "Tm24" => "r", "Tx24" => "r", "SSS24" => "r", "SGLB24" => "r", "Tmin" => "r", "Tmax" => "r", "Tg24" => "r", "Tn24" => "r", "Tm24" => "r", "Tx24" => "r", "SSS24" => "r", "SGLB24" => "r",
@ -938,25 +890,50 @@ sub retrieveConditions($$@){
$cread{$prefix."_stationName"} = "unknown: $myStation"; $cread{$prefix."_stationName"} = "unknown: $myStation";
} }
# CommandDeleteReading(undef, "$name $prefix"."_.*");
readingsBeginUpdate($hash); readingsBeginUpdate($hash);
while (($k, $v) = each %cread) { while (($k, $v) = each %cread) {
readingsBulkUpdate($hash, $k, latin1ToUtf8($v)) if(defined($v)); } # skip update if no valid data is available
unless(defined($v)) {delete($defs{$name}{READINGS}{$k}); next;}
if($v =~ m/^--/) {delete($defs{$name}{READINGS}{$k}); next;};
unless(length(trim($v))) {delete($defs{$name}{READINGS}{$k}); next;};
readingsBulkUpdate($hash, $k, latin1ToUtf8($v));
}
readingsEndUpdate($hash, 1); readingsEndUpdate($hash, 1);
return ; return ;
} }
sub retrieveFile($$;$$){ sub retrieveFile($$$$){
# #
# request = type, e.g. alerts, conditions, warnings # request = type, e.g. alerts, conditions, warnings
# parameter = additional selector, e.g. Bundesland # parameter = additional selector, e.g. Bundesland
# #
my ($hash, $request, $parameter, $parameter2) = @_; my ($hash, $request, $parameter, $parameter2) = @_;
$hash->{helper}{request} = $request;
$hash->{helper}{parameter} = $parameter;
$hash->{helper}{parameter2} = $parameter2;
BlockingCall('_retrieveFile',$hash,undef,60,undef,undef);
delete $hash->{helper}{request};
delete $hash->{helper}{parameter};
delete $hash->{helper}{parameter2};
return(undef,undef);
}
sub _retrieveFile($){
my ($hash) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $user = $hash->{helper}{USER}; my $user = $hash->{helper}{USER};
my $pass = $hash->{helper}{PASS}; my $pass = $hash->{helper}{PASS};
my $request = $hash->{helper}{request};
my $parameter = $hash->{helper}{parameter};
my $parameter2 = $hash->{helper}{parameter2};
# my $debugString = "r: $request ";
# $debugString .= "p: $parameter " if(defined($parameter) && length($parameter));
# $debugString .= "p2: $parameter2 " if(defined($parameter2) && length($parameter2));
# Debug $debugString;
my $proxyName = AttrVal($name, "gdsProxyName", ""); my $proxyName = AttrVal($name, "gdsProxyName", "");
my $proxyType = AttrVal($name, "gdsProxyType", ""); my $proxyType = AttrVal($name, "gdsProxyType", "");
my $passive = AttrVal($name, "gdsPassiveFtp", 0); my $passive = AttrVal($name, "gdsPassiveFtp", 0);
@ -1079,30 +1056,29 @@ sub retrieveFile($$;$$){
readingsBeginUpdate($hash); readingsBeginUpdate($hash);
readingsBulkUpdate($hash, "_dataSource", "Quelle: Deutscher Wetterdienst"); readingsBulkUpdate($hash, "_dataSource", "Quelle: Deutscher Wetterdienst");
readingsBulkUpdate($hash, "_dF_".$request, $dataFile) if(AttrVal($name, "gdsDebug", 0)); readingsBulkUpdate($hash, "_dF_".$request, $dataFile) if(AttrVal($name, "gdsDebug", 0));
readingsEndUpdate($hash, 1); readingsEndUpdate($hash, 0);
}; };
return ($dataFile, $found); return ($hash);
} }
sub getListStationsDropdown($){ sub getListStationsDropdown($){
my ($hash) = @_; my ($hash) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my ($line, $liste, @a); my ($line, $liste);
my $filename = $tempDir.$name."_conditions"; my $fileName = $tempDir.$name."_conditions";
return unless -e $filename; return unless -e $fileName;
my $filesize = -s $filename; my $filesize = -s $fileName;
return unless $filesize != 0; return unless $filesize != 0;
open WXDATA, $filename; my ($err,@a) = FileRead({FileName=>$fileName,ForceType=>"file" });
while (chomp($line = <WXDATA>)) { return "GDS error reading $fileName" if($err);
push @a, trim(substr(latin1ToUtf8($line),0,19)); @a = map (trim(substr(latin1ToUtf8($_),0,19)), @a);
}
close WXDATA;
# delete header lines
splice(@a,0,6); splice(@a,0,6);
splice(@a,first_index { /Höhe/ } @a); # delete legend
splice(@a,-1); splice(@a,(first_index { /Höhe/ } @a)-1);
@a = sort(@a); @a = sort(@a);
$sList = join(",", @a); $sList = join(",", @a);
@ -1337,6 +1313,9 @@ sub initDropdownLists($){
# fill $sList # fill $sList
getListStationsDropdown($hash) if(-e $tempDir.$name."_conditions"); getListStationsDropdown($hash) if(-e $tempDir.$name."_conditions");
# fill $fList
getListForecastStationsDropdown($hash) if(-e $tempDir.$name."_forecasts");
return; return;
} }
@ -1354,7 +1333,11 @@ sub gdsHeadlines($;$) {
sub _readDir($) { sub _readDir($) {
my ($destinationDirectory) = @_; my ($destinationDirectory) = @_;
opendir(DIR,$destinationDirectory) or warn "$!"; eval { opendir(DIR,$destinationDirectory) or warn "$!"; };
if ($@) {
Log3(undef,1,'GDS: file system error '.$@);
return ("");
}
my @files = readdir(DIR); my @files = readdir(DIR);
close(DIR); close(DIR);
return @files; return @files;
@ -1436,6 +1419,13 @@ sub mergeCapFile($) {
# forecast retrieval # forecast retrieval
# provided by jensb # provided by jensb
# #
# improved by betateilchen
# - use FileRead instead of own I/O
# - do not set empty readings
# - allow temperature readings below zero degree
# - read forecasts on startup if attr gdsSetForecasts already defined before
# - delete all fc_.* readings in case of new station selection
#
#################################################################################################### ####################################################################################################
sub retrieveForecasts($$@) { sub retrieveForecasts($$@) {
@ -1455,12 +1445,14 @@ sub retrieveForecasts($$@){
if ($i <= 0 ) { if ($i <= 0 ) {
return; return;
} }
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
my ($dataFile, $found, $line, %fread, $k, $v);
my $area = utf8ToLatin1(substr($a[2], 0, $i)); my $area = utf8ToLatin1(substr($a[2], 0, $i));
my $station = utf8ToLatin1(substr($a[2], $i+1)); my $station = utf8ToLatin1(substr($a[2], $i+1));
$station =~ s/_/ /g; # replace underscore in station name by space $station =~ s/_/ /g; # replace underscore in station name by space
my $searchLen = length($station); my $searchLen = length($station);
%fread = ();
my ($dataFile, $found, $line, %fread, $k, $v);
# define fetch scope (all forecasts or single forecast) # define fetch scope (all forecasts or single forecast)
my $fc = 0; my $fc = 0;
@ -1471,10 +1463,6 @@ sub retrieveForecasts($$@){
$fcStep = 10; $fcStep = 10;
} }
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
%fread = ();
# fetch up to 10 forecasts for today and the next 3 days # fetch up to 10 forecasts for today and the next 3 days
do { do {
my $day; my $day;
@ -1538,13 +1526,13 @@ sub retrieveForecasts($$@){
$copyTimeLabel = '24'; $copyTimeLabel = '24';
} }
} }
} } # if ($day == 0) {
# define forecast date (based on "now" + day) # define forecast date (based on "now" + day)
my $fcEpoch = time() + $day*24*60*60; my $fcEpoch = time() + $day*86400;
if ($fc == 3) { if ($fc == 3) {
# night continues at next day # night continues at next day
$fcEpoch += 24*60*60; $fcEpoch += 86400;
} }
my ($fcSec,$fcMin,$fcHour,$fcMday,$fcMon,$fcYear,$fcWday,$fcYday,$fcIsdst) = localtime($fcEpoch); my ($fcSec,$fcMin,$fcHour,$fcMday,$fcMon,$fcYear,$fcWday,$fcYday,$fcIsdst) = localtime($fcEpoch);
my $fcWeekday = $weekdays[$fcWday]; my $fcWeekday = $weekdays[$fcWday];
@ -1554,25 +1542,32 @@ sub retrieveForecasts($$@){
# FTP retrieve # FTP retrieve
my $noDataFound = 1; my $noDataFound = 1;
Log3($name, 4, "GDS $name: Retrieving forecasts data for day $day: $areaAndTime"); Log3($name, 4, "GDS $name: Retrieving forecasts data for day $day: $areaAndTime");
($dataFile, $found) = retrieveFile($hash, "forecasts", $areaAndTime, undef); retrieveFile($hash, "forecasts", $areaAndTime, undef); sleep 1;
if (open WXDATA, $tempDir.$name."_forecasts") {
while (!eof(WXDATA) && chomp($line = <WXDATA>)) { my $fileName = $tempDir.$name."_forecasts";
if (index($line, $fcDate) > 0) { my ($err,@data) = FileRead({FileName=>$fileName,ForceType=>"file" });
return "GDS error reading $fileName" if($err);
unless ($err) {
foreach my $l (@data) {
if (index($l, $fcDate) > 0) {
# forecast date found # forecast date found
$fcDateFound = 1; $fcDateFound = 1;
} } # if
if (index(substr(lc($line),0,$searchLen), substr(lc($station),0,$searchLen)) != -1) { if (index(substr(lc($l),0,$searchLen), substr(lc($station),0,$searchLen)) != -1) {
# station found # station found
$line = $l;
last; last;
} } # if
} } # foreach
close WXDATA;
# parse file # parse file
if ($fcDateFound && length($line) > 0) { if ($fcDateFound && length($line) > 0) {
if (index(substr(lc($line),0,$searchLen), substr(lc($station),0,$searchLen)) != -1) { if (index(substr(lc($line),0,$searchLen), substr(lc($station),0,$searchLen)) != -1) {
# station found but there is no header line and column width varies: # station found but there is no header line and column width varies:
$line =~ s/---/ ---/g; # column distance may drop to zero between station name and invalid temp "---" -> prepend 3 spaces $line =~ s/---/ ---/g; # column distance may drop to zero between station name
# and invalid temp "---" -> prepend 3 spaces
$line =~ s/ /;/g; # now min. column distance is 3 spaces -> convert to semicolon $line =~ s/ /;/g; # now min. column distance is 3 spaces -> convert to semicolon
$line =~ s/;+/;/g; # replace multiple consecutive semicolons by one semicolon $line =~ s/;+/;/g; # replace multiple consecutive semicolons by one semicolon
my @b = split(';', $line); # split columns by semicolon my @b = split(';', $line); # split columns by semicolon
@ -1598,7 +1593,7 @@ sub retrieveForecasts($$@){
last; last;
} }
} }
} } # unless
if ($noDataFound) { if ($noDataFound) {
# forecast period already passed or no data available # forecast period already passed or no data available
@ -1619,7 +1614,7 @@ sub retrieveForecasts($$@){
if (!defined($ltime) || $mday != $lmday) { if (!defined($ltime) || $mday != $lmday) {
# day has changed, rotate old forecast forward by one day because new forecast is not immediately available # day has changed, rotate old forecast forward by one day because new forecast is not immediately available
my $temp = $fread{$prefix.$day.$tempLabel}; my $temp = $fread{$prefix.$day.$tempLabel};
if (defined($temp) && substr($temp, 0, 1) eq '-') { if (defined($temp) && substr($temp, 0, 2) eq '--') {
if (defined($copyTimeLabel)) { if (defined($copyTimeLabel)) {
$fread{$prefix.$day.$tempLabel} = utf8ToLatin1(ReadingsVal($name, $prefix.$copyDay.$tempLabel, '---')); $fread{$prefix.$day.$tempLabel} = utf8ToLatin1(ReadingsVal($name, $prefix.$copyDay.$tempLabel, '---'));
} else { } else {
@ -1628,35 +1623,37 @@ sub retrieveForecasts($$@){
} }
} }
my $weather = $fread{$prefix.$day."_weather".$timeLabel}; my $weather = $fread{$prefix.$day."_weather".$timeLabel};
if (defined($weather) && substr($weather, 0, 1) eq '-') { if (defined($weather) && substr($weather, 0, 2) eq '--') {
if (defined($copyTimeLabel)) { if (defined($copyTimeLabel)) {
$fread{$prefix.$day."_weather".$timeLabel} = utf8ToLatin1(ReadingsVal($name, $prefix.$copyDay."_weather".$copyTimeLabel, '---')); $fread{$prefix.$day."_weather".$timeLabel} =
utf8ToLatin1(ReadingsVal($name, $prefix.$copyDay."_weather".$copyTimeLabel, '---'));
} else { } else {
# today noon/night and 3rd day is undefined # today noon/night and 3rd day is undefined
$fread{$prefix.$day."_weather".$timeLabel} = ' '; $fread{$prefix.$day."_weather".$timeLabel} = ' ';
} }
} }
my $windGust = $fread{$prefix.$day."_windGust".$timeLabel}; my $windGust = $fread{$prefix.$day."_windGust".$timeLabel};
if (defined($windGust) && substr($windGust, 0, 1) eq '-') { if (defined($windGust) && substr($windGust, 0, 2) eq '--') {
if (defined($copyTimeLabel)) { if (defined($copyTimeLabel)) {
$fread{$prefix.$day."_windGust".$timeLabel} = utf8ToLatin1(ReadingsVal($name, $prefix.$copyDay."_windGust".$copyTimeLabel, '---')); $fread{$prefix.$day."_windGust".$timeLabel} =
utf8ToLatin1(ReadingsVal($name, $prefix.$copyDay."_windGust".$copyTimeLabel, '---'));
} else { } else {
# today noon/night and 3rd day is undefined # today noon/night and 3rd day is undefined
$fread{$prefix.$day."_windGust".$timeLabel} = ' '; $fread{$prefix.$day."_windGust".$timeLabel} = ' ';
} }
} }
} }
$fc += $fcStep; $fc += $fcStep;
} while ($fc < 10); } while ($fc < 10);
readingsBeginUpdate($hash); readingsBeginUpdate($hash);
while (($k, $v) = each %fread) { while (($k, $v) = each %fread) {
# skip update if no valid data is available # skip update if no valid data is available
if (defined($v) && substr($v, 0, 1) ne '-') { unless(defined($v)) {delete($defs{$name}{READINGS}{$k}); next;}
if($v =~ m/^--/) {delete($defs{$name}{READINGS}{$k}); next;};
unless(length(trim($v))) {delete($defs{$name}{READINGS}{$k}); next;};
readingsBulkUpdate($hash, $k, latin1ToUtf8($v)); readingsBulkUpdate($hash, $k, latin1ToUtf8($v));
} }
}
readingsEndUpdate($hash, 1); readingsEndUpdate($hash, 1);
} }
@ -1668,10 +1665,12 @@ sub getListForecastStationsDropdown($) {
my @regions = keys(%rmapList); my @regions = keys(%rmapList);
foreach (@regions) { foreach (@regions) {
my $areaAndTime = $_.'_morgen_spaet'; my $areaAndTime = $_.'_morgen_spaet';
my ($dataFile, $found) = retrieveFile($hash, "forecasts", $areaAndTime, undef); retrieveFile($hash, "forecasts", $areaAndTime, undef);
if (open WXDATA, $tempDir.$name."_forecasts") { my $fileName = $tempDir.$name."_forecasts";
my ($err,@data) = FileRead({FileName=>$fileName,ForceType=>"file" });
return "GDS error reading $fileName" if($err);
my $lineCount = 0; my $lineCount = 0;
while (chomp(my $line = <WXDATA>)) { foreach my $line (@data) {
# skip header lines # skip header lines
$lineCount++; $lineCount++;
if ($lineCount > 2) { if ($lineCount > 2) {
@ -1688,21 +1687,19 @@ sub getListForecastStationsDropdown($) {
push @a, $_.'/'.$b[0]; # concat region name and station name (1st column) push @a, $_.'/'.$b[0]; # concat region name and station name (1st column)
} }
} }
} } # foreach @data
close WXDATA; } # foreach @regions
}
}
if (!@a) { if (!@a) {
Log3($name, 4, "GDS $name: Error: unable to open forecast file!"); Log3($name, 4, "GDS $name: error: unable to read forecast data");
} }
@a = sort(@a); @a = sort(@a);
my $liste = join(",", @a);
$liste =~ s/\s+,/,/g; # replace multiple spaces followed by comma with comma
$liste =~ s/\s/_/g; # replace spaces in stationName with underscore for list in frontend
return $liste; $fList = join(",", @a);
$fList =~ s/\s+,/,/g; # replace multiple spaces followed by comma with comma
$fList =~ s/\s/_/g; # replace spaces in stationName with underscore for list in frontend
return;
} }
#################################################################################################### ####################################################################################################
@ -2079,7 +2076,9 @@ sub GDSAsHtmlD($;$) {
# added forecast retrieval # added forecast retrieval
# added weblink generator # added weblink generator
# added more "set clear ..." commands # added more "set clear ..." commands
# done a lot of code cleanup # done lots and lots of code cleanup
#
# feature MAKE retrieveFile() NONBLOCKING (experimental) :-)
# #
#################################################################################################### ####################################################################################################
# #