From 988899df41c986b756a0b3c73b3fe121ad854b20 Mon Sep 17 00:00:00 2001 From: herrmannj <> Date: Mon, 10 Feb 2020 23:32:50 +0000 Subject: [PATCH] 59_GSI.pm: initial check-in git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@21172 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- FHEM/59_GSI.pm | 725 +++++++++++++++++++++++++++++++++++++++++++++++++ fhem.cfg | 36 ++- 2 files changed, 759 insertions(+), 2 deletions(-) create mode 100644 FHEM/59_GSI.pm diff --git a/FHEM/59_GSI.pm b/FHEM/59_GSI.pm new file mode 100644 index 000000000..cf60fec3b --- /dev/null +++ b/FHEM/59_GSI.pm @@ -0,0 +1,725 @@ +# $Id$ +############################################################################### +# +# 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 utf8; +use Time::HiRes qw( gettimeofday tv_interval ); +use HttpUtils; + +sub GSI_Initialize { + my ($hash) = @_; + + $hash->{'DefFn'} = 'GSI_Define'; + $hash->{'UndefFn'} = 'GSI_Undef'; + $hash->{'NotifyFn'} = 'GSI_Notify'; + $hash->{'FW_detailFn'} = 'GSI_FW_detailFn'; + $hash->{'AttrList'} = "$readingFnAttributes "; + $hash->{'NOTIFYDEV'} = 'TYPE=Global'; + return undef; +}; + +sub GSI_Define { + my ($hash, $def) = @_; + my ($name, $type, $plz) = split /\s/, $def; + + my $cvsid = '$Id$'; + + return "German ZIP code required" unless ($plz =~ m/\d{5}/); + $hash->{'ZIP'} = $plz; + $hash->{'SVN'} = $cvsid; + + $attr{$name}{'devStateIcon'} = '{GSI::devStateIcon($name)}'; + GSI_Run($hash) if ($init_done); + return undef; +}; + +sub GSI_Undef { + my ($hash) = @_; + + RemoveInternalTimer($hash, \&GSI_ApiRequest); + RemoveInternalTimer($hash, \&GSI_doReadings); + return undef; +}; + +sub GSI_Notify { + my ($hash, $dev) = @_; + my $name = $hash->{'NAME'}; + return undef if(IsDisabled($name)); + + my $events = deviceEvents($dev, 1); + return if(!$events); + + foreach my $event (@{$events}) { + my @e = split /\s/, $event; + Log3 ($name, 5, sprintf('[%s] event:[%s], device:[%s]', $name, $event, $dev->{'NAME'})); + if ($dev->{'TYPE'} eq 'Global') { + if ($e[0] and $e[0] eq 'INITIALIZED') { + GSI_Run($hash); + }; + }; + }; +}; + +sub GSI_FW_detailFn { + my ($FW_wname, $name, $FW_room) = @_; + my $hash = $defs{$name}; + + my $ret; + + if (exists($hash->{'forecast'}) and scalar @{$hash->{'forecast'}}) { + my $fc = $hash->{'forecast'}; + + $ret = '
'; + $ret .= sprintf(<<'HTML', 'Zeit', 'Index (EE)', 'Co2 (EE)', 'Co2 (Std.Mix)'); + + + + + +HTML + $ret .= ''; + my $i = 0; + foreach my $e (@{$fc}) { + last if ($i++ == 24); + my $p0 = ($i % 2 == 1)?'odd':'even'; + my $p1 = POSIX::strftime('%a %R (%D)', localtime($e->{'epochtime'})); + my $p2 = $e->{'eevalue'}; + my $p3 = $e->{'co2_g_oekostrom'}; + my $p4 = $e->{'co2_g_standard'}; + $ret .= sprintf(<<'HTML', $p0, $p1, $i, $p2, $i, $p3, $i, $p4); + + + + + + +HTML + }; + return "$ret
%s
%s
%s
%s
+
%s
%i
%s g/kWh
%s g/kWh
"; + }; +}; + +sub GSI_Run { + my ($hash) = @_; + GSI_ApiRequest($hash); + return undef; +}; + +sub GSI_doReadings { + my ($hash) = @_; + + $hash->{'NEXT_EVENT'} = undef; + + if (exists($hash->{'forecast'}) and (ref($hash->{'forecast'}) eq 'ARRAY') + and (scalar @{$hash->{'forecast'}} > 1)) { + + my $fc = $hash->{'forecast'}; + my $t = gettimeofday(); + + while ((scalar @{$hash->{'forecast'}} > 1) and ($t > $fc->[1]->{'epochtime'})) { + shift @{$fc}; + }; + return undef if (not scalar @{$hash->{'forecast'}} > 1); + + + my sub linearInterpolate { + my ($x, $x1, $x2, $y1, $y2) = @_; + # eval for safety reasons, in case json input is broken + eval { + my $m = ($x - $x1) / ($x2 - $x1); + my $r = ($y1 * (1 - $m) + $y2 * $m); + # negativ clipping + $r = 0 if ($r < 0); + return $r; + 1; + } or do { + Log3 ($hash, 2, sprintf('[%s] GSI LinearInterpolate error: %s', $hash->{'NAME'}, $@)); + return $y1; + }; + }; + + # right after start the actual hour is not available + # create a 'fake' entry based on backward projection of hr+2 and hr+1 + if ($t < $fc->[0]->{'epochtime'}) { + my $e; + # easy way to get the last full hr + $e->{'epochtime'} = $fc->[0]->{'epochtime'} - 3600; + $e->{'eevalue'} = linearInterpolate($e->{'epochtime'}, $fc->[0]->{'epochtime'}, + $fc->[1]->{'epochtime'}, $fc->[0]->{'eevalue'}, $fc->[1]->{'eevalue'}); + # clipping + $e->{'eevalue'} = 100 if ($e->{'eevalue'} >100); + $e->{'co2_g_oekostrom'} = linearInterpolate($e->{'epochtime'}, $fc->[0]->{'epochtime'}, + $fc->[1]->{'epochtime'}, $fc->[0]->{'co2_g_oekostrom'}, $fc->[1]->{'co2_g_oekostrom'}); + $e->{'co2_g_standard'} = linearInterpolate($e->{'epochtime'}, $fc->[0]->{'epochtime'}, + $fc->[1]->{'epochtime'}, $fc->[0]->{'co2_g_standard'}, $fc->[1]->{'co2_g_standard'}); + unshift @{$fc}, $e; + }; + + my sub readingsBulkUpdateGSI { + my ($readingName, $dataName) = @_; + my $val = linearInterpolate($t, $fc->[0]->{'epochtime'}, + $fc->[1]->{'epochtime'}, $fc->[0]->{$dataName}, $fc->[1]->{$dataName}); + my $diff = abs(ReadingsVal($hash->{'NAME'}, $readingName, 0) - $val); + if ($diff >= 1) { + readingsBulkUpdate($hash, $readingName, sprintf('%.f', $val)); + }; + }; + + readingsBeginUpdate($hash); + readingsBulkUpdateGSI('state', 'eevalue'); + readingsBulkUpdateGSI('oeko_co2', 'co2_g_oekostrom'); + readingsBulkUpdateGSI('standard_co2', 'co2_g_standard'); + readingsEndUpdate($hash, 1); + + my sub calcNext { + my ($id, $timeframe) = @_; + if (my $s = abs($fc->[0]->{$id} - $fc->[1]->{$id})) { + # stepwide in sec + my $p0 = $timeframe / $s; + # time spend in timeframe div stepwide + my $p1 = (($t - $fc->[0]->{'epochtime'}) / $p0); + # time to next + return $p0 - (($p1 - int($p1)) * $p0); + } else { + return $timeframe; + }; + }; + + my $next = 3600; + foreach my $item ('eevalue', 'co2_g_oekostrom', 'co2_g_standard') { + my $n = calcNext($item, 3600); + $next = $n if ($n < $next); + }; + $hash->{'NEXT_EVENT'} = int($t + $next); + InternalTimer($t + $next, \&GSI_doReadings, $hash); + }; + + return undef; +}; + +sub GSI_ApiRequest { + my ($hash) = @_; + my $plz = $hash->{'ZIP'}; + my $param = { + 'hash' => $hash, + 'url' => "https://api.corrently.io/core/gsi?plz=$plz", + 'timeout' => 30, + 'callback' => \&GSI_ApiResponse + }; + HttpUtils_NonblockingGet($param); +}; + +sub GSI_ApiResponse { + my ($param, $err, $data) = @_; + my $hash = $param->{hash}; + + $hash->{'API__LAST_RES'} = int(gettimeofday()); + + my sub doError { + my ($msg) = @_; + $hash->{'API__LAST_MSG'} = $msg; + my $next = gettimeofday() + 600; + $hash->{'API__NEXT_REQ'} = $next; + return InternalTimer($next, \&GSI_ApiRequest, $hash); + }; + + # in case of error + if ($err) { + return doError($err); + }; + + my $rs = GSI::JSON::StreamReader->new()->parse($data); + if (not $rs or (ref($rs) ne 'HASH')) { + return doError('invalid server response'); + }; + # no plz, message "Internal server error" + if (exists($rs->{'message'}) and $rs->{'message'} =~ m/error/) { + return doError($rs->{'message'}); + } elsif ((exists($rs->{'forecast'}) and ref($rs->{'forecast'}) eq 'ARRAY') + and scalar @{$rs->{'forecast'}}) { + my $fc = $rs->{'forecast'}; + $hash->{'API__LAST_MSG'} = sprintf ('ok with %s items', scalar @{$fc}); + # sort for safety reasons + @{$fc} = sort {$a->{'epochtime'} <=> $b->{'epochtime'}} @{$fc}; + # insert actual + if (exists($hash->{'forecast'}) and (ref($hash->{'forecast'}) eq 'ARRAY')) { + my $e; + while ($e = shift @{$hash->{'forecast'}} + and ($e->{'epochtime'} < $fc->[0]->{'epochtime'})) { + unshift @{$fc}, $e; + }; + }; + # store it + $hash->{'forecast'} = $fc; + + # schedule + my $next = (int(gettimeofday() / 3600) * 3600) + (3600 + 1800 + int(rand(1200))); + $hash->{'API__NEXT_REQ'} = $next; + InternalTimer($next, \&GSI_ApiRequest, $hash); + + if ($hash->{'NEXT_EVENT'} and $hash->{'NEXT_EVENT'} > gettimeofday()) { + return undef; + } else { + RemoveInternalTimer($hash, \&GSI_doReadings); + GSI_doReadings($hash); + return undef; + }; + } else { + return doError('invalid server response'); + }; + return doError('unknown'); +}; + +############################################################################### +package GSI; + +use strict; +use warnings; +use utf8; + +use Carp qw( longmess cluck confess ); + +sub devStateIcon { + my ($name, $icon) = @_; + $icon //= 'message_socket_on_off'; + my $gsi = main::ReadingsVal($name, 'state', 0); + return $gsi if (not $icon); + + if ($gsi < 40) { + return ".*:$icon\@black"; + } elsif ($gsi < 60) { + return ".*:$icon\@orange"; + } else { + return ".*:$icon\@green"; + #return ".*:message_socket_on_off\@green"; + }; +}; + +sub greenPower { + my ($name, $duration, $timeframe) = @_; + + ($duration) = ($duration||'2' =~ m/^(\d+)$/); + ($timeframe) = ($timeframe||'12' =~ m/^(\d+)$/); + + if (not $duration or not $timeframe) { + main::Log3(undef, 2, sprintf('GSI::greenPower usage: devicename, duration, timeframe')); + return undef; + }; + $timeframe = ($timeframe > 24)?24:$timeframe; + $duration = ($duration > $timeframe)?$timeframe:$duration; + + if ($name and exists($main::defs{$name})) { + my $hash = $main::defs{$name}; + if (exists($hash->{'forecast'}) and (ref($hash->{'forecast'}) eq 'ARRAY') + and (scalar @{$hash->{'forecast'}} > 1)) { + my $fc = $hash->{'forecast'}; + my $ds = scalar @{$hash->{'forecast'}}; + + if ($timeframe >= $ds) { + return greenPower($name, $duration, $ds -1); + }; + + my %list; + for (my $i=1; $i <= ($timeframe - $duration +1); $i++) { + my $r = 0; + for (my $j=0; $j < ($duration); $j++) { + $r += $fc->[$i + $j]->{'eevalue'}; + }; + $list{$fc->[$i]->{'epochtime'}} = $r; + }; + my @timelist; + foreach my $ts (sort { $list{$a} <=> $list{$b} } keys %list) { + push @timelist, POSIX::strftime ('%H:%M', localtime($ts)); + @timelist = reverse @timelist; + }; + if (wantarray) { + return @timelist; + } elsif (defined(wantarray)) { + return $timelist[0]; + }; + }; + }; + return undef; +}; + + +############################################################################### +# credits to David Oswald +# http://cpansearch.perl.org/src/DAVIDO/JSON-Tiny-0.58/lib/JSON/Tiny.pm +package GSI::JSON::StreamWriter; + +use strict; +use warnings; +use utf8; +use B; + +my ($escape, $reverse); + +BEGIN { + eval "use JSON::XS;1;" or do { + if (not $main::_JSON_PP_WARN) { + main::Log3 (undef, 3, sprintf('json [%s] is PP. Consider installing JSON::XS', __PACKAGE__)); + $main::_JSON_PP_WARN = 1; + }; + }; +}; + +BEGIN { + %{$escape} = ( + '"' => '"', + '\\' => '\\', + '/' => '/', + 'b' => "\x08", + 'f' => "\x0c", + 'n' => "\x0a", + 'r' => "\x0d", + 't' => "\x09", + 'u2028' => "\x{2028}", + 'u2029' => "\x{2029}" + ); + %{$reverse} = map { $escape->{$_} => "\\$_" } keys %{$escape}; + for(0x00 .. 0x1f) { + my $packed = pack 'C', $_; + $reverse->{$packed} = sprintf '\u%.4X', $_ unless defined $reverse->{$packed}; + }; +}; + +sub new { + my $class = shift; + my $self = {}; + bless $self, $class; + return $self; +}; + +sub parse { + my ($self, $data) = @_; + my $stream; + + # use JSON::XS if available + my $xs = eval 'JSON::XS::encoode_json($data)'; + return $xs if ($xs); + + if (my $ref = ref $data) { + use Encode; + return Encode::encode_utf8($self->addValue($data)); + }; +}; + +sub addValue { + my ($self, $data) = @_; + if (my $ref = ref $data) { + return $self->addONode($data) if ($ref eq 'HASH'); + return $self->addANode($data) if ($ref eq 'ARRAY'); + }; + return 'null' unless defined $data; + return $data + if B::svref_2object(\$data)->FLAGS & (B::SVp_IOK | B::SVp_NOK) + # filter out "upgraded" strings whose numeric form doesn't strictly match + && 0 + $data eq $data + # filter out inf and nan + && $data * 0 == 0; + # String + return $self->addString($data); +}; + +sub addString { + my ($self, $str) = @_; + $str =~ s!([\x00-\x1f\x{2028}\x{2029}\\"/])!$reverse->{$1}!gs; + return "\"$str\""; +}; + +sub addONode { + my ($self, $object) = @_; + my @pairs = map { $self->addString($_) . ':' . $self->addValue($object->{$_}) } + sort keys %$object; + return '{' . join(',', @pairs) . '}'; +}; + +sub addANode { + my ($self, $array) = @_; + return '[' . join(',', map { $self->addValue($_) } @{$array}) . ']'; +}; + +############################################################################### +# credits to David Oswald +# http://cpansearch.perl.org/src/DAVIDO/JSON-Tiny-0.58/lib/JSON/Tiny.pm +package GSI::JSON::StreamReader; +use strict; +use warnings; +use utf8; + +BEGIN { + eval "use JSON::XS;1;" or do { + if (not $main::_JSON_PP_WARN) { + main::Log3 (undef, 3, sprintf('json [%s] is PP. Consider installing JSON::XS', __PACKAGE__)); + $main::_JSON_PP_WARN = 1; + }; + }; +}; + +sub new { + my $class = shift; + my $self = {}; + bless $self, $class; + return $self; +}; + +sub parse { + my ($self, $in) = @_; + my $TRUE = 1; + my $FALSE = 0; + + local *exception = sub { + my ($e) = @_; + # Leading whitespace + m/\G[\x20\x09\x0a\x0d]*/gc; + # Context + my $context = 'Malformed JSON: ' . shift; + if (m/\G\z/gc) { + $context .= ' before end of data'; + } else { + my @lines = split "\n", substr($_, 0, pos); + $context .= ' at line ' . @lines . ', offset ' . length(pop @lines || ''); + }; + die "$context"; + }; + + local *_decode_string = sub { + my $pos = pos; + + # Extract string with escaped characters + m!\G((?:(?:[^\x00-\x1f\\"]|\\(?:["\\/bfnrt]|u[0-9a-fA-F]{4})){0,32766})*)!gc; # segfault on 5.8.x in t/20-mojo-json.t + my $str = $1; + + # Invalid character + unless (m/\G"/gc) { #" + exception('Unexpected character or invalid escape while parsing string') + if m/\G[\x00-\x1f\\]/; + exception('Unterminated string'); + }; + + # Unescape popular characters + if (index($str, '\\u') < 0) { + #no warnings; + $str =~ s!\\(["\\/bfnrt])!$self->{'ESCAPE'}->{$1}!gs; + return $str; + }; + + # Unescape everything else + my $buffer = ''; + while ($str =~ m/\G([^\\]*)\\(?:([^u])|u(.{4}))/gc) { + $buffer .= $1; + # Popular character + if ($2) { + $buffer .= $self->{'ESCAPE'}->{$2}; + } else { # Escaped + my $ord = hex $3; + # Surrogate pair + if (($ord & 0xf800) == 0xd800) { + # High surrogate + ($ord & 0xfc00) == 0xd800 + or pos($_) = $pos + pos($str), exception('Missing high-surrogate'); + # Low surrogate + $str =~ m/\G\\u([Dd][C-Fc-f]..)/gc + or pos($_) = $pos + pos($str), exception('Missing low-surrogate'); + $ord = 0x10000 + ($ord - 0xd800) * 0x400 + (hex($1) - 0xdc00); + }; + # Character + $buffer .= pack 'U', $ord; + }; + }; + # The rest + return $buffer . substr $str, pos $str, length $str; + }; + + local *_decode_object = sub { + my %hash; + until (m/\G[\x20\x09\x0a\x0d]*\}/gc) { + # Quote + m/\G[\x20\x09\x0a\x0d]*"/gc + or exception('Expected string while parsing object'); + # Key + my $key = _decode_string(); + # Colon + m/\G[\x20\x09\x0a\x0d]*:/gc + or exception('Expected colon while parsing object'); + # Value + $hash{$key} = _decode_value(); + # Separator + redo if m/\G[\x20\x09\x0a\x0d]*,/gc; + # End + last if m/\G[\x20\x09\x0a\x0d]*\}/gc; + # Invalid character + exception('Expected comma or right curly bracket while parsing object'); + }; + return \%hash; + }; + + local *_decode_array = sub { + my @array; + until (m/\G[\x20\x09\x0a\x0d]*\]/gc) { + # Value + push @array, _decode_value(); + # Separator + redo if m/\G[\x20\x09\x0a\x0d]*,/gc; + # End + last if m/\G[\x20\x09\x0a\x0d]*\]/gc; + # Invalid character + exception('Expected comma or right square bracket while parsing array'); + }; + return \@array; + }; + + local *_decode_value = sub { + # Leading whitespace + m/\G[\x20\x09\x0a\x0d]*/gc; + # String + return _decode_string() if m/\G"/gc; + # Object + return _decode_object() if m/\G\{/gc; + # Array + return _decode_array() if m/\G\[/gc; + # Number + # jh: failed with 0123 + #my ($i) = /\G([-]?(?:0(?!\d)|[1-9][0-9]*)(?:\.[0-9]*)?(?:[eE][+-]?[0-9]+)?)/gc; + my ($i) = /\G(?=.)([+-]?([0-9]*)(\.([0-9]+))?)([eE][+-]?\d+)?/gc; + return 0 + $i if defined $i; + # True + { no warnings; + return $TRUE if m/\Gtrue/gc; + # False + return $FALSE if m/\Gfalse/gc; + }; + # Null + return undef if m/\Gnull/gc; ## no critic (return) + # Invalid character + exception('Expected string, array, object, number, boolean or null'); + }; + + local *_decode = sub { + my $valueref = shift; + eval { + # Missing input + die "Missing or empty input\n" unless length( local $_ = shift ); + # UTF-8 + $_ = eval { Encode::decode('UTF-8', $_, 1) } unless shift; + die "Input is not UTF-8 encoded\n" unless defined $_; + # Value + $$valueref = _decode_value(); + # Leftover data + return m/\G[\x20\x09\x0a\x0d]*\z/gc || exception('Unexpected data'); + } ? return undef : chomp $@; + return $@; + }; + + # use JSON::XS if available + my $xs = eval 'JSON::XS::decode_json($in)'; + return $xs if ($xs); + + my $err = _decode(\my $value, $in, 1); + return defined $err ? $err : $value; +}; + +1; + +=pod +=item helper +=item summary green power index (Energy and carbon consumption) +=item summary_DE Gruen Strom Index (Energie und Co2) +=begin html + + +

