<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package umfrage;

use frage;
use grafik;
use kasse;
#use strict;

@ISA = qw ( template );


####################################################################
####         Konstruktor der Umfragenklasse
####         Argumente  : -
####         Returnwert : -
####################################################################
sub init {
	my $that = shift;
	my $class = ref($that) || $that;
	my $self = template-&gt;init(@_);
	bless $self, $class;	
	$self-&gt;{name}     = "Neue Umfrage";
	$self-&gt;{usepanel} = 0;
	$self-&gt;{template} = $self-&gt;{parent}-&gt;{template}+0;
	$self-&gt;{knr} 	  = $self-&gt;{parent}-&gt;{knr}+0;
	$self-&gt;{showstat} = 0;	
	$self-&gt;{sprache}  = 0;	
        $self-&gt;{exiturl}  = "http://www.prorata.de";	
        $self-&gt;{beginn}   = '2000-01-01';
	$self-&gt;{ende}	  = '2000-01-01';
        $self-&gt;{ppf}	  = 100;
        $self-&gt;{firstfid} = 1;
	$self-&gt;{uspringen} = 1;
	$self-&gt;{maxuser}  = 100;
	return $self;
}

####################################################################
####         Laden der Umfrage aus der DB
####         Argumente  : -
####         Returnwert : -
####################################################################
sub load {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:load");
	my $sql = "select umfrage, usepanel, template, knr, showstat , beginn, ende, ppf, stface, stsize, stcolor, exiturl, name, pass, ".
		  "sprache, firstfid, uspringen, maxuser from umfragen where umfid=$self-&gt;{id}";
	($self-&gt;{name}, $self-&gt;{usepanel}, $self-&gt;{template}, $self-&gt;{knr},
	 $self-&gt;{showstat},$self-&gt;{beginn},$self-&gt;{ende},$self-&gt;{ppf}, $f,$s,$c, $self-&gt;{exiturl},
	 $self-&gt;{uname}, $self-&gt;{upass}, $self-&gt;{sprache}, $self-&gt;{firstfid}, $self-&gt;{uspringen},
	 $self-&gt;{maxuser} ) = $self-&gt;sqlselect($sql);
	if (! defined $self-&gt;{knr}) {$self-&gt;log(2,"Umfrage ist nicht vorhanden"); return;}
	$baseq::VARS{umfid}=$self-&gt;{id};		# Umfid setzen
	$self-&gt;loadtmp();    	                	# Template laden
        $self-&gt;loadsprache($self-&gt;{sprache});                             # Sprache laden
	$self-&gt;{stface}=$f; $self-&gt;{stsize}=$s; $self-&gt;{stcolor}=$c;
	return $self;
}

####################################################################
####         Ermittelt eine neue umfid und speichert sich
####         Argumente  : -
####         Returnwert : -
####################################################################
sub new {
	my $self = shift;
    $self-&gt;log(4,"Entering: umfrage:new");
	my $sql1 = "select max(umfid) from umfragen";
	($self-&gt;{id}) = ($self-&gt;sqlselect($sql1))+1;
    my $sql2 = "insert into umfragen set umfrage='$self-&gt;{name}', umfid=$self-&gt;{id}, usepanel=$self-&gt;{usepanel}, template=$self-&gt;{template}, ".
               "knr=$self-&gt;{knr}, showstat=$self-&gt;{showstat}, beginn='$self-&gt;{beginn}', ende='$self-&gt;{ende}', ppf=$self-&gt;{ppf}, ".
		   "stface='$self-&gt;{stface}', stsize='$self-&gt;{stsize}', stcolor='$self-&gt;{stcolor}', exiturl='$self-&gt;{exiturl}', ".
		   "name='$self-&gt;{uname}', pass='$self-&gt;{upass}', ".
		   "sprache=$self-&gt;{sprache}, firstfid=$self-&gt;{firstfid}, uspringen=$self-&gt;{uspringen}, maxuser=$self-&gt;{maxuser}";
	$self-&gt;sqldo($sql2);
    $baseq::VARS{umfid}=$self-&gt;{id}		# Umfid setzen
}

####################################################################
####         Speichert sich mit Update
####         Argumente  : -
####         Returnwert : -
####################################################################
sub store {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:store");
	my $sql = "update umfragen set umfrage='$self-&gt;{name}', usepanel=$self-&gt;{usepanel}, ".
		  "template=$self-&gt;{template}, knr=$self-&gt;{knr}, ".
		  "showstat=$self-&gt;{showstat}, beginn='$self-&gt;{beginn}', ".
      		  "ende='$self-&gt;{ende}', ppf=$self-&gt;{ppf}, ".
		  "stface='$self-&gt;{stface}', stsize='$self-&gt;{stsize}', stcolor='$self-&gt;{stcolor}', ".
	 	  "name='$self-&gt;{uname}', pass='$self-&gt;{upass}', exiturl='$self-&gt;{exiturl}', sprache=$self-&gt;{sprache}, ".
		  "firstfid=$self-&gt;{firstfid}, uspringen=$self-&gt;{uspringen}, maxuser=$self-&gt;{maxuser} where umfid=$self-&gt;{id}";
	$self-&gt;sqldo($sql);
	return;
}

