<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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-&gt;init(@_);
        if (! defined $self-&gt;{parent}) { $self-&gt;log(1,"Frage bitte mit parent initialisieren");}
    	bless $self, $class;	
	$self-&gt;{umfid}    = $self-&gt;{parent}-&gt;{id};
        $self-&gt;{name}     = "";
	$self-&gt;{typ}      = "E";
	$self-&gt;{bild}     = "";	
	$self-&gt;{ant}      = [];
	$self-&gt;{nextfid}  = $self-&gt;{id}+1;
	$self-&gt;{template} = $self-&gt;{parent}-&gt;{template};
        $self-&gt;{grafik}   ="BAS";
	$self-&gt;loadtmp();
	$self-&gt;{stfcace}=$self-&gt;{parent}-&gt;{stface};
	$self-&gt;{stsize}=$self-&gt;{parent}-&gt;{stsize};
	$self-&gt;{stcolor}=$self-&gt;{parent}-&gt;{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-&gt;{umfid} and fid=$self-&gt;{id} ";
	($self-&gt;{typ}, $self-&gt;{name}, $self-&gt;{nextfid}, $self-&gt;{bild}, $self-&gt;{qtface}, $self-&gt;{qtsize}, $self-&gt;{qtcolor},
	 $self-&gt;{atface}, $self-&gt;{atsize}, $self-&gt;{atcolor}, $self-&gt;{grafik} ) = $self-&gt;sqlselect($sql);
	if (! defined $self-&gt;{nextfid}) {return;}
	$self-&gt;loadantw;
        return $self;
}

