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

use template;
#use strict;

@ISA = qw ( template );


####################################################################
####         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-&gt;init(@_);
	bless $self, $class;	
	return $self;
}

####################################################################
####         Konstuktor der Antwortenklasse
####         Argumente  : Umfid , fid , aid
####         Returnwert : Referenz auf das neue Antwortobjekt
####################################################################
sub load {
	my $self = shift;
	return;
	$self-&gt;log(4,"Entering: antwort:load");
        my $sql = "select antwort, nextfid, typ, tlang from antworten where umfid=$self-&gt;{umfid} and fid=$self-&gt;{fid} and aid=$self-&gt;{id} ";
        ($self-&gt;{name}, $self-&gt;{nextfid}, $self-&gt;{typ}, $self-&gt;{tlang}) = $self-&gt;sqlselect($sql);
	if (! defined $self-&gt;{nextfid}) { $self-&gt;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;
	return;
	$self-&gt;log(4,"Entering: antwort:new");
	my $sql1 = "select max(aid) from antworten where umfid=$self-&gt;{umfid} and fid=$self-&gt;{fid}";
	$self-&gt;{id} = ($self-&gt;sqlselect($sql1))+1;                # größte ID+1
    my $sql2 = "insert into antworten set umfid=$self-&gt;{umfid}, fid=$self-&gt;{fid}, aid=$self-&gt;{id}, antwort='$self-&gt;{name}', ".
		       "nextfid='$self-&gt;{nextfid}', typ='$self-&gt;{typ}', tlang=$self-&gt;{tlang}";
	$self-&gt;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;
	return;
	$self-&gt;log(4,"Entering: antwort:store");
	my $sql = "update antworten set antwort='$self-&gt;{name}', nextfid=$self-&gt;{nextfid}, ".
              "typ=$self-&gt;{typ}, tlang=$self-&gt;{tlang} where umfid=$self-&gt;{umfid} and fid=$self-&gt;{fid} and aid=$self-&gt;{id}";
	$self-&gt;sqldo($sql);
    return;
}

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

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

####################################################################
####         Gibt eine Dropdown der Anreden zurueck
####         Argumente  : -
####         Returnwert : -
####################################################################
sub DDanrede {
	my ($self, $name, $val)=@_;
	my ($x, @L, %H);
	if ($name eq "") {$name="anrede";}
	if ($val eq "") {$val=$self-&gt;{anrede};}
	for ($x=1; $x&lt;3; $x++) {push @L,$x; $H{$x}=$baseq::HF[$x];}
	return $self-&gt;DD($name,\@L,$val,\%H);
}

####################################################################
####         Gibt eine Dropdown der Familienstaende zurueck
####         Argumente  : -
####         Returnwert : -
####################################################################
sub DDfamilie {
	my ($self, $name, $val)=@_;
	my ($x, @L, %H);
	if ($name eq "") {$name="famstand";}
	if ($val eq "") {$val=$self-&gt;{famstand};}
	for ($x=0; $x&lt;3; $x++) {push @L,$x; $H{$x}=$baseq::FS[$x];}
	return $self-&gt;DD($name,\@L,$val,\%H);
}

####################################################################
####         Gibt eine Dropdown der Bildungen zurueck
####         Argumente  : -
####         Returnwert : -
####################################################################
sub DDbildung {
	my ($self, $name, $val)=@_;
	my ($x, @L, %H);
	if ($name eq "") {$name="bildung";}
	if ($val eq "") {$val=$self-&gt;{bildung};}
	for ($x=0; $x&lt;8; $x++) {push @L,$x; $H{$x}=$baseq::BI[$x];}
	return $self-&gt;DD($name,\@L,$val,\%H);
}

####################################################################
####         Gibt eine Dropdown der Beschaeftigungen zurueck
####         Argumente  : -
####         Returnwert : -
####################################################################
sub DDarbeit {
	my ($self, $name, $val)=@_;
	my ($x, @L, %H);
	if ($name eq "") {$name="arbeit";}
	if ($val eq "") {$val=$self-&gt;{arbeit};}
	for ($x=0; $x&lt;7; $x++) {push @L,$x; $H{$x}=$baseq::BS[$x];}
	return $self-&gt;DD($name,\@L,$val,\%H);
}

####################################################################
####         Gibt die Kriterientabellen zurueck
####         Argumente  : -
####         Returnwert : Kategorien, Hobbies
####################################################################
sub krittable {
	my ($self, $klicked)=@_;
	my ($num, $retl);
	my $ret="&lt;TABLE BORDER=1&gt;\n";
        my $xa=3; my @L=();
	for ($x=1; $x&lt;49 ;$x++) {
        if ($baseq::KRIT[$x] eq "") {next}
	    push @L, $self-&gt;sfont($self-&gt;CB("pk$x",1,$baseq::VARS{"pk$x"} ).$baseq::KRIT[$x]);
        $xa--; if ($xa==0 || $x==25 || $x==48) {$xa=3; $ret.=$self-&gt;TR(\@L); @L=()}
        if ($x==25) {$retl=$ret."&lt;/TABLE&gt;\n"; $ret="&lt;TABLE BORDER=1&gt;\n";}
	}
	return ($retl, $ret."&lt;/TABLE&gt;\n");
}

####################################################################
####         Gibt die Versandhaus-Tabelle zurueck
####         Argumente  : -
####         Returnwert : Versandhauser
####################################################################
sub vhtable {
	my ($self, $klicked)=@_;
	my $vh;
	my $ret="&lt;TABLE BORDER=1&gt;\n";
        my $xa=3; my @L=();
	for ($x=0; $x&lt;20 ;$x++) {
         if ($baseq::VH[$x] eq "") {next}
         push @L, $self-&gt;sfont($self-&gt;CB("vh$x",1,$baseq::VARS{"vh$x"} ).$baseq::VH[$x]);
         $xa--; if ($xa==0 || $x==19) {$xa=3; $ret.=$self-&gt;TR(\@L); @L=()}
	}
	return $ret."&lt;/TABLE&gt;\n"; 
}

</pre></body></html>