package frage;

use template;
use antwort;
use grafikm;
#use strict;

@ISA = qw ( template );


####################################################################
####         Konstruktor der Fragenklasse
####         Argumente  : parent, umfid, Fragentext, Fragentyp
####         Returnwert : -
####################################################################
sub init {
	my $that = shift;
	my $class = ref($that) || $that;
	my $self = template->init(@_);
    if (! defined $self->{parent}) { $self->log(1,"Frage bitte mit parent initialisieren");}
	my @V=qw/umfid id name typ bild nextfid grafik incent gschmuck sort minant maxant showstat qtface qtsize qtcolor atface atsize atcolor/;
	bless $self, $class;	
	$self->{umfid}    = $self->{parent}->{id};
    $self->{name}     = "";
	$self->{typ}      = "E";
	$self->{bild}     = "";	
	$self->{ant}      = [];
	$self->{nextfid}  = 0;
	$self->{template} = $self->{parent}->{template};
    $self->{grafik}   ="BAS";
	$self->{incent}	  = 1;
	$self->{gschmuck} = 1;  # 3D grafiken
	$self->{sort}	  = 0;  #Sortierung ( 0=nach Antwortnummer )
	$self->loadtmp();
	$self->{minant}=0;
	$self->{maxant}=0;
	$self->{showstat}=1;
	$self->{stfcace}=$self->{parent}->{stface};
	$self->{stsize}=$self->{parent}->{stsize};
	$self->{stcolor}=$self->{parent}->{stcolor};
	$self->{exportvars}=\@V;
	$self->{ordernum}="neu";
	return $self;
}

####################################################################
####         Konstruktor der Fragenklasse
####         Argumente  : parent, umfid, fid
####         Returnwert : -
####################################################################
sub load {
	my $self = shift;
    $self->log(4,"Entering: frage:load");
	my $sql = "select typ,frage,nextfid,bild,qtface,qtsize,qtcolor,atface,atsize,atcolor,grafik,incent,gschmuck,sort,minant,maxant,showstat,ordernum ".
		      " from fragen where umfid=$self->{umfid} and fid=$self->{id} ";
	($self->{typ}, $self->{name}, $self->{nextfid}, $self->{bild}, $self->{qtface}, $self->{qtsize}, $self->{qtcolor},
	 $self->{atface}, $self->{atsize}, $self->{atcolor}, $self->{grafik}, $self->{incent}, $self->{gschmuck},
	 $self->{sort},$self->{minant},$self->{maxant},$self->{showstat},$self->{ordernum}) = $self->sqlselect($sql);
	if (! defined $self->{nextfid}) {return;}
	if ($self->{ordernum} eq "") {$self->{ordernum}=$self->{id} }	
	$self->loadantw;
	$self->{grafik}=substr($self->{grafik},0,2);
	return $self;
}

####################################################################
####         Saug die Eigenschaften von woanders
####         Argumente  : array der Eigenschaften
####         Returnwert : -
####################################################################
sub getpreloaded {
	my $self = shift;
	($self->{umfid}, $self->{id}, $self->{name}, $self->{typ}, $self->{bild}, $self->{nextfid}, 
	 $self->{qtface}, $self->{qtsize}, $self->{qtcolor}, $self->{atface}, $self->{atsize}, $self->{atcolor}, 
	 $self->{grafik}, $self->{incent}, $self->{gschmuck}, $self->{sort}, $self->{minant}, $self->{maxant}, $self->{showstat}, $self->{ordernum} ) = @_;
	if ($self->{ordernum} eq "") {$self->{ordernum}=$self->{id} }	
	$self->loadantw;
}

####################################################################
####         Antworten zur Frage laden und in $self->{ant} speichern
####         Argumente  : umfid, fid
####         Returnwert : -
####################################################################
sub loadantw {
	my $self = shift;
    $self->log(4,"Entering: frage:loadantw");
	my (@y, $x);
	my $sql = "select * from antworten where umfid=$self->{umfid} and fid=$self->{id}";
	my $sth = $self->sqlprepare($sql);
	$self->{ant}=\@y;
	while (my @ant = $sth->fetchrow_array) {
	   my $a = antwort->init($self,1); 
	   $a->getpreloaded(@ant);
	   push @y, $a;  #existierende Fragen ins Array packen
	}
	return;
}

