First version

git-svn-id: https://svn.fhem.de/fhem/trunk@1203 2b470e98-0d58-463d-a4d8-8e2adae1ed80

fhem/contrib/survey.pl

@@ -0,0 +1,143 @@
+#!/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
+  );
+my @help = qw(
+  at notify sequence watchdog FileLog FHEM2FHEM PachLog holiday PID autocreate
+  dummy structure 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",
+  );
+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 $TIMES_HOME = "/opt/times/TIMES.rko";
+#my $TIMES_HOME = "/home/ipqmbe/times/TIMES";
+
+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;