package frage;

use template;
use antwort;
use grafik;
#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");}
    	bless $self, $class;	
	$self->{umfid}    = $self->{parent}->{id};
        $self->{name}     = "";
	$self->{typ}      = "E";
	$self->{bild}     = "";	
	$self->{ant}      = [];
	$self->{nextfid}  = $self->{id}+1;
	$self->{template} = $self->{parent}->{template};
        $self->{grafik}   ="BAS";
	$self->loadtmp();
	$self->{stfcace}=$self->{parent}->{stface};
	$self->{stsize}=$self->{parent}->{stsize};
	$self->{stcolor}=$self->{parent}->{stcolor};
	return $self;
}

####################################################################
####         Konstruktor der Fragenklasse
####         Argumente  : parent, umfid, fid
####         Returnwert : -
####################################################################
sub load {
	my $self = shift;
	my $sql = "select typ,frage,nextfid,bild,qtface,qtsize,qtcolor,atface,atsize,atcolor,grafik 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->sqlselect($sql);
	if (! defined $self->{nextfid}) {return;}
	$self->loadantw;
        return $self;
}

####################################################################
####         Antworten zur Frage laden und in $self->{ant} speichern
####         Argumente  : umfid, fid
####         Returnwert : -
####################################################################
sub loadantw {
	my $self = shift;
	my $sql = "select max(aid) from antworten where umfid=$self->{umfid} and fid=$self->{id}";
	my $maxant = $self->sqlselect($sql);
        my @y=(); my $x=0;
	$self->{ant}=\@y;
	for ( $x=1; $x<=$maxant; $x++) {
	   $a = antwort->init($self,$x); $a=$a->load();
	   if ($a) { 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} ";
	$self->{id} = ($self->sqlselect($sql1))+1;
	$self->{nextfid}  = $self->{id}+1;
        my $sql2 = "insert into fragen values ( $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->sqldo($sql2);
}

####################################################################
####         Speichert sich mit Update
####         Argumente  : evtl Fragentext und Fragentyp
####         Returnwert : -
####################################################################
sub store {
	my $self = shift;
	if (@_[0]) { $self->{name} = @_[0]; }
	if (@_[1]) { $self->{typ} = @_[1]; }
	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}' where umfid=$self->{umfid} and fid=$self->{id}";
	$self->sqldo($sql);
	my $a; my @L=@{$self->{ant}};
	while ($a=shift @L) {$a->store}
}

