diff --git a/fhem/FHEM/98_fheminfo.pm b/fhem/FHEM/98_fheminfo.pm index 5a29485f9..ef3c12432 100644 --- a/fhem/FHEM/98_fheminfo.pm +++ b/fhem/FHEM/98_fheminfo.pm @@ -1,220 +1,181 @@ -################################################################ -#+$Id$ -#+vim: ts=2:et -# -#+ (c) 2012 Copyright: Martin Fischer (m_fischer at gmx dot de) -#+ All rights reserved -# -#+ 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. -# -################################################################ +=for comment + +# $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. + +=cut + package main; use strict; use warnings; use Config; +use HttpUtils; +my %fhemInfo =(); -sub CommandFheminfo($$); - -######################################## -sub -fheminfo_Initialize($$) -{ +sub fheminfo_Initialize($$) { my %hash = ( Fn => "CommandFheminfo", + uri => "https://fhem.de/stats/statistics2.cgi", Hlp => "[send],show or send Fhem statistics", ); $cmds{fheminfo} = \%hash; } -######################################## -sub -CommandFheminfo($$) -{ +sub CommandFheminfo($$) { my ($cl,$param) = @_; - - # split arguments - my @args = split(/ +/,$param); - - my $name = "fheminfo"; - my %info; - - my $module = "HTTP::Request::Common"; - my $err = "Missing perl module '$module'. Please install this module first."; - if(!checkModule($module)) { - Log 1, "$name $err"; - return $err; - } - - $module = "LWP::UserAgent"; - if(!checkModule($module)) { - Log 1, "$name $err"; - return $err; - } + 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: fheminfo [send]" - if(@args && lc($args[0]) ne "send"); + if($args[0] ne "send" && $args[0] ne ""); return "Won't send, as sendStatistics is set to 'never'." - if(@args && - lc($args[0]) eq "send" && - lc(AttrVal("global","sendStatistics","")) eq "never"); + if($doSend && lc(AttrVal("global","sendStatistics","")) eq "never"); - my $branch = "DEVELOPMENT"; # UNUSED - my $release = "5.8"; - my $feature = $featurelevel ? $featurelevel : $release; - my $os = $^O; - my $arch = $Config{"archname"}; - my $perl = $^V; - my $uniqueID = getUniqueId(); - my $sendStatistics = AttrVal("global","sendStatistics",undef); - my $moddir = $attr{global}{modpath}."/FHEM"; - my $upTime = fhemUptime(); - - my %official_module; + _fi2_Count(); - opendir(DH, $moddir) || return("$moddir: $!"); - foreach my $file (grep /^controls.*.txt$/, readdir(DH)) { - open(FH, "$moddir/$file") || next; - while(my $l = ) { - $official_module{$1} = 1 if($l =~ m+^UPD.* FHEM/\d\d_(.*).pm+); - } - close(FH); - } - closedir(DH); - return "Can't read FHEM/controls_fhem.txt, execute update first." - if(!%official_module); + _fi2_Send() if $args[0] eq 'send'; - foreach my $d (sort keys %defs) { - my $n = $defs{$d}{NAME}; - my $t = $defs{$d}{TYPE}; - my $m = "unknown"; - $m = $defs{$d}{model} if( defined($defs{$d}{model}) ); - $m = AttrVal($n,"model",$m); - if($official_module{$t} && !$defs{$d}{TEMPORARY} && !$attr{$d}{ignore}) { - $info{modules}{$t}{$n} = $m; - } - } + return _fi2_TelnetTable($doSend) if ($cl && $cl->{TYPE} eq 'telnet'); + return _fi2_HtmlTable($doSend); +} - $info{modules}{configDB}{configDB} = 'unknown' if (configDBUsed()); +################################################################ +# 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); - my $str; - $str = "Fhem info:\n"; - $str .= sprintf(" Release%*s: %s FeatureLevel: %s\n", - 2, " ", $release, $feature); - $str .= sprintf(" OS%*s: %s\n",7," ",$os); - $str .= sprintf(" Arch%*s: %s\n",5," ",$arch); - $str .= sprintf(" Perl%*s: %s\n",5," ",$perl); - $str .= sprintf(" uniqueID%*s: %s\n",0," ",$uniqueID); - $str .= sprintf(" upTime%*s: %s\n",3," ",$upTime); - $str .= "\n"; + %fhemInfo = (); - my $contModules; - my $contModels; - my $modStr; - my @modules = keys %{$info{modules}}; - my $length = (reverse sort { $a <=> $b } map { length($_) } @modules)[0]; + $fhemInfo{'system'}{'uniqueID'} = $uniqueID; + $fhemInfo{'system'}{'release'} = $release; + $fhemInfo{'system'}{'feature'} = $feature; + $fhemInfo{'system'}{'os'} = $os; + $fhemInfo{'system'}{'arch'} = $arch; + $fhemInfo{'system'}{'perl'} = $perl; - $str .= "Defined modules:\n"; - foreach my $t (sort keys %{$info{modules}}) { - my $c = scalar keys %{$info{modules}{$t}}; - my @models; - foreach my $n (sort keys %{$info{modules}{$t}}) { - my $model = $info{modules}{$t}{$n}; - if($model ne "unknown" && $t ne "dummy") { - push(@models,$model) if(!grep {$_ =~ /$model/} @models); - } - } - $str .= sprintf(" %s%*s: %d\n",$t,$length-length($t)+1," ",$c); - if(@models != 0) { - $modStr .= sprintf(" %s%*s: %s\n", - $t,$length-length($t)+1," ", join(",",sort @models)); - $contModels .= join(",",sort @models)."|"; - } - $contModules .= "$t:$c|"; - } + 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 + } - if($modStr) { - $str .= "\n"; - $str .= "Defined models per module:\n"; - $str .= $modStr; - } + return; +} - my $td = (lc(AttrVal("global", "sendStatistics", "")) eq "onupdate") ? - "yes" : "no"; +sub _fi2_Send() { + my $json = toJSON(\%fhemInfo); - $str .= "\n"; - $str .= "Transmitting this information during an update: $td\n"; - $str .= "You can change this via the global attribute sendStatistics\n"; + Log3("fheminfo",4,"fheminfo: $json"); - if(@args != 0 && $args[0] eq "send") { - my $uri = "http://fhem.de/stats/statistics.cgi"; - my $req = HTTP::Request->new("POST",$uri); - $req->content_type("application/x-www-form-urlencoded"); - my $contInfo; - $contInfo = "Release:$release|"; - $contInfo .= "Branch:$branch|"; - $contInfo .= "OS:$os|"; - $contInfo .= "Arch:$arch|"; - $contInfo .= "Perl:$perl"; - chop($contModules); - if(!$contModels) { - $req->content("uniqueID=$uniqueID&system=$contInfo&modules=$contModules"); - } else { - chop($contModels); - $req->content("uniqueID=$uniqueID&system=$contInfo&modules=$contModules&models=$contModels"); - } - - my $ua = LWP::UserAgent->new( - agent => "Fhem/$release", - timeout => 60); - my $res = $ua->request($req); + my %hu_hash = (); + $hu_hash{url} = $cmds{fheminfo}{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; +} - $str .= "\nserver response: "; - if($res->is_success) { - $str .= $res->content."\n"; - } else { - $str .= $res->status_line."\n"; - } - } +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 checkModule($) { - my $module = shift; - eval("use $module"); +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 .= ""; - if($@) { - return(0); - } else { - return(1); - } + 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 -fhemUptime() -{ +sub _fi2_Uptime() { my $diff = time - $fhem_started; my ($d,$h,$m,$ret); - ($d,$diff) = _myDiv($diff,86400); - ($h,$diff) = _myDiv($diff,3600); - ($m,$diff) = _myDiv($diff,60); + ($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); @@ -224,9 +185,7 @@ fhemUptime() return $ret; } -sub -_myDiv($$) -{ +sub _fi2_Div($$) { my ($p1,$p2) = @_; return (int($p1/$p2), $p1 % $p2); } @@ -266,47 +225,6 @@ _myDiv($$)
  • Defined models per module

    • - Example: - 
    -      fhem> fheminfo