####################################################################
####         Ermittelt eine neue fid und speichert sich
####         Argumente  : -
####         Returnwert : -
####################################################################
sub new {
	my $self = shift;
	my $sql1 = "select max(fid) from fragen where umfid=$self->{umfid} ";
	my $a;
	$self->log(4,"Entering: frage:new");
	$self->sqldo("lock table fragen write");
	$self->{id} = ($self->sqlselect($sql1))+1;
	while ($self->sqldo("select fid from fragen where umfid='$self->{umfid}' and ordernum='$self->{ordernum}' and fid!='$self->{id}'") > 0) {
		$self->{ordernum}.="x";
	}
	my $sql2 = "insert into fragen set umfid=$self->{umfid}, fid=$self->{id}, frage='$self->{name}', ".
		   "typ='$self->{typ}', bild='$self->{bild}', nextfid='$self->{nextfid}', ".
		   "qtface='$self->{qtface}', qtsize='$self->{qtsize}', qtcolor='$self->{qtcolor}', ".
		   "atface='$self->{atface}', atsize='$self->{atsize}', atcolor='$self->{atcolor}', ".
		   "grafik='$self->{grafik}', incent='$self->{incent}', gschmuck='$self->{gschmuck}', ".
		   "sort='$self->{sort}', minant='$self->{minant}', maxant='$self->{maxant}', ".
		   "showstat='$self->{showstat}', ordernum='$self->{ordernum}' ";
	$self->sqldo($sql2);
	$self->sqldo("unlock tables");
	foreach $a (@{$self->{ant}}) {$a->{umfid}=$self->{umfid}; $a->{fid}=$self->{id}; $a->new;}
}

####################################################################
####         Speichert sich mit Update
####         Argumente  : evtl Fragentext und Fragentyp
####         Returnwert : -
####################################################################
sub store {
	my $self = shift;
        $self->log(4,"Entering: frage:store");
	if (@_[0]) { $self->{name} = @_[0]; }
	if (@_[1]) { $self->{typ} = @_[1]; }
	while ($self->sqldo("select fid from fragen where umfid='$self->{umfid}' and ordernum='$self->{ordernum}' and fid!='$self->{id}'") > 0) {
		$self->{ordernum}.="x";
	}
	my $sql = "update fragen set frage='$self->{name}', typ='$self->{typ}', nextfid='$self->{nextfid}', bild='$self->{bild}', ".
		  "qtface='$self->{qtface}', qtsize='$self->{qtsize}', ".
		  "qtcolor='$self->{qtcolor}', atface='$self->{atface}', atsize='$self->{atsize}', atcolor='$self->{atcolor}', ".
		  "grafik='$self->{grafik}', incent='$self->{incent}', gschmuck='$self->{gschmuck}', ".
 		  "sort='$self->{sort}', minant='$self->{minant}', maxant='$self->{maxant}', showstat='$self->{showstat}', ordernum='$self->{ordernum}' ".
		  "where umfid=$self->{umfid} and fid=$self->{id}";
	$self->sqldo($sql);
	my $a; 
	foreach $a ( @{$self->{ant}} ) {$a->store}
}

####################################################################
####         Löscht sich und alle seine Antworten der Probanden
####	     aus der DB
####         Argumente  : -
####         Returnwert : -
####################################################################
sub delete {
	my $self = shift;
        $self->log(4,"Entering: frage:delete");
	my $sql  = "delete from fragen where umfid=$self->{umfid} and fid=$self->{id} ";
        my $sql1 = "update fragen set nextfid=$self->{nextfid} where umfid=$self->{umfid} and nextfid=$self->{id}";
        my $sql2 = "update antworten set nextfid=$self->{nextfid} where umfid=$self->{umfid} and nextfid=$self->{id}";
        my $sql3 = "select pin from ergebnis where umfid=$self->{umfid} and fid=$self->{id}";
	my $antw = $self->sqldo($sql3);
	if ($antw>1) {return $self->trans("WA15a")." ".$self->{id}." ".$self->trans("WA15c");}
	$self->sqldo($sql);
 	my $f=frage->init($self->{parent}, $self->{nextfid}); $f=$f->load;
 	if (defined $f) {             # Die nextfids nur updaten
	   $self->sqldo($sql1);
	   $self->sqldo($sql2);       # wenn es meine nextfid-Frage gibt
	}
	my $x=$self->{id};
	$self->{id} = undef;
	my $a; 
	foreach $a (@{$self->{ant}}) {$a->delete}
    return $self->trans("WA15a")." ".$x." ".$self->trans("WA15b");
}

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

####################################################################
####         Liefert einen eindeutigen identifikationsstring
####         Argumente  : -
####         Returnwert : Identifikationsstring
####################################################################
sub IDstr {
	my $self = shift;	
	return "U" . $self->{umfid} . "F" . $self->{id}  ;
}

####################################################################
####         Liefert den Fragentext mit Nummer davor in ()
####         Argumente  : -
####         Returnwert : Fullname
####################################################################
sub fullname {
	my $self = shift;	
	return "(" . $self->{ordernum} . ") " . $self->{name}  ;
}