GSI

+ +=end html + +=cut \ No newline at end of file diff --git a/fhem.cfg b/fhem.cfg index b23d34fae..1f3b1b3a1 100644 --- a/fhem.cfg +++ b/fhem.cfg @@ -1,17 +1,49 @@ +attr global userattr MQTT2_Legacy:textField-long cmdIcon devStateIcon:textField-long devStateStyle icon sortby webCmd webCmdLabel:textField-long widgetOverride +attr global autoload_undefined_devices 1 +attr global autosave 0 +attr global dnsServer 192.168.178.1 attr global logfile ./log/fhem-%Y-%m.log attr global modpath . -attr global verbose 3 +attr global motd SecurityCheck:\ + WEB is not password protected\ +\ +Protect this FHEM installation by defining an allowed device with define allowed allowed\ +You can disable this message with attr global motd none attr global statefile ./log/fhem.save +attr global verbose 3 define WEB FHEMWEB 8083 global +setuuid WEB 5e29fd90-f33f-a6e8-e33d-0056ae0507d8dcd0 # Fake FileLog entry, to access the fhem log from FHEMWEB define Logfile FileLog ./log/fhem-%Y-%m.log fakelog +setuuid Logfile 5e29fd90-f33f-a6e8-ea27-4944d78843a5a03d define autocreate autocreate +setuuid autocreate 5e29fd90-f33f-a6e8-3940-e9630ce6765699fe +attr autocreate disable 1 attr autocreate filelog ./log/%NAME-%Y.log define eventTypes eventTypes ./log/eventTypes.txt +setuuid eventTypes 5e29fd90-f33f-a6e8-2145-989814a73d0ef7d6 # Disable this to avoid looking for new USB devices on startup -define initialUsbCheck notify global:INITIALIZED usb create +define initialUsbCheck notify global:INITIALIZED usb create +setuuid initialUsbCheck 5e29fd90-f33f-a6e8-9def-f6855cfd0b19e6f5 +attr initialUsbCheck disable 1 +define t2 dummy +setuuid t2 5e2a25db-f33f-a6e8-afa5-0b1ca2ff2d1d7848 +attr t2 MQTT2_Legacy publish: "state", "home/test/$NAME/state", "$VAL";; +attr t2 alias dummy alias +attr t2 readingList r1 r2 r3 +attr t2 setList r1 r2 r3 +define mqtt MQTT2_CLIENT fhem0:1883 +setuuid mqtt 5e2f63f0-f33f-a6e8-f643-3f10a9efac8339aa +attr mqtt autocreate no +attr mqtt verbose 4 +define test MQTT2_Legacy mqtt +setuuid test 5e3045c0-f33f-a6e8-7596-6cb8d48320413398 +attr test IODev mqtt +define gsi GSI 22145 +setuuid gsi 5e3dc9c5-f33f-a6e8-d4a1-7b6777d75612f761 +attr gsi devStateIcon {GSI::devStateIcon($name)}