<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package umfrage;

use frage;
use kasse;
use Spreadsheet::WriteExcel;
#use strict;

@ISA = qw ( template );


####################################################################
####         Konstruktor der Umfragenklasse
####         Argumente  : -
####         Returnwert : -
####################################################################
sub init {
	my $that = shift;
	my $class = ref($that) || $that;
	my $self = template-&gt;init(@_);
	my @V=qw/knr id name template exiturl beginn ende ppf firstfid uspringen maxuser usepanel showstat sprache uname upass stface stsize stcolor/;
	bless $self, $class;
	$self-&gt;{name}     = "Neue Umfrage";
	$self-&gt;{usepanel} = 1;
	$self-&gt;{template} = $self-&gt;{parent}-&gt;{template}+0;
	$self-&gt;{knr} 	  = $self-&gt;{parent}-&gt;{knr}+0;
	$self-&gt;{showstat} = 0;
	$self-&gt;{sprache}  = 0;
    	$self-&gt;{exiturl}  = "http://www.prorata.de";
    	$self-&gt;{beginn}   = '2013-03-01';
	$self-&gt;{ende}	  = '2013-03-01';
	$self-&gt;{ppf}	  = 20;
	$self-&gt;{firstfid} = 0;
	$self-&gt;{uspringen} = 0;
	$self-&gt;{maxuser}  = 100;
	$self-&gt;{status}	  = 0;  # Stataus = normal, geloescht, Archiv usw.
	$self-&gt;{exportvars}=\@V;
	return $self;
}

####################################################################
####         Laden der Umfrage aus der DB
####         Argumente  : -
####         Returnwert : -
####################################################################
sub load {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:load");
	my $sql = "select umfrage, usepanel, template, knr, showstat , beginn, ende, ppf, stface, stsize, stcolor, exiturl, name, pass, ".
		  "sprache, firstfid, uspringen, maxuser from umfragen where umfid=$self-&gt;{id}";
	($self-&gt;{name}, $self-&gt;{usepanel}, $self-&gt;{template}, $self-&gt;{knr},
	 $self-&gt;{showstat},$self-&gt;{beginn},$self-&gt;{ende},$self-&gt;{ppf}, $f,$s,$c, $self-&gt;{exiturl},
	 $self-&gt;{uname}, $self-&gt;{upass}, $self-&gt;{sprache}, $self-&gt;{firstfid}, $self-&gt;{uspringen},
	 $self-&gt;{maxuser} ) = $self-&gt;sqlselect($sql);
	if (! defined $self-&gt;{knr}) {$self-&gt;log(2,"Umfrage ist nicht vorhanden"); return;}
	$baseq::VARS{umfid}=$self-&gt;{id};		# Umfid setzen
	$self-&gt;loadtmp();    	                	# Template laden
        $self-&gt;loadsprache($self-&gt;{sprache});                             # Sprache laden
	$self-&gt;{stface}=$f; $self-&gt;{stsize}=$s; $self-&gt;{stcolor}=$c;
	$self-&gt;loadordernum();
	return $self;
}

####################################################################
####         Laden der Umfrage aus der DB
####         Argumente  : -
####         Returnwert : -
####################################################################
sub loadordernum {
	my $self = shift;
	my %ordernums=(-1 =&gt; "Ende", 0 =&gt; "Nächste");
	my @lordernum=(-1,0);
	my $sth=$self-&gt;sqlprepare("select fid, ordernum from fragen where umfid='$self-&gt;{id}' order by ordernum,fid");
	while (my ($fid, $ordernum) = $sth-&gt;fetchrow_array()) {
		if ($ordernum eq "") {$ordernum=$fid}
		$ordernums{$fid}=$ordernum;
		push @lordernum,$fid;
	}
	$baseq::RHordernums=\%ordernums;
	$baseq::RLordernums=\@lordernum;
}

####################################################################
####         Ermittelt eine neue umfid und speichert sich
####         Argumente  : -
####         Returnwert : -
####################################################################
sub new {
	my $self = shift;
    $self-&gt;log(4,"Entering: umfrage:new");
	$self-&gt;sqldo("lock tables umfragen");
	my $sql1 = "select max(umfid) from umfragen";
	($self-&gt;{id}) = ($self-&gt;sqlselect($sql1))+1;
    my $sql2 = "insert into umfragen (umfrage, umfid, usepanel, template, knr, showstat, beginn, ende, ppf, ".
			   "stface, stsize, stcolor, exiturl, name, pass, sprache, firstfid, uspringen, maxuser, status) ".
			   "VALUES ('$self-&gt;{name}', $self-&gt;{id}, $self-&gt;{usepanel}, $self-&gt;{template}, '$self-&gt;{knr}', ".
			   "'$self-&gt;{showstat}', '$self-&gt;{beginn}', '$self-&gt;{ende}', '$self-&gt;{ppf}', ".
		       "'$self-&gt;{stface}', '$self-&gt;{stsize}', '$self-&gt;{stcolor}', '$self-&gt;{exiturl}', ".
   		       "'$self-&gt;{uname}', '$self-&gt;{upass}', '$self-&gt;{sprache}', '$self-&gt;{firstfid}', ".
			   "'$self-&gt;{uspringen}', '$self-&gt;{maxuser}', '$self-&gt;{deleted}' )";
	$self-&gt;sqldo($sql2);
	$self-&gt;sqldo("unlock tables umfragen");
    $baseq::VARS{umfid}=$self-&gt;{id}		# Umfid setzen
}

####################################################################
####         Speichert sich mit Update
####         Argumente  : -
####         Returnwert : -
####################################################################
sub store {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:store");
	my $sql = "update umfragen set umfrage='$self-&gt;{name}', usepanel=$self-&gt;{usepanel}, ".
		  "template=$self-&gt;{template}, knr=$self-&gt;{knr}, ".
		  "showstat=$self-&gt;{showstat}, beginn='$self-&gt;{beginn}', ".
    	  "ende='$self-&gt;{ende}', ppf=$self-&gt;{ppf}, ".
		  "stface='$self-&gt;{stface}', stsize='$self-&gt;{stsize}', stcolor='$self-&gt;{stcolor}', ".
	 	  "name='$self-&gt;{uname}', pass='$self-&gt;{upass}', exiturl='$self-&gt;{exiturl}', sprache=$self-&gt;{sprache}, ".
		  "firstfid=$self-&gt;{firstfid}, uspringen=$self-&gt;{uspringen}, maxuser=$self-&gt;{maxuser}, ".
		  "status='$self-&gt;{status}' where umfid=$self-&gt;{id}";
	$self-&gt;sqldo($sql);
	return;
}

####################################################################
####         Löscht sich und alle seine Fragen aus der DB,
####	     wenn die Umfrage noch nicht beantwortet wurde
####         Argumente  : -
####         Returnwert : -
####################################################################
sub delete {
	my $self = shift;
    $self-&gt;log(4,"Entering: umfrage:delete");
	my $inhalt=$self-&gt;sqldo("select pin from ergebnis where umfid=$self-&gt;{id} and pin !='$baseq::TESTPIN'");
    if ($inhalt &gt; 0) {  # Wir muessen uns unsichtbar machen
		$self-&gt;{status} = 1;  # Status auf 1=deleted setzen
		$self-&gt;store;
		return ;
	}
	my $sql  = "delete from umfragen where umfid=$self-&gt;{id}";
	$self-&gt;sqldo($sql);
	my $f;
	my $y=$self-&gt;loadfragen;
	foreach (@$y) {$_-&gt;delete}
	$self-&gt;{id} = undef;
	return ;
}

####################################################################
####         Schreibt ins Logfile
####         Argumente  : Emergency und Logtext
####         Returnwert : -
####################################################################
sub log {
	my ($self, $emer, $TEXT) = @_;
	$self-&gt;printlog($emer, "U[$self-&gt;{id}/./.] $TEXT");
}

####################################################################
####         Frage zur Umfrage laden
####         Argumente  : -
####         Returnwert : Zeiger auf Fragenarry
####################################################################
sub loadfragen {
	my $self = shift;
    $self-&gt;log(4,"Entering: umfrage:loadfragen");
	my @y;
	my $sql = "select * from fragen where umfid=$self-&gt;{id} order by ordernum, fid";
	my $sth = $self-&gt;sqlprepare($sql);
	while (my @fra=$sth-&gt;fetchrow_array) {
		my $f=frage-&gt;init($self,1);
		$f-&gt;getpreloaded(@fra);
		push @y,$f;
	}
	return \@y;
}

