# $Id$ ################################################################ # # This script 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 # 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 textfile 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. # ################################################################ package main; use strict; use warnings; use Config; use HttpUtils; my %fhemInfo =(); sub fheminfo2_Initialize($$) { my %hash = ( Fn => "CommandFheminfo2", uri => "http://fhem.j65.de/stats/statistics2.cgi", Hlp => "[send],show or send Fhem statistics", ); $cmds{fheminfo2} = \%hash; } sub CommandFheminfo2($$) { my ($cl,$param) = @_; my @args = split("[ \t]+", $param); $args[0] = defined($args[0]) ? lc($args[0]) : ""; my $doSend = ($args[0] eq 'send') ? 1 : 0; return "Unknown argument $args[0], usage: fheminfo2 [send]" if($args[0] ne "send" && $args[0] ne ""); return "Won't send, as sendStatistics is set to 'never'." if($doSend && lc(AttrVal("global","sendStatistics","")) eq "never"); _fi2_Count(); _fi2_Send() if $args[0] eq 'send'; return _fi2_TelnetTable($doSend) if ($cl && $cl->{TYPE} eq 'telnet'); return _fi2_HtmlTable($doSend); } ################################################################ # tools # sub _fi2_Count() { my $uniqueID = getUniqueId(); my $release = "5.8"; my $feature = $featurelevel ? $featurelevel : $release; my $os = $^O; my $arch = $Config{"archname"}; my $perl = sprintf("%vd", $^V); %fhemInfo = (); $fhemInfo{'system'}{'uniqueID'} = $uniqueID; $fhemInfo{'system'}{'release'} = $release; $fhemInfo{'system'}{'feature'} = $feature; $fhemInfo{'system'}{'os'} = $os; $fhemInfo{'system'}{'arch'} = $arch; $fhemInfo{'system'}{'perl'} = $perl; foreach my $key ( keys %defs ) { my $name = $defs{$key}{NAME}; my $type = $defs{$key}{TYPE}; my $model = 'noModel'; $model = defined($defs{$key}{model}) ? $defs{$key}{model} : $model; $model = defined($defs{$key}{MODEL}) ? $defs{$key}{MODEL} : $model; $model = AttrVal($name,'model',$model); # $model = ReadingsVal($name,'type',$model); $model = ReadingsVal($name,'model',$model); $fhemInfo{$type}{$model}++ unless (defined($defs{$key}{'chanNo'}) || $name =~ m/^unknown_/); # exclude Homematic specials } return; } sub _fi2_Send() { # my $json = _fi2_to_json(\%fhemInfo); my $json = toJSON(\%fhemInfo); Log3("fheminfo",4,"fheminfo: $json"); my %hu_hash = (); $hu_hash{url} = $cmds{fheminfo2}{uri}; $hu_hash{data} = "uniqueID=".$fhemInfo{'system'}{'uniqueID'}."&json=$json"; $hu_hash{header} = "User-Agent: FHEM/".$fhemInfo{'system'}{'release'}; $hu_hash{callback} = sub($$$) { my ($hash, $err, $data) = @_; if($err) { Log 1, "fheminfo send: Server ERROR: $err"; } else { Log3("fheminfo",4,"fheminfo send: Server RESPONSE: $data"); } }; HttpUtils_NonblockingGet(\%hu_hash); return; } sub _fi2_TelnetTable($) { my ($doSend) = shift; my $upTime = _fi2_Uptime(); my $str = "Following statistics data will be sent to server:\n(see Logfile for server response)\n\n" if($doSend == 1); $str .= "System Info\n"; $str .= sprintf(" Release%*s: %s\n",6," ",$fhemInfo{'system'}{'release'}); $str .= sprintf(" FeatureLevel%*s: %s\n",0," ",$fhemInfo{'system'}{'feature'}); $str .= sprintf(" OS%*s: %s\n",11," ",$fhemInfo{'system'}{'os'}); $str .= sprintf(" Arch%*s: %s\n",9," ",$fhemInfo{'system'}{'arch'}); $str .= sprintf(" Perl%*s: %s\n",9," ",$fhemInfo{'system'}{'perl'}); $str .= sprintf(" uniqueID%*s: %s\n",5," ",$fhemInfo{'system'}{'uniqueID'}); $str .= sprintf(" upTime%*s: %s\n",7," ",$upTime); my @keys = keys %fhemInfo; foreach my $type (sort @keys) { next if $type eq 'system'; $str .= "\nType: $type "; $str .= "Count: ".$fhemInfo{$type}{'noModel'} if defined $fhemInfo{$type}{'noModel'}; $str .= "\n"; while ( my ($model, $count) = each(%{$fhemInfo{$type}}) ) { $str .= " $model = $fhemInfo{$type}{$model}\n" unless $model eq 'noModel'; } } return $str; } sub _fi2_HtmlTable($) { my ($doSend) = shift; my $upTime = _fi2_Uptime(); my $result = ""; $result .= "" if($doSend == 1); $result .= ""; $result .= ""; $result .= ""; $result .= ""; $result .= ""; $result .= ""; $result .= ""; $result .= ""; $result .= ""; my @keys = keys %fhemInfo; foreach my $type (sort @keys) { next if $type eq 'system'; $result .= ""; while ( my ($model, $count) = each(%{$fhemInfo{$type}}) ) { $result .= "" unless $model eq 'noModel'; } } $result .= "
Following statistics data will be sent to server:
(see Logfile for server response)
System Info
Release:$fhemInfo{'system'}{'release'}
FeatureLevel:$fhemInfo{'system'}{'feature'}
OS:$fhemInfo{'system'}{'os'}
Arch:$fhemInfo{'system'}{'arch'}
Perl:$fhemInfo{'system'}{'perl'}
uniqueId:$fhemInfo{'system'}{'uniqueID'}
upTime:$upTime
ModulesModelCount
$type $fhemInfo{$type}{'noModel'}
$model$fhemInfo{$type}{$model}
"; return $result; } sub _fi2_Uptime() { my $diff = time - $fhem_started; my ($d,$h,$m,$ret); ($d,$diff) = _fi2_Div($diff,86400); ($h,$diff) = _fi2_Div($diff,3600); ($m,$diff) = _fi2_Div($diff,60); $ret = ""; $ret .= "$d days, " if($d > 1); $ret .= "1 day, " if($d == 1); $ret .= sprintf("%02s:%02s:%02s", $h, $m, $diff); return $ret; } sub _fi2_Div($$) { my ($p1,$p2) = @_; return (int($p1/$p2), $p1 % $p2); } 1; =pod =item command =item summary display information about the system and FHEM definitions =item summary_DE zeigt Systeminformationen an =begin html

fheminfo

=end html =begin html_DE

fheminfo

=end html_DE =cut