2
0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-01-31 18:59:33 +00:00
fhem-mirror/fhem/contrib/survey.pl
rudolfkoenig 05e2ee065d Remainders from previous projects removed
git-svn-id: https://svn.fhem.de/fhem/trunk@1591 2b470e98-0d58-463d-a4d8-8e2adae1ed80
2012-05-29 09:16:47 +00:00

141 lines
3.8 KiB
Perl
Executable File

#!/usr/bin/perl
use strict;
use warnings;
use CGI;
sub collectSubmitted($$@);
sub printChapter($$@);
my @hw = qw(
CM11 CUL FHZ HMLAN KM271 LIRC TCM TUL BS CUL_FHTTK USF1000 CUL_HM EIB EnOcean
FS20 FHT FHT8V HMS KS300 CUL_TX CUL_WS CUL_EM CUL_RFR SIS_PMS CUL_HOERMANN
OWFS X10 OWTEMP ALL3076 ALL4027 WEBIO WEBIO_12DIGITAL WEBTHERM RFXCOM OREGON
RFXMETER RFXX10REC RFXELSE WS300 Weather EM EMWZ EMEM EMGZ ESA2000 ECMD
ECMDDevice SCIVT SISPM USBWX WS3600 M232 xxLG7000 M232Counter LGTV
M232Voltage WS2000 ALL4000T IPWE VantagePro2 WOL NetIO230B IT CUL_IR
);
my @help = qw(
at average notify sequence watchdog FileLog FHEM2FHEM PachLog holiday PID
autocreate dummy structure JsonList SUNRISE_EL Utils XmlList updatefhem
);
my @fe = (
"FHEMRENDERER", "fheME", "iPhone: dhs-computertechnik", "iPhone: fhemgw",
"iPhone: fhemobile", "iPhone: phyfhem", "myHCE", "pgm2/FHEMWEB with SVG",
"pgm2/FHEMWEB with gnuplot", "pgm3", "pgm5", "HomeMini", "android: andFHEM",
);
my @platform = (
"PC: Linux", "OSX", "PC: Windows", "PC: BSD", "Fritz!Box 7390", "Fritz!Box 7270",
"Fritz!Box 7170", "Synology", "NSLU2", "TuxRadio", "Plug Computer",
);
my $title = "Used FHEM Modules & Components";
my $q = new CGI;
print $q->header,
$q->start_html( -title => $title, -style=>{-src=>"style.css"}), "\n";
print '<div id="left">', "\n",
'<img src="fhem.png" alt="fhem-logo"/>', "\n",
' <h3>FHEM survey</h3>', "\n",
'</div>', "\n";
print '<div id="right">',"\n",
$q->h3("$title"), "\n";
if($q->param('Submit')) {
my $ret = "";
$ret .= collectSubmitted("1. User", 0, ("user"));
$ret .= collectSubmitted("2. Hardware", 1, @hw);
$ret .= collectSubmitted("3. Helper", 1, @help);
$ret .= collectSubmitted("4. Frontends",1, @fe);
$ret .= collectSubmitted("5. Platform", 1, @platform);
$ret .= collectSubmitted("6. Other", 0, ("other"));
if(0) {
$ret =~ s/\n/<br>\n/g;
print $ret;
} else {
require Mail::Send;
my $msg = Mail::Send->new;
$msg->to('info-r@koeniglich.de');
$msg->subject('Formulardaten');
my $fh = $msg->open;
print $fh $ret;
if(!$fh->close) {
print "Couldn't send message: $!\n";
} else {
print "Collected data is forwarded for half-automated evaluation.\n";
}
}
print "</div>\n";
print $q->end_html;
exit(0);
}
print "This is a survey to get a feeling which fhem modules are used.<br>";
print "<br>";
print $q->start_form;
##############################################
print $q->h4("User (optional):");
print $q->textfield(-name=>'user', -size=>18, -maxsize=>36);
##############################################
sub
printChapter($$@)
{
my @arr = @_;
my $name = shift @arr;
my $cols = shift @arr;
@arr = sort(@arr);
print $q->h4("$name:");
print "<div id=\"block\">";
print "<table><tr>";
foreach(my $i=0; $i < @arr; $i++) {
print "<td>",$q->checkbox(-name=>"$arr[$i]",-label=>"$arr[$i]"),"</td>";
print "</tr><tr>\n" if($i % $cols == ($cols-1));
}
print "</tr></table>";
print "</div>";
}
sub
collectSubmitted($$@)
{
my ($name, $flags, @arr) = @_;
my $ret = "";
my @set;
foreach my $f (@arr) {
#print "Testing $f ", ($q->param($f) ? $q->param($f) : "UNDEF"), "<br>\n";
push @set, $f if($q->param($f) && $flags);
push @set, $q->param($f) if($q->param($f) && !$flags);
}
$ret .= join(", ' '", @set) if(@set);
return "$name\n '$ret'\n";
}
printChapter("Hardware devices", 4, @hw);
printChapter("Helper modules", 6, @help);
printChapter("Frontends", 3, @fe);
printChapter("Platform", 5, @platform);
##############################################
print $q->h4("Other modules:");
print $q->textfield(-name=>'other', -size=>80, -maxsize=>80);
print "<br><br><br>\n";
print $q->submit('Submit');
print "<br><br><br>\n";
print $q->end_form;
print "</div>\n";
print $q->end_html;