####################################################################
####         Löscht sich und alle seine Antworten der Probanden
####	     aus der DB
####         Argumente  : -
####         Returnwert : -
####################################################################
sub delete {
	my $self = shift;
	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; my $y=$self->{ant};
	while ($a=shift @$y) {$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;	
	my $tring = "U" . $self->{umfid} . "F" . $self->{id}  ;
	return $tring;
}

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

####################################################################
####         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,"Enter nextfrage");
	if ($firstfid==0){$firstfid=$self->{id};}
	my $a; my $nf; my $fra;  my $nextf; my @L=@{$self->{ant}};
	while ($a=shift @L) {
	  if ($nf=$a->getnextfid($pin)) {$nextf=$nf}  # Von allen beantworteten Fragen die Nextfid holen
        }                                             # 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 == -1) {return;}                   # Fragebogen zuende !!
	if ($nextf == $self->{id}) {
		$self->log(4,"Ich bin Nextfid von mir selbst !"); 
		$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; my @L=@{$self->{ant}};
	while ($a=shift @L) { $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 $y=$self->{ant}; my @L=();
	while ($a=shift @$y) {
		if ($a->{id} == $aid) {$a->delete;}
		else {push (@L, $a); }
	}	
	$self->{ant}=\@L;
}

####################################################################
####         Speichert die Antworten
####         Argumente  : Zeiger auf Variablen
####         Returnwert : -
####################################################################
sub enterant {
	my $self = shift;
	my $a; my $gd;  my @L=@{$self->{ant}}; my $good; my %vars=%{$self->{vars}};
        my $sql1= "select pin from ergebnis where umfid=$vars{umfid} and fid=$vars{fid} and pin=$vars{pin}";
	if ( defined $self->sqlselect($sql1) ){ return ;}
	while ($a=shift @L) { $a->enterant; }	
        return 1;
}

####################################################################
####         Gibt nur den Fragentext als html für Probanden zurück
####         Argumente  : -
####         Returnwert : HTML-text der Frage
####################################################################
sub htmlfra {
	my $self = shift;
	my $BILD;
        my $query=$self->{query};
	if ($self->{bild} ne "") {$BILD="<img src='".$self->{bild}."' border=0>";} else {$BILD="&nbsp;"}
	if ($self->{warntext} eq "") {$self->{warntext}=$self->{parent}->{warntext};}
        $TITLE=$self->trans("TI6");
        $HTML= $self->qfont($self->{name})."\n<BR>\n".
		"<TABLE>\n".
 	        $self->TR([ $self->htmlant , $BILD ]).
		"</TABLE>\n<BR><BR>\n".
	       $query->submit('but',$self->trans("BU1"))."&nbsp;&nbsp;\n";  # Speichern
	       if ($self->{uspringen}) {$HTML.=$query->submit('but',$self->trans("BU3"))."&nbsp;&nbsp;\n";}  # Überspringen
	       $HTML.=$query->submit('but',$self->trans("BU2"))."\n" ;            # Unterbrechen

        $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";
	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  );
	my $query=$self->{query};
        my $TITLE=$self->trans("TI6")." ".$self->{id};
	$ret=$self->qfont($self->{id}." ".$self->trans("HI24"))."\n<input type='text' name='frage' value='$self->{name}' size=100>\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->sfont($query->popup_menu('qtface',$self->{RLfontface},$self->{qtface})),
                            "<input type='text' name='qtsize' value='$self->{qtsize}' size=5>",
                            $self->sfont($query->popup_menu('qtcolor',$self->{RLfontcolor},$self->{qtcolor},$self->{RHfontcolor}) ) ]).
                $self->TR([ $self->sfont($self->trans("HI29")),
                            $self->sfont($query->popup_menu('atface',$self->{RLfontface},$self->{atface})),
                            "<input type='text' name='atsize' value='$self->{atsize}' size=5>",
                            $self->sfont($query->popup_menu('atcolor',$self->{RLfontcolor},$self->{atcolor},$self->{RHfontcolor}) ) ]).
	      "</TABLE>\n<BR><BR>\n";	

        my %htyp=("E",$self->trans("HI32"),"M",$self->trans("HI33"),"T",$self->trans("HI34"),
		  "S5",$self->trans("HI35"),"S7",$self->trans("HI36"),"D",$self->trans("HI36a"));
        my @ltyp = keys %htyp;
        my %hgrafik=("BAU",$self->trans("HI46"),"BAS",$self->trans("HI47"),"VLU",$self->trans("HI48"),"VLS",$self->trans("HI49"),"SKU",$self->trans("HI50"),"SKS",$self->trans("HI51"),"PIS",$self->trans("HI52"));
        my @lgrafik = keys %hgrafik;

	$ret.="<TABLE>\n".
	      $self->TR([$self->sfont($self->trans("HI30")), "<input type='text' name='bild' value='$self->{bild}' size=30>" ]).
	      $self->TR([$self->sfont($self->trans("HI31")), "<input type='text' name='nextfid' value='$self->{nextfid}' size=5>" ]).
	      $self->TR([$self->sfont($self->trans("HI31a")),$self->sfont($query->popup_menu("typ",\@ltyp,$self->{typ},\%htyp)) ]).
	      $self->TR([$self->sfont($self->trans("HI31b")),$self->sfont($query->popup_menu("grafik",\@lgrafik,$self->{grafik},\%hgrafik)) ]).
	      "</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("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->sfont( "\n".
      	        $query->submit('but',$self->trans("BU1")) ."&nbsp;&nbsp;\n".
      	        $query->submit('but',$self->trans("BU5")) ."&nbsp;&nbsp;\n".
      	        $query->submit('but',$self->trans("BU10")) ."&nbsp;&nbsp;\n".
      	        $query->submit('but',$self->trans("BU8")) ."&nbsp;&nbsp;\n".
  	        $query->submit('but',$self->trans("BU4"))."\n" );


        $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 );
        my %vars = %{$self->{vars}};
	$self->{name}=$vars{frage};
	$self->{bild}=$vars{bild};	
	$self->{nextfid}=$vars{nextfid}+0;	
	$self->{typ}=$vars{typ};
	$self->{qtface}=$vars{qtface};	
	$self->{qtsize}=$vars{qtsize};	
	$self->{qtcolor}=$vars{qtcolor};	
	$self->{atface}=$vars{atface};	
	$self->{atsize}=$vars{atsize};	
	$self->{atcolor}=$vars{atcolor};
	$self->{grafik}=$vars{grafik};
	for ($x=1;$x<6;$x++){  $self->newant; }           # 5 neue Antworten bauen
	@L1=@L=@{$self->{ant}};
	while ($a=shift @L) { $a->getbearb($#L1); }               # Werte einlesen
	while ($a=shift @L1) {if ( $a->{name} eq "") {$self->delant($a->{id});};} # alle leeren Fragen löschen
        $self->loadantw;
        $self->renumant;
        $self->store;
}
	
####################################################################
####         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 $umf=$self->{parent};
	my $warn="&nbsp;";
	if ($self->{nextfid} == $self->{id}) {$warn=$self->trans("LW5");}
	if ($self->{nextfid} == -1) {$warn=$self->trans("LW4");}
	my $f=$self->sqlselect("select fid from fragen where umfid=$self->{umfid} and fid=$self->{nextfid}");
	if ($f==0) {$warn=$self->trans("LW4");}
	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} < $self->{id} && $self->{nextfid} != -1) {$warn=$self->trans("LW2");}
	$ret.=$self->TR([
	        "<input type='radio' name='radio' value='$self->{id}'>",
	      	$self->{id}.")",
	      	$self->sfont("[".$self->{typ}."]") . $self->qfont($self->{name}),
	      	$self->sfont(">".$self->{nextfid}),
	      	$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 = shift;
	my ($X)=$self->{typ}=~/^S(\d{1,2})$/;    # $X=5 oder 7 wenn Skalenantwort 	      	
	my $size = shift;
	my $GRA=substr($self->{grafik},0,2);
        my $sort =substr($self->{grafik},2,1);
	if ($size == 0) {$size=35;}
	my $PATH = shift;
	if ($PATH == "") {$PATH="../www.prorata.de/";}
        my $sql="select distinct(pin) from ergebnis where umfid=$self->{umfid} and fid=$self->{id}";
	my $sth=$self->sqlprepare($sql);
	my $N=$sth->rows;
	$sth->finish;
	my $filename="umfimg/".$self->IDstr.$self->{grafik}.$N.".gif";
	$PATH.=$filename;
	my $Y=open (FILE, "<$PATH"); close FILE;
	if ($Y){return $filename;}

	$self->log(4,"Grafikdatei = $PATH / X=$X, GRA=$GRA, sort=$sort");
	
	my @Liste=();
        my @L=@{$self->{ant}};
	my $anz=$#L+1;
	$self->log(4, "Anzahl der Teilnehmer N: $N ,  Anzahl der Antworten: $anz" );

	while ($a= shift @L) {push @Liste,$a->grafikstring($X);}
	
	grafik::paint($GRA, $PATH , $size , \@Liste , $X , $N, $sort);
        return $filename;
}

####################################################################
####         Strickt die Grafik für Live statistik
####         Argumente  : -
####         Returnwert : HTML-text
####################################################################

sub htmlgrafik {
	my $self = shift;
	my $IMG="";
	$pin=$self->sqlselect("select pin from ergebnis where umfid=$self->{umfid} and fid=$self->{id}");
        if ($pin>0){
	    if ($self->{typ} ne "T") {	
		$IMG="<img src='/".$self->makegrafik."' border=0>\n"."<BR>\n".$self->htmltextant;
            }
            if ($self->{typ} eq "T") { $IMG=$self->htmltextant; }
	}	
	else {$IMG=$self->afont($self->trans("HI40"));}
	
	return  $self->qfont($self->{name}) ."<BR>\n". $IMG . "\n<HR>\n"; 	

}

####################################################################
####         Strickt die Grafik für Live statistik
####         Argumente  : -
####         Returnwert : HTML-text
####################################################################

sub anzahlstr {
	my $self = shift;
	my $IMG="";
	my $pinz=$self->sqldo("select distinct(pin) from ergebnis where umfid=$self->{umfid} and fid=$self->{id}");
        return $pinz." Frage ".$self->{id};
}

####################################################################
####         Erstellt HTML-Datei mit Textantworten
####         Argumente  : -
####         Returnwert : Link auf HTML-Datei
####################################################################

sub htmltextant {
	my $self = shift;
	my $PATH=shift;
	my $TITLE=$self->trans("TI13");
	my $HTML=$self->qfont($self->{name})."<BR>\n";
	my $ret="";
	my @L=@{$self->{ant}} ;
	my $typ = $self->{typ} =~/^(.)\d*/;
	if ($PATH == "") {$PATH="../www.prorata.de/";}
        my $sql="select distinct(pin) from ergebnis where umfid=$self->{umfid} and fid=$self->{id}";
	my $sth=$self->sqlprepare($sql);
	my $N=$sth->rows;
	$sth->finish;
	my $filename="umfimg/".$self->IDstr."N".$N.".html";
	$PATH.=$filename;
	my $retw = $self->{parent}->sfont("<A HREF='/$filename'>".$self->trans("HI41")."</A>");
	my $X=open (FILE, "<$PATH"); close FILE;
	if ($X){return $retw;}
	if ($typ ne "S" ) {                                    # Antwortliste ausgeben
	    while ($a=shift @L) {$ret .= $a->htmltextant; }
	}	


	if ($ret eq ""){return;}
        $self->printhtml($TITLE, $HTML.$ret, $PATH);
	return $retw;
}