####################################################################
####         liest die Antworten ein
####         Argumente  : -
####         Returnwert : -
####################################################################
sub enterant {
	my $self = shift;
	my $f;
       $self-&gt;log(4,"Entering: umfrage:enterant");
	my @RE=("",$self-&gt;trans("WA1"),$self-&gt;trans("WA2"),"");
	my $x=0;
	$self-&gt;log(4,"Entering 'enterant' Umfid=$baseq::VARS{umfid} Pin=$baseq::VARS{pin} Fid=$baseq::VARS{fid}");
    # Wenn beendet werden soll : Redirect !
	if ($baseq::VARS{lbut} eq $self-&gt;trans("BU11")) {$self-&gt;redirect;}

	# Anmeldedaten übernehmen
        if ($baseq::VARS{lbut} eq $self-&gt;trans("BU12")) {
		$baseq::VARS{pin}=$baseq::VARS{apin};
		$baseq::VARS{pass}=crypt($baseq::VARS{apass}, "xy");
	}
	$self-&gt;log(4,"fid am Anfang=$baseq::VARS{fid}");
	# Pin überprüfen und nötigenfalls erfragen
	if ($baseq::VARS{pin} eq ""){
		if ($self-&gt;{usepanel}==0) {$baseq::VARS{pin}=$self-&gt;newpin;}
		else {$self-&gt;login();$self-&gt;exit;}
	}

    # Passwortüberprüfung
	if ($self-&gt;{usepanel}==1) {my $RET = $self-&gt;checkpass($baseq::VARS{pin}, $baseq::VARS{pass});
	    if ($RET == 3) { $self-&gt;statistik;$self-&gt;exit;}
		if ($RET != 0) { $self-&gt;{warntext}=$RE[$RET]; $self-&gt;login();$self-&gt;exit; }
    }

	# Ist der Fragebogen aktiv ??

	if ($self-&gt;checkdate==1) {
	        $self-&gt;{warntext}=$self-&gt;trans("WA11");$self-&gt;login();
 		$self-&gt;log(1,"Fragebogen nicht aktiv;");
	}
	# Ist der Fragebogen beendet ??
        if ($self-&gt;checkdate==2 ||$self-&gt;checkdate==3) {
                $self-&gt;{warntext}=$self-&gt;trans("WA8");$self-&gt;login();
                $self-&gt;log(1,"Fragebogen beendet;");
        }

	$self-&gt;log(4,"FID=$baseq::VARS{fid}");
	# Wenn VARS{fid} nicht definiert ist muß die erste Frage genommen werden
	if ( $baseq::VARS{fid} &lt;1 ) {
		$self-&gt;log(4,"Keine fid, lade firstfid");
		$baseq::VARS{fid}=$self-&gt;{firstfid};
		if ($baseq::VARS{fid} == 0) {($baseq::VARS{fid})=$self-&gt;sqlselect("select fid from fragen where umfid='$self-&gt;{id}' order by ordernum,fid");}
		$f = frage-&gt;init($self,$baseq::VARS{fid}); $f-&gt;load();
		$f=$f-&gt;nextfrage($baseq::VARS{pin},1);
	}
	else {$f = frage-&gt;init($self,$baseq::VARS{fid}); $f=$f-&gt;load(); } # sonst jetzt anliegende Frage laden....

        if (! defined $f) { $self-&gt;umfende; $self-&gt;exit;}

	# Wenn gespeichert werden soll
	if ($baseq::VARS{but} eq $self-&gt;trans("BU25")) {
	   $self-&gt;log(4,"Proband speichert");
	   $f-&gt;enterant;
	   $f = $f-&gt;nextfrage($baseq::VARS{pin});
	}

	# Wenn übersprungen werden soll
	if ($baseq::VARS{but} eq $self-&gt;trans("BU3")) {
	   $f = $f-&gt;nextfrage($baseq::VARS{pin});
	   $self-&gt;log(4,"Proband Überspringt");
	   $self-&gt;{warntext}=$self-&gt;trans("WA6");
	}

	# Wenn abgebrochen werden soll
	if ($baseq::VARS{but} eq $self-&gt;trans("BU2")) {
	   $self-&gt;log(4,"Proband Unterbricht");
	   $self-&gt;{warntext}=$self-&gt;trans("WA7");
	   $self-&gt;umfende(1);  # beenden ohne bezahlen
	   return;
	}
	# Wenn die Hilfe angezeigt werden soll
	if ($baseq::VARS{but} eq $self-&gt;trans("BU24")) {
	   $self-&gt;log(4,"Proband sieht Hilfe");
	   $self-&gt;hilfe; $self-&gt;exit;  # Hilfe zeigen
	   return;
	}


   # Standardmäßig die neue Frage anzeigen !
   if (defined $f) { $baseq::VARS{fid}=$f-&gt;{id};}
   if (! defined $f) {$self-&gt;umfende;}
   else {$f-&gt;htmlfra;}

}


####################################################################
####         Laeutet das Ende der Umfrage ein......
####         Argumente  : -
####         Returnwert : -
####################################################################
sub umfende {
	my ($self, $break) = @_;
	my ( $HTML, $TITLE );
    $self-&gt;log(4,"Entering: umfrage:umfende");
	$TITLE=$self-&gt;trans("TI5");
	if ($self-&gt;{usepanel}==1) {
		my $verd=$self-&gt;verdient($baseq::VARS{pin});
		if ($break) {$verd=0 }
		if ($baseq::VARS{pin}==100 or $verd == 0){$self-&gt;{warntext}=$self-&gt;trans("WA9c")}
		else{
		 $self-&gt;{warntext}=$self-&gt;trans("WA9a")." ".$verd." ".$self-&gt;trans("WA9b")."&lt;br&gt;".$self-&gt;trans("WA9d")};
	    my $kasse=kasse-&gt;init($self);
		$kasse-&gt;haben($baseq::VARS{pin}, $self-&gt;{id}, $verd*100);
	}
        else {$self-&gt;{warntext}=$self-&gt;trans("WA10");}

	$self-&gt;sqldo("delete from ergebnis where umfid=$self-&gt;{id} and pin=$baseq::TESTPIN");

	if ($baseq::VARS{umfid} = 146 and $baseq::VARS{fid} =12){
	#if ($baseq::VARS{umfid} = 146 and $baseq::VARS{fid} = 11 and $baseq::VARS{aid} = 1 ){
		$self-&gt;log(4,"Entering: Musterumfrage - Kunde wünscht Infozusendung!! ");
		$self-&gt;benachrichtigungsmail($baseq::VARS{pin},$baseq::VARS{umfid},$baseq::VARS{fid});
	}

	
    if ($self-&gt;{showstat} !=0) {$self-&gt;statistik;$self-&gt;exit;}
	else {
	   $HTML=$self-&gt;SM('lbut',"BU11")."\n";
       $self-&gt;printhtml($TITLE,$HTML);
	}
}

####################################################################
####         Listet alle Fragen zu dieser Umfrage auf zur Bearbeitung
####		durch den Kunden
####         Argumente  : -
####         Returnwert : -
####################################################################
sub fragenliste {
	my $self = shift;
	$self-&gt;loadordernum();
    $self-&gt;log(4,"Entering: umfrage:fragenliste");
    $self-&gt;{buttonwidth}=18;
	my $fl=$self-&gt;loadfragen;
  	my $TITLE=$self-&gt;trans("TI7");
   	my $HTML="&lt;TABLE&gt;\n";
   	foreach (@$fl) { $HTML.=$_-&gt;fragenliste; }
	$HTML.="&lt;/TABLE&gt;&lt;BR&gt;\n".
   	$self-&gt;SMrow( ["but","but","but","but"] , ["BU6","BU8","BU10","BU5"] ).
    $self-&gt;SMrow( ["kbut","but","but","but"], ["BU13","BU11","BU24","BU36"]);
    $self-&gt;{helpkontext}="fragenliste";
    $self-&gt;printhtml($TITLE, $HTML);
}

