package antwort;

use template;
#use strict;

@ISA = qw ( template );

$Htyp={"0","Kein","1","Normal","2","Zahl","3","Datum"};

####################################################################
####         Konstuktor der Antwortenklasse
####         Argumente  : Umfid , fid , Antworttext
####         Returnwert : Referenz auf das neue Antwortobjekt
####################################################################
sub init {
	my $that = shift;
	my $class = ref($that) || $that;
	my $self = template->init(@_);
	if (! defined $self->{parent}){ $self->log(1, "Antwort bitte mit Parent initialisieren"); }
	bless $self, $class;	
	$self->{umfid}   = $self->{parent}->{umfid};
	$self->{fid}     = $self->{parent}->{id};
        $self->{name}    = "";
	$self->{nextfid} = $self->{fid} + 1;
	$self->{tlang}   = 0;		
	$self->{typ}     = 0;		
	$self->{template} = $self->{parent}->{template};
        $self->loadtmp;
	$self->{atfcace}=$self->{parent}->{atface};
	$self->{atsize}=$self->{parent}->{atsize};
	$self->{atcolor}=$self->{parent}->{atcolor};
	$self->{qtfcace}=$self->{parent}->{qtface};
	$self->{qtsize}=$self->{parent}->{qtsize};
	$self->{qtcolor}=$self->{parent}->{qtcolor};
	$self->{stfcace}=$self->{parent}->{stface};
	$self->{stsize}=$self->{parent}->{stsize};
	$self->{stcolor}=$self->{parent}->{stcolor};
	return $self;
}

####################################################################
####         Konstuktor der Antwortenklasse
####         Argumente  : Umfid , fid , aid
####         Returnwert : Referenz auf das neue Antwortobjekt
####################################################################
sub load {
	my $self = shift;
        my $sql = "select antwort, nextfid, typ, tlang from antworten where umfid=$self->{umfid} and fid=$self->{fid} and aid=$self->{id} ";
        ($self->{name}, $self->{nextfid}, $self->{typ}, $self->{tlang}) = $self->sqlselect($sql);
	if (! defined $self->{nextfid}) { $self->log(2, "Konnte Antwort nicht laden"); return;}
	return $self;
}

####################################################################
####         ermittelt eine neue ID und speichert die Antwort mit dieser
####         Argumente  -
####         Returnwert -
####################################################################
sub new {
	my $self = shift;
	my $sql1 = "select max(aid) from antworten where umfid=$self->{umfid} and fid=$self->{fid}";
	$self->{id} = ($self->sqlselect($sql1))+1;                # größte ID+1
        my $sql2 = "insert into antworten values ( $self->{umfid}, $self->{fid}, $self->{id}, '$self->{name}', ".
		   "'$self->{nextfid}', '$self->{typ}', $self->{tlang} )";
	$self->sqldo($sql2);	                           # gleich in die Datenbank speichern !!
}

####################################################################
####         Speichert die Antwort mit "Update" in der DB
####         Argumente  : evtl eine neue ID
####         Returnwert : -
####################################################################
sub store {
	my $self = shift;
	my $newid = $self->{id};         # entweder ist die neue ID = die alte, oder
	if (@_[0]) { $newid = shift; }   # wenn eine übergeben wurde, dann halt die neue
	my $sql = "update antworten set antwort='$self->{name}', aid=$newid, nextfid=$self->{nextfid}, ".
                  "typ=$self->{typ}, tlang=$self->{tlang} where umfid=$self->{umfid} and fid=$self->{fid} and aid=$self->{id}";
	$self->sqldo($sql);
        $self->{id}=$newid;              # neue ID selber annehmen
        return;
}

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

####################################################################
####         Löscht sich aus der Datenbank und setzt seine ID auf UNDEF
####         Argumente  : -
####         Returnwert : -
####################################################################
sub delete {
	my $self = shift;
	my $sql = "delete from antworten where umfid=$self->{umfid} and fid=$self->{fid} and aid=$self->{id} ";
	$self->sqldo($sql);
        $self->{id} = undef;
}

####################################################################
####         Ermittelt einen eindeutigen Identifikationsstring
####         Argumente  : -
####         Returnwert : Identifikationsstring
####################################################################
sub IDstr {
	my $self = shift;	
	my $tring = "U" . $self->{umfid} . "F" . $self->{fid} . "A" . $self->{id} ;
	return $tring;
}
sub IDFstr {
	my $self = shift;	
	return $self->{parent}->IDstr;
}

####################################################################
####         Aendert die AID der Frage
####         Argumente  : -
####         Returnwert : -
################################ ####################################
sub changeaid {
	my $self = shift;
	my $neue = shift;
	if ($neue == $self->{id} ) { return $neue; }
	$neue += 0;                                                      # mache es zu ner Zahl;
	my $sql = "select aid from antworten where umfid=$self->{umfid} and fid=$self->{fid} and aid=$neue";	
	if ($neue != 0){
        	my $tst = $self->sqlselect($sql);                        # gibts diese Antw.ID schon ?
		if ($tst == 0) {$self->store($neue);}                    # wenn nicht, dann speichern
	}
	return $neue;                                                    # neue ID zurückgeben
}

####################################################################
####         Liest die von Probanden beantwortete Antwort ein
####         Argumente  : Zeiger auf Var-Hash-
####         Returnwert : 1, wenn alles ok, sonst 0
####################################################################
sub enterant {
	my $self = shift;
	my %vars = %{$self->{vars}};                                    # von apache übergebene Variablen
        my $IDString = $self->IDstr;
	my $key=""; my $val=""; my $return;
	my $antw=0;  my $antwt="";                                      # antwortnummer, antworttext
	
	while ( ($key,$val) = each( %vars) )  {                         # den ganzen Hash durchackern
	  if ($val eq $IDString)     {$antw=$self->{id};}               # Anklickantwort
	  if ($key eq $IDString."T") {$antwt=$val;}   # Textantwort bei anklickantwort
	  if ($key eq $IDString."S") {$antw=$self->{id}; $antwt=$val;}  # Skalenantwort
	}
        if (($self->{parent}->{typ} eq "T") and ($antwt ne "")) {$antw=$self->{id};}
	if ($self->{typ}==2) {$antwt=$antwt+0;}
	if ($self->{typ}==3) {
		($t,$m,$j)=$antwt=~/(\d{1,2}).(\d{1,2}).(\d{2,4})/;
		if ($m<10) {$m="0".$m;}
		if ($t<10) {$t="0".$t;}
		if ($j<70) {$j+=2000;}
		if ($j<100) {$j+=1900;}
		$antwt="$j-$m-$t";
	}
	my $sql=  "insert into ergebnis values ( $vars{pin}, $self->{umfid}, $self->{fid}, $antw, '$antwt', NULL )";
	$self->log(4,"enterant: antw=$antw");
	if ($antw != 0) {                                           # Wenn diese Antwort angeklickt wurde, oder eingetippt
	  $self->sqldo($sql) ;
          $return=1;	                                            # Ich war dabei !!!
	}
        return $return;                                             # oder ich wurde nicht geklickt...  :-(
}

####################################################################
####         gibt die nächste fid
####         Argumente  : pin des Benutzers
####         Returnwert : nextfid oder undefiniert
####################################################################
sub getnextfid {
	my $self = shift;
	my $pin = shift;
        if (! defined $pin){$self->log(1,"Antwort->getnextfid : Die pin muß uebergeben werden !");}
	my $sql="select pin from ergebnis where pin=$pin and umfid=$self->{umfid} and fid=$self->{fid} and aid=$self->{id}";
	if ($pin == $self->sqlselect($sql)) {
            $self->log(4,"getnextfid: Gefunden!");
            return $self->{nextfid};
        }                                                    	# nextfid , der mit dieser pin geklickten Antwort
        return;                                                # oder undef zurück !
}


####################################################################
####         gibt sich als HTML zurück, damit Probanden die
####         Frage beantworten können
####         Argumente  : -
####         Returnwert : HTML-Text <input type........>
####################################################################
sub htmlant {
	my $self = shift;
	my $art = $self->{parent}->{typ};
	(my $typ, my $menge)=$art=~/(.)(.*)/ ;
	my $txt=""; my $me=0; my $FIE=();
	my $maxlen="size='50'";
	if ($self->{tlang}>0) {$maxlen="size='$self->{tlang}' maxlength='$self->{tlang}'";}
	if ($self->{tlang}>50) {$maxlen="size='50' maxlength='$self->{tlang}'";}
	$FIE[0]="&nbsp;";
        $FIE[1]=$self->afont($self->{name});
	$FIE[2]="&nbsp;";
	if ($typ eq "E") { $FIE[0] = "<INPUT type='radio' name='".$self->IDFstr."' value='".$self->IDstr."'>"; }
	if ($typ eq "M") { $FIE[0] = "<INPUT type='checkbox' name='".$self->IDstr."' value='".$self->IDstr."'>"; }
        if ($self->{typ}>0 ) {@FIE[2]="<INPUT type='textfield' name='".$self->IDstr."T' $maxlen>";}
	if ($typ eq "S") {                                                                                 # Skalenantwort
		for ($me=1; $me<=$menge; $me++) {
	          $FIE[$me+1] = "<INPUT type='radio' name='".$self->IDstr."S' value='$me'>";
		}
	}
	if ($typ eq "D") {return "<OPTION value='".$self->IDstr."'>".$FIE[1]."\n";}
	return $self->TR(\@FIE);
}


####################################################################
####         gibt sich als HTML zurück, damit die Kunden die Antwort
####         bearbeiten können
####         Argumente  : -
####         Returnwert : HTML-Text
####################################################################
sub htmlbearb {
	my $self = shift;
	my $ID = $self->IDstr;
        my ($typ)=$self->{parent}->{typ}=~/^(\S)\d*/;
        my $Ltyp=[0,1,2,3];
	if ($typ eq "T") {$Ltyp=[1,2,3];}
	if ( ($typ eq "S") || ($typ eq "D") ) {$Ltyp=[0];}
	return $self->TR([
                 "<input type='text' name='".$ID."I' value='$self->{id}' size=4>",
                 "<input type='text' name='".$ID."N' value='$self->{name}' size=40>",
		 $self->sfont($self->{query}->popup_menu($ID."T", $Ltyp, $self->{typ}, $Htyp)),
		 "<input type='text' name='".$ID."L' value='$self->{tlang}' size=4>",	
                 "<input type='text' name='".$ID."F' value='$self->{nextfid}' size=4>"      ]);
 }

####################################################################
####         nimmt die Änderungen des Kunden an der Antwort an
####         Argumente  : POST-Variablen-zeiger
####         Returnwert : -
####################################################################
sub getbearb {
	my $self = shift;
 	my $antzahl=shift;
        my %vars = %{$self->{vars}};
       	my $ID = $self->IDstr;
       	my $IDN=$ID."N";my $IDI=$ID."I";my $IDF=$ID."F"; my $IDT=$ID."T"; my $IDL=$ID."L";
 	
       	$self->{name}=$vars{$IDN};
	$self->{nextfid}=$vars{$IDF}+0;       	
        $self->{typ}=$vars{$IDT}+0;
        $self->{tlang}=$vars{$IDL}+0;
	$self->changeaid($vars{$IDI}+$antzahl);
	$self->store;
	return
}

####################################################################
####         Listet die Antworten in der Fragenliste für die Kunden
####         Argumente  : -
####         Returnwert : HTML-text
####################################################################

sub antwortenliste {
	my $self = shift;
	my $fnfid= $self->{parent}->{nextfid};   # nextfid der Frage
	my $ret="";
	my $warn="&nbsp;";
	if (($self->{nextfid} != $fnfid) && ($fnfid != $self->{fid})) {$warn=$self->trans("LW1");}	
	if ($self->{nextfid} < $self->{fid}) {$warn=$self->trans("LW2");}
	if ($self->{nextfid} == $self->{fid}) {$warn=$self->trans("LW3");}
	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->{nextfid} == 0) {$warn=" (->$fnfid)";}
	$ret.=$self->TR([
	        "&nbsp;",
	        $self->{fid}.".".$self->{id}.")",
	        $self->afont($self->{name}),
	      	$self->sfont(">".$self->{nextfid}),
	      	$self->sfont($warn)   ]);
       	return $ret;
}

####################################################################
####         Liefert einen String für die Grafik
####         Argumente  : -
####         Returnwert : String für Grafik
####################################################################

sub grafikstring {
	my $self = shift;
	my $sql="select count(pin), avg(text) from ergebnis where umfid=$self->{umfid} and fid=$self->{fid} and aid=$self->{id}";
	my ($A, $B)=$self->sqlselect($sql);
	if (shift() > 0 ) {$A=$B;}  # Wenn eine Zahl >0 übergeben, dann den Durchschnittswert für Skala
	$A.=" ".$self->{name};
        $self->log(4, $A);
	return $A;
}

####################################################################
####         gibt sich als HTML - Textantwort zurück
####         Argumente  : -
####         Returnwert : HTML-Text <input type........>
####################################################################
sub htmltextant {
	my $self = shift;
	my $f = $self->{parent};
	my ($HTML, $text, $ret);
	if (($self->{typ}>0) || ($self->{parent}->{typ} eq "T")) {
	  $HTML=$f->afont($self->{name}). "<BR>\n";
	  my $sth =$self->sqlprepare("select text from ergebnis where umfid=$self->{umfid} and fid=$self->{fid} and aid=$self->{id} and text>'' order by pin");
       	  while($text=$sth->fetchrow_array){$ret.=$text."<BR>\n";}
	}
        if ($ret ne "") {return $HTML.$self->sfont($ret)."<BR>\n";}
	return;
}