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->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->{name}     = "Neue Umfrage";
	$self->{usepanel} = 1;
	$self->{template} = $self->{parent}->{template}+0;
	$self->{knr} 	  = $self->{parent}->{knr}+0;
	$self->{showstat} = 0;
	$self->{sprache}  = 0;
    	$self->{exiturl}  = "http://www.prorata.de";
    	$self->{beginn}   = '2010-05-01';
	$self->{ende}	  = '2010-05-01';
	$self->{ppf}	  = 20;
	$self->{firstfid} = 0;
	$self->{uspringen} = 0;
	$self->{maxuser}  = 100;
	$self->{status}	  = 0;  # Stataus = normal, geloescht, Archiv usw.
	$self->{exportvars}=\@V;
	return $self;
}

####################################################################
####         Laden der Umfrage aus der DB
####         Argumente  : -
####         Returnwert : -
####################################################################
sub load {
	my $self = shift;
        $self->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->{id}";
	($self->{name}, $self->{usepanel}, $self->{template}, $self->{knr},
	 $self->{showstat},$self->{beginn},$self->{ende},$self->{ppf}, $f,$s,$c, $self->{exiturl},
	 $self->{uname}, $self->{upass}, $self->{sprache}, $self->{firstfid}, $self->{uspringen},
	 $self->{maxuser} ) = $self->sqlselect($sql);
	if (! defined $self->{knr}) {$self->log(2,"Umfrage ist nicht vorhanden"); return;}
	$baseq::VARS{umfid}=$self->{id};		# Umfid setzen
	$self->loadtmp();    	                	# Template laden
        $self->loadsprache($self->{sprache});                             # Sprache laden
	$self->{stface}=$f; $self->{stsize}=$s; $self->{stcolor}=$c;
	$self->loadordernum();
	return $self;
}