####################################################################
####         Erstellt eine neue Antwort zur Frage
####         Argumente  : Antworttext
####         Returnwert : AntwortID
####################################################################
sub newant {
	my $self = shift;	
	my $a;
	my $L=$self->{ant};
        $self->log(4,"Entering: frage:newant");
	$a = antwort->init($self); $a->new();
	if ($a) {push (@$L, $a);}  #existierende Fragen ins Array packen
	return $a->{id};
}

####################################################################
####         Aendert die FID der Frage
####         Argumente  : neue FID
####         Returnwert : -
####################################################################
sub changefid {
	my $self = shift;
	my $neue = shift()+0;
	$self->log(4,"Entering: frage:changefid");
	if ($neue == $self->{id} ) { return $neue; }
	my $sql = "select fid from fragen where umfid=$self->{umfid} and fid=$neue";	
	if ($neue != 0){
        my $tst = $self->sqlselect($sql);                        # gibts diese Antw.ID schon ?
		if ($tst == 0) {
			$self->sqldo("update fragen set fid=$neue where umfid=$self->{umfid} and fid=$self->{id}");                    
			if ($self->{nextfid}==$self->{id}) {$self->{nextfid}=$neue; $self->store;}
            my $sql1 = "update fragen set nextfid=$neue where umfid=$self->{umfid} and nextfid=$self->{id}";
            my $sql2 = "update antworten set nextfid=$neue where umfid=$self->{umfid} and nextfid=$self->{id}";
			$self->sqldo($sql1);
			$self->sqldo($sql2);
			$self->{id}=$neue;									# wenn nicht, dann speichern
			foreach (@{$self->{ant}}) {$_->changefid($self->{id});}
		}	
			
	}
	return $neue;                                                    # neue ID zurückgeben
}

####################################################################
####         Gibt Zeiger auf die nächste Frage zurück
####         Argumente  : die PIN und 1 damit auch sichselbst als nächste Frage gibt, sonst nicht
####                 oder bei 2 gibt er immer die nächste , ob beantwortet oder nicht !    										
####         Returnwert : Zeiger auf nächste Frage oder kein Zeiger, wenn letzte
####################################################################
sub nextfrage {
	my $self = shift;	
        my $pin= shift;                               # Benutzerpin
	my $selftoo= shift;                           # Steuervariable
	my $firstfid= shift;			      # erstefid gegen loopings.....	
        $self->log(4,"Entering: frage:nextfrage");
	if ($firstfid==0){$firstfid=$self->{id};}
	my $nf; my $fra;  my $nextf; my $acnt;
	foreach (@{$self->{ant}}) {
	  if ( defined ($nf=$_->getnextfid($pin))) {
		$nextf=$nf;								 # Von allen beantworteten Fragen die Nextfid holen
		$acnt++;
	  } 
        }                                             # Und in nextf speichern
	if (! defined $nextf) {                       # nicht def., bzw 0  =  nicht beantwortet
	    if ($selftoo == 1) {return $self;}        # bei "ichauch" gebe ich mich zurück
	    $nextf=$self->{nextfid};                  # sonst die Standardnextfid der Frage
        }
        if ($nextf == 0) {$nextf=$self->sqlselect("select fid from fragen where umfid='$self->{umfid}' and ordernum > '$self->{ordernum}' order by ordernum");}
        if ($nextf == -1) {return;}                   # Fragebogen zuende !!
	if ($nextf == $self->{id}) {
		$self->log(4,"Ich bin Nextfid von mir selbst !"); 
		if ($self->{warntext} eq "") {
			$self->{warntext} = $self->trans("WA5");
		}
		return $self; 
	}
					 	       # bin ich selbst meine nächste ? , Dann halt mich zurück um endlosschl. zu verh.
    if ($nextf == $firstfid) {$self->log(2,"Aaargh, Antwortlooping entdeckt !"); return;}    # Wenn die Anfangsfrage wieder auftaucht:  Loopinggefahr!!! und ENDE !
    $fra=frage->init($self->{parent}, $nextf); $fra=$fra->load;     # nächste Frage fragen !!!
	if (! defined $fra) {return;}                   # wenn nicht definiert dann ende
	if ($selftoo == 2) {return $fra;}             # unbedingt nächste Frage, dann nächste zurück !
	return $fra->nextfrage($pin,1,$firstfid);     # rekursiv die nächste mit "ichauch" aufrufen

}

####################################################################
####         Nummeriert die Antworten neu durch
####         Argumente  : -
####         Returnwert : -
####################################################################
sub renumant {
	my $self = shift;
	my $a=undef; my $x=1; 
        $self->log(4,"Entering: frage:renumant");
	foreach $a ( @{$self->{ant}}) { $a->changeaid($x++) }
}