####################################################################
####         Löscht sich und alle seine Fragen aus der DB,
####	     wenn die Umfrage noch nicht beantwortet wurde	
####         Argumente  : -
####         Returnwert : 1 bei Misserfolg
####################################################################
sub delete {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:delete");
	my $inhalt=$self-&gt;sqldo("select pin from ergebnis where umfid=$self-&gt;{id}");
        if ($inhalt &gt; 0) {return 1;}
	my $sql  = "delete from umfragen where umfid=$self-&gt;{id}";
	$self-&gt;sqldo($sql);
	my $f;
	my $y=$self-&gt;loadfragen;
	while ($f=shift @$y) {$f-&gt;delete}
	$self-&gt;{id} = undef;
	return 0;
}

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

####################################################################
####         Frage zur Umfrage laden
####         Argumente  : -
####         Returnwert : Zeiger auf Fragenarry
####################################################################
sub loadfragen {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:loadfragen");
	my $sql = "select max(fid) from fragen where umfid=$self-&gt;{id}";
	my $max = $self-&gt;sqlselect($sql);
        my @y=(); my $x=0; my $f;
	for ( $x=1; $x&lt;=$max; $x++) {
	   $f = frage-&gt;init($self,$x);
   	   if ($f-&gt;load()) { push (@y, $f);}        #existierende Fragen ins Array packen
	}
	return \@y;
}

####################################################################
####         liest die Antworten ein
####         Argumente  : -
####         Returnwert : -
####################################################################
sub enterant {
	my $self = shift;
	my $f;
        $self-&gt;log(4,"Entering: umfrage:enterant");
	my @RE=("",$self-&gt;trans("WA1"),$self-&gt;trans("WA2"),"");
	my $x=0;
	$self-&gt;log(4,"Entering 'enterant' Umfid=$baseq::VARS{umfid} Pin=$baseq::VARS{pin} Fid=$baseq::VARS{fid}");
        # Wenn beendet werden soll : Redirect !
	if ($baseq::VARS{lbut} eq $self-&gt;trans("BU11")) {$self-&gt;redirect;}

	# Anmeldedaten übernehmen
        if ($baseq::VARS{lbut} eq $self-&gt;trans("BU12")) {
		$baseq::VARS{pin}=$baseq::VARS{apin};
		$baseq::VARS{pass}=crypt($baseq::VARS{apass}, "xy");
	}
	$self-&gt;log(4,"fid am Anfang=$baseq::VARS{fid}");
	# Pin überprüfen und nötigenfalls erfragen
	if ($baseq::VARS{pin} eq ""){
		if ($self-&gt;{usepanel}==0) {$baseq::VARS{pin}=$self-&gt;newpin;}	
		else {$self-&gt;login();$self-&gt;exit;}
	}

        # Passwortüberprüfung
	if ($self-&gt;{usepanel}==1) {my $RET = $self-&gt;checkpass($baseq::VARS{pin}, $baseq::VARS{pass});
	        if ($RET == 3) { $self-&gt;pstatistik;$self-&gt;exit;}
		if ($RET != 0) { $self-&gt;{warntext}=$RE[$RET]; $self-&gt;login();$self-&gt;exit; }
        }

	# Ist der Fragebogen aktiv ??
	if ($self-&gt;checkdate) {
	        $self-&gt;{warntext}=$self-&gt;trans("WA11");$self-&gt;login();
 		$self-&gt;log(1,"Fragebogen nicht aktiv");
	}
	$self-&gt;log(4,"FID=$baseq::VARS{fid}");
	# Wenn VARS{fid} nicht definiert ist muß die erste Frage genommen werden
	if ( $baseq::VARS{fid} &lt;1 ) {
		$self-&gt;log(4,"Keine fid, lade firstfid");
		$baseq::VARS{fid}=$self-&gt;{firstfid};
		$f = frage-&gt;init($self,$baseq::VARS{fid}); $f-&gt;load();
		$f=$f-&gt;nextfrage($baseq::VARS{pin},1);
	}
	else {$f = frage-&gt;init($self,$baseq::VARS{fid}); $f=$f-&gt;load(); } # sonst jetzt anliegende Frage laden....

        if (! defined $f) { $self-&gt;umfende; $self-&gt;exit;}
	
	# Wenn gespeichert werden soll
	if ($baseq::VARS{but} eq $self-&gt;trans("BU25")) {
	   if ($f-&gt;enterant == 0) {$self-&gt;{warntext}=$self-&gt;trans("WA4");}
	   $self-&gt;log(4,"Proband speichert");
	   $f = $f-&gt;nextfrage($baseq::VARS{pin});
	}

	# Wenn übersprungen werden soll
	if ($baseq::VARS{but} eq $self-&gt;trans("BU3")) {
	   $f = $f-&gt;nextfrage($baseq::VARS{pin});
	   $self-&gt;log(4,"Proband Überspringt");
	   $self-&gt;{warntext}=$self-&gt;trans("WA6");
	}

	# Wenn abgebrochen werden soll
	if ($baseq::VARS{but} eq $self-&gt;trans("BU2")) {
	   $self-&gt;log(4,"Proband Unterbricht");
	   $self-&gt;{warntext}=$self-&gt;trans("WA7");
	   undef $f;
	}
        	

   # Standardmäßig die neue Frage anzeigen !
   if (defined $f) { $baseq::VARS{fid}=$f-&gt;{id};}
   if (! defined $f) {$self-&gt;umfende;}
   else {$f-&gt;htmlfra;}

}     	