####################################################################
####         Gibt sich und die Antworten zur Bearbeitung durch den
####		Kunden aus
####         Argumente  : -
####         Returnwert : HTML-string
####################################################################
sub htmlumfrage {
    my $self = shift;
    $self-&gt;log(4,"Entering: umfrage:htmlumfrage");
    my $kasse=kasse-&gt;init($self);
    my $umfk=$kasse-&gt;umfragekosten($self-&gt;{id});
    my (%flist, @aflist);
	my $sth=$self-&gt;sqlprepare("select fid,ordernum, frage from fragen where umfid='$self-&gt;{id}' order by ordernum,fid");
	while (my @x=$sth-&gt;fetchrow_array) {
		$x[2]=~s/&lt;[^&gt;]+[&gt;\$]//g;
		$flist{$x[0]}="($x[1]) ".substr($x[2], 0, 40);
		push @aflist, $x[0];
	}
	my ( $up, $ss, $htemp, $ntemp );
    my @datetext=($self-&gt;trans("HI2"),$self-&gt;trans("HI3"),$self-&gt;trans("HI4"), $self-&gt;trans("HI4a"));
    my $TITLE=$self-&gt;trans("TI9")." ".$self-&gt;{id};
    $self-&gt;{warntext}=$self-&gt;trans("TI9")." ".$self-&gt;{id};
    $self-&gt;{buttonwidth}=18;
	my $HTML=$self-&gt;sfont($self-&gt;trans("HI6"))."\n".$self-&gt;TF("umfrage",$self-&gt;{name},80)."&lt;BR&gt;\n".
             $self-&gt;sfont($self-&gt;trans("HI7"))."\n".$self-&gt;TF("exiturl",$self-&gt;{exiturl},80)."&lt;BR&gt;&lt;BR&gt;\n".
	"&lt;TABLE cellspacing=8&gt;\n".
    $self-&gt;TR([
   	    $self-&gt;DD("usepanel", [0,1,2], $self-&gt;{usepanel}, {0 =&gt; "Umfrage ohne Panel", 1 =&gt; "Online-Panel verwenden", 2 =&gt; "Telefonbefragung"} ),
	    $self-&gt;sfont($self-&gt;trans("HI9")),
	    $self-&gt;TF("beginn",$self-&gt;{beginn}),
	    $self-&gt;sfont($self-&gt;trans("HI10")),
	    $self-&gt;DDfface("stface",$self-&gt;{stface})  ]) .
	$self-&gt;TR([
	    $self-&gt;CB("showstat", 1, $self-&gt;{showstat} ).
        $self-&gt;sfont($self-&gt;trans("HI11")."&amp;nbsp;&amp;nbsp;"),
        $self-&gt;sfont($self-&gt;trans("HI5")),
	    $self-&gt;TF("ende",$self-&gt;{ende})."&amp;nbsp;&amp;nbsp;",
	    $self-&gt;sfont($self-&gt;trans("HI12")),
        $self-&gt;TF("stsize",$self-&gt;{stsize},10) ])  .
	$self-&gt;TR([
	    $self-&gt;DDtemp("template",$self-&gt;{template},0) ,
        $self-&gt;sfont($self-&gt;trans("HI13")),
	    $self-&gt;TF("ppf",$self-&gt;{ppf}),
	    $self-&gt;sfont($self-&gt;trans("HI14")),
        $self-&gt;DDfcolor("stcolor",$self-&gt;{stcolor})  ]) .
	"&lt;/TABLE&gt;\n&lt;HR&gt;\n".
	$self-&gt;sfont($self-&gt;trans("HI15").$self-&gt;TF("uname",$self-&gt;{uname}).$self-&gt;trans("HI16").
	                $self-&gt;TF("upass",$self-&gt;{upass}).$self-&gt;trans("HI17")."&lt;HR&gt;\n").
	$self-&gt;sfont($datetext[$self-&gt;checkdate()].
	sprintf("&amp;nbsp;&amp;nbsp;&amp;nbsp;Panelistenkosten: %0.2f Euro bzw. %0.2f DM",$umfk/100,$umfk*0.0195583 )).
	"&lt;HR&gt;\n".
    "&lt;TABLE width=80%&gt;\n".
	$self-&gt;TR([ $self-&gt;sfont($self-&gt;trans("HI17a")), $self-&gt;DDsprache('sprache',$self-&gt;{sprache}), $self-&gt;DD('radio', \@aflist, '', \%flist) ]).
	$self-&gt;TR([ $self-&gt;sfont($self-&gt;trans("HI17c")),
		    $self-&gt;DD('uspringen',[1,0],$self-&gt;{uspringen},{"1" =&gt; "Anzeigen","0"=&gt;"Verstecken"}), $self-&gt;SM("but", "BU6")  ]).
	$self-&gt;TR([ $self-&gt;sfont($self-&gt;trans("HI17d")), $self-&gt;TF("maxuser",$self-&gt;{maxuser},5) ]).
	"&lt;/TABLE&gt;\n&lt;BR&gt;\n".
   	$self-&gt;SMrow( ["but","but","but","kbut"] , ["BU9","BU5","BU4","BU13"] ).
	$self-&gt;SMrow( ["but","but","but","but"] , ["BU11","BU24","BU26","BU28"] ).
	$self-&gt;SMrow( ["pbut","sbut","but","but"] , ["BU32","BU33","BU14","BU56"] ).
	$self-&gt;SMrow( ["but","but","but"] , ["BU72","BU73","BU74"] );
	$self-&gt;{helpkontext}="umfrage";
    $self-&gt;printhtml($TITLE, $HTML);
}

####################################################################
####         Bearbeitet die Eingabe der Frage durch den Kunden
####         Argumente  : -
####         Returnwert : -
####################################################################
sub getbearb {
	my $self = shift;
	my ( $f, $TITLE, $x );
    $self-&gt;log(4,"Entering: umfrage:getbearb");

	# Wenn VARS{fid} nicht definiert ist wird eine Fragenliste ausgegeben
	#if ( (! defined $baseq::VARS{fid}) ) {
	#   $self-&gt;htmlumfrage;
	#}
        $self-&gt;log(4,"SPRACHE: $self-&gt;{sprache} -- $baseq::VARS{sprache} BU9=".$self-&gt;trans("BU9")." but=".$baseq::VARS{but} );
	# Hilfe anzeigen !?
	if ($baseq::VARS{but} eq $self-&gt;trans("BU24")) {
		$self-&gt;hilfe;
	}


	# Wenn gespeichert werden soll
	if ($baseq::VARS{but} eq $self-&gt;trans("BU1")) {
	  $self-&gt;log(4,"Kunde speichert");
	  $f = frage-&gt;init($self,$baseq::VARS{fid});  #  jetzt anliegende Frage laden....
	  $f-&gt;load();
	  if (! defined $f){$self-&gt;htmlumfrage;}
	  $f-&gt;getbearb;
	  $self-&gt;{warntext}=$self-&gt;trans("WA14");
	  $self-&gt;loadordernum();
	  $f-&gt;htmlbearb;
	}

	# Wenn die Frage gelöscht werden soll
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU8")) {
  	  $self-&gt;log(4,"Kunde löscht");
	  if ($baseq::VARS{radio} ne "") {$baseq::VARS{fid}=$baseq::VARS{radio};}
	  if ($baseq::VARS{fid} &gt; 0) {
	    $f = frage-&gt;init($self,$baseq::VARS{fid});  #  jetzt anliegende Frage laden....
	    $f=$f-&gt;load();
	    if (defined $f) {$x=$f-&gt;delete;}
	    $baseq::VARS{fid}=0;
	    $self-&gt;{warntext}=$x;
	  }
	  else {
	    $self-&gt;{warntext}=$self-&gt;trans("WA16");
	  }
	  $self-&gt;fragenliste();
	}

	# Wenn eine neue Frage erstellt werden soll
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU5")) {
           $self-&gt;log(4,"Kunde erstellt neue Frage");
	   $f=frage-&gt;init($self,$baseq::VARS{fid});
	   $f-&gt;new();
	   $baseq::VARS{fid}=$f-&gt;{id};
	   $self-&gt;{warntext}=$self-&gt;trans("WA17");
	   $self-&gt;loadordernum();
	   $f-&gt;htmlbearb;
	}

	#Wenn aus der Liste bearbeitet werden soll
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU6") || $baseq::VARS{but} eq $self-&gt;trans("BU36") ) {
	  $self-&gt;log(4,"Kunde bearbeitet Frage");
	  if ($baseq::VARS{radio} &lt; 1) {
	     $self-&gt;{warntext}=$self-&gt;trans("WA16");
	     $self-&gt;fragenliste;
	  }
	  else {
	     $f=frage-&gt;init($self,$baseq::VARS{radio});
	     $f=$f-&gt;load();
	     if ($baseq::VARS{but} eq $self-&gt;trans("BU36")) {$f-&gt;new();}
		 $baseq::VARS{fid}=$f-&gt;{id};
	     $self-&gt;{warntext}=$self-&gt;trans("WA18");
	     $self-&gt;loadordernum();
	     $f-&gt;htmlbearb;
	  }
	}

	# Wenn die Liste angezeigt werden soll.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU4")) {
	     $self-&gt;log(4,"Kunde sieht Liste der Fragen");
	     $self-&gt;{warntext}=$self-&gt;trans("WA19");
             $baseq::VARS{fid}=0;
             $self-&gt;fragenliste;
    }

    # Wenn die Fragen angeglichen werden sollen !
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU26")) {
	     $self-&gt;log(4,"Kunde gleicht die Fragen an");
	     $self-&gt;{warntext}=$self-&gt;trans("WA19");
             my $y=$self-&gt;loadfragen;
             foreach $f (@$y) {$f-&gt;settext};
             $self-&gt;fragenliste;
    }

    # Wenn die Umfrage gespeichert werden soll.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU9")) { $self-&gt;log(4,"Kunde speichert Umfrage"); $self-&gt;getumfbearb;}

    # Wenn die Statistik angezeigt werden soll.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU14")) { $self-&gt;log(4,"Kunde sieht Statistik"); $self-&gt;statistik;}

    # Wenn die Umfrage angezeigt werden soll.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU10")) { $self-&gt;log(4,"Kunde sieht Umfrage"); $self-&gt;htmlumfrage;}

	# Wenn die Pivotierten Ergebnisse angezeigt werden soll.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU32")) { $self-&gt;log(4,"Kunde sieht Pivot-Tabelle"); $self-&gt;pivot;}

    # Wenn die Pivotierten Ergebnisse angezeigt werden soll.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU56")) {
	  $self-&gt;{status} = 2;  # Status auf 2=archiviert setzen
	  $self-&gt;store;
      $self-&gt;htmlumfrage;
	}
	# Wenn die Umfrage kopiert wird als neu.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU28")) {
		$self-&gt;log(4,"Kunde Kopiert neue Umfrage");
		my $frag=$self-&gt;loadfragen;
		$self-&gt;{name} .= "  (Kopie)";
		$self-&gt;new;
		foreach $f (@$frag) {$f-&gt;{umfid}=$self-&gt;{id}; $f-&gt;new;}
		$self-&gt;htmlumfrage;
	}

	# Wenn die Umfrage getestet wird....