####################################################################
####         Loescht die Antwort mit der angegebenen ID
####         Argumente  : Aid der Antwort
####         Returnwert : -
####################################################################
sub delant {
	my $self = shift;
	my $a; 
	my $aid = shift;  my @L=();
    $self->log(4,"Entering: frage:delant");
	foreach $a (@{$self->{ant}}) {
		if ($a->{id} == $aid) {$a->delete;}
		else {push (@L, $a); }
	}	
	$self->{ant}=\@L;
}

####################################################################
####         Speichert die Antworten der Panelisten
####         Argumente  : Zeiger auf Variablen
####         Returnwert : -
####################################################################
sub enterant {
	my $self = shift;
	my ($a,$gd,$acnt);
    my $ID=$self->IDstr;
	my $sql1= "select pin from ergebnis where umfid=$baseq::VARS{umfid} and fid=$baseq::VARS{fid} and pin=$baseq::VARS{pin}";
    $self->log(4,"Entering: frage:enterant");
	if ( defined $self->sqlselect($sql1) ) { 
		$self->{warntext}=$self->trans("WA4");
		return ;
	}
	foreach (keys %baseq::VARS) {
		next unless /^$ID/;
		if ($baseq::VARS{$_} ne "") {$acnt++ }
	}
	$self->log(4,"acnt=$acnt");
	if ($acnt>$self->{maxant} && $self->{maxant}>0) {	# Wenn zuviel angeklickt wurde.....	
		$self->{warntext}=$self->trans("WA5b")." ".$self->{maxant}." ".$self->trans("WA5c");
		$self->log(4,"Zuviel angeklickt !");
		return;
	}
	if ($acnt<$self->{minant} && $self->{minant}>0) {   # Wenn zuwenig angeklickt wurde.....	
		$self->{warntext}=$self->trans("WA5a")." ".$self->{minant}." ".$self->trans("WA5c");
		$self->log(4,"Zuwenig angeklickt !");
		return; 
	}
	
	foreach (@{$self->{ant}}) { $_->enterant; }	
    return;
}

####################################################################
####         Uebernimmt Textattribute des Parent
####         Argumente  : Zeiger auf Variablen
####         Returnwert : -
####################################################################
sub settext {
	my $self = shift;
    $self->log(4,"Entering: frage:settext");
	$self->{qtface} = $self->{parent}->{qtface};
 	$self->{qtsize} = $self->{parent}->{qtsize};
 	$self->{qtcolor} = $self->{parent}->{qtcolor};
	$self->{atface} = $self->{parent}->{atface};
 	$self->{atsize} = $self->{parent}->{atsize};
 	$self->{atcolor} = $self->{parent}->{atcolor};
    $self->store;
}


####################################################################
####         Gibt die Frage als html für Panelisten aus
####         Argumente  : -
####         Returnwert : HTML-text der Frage
####################################################################
sub htmlfra {
	my $self = shift;
	my ($BILD, $ordernum);
    $self->log(4,"Entering: frage:htmlfra");
	if ($self->{bild} ne "") { $BILD=$self->IMG($self->{bild}); } else {$BILD="&nbsp;"}
	if ($self->{warntext} eq "") {$self->{warntext}=$self->{parent}->{warntext};}
	$self->{helpkontext}="frage_".substr $self->{typ},0,1;
	$TITLE=$self->trans("TI6");
    	$HTML= $self->qfont($self->fullname());
    	if ($self->{typ} eq "H") {$HTML=$self->qfont($self->{name});}
	$HTML.="\n<BR>\n<TABLE>\n".
 	$self->TR([ $self->htmlant , $BILD ]).
	"</TABLE>\n<BR><BR>\n";
	my @L1=("but","but","but","but"); my @L2=("BU25","BU3","BU2","BU24");
	if (! $self->{parent}{uspringen}) {@L1=("but","but","but"); @L2=("BU25","BU2","BU24");}  # Überspringen
	if ($self->{typ} eq "H")  {@L1=("but","but"); @L2=("BU25","BU24");}  # Nur Weiter
	$HTML.=$self->SMrow(\@L1,\@L2);
    $self->printhtml("prorata.web: internet market research", $HTML)
}

####################################################################
####         Gibt die Antworten als html für Probanden zurück
####         Argumente  : -
####         Returnwert : Antworten als HTML
####################################################################
sub htmlant {
	my $self = shift;
	my ($a, $ret, $me );
	my @L=@{$self->{ant}} ;
 	my @LI=("&nbsp;","&nbsp;");
	my $typ = $self->{typ};
    (my $typ1, my $menge) = $typ =~/^(.)(.*)/;
	my $me=0;
	my $Start="<TABLE size=100% >\n";
	my $End="</TABLE>\n";
    $self->log(4,"Entering: frage:htmlant");
	if ($typ1 eq "D" ) {$Start="<SELECT name='".$self->IDstr."'>\n"; $End="</SELECT>\n";}
	if ($typ1 eq "S" ) {
		for ($me=1; $me<=$menge; $me++) { @Li[$me+1] = $self->afont($me); }
       	$Start.=$self->TR(\@Li);
    }
    $ret .= $Start;
	while ($a=shift @L) { $ret .= $a->htmlant;  }	
    $ret .= $End;

	return $ret
}	
			