####################################################################
####         Laeutet das Ende der Umfrage ein......
####         Argumente  : -
####         Returnwert : -
####################################################################
sub umfende {	
	my $self= shift;
	my ( $HTML, $TITLE );
        $self-&gt;log(4,"Entering: umfrage:umfende");
	$TITLE=$self-&gt;trans("TI5");
	if ($self-&gt;{usepanel}==1) {
		my $verd=$self-&gt;verdient($baseq::VARS{pin});
		if ($verd == 0){$self-&gt;{warntext}=$self-&gt;trans("WA9c")}
		else{ $self-&gt;{warntext}=$self-&gt;trans("WA9a")." ".$verd." ".$self-&gt;trans("WA9b")."&lt;br&gt;".$self-&gt;trans("WA9d")};
	    my $kasse=kasse-&gt;init($self);
		$kasse-&gt;haben($baseq::VARS{pin}, $self-&gt;{id}, $verd*100);
	}
        else {$self-&gt;{warntext}=$self-&gt;trans("WA10");}
	
	$self-&gt;sqldo("delete from ergebnis where umfid=$self-&gt;{id} and pin=$baseq::TESTPIN");
    if ($self-&gt;{showstat} !=0) {$self-&gt;pstatistik;$self-&gt;exit;}
	else {
	   $HTML=$self-&gt;SM('lbut',"BU11")."\n";
       $self-&gt;printhtml($TITLE,$HTML);
	}
}

####################################################################
####         Listet alle Fragen zu dieser Umfrage auf zur Bearbeitung
####		durch den Kunden
####         Argumente  : -
####         Returnwert : -
####################################################################
sub fragenliste {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:fragenliste");
  	my $f; my $fl=$self-&gt;loadfragen;
  	my $TITLE=$self-&gt;trans("TI7");
   	my $HTML=$self-&gt;sfont($self-&gt;trans("HI43")." ".$self-&gt;{firstfid})."&lt;BR&gt;\n&lt;TABLE&gt;\n";
   	while ($f = shift @$fl) { $HTML.=$f-&gt;fragenliste; }
	$HTML.="&lt;/TABLE&gt;&lt;BR&gt;\n".
   	$self-&gt;SMrow( ["but","but","but","but","kbut","but","but"] , ["BU6","BU8","BU10","BU5","BU13","BU11","BU24"] );

        $self-&gt;{helpkontext}="fragenliste";
        $self-&gt;printhtml($TITLE, $HTML);
}