#	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU36")) {
#		$baseq::VARS{lbut}=$self-&gt;trans("BU12");
#		$baseq::VARS{apin}=100;
#		$baseq::VARS{apass}="muster";
#		$baseq::VARS{fid}=$self-&gt;{firstfid};
#		$self-&gt;log(4,"Kunde sieht Umfrage zum Testen");
#		$self-&gt;enterant;
#	}
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU25")) {$self-&gt;enterant;}
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU3")) {$self-&gt;enterant;}
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU2")) {$self-&gt;enterant;}

	# Export
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU72")) {$self-&gt;export;}
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU73")) {$self-&gt;exportxls;}

	# Pinliste
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU74")) {$self-&gt;pinliste;}
	
	# Panelisten "entfernen"
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU75")) {$self-&gt;rmpanelist;}

	# Beenden mit Redirect....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU11")) { $self-&gt;redirect;}

	# Wenn alles andere versagt.....   :-)
	else { $self-&gt;htmlumfrage; $self-&gt;log(4,"Kein Button gedrückt, Kunde sieht Umfrage"); }

}

####################################################################
####         nimmt die Änderungen aus dem Formular an
####         Argumente  : Zeiger auf Variablen
####         Returnwert : -
####################################################################
sub getumfbearb {
	my $self = shift;
    $self-&gt;log(4,"Entering: umfrage:getumfbearb");
	$self-&gt;{name}=$self-&gt;fclean($baseq::VARS{umfrage});
	$self-&gt;{template}=$baseq::VARS{template}+0;
	$self-&gt;{usepanel}=$baseq::VARS{usepanel}+0;
	$self-&gt;{showstat}=$baseq::VARS{showstat}+0;
	$self-&gt;{beginn}=$self-&gt;fclean($baseq::VARS{beginn});
	$self-&gt;{ende}=$self-&gt;fclean($baseq::VARS{ende});
	$self-&gt;{ppf}=$baseq::VARS{ppf}+0;
	$self-&gt;{stface}=$self-&gt;fclean($baseq::VARS{stface});
	$self-&gt;{stsize}=$self-&gt;fclean($baseq::VARS{stsize});
	$self-&gt;{stcolor}=$self-&gt;fclean($baseq::VARS{stcolor});
	$self-&gt;{exiturl}=$self-&gt;fclean($baseq::VARS{exiturl});
    $self-&gt;{uname}=$self-&gt;fclean($baseq::VARS{uname});
	$self-&gt;{upass}=$self-&gt;fclean($baseq::VARS{upass});
	$self-&gt;{sprache}=$baseq::VARS{sprache}+0;
	$self-&gt;{firstfid}=$baseq::VARS{firstfid}+0;
	$self-&gt;{uspringen}=$baseq::VARS{uspringen}+0;
    $self-&gt;{maxuser}=$baseq::VARS{maxuser}+0;
	$self-&gt;store;
    $self-&gt;load;
	$self-&gt;htmlumfrage;
}


####################################################################
####         Liefert den Preis für die Beantwortung !
####         Argumente  : -
####         Returnwert : Betrag in Pfennigen
####################################################################
sub verdient {
	my $self = shift;
	my $pin = shift;
    my ($f, $x);
	$self-&gt;log(4,"Entering: umfrage:verdient");
	if ($pin==0) {$self-&gt;log(1, "umfrage-&gt;verdient : PIN wurde nicht übergeben !"); }
	if ($pin!=100){
		foreach $f (@{$self-&gt;loadfragen}) {$x+=$f-&gt;verdient($pin);}
		return sprintf("%0.2f",$x*$self-&gt;{ppf}/100);#/
	}
}
####################################################################
####         Liefert den Preis für die Beantwortung !
####         Argumente  : -
####         Returnwert : Betrag in Pfennigen
####################################################################
sub IDstr {
	my $self = shift;
	return "U".$self-&gt;{id}."DE".$self-&gt;{gtyp};
}

my %democol = (HF =&gt; "anrede", BI =&gt; "bildung", FS =&gt; "famstand", BS =&gt; "arbeit",
			   PLZ =&gt; "plzcod", ALT =&gt; "gebclusn");

my %demoadd = (HF =&gt; 0, BI =&gt; 1, FS =&gt; 1, BS =&gt; 1,
			   PLZ =&gt; 1, ALT =&gt; 1);


####################################################################
####         Gibt die Statistik für die Umfrage aus
####         Argumente  : -
####         Returnwert : -
####################################################################
sub htmlgrafik {
	my $self = shift;
    $self-&gt;log(4,"Entering: umfrage:htmlgrafik");
   $self-&gt;sqldo("delete from bar where changed &lt; NOW()-100000");
	$self-&gt;{FL}=$self-&gt;loadfragen;  # alle Fragen laden
    $self-&gt;{grafik}="VL";	#Grafiktyp auf Verlauf fuer erste Grafik
	$self-&gt;{sort}=0;		# Sortierung auf lfd
    $self-&gt;{gschmuck}=1;	# kein Schmuck
	my @tdiff; my @FL=@{ $self-&gt;{FL} };# FL = Fragenliste
	my (@shortcuta, @shortcutf, $sth, $pins, $oldgraf, %oldkoord, $whereref, $tableref, $descref,
		@table, @where, $target, $details, @pinselect, $alles, @hiddenpin);
	my $grafik=grafikm-&gt;init($self); # neue Grafik
	foreach (keys %baseq::VARS) {
		# wir suchen in z.B. "stbut54.x" die 54 und das x oder y und speichern es in $oldkoord{x} und die 54 in $oldgraf
		if (/^stbut(\d+)\.([xy])/) {$oldgraf=$1; $oldkoord{lc($2)}=$baseq::VARS{$_};}
		elsif (/^stbut(U\d\S+)/) {$self-&gt;{details}=$1;} # oder hat jemand auf DETAILS geklickt ?
		elsif (/^(U\d+F\d+A\d+PIN(\d{1,5}))$/) { # er/sie hat einzelne PINs selektiert
			$alles=1;
			push @pinselect, "a.pin=$2";
			push @hiddenpin, $1;
		}
		$self-&gt;{statselpin}=\@hiddenpin;
	}
	if ($alles) {push @$whereref, "(".join(" or ", @pinselect).")" }
	$self-&gt;log(4, "Whereref - PIN:". $$whereref[0]);

	$self-&gt;log(4,"Details=".$self-&gt;{details});
	if ($baseq::VARS{grpid} &gt; 0) { # wurde frueher einmal auf ein Bild geklickt ?
		$target=$grafik-&gt;load($baseq::VARS{grpid}, $baseq::VARS{grplfd}); # dann diesen Balken/Pie holen
		$self-&gt;log(4,"grpid=$baseq::VARS{grpid}, grplfd=$baseq::VARS{grplfd}");
	}
	if ($oldgraf&gt;0) { # laden wir doch mal die alte grafik
		$self-&gt;log(4,"NR=$oldgraf, X=$oldkoord{x}, Y=$oldkoord{y}");	# oder wenn jetzt auf ein IMG
		$grafik-&gt;load($oldgraf);										# geklickt wurde
		$target=$grafik-&gt;polygonhit($oldkoord{x}, $oldkoord{y});		# schaun wir mal worauf er klickte...
	}
	if ($baseq::VARS{stbut} eq $self-&gt;trans("BU60")) {
		$alles=1;
		$self-&gt;{statselpin}=[];
		@whereref=();
	}
	if ($alles) {undef $target}	# hat er/sie auf "ALLES" geklickt ?

	if (defined $target) {
		($tableref, $whereref, $descref) = $grafik-&gt;tablwher($target);	#wenn ein klick auf eine Grafik war
		$self-&gt;{grpid}=$target-&gt;{id};	# die ID der alten
		$self-&gt;{grplfd}=$target-&gt;{lfd};	# und die lfd sich merken machen tun
	}
	($self-&gt;{tableref}, $self-&gt;{whereref}) = ($tableref, $whereref);
	$grafik-&gt;imgreset; # Bild zurücksetzen


	my $HTML=""; my $minpin; my $maxpin; my $pin; my $changed; my @max; my @min;
	my $maxdiff=0; my $mindiff=50000000000000;
	my $maxdate=0; my $mindate=$mindiff;
	foreach (@FL) { # Wir bauen jetzt Zeigerlisten auf Fragen und Antworten
		my ($id,$ref) = $_-&gt;createantarrayref;
		$self-&gt;log(2,"ERROR: ID: ".$id);
		$shortcuta[$id]=$ref;	# Array[fid][aid] zeigt auf Antwortobjekt
		$shortcutf[$id]=$_;		# Array[fid] zeigt auf das Frageobjekt
		$shortcutf[$id]-&gt;{countpin}=0;  # Zaehler resetten
	}

	# fid, aid anzahl der Antworten und Textantworten selektieren
	@where=@{$whereref}; @table=@{$tableref};
	push @where, "a.umfid=$self-&gt;{id}"; push @table, "ergebnis a";
	($table, $where) = $self-&gt;jointables(\@table, \@where);
	$sth=$self-&gt;sqlprepare("select a.fid, a.aid, count(a.pin), avg(a.text) from $table where $where group by a.fid, a.aid");
	while ( my ($fid, $aid, $cnt, $avg) = $sth-&gt;fetchrow_array ) {
		$shortcuta[$fid][$aid]-&gt;{countpin}=$cnt;	# Die Anzahl der Antworten zuweisen
		$shortcuta[$fid][$aid]-&gt;{avgtext}=$avg;		# Den Durchschnitt bei Skalen dem Antwortobjekt mitteilen
	}
	$sth-&gt;finish;

	# Die N's pro Frage raussuchen
	@where=@{$whereref}; @table=@{$tableref};
	push @where, "a.umfid=$self-&gt;{id}"; push @table, "ergebnis a";
	($table, $where) = $self-&gt;jointables(\@table, \@where);
	$sth=$self-&gt;sqlprepare("select distinct a.fid, a.pin from $table where $where");
	while ( my ($fid, $cnt) = $sth-&gt;fetchrow_array ) {
		if ($shortcutf[$fid]-&gt;{showstat}) {
			$self-&gt;{benutzer}-&gt;{FID}[$fid]++; #und aufaddieren wenn Statistik gezeigt werden soll
		}
		$shortcutf[$fid]-&gt;{countpin}++
	}

	@where=@{$whereref}; @table=@{$tableref};
	my $tab1="ergebnis a";
	my $tab2="ergebnis b";
	my @whe1=("a.umfid=$self-&gt;{id}", "a.fid=".($baseq::VARS{kreuztab1}+0) );
	my @whe2=("b.umfid=$self-&gt;{id}", "b.fid=".($baseq::VARS{kreuztab2}+0) );
	my $sel1="a.aid";
	my $sel2="b.aid";
	if ($democol{$baseq::VARS{kreuztab1}} ne "" ) {
		$tab1="benutzer a";
		@whe1=("a.pin is not NULL");
		$sel1="a.".$democol{$baseq::VARS{kreuztab1}};
	}

	if ($democol{$baseq::VARS{kreuztab2}} ne "" ) {
		$tab2="benutzer b";
		@whe2=("b.pin is not NULL");
		$sel2="b.".$democol{$baseq::VARS{kreuztab2}};
	}

	push @where, (@whe1, @whe2);
	push @table, ($tab1, $tab2);
	($table, $where) = $self-&gt;jointables(\@table, \@where);
	$sth=$self-&gt;sqlprepare("select $sel1, $sel2, count(*) from $table where $where group by $sel1, $sel2");
	my (@kreuztab, $maid1, $maid2);
	while ( my ($aid1, $aid2, $cnt) = $sth-&gt;fetchrow_array ) {
		$aid1+=$demoadd{$baseq::VARS{kreuztab1}};
		$aid2+=$demoadd{$baseq::VARS{kreuztab2}};
		$kreuztab[$aid1][$aid2]=$cnt;
		$kreuztab[0][$aid2]+=$cnt;
		$kreuztab[$aid1][0]+=$cnt;
		$kreuztab[0][0]+=$cnt;
		if ($aid1&gt;$maid1) {$maid1=$aid1}
		if ($aid2&gt;$maid2) {$maid2=$aid2}
	}
	$sth-&gt;finish;

	# Alle Textantworten selektieren
	@where=@{$whereref}; @table=@{$tableref};
	push @where, ("a.umfid=$self-&gt;{id}", "a.fid &gt; 0", "a.aid &gt; 0", "a.text &gt; ''"); push @table, "ergebnis a";
	($table, $where) = $self-&gt;jointables(\@table, \@where);
	$sth =$self-&gt;sqlprepare("select a.fid,a.aid,a.pin,a.text from $table where $where order by a.pin");
	while ( my ($fid, $aid, $pin, $txt) = $sth-&gt;fetchrow_array ) {
		$self-&gt;log(2,"ERROR: FID: ".$fid." AID:".$aid);
		$shortcuta[$fid][$aid]-&gt;slurptextant($pin, $txt);
	}
	$sth-&gt;finish;
	# Min Max changed
	@where=@{$whereref}; @table=@{$tableref};
	push @where, "a.umfid=$self-&gt;{id}"; push @table, "ergebnis a";
	($table, $where) = $self-&gt;jointables(\@table, \@where);
	$sth=$self-&gt;sqlprepare("select a.pin, min(a.changed), max(a.changed) from $table where $where group by a.pin");
	$self-&gt;{pins}=$sth-&gt;rows;
	while ( ($pin,$min,$max)=$sth-&gt;fetchrow_array) {
	$self-&gt;log(2,"PIN=$pin; MIN=$min; MAX=$max");

              if ($mindate&gt;$min) {$mindate=$min;}
	      if ($maxdate&lt;$max) {$maxdate=$max;}
	      $maxdate=$max;
	      $self-&gt;log(2,"Erste Antwort: $mindate; Letzte Antwort: $maxdate; Min = $min;Max=$max;");

		@tdiff=$self-&gt;timediff($min, $max);
	    if ($tdiff[0]&gt;$maxdiff) {$maxpin=$pin; $maxdiff=$tdiff[0]; $maxdiffpin=$self-&gt;duration($min, $max); }
	    if ($tdiff[0]&lt;$mindiff &amp;&amp; $max - $min !=0 ) {$minpin=$pin; $mindiff=$tdiff[0]; $mindiffpin=$self-&gt;duration($min, $max); }
		$self-&gt;log(5,join(" - ",@tdiff));
		#if ($mindate&gt;$min) {$mindate=$min;}
		#if ($maxdate&lt;$max) {$maxdate=$max;}

		#$self-&gt;log(2,"Erste Antwort: $mindate; Letzte Antwort: $maxdate; Min = $min;Max=$max;");
	}
	$sth-&gt;finish;
	# persoenliche Dinge, Alter, Geschlecht etc.
	@where=@{$whereref}; @table=@{$tableref};
	push @where,("b.umfid=$self-&gt;{id}", "a.pin is not NULL"); push @table, ("ergebnis b", "benutzer a") ;
	($table, $where) = $self-&gt;jointables(\@table, \@where);
	$sth =$self-&gt;sqlprepare("select distinct a.anrede, a.plzcod, a.gebclusn, a.bildung, a.famstand, a.arbeit, a.pin from $table where $where");
	$now =substr($self-&gt;{ende},0,4);
	$self-&gt;log(4,"Now=$now");
	while ( my @p=$sth-&gt;fetchrow_array ) {
		foreach (qw/HF PLZ ALT BI FS BS/) {
			my $wo=shift @p;
			$self-&gt;{benutzer}-&gt;{$_}[$wo]++;
		}
	}
	$sth-&gt;finish;

	$self-&gt;log(4,"Milestone 0");

	###################### test 21.10.10
	######################

	$HTML.=$self-&gt;smfont(join("&lt;BR&gt;\n",@$descref))."&lt;HR&gt;\n";
	$HTML.="&lt;TABLE&gt;\n".
		##self-&gt;TR([ $self-&gt;sfont("Erste Antwort:"),$self-&gt;sfont($self-&gt;timestamp($mindate)) ]).
		#$self-&gt;TR([ $self-&gt;sfont("Letzte Antwort:"),$self-&gt;sfont($self-&gt;timestamp($maxdate)) ]).
		#
		$self-&gt;TR([ $self-&gt;sfont("Erste Antwort:"),$self-&gt;sfont($mindate) ]).
		$self-&gt;TR([ $self-&gt;sfont("Letzte Antwort:"),$self-&gt;sfont($maxdate) ]).

		#
		#$self-&gt;TR([ $self-&gt;sfont("Zeitraum:"),$self-&gt;sfont($self-&gt;duration($mindate, $maxdate)) ]).
		$self-&gt;TR([ $self-&gt;sfont("Teilnehmer:"),$self-&gt;sfont($self-&gt;{pins}) ]).
		#$self-&gt;TR([ $self-&gt;sfont("Min. Teilnahmezeit:"),$self-&gt;sfont($mindiffpin) ]).
		#$self-&gt;TR([ $self-&gt;sfont("Max. Teilnahmezeit:"),$self-&gt;sfont($maxdiffpin) ]).
	"&lt;/TABLE&gt;\n";
		$self-&gt;log(4,"Min: ". $mindiffpin );
		$self-&gt;log(4,"Max: ". $maxdiffpin );
	$self-&gt;log(4,"Milestone 1");
	if ($self-&gt;{pins}&gt;0) { $self-&gt;{gtyp}="FID"; $HTML.=$self-&gt;grafikhtml("U".$self-&gt;{id}."FR");}
	$HTML.="&lt;HR&gt;\n";
	my (%flist, @alist);
	foreach  (@FL) {
		if ( ($_-&gt;{typ} eq "D" || $_-&gt;{typ} eq "E" ) &amp;&amp; $_-&gt;{showstat}) {
			$name=$_-&gt;fullname;
			$name=~s/&lt;[^&gt;]+[&gt;\$]//g;
			$flist{$_-&gt;{id}}=substr($name,0,45);
			push @alist,$_-&gt;{id};
		}
	}
	if ($self-&gt;{usepanel}) {
		%flist=(%flist,%baseq::TITLE);
	}
        @alist=(sort {$a &lt;=&gt; $b} keys %flist);
	$HTML.=$self-&gt;DD("kreuztab1",\@alist,$baseq::VARS{kreuztab1},\%flist)." ".
	       $self-&gt;DD("kreuztab2",\@alist,$baseq::VARS{kreuztab2},\%flist)." ".
           $self-&gt;DD("kreuzrowcol",[0,1],$baseq::VARS{kreuzrowcol},{0 =&gt; "Zeilenprozente", 1 =&gt; "Spaltenprozente"})." ".
		   $self-&gt;SM("stbut","BU62");
	if ($baseq::VARS{stbut} eq $self-&gt;trans("BU62")) {
		my @ktab;
		$kreuztab[++$maid1]=$kreuztab[0];
		$maid2++;
		my (@demolabel1, @demolabel2);
		my $evstr= "\@demolabel1=\@baseq::".$baseq::VARS{kreuztab1}.
                ";\@demolabel2=\@baseq::".$baseq::VARS{kreuztab2};
		eval $evstr;
		$self-&gt;log(4,"EVAL: $evstr, A1=".join("|",@demolabel1));
		for (my $aid1=$maid1; $aid1&gt;0; $aid1--) {
		   $kreuztab[$aid1][$maid2]=$kreuztab[$aid1][0];
		   for $aid2 (1...$maid2) {
			  my $kreuzN=($kreuztab[$aid1][$maid2], $kreuztab[$maid1][$aid2])[$baseq::VARS{kreuzrowcol}+0];
		      $self-&gt;log(3,"$aid1 - $aid2 : $kreuztab[$maid1][$aid2]");
			  if ($kreuzN==0) {$kreuzN=0.01}
			  my $cnt=$kreuztab[$aid1][$aid2];
			  $ktab[$aid1][$aid2*2]=$self-&gt;smfont(sprintf("%2.1f%" , $cnt*100/$kreuzN));
	          	  $ktab[$aid1][$aid2*2-1]=$self-&gt;smfont($cnt+0);
			  if ($democol{$baseq::VARS{kreuztab1}} ne "" ) {
				  $ktab[$aid1][0]=$demolabel1[$aid1-$demoadd{$baseq::VARS{kreuztab1}}] ;
				  $self-&gt;log(4,"Label:$ktab[$aid1][0]");
			  }
			  else {
				  $ktab[$aid1][0]=$shortcuta[$baseq::VARS{kreuztab1}][$aid1]-&gt;{name};
		      }
			  $ktab[$aid1][0]="&lt;B&gt;".$self-&gt;smfont(substr($ktab[$aid1][0],0,20))."&lt;/B&gt;";

			  if ($democol{$baseq::VARS{kreuztab2}} ne "" ) {
				  $ktab[0][$aid2]=$demolabel2[$aid2-$demoadd{$baseq::VARS{kreuztab2}}]
			  }
			  else {
				  $ktab[0][$aid2]=$shortcuta[$baseq::VARS{kreuztab2}][$aid2]-&gt;{name};
		      }
			  $ktab[0][$aid2]="&lt;B&gt;".$self-&gt;smfont(substr($ktab[0][$aid2],0,20))."&lt;/B&gt;";

		      $self-&gt;log(3,"AID-1=$aid1, AID-2=$aid2 , CNT=$cnt , kreuzN=$kreuzN");
		   }
		}
	    $ktab[$maid1][0] = $ktab[0][$maid2] = "&lt;B&gt;".$self-&gt;smfont("Gesamt",0,20)."&lt;/B&gt;";

		$HTML.="&lt;TABLE border=1&gt;\n";
		my $erst=1;
		foreach (@ktab) {
			my $attr="align=center";
			if ($erst) {$attr="colspan=2"; undef $erst}
			else {unshift @$_, ""}
			$HTML.=$self-&gt;TR($_, $attr);
		}
		$HTML.="&lt;/TABLE&gt;\n";
	}
	else {
	   $HTML.="&lt;HR&gt;";
	   $self-&gt;{grafik}="BA";
	   $self-&gt;log(4,"Milestone 3");
	   #if ($self-&gt;{knr}==4) {$HTML.=$self-&gt;otto;}
	   foreach ( @FL) {
		$_-&gt;{details}=$self-&gt;{details};
		$HTML.=$_-&gt;htmlgrafik;
	   }
	   $HTML.="&lt;HR&gt;\n";
	   if ($self-&gt;{usepanel}) {
	       foreach  (qw/HF BI FS BS ALT PLZ/) {
			$self-&gt;{gtyp}=$_;
			my $IMG = $self-&gt;grafikhtml;
			if ($self-&gt;{details} ne "" &amp;&amp; $self-&gt;IDstr ne $self-&gt;{details}) {$HTML.=$IMG;}
			else {$HTML.=$self-&gt;qfont($baseq::TITLE{$self-&gt;{gtyp}}) ."&lt;BR&gt;\n". $IMG . "\n&lt;HR&gt;\n"; 	}
	       }	
	   }
        }
	$self-&gt;log(4,"Milestone 4");
	return $HTML
}

#sub kstatistik {
#	$self=shift;
#	$HTML=$self-&gt;htmlgrafik;
#	$self-&gt;printhtml($self-&gt;trans("TI4"),$HTML."&lt;TABLE&gt;".$self-&gt;SMrow( ['but','stbut'], ["BU13","BU60"] )."&lt;/TABLE&gt;" )
#}


sub statistik {
	$self=shift;
	if ($baseq::VARS{stbut} eq $self-&gt;trans("BU11")) {$self-&gt;redirect;}
	if ($baseq::VARS{stbut} eq $self-&gt;trans("BU24")) {$self-&gt;hilfe;}
	$HTML=$self-&gt;htmlgrafik;
    $self-&gt;{helpkontext}="statistik";
	$self-&gt;printhtml($self-&gt;trans("TI4"),$HTML."&lt;TABLE&gt;".$self-&gt;SMrow( ['stbut','stbut','stbut'], ["BU11", "BU60", "BU24"])."&lt;/TABLE&gt;" )
}


sub makegrafik {
    my ($self, $grafik) = @_;
	my $typ=$self-&gt;{gtyp};
	my %grdata;
    $self-&gt;log(4,"Demos: $typ");
    if ($typ ne "FID") {
     $self-&gt;{typ}="E";
	 my @list;
     $evalcode="\@list=\@baseq::$typ";
     eval $evalcode;
     $self-&gt;log(4,"EVAL: $evalcode");
     $self-&gt;log(4,"\@list=". join("|", @list) );
     for (0...$#list) {
		if ($list[$_] eq "") {next;}
		my $x={};
		$x-&gt;{tabl}="benutzer";
		$x-&gt;{lfd}=$_;
		$x-&gt;{num}=$self-&gt;{benutzer}-&gt;{$typ}[$_];
		$x-&gt;{txt}=$list[$_];
		$x-&gt;{wher}=$democol{$typ}."=".$_;
		$x-&gt;{descr}=$baseq::TITLE{$typ}.": ".$list[$_];
		$self-&gt;log(4,"\$x-&gt;{wher}=".$x-&gt;{wher} );
		$grafik-&gt;newdataset($x);
	 }
	}
    else {
		my $x={};
		$x-&gt;{tabl}="ergebnis";
        $grdata{textformatv}="Frage: &amp;T";
        $grdata{textformath}="&amp;Z - &amp;P%";
        $grdata{sorttype}="txt";
		$self-&gt;{typ}="M";
		my @tmpa=@{$self-&gt;{benutzer}-&gt;{FID}};
		foreach (1...$#tmpa) {
		  if ($tmpa[$_]==0) {next;}
		  $x-&gt;{lfd}=$_;
		  $x-&gt;{txt}=$baseq::RHordernums-&gt;{$_};
		  $x-&gt;{num}=$tmpa[$_];
		  $x-&gt;{wher}="umfid=$self-&gt;{id} fid=".($_);
          	  $x-&gt;{descr}=$baseq::TITLE{$typ}.": Frage ".$tmpa[$_];
		  $grafik-&gt;newdataset($x);
		}
	}
    $grdata{nachkomma}=0;
    $grdata{N}=$self-&gt;{pins};
	$grdata{nachkomma}=0;
    $grafik-&gt;setdata(\%grdata);
    $grafik-&gt;createimg;

	return
}


####################################################################
####         macht aus den Arrays der Wheres und tables 2 Strings
####         Argumente  : -
####         Returnwert : -
####################################################################
sub jointables {
	my ($self, $tableref, $whereref) = @_;
	my @table=@$tableref; my @where=@$whereref;
	my $OK=0;
	foreach (@table) { $OK=1 if /ergebnis/}
	unless ($OK) {push @table,"ergebnis kell"; push @where,"kell.umfid=".$self-&gt;{id};}
	my $wh = join (" and ", @where);
	if (@table == 1) {return $table[0], $wh };
	while (($table[0]=~/benutzer/) &amp;&amp; ($x&lt;$#table)) { $join=shift @table; push @table, $join; $x++}
	$join = shift @table;
	$join=$join." left join ". join (" using(pin) left join ", @table)." using(pin)";
	return ($join, $wh);
}

####################################################################
####         Gibt die otto Statistik für die Umfrage aus
####         Argumente  : -
####         Returnwert : -
####################################################################
sub otto {
	my $self = shift;
    $self-&gt;log(4,"Entering: umfrage:otto");
    my $SQL1 = "select  hermes.depot from benutzer ".
               "left join hermes on hermes.plz=benutzer.plz left join umfidpin on umfidpin.pin=benutzer.pin where umfidpin.umfid=$self-&gt;{id}";
    my $SQL3 = "select distinct depot,ort,gebiet from hermes order by id";
    my $SQL4 = "select distinct pin from ergebnis where umfid=$self-&gt;{id}";
	my $rows = $self-&gt;sqldo($SQL4);
    my ($HTML, $pin, $plz, $depot, @adepot, @xdepot, @aleit, @xleit, $x, $leit, @proz, @Lleit, @Ldepot, @aids, $aid);
    my $file2=$baseq::UMFIMG."U".$self-&gt;{id}."O2T".$rows.".gif";
    my $sth=$self-&gt;sqlprepare("select distinct aid,antwort from antworten where umfid=$self-&gt;{id} and fid=1");
	while (($aid,$atext)=$sth-&gt;fetchrow_array) {push @aids, $aid; $atext=~/,\s*([0-9\.]+)\.\d{4}$/; push @antworts, $1}

	$sth=$self-&gt;sqlprepare($SQL1);
	while ( ($depot)=$sth-&gt;fetchrow_array) {	$adepot[$depot]++;  	}
	$sth-&gt;finish;

	foreach $aid (@aids) {
          my $SQL2 = "select distinct ergebnis.pin ,benutzer.plz, hermes.depot from ergebnis ".
		   "left join benutzer on benutzer.pin=ergebnis.pin ".
		   "left join hermes on hermes.plz=benutzer.plz where ergebnis.umfid=$self-&gt;{id} and ergebnis.fid=1 and ergebnis.aid=$aid";
          $sth=$self-&gt;sqlprepare($SQL2);
	      while ( ($pin,$plz,$depot)=$sth-&gt;fetchrow_array) {	$xdepot[$aid][$depot]++; }
	      $sth-&gt;finish;
	}

	$HTML.=$self-&gt;qfont("Aufteilung der Zulieferung nach Tagen und Depots")."&lt;BR&gt;&lt;BR&gt;\n";
	$HTML.="&lt;TABLE border=1&gt;\n".$self-&gt;TR(["Dep","Name","Geb.","n","ges", @antworts]);
	$sth=$self-&gt;sqlprepare($SQL3);
	while ( ($x,$xa,$xb)=$sth-&gt;fetchrow_array) {
    	  @xdepotaid=(); $ges=0;
	      foreach $aid (@aids) {
		      if ($xdepot[$aid][$x] eq "") {$xdepot[$aid][$x]="&amp;nbsp;";}
		      push @xdepotaid, $xdepot[$aid][$x];
			  $ges+=$xdepot[$aid][$x];
		  }
		  unshift @xdepotaid, $ges;
          if ($x&lt;10) {$x="0".$x;}
		  if ($adepot[$x]&lt;10){$adepot[$x]="0".$adepot[$x];}
		  if ($adepot[$x]==0){$adepot[$x]="0";}
		  push @Ldepot,"$ges Depot[$x] ($adepot[$x])";
          $HTML.=$self-&gt;TR(["[$x]",$xa,$xb,$adepot[$x],@xdepotaid ]);
	}

   	$Y=open (FILE, "&lt;$baseq::PATH.$file2"); close FILE;
	if (! $Y) {grafik::paint("VL",$baseq::PATH.$file2, 25,\@Ldepot,0,100,0,1);}

        $HTML.="&lt;/TABLE&gt;\n&lt;HR&gt;\n".$self-&gt;IMG($file2)."\n&lt;HR&gt;\n";

	######################################## 5.7 ) Pin, Depot,Einz,mehrfam Datum, Zuste
	my $titel="R&amp;uuml;ckmeldung der Panelteilnehmer";
	my $HTMLX=$self-&gt;qfont($titel)."&lt;BR&gt;\n&lt;TABLE border=1&gt;\n";
	$HTMLX.=$self-&gt;TR(["Nr","Depot","PIN","R&amp;uuml;ckmeldung am","Katalogankunft","Wohnart"]);
	my $SQL="select hermes.depot, hermes.ort, ergebnis.pin, ergebnis.changed, ergebnis.aid from ergebnis left join benutzer on ergebnis.pin=benutzer.pin ".
			"left join hermes using(plz) where umfid=$self-&gt;{id} and fid&lt;3 order by hermes.id,ergebnis.pin, ergebnis.fid";
	my $sth=$self-&gt;sqlprepare($SQL);
	my $oldpin=0;
	foreach $f (@{$self-&gt;{FL}}) {
		if ($f-&gt;{id}==1) {@F1A=$f-&gt;antwortarray}
		if ($f-&gt;{id}==2) {@F2A=$f-&gt;antwortarray}
	}
	while (@L=$sth-&gt;fetchrow_array) {
		my $pin=$L[2]; #PIN
		if ($pin==$oldpin) {
			push (@Lout, @F2A[$L[4]] ) ;  #AID
			$HTMLX.=$self-&gt;TR(\@Lout);
		}
		else {
			@Lout=@L;
			$Lout[3]=$self-&gt;timestamp($Lout[3]); #CHANGED
			$Lout[4]=@F1A[$Lout[4]]; #AID
			$self-&gt;log(4,"PIN=$pin, OldPIN=$oldpin");
			$oldpin=$pin;
		}
	}
        $HTMLX.="&lt;/TABLE&gt;\n";
	my $filename=$baseq::UMFIMG."U".$self-&gt;{id}."OTTO-TAB".$sth-&gt;rows.".html";
	$self-&gt;log(4,"OTTO-Schreckliche Tabelle: ".$baseq::PATH.$filename);
	$self-&gt;printhtml($titel,$HTMLX,$baseq::PATH.$filename);
	$HTML.=$self-&gt;AH($filename,$self-&gt;qfont($titel))."&lt;HR&gt;\n";
	return $HTML;

}

####################################################################
####         Selektiert eine neue PIN für Panellose Umfragen
####         Argumente  : -
####         Returnwert : Neue Pin
####################################################################
sub newpin {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:newpin");
        my ($a,$b,$c,$d)=$ENV{REMOTE_ADDR}=~/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/;
	my $avgpin=$self-&gt;sqlselect("select avg(pin) from ergebnis where umfid=$self-&gt;{id}");
	$avgpin=~s/\..*$//;
	my $resu=$avgpin+$a+$b+$c+$d;
	$self-&gt;log(4,"AveragePIN: $avgpin+$a+$b+$c+$d=$resu");
	while ($self-&gt;sqlselect("select pin from ergebnis where umfid=$self-&gt;{id} and pin=$resu")&gt;0) {$resu++;}
	$self-&gt;log(4,$baseq::VARS{fid});
	$baseq::VARS{fid}=$self-&gt;{firstfid};
	return $resu;
}

####################################################################
####         Überprüft den Umfragenzeitraum
####         Argumente  : -
####         Returnwert : 0=aktuell, 1=noch nicht aktiv, 2=vorbei
####################################################################
sub checkdate {
      my $self = shift;
      $self-&gt;log(4,"Entering: umfrage:checkdate");
      my $date = $self-&gt;sqlselect("select NOW() from umfragen");
      my $user = $self-&gt;sqldo("select distinct pin from ergebnis where umfid=$self-&gt;{id}");
      if ( ($baseq::VARS{fid} &lt; 1) or ($baseq::VARS{fid} == $self-&gt;{firstfid}) ) {$user++}
      my $ret=0;
      $self-&gt;log(4,"Datum=$date");
      if ($date gt $self-&gt;{ende}) {$ret=2;}
      if ($date lt $self-&gt;{beginn}) {$ret=1;}
      if ($user &gt; $self-&gt;{maxuser}) {$ret=3;}
      return $ret;
}

####################################################################
####         Exportieren der Umfrage
####         Argumente  : -
####         Returnwert : 0=aktuell, 1=noch nicht aktiv, 2=vorbei
####################################################################
sub export {
      my $self = shift;
	  my $q=$self-&gt;loadfragen;
	  my $exp="[umfrage]\n";
	  foreach  (@{$self-&gt;{exportvars}}) {
		  next if ref $self-&gt;{$_};
		  $exp.=sprintf("%-13s = %s\n", $_, $self-&gt;{$_} );
	  }
	  $exp.="\n";
	  foreach (@$q) {
		$exp.=$_-&gt;export;
	  }
      $exp.="[ergebnisse]\n";
	  my $sth=$self-&gt;sqlprepare("select fid,aid,pin,text from ergebnis where umfid=$self-&gt;{id}");
      while (my @X=$sth-&gt;fetchrow_array) {
	     $exp.=sprintf("%3d %3d %5d ",@X).$X[3]."\n";
      }	  	
	  print "Content-type: text/plain\n\n$exp";
	  $self-&gt;exit;
}

####################################################################
####         Exportieren der Umfrage
####         Argumente  : -
####         Returnwert : 0=aktuell, 1=noch nicht aktiv, 2=vorbei
####################################################################
sub exportxls {
      my $self = shift;
	  my $q=$self-&gt;loadfragen;
	  my $excel  = Spreadsheet::WriteExcel-&gt;new("-");
      my $umfragen = $excel-&gt;addworksheet("Umfrage");
      my $fragen = $excel-&gt;addworksheet("Fragen");
      my $antworten = $excel-&gt;addworksheet("Antworten");
	  my $ergebnisse= $excel-&gt;addworksheet("Ergebnisse");
	  my $cnt=0;
	  foreach  (@{$self-&gt;{exportvars}}) {
		  $umfragen-&gt;write_string(0,$cnt, $_);
  		  $umfragen-&gt;write_string(1,$cnt++, $self-&gt;{$_});
	  }
	  $cnt=0;my $antrow=0;
	  foreach (@$q) {
		$antrow=$_-&gt;exportxls($fragen,$antworten,$cnt++,$antrow);
	  }
      $exp.="[ergebnisse]\n";
	  my $sth=$self-&gt;sqlprepare("select fid,aid,pin,text from ergebnis where umfid=$self-&gt;{id}");
	  $cnt=1;
	  my @li= qw/Frageid AntwortID PIN Text/;
	  while (my @X=$sth-&gt;fetchrow_array) {
		 for (0...3) {
		    $ergebnisse-&gt;write_string(0,$_,$li[$_]);
			$ergebnisse-&gt;write_string($cnt,$_,$X[$_]);	
		 }
         $cnt++
	  }	  	
	  print "Content-type: application/vnd.ms-excel\n\n";
	  $excel-&gt;close();	
	  $self-&gt;exit;
}

####################################################################
####         Liste der Panelisten bei dieser Umfrage 
####         Argumente  : -
####         Returnwert : 
####################################################################
sub pinliste {
	my $self=shift;
	if ($self-&gt;{usepanel} != 1 ) {$self-&gt;{warntext}="Bei Panelloser Umfrage gibt es keine Pinliste !";$self-&gt;htmlumfrage;$self-&gt;exit;}  # ohne Panel macht das keinen Sinn :-)
	my ($HTML);
	my $sth=$self-&gt;sqlprepare("select  distinct b.pin, b.vname, b.nname, b.stadt from ergebnis left join benutzer b using(pin) where umfid='$self-&gt;{id}' order by b.pin");
	while (my (@udat) = $sth-&gt;fetchrow_array) {
		$HTML.=$self-&gt;TR([$self-&gt;CB("delpin-$udat[0]"),@udat]);
	}
	$HTML="&lt;TABLE&gt;\n".$self-&gt;TR(["","&lt;b&gt;PIN&lt;/b&gt;","&lt;b&gt;Vorname&lt;/b&gt;","&lt;b&gt;Nachname&lt;/b&gt;","&lt;b&gt;Ort&lt;/b&gt;"]).$HTML."&lt;TABLE&gt;\n".$self-&gt;SM("but","BU75");
	$self-&gt;printhtml("Panelliste",$HTML);
}


####################################################################
####         Löscht angeklickte Panelisten 
####         Argumente  : -
####         Returnwert : 
####################################################################
sub rmpanelist {
	my $self=shift;
	my (@pinlist, $where);
	foreach (keys %baseq::VARS) { #alle Variablen nach "delpin-xxxxx" durchsuchen
		push @pinlist, "pin=$1" if /delpin-(\d{5})$/;
	}
	if ($#pinlist &gt; -1) { # Das WHERE statement zusammenbauen
		my $where=" where umfid='$self-&gt;{id}' and ( ".join(" or ",@pinlist)." )";
		$self-&gt;log(4,$where);
		if ($where ne "") { # noch eine Sicherheitsabfrage - Paranoia ole :-)
			$self-&gt;sqldo("delete from umfidpin $where");
			$self-&gt;sqldo("update ergebnis set umfid=umfid+1000000 $where");
			$self-&gt;sqldo("insert into verbrkasse (pin,umfid,betrag) select (pin,umfid,betrag) from kasse $where");
			$self-&gt;sqldo("delete from kasse $where");
		}
	}
	$self-&gt;htmlumfrage;
}


####################################################################
#####         Musterbefragung - Information-Anforderung
#####         Versendet Mail
####################################################################
#
sub benachrichtigungsmail {

my $self = shift;
my $pin = shift;
my $umfid = shift;
my $fid = shift;


$self-&gt;log(4,"Entering: Musterumfrage - Benachrichtigungsmail wird erstellt!! ");

$mailprog = '/usr/sbin/sendmail';
$absender = 'prorataweb@prorata.de';
$subject = 'Information-Anforderung durch Musterbefragung';

my $FROM="musterbefragung\@prorata.de";
my $TO="info\@prorata.de";
#
#my $TO="ija.peters\@prorata.de";
my $date = getdate();

($firma)=$self-&gt;sqlselect("select text from ergebnis where umfid=$umfid  AND fid=$fid AND aid=1 and pin=$pin;");
($anrede)=$self-&gt;sqlselect("select text from ergebnis where umfid=$umfid  AND fid=$fid AND aid=2 and pin=$pin;");
($vname)=$self-&gt;sqlselect("select text from ergebnis where umfid=$umfid  AND fid=$fid AND aid=3 and  pin=$pin;");
($nname)=$self-&gt;sqlselect("select text from ergebnis where umfid=$umfid  AND fid=$fid AND aid=4 and  pin=$pin;");

($email)=$self-&gt;sqlselect("select text from ergebnis where umfid=$umfid  AND fid=$fid AND aid=7 and pin=$pin;");
($telefon)=$self-&gt;sqlselect("select text from ergebnis where umfid=$umfid  AND fid=$fid AND aid=5 and pin=$pin;");
($fax)=$self-&gt;sqlselect("select text from ergebnis where umfid=$umfid AND fid=$fid AND aid=6 and pin=$pin;");


#$self-&gt;log(4,"Entering: Musterumfrage - Infozusendung!! email = $email ");
#$self-&gt;log(4,"Entering: Musterumfrage - Infozusendung!! telefon = $telefon");
#$self-&gt;log(4,"Entering: Musterumfrage - Infozusendung!! fax = $fax");



#if (($email != "") or ($telefon != "") or ($fax != ""))
#
if (($email ne "") || ($telefon ne "") || ($fax ne ""))
{

   $self-&gt;log(4,"Entering: Musterumfrage - Interessenten-Daten vorhanden -  kann kontaktiert werden!! ");

#   $self-&gt;log(4,"Entering: Musterumfrage - Infozusendung!! email = $email ");
#   $self-&gt;log(4,"Entering: Musterumfrage - Infozusendung!! telefon = $telefon");
#   $self-&gt;log(4,"Entering: Musterumfrage - Infozusendung!! fax = $fax");
   
   
        # Open The Mail Program
         open(MAIL,"|$mailprog -t");
        #open(MAIL,"&gt;&gt;tehest");
        my $date = getdate();
        print MAIL "To: $TO\n";
        print MAIL "From: $absender\n";
       # Print Message Subject
       print MAIL "Subject: $subject \n\n";
       print MAIL "Hallo!  \n\n";
       print MAIL "durch Musterbefragung wurde Information angefordert.\n\n";
       print MAIL "Interessent:\n\n";
       print MAIL "Firma: $firma\n";
       print MAIL "Anrede: $anrede \n";
       print MAIL "Vorname: $vname\n";
       print MAIL "Nachname: $nname \n";
       print MAIL "eMail-Adresse: $email\n";
       print MAIL "Telefon: $telefon \n";
       print MAIL "Fax: $fax \n\n";
       print MAIL "Mit freundlichem Gruß\n\nPRORATA.WEB - automatischer DB-Administrator!\n";
       print MAIL "-------------------------------------------------------\n\n".
       "Information angefordert am ".$date."\n";
       close (MAIL);

       $self-&gt;log(4,"Entering: Musterumfrage - Benachrichtigungsmail abgeschickt!! ");

}
	else{ $self-&gt;log(4,"Entering: Musterumfrage - kann nicht kontaktiert werden!! ");}
      
}


  ####################################################################
  #####         Gibt die locale Zeit aus
  #####         Argumente  :
  ####         Returnwert : -
  #####################################################################
  
   sub getdate {
       @days   = ('Sonntag','Montag','Dienstag','Mittwoch',
                 'Donnerstag','Freitag','Samstag');
       @months = ('Januar','Februar','März','April','Mai','Juni','Juli',
                  'August','September','Oktober','November','Dezember');
     ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6];
     $time = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
     $year += 1900;
     $date = "$days[$wday], $months[$mon] $mday, $year um $time";
     return $date;
  }
</pre></body></html>