####################################################################
####         Laden der Umfrage aus der DB
####         Argumente  : -
####         Returnwert : -
####################################################################
sub loadordernum {
	my $self = shift;
	my %ordernums=(-1 => "Ende", 0 => "Nächste");
	my @lordernum=(-1,0);
	my $sth=$self->sqlprepare("select fid, ordernum from fragen where umfid='$self->{id}' order by ordernum,fid");
	while (my ($fid, $ordernum) = $sth->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->log(4,"Entering: umfrage:new");
	$self->sqldo("lock tables umfragen");
	my $sql1 = "select max(umfid) from umfragen";
	($self->{id}) = ($self->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->{name}', $self->{id}, $self->{usepanel}, $self->{template}, '$self->{knr}', ".
			   "'$self->{showstat}', '$self->{beginn}', '$self->{ende}', '$self->{ppf}', ".
		       "'$self->{stface}', '$self->{stsize}', '$self->{stcolor}', '$self->{exiturl}', ".
   		       "'$self->{uname}', '$self->{upass}', '$self->{sprache}', '$self->{firstfid}', ".
			   "'$self->{uspringen}', '$self->{maxuser}', '$self->{deleted}' )";
	$self->sqldo($sql2);
	$self->sqldo("unlock tables umfragen");
    $baseq::VARS{umfid}=$self->{id}		# Umfid setzen
}

####################################################################
####         Speichert sich mit Update
####         Argumente  : -
####         Returnwert : -
####################################################################
sub store {
	my $self = shift;
        $self->log(4,"Entering: umfrage:store");
	my $sql = "update umfragen set umfrage='$self->{name}', usepanel=$self->{usepanel}, ".
		  "template=$self->{template}, knr=$self->{knr}, ".
		  "showstat=$self->{showstat}, beginn='$self->{beginn}', ".
    	  "ende='$self->{ende}', ppf=$self->{ppf}, ".
		  "stface='$self->{stface}', stsize='$self->{stsize}', stcolor='$self->{stcolor}', ".
	 	  "name='$self->{uname}', pass='$self->{upass}', exiturl='$self->{exiturl}', sprache=$self->{sprache}, ".
		  "firstfid=$self->{firstfid}, uspringen=$self->{uspringen}, maxuser=$self->{maxuser}, ".
		  "status='$self->{status}' where umfid=$self->{id}";
	$self->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->log(4,"Entering: umfrage:delete");
	my $inhalt=$self->sqldo("select pin from ergebnis where umfid=$self->{id} and pin !='$baseq::TESTPIN'");
    if ($inhalt > 0) {  # Wir muessen uns unsichtbar machen
		$self->{status} = 1;  # Status auf 1=deleted setzen
		$self->store;
		return ;
	}
	my $sql  = "delete from umfragen where umfid=$self->{id}";
	$self->sqldo($sql);
	my $f;
	my $y=$self->loadfragen;
	foreach (@$y) {$_->delete}
	$self->{id} = undef;
	return ;
}

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

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

####################################################################
####         liest die Antworten ein
####         Argumente  : -
####         Returnwert : -
####################################################################
sub enterant {
	my $self = shift;
	my $f;
       $self->log(4,"Entering: umfrage:enterant");
	my @RE=("",$self->trans("WA1"),$self->trans("WA2"),"");
	my $x=0;
	$self->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->trans("BU11")) {$self->redirect;}

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

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

	# Ist der Fragebogen aktiv ??

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

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

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

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

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

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


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

}


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

	$self->sqldo("delete from ergebnis where umfid=$self->{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->log(4,"Entering: Musterumfrage - Kunde wünscht Infozusendung!! ");
		$self->benachrichtigungsmail($baseq::VARS{pin},$baseq::VARS{umfid},$baseq::VARS{fid});
	}

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	# Wenn alles andere versagt.....   :-)
	else { $self->htmlumfrage; $self->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->log(4,"Entering: umfrage:getumfbearb");
	$self->{name}=$self->fclean($baseq::VARS{umfrage});
	$self->{template}=$baseq::VARS{template}+0;
	$self->{usepanel}=$baseq::VARS{usepanel}+0;
	$self->{showstat}=$baseq::VARS{showstat}+0;
	$self->{beginn}=$self->fclean($baseq::VARS{beginn});
	$self->{ende}=$self->fclean($baseq::VARS{ende});
	$self->{ppf}=$baseq::VARS{ppf}+0;
	$self->{stface}=$self->fclean($baseq::VARS{stface});
	$self->{stsize}=$self->fclean($baseq::VARS{stsize});
	$self->{stcolor}=$self->fclean($baseq::VARS{stcolor});
	$self->{exiturl}=$self->fclean($baseq::VARS{exiturl});
    $self->{uname}=$self->fclean($baseq::VARS{uname});
	$self->{upass}=$self->fclean($baseq::VARS{upass});
	$self->{sprache}=$baseq::VARS{sprache}+0;
	$self->{firstfid}=$baseq::VARS{firstfid}+0;
	$self->{uspringen}=$baseq::VARS{uspringen}+0;
    $self->{maxuser}=$baseq::VARS{maxuser}+0;
	$self->store;
    $self->load;
	$self->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->log(4,"Entering: umfrage:verdient");
	if ($pin==0) {$self->log(1, "umfrage->verdient : PIN wurde nicht übergeben !"); }
	if ($pin!=100){
		foreach $f (@{$self->loadfragen}) {$x+=$f->verdient($pin);}
		return sprintf("%0.2f",$x*$self->{ppf}/100);#/
	}
}
####################################################################
####         Liefert den Preis für die Beantwortung !
####         Argumente  : -
####         Returnwert : Betrag in Pfennigen
####################################################################
sub IDstr {
	my $self = shift;
	return "U".$self->{id}."DE".$self->{gtyp};
}

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

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


####################################################################
####         Gibt die Statistik für die Umfrage aus
####         Argumente  : -
####         Returnwert : -
####################################################################
sub htmlgrafik {
	my $self = shift;
    $self->log(4,"Entering: umfrage:htmlgrafik");
   $self->sqldo("delete from bar where changed < NOW()-100000");
	$self->{FL}=$self->loadfragen;  # alle Fragen laden
    $self->{grafik}="VL";	#Grafiktyp auf Verlauf fuer erste Grafik
	$self->{sort}=0;		# Sortierung auf lfd
    $self->{gschmuck}=1;	# kein Schmuck
	my @tdiff; my @FL=@{ $self->{FL} };# FL = Fragenliste
	my (@shortcuta, @shortcutf, $sth, $pins, $oldgraf, %oldkoord, $whereref, $tableref, $descref,
		@table, @where, $target, $details, @pinselect, $alles, @hiddenpin);
	my $grafik=grafikm->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->{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->{statselpin}=\@hiddenpin;
	}
	if ($alles) {push @$whereref, "(".join(" or ", @pinselect).")" }
	$self->log(4, "Whereref - PIN:". $$whereref[0]);

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

	if (defined $target) {
		($tableref, $whereref, $descref) = $grafik->tablwher($target);	#wenn ein klick auf eine Grafik war
		$self->{grpid}=$target->{id};	# die ID der alten
		$self->{grplfd}=$target->{lfd};	# und die lfd sich merken machen tun
	}
	($self->{tableref}, $self->{whereref}) = ($tableref, $whereref);
	$grafik->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) = $_->createantarrayref;
		$self->log(2,"ERROR: ID: ".$id);
		$shortcuta[$id]=$ref;	# Array[fid][aid] zeigt auf Antwortobjekt
		$shortcutf[$id]=$_;		# Array[fid] zeigt auf das Frageobjekt
		$shortcutf[$id]->{countpin}=0;  # Zaehler resetten
	}

	# fid, aid anzahl der Antworten und Textantworten selektieren
	@where=@{$whereref}; @table=@{$tableref};
	push @where, "a.umfid=$self->{id}"; push @table, "ergebnis a";
	($table, $where) = $self->jointables(\@table, \@where);
	$sth=$self->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->fetchrow_array ) {
		$shortcuta[$fid][$aid]->{countpin}=$cnt;	# Die Anzahl der Antworten zuweisen
		$shortcuta[$fid][$aid]->{avgtext}=$avg;		# Den Durchschnitt bei Skalen dem Antwortobjekt mitteilen
	}
	$sth->finish;

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

	@where=@{$whereref}; @table=@{$tableref};
	my $tab1="ergebnis a";
	my $tab2="ergebnis b";
	my @whe1=("a.umfid=$self->{id}", "a.fid=".($baseq::VARS{kreuztab1}+0) );
	my @whe2=("b.umfid=$self->{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->jointables(\@table, \@where);
	$sth=$self->sqlprepare("select $sel1, $sel2, count(*) from $table where $where group by $sel1, $sel2");
	my (@kreuztab, $maid1, $maid2);
	while ( my ($aid1, $aid2, $cnt) = $sth->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>$maid1) {$maid1=$aid1}
		if ($aid2>$maid2) {$maid2=$aid2}
	}
	$sth->finish;

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

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

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

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

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

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

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

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

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

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

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

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


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


