mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-03-12 16:46:35 +00:00
statistics2.cgi: updated
git-svn-id: https://svn.fhem.de/fhem/trunk@14355 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
betateilchen
parent
d4dd8a93ed
commit
d665bedab7
@ -2,18 +2,23 @@
|
||||
# $Id$
|
||||
use strict;
|
||||
use warnings;
|
||||
use Time::HiRes qw(gettimeofday);
|
||||
use Time::HiRes qw(time);
|
||||
use DBI;
|
||||
use Geo::IP;
|
||||
use JSON;
|
||||
use CGI qw(:standard Vars);
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
sub insertDB();
|
||||
sub viewStatistics();
|
||||
sub getLocation();
|
||||
sub countDB();
|
||||
sub doAggregate();
|
||||
sub viewStatistics();
|
||||
|
||||
my $start = time();
|
||||
|
||||
my $ua = $ENV{HTTP_USER_AGENT};
|
||||
$ua //= "";
|
||||
my $geoip = $ENV{REMOTE_ADDR};
|
||||
my %data = Vars();
|
||||
|
||||
@ -21,8 +26,15 @@ my %data = Vars();
|
||||
my $datadir = "./data";
|
||||
my $dbf = "$datadir/fhem_statistics.sqlite";
|
||||
my $dsn = "dbi:SQLite:dbname=$dbf";
|
||||
my $dbh;
|
||||
my $sth;
|
||||
|
||||
my $css = "style.css";
|
||||
my $limit = "datetime('now', '-12 months')";
|
||||
#my $limit = "datetime('now', '-2 hour')";
|
||||
|
||||
# ---------- decide task ----------
|
||||
|
||||
if(index($ua,"FHEM") > -1) {
|
||||
insertDB();
|
||||
print header("application/x-www-form-urlencoded");
|
||||
@ -31,33 +43,21 @@ if(index($ua,"FHEM") > -1) {
|
||||
viewStatistics();
|
||||
}
|
||||
|
||||
# ---------- collect data into database ----------
|
||||
# ---------- reached by "fheminfo send" ----------
|
||||
|
||||
sub insertDB() {
|
||||
my $uniqueID = $data{uniqueID};
|
||||
my $json = $data{json};
|
||||
my $geo = getLocation();
|
||||
|
||||
my $dbh = DBI->connect($dsn,"","", { RaiseError => 1, ShowErrorStatement => 1 }) ||
|
||||
$dbh = DBI->connect($dsn,"","", { RaiseError => 1, ShowErrorStatement => 1 }) ||
|
||||
die "Cannot connect: $DBI::errstr";
|
||||
$sth = $dbh->prepare(q{INSERT OR REPLACE INTO jsonNodes(uniqueID,geo,json) VALUES(?,?,?)});
|
||||
$sth->execute($uniqueID,$geo,$json);
|
||||
$dbh->disconnect();
|
||||
}
|
||||
|
||||
sub viewStatistics() {
|
||||
|
||||
my $q = new CGI;
|
||||
my $timestamp = localtime;
|
||||
|
||||
print $q->header( "text/html" ),
|
||||
$q->start_html( -title => "FHEM statistics 2017",
|
||||
-bgcolor => "#ffffff" ),
|
||||
$q->h2( "FHEM statistics 2017" ),
|
||||
$q->hr,
|
||||
$q->p( "to be implemented..." ),
|
||||
$q->p("Statistics database contains ".countDB()." entries."),
|
||||
$q->end_html;
|
||||
}
|
||||
|
||||
sub getLocation() {
|
||||
my $geoIPDat = "$datadir/GeoLiteCity.dat";
|
||||
my %geoIP = ();
|
||||
@ -83,13 +83,95 @@ sub getLocation() {
|
||||
}
|
||||
}
|
||||
|
||||
sub countDB() {
|
||||
my $dbh = DBI->connect($dsn,"","", { RaiseError => 1, ShowErrorStatement => 1 }) ||
|
||||
# ---------- count everything for statistics ----------
|
||||
|
||||
sub doAggregate() {
|
||||
$dbh = DBI->connect($dsn,"","", { RaiseError => 1, ShowErrorStatement => 1 }) ||
|
||||
die "Cannot connect: $DBI::errstr";
|
||||
my $count = $dbh->selectrow_array("SELECT count (*) from jsonNodes");
|
||||
|
||||
my $created = $dbh->selectrow_array("SELECT lastSeen from jsonNodes where uniqueID = 'databaseCreated'");
|
||||
|
||||
my $sql = "SELECT geo,json FROM jsonNodes WHERE lastSeen > $limit AND uniqueID <> 'databaseCreated'";
|
||||
$sth = $dbh->prepare( $sql );
|
||||
$sth->execute();
|
||||
|
||||
my (%countAll,$decoded,$nodes,$res);
|
||||
$nodes = 0;
|
||||
|
||||
while (my @line = $sth->fetchrow_array()) {
|
||||
$nodes++;
|
||||
# process GeoIP data
|
||||
$decoded = decode_json( $line[0] );
|
||||
$res = $decoded->{'continentcode'};
|
||||
$countAll{'geo'}{'continent'}{$res}++;
|
||||
$res = $decoded->{'countryname'};
|
||||
$countAll{'geo'}{'countryname'}{$res}++;
|
||||
$res = $decoded->{'regionname'};
|
||||
$countAll{'geo'}{'regionname'}{$res}++;
|
||||
($decoded,$res) = (undef,undef);
|
||||
|
||||
# process system data
|
||||
$decoded = decode_json( $line[1] );
|
||||
$res = $decoded->{'system'}{'os'};
|
||||
$countAll{'system'}{'os'}{$res}++;
|
||||
$res = $decoded->{'system'}{'arch'};
|
||||
$countAll{'system'}{'arch'}{$res}++;
|
||||
$res = $decoded->{'system'}{'perl'};
|
||||
$countAll{'system'}{'perl'}{$res}++;
|
||||
$res = $decoded->{'system'}{'release'};
|
||||
$countAll{'system'}{'release'}{$res}++;
|
||||
($decoded,$res) = (undef,undef);
|
||||
|
||||
# process modules and model data
|
||||
$decoded = decode_json( $line[1] );
|
||||
my @keys = keys %{$decoded};
|
||||
|
||||
foreach my $type (sort @keys) {
|
||||
next if $type eq 'system';
|
||||
$countAll{'modules'}{$type} += $decoded->{$type}{'noModel'} ? $decoded->{$type}{'noModel'} : 0;
|
||||
while ( my ($model, $count) = each(%{$decoded->{$type}}) ) {
|
||||
$countAll{'modules'}{$type} += $count unless $model eq 'noModel';
|
||||
$countAll{'models'}{$type}{$model} += $count unless $model eq 'noModel';
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$dbh->disconnect();
|
||||
return $count-1; # without the creation entry
|
||||
|
||||
return ($created,$nodes,%countAll);
|
||||
}
|
||||
|
||||
# ---------- do the presentation ----------
|
||||
# ---------- reached by browser access ----------
|
||||
|
||||
sub viewStatistics() {
|
||||
my ($created,$count,%countAll) = doAggregate();
|
||||
my $countSystem = $countAll{'system'};
|
||||
my $countGeo = $countAll{'geo'};
|
||||
my $countModules = $countAll{'modules'};
|
||||
my $countModels = $countAll{'models'};
|
||||
|
||||
my $q = new CGI;
|
||||
print $q->header( "text/html" ),
|
||||
$q->start_html( -title => "FHEM statistics 2017",
|
||||
-style => {-src => $css},
|
||||
-meta => {'keywords' => 'fhem homeautomation statistics'},
|
||||
),
|
||||
|
||||
$q->h2( "FHEM statistics 2017 (experimental)" ),
|
||||
$q->p( "graphics to be implemented..." ),
|
||||
$q->hr,
|
||||
$q->p( "Statistics database created $created contains $count entries (last 12 months)\n"),
|
||||
$q->p( "System info <br>". Dumper $countSystem ),
|
||||
$q->p( "GeoIP info <br>". Dumper $countGeo ),
|
||||
$q->p( "Modules info <br>". Dumper $countModules ),
|
||||
$q->p( "Models per module info <br>". Dumper $countModels ),
|
||||
$q->hr,
|
||||
$q->p( "Generation time: ".sprintf("%.3f",time()-$start)." seconds" ),
|
||||
|
||||
$q->end_html;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
#
|
||||
Loading…
x
Reference in New Issue
Block a user