####################################################################
####         Gibt sich und die Antworten zur Bearbeitung
####		durch den Kunden aus
####         Argumente  : -
####         Returnwert : HTML-string
####################################################################
sub htmlbearb {
	my $self = shift;
	my ( $a, $ret, @merk, $x, $fid, @fidl, @freefids  );
	my $TITLE=$self->trans("TI6")." ".$self->{id};
	$self->log(4,"Entering: frage:htmlbearb");
	my $typ=substr($self->{typ},0,1);
		
	$ret=$self->TF("ordernum", $self->{ordernum},5 )."\n".
	"<TEXTAREA NAME=\"frage\" cols=80 rows=8
	>".$self->{name}."</TEXTAREA>".
	"\n<BR><BR>\n";

        $ret.="<TABLE>\n".
                $self->TR([ $self->sfont($self->trans("HI25")),
                            $self->sfont($self->trans("HI26")),
                            $self->sfont($self->trans("HI27")),
                            $self->sfont($self->trans("HI28")) ]).
                $self->TR([ $self->sfont($self->trans("HI24")),
                            $self->DDfface("qtface",$self->{qtface}),
                            $self->TF("qtsize",$self->{qtsize},5),
                            $self->DDfcolor("qtcolor",$self->{qtcolor})  ]).
                $self->TR([ $self->sfont($self->trans("HI29")),
                            $self->DDfface("atface",$self->{atface}),
                            $self->TF("atsize",$self->{atsize},5),
                            $self->DDfcolor("atcolor",$self->{atcolor})  ]).
	      "</TABLE>\n<BR><BR>\n";	

    	$ret.="<TABLE>\n".
	      $self->TR([
				$self->sfont($self->trans("HI31c")),
				$self->sfont($self->trans("HI30")),
				$self->sfont($self->trans("HI31")),
				$self->sfont($self->trans("HI31a")),
				$self->sfont($self->trans("HI31j")) ]).
					
		  $self->TR([
				$self->CB("incent", 1, $self->{incent}) ,
				$self->TF("bild",$self->{bild},30),
				$self->DDordernum("nextfid",$self->{nextfid}),
				$self->DD("typ", $self->{ltyp}, $self->{typ}, $self->{htyp} ),
				$self->CB("showstat", 1, $self->{showstat}) ]).

		  $self->TR([
				$self->sfont($self->trans("HI31b")),
				$self->sfont($self->trans("HI31d")),
				$self->sfont($self->trans("HI31f")), 
				$self->sfont($self->trans("HI31g")) ]).		 
		  
		  $self->TR([
				$self->DD("grafik",$self->{lgrafik}{$typ}, $self->{grafik}, $self->{hgrafik}{$typ}),
				$self->DD("gschmuck",$self->{lschmuck}, $self->{gschmuck}, $self->{hschmuck}),
				$self->DD("sort", $self->{lsort},$self->{sort}, $self->{hsort}),
				$self->sfont($self->trans("HI31h").$self->TF("minant",$self->{minant},3,3).$self->trans("HI31i").$self->TF("maxant",$self->{maxant},3,3)) ]).	
		  "</TABLE>\n";
	



        $ret.="<TABLE>\n".$self->TR([
                $self->sfont($self->trans("HI37")),
                $self->sfont($self->trans("HI38")),
                $self->sfont($self->trans("HI44")),
                $self->sfont($self->trans("HI45")),
                $self->sfont($self->trans("HI106")),
				$self->sfont($self->trans("HI31")),
				]);

        for ($x=1;$x<6;$x++){ push (@merk, $self->newant); }     # 5 neue Antworten bauen
	my @L=@{$self->{ant}};
	while ($a=shift @L) { $ret.=$a->htmlbearb; }                     # alle Antworten ausgeben
	while ($a=shift @merk) {$self->delant($a);}                      # und die 5 wieder löschen....
        $ret.="</TABLE>\n<BR>\n".
      	$self->SMrow(["but","but","but","but","but","but"] , ["BU1","BU5","BU10","BU8","BU4","BU24"]); 

        $self->{helpkontext}="fragebearbeiten";
        $self->printhtml($TITLE, $ret);
        return;
}