####################################################################
####         Antworten zur Frage laden und in $self-&gt;{ant} speichern
####         Argumente  : umfid, fid
####         Returnwert : -
####################################################################
sub loadantw {
	my $self = shift;
	my $sql = "select max(aid) from antworten where umfid=$self-&gt;{umfid} and fid=$self-&gt;{id}";
	my $maxant = $self-&gt;sqlselect($sql);
        my @y=(); my $x=0;
	$self-&gt;{ant}=\@y;
	for ( $x=1; $x&lt;=$maxant; $x++) {
	   $a = antwort-&gt;init($self,$x); $a=$a-&gt;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-&gt;{umfid} ";
	$self-&gt;{id} = ($self-&gt;sqlselect($sql1))+1;
	$self-&gt;{nextfid}  = $self-&gt;{id}+1;
        my $sql2 = "insert into fragen set umfid=$self-&gt;{umfid}, fid=$self-&gt;{id}, frage='$self-&gt;{name}', ".
		   "typ='$self-&gt;{typ}', bild='$self-&gt;{bild}', nextfid='$self-&gt;{nextfid}', ".
		   "qtface='$self-&gt;{qtface}', qtsize='$self-&gt;{qtsize}', qtcolor='$self-&gt;{qtcolor}', ".
		   "atface='$self-&gt;{atface}', atsize='$self-&gt;{atsize}', atcolor='$self-&gt;{atcolor}', ".
		   "grafik='$self-&gt;{grafik}'";
	$self-&gt;sqldo($sql2);
}

####################################################################
####         Speichert sich mit Update
####         Argumente  : evtl Fragentext und Fragentyp
####         Returnwert : -
####################################################################
sub store {
	my $self = shift;
	if (@_[0]) { $self-&gt;{name} = @_[0]; }
	if (@_[1]) { $self-&gt;{typ} = @_[1]; }
	my $sql = "update fragen set frage='$self-&gt;{name}', typ='$self-&gt;{typ}', nextfid='$self-&gt;{nextfid}', bild='$self-&gt;{bild}', ".
		  "qtface='$self-&gt;{qtface}', qtsize='$self-&gt;{qtsize}', ".
		  "qtcolor='$self-&gt;{qtcolor}', atface='$self-&gt;{atface}', atsize='$self-&gt;{atsize}', atcolor='$self-&gt;{atcolor}', ".
		  "grafik='$self-&gt;{grafik}' where umfid=$self-&gt;{umfid} and fid=$self-&gt;{id}";
	$self-&gt;sqldo($sql);
	my $a; my @L=@{$self-&gt;{ant}};
	while ($a=shift @L) {$a-&gt;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-&gt;{umfid} and fid=$self-&gt;{id} ";
        my $sql1 = "update fragen set nextfid=$self-&gt;{nextfid} where umfid=$self-&gt;{umfid} and nextfid=$self-&gt;{id}";
        my $sql2 = "update antworten set nextfid=$self-&gt;{nextfid} where umfid=$self-&gt;{umfid} and nextfid=$self-&gt;{id}";
        my $sql3 = "select pin from ergebnis where umfid=$self-&gt;{umfid} and fid=$self-&gt;{id}";
	my $antw = $self-&gt;sqldo($sql3);
	if ($antw&gt;1) {return $self-&gt;trans("WA15a")." ".$self-&gt;{id}." ".$self-&gt;trans("WA15c");}
	$self-&gt;sqldo($sql);
 	my $f=frage-&gt;init($self-&gt;{parent}, $self-&gt;{nextfid}); $f=$f-&gt;load;
 	if (defined $f) {             # Die nextfids nur updaten
	   $self-&gt;sqldo($sql1);
	   $self-&gt;sqldo($sql2);       # wenn es meine nextfid-Frage gibt
	}
	my $x=$self-&gt;{id};
	$self-&gt;{id} = undef;
	my $a; my $y=$self-&gt;{ant};
	while ($a=shift @$y) {$a-&gt;delete}
        return $self-&gt;trans("WA15a")." ".$x." ".$self-&gt;trans("WA15b");
}

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

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

####################################################################
####         Erstellt eine neue Antwort zur Frage
####         Argumente  : Antworttext
####         Returnwert : AntwortID
####################################################################
sub newant {
	my $self = shift;	
	my $a;
	my $L=$self-&gt;{ant};
	$a = antwort-&gt;init($self); $a-&gt;new();
	if ($a) {push (@$L, $a);}  #existierende Fragen ins Array packen
	return $a-&gt;{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-&gt;log(4,"Enter nextfrage");
	if ($firstfid==0){$firstfid=$self-&gt;{id};}
	my $a; my $nf; my $fra;  my $nextf; my @L=@{$self-&gt;{ant}};
	while ($a=shift @L) {
	  if ($nf=$a-&gt;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-&gt;{nextfid};                  # sonst die Standardnextfid der Frage
        }
        if ($nextf == -1) {return;}                   # Fragebogen zuende !!
	if ($nextf == $self-&gt;{id}) {
		$self-&gt;log(4,"Ich bin Nextfid von mir selbst !"); 
		$self-&gt;{warntext}=$self-&gt;trans("WA5");
		return $self; 
	}
					 	       # bin ich selbst meine nächste ? , Dann halt mich zurück um endlosschl. zu verh.
        if ($nextf == $firstfid) {$self-&gt;log(2,"Aaargh, Antwortlooping entdeckt !"); return;}    # Wenn die Anfangsfrage wieder auftaucht:  Loopinggefahr!!! und ENDE !
        $fra=frage-&gt;init($self-&gt;{parent}, $nextf); $fra=$fra-&gt;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-&gt;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-&gt;{ant}};
	while ($a=shift @L) { $a-&gt;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-&gt;{ant}; my @L=();
	while ($a=shift @$y) {
		if ($a-&gt;{id} == $aid) {$a-&gt;delete;}
		else {push (@L, $a); }
	}	
	$self-&gt;{ant}=\@L;
}

####################################################################
####         Speichert die Antworten
####         Argumente  : Zeiger auf Variablen
####         Returnwert : -
####################################################################
sub enterant {
	my $self = shift;
	my $a; my $gd;  my @L=@{$self-&gt;{ant}}; my $good;
        my $sql1= "select pin from ergebnis where umfid=$baseq::VARS{umfid} and fid=$baseq::VARS{fid} and pin=$baseq::VARS{pin}";
	if ( defined $self-&gt;sqlselect($sql1) ){ return ;}
	while ($a=shift @L) { $a-&gt;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;
	if ($self-&gt;{bild} ne "") { $BILD=$self-&gt;IMG($self-&gt;{bild}); } else {$BILD="&amp;nbsp;"}
	if ($self-&gt;{warntext} eq "") {$self-&gt;{warntext}=$self-&gt;{parent}-&gt;{warntext};}
        $TITLE=$self-&gt;trans("TI6");
        $HTML= $self-&gt;qfont($self-&gt;{name})."\n&lt;BR&gt;\n".
		"&lt;TABLE&gt;\n".
 	        $self-&gt;TR([ $self-&gt;htmlant , $BILD ]).
		"&lt;/TABLE&gt;\n&lt;BR&gt;&lt;BR&gt;\n";
	my @L1=("but","but","but"); my @L2=("BU25","BU3","BU2");
	if (! $self-&gt;{parent}{uspringen}) {@L1=("but","but"); @L2=("BU25","BU2");}  # Überspringen
	$HTML.=$self-&gt;SMrow(\@L1,\@L2);     

        $self-&gt;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-&gt;{ant}} ;
 	my @LI=("&amp;nbsp;","&amp;nbsp;");
	my $typ = $self-&gt;{typ};
        (my $typ1, my $menge) = $typ =~/^(.)(.*)/;
	my $me=0;
	my $Start="&lt;TABLE size=100% &gt;\n";
	my $End="&lt;/TABLE&gt;\n";
	if ($typ1 eq "D" ) {$Start="&lt;SELECT name='".$self-&gt;IDstr."'&gt;\n"; $End="&lt;/SELECT&gt;\n";}
	if ($typ1 eq "S" ) {
		for ($me=1; $me&lt;=$menge; $me++) { @Li[$me+1] = $self-&gt;afont($me); }
        	$Start.=$self-&gt;TR(\@Li);
        }
        $ret .= $Start;
	while ($a=shift @L) { $ret .= $a-&gt;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 $TITLE=$self-&gt;trans("TI6")." ".$self-&gt;{id};
	$ret=$self-&gt;qfont($self-&gt;{id}." ".$self-&gt;trans("HI24"))."\n".
	$self-&gt;TF("frage",$self-&gt;{name},80)."\n&lt;BR&gt;&lt;BR&gt;\n";

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

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

	$ret.="&lt;TABLE&gt;\n".
	      $self-&gt;TR([$self-&gt;sfont($self-&gt;trans("HI30")), $self-&gt;TF("bild",$self-&gt;{bild},30) ]).
	      $self-&gt;TR([$self-&gt;sfont($self-&gt;trans("HI31")), $self-&gt;TF("nextfid",$self-&gt;{nextfid},5) ]).
	      $self-&gt;TR([$self-&gt;sfont($self-&gt;trans("HI31a")),$self-&gt;DD("typ",\@ltyp,$self-&gt;{typ},\%htyp) ]).
	      $self-&gt;TR([$self-&gt;sfont($self-&gt;trans("HI31b")),$self-&gt;DD("grafik",\@lgrafik,$self-&gt;{grafik},\%hgrafik) ]).
	      "&lt;/TABLE&gt;\n";
	



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

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

        $self-&gt;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-&gt;{name}=$self-&gt;clean($baseq::VARS{frage});
	$self-&gt;{bild}=$self-&gt;fclean($baseq::VARS{bild});	
	$self-&gt;{nextfid}=$baseq::VARS{nextfid}+0;
	$self-&gt;{typ}=$self-&gt;fclean($baseq::VARS{typ});
	$self-&gt;{qtface}=$self-&gt;fclean($baseq::VARS{qtface});	
	$self-&gt;{qtsize}=$self-&gt;fclean($baseq::VARS{qtsize});	
	$self-&gt;{qtcolor}=$self-&gt;fclean($baseq::VARS{qtcolor});	
	$self-&gt;{atface}=$self-&gt;fclean($baseq::VARS{atface});	
	$self-&gt;{atsize}=$self-&gt;fclean($baseq::VARS{atsize});	
	$self-&gt;{atcolor}=$self-&gt;fclean($baseq::VARS{atcolor});
	$self-&gt;{grafik}=$self-&gt;fclean($baseq::VARS{grafik});
	for ($x=1;$x&lt;6;$x++){  $self-&gt;newant; }           # 5 neue Antworten bauen
	@L1=@L=@{$self-&gt;{ant}};
	while ($a=shift @L) { $a-&gt;getbearb($#L1); }               # Werte einlesen
	while ($a=shift @L1) {if ( $a-&gt;{name} eq "") {$self-&gt;delant($a-&gt;{id});};} # alle leeren Fragen löschen
        $self-&gt;loadantw;
        $self-&gt;renumant;
        $self-&gt;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-&gt;{ant}};
	my $umf=$self-&gt;{parent};
	my $warn="&amp;nbsp;";
	if ($self-&gt;{nextfid} == $self-&gt;{id}) {$warn=$self-&gt;trans("LW5");}
	if ($self-&gt;{nextfid} == -1) {$warn=$self-&gt;trans("LW4");}
	my $f=$self-&gt;sqlselect("select fid from fragen where umfid=$self-&gt;{umfid} and fid=$self-&gt;{nextfid}");
	if ($f==0) {$warn=$self-&gt;trans("LW4");}
	if (! ($self-&gt;{qtsize}=~/^\+{0,1}[0-9]$/)) {$warn=$self-&gt;trans("LW6");}
	if (! ($self-&gt;{atsize}=~/^\+{0,1}[0-9]$/)) {$warn=$self-&gt;trans("LW7");}
	if ($self-&gt;{typ} eq "" ) {$warn=$self-&gt;trans("LW8");}
	if ($self-&gt;{nextfid} &lt; $self-&gt;{id} &amp;&amp; $self-&gt;{nextfid} != -1) {$warn=$self-&gt;trans("LW2");}
	$ret.=$self-&gt;TR([
	        $self-&gt;RB("radio",$self-&gt;{id}),
	      	$self-&gt;{id}.")",
	      	$self-&gt;sfont("[".$self-&gt;{typ}."]") . $self-&gt;qfont($self-&gt;{name}),
	      	$self-&gt;sfont("&gt;".$self-&gt;{nextfid}),
	      	$self-&gt;sfont($warn)  ]);
	$self-&gt;log(4,"Jetzt in die Antwortenliste");      	
	while ($a=shift @L) { $ret.=$a-&gt;antwortenliste; }
	$ret.=$self-&gt;TR(["&amp;nbsp","&amp;nbsp;","&amp;nbsp;","&amp;nbsp;"]);  # Eine Leerzeile......
	return $ret;
}
	
####################################################################
####         Strickt die Grafik für Live statistik
####         Argumente  : -
####         Returnwert : HTML-text
####################################################################

sub makegrafik {
	my $self = shift;
	my ($X)=$self-&gt;{typ}=~/^S(\d{1,2})$/;    # $X=5 oder 7 wenn Skalenantwort 	      	
	my $size = shift;
	my $GRA=substr($self-&gt;{grafik},0,2);
        my $sort =substr($self-&gt;{grafik},2,1);
	if ($size == 0) {$size=35;}
        my $sql="select distinct(pin) from ergebnis where umfid=$self-&gt;{umfid} and fid=$self-&gt;{id}";
	my $sth=$self-&gt;sqlprepare($sql);
	my $N=$sth-&gt;rows;
	$sth-&gt;finish;
	my $filename=$baseq::UMFIMG.$self-&gt;IDstr.$self-&gt;{grafik}.$N.".gif";
	my $Y=open (FILE, "&lt;$baseq::PATH.$filename"); close FILE;
	if ($Y){return $filename;}

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

	while ($a= shift @L) {push @Liste,$a-&gt;grafikstring($X);}
	
	grafik::paint($GRA, $baseq::PATH.$filename , $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-&gt;sqlselect("select pin from ergebnis where umfid=$self-&gt;{umfid} and fid=$self-&gt;{id}");
        if ($pin&gt;0){
	    if ($self-&gt;{typ} ne "T") {	
		$IMG=$self-&gt;IMG($self-&gt;makegrafik)."&lt;BR&gt;\n".$self-&gt;htmltextant;
            }
            if ($self-&gt;{typ} eq "T") { $IMG=$self-&gt;htmltextant; }
	}	
	else {$IMG=$self-&gt;afont($self-&gt;trans("HI40"));}
	
	return  $self-&gt;qfont($self-&gt;{name}) ."&lt;BR&gt;\n". $IMG . "\n&lt;HR&gt;\n"; 	

}

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

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

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

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


	if ($ret eq ""){return;}
        $self-&gt;printhtml($TITLE, $HTML.$ret, $baseq::PATH.$filename);
	return $retw;
}
</pre></body></html>