-      Fhem info:
-        Release  : 5.3
-        OS       : linux
-        Arch     : i686-linux-gnu-thread-multi-64int
-        Perl     : v5.14.2
-        uniqueID : 87c5cca38dc75a4f388ef87bdcbfbf6f
-
-      Defined modules:
-        ACU        : 1
-        CUL        : 1
-        CUL_FHTTK  : 12
-        CUL_HM     : 66
-        CUL_WS     : 3
-        FHEM2FHEM  : 1
-        FHEMWEB    : 3
-        FHT        : 9
-      [...]
-        at         : 4
-        autocreate : 1
-        dummy      : 23
-        notify     : 54
-        structure  : 3
-        telnet     : 2
-        watchdog   : 9
-        weblink    : 17
-      
-      Defined models per module:
-        CUL        : CUN
-        CUL_FHTTK  : FHT80TF
-        CUL_HM     : HM-CC-TC,HM-CC-VD,HM-LC-DIM1T-CV,HM-LC-DIM1T-FM,HM-LC-SW1-PL,[...]
-        CUL_WS     : S555TH
-        FHT        : fht80b
-        FS20       : fs20pira,fs20s16,fs20s4a,fs20sd,fs20st
-        HMS        : hms100-mg,hms100-tf,hms100-wd
-        KS300      : ks300
-        OWSWITCH   : DS2413
-
    -
    Attributes @@ -331,98 +249,4 @@ _myDiv($$) =end html -=begin html_DE - - -

    fheminfo

    - - -=end html_DE =cut diff --git a/fhem/MAINTAINER.txt b/fhem/MAINTAINER.txt index c32fb04e4..1764928b3 100644 --- a/fhem/MAINTAINER.txt +++ b/fhem/MAINTAINER.txt @@ -417,7 +417,7 @@ FHEM/98_dewpoint.pm Joachim http://forum.fhem.de Automatis FHEM/98_Dooya.pm Jarnsen/ralf9/darkmission http://forum.fhem.de Sonstige Systeme FHEM/98_dummy.pm rudolfkoenig http://forum.fhem.de Automatisierung FHEM/98_expandJSON.pm dev0 http://forum.fhem.de Unterstuetzende Dienste -FHEM/98_fheminfo.pm mfr69bs/rudolfkoenig http://forum.fhem.de Sonstiges +FHEM/98_fheminfo.pm betateilchen http://forum.fhem.de Sonstiges FHEM/98_fhemdebug.pm rudolfkoenig http://forum.fhem.de Sonstiges FHEM/98_GoogleAuth.pm betateilchen http://forum.fhem.de Unterstuetzende Dienste FHEM/98_help.pm betateilchen http://forum.fhem.de Sonstiges diff --git a/fhem/contrib/statistics/2017/98_fheminfo.pm b/fhem/contrib/statistics/2017/98_fheminfo.pm deleted file mode 100644 index f2c5a7e1f..000000000 --- a/fhem/contrib/statistics/2017/98_fheminfo.pm +++ /dev/null @@ -1,252 +0,0 @@ -=for comment - -$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. - -=cut - -package main; -use strict; -use warnings; -use Config; -use HttpUtils; - -my %fhemInfo =(); - -sub fheminfo_Initialize($$) { - my %hash = ( - Fn => "CommandFheminfo", - uri => "https://fhem.de/stats/statistics2.cgi", - Hlp => "[send],show or send Fhem statistics", - ); - $cmds{fheminfo} = \%hash; -} - -sub CommandFheminfo($$) { - 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: fheminfo [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 = toJSON(\%fhemInfo); - - Log3("fheminfo",4,"fheminfo: $json"); - - my %hu_hash = (); - $hu_hash{url} = $cmds{fheminfo}{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 -=cut