####################################################################
####         nimmt die Änderungen aus dem Formular an
####         Argumente  : Zeiger auf Variablen
####         Returnwert : -
####################################################################
sub getbearb {
	my $self = shift;
	my ( $a, $gd, $good, @L, @L1, $x );
        $self->log(4,"Entering: frage:getbearb");
	$self->{name}=$self->clean($baseq::VARS{frage});
	$self->{bild}=$self->fclean($baseq::VARS{bild});	
	$self->{nextfid}=$baseq::VARS{nextfid}+0;
	$self->{typ}=$self->fclean($baseq::VARS{typ});
	$self->{qtface}=$self->fclean($baseq::VARS{qtface});	
	$self->{qtsize}=$self->fclean($baseq::VARS{qtsize});	
	$self->{qtcolor}=$self->fclean($baseq::VARS{qtcolor});	
	$self->{atface}=$self->fclean($baseq::VARS{atface});	
	$self->{atsize}=$self->fclean($baseq::VARS{atsize});	
	$self->{atcolor}=$self->fclean($baseq::VARS{atcolor});
	$self->{grafik}=$self->fclean($baseq::VARS{grafik});
	$self->{incent}=$baseq::VARS{incent}+0;
	$self->{gschmuck}=$baseq::VARS{gschmuck}+0;
	$self->{sort}=$baseq::VARS{sort}+0;
	$self->{minant}=$baseq::VARS{minant}+0;
	$self->{maxant}=$baseq::VARS{maxant}+0;
	$self->{showstat}=$baseq::VARS{showstat}+0;
	$self->{ordernum}=$self->fclean($baseq::VARS{ordernum});
	my $newfid=$baseq::VARS{newfid}+0;
	for ($x=1;$x<6;$x++){  $self->newant; }           # 5 neue Antworten bauen
	@L=@{$self->{ant}};
	foreach $a (@L) { $a->getbearb($#L+2); }            # Werte einlesen
	foreach $a (@L) {if ( $a->{name} eq "") {$self->delant($a->{id});};} # alle leeren Antworten loeschen
		$self->loadantw;
		$self->renumant;
		$self->store;
	# if ($newfid != $self->{id}) {$self->changefid($newfid);}	# ist mit den neuen Nummern nicht mehr nötig !!!
}
	
####################################################################
####         Listet die Fragen auf zur Anzeige für den Kunden
####         Argumente  : -
####         Returnwert : HTML-text
####################################################################
sub fragenliste {
	my $self = shift;
	my $ret=""; my $a; my @L=@{$self->{ant}}; my $next;
	my $umf=$self->{parent};
	my $warn="&nbsp;";
        $self->log(4,"Entering: frage:fragenliste");
	if ($self->{nextfid} == $self->{id}) {$warn=$self->trans("LW5");}
	if (! ($self->{qtsize}=~/^\+{0,1}[0-9]$/)) {$warn=$self->trans("LW6");}
	if (! ($self->{atsize}=~/^\+{0,1}[0-9]$/)) {$warn=$self->trans("LW7");}
	if ($self->{typ} eq "" ) {$warn=$self->trans("LW8");}
	if ($self->{nextfid} != 0) {
		 $next=$self->sfont(">".$baseq::RHordernums->{$self->{nextfid}});
	}
	$ret.=$self->TR([
	        $self->RB("radio",$self->{id}),
	      	$self->{ordernum}.")",
	      	$self->sfont("[".$self->{typ}."]") . $self->qfont($self->{name}),
	      	$next,
	      	$self->sfont($warn)  ]);
	$self->log(4,"Jetzt in die Antwortenliste");      	
	while ($a=shift @L) { $ret.=$a->antwortenliste; }
	$ret.=$self->TR(["&nbsp","&nbsp;","&nbsp;","&nbsp;"]);  # Eine Leerzeile......
	return $ret;
}
	
####################################################################
####         Strickt die Grafik für Live statistik
####         Argumente  : -
####         Returnwert : HTML-text
####################################################################
sub makegrafik {
	my ($self, $grafik) = @_;
	$self->log(4,"Entering: frage:makegrafik");

	my ($X)=$self->{typ}=~/^S(\d{1,2})$/;    # $X=5 oder 7 wenn Skalenantwort 	      	
	# $self->{olda}=0;                   ######### Nochn OTTO-HACK (siehe antwort.pm->grafikdataset)
    my $N=$self->{countpin};
	my %grdata;
	$self->log(4,"OTTO HACK: ".$self->{parent}->{knr}." | ".$self->{id});

	########################### OTTO HACK :-)
	#if ( ($self->{parent}->{knr}==4) && ($self->{id}==1) ) {
	#	$N=$self->sqlselect("select count(pin) from umfidpin where umfid=$self->{umfid}");
	#}
	########################### OTTO Hack Ende.....

	if ($X>0) {$N=$X;}
	$grdata{N}=$N;
	$grafik->setdata(\%grdata);
	foreach ( @{$self->{ant}} ) {$grafik->newdataset($_->grafikdataset($X));}
	$grafik->createimg;
    return;
}

####################################################################
####         Strickt die Grafik für Live statistik
####         Argumente  : -
####         Returnwert : HTML-text
####################################################################
sub htmlgrafik {
	my $self = shift;
	my $IMG="";
    $self->log(4,$self->{details}." -- ".$self->IDstr);
    if ($self->{details} ne "" && $self->IDstr ne $self->{details}) {return $self->grafikhtml;}
	$self->{grpid}=$self->{parent}->{grpid};
	$self->{grplfd}=$self->{parent}->{grplfd};
	$self->log(4,"Entering: frage:htmlgrafik");
	if ($self->{typ} eq "H" || (! $self->{showstat}) ) {return;}
	if ($self->{countpin}){
	   if ($self->{typ} ne "T") {	
		   $IMG=$self->grafikhtml;			
		}
        else {
		  if ($self->IDstr eq $self->{details}) {
				$IMG=$self->grafikdetails.
				$self->SM("stbut","BU58"); 
		  }
		  $IMG.=$self->SM("stbut".$self->IDstr,"BU59");
		} 
	}	
	
	else {$IMG=$self->afont($self->trans("HI40"));}
	return $self->qfont($self->fullname()) ."<BR>\n". $IMG . "\n<HR>\n"; 	
}

####################################################################
####         Fragenstatistik
####         Argumente  : -
####         Returnwert : Zeiger auf Datensatz
####################################################################
sub createantarrayref {
	my $self = shift;
	my @ret;
	foreach ( @{$self->{ant}} ) {
		$ret[$_->{id}]=$_;
    		$self->log(2,"FID:".$self->{id}." AID:".$_->{id});
	}
	return ($self->{id}, \@ret);
}

####################################################################
####         Erstellt HTML-Datei mit Textantworten
####         Argumente  : -
####         Returnwert : Link auf HTML-Datei
####################################################################
sub grafikdetails {
	my $self = shift;
    $self->log(4,"Entering: frage:htmltextant");
	if ($self->{typ}=~/^S\d+$/ ) {return $self->grafikdetailskala();}
	my $ret="";
    if ($self->{showstat}) {
    	foreach  (@{$self->{ant}}) {$ret .= $_->htmltextant; }
	}
	return $ret;
}

####################################################################
####         Erstellt HTML-Datei mit Textantworten
####         Argumente  : -
####         Returnwert : Link auf HTML-Datei
####################################################################
sub grafikdetailskala {
	my $self = shift;
    $self->log(4,"Entering: frage:htmltextant");

	my $HTML="";

	# fid, aid anzahl der Antworten und Textantworten selektieren
	@where=@{$self->{parent}->{whereref}}; @table=@{$self->{parent}->{tableref}}; 
	push @where, ("a.umfid=$self->{umfid}","a.fid=$self->{id}"); push @table, "ergebnis a";
	($table, $where) = $self->{parent}->jointables(\@table, \@where);
	my $sth=$self->sqlprepare("select a.aid, a.text from $table where $where ");
	while ( my ($aid, $txt) = $sth->fetchrow_array ) {
		$ants[$aid][$txt]++  # Mitzaehlen wieviel
	}
	$sth->finish;
	
    my $grafik=grafikm->init($self->{parent});
    $grdata{GRA}="BA";      
    $grdata{pid}=$self->{parent}->{grpid};
    $grdata{plfd}=$self->{parent}->{grplfd};
    $grdata{schmuck}=1;
    $grdata{sorttype}="lfd";
    $grdata{shadowcolor}=$self->{shadowcolor};
    $grdata{textformath}="&T - &P%";
    $grdata{textformatv}="Nr.&L (&Z) ";
    $grdata{nachkomma}=0;
	my @names;
	foreach (@{$self->{ant}}) {$names[$_->{id}]=$_->{name} }
	foreach $aid (1...$#ants) {
                my $zufz=int(rand 10000000)+1;
		my $filename=$baseq::UMFIMG."U".$self->{umfid}."F".$self->{id}."C".$self->{countpin}."-".$self->{parent}->{grpid}."x".$self->{parent}->{grplfd}."x".$aid.$zufz.".gif";		
	    $self->log(4,"DETAILS Grafikdatei = $baseq::PATH.$filename / X=$X, IDG=$IDG, IDS=$IDS IDV=$IDV");
		$grafik->imgreset;
		$grdata{filename}=$baseq::PATH.$filename;
	    $grafik->setdata(\%grdata);
	    @anz=@{$ants[$aid]};
		foreach (1...$#anz) {
			$name=$self->{name};
			$name=~s/<[^>]+[>\$]//g;
			$grafik->newdataset({"lfd" => $_,
			 				     "txt" => "Antworten mit $_",
							     "num" => $ants[$aid][$_],
							     "tabl"=> "ergebnis",
			 			         "wher"=> "umfid='$self->{umfid}' fid='$self->{id}' aid='$aid' text=$_",
							     "descr"=>$name.": ".$names[$aid]." - Antwort=$_"});
								 
		}	
		$grafik->createimg;
		$HTML.= $self->qfont($names[$aid])."<BR>\n".$self->IMGsubmit($filename, "stbut".$grafik->{id})."<BR>\n";
	}
    return $HTML;
}

####################################################################
####         liefert ein Array der Antworttexte zurueck
####         Argumente  : -
####         Returnwert : das Array
####################################################################

sub antwortarray {
	my $self = shift;
	my @erg=();
	foreach (@{$self->{ant}}) {$erg[$_->{id}]=$_->{name};}
	$self->log(4,join (" - ", @erg) );
	return @erg;
}

####################################################################
####         liefert den fuer diese Frage verdienten Betrag
####		 in Eurocent
####         Argumente  : -
####         Returnwert : Link auf HTML-Datei
####################################################################

sub verdient {
	my $self = shift;
	my $pin = shift;
	if ($pin==0) {$self->log(1, "frage->verdient : PIN wurde nicht übergeben !"); }
	my $sql="select aid from ergebnis where umfid=$self->{umfid} and fid=$self->{id} and pin=$pin";
	if ($self->sqlselect($sql)){return $self->{incent};}
	return 0;
}

####################################################################
####         Pivotiert die Ergebnistabelle
####		 in Eurocent
####         Argumente  : -
####         Returnwert : Zeiger auf Hash und TextString
####################################################################

sub pivot {
	  my $self=shift;
	  my $hash=shift;
	  my $num=$self->{id};
	  if ($num<10) {$num="0".$num;}
	  my $beschr="\n\nFRAGE ".$self->{id}."\n========\n";
	  my $zah=10000; my %bes; my $key="";my $txt="";my $aid; my $pin;
	  my $sql="select distinct a.pin,a.aid,a.text,b.ID from ergebnis a left join pivot b using(umfid,fid,aid,pin) where a.umfid=$self->{umfid} and a.fid=$self->{id} order by b.ID";
	  my $sth=$self->sqlprepare($sql);
	  while (($pin,$aid,$txt,$grpid)=$sth->fetchrow_array) {
	  if ($grpid) {$txt=$grpid}
		$txt=~s/ä/ae/g;
		$txt=~s/ö/oe/g;
		$txt=~s/ü/ue/g;
		$txt=~s/Ä/ae/g;
		$txt=~s/Ö/oe/g;
		$txt=~s/Ü/ue/g;
		$txt=~s/ß/ss/g;
		$txt=~s/[^a-z,\.@\d]/ /gi;
		$txt=~s/\s*(.*)\s*/$1/;
        $txt=~s/,/\./g;		
		if ($txt eq "" ){$txt="1";}		#Anklickantworten
		if ( $txt =~ /[^\d\.]/) {	    #Textantworten als Zahl
     		$txt=~s/\./,/g;		
			$txt=lc($txt);
			if ($bes{$txt} == 0) {$bes{$txt}=++$zah; }
			$self->log(4,$bes{$txt}."  ||  ".$txt);
			$txt=$bes{$txt};
		}
		my $col ="F".$num."A".$aid;
		$$hash{$pin}{$col}=$txt;
		$$hash{$pin}{-pin}=$pin;
		$$hash{0}{$col}=$col;			# Den Beschreibungstext in der ersten Zeile.....
		$txt="";
	  }
	  foreach $key (sort {$bes{$a} <=> $bes{$b} } keys %bes) {
		$beschr.=$bes{$key}."\t".$key."\n";
	  }
	  
	  if ($zah==10000) {$beschr="";}
	  
	  return $beschr;
}	  	

####################################################################
####         Exportieren der Frage
####         Argumente  : -
####         Returnwert : string
####################################################################
sub export {
      my $self = shift;
	  my $exp="   [frage]\n";
	  foreach  (@{$self->{exportvars}}) {
		  $exp.=sprintf("   %-13s = %s\n", $_, $self->{$_} );
	  }
  	  $exp.="\n";
	  foreach (@{$self->{ant}}) {
		$exp.=$_->export;
	  }
      return $exp;
}

####################################################################
####         Exportieren der Frage
####         Argumente  : -
####         Returnwert : string
####################################################################
sub exportxls {
      my ($self,$fragen, $antworten,$row,$antrow) = @_;
	  my $cnt=0;
	  foreach  (@{$self->{exportvars}}) {
		  $fragen->write_string(0,$cnt, $_);
  		  $fragen->write_string($row,$cnt++, $self->{$_});
	  }
	  foreach (@{$self->{ant}}) {
		$_->exportxls($antworten,$antrow++);
	  }
	  return $antrow;
}