sub makegrafik {
    my ($self, $grafik) = @_;
	my $typ=$self->{gtyp};
	my %grdata;
    $self->log(4,"Demos: $typ");
    if ($typ ne "FID") {
     $self->{typ}="E";
	 my @list;
     $evalcode="\@list=\@baseq::$typ";
     eval $evalcode;
     $self->log(4,"EVAL: $evalcode");
     $self->log(4,"\@list=". join("|", @list) );
     for (0...$#list) {
		if ($list[$_] eq "") {next;}
		my $x={};
		$x->{tabl}="benutzer";
		$x->{lfd}=$_;
		$x->{num}=$self->{benutzer}->{$typ}[$_];
		$x->{txt}=$list[$_];
		$x->{wher}=$democol{$typ}."=".$_;
		$x->{descr}=$baseq::TITLE{$typ}.": ".$list[$_];
		$self->log(4,"\$x->{wher}=".$x->{wher} );
		$grafik->newdataset($x);
	 }
	}
    else {
		my $x={};
		$x->{tabl}="ergebnis";
        $grdata{textformatv}="Frage: &T";
        $grdata{textformath}="&Z - &P%";
        $grdata{sorttype}="txt";
		$self->{typ}="M";
		my @tmpa=@{$self->{benutzer}->{FID}};
		foreach (1...$#tmpa) {
		  if ($tmpa[$_]==0) {next;}
		  $x->{lfd}=$_;
		  $x->{txt}=$baseq::RHordernums->{$_};
		  $x->{num}=$tmpa[$_];
		  $x->{wher}="umfid=$self->{id} fid=".($_);
          	  $x->{descr}=$baseq::TITLE{$typ}.": Frage ".$tmpa[$_];
		  $grafik->newdataset($x);
		}
	}
    $grdata{nachkomma}=0;
    $grdata{N}=$self->{pins};
	$grdata{nachkomma}=0;
    $grafik->setdata(\%grdata);
    $grafik->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->{id};}
	my $wh = join (" and ", @where);
	if (@table == 1) {return $table[0], $wh };
	while (($table[0]=~/benutzer/) && ($x<$#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->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->{id}";
    my $SQL3 = "select distinct depot,ort,gebiet from hermes order by id";
    my $SQL4 = "select distinct pin from ergebnis where umfid=$self->{id}";
	my $rows = $self->sqldo($SQL4);
    my ($HTML, $pin, $plz, $depot, @adepot, @xdepot, @aleit, @xleit, $x, $leit, @proz, @Lleit, @Ldepot, @aids, $aid);
    my $file2=$baseq::UMFIMG."U".$self->{id}."O2T".$rows.".gif";
    my $sth=$self->sqlprepare("select distinct aid,antwort from antworten where umfid=$self->{id} and fid=1");
	while (($aid,$atext)=$sth->fetchrow_array) {push @aids, $aid; $atext=~/,\s*([0-9\.]+)\.\d{4}$/; push @antworts, $1}

	$sth=$self->sqlprepare($SQL1);
	while ( ($depot)=$sth->fetchrow_array) {	$adepot[$depot]++;  	}
	$sth->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->{id} and ergebnis.fid=1 and ergebnis.aid=$aid";
          $sth=$self->sqlprepare($SQL2);
	      while ( ($pin,$plz,$depot)=$sth->fetchrow_array) {	$xdepot[$aid][$depot]++; }
	      $sth->finish;
	}

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

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

        $HTML.="</TABLE>\n<HR>\n".$self->IMG($file2)."\n<HR>\n";

	######################################## 5.7 ) Pin, Depot,Einz,mehrfam Datum, Zuste
	my $titel="R&uuml;ckmeldung der Panelteilnehmer";
	my $HTMLX=$self->qfont($titel)."<BR>\n<TABLE border=1>\n";
	$HTMLX.=$self->TR(["Nr","Depot","PIN","R&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->{id} and fid<3 order by hermes.id,ergebnis.pin, ergebnis.fid";
	my $sth=$self->sqlprepare($SQL);
	my $oldpin=0;
	foreach $f (@{$self->{FL}}) {
		if ($f->{id}==1) {@F1A=$f->antwortarray}
		if ($f->{id}==2) {@F2A=$f->antwortarray}
	}
	while (@L=$sth->fetchrow_array) {
		my $pin=$L[2]; #PIN
		if ($pin==$oldpin) {
			push (@Lout, @F2A[$L[4]] ) ;  #AID
			$HTMLX.=$self->TR(\@Lout);
		}
		else {
			@Lout=@L;
			$Lout[3]=$self->timestamp($Lout[3]); #CHANGED
			$Lout[4]=@F1A[$Lout[4]]; #AID
			$self->log(4,"PIN=$pin, OldPIN=$oldpin");
			$oldpin=$pin;
		}
	}
        $HTMLX.="</TABLE>\n";
	my $filename=$baseq::UMFIMG."U".$self->{id}."OTTO-TAB".$sth->rows.".html";
	$self->log(4,"OTTO-Schreckliche Tabelle: ".$baseq::PATH.$filename);
	$self->printhtml($titel,$HTMLX,$baseq::PATH.$filename);
	$HTML.=$self->AH($filename,$self->qfont($titel))."<HR>\n";
	return $HTML;

}

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

####################################################################
####         Überprüft den Umfragenzeitraum
####         Argumente  : -
####         Returnwert : 0=aktuell, 1=noch nicht aktiv, 2=vorbei
####################################################################
sub checkdate {
      my $self = shift;
      $self->log(4,"Entering: umfrage:checkdate");
      my $date = $self->sqlselect("select NOW() from umfragen");
      my $user = $self->sqldo("select distinct pin from ergebnis where umfid=$self->{id}");
      if ( ($baseq::VARS{fid} < 1) or ($baseq::VARS{fid} == $self->{firstfid}) ) {$user++}
      my $ret=0;
      $self->log(4,"Datum=$date");
      if ($date gt $self->{ende}) {$ret=2;}
      if ($date lt $self->{beginn}) {$ret=1;}
      if ($user > $self->{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->loadfragen;
	  my $exp="[umfrage]\n";
	  foreach  (@{$self->{exportvars}}) {
		  next if ref $self->{$_};
		  $exp.=sprintf("%-13s = %s\n", $_, $self->{$_} );
	  }
	  $exp.="\n";
	  foreach (@$q) {
		$exp.=$_->export;
	  }
      $exp.="[ergebnisse]\n";
	  my $sth=$self->sqlprepare("select fid,aid,pin,text from ergebnis where umfid=$self->{id}");
      while (my @X=$sth->fetchrow_array) {
	     $exp.=sprintf("%3d %3d %5d ",@X).$X[3]."\n";
      }	  	
	  print "Content-type: text/plain\n\n$exp";
	  $self->exit;
}

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

####################################################################
####         Liste der Panelisten bei dieser Umfrage 
####         Argumente  : -
####         Returnwert : 
####################################################################
sub pinliste {
	my $self=shift;
	if ($self->{usepanel} != 1 ) {$self->{warntext}="Bei Panelloser Umfrage gibt es keine Pinliste !";$self->htmlumfrage;$self->exit;}  # ohne Panel macht das keinen Sinn :-)
	my ($HTML);
	my $sth=$self->sqlprepare("select  distinct b.pin, b.vname, b.nname, b.stadt from ergebnis left join benutzer b using(pin) where umfid='$self->{id}' order by b.pin");
	while (my (@udat) = $sth->fetchrow_array) {
		$HTML.=$self->TR([$self->CB("delpin-$udat[0]"),@udat]);
	}
	$HTML="<TABLE>\n".$self->TR(["","<b>PIN</b>","<b>Vorname</b>","<b>Nachname</b>","<b>Ort</b>"]).$HTML."<TABLE>\n".$self->SM("but","BU75");
	$self->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 > -1) { # Das WHERE statement zusammenbauen
		my $where=" where umfid='$self->{id}' and ( ".join(" or ",@pinlist)." )";
		$self->log(4,$where);
		if ($where ne "") { # noch eine Sicherheitsabfrage - Paranoia ole :-)
			$self->sqldo("delete from umfidpin $where");
			$self->sqldo("update ergebnis set umfid=umfid+1000000 $where");
			$self->sqldo("insert into verbrkasse (pin,umfid,betrag) select (pin,umfid,betrag) from kasse $where");
			$self->sqldo("delete from kasse $where");
		}
	}
	$self->htmlumfrage;
}


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

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


$self->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->sqlselect("select text from ergebnis where umfid=$umfid  AND fid=$fid AND aid=1 and pin=$pin;");
($anrede)=$self->sqlselect("select text from ergebnis where umfid=$umfid  AND fid=$fid AND aid=2 and pin=$pin;");
($vname)=$self->sqlselect("select text from ergebnis where umfid=$umfid  AND fid=$fid AND aid=3 and  pin=$pin;");
($nname)=$self->sqlselect("select text from ergebnis where umfid=$umfid  AND fid=$fid AND aid=4 and  pin=$pin;");

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


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



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

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

#   $self->log(4,"Entering: Musterumfrage - Infozusendung!! email = $email ");
#   $self->log(4,"Entering: Musterumfrage - Infozusendung!! telefon = $telefon");
#   $self->log(4,"Entering: Musterumfrage - Infozusendung!! fax = $fax");
   
   
        # Open The Mail Program
         open(MAIL,"|$mailprog -t");
        #open(MAIL,">>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->log(4,"Entering: Musterumfrage - Benachrichtigungsmail abgeschickt!! ");

}
	else{ $self->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;
  }