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(@_);
    my @V=qw/umfid fid id name nextfid typ tlang gcolor/;
	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} = 0;
	$self->{tlang}   = 0;		
	$self->{typ}     = 0;		
	$self->{gcolor}	 = 0;
	$self->{template}= $self->{parent}->{template};
	$self->{textant} = [];
	$self->loadtmp;
	$self->{atface}=$self->{parent}->{atface};
	$self->{atsize}=$self->{parent}->{atsize};
	$self->{atcolor}=$self->{parent}->{atcolor};
	$self->{qtface}=$self->{parent}->{qtface};
	$self->{qtsize}=$self->{parent}->{qtsize};
	$self->{qtcolor}=$self->{parent}->{qtcolor};
	$self->{stface}=$self->{parent}->{stface};
	$self->{stsize}=$self->{parent}->{stsize};
	$self->{stcolor}=$self->{parent}->{stcolor};
	$self->{exportvars}=\@V;
	return $self;
}

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

####################################################################
####         ermittelt eine neue ID und speichert die Antwort mit dieser
####         Argumente  -
####         Returnwert -
####################################################################
sub new {
	my $self = shift;
	$self->log(4,"Entering: antwort:new");
	$self->sqldo("lock tables antworten write");
	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 set umfid=$self->{umfid}, fid=$self->{fid}, aid=$self->{id}, antwort='$self->{name}', ".
		       "nextfid='$self->{nextfid}', typ='$self->{typ}', tlang='$self->{tlang}', gcolor='$self->{gcolor}'";
	$self->sqldo($sql2);	                           # gleich in die Datenbank speichern !!
	$self->sqldo("unlock tables");
}

####################################################################
####         Speichert die Antwort mit "Update" in der DB
####         Argumente  : evtl eine neue ID
####         Returnwert : -
####################################################################
sub store {
	my $self = shift;
	$self->log(4,"Entering: antwort:store");
	my $sql = "update antworten set antwort='$self->{name}', nextfid=$self->{nextfid}, ".
              "typ=$self->{typ}, tlang=$self->{tlang},  gcolor='$self->{gcolor}' ".
			  "where umfid=$self->{umfid} and fid=$self->{fid} and aid=$self->{id}";
	$self->sqldo($sql);
    return;
}

####################################################################
####         Schreibt ins Logfile
####         Argumente  : Emergency-NR und Logtext
####         Returnwert : -
####################################################################
sub log {
	my ($self, $emer, $TEXT) = @_;
	$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;
	$self->log(4,"Entering: antwort:delete");
	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 Antwort
####         Argumente  : -
####         Returnwert : -
####################################################################
sub changeaid {
	my $self = shift;
	my $neue = shift()+0;
	$self->log(4,"Entering: antwort:changeaid");
	if ($neue == $self->{id} ) { return $neue; }
	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->sqldo("update antworten set aid=$neue where umfid=$self->{umfid} and fid=$self->{fid} and aid=$self->{id}");}                    
	$self->{id}=$neue;									# wenn nicht, dann speichern
	}
	return $neue;                                                    # neue ID zurückgeben
}

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


####################################################################
####         Liest die von Probanden beantwortete Antwort ein
####         Argumente  : -
####         Returnwert : 1, wenn alles ok, sonst 0
####################################################################
sub enterant {
	my $self = shift;
	$self->log(4,"Entering: antwort:enterant");
        my $IDString = $self->IDstr;
	my $key=""; my $val=""; my $return;
	my $antw=0;  my $antwt="";                                      # antwortnummer, antworttext
	
	while ( ($key,$val) = each( %baseq::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 ($antwt ne "") {$antwt=$self->fclean($antwt); }
	if ($self->{typ}==2) {$antwt=~s/^\D*([\d,\.]*)\D*$/$1/;}
	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";
	}


##########     ORIGINAL   #############################################################
#
#	my $sql=  "insert into ergebnis values ( $baseq::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 !!!
#	}
#
#########    ORIGINAL ENDE  #############################################################	
######################## Test Fressnapf: zur Befragung weiterleitren.... ################################

        if ($self->{umfid} = 156 and $self->{fid} = 1 and $antw = 2)
        {
		 $self->log(2,"id:: $self->{id} ");
		 $text="Hat abgebrochen";
		 $antwt = $ text;
		 $self->log(2,"$antwt");
									                  
		 my $sql=  "insert into ergebnis values ( $baseq::VARS{pin}, $self->{umfid}, $self->{fid}, $antw, '$antwt', NULL )";
		 $self->log(2,"enterant: antw=$sql");
		        if ($antw != 0) { $self->sqldo($sql) ;$return=1;}
		return $return;	
         };

																           if ($self->{umfid} = 156 and $self->{fid} = 1 and $antw = 1)
       {
	         $self->log(2,"id:: $self->{id} ");
		 $text="Wurde weitergeleitet";
		 $antwt = $ text;
		 $self->log(2,"$antwt");

		 my $sql=  "insert into ergebnis values ( $baseq::VARS{pin}, $self->{umfid}, $self->{fid}, $antw, '$antwt', NULL )";
		 $self->log(2,"enterant: antw=$sql");
		 if ($antw != 0) { 
		 	$self->sqldo($sql) ;
		 	$self->log(2,"Fressnapf, Unterstützung der Meisterarbeit, Teilnehemer wurde weitergeleitet");

		 	#   WEITERLEITUNG
		 	$location = "http://www.voycer.de/umfrage.html?sid=36963";
		 	print "Status: 302 Found\n";
		 	print "Location: $location\n";
		 	print "URI: <$location>\n";
		 	print "Content-type: text/html\r\n\r\n";
 	         	$return=1;}
			return $return												                }
																																	######################## Test Fressnapf: zur Befragung weiterleitren.... ################################

#}

########################################################################################################

##########     ORIGINAL   #############################################################

else{

        my $sql=  "insert into ergebnis values ( $baseq::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 !!!
		 }

	 #########    ORIGINAL ENDE  #############################################################
	}
    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;
	$self->log(4,"Entering: antwort:getnextfid");
	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;
	$self->log(4,"Entering: antwort:htmlant");
	my $art = $self->{parent}->{typ};
	(my $typ, my $menge)=$art=~/(.)(.*)/ ;
	my $txt=""; my $me=0; my @FIE=();
	my $maxlen=""; my $size=50;
	$self->{parent}->{helpkontext}="frage_".$typ;
	if ( $self->{name}=~/\{(\d{1,3})\.(\d{1,3})\.(\d{1,3})\}/ )      {
		if ($1>0 && $2>0 && $3>0) {
			my $text=$self->sqlselect("select text from ergebnis where umfid=$1 and fid=$2 and aid=$3 and pin=".$baseq::VARS{pin});
			$self->{name}=~s/\{[\d\.]{5,11}\}/$text/;	
			if ($text eq "") {return }
		}
	}
	if ($self->{tlang}>0) {$size=$self->{tlang}; $maxlen=$self->{tlang};}
	if ($self->{tlang}>50) {$size=50; $maxlen=$self->{tlang};}
	@FIE=("&nbsp;", $FIE[1]=$self->afont($self->{name}), "&nbsp;");
	if ($typ eq "E") { $FIE[0] = $self->RB($self->IDFstr, $self->IDstr,($baseq::VARS{$self->IDstr} ne "")); }
	if ($typ eq "M") { $FIE[0] = $self->CB($self->IDstr,$self->IDstr,($baseq::VARS{$self->IDstr} ne "")); }
    if ($self->{typ}>0 ) {
		$FIE[2]=$self->TF($self->IDstr."T", $baseq::VARS{$self->IDstr."T"}, $size, $maxlen);
		$self->{parent}->{helpkontext}.="T";
	}
	if ($typ eq "S") {                                                                                 # Skalenantwort
		for ($me=1; $me<=$menge; $me++) {
	          $FIE[$me+1] = $self->RB($self->IDstr."S", $me,($baseq::VARS{"{$self->IDstr}S"}==$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;
	$self->log(4,"Entering: antwort:htmlbearb");
	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([
                 $self->TF($ID."I",$self->{id},4),
                 $self->TF($ID."N",$self->{name},40),
		         $self->sfont($self->DD($ID."T", $Ltyp, $self->{typ}, $Htyp)),
		         $self->TF($ID."L",$self->{tlang},4),	
			     $self->sfont($self->DDfcolor($ID."G", $self->{gcolor}, "grafik")),
                 $self->DDordernum($ID."F",$self->{nextfid},4)    ]);
 }

####################################################################
####         nimmt die Änderungen des Kunden an der Antwort an
####         Argumente  : POST-Variablen-zeiger
####         Returnwert : -
####################################################################
sub getbearb {
	my $self = shift;
	$self->log(4,"Entering: antwort:getbearb");
 	my $antzahl=shift;
    my $ID = $self->IDstr;
    my $IDN=$ID."N";my $IDI=$ID."I";my $IDF=$ID."F"; 
	my $IDT=$ID."T"; my $IDL=$ID."L";my $IDG=$ID."G";
 	
    $self->{name}=$self->clean($baseq::VARS{$IDN});
	$self->{nextfid}=$baseq::VARS{$IDF}+0;       	
    $self->{typ}=$baseq::VARS{$IDT}+0;
    $self->{tlang}=$baseq::VARS{$IDL}+0;
	$self->{gcolor}=$self->fclean($baseq::VARS{$IDG});
	$self->changeaid($baseq::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;
	$self->log(4,"Entering: antwort:antwortenliste");
	my $fnfid= $self->{parent}->{nextfid};   # nextfid der Frage
	my $ret=""; my $next;
	my $warn="&nbsp;";
	if ($self->{nextfid} == $self->{fid}) {$warn=$self->trans("LW3");}
	if ($self->{nextfid} != 0) {
		 $next=$self->sfont(">".$baseq::RHordernums->{$self->{nextfid}});
	}
	$ret.=$self->TR([
	        "&nbsp;",
	        $self->{parent}->{ordernum}.".".$self->{id}.")",
	        $self->afont($self->{name}),
	      	$next,
	      	$self->sfont($warn)   ]);
       	return $ret;
}

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

sub grafikdataset {
	my $self = shift;
	my %ret;
	my $olda=0;
	$self->log(4,"Entering: antwort:grafikstring");
	my ($A, $B)=($self->{countpin}, $self->{avgtext} );
	if (shift() > 0 ) {$A=$B;}  # Wenn eine Zahl >0 übergeben, dann den Durchschnittswert für Skala
	$self->log(4,"OTTO-HACK: ".$self->{parent}->{parent}->{knr}." | ".$self->{fid} );

	########################### OTTO HACK :-)
	if ( ($self->{parent}->{parent}->{knr}==4) && ($self->{fid}==1) ) {
		$self->{parent}->{olda}+=$A;
		$A=$self->{parent}->{olda};
		$self->log(4,"OLDA=$A");	
	}
	########################### OTTO Hack Ende.....
	$ret{lfd}=$self->{id};
	$ret{num}=$A;
	$ret{txt}=$self->{name};
    $ret{tabl}="ergebnis";
	$ret{wher}="umfid='$self->{umfid}' fid='$self->{fid}' aid='$self->{id}'";  
	if ($self->{gcolor}) {$ret{color}=$self->{gcolor};}
	$ret{descr}=$self->{parent}->fullname.": ".$self->{name};
	$ret{descr}=~s/<[^>]+[>\$]//g;
	return \%ret;
}
####################################################################
####         saugt sich die Textantworten rein
####         Argumente  : hashref mit {pin} und {text}
####         Returnwert : -
####################################################################
sub slurptextant {
	my ($self, $pin, $txt) = @_;
	my $ref = { "pin" => $pin , "text" => $txt };
	push @{$self->{textant}} , $ref;
}

####################################################################
####         gibt sich als HTML - Textantwort zurück
####         Argumente  : -
####         Returnwert : HTML-Text  12345: Blablabla
####################################################################
sub htmltextant {
	my $self = shift;
	my ($HTML, $text, $ret, $pin);
	my $ID=$self->IDstr;
	$self->log(4,"Entering: antwort:htmltextant");
	if (($self->{typ}>0) || ($self->{parent}->{typ} eq "T")) {
	  $HTML=$self->afont($self->{name}). "<BR>\n";
	  foreach (@{$self->{textant}}) {
	   my $IDX=$ID."PIN".$_->{pin};
	   $ret.=$self->CB($IDX,1, $baseq::VARS{$IDX}).$_->{pin}.": ".$_->{text}."<BR>\n";}
	}
    if ($ret) {  return $HTML.$self->sfont($ret)."<BR>\n";}
	return;
}

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

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