####################################################################
####         Gibt sich und die Antworten zur Bearbeitung durch den
####		Kunden aus
####         Argumente  : -
####         Returnwert : HTML-string
####################################################################
sub htmlumfrage {
    my $self = shift;
    $self-&gt;log(4,"Entering: umfrage:htmlumfrage");
    my $kasse=kasse-&gt;init($self);
    my $umfk=$kasse-&gt;umfragekosten($self-&gt;{id});
    my ( $up, $ss, $htemp, $ntemp );
    my @datetext=($self-&gt;trans("HI2"),$self-&gt;trans("HI3"),$self-&gt;trans("HI4"), $self-&gt;trans("HI4a"));
    my $TITLE=$self-&gt;trans("TI9")." ".$self-&gt;{id};
    $self-&gt;{warntext}=$self-&gt;trans("TI9")." ".$self-&gt;{id};
    $self-&gt;{buttonwidth}=18;
	my $HTML=$self-&gt;sfont($self-&gt;trans("HI6"))."\n".$self-&gt;TF("umfrage",$self-&gt;{name},80)."&lt;BR&gt;\n".
             $self-&gt;sfont($self-&gt;trans("HI7"))."\n".$self-&gt;TF("exiturl",$self-&gt;{exiturl},80)."&lt;BR&gt;&lt;BR&gt;\n".
	"&lt;TABLE cellspacing=8&gt;\n".
    	$self-&gt;TR([
    	    $self-&gt;CB("usepanel", 1, $self-&gt;{usepanel}).
	    $self-&gt;sfont($self-&gt;trans("HI8")),
    	    $self-&gt;sfont($self-&gt;trans("HI9")),
	    $self-&gt;TF("beginn",$self-&gt;{beginn}),
	    $self-&gt;sfont($self-&gt;trans("HI10")),
	    $self-&gt;DDfface("stface",$self-&gt;{stface})  ]) .
	$self-&gt;TR([
	    $self-&gt;CB("showstat", 1, $self-&gt;{showstat} ).
            $self-&gt;sfont($self-&gt;trans("HI11")."&amp;nbsp;&amp;nbsp;"),
    	    $self-&gt;sfont($self-&gt;trans("HI5")),
	    $self-&gt;TF("ende",$self-&gt;{ende})."&amp;nbsp;&amp;nbsp;",   	
	    $self-&gt;sfont($self-&gt;trans("HI12")),
            $self-&gt;TF("stsize",$self-&gt;{stsize},10) ])  .
	$self-&gt;TR([
	    $self-&gt;DDtemp("template",$self-&gt;{template},0) ,
    	    $self-&gt;sfont($self-&gt;trans("HI13")),
	    $self-&gt;TF("ppf",$self-&gt;{ppf}),
	    $self-&gt;sfont($self-&gt;trans("HI14")),
            $self-&gt;DDfcolor("stcolor",$self-&gt;{stcolor})  ]) .
	"&lt;/TABLE&gt;\n&lt;HR&gt;\n".
	$self-&gt;sfont($self-&gt;trans("HI15").$self-&gt;TF("uname",$self-&gt;{uname}).$self-&gt;trans("HI16").
	                $self-&gt;TF("upass",$self-&gt;{upass}).$self-&gt;trans("HI17")."&lt;HR&gt;\n").
	$self-&gt;sfont($datetext[$self-&gt;checkdate()].
	sprintf("&amp;nbsp;&amp;nbsp;&amp;nbsp;Panelistenkosten: %0.2f Euro bzw. %0.2f DM",$umfk/100,$umfk*0.0195583 )).
	"&lt;HR&gt;\n".
        "&lt;TABLE&gt;\n".
	$self-&gt;TR([ $self-&gt;sfont($self-&gt;trans("HI17a")), $self-&gt;DDsprache('sprache',$self-&gt;{sprache}) ]).
	$self-&gt;TR([ $self-&gt;sfont($self-&gt;trans("HI17b")), $self-&gt;TF("firstfid",$self-&gt;{firstfid},5) ]).
	$self-&gt;TR([ $self-&gt;sfont($self-&gt;trans("HI17c")),
		    $self-&gt;DD('uspringen',[1,0],$self-&gt;{uspringen},{"1" =&gt; "Anzeigen","0"=&gt;"Verstecken"}) ]).
	$self-&gt;TR([ $self-&gt;sfont($self-&gt;trans("HI17d")), $self-&gt;TF("maxuser",$self-&gt;{maxuser},5) ]).	
	"&lt;/TABLE&gt;\n&lt;BR&gt;\n".
   	$self-&gt;SMrow( ["but","but","but","kbut"] , ["BU9","BU5","BU4","BU13"] ).
	$self-&gt;SMrow( ["but","but","but","but"] , ["BU11","BU24","BU26","BU28"] );

    $self-&gt;{helpkontext}="umfrage";
    $self-&gt;printhtml($TITLE, $HTML);
}

####################################################################
####         Bearbeitet die Eingabe der Frage durch den Kunden
####         Argumente  : -
####         Returnwert : -
####################################################################
sub getbearb {
	my $self = shift;
	my ( $f, $TITLE, $x );
    $self-&gt;log(4,"Entering: umfrage:getbearb");	
	
	# Wenn VARS{fid} nicht definiert ist wird eine Fragenliste ausgegeben
	#if ( (! defined $baseq::VARS{fid}) ) {
	#   $self-&gt;htmlumfrage;
	#}
        $self-&gt;log(4,"SPRACHE: $self-&gt;{sprache} -- $baseq::VARS{sprache} BU9=".$self-&gt;trans("BU9")." but=".$baseq::VARS{but} );
	# Hilfe anzeigen !?
	if ($baseq::VARS{but} eq $self-&gt;trans("BU24")) {
		$self-&gt;hilfe;
	}


	# Wenn gespeichert werden soll
	if ($baseq::VARS{but} eq $self-&gt;trans("BU1")) {
	  $self-&gt;log(4,"Kunde speichert");
	  $f = frage-&gt;init($self,$baseq::VARS{fid});  #  jetzt anliegende Frage laden....
	  $f-&gt;load();
	  if (! defined $f){$self-&gt;htmlumfrage;}
	  $f-&gt;getbearb;
	  $self-&gt;{warntext}=$self-&gt;trans("WA14");
	  $f-&gt;htmlbearb;
	}

	# Wenn die Frage gelöscht werden soll
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU8")) {
  	  $self-&gt;log(4,"Kunde löscht");
	  if ($baseq::VARS{radio} ne "") {$baseq::VARS{fid}=$baseq::VARS{radio};}
	  if ($baseq::VARS{fid} &gt; 0) {
	    $f = frage-&gt;init($self,$baseq::VARS{fid});  #  jetzt anliegende Frage laden....
	    $f=$f-&gt;load();
	    if (defined $f) {$x=$f-&gt;delete;}
	    $baseq::VARS{fid}=0;
	    $self-&gt;{warntext}=$x;
	  }
	  else {
	    $self-&gt;{warntext}=$self-&gt;trans("WA16");
	  }
	  $self-&gt;fragenliste();
	}

	# Wenn eine neue Frage erstellt werden soll
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU5")) {
           $self-&gt;log(4,"Kunde erstellt neue Frage");
	   $f=frage-&gt;init($self,$baseq::VARS{fid});
	   $f-&gt;new();
	   $baseq::VARS{fid}=$f-&gt;{id};
	   $self-&gt;{warntext}=$self-&gt;trans("WA17");
	   $f-&gt;htmlbearb;
	}

	#Wenn aus der Liste bearbeitet werden soll
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU6")) {
	  $self-&gt;log(4,"Kunde bearbeitet Frage");
	  if ($baseq::VARS{radio} &lt; 1) {
	     $self-&gt;{warntext}=$self-&gt;trans("WA16");
	     $self-&gt;fragenliste;
	  }
	  else {
	     $f=frage-&gt;init($self,$baseq::VARS{radio});
	     $f=$f-&gt;load();
	     $baseq::VARS{fid}=$f-&gt;{id};
	     $self-&gt;{warntext}=$self-&gt;trans("WA18");
	     $f-&gt;htmlbearb;
	  }
	} 	
    
	# Wenn die Liste angezeigt werden soll.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU4")) {
	     $self-&gt;log(4,"Kunde sieht Liste der Fragen");
	     $self-&gt;{warntext}=$self-&gt;trans("WA19");
             $baseq::VARS{fid}=0;
             $self-&gt;fragenliste;
    }

    # Wenn die Fragen angeglichen werden sollen !
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU26")) {
	     $self-&gt;log(4,"Kunde gleicht die Fragen an");
	     $self-&gt;{warntext}=$self-&gt;trans("WA19");
             my $y=$self-&gt;loadfragen;
             foreach $f (@$y) {$f-&gt;settext};
             $self-&gt;fragenliste;
    }

    # Wenn die Umfrage gespeichert werden soll.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU9")) { $self-&gt;getumfbearb; $self-&gt;log(4,"Kunde speichert Umfrage");}

    # Wenn die Umfrage angezeigt werden soll.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU10")) { $self-&gt;htmlumfrage; $self-&gt;log(4,"Kunde sieht Umfrage");}

	# Wenn die Umfrage angezeigt werden soll.....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU28")) { 
		$self-&gt;log(4,"Kunde Kopiert neue Umfrage");
		my $frag=$self-&gt;loadfragen; 
		$self-&gt;{name} .= "  (Kopie)";
		$self-&gt;new;
		foreach $f (@$frag) {$f-&gt;{umfid}=$self-&gt;{id}; $f-&gt;new;}
		$self-&gt;htmlumfrage;	
	}
	
	# Beenden mit Redirect....
	elsif ($baseq::VARS{but} eq $self-&gt;trans("BU11")) { $self-&gt;redirect;}
	
	# Wenn alles andere versagt.....   :-)
	else { $self-&gt;htmlumfrage; $self-&gt;log(4,"Kein Button gedrückt, Kunde sieht Umfrage"); }

}

####################################################################
####         nimmt die Änderungen aus dem Formular an
####         Argumente  : Zeiger auf Variablen
####         Returnwert : -
####################################################################
sub getumfbearb {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:getumfbearb");
	$self-&gt;{name}=$self-&gt;fclean($baseq::VARS{umfrage});
	$self-&gt;{template}=$baseq::VARS{template}+0;	
	$self-&gt;{usepanel}=$baseq::VARS{usepanel}+0;	
	$self-&gt;{showstat}=$baseq::VARS{showstat}+0;	
	$self-&gt;{beginn}=$self-&gt;fclean($baseq::VARS{beginn});
	$self-&gt;{ende}=$self-&gt;fclean($baseq::VARS{ende});
	$self-&gt;{ppf}=$baseq::VARS{ppf}+0;
	$self-&gt;{stface}=$self-&gt;fclean($baseq::VARS{stface});	
	$self-&gt;{stsize}=$self-&gt;fclean($baseq::VARS{stsize});	
	$self-&gt;{stcolor}=$self-&gt;fclean($baseq::VARS{stcolor});	
	$self-&gt;{exiturl}=$self-&gt;fclean($baseq::VARS{exiturl});	
        $self-&gt;{uname}=$self-&gt;fclean($baseq::VARS{uname});	
	$self-&gt;{upass}=$self-&gt;fclean($baseq::VARS{upass});	
	$self-&gt;{sprache}=$baseq::VARS{sprache}+0;	
	$self-&gt;{firstfid}=$baseq::VARS{firstfid}+0;
	$self-&gt;{uspringen}=$baseq::VARS{uspringen}+0;
        $self-&gt;{maxuser}=$baseq::VARS{maxuser}+0;
	$self-&gt;store;
        $self-&gt;load;
	$self-&gt;htmlumfrage;
}


####################################################################
####         Liefert den Preis für die Beantwortung !
####         Argumente  : -
####         Returnwert : Betrag in Pfennigen
####################################################################
sub verdient {
	my $self = shift;
	my $pin = shift;
    my ($f, $x);
	$self-&gt;log(4,"Entering: umfrage:verdient");
	if ($pin==0) {$self-&gt;log(1, "umfrage-&gt;verdient : PIN wurde nicht übergeben !"); }
	foreach $f (@{$self-&gt;loadfragen}) {$x+=$f-&gt;verdient($pin);}
	return sprintf("%0.2f",$x*$self-&gt;{ppf}/100);#/
	
}

####################################################################
####         Gibt die Statistik für die Umfrage aus
####         Argumente  : -
####         Returnwert : -
####################################################################
sub htmlgrafik {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:htmlgrafik");
	$self-&gt;{FL}=$self-&gt;loadfragen;
	my @tdiff; my @FL=@{ $self-&gt;{FL} };
	my $HTML=""; my $minpin; my $maxpin; my $pin; my $changed; my @max; my @min;
	my $f;my $maxdiff=0; my $mindiff=50000000000000;
	my $pins=$self-&gt;sqldo("select distinct(pin) from ergebnis where umfid=$self-&gt;{id}")+0;

	my $sth=$self-&gt;sqlprepare("select pin, min(changed), max(changed) from ergebnis where umfid=$self-&gt;{id} group by pin");
	while ( ($pin,$min,$max)=$sth-&gt;fetchrow_array) {
		@tdiff=$self-&gt;timediff($min, $max);
	        if ($tdiff[0]&gt;$maxdiff) {$maxpin=$pin; $maxdiff=$tdiff[0]; $maxdiffpin=$self-&gt;duration($min, $max); }
	        if ($tdiff[0]&lt;$mindiff &amp;&amp; $max - $min !=0 ) {$minpin=$pin; $mindiff=$tdiff[0]; $mindiffpin=$self-&gt;duration($min, $max); }
		$self-&gt;log(4,join(" - ",@tdiff));
	}

	$mindate=$self-&gt;sqlselect("select min(changed) from ergebnis where umfid=$self-&gt;{id}");
	$maxdate=$self-&gt;sqlselect("select max(changed) from ergebnis where umfid=$self-&gt;{id}");
	$HTML.="&lt;TABLE&gt;".
		$self-&gt;TR([ $self-&gt;sfont("Erste Antwort:"),$self-&gt;sfont($self-&gt;timestamp($mindate)) ]).
		$self-&gt;TR([ $self-&gt;sfont("Letzte Antwort:"),$self-&gt;sfont($self-&gt;timestamp($maxdate)) ]).
		$self-&gt;TR([ $self-&gt;sfont("Zeitraum:"),$self-&gt;sfont($self-&gt;duration($mindate, $maxdate)) ]).
		$self-&gt;TR([ $self-&gt;sfont("Teilnehmer:"),$self-&gt;sfont($pins) ]).
		$self-&gt;TR([ $self-&gt;sfont("Min. Teilnahmezeit:"),$self-&gt;sfont($mindiffpin) ]).
		$self-&gt;TR([ $self-&gt;sfont("Max. Teilnahmezeit:"),$self-&gt;sfont($maxdiffpin) ]).
	"&lt;/TABLE&gt;";
		$self-&gt;log(4,"Min: ". $mindiffpin );
		$self-&gt;log(4,"Max: ". $maxdiffpin );
	my @L1;
	foreach $f (@FL) {
	push (@L1, $f-&gt;anzahlstr);
	}
	my $filename=$baseq::UMFIMG."U".$self-&gt;{id}."FRAGEN".$pins.".gif";
	if ($pins&gt;0) {
	  grafik::paint("VL",$baseq::PATH.$filename,25,\@L1,5,$pins);
	  $HTML.=$self-&gt;IMG($filename);
	}
	$HTML.="&lt;HR&gt;\n";
	if ($self-&gt;{knr}==4) {$HTML.=$self-&gt;otto;}
	foreach $f  ( @FL) {
	$HTML.=$f-&gt;htmlgrafik;
	}
	return $HTML
}

sub kstatistik {
	$self=shift;
	$HTML=$self-&gt;htmlgrafik;
	$self-&gt;printhtml($self-&gt;trans("TI4"),$HTML.$self-&gt;SM('kbut',"BU13") )
}

sub pstatistik {
	$self=shift;
	$HTML=$self-&gt;htmlgrafik;
	$self-&gt;printhtml($self-&gt;trans("TI4"),$HTML.$self-&gt;SM('lbut',"BU11") )
}

####################################################################
####         Gibt die otto Statistik für die Umfrage aus
####         Argumente  : -
####         Returnwert : -
####################################################################
sub otto {
	my $self = shift;
    $self-&gt;log(4,"Entering: umfrage:otto");
    my $SQL1 = "select  hermes.depot from benutzer ".
               "left join hermes on hermes.plz=benutzer.plz left join umfidpin on umfidpin.pin=benutzer.pin where umfidpin.umfid=$self-&gt;{id}";
    my $SQL3 = "select distinct depot,ort,gebiet from hermes order by id";
    my $SQL4 = "select distinct pin from ergebnis where umfid=$self-&gt;{id}";
	my $rows = $self-&gt;sqldo($SQL4);
    my ($HTML, $pin, $plz, $depot, @adepot, @xdepot, @aleit, @xleit, $x, $leit, @proz, @Lleit, @Ldepot, @aids, $aid);
    my $file2=$baseq::UMFIMG."U".$self-&gt;{id}."O2T".$rows.".gif";
    my $sth=$self-&gt;sqlprepare("select distinct aid,antwort from antworten where umfid=$self-&gt;{id} and fid=1");
	while (($aid,$atext)=$sth-&gt;fetchrow_array) {push @aids, $aid; $atext=~/,\s*([0-9\.]+)\.\d{4}$/; push @antworts, $1}

	$sth=$self-&gt;sqlprepare($SQL1);
	while ( ($depot)=$sth-&gt;fetchrow_array) {	$adepot[$depot]++;  	}
	$sth-&gt;finish;

	foreach $aid (@aids) {	
          my $SQL2 = "select distinct ergebnis.pin ,benutzer.plz, hermes.depot from ergebnis ".
		   "left join benutzer on benutzer.pin=ergebnis.pin ".
		   "left join hermes on hermes.plz=benutzer.plz where ergebnis.umfid=$self-&gt;{id} and ergebnis.fid=1 and ergebnis.aid=$aid";
          $sth=$self-&gt;sqlprepare($SQL2);
	      while ( ($pin,$plz,$depot)=$sth-&gt;fetchrow_array) {	$xdepot[$aid][$depot]++; }
	      $sth-&gt;finish;
	}
  
	$HTML.=$self-&gt;qfont("Aufteilung der Zulieferung nach Tagen und Depots")."&lt;BR&gt;&lt;BR&gt;\n";
	$HTML.="&lt;TABLE border=1&gt;\n".$self-&gt;TR(["Dep","Name","Geb.","n","ges", @antworts]);
	$sth=$self-&gt;sqlprepare($SQL3);
	while ( ($x,$xa,$xb)=$sth-&gt;fetchrow_array) {
    	  @xdepotaid=(); $ges=0;
	      foreach $aid (@aids) {
		      if ($xdepot[$aid][$x] eq "") {$xdepot[$aid][$x]="&amp;nbsp;";}
		      push @xdepotaid, $xdepot[$aid][$x];
			  $ges+=$xdepot[$aid][$x];		      
		  }
		  unshift @xdepotaid, $ges;	
          if ($x&lt;10) {$x="0".$x;}
		  if ($adepot[$x]&lt;10){$adepot[$x]="0".$adepot[$x];}	
		  if ($adepot[$x]==0){$adepot[$x]="0";}
		  push @Ldepot,"$ges Depot[$x] ($adepot[$x])"; 
          $HTML.=$self-&gt;TR(["[$x]",$xa,$xb,$adepot[$x],@xdepotaid ]);
	}
   	$Y=open (FILE, "&lt;$baseq::PATH.$file2"); close FILE;
	$self-&gt;log(4,"$baseq::PATH.$file2".join(" - ",@Ldepot) );
	if (! $Y) {grafik::paint("VL",$baseq::PATH.$file2, 25,\@Ldepot,0,100,0,1);}

        $HTML.="&lt;/TABLE&gt;\n&lt;HR&gt;\n".$self-&gt;IMG($file2)."\n&lt;HR&gt;\n";

	######################################## 5.7 ) Pin, Depot,Einz,mehrfam Datum, Zuste	
	my $titel="R&amp;uuml;ckmeldung der Panelteilnehmer";
	my $HTMLX=$self-&gt;qfont($titel)."&lt;BR&gt;\n&lt;TABLE border=1&gt;\n";
	$HTMLX.=$self-&gt;TR(["PIN","Depot","R&amp;uuml;ckmeldung am","Katalogankunft","Wohnart"]);
	my $SQL="select ergebnis.pin, hermes.depot, ergebnis.changed, ergebnis.aid from ergebnis left join benutzer on ergebnis.pin=benutzer.pin left join hermes on hermes.plz=benutzer.plz where umfid=$self-&gt;{id} and fid&lt;3 order by ergebnis.pin, ergebnis.fid";
	my $sth=$self-&gt;sqlprepare($SQL);
	my $oldpin=0;
	foreach $f (@{$self-&gt;{FL}}) {
		if ($f-&gt;{id}==1) {@F1A=$f-&gt;antwortarray}
		if ($f-&gt;{id}==2) {@F2A=$f-&gt;antwortarray}
	}
	while (@L=$sth-&gt;fetchrow_array) {
		my $pin=$L[0];
		if ($pin==$oldpin) {
			push (@Lout, @F2A[$L[3]] ) ;
			$HTMLX.=$self-&gt;TR(\@Lout);
		}
		else { 
			@Lout=@L; 
			$Lout[2]=$self-&gt;timestamp($Lout[2]);
			$Lout[3]=@F1A[$Lout[3]];
			$oldpin=$pin;
		}
	}
        $HTMLX.="&lt;/TABLE&gt;\n";
	my $filename=$baseq::UMFIMG."U".$self-&gt;{id}."OTTO-TAB".$sth-&gt;rows.".html";
	$self-&gt;log(4,"OTTO-Schreckliche Tabelle: ".$baseq::PATH.$filename);
	$self-&gt;printhtml($titel,$HTMLX,$baseq::PATH.$filename);
	$HTML.=$self-&gt;AH($filename,$self-&gt;qfont($titel))."&lt;HR&gt;\n";
	return $HTML;

}

####################################################################
####         Selektiert eine neue PIN für Panellose Umfragen
####         Argumente  : -
####         Returnwert : Neue Pin
####################################################################
sub newpin {
	my $self = shift;
        $self-&gt;log(4,"Entering: umfrage:newpin");
        my ($a,$b,$c,$d)=$ENV{REMOTE_ADDR}=~/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/;
	my $avgpin=$self-&gt;sqlselect("select avg(pin) from ergebnis where umfid=$self-&gt;{id}");
	$avgpin=~s/\..*$//;
	my $resu=$avgpin+$a+$b+$c+$d;
	$self-&gt;log(4,"AveragePIN: $avgpin+$a+$b+$c+$d=$resu");
	while ($self-&gt;sqlselect("select pin from ergebnis where umfid=$self-&gt;{id} and pin=$resu")&gt;0) {$resu++;}
	$self-&gt;log(4,$baseq::VARS{fid});
	$baseq::VARS{fid}=$self-&gt;{firstfid};
	return $resu;
}

####################################################################
####         Überprüft den Umfragenzeitraum
####         Argumente  : -
####         Returnwert : 0=aktuell, 1=noch nicht aktiv, 2=vorbei
####################################################################
sub checkdate {
      my $self = shift;
      $self-&gt;log(4,"Entering: umfrage:checkdate");
      my $date = $self-&gt;sqlselect("select NOW() from umfragen");
      my $user = $self-&gt;sqldo("select distinct pin from ergebnis where umfid=$self-&gt;{id}");
      if ( ($baseq::VARS{fid} &lt; 1) or ($baseq::VARS{fid} == $self-&gt;{firstfid}) ) {$user++}
      my $ret=0;
      $self-&gt;log(4,"Datum=$date");
      if ($date gt $self-&gt;{ende}) {$ret=2;}
      if ($date lt $self-&gt;{beginn}) {$ret=1;}
      if ($user &gt; $self-&gt;{maxuser}) {$ret=3;}
      return $ret;
}
</pre></body></html>