diff --git a/contrib/survey.pl b/contrib/survey.pl
new file mode 100755
index 000000000..139f49040
--- /dev/null
+++ b/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 '
', "\n",
+ '

', "\n",
+ '
FHEM survey
', "\n",
+ '
', "\n";
+
+print '',"\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/
\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 "
\n";
+ print $q->end_html;
+ exit(0);
+}
+
+
+print "This is a survey to get a feeling which fhem modules are used.
";
+print "
";
+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 "";
+ print "
";
+ foreach(my $i=0; $i < @arr; $i++) {
+ print "| ",$q->checkbox(-name=>"$arr[$i]",-label=>"$arr[$i]")," | ";
+ print "
\n" if($i % $cols == ($cols-1));
+ }
+ print "
";
+ print "
";
+}
+
+sub
+collectSubmitted($$@)
+{
+ my ($name, $flags, @arr) = @_;
+ my $ret = "";
+ my @set;
+ foreach my $f (@arr) {
+ #print "Testing $f ", ($q->param($f) ? $q->param($f) : "UNDEF"), "
\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 "
\n";
+
+print $q->submit('Submit');
+print "
\n";
+
+print $q->end_form;
+print "\n";
+print $q->end_html;