<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl
#
#

use DBI;
use CGI;
use err;

open (FILE, "&lt;panel2.conf") or die "AAAAr";
while ($line = &lt;FILE&gt;) {
  ($key,$val) = ($line =~/^(\S*)\s*=\s*(\S*)/);
   if ($key ne "") { $conf{$key}=$val }
}
close FILE;

# Define the variables.

my $query= new CGI;

my $button = $query-&gt;param('but');
my %val = $query-&gt;Vars;
my %mon = ("Januar","01","Februar","02","März","03","April","04","Mai","05","Juni","06","Juli","07",
			"August","08","September","09","Oktober","10","November","11","Dezember","12");
my %landkz = ("Deutschland","D","Österreich","A","Schweiz","CH");

my $zurucktext="&lt;i&gt;\n&lt;li&gt;Klicken sie auf &lt;b&gt; ZURÜCK &lt;/b&gt; um das Anmeldeformular zu vervollständigen oder zu korrigieren&lt;/i&gt;&lt;br&gt;&lt;br&gt;\n&lt;hr size=1 width=75%&gt;&lt;p&gt;\n";
my $ende='    Ende    ';
my $endebut = $query-&gt;startform . $query-&gt;submit("but",$ende) . $query-&gt;endform;

my $DB_DSN      = "DBI:$conf{database}:$conf{dataname}:$conf{datahost}";
my $DB_USER     = "$conf{datauser}";
my $DB_PASSWD   = "$conf{datapass}";

my $dbh = DBI-&gt;connect($DB_DSN, $DB_USER, 
   $DB_PASSWD) or {err::error_seite("Cannot connect to DB")};


#-----------------------------------------------------------------------------------------------
#Angabe beenden

if ($button eq $ende){ print $query-&gt;redirect("/index.htm")}

#--------------------------------------------------------------------------------------------------
#Anfangswerte für Integer-Felder auf Null setzen 

$val{pers3}+=0;
$val{pers12}+=0;
$val{pers54}+=0;
$val{pers55}+=0;
$val{pers22}+=0;
$val{plz}+=0;
$pin=0;
$gdat="1.1.1800";

#--------------------------------------------------------------------------------------------------
#Daten Löschen
$sql="delete from benutzer where pin=$val{pin}";

if ($val{but} eq "Eintrag Löschen"){
   $dbh-&gt;do($sql) or {err::error_seite("Es ist ein Fehler aufgetreten, oder Ihre Eingaben sind schon gelöscht worden!",$endebut)};
	err::error_seite("Ihre Eingaben wurden aus der Datenbank entfernt",$endebut);
}

#-----------------------------------------------------------------------------------------------
#Leere  Pflichtfelder?

if ($val{vname} eq "" ||
	$val{nname} eq "" ||
	$val{strasse} eq "" ||
	$val{plz} eq "" ||
	$val{land} eq "" ||
	$val{email} eq "" ||
	$val{tel} eq "" ||
	$val{gdatum} eq "" ||
	$val{gjahr} eq ""
	)

{	$dbh-&gt;disconnect();
	err::error_seite("Überprüfen Sie bitte, daß alle mit Sternen markierte Felder ausgefüllt sind!",$zurucktext);
}

#----------------------------------------------------------------------------------------------
#E-Mail Adresse überprüfen

if ($val{email} !~/.+@.+\.([a-z|A-Z]){2,3}$/) #Reguläre Ausdrücke !!!
#testet auf @ mit zeichen davor und dahinter und Punkt zwischen Zeichen hinter @

{	err::error_seite("Überprüfen Sie bitte Ihre E-Mail Adresse",$zurucktext);}

#----------------------------------------------------------------------------------------------
#Postleitzahl überprüfen

if ($val{plz} !~/^\d{4,5}$/) #testet auf 5-stellige Zahl

{	err::error_seite("Überprüfen Sie bitte Ihre Postleitzahl.",$zurucktext);}

#----------------------------------------------------------------------------------------------
# Ort nach PLZ ermitteln
%laender=('1','D','2','CH','3','A');
my $sql = "select ort from plz where plz=$val{plz} and land='$laender{$val{land}}'";

if ($val{stadt} eq "" &amp;&amp; $val{plz} ne "") { $val{stadt} = $dbh-&gt;selectrow_array($sql) }


#---------------------------------------------------------------------------------------------
# Ort nicht existiert -&gt; PLZ nicht korrekt!

if ($val{stadt} eq "")
	{err::error_seite("Ihr Wohnort konnte nicht automatisch ermittelt werden, überprüfen Sie Ihre Plz oder tragen Sie Ihren Wohnort ein",$zurucktext)}

#----------------------------------------------------------------------------------------------
#Telefonnummerangabe überprüfen

$val{tel}=~s/\D//g;   #Löscht alle nicht digits aus der Telefonnummer
if ($val{tel} !~/0\d{5,}/)   #Tel.Nr muß mit 0 anfangen und mind. 6 zeichen lang sein
	{err::error_seite("Überprüfen Sie bitte, ob Sie Ihre Telefonnummer korrekt mit Vorwahl eingegeben haben.",$zurucktext)}

#------------------------------------------------------------------------------------------------
#Benutzer vorhanden! oder falsche Angaben

$sql = "select * from benutzer where vname='$val{vname}' and nname='$val{nname}' and tel='$val{tel}'";
if (defined($row = $dbh-&gt;selectrow_array($sql)))
	{err::error_seite("Falls Ihre Angaben korrekt sind , dann sind Sie bereits als Benutzer registriert.",$zurucktext)}

#--------------------------------------------------------------------------------------------------

#Bankinstitut, BLZ oder Kontonummer sind leer?

if (($val{lohnart} eq "Überweisung") &amp;&amp; (($val{bank} eq "") || ($val{blz} eq "") || ($val{kontonr} eq "")))
	{err::error_seite("Sie haben sich für eine Banküberweisung entschieden! Dafür benötigen wir noch die Angabe Ihres Bankinstitutes, Bankleitzahl und Ihre Kontonummer",$zurucktext)}

#--------------------------------------------------------------------------------------------------
#BLZ und Kontonummer bearbeiten und überprüfen ..

if ($val{blz} ne "") {
	
	$val{blz}=~s/\D//g;					#Löscht alle nicht digits aus der BLZ &amp; Kontonnummer
	if ($val{blz} !~/^\d{8,15}$/) #testet auf 8-15 stellige Zahl

	{	err::error_seite("Überprüfen Sie bitte Ihre Bankleitzahl.",$zurucktext);}


	}	
	
if ($val{kontonr} ne "") {

	$val{kontonr}=~s/\D//g;
	
	if ($val{kontonr} !~/^\d{4,15}$/) #testet auf 8-15 stellige Zahl

	{	err::error_seite("Überprüfen Sie bitte Ihre Kontonummer.",$zurucktext);}

}

#--------------------------------------------------------------------------------------------------
#Geburtsdatum in ein Feld schreiben
$val{gdatum}=~s/\D//g;   #Löscht alle nicht digits aus dem Tag
$val{gjahr}=~s/\D//g;   #Löscht alle nicht digits aus dem Jahr


if ((($val{gdatum}+0) &gt; 31) || (($val{gjahr}+0) &gt; 2100)) {
	err::error_seite("Bitte überprüfen Sie Ihr Geburtsdatum",$zurucktext);
}
	
 
if (($val{gdatum} eq "") || ($val{gjahr} eq "") || ($val{gmonat} eq ""))
	{$gdat="1800-01-01";
	 $geb="1800";}


elsif (($val{gdatum} ne "") &amp;&amp; ($val{gjahr} ne "") &amp;&amp; ($val{gjahr} =~/^\d{2}$/))
	{$gdat="19$val{gjahr}-$mon{$val{gmonat}}-$val{gdatum}";
	 $geb="19$val{gjahr}";}
  

elsif (($val{gdatum} ne "") &amp;&amp; ($val{gjahr} ne "") &amp;&amp; ($val{gjahr} =~/^\d{4}$/))
	{$gdat="$val{gjahr}-$mon{$val{gmonat}}-$val{gdatum}";
	 $geb="$val{gjahr}";}


#--------------------------------------------------------------------------------------------------
#Jahr der letzten Bestellung
$val{bestjahr}=~s/\D//g;   #Löscht alle nicht digits aus dem Jahr

if (($val{bestjahr} ne "") &amp;&amp; ($val{bestjahr} =~/^\d{2}$/))

{	err::error_seite("Jahr der letzten Bestellung muß 4stellig sein.",$zurucktext);}

#Passwort überprüfen

if (($val{pass1} ne $val{pass2}) || ($val{pass1} eq ""))

{	err::error_seite("Die Passwörter stimmen nicht überein oder sind nicht eingegeben worden.",$zurucktext);}

#--------------------------------------------------------------------------------------------------

if ($val{pass1} !~/^\S{5,8}$/) 


{	err::error_seite("Das Passwort darf nicht kürzer als 5 oder länger als 8 Zeichen sein!",$zurucktext);}


#--------------------------------------------------------------------------------------------------
#PIN - Nummer zuweisen

$sql = "select max(pin) from benutzer";
if (($pin=$dbh-&gt;selectrow_array($sql)+1) == 1) {$pin="10323"}

#----------------------------------------------------------------------------------------------
#Benutzerdaten in die Datenbank einfügen
#Produktkategorien hinzufügen
@gueter=$query-&gt;param('krit');
for ($x=1; $x&lt;51 ;$x++) { @liste[$x]="0"}
while($gut = shift(@gueter)) { @liste[$gut] = "1"}
my $riesenliste= join(",",@liste);

#Versandhäuser
my @vhaeuser=$query-&gt;param("vh");
my $aus=""; my $vhs="";
for ($x=0; $x&lt;20 ;$x++) { @listeu[$x]="0";}
while(defined($vhs = shift (@vhaeuser)) ) { @listeu[$vhs] = "1";}
my $riesenliste2= join(",",@listeu);

$val{bestjahr}+=0;
$sql = "insert into benutzer values ($val{anrede},'$val{vname}','$val{nname}','$val{strasse}','$val{stadt}',$val{plz},$val{land},'$val{email}','$val{tel}','$gdat',$val{bildung},$val{famstand},$val{arbeit},$val{pers3},$val{pers12},$val{pers22},$val{pers54},$val{pers55},'$val{pass1}',$pin,'$val{lohnart}','$val{bank}','$val{blz}','$val{kontonr}'$riesenliste,$val{provider},$val{herkunft},$riesenliste2,$val{bestjahr},$geb,NULL,0)";
$dbh-&gt;do($sql) or err::error_seite("Insert failed ($sql)",$ende);

#--------------------------------------------------------------------------------------------------
#HTML - Ergebnissdokument generieren

print  $query-&gt;header,
   $query-&gt;start_html(-title=&gt;'Prorata Anmeldungsergebnis',
		     -text=&gt;'#000000', -bgcolor=&gt;'#CCCCCC', -link=&gt;'#0000FF',
		     -vlink=&gt;'#0000FF', -alink=&gt;'#0000FF', 
		     -background=&gt;'' ),

"&lt;b&gt;&lt;font face='$conf{stdfont}' size=5&gt;Vielen Dank für die zugesandte Information!&lt;br&gt;Ihre Eingaben wurden wie folgt abgespeichert : &lt;/font&gt;&lt;br&gt;&lt;br&gt;&lt;font size=3&gt;Sobald eine Internet-Befragung vorliegt, werden wir Sie per E-Mail benachrichtigen.&lt;br&gt;&lt;br&gt;",
"&lt;/b&gt;&lt;font face='$conf{stdfont}' size=3 color='#FF8000'&gt;&lt;b&gt;Falls Ihre Angaben noch Fehler enthalten, drücken Sie bitte den Button \"Eintrag Löschen\"",
'&lt;br&gt;und dann 2 mal den Button "Zurück" in der Symbolleiste des Browsers, um Ihre Eingaben zu korrigieren&lt;/font&gt;&lt;/b&gt;&lt;b&gt;&lt;br&gt;&lt;br&gt;';

print "&lt;font face='$conf{stdfont}'&gt;";
	  @HF=("","Herr","Frau");
	  print @HF[$val{anrede}];
      @LA=("","Deutschland","&amp;Ouml;sterreich","Schweiz");
	  @PR=("","T-Online","AOL","Arcor","Otello","Freenet","Talknet","1 &amp; 1","Netcologne","OWL-Online","Surf Callino","Viag Interkom","Compuserve","Okaynet","Debitel","Nikoma","UU-Net","Germanynet","Uni-Server","FH-Server","Andere");
print	  "&lt;br&gt;$val{vname}&amp;nbsp;$val{nname}&lt;br&gt;",
      "$val{strasse}&lt;br&gt;&lt;br&gt;$val{plz}&amp;nbsp;$val{stadt}&lt;br&gt;",
	  "@LA[$val{land}]&lt;br&gt;&lt;hr&gt;&lt;br&gt;&lt;table border=2&gt;",
	  "&lt;TR&gt;&lt;TD&gt;E-Mail :&lt;/TD&gt;&lt;TD&gt;$val{email}&lt;/TD&gt;&lt;/TR&gt;",	
      "&lt;TR&gt;&lt;TD&gt;Provider :&lt;/TD&gt;&lt;TD&gt;@PR[$val{provider}]&lt;/TD&gt;&lt;/TR&gt;",
	  "&lt;TR&gt;&lt;TD&gt;Tel :&lt;/TD&gt;&lt;TD&gt;$val{tel}&lt;/TD&gt;&lt;/TR&gt;&lt;/b&gt;";
	  if ($gdat) {
	  	  print"&lt;TR&gt;&lt;TD&gt;Geburtsdatum :&lt;/TD&gt;&lt;TD&gt;$gdat&lt;/TD&gt;&lt;/TR&gt;";	  
 	  }
	 if ($val{bildung}) {
	      @BI=("Keine Angaben","Hauptschule","Realschule","Gymnasium","Fachhochschule","Hochschule","Magister","Promotion"); 
		  print "&lt;TR&gt;&lt;TD&gt;Bildung :&lt;/TD&gt;&lt;TD&gt;@BI[$val{bildung}]&lt;/TD&gt;&lt;/TR&gt;";
	  }
	  if ($val{famstand}) {
	      @FS=("Keine Angaben","Verheiratet","Ledig");
		  print "&lt;TR&gt;&lt;TD&gt;Familienstand :&lt;/TD&gt;&lt;TD&gt;@FS[$val{famstand}]&lt;/TD&gt;&lt;/TR&gt;";
	  }
	  if ($val{arbeit}) {
	      @BS=("Keine Angaben","Vollzeitbesch&amp;auml;ftigt","Teilzeitbesch&amp;auml;ftigt","Rentner/in","Student/in","Sch&amp;uuml;ler/in","zur Zeit erwerbslos");
		  print "&lt;TR&gt;&lt;TD&gt;Beschäftigung :&lt;/TD&gt;&lt;TD&gt;@BS[$val{arbeit}]&lt;/TD&gt;&lt;/TR&gt;";
	  }
	  if ($val{pers3}!=0) {
	      print "&lt;TR&gt;&lt;TD&gt;Personen im Haushalt bis 3 Jahren :&lt;/TD&gt;&lt;TD&gt;$val{pers3}&lt;/TD&gt;&lt;/TR&gt;";
	  }
	  if ($val{pers12}!=0) {
	      print "&lt;TR&gt;&lt;TD&gt;Personen im Haushalt ab 3 bis 12 Jahren :&lt;/TD&gt;&lt;TD&gt;$val{pers12}&lt;/TD&gt;&lt;/TR&gt;";
	  }
	  if ($val{pers22}!=0) {
	      print "&lt;TR&gt;&lt;TD&gt;Personen im Haushalt ab 12 bis 22 Jahren :&lt;/TD&gt;&lt;TD&gt;$val{pers22}&lt;/TD&gt;&lt;/TR&gt;";
	  }
	  if ($val{pers54}!=0) {
	      print "&lt;TR&gt;&lt;TD&gt;Personen im Haushalt ab 22 bis 54 Jahren :&lt;/TD&gt;&lt;TD&gt;$val{pers54}&lt;/TD&gt;&lt;/TR&gt;";
	  }
	  if ($val{pers55}!=0) {
	      print "&lt;TR&gt;&lt;TD&gt;Personen im Haushalt ab 55 Jahren :&lt;/TD&gt;&lt;TD&gt;$val{pers55}&lt;/TD&gt;&lt;/TR&gt;";
	  }
	    print "&lt;/Table&gt;";

	  if (@liste1=$query-&gt;param(krit)) {
          while($item=shift @liste1) {
            $teil=$dbh-&gt;selectrow_array("select krit from krit where nr=$item");
			if ($item &lt; 25) {unshift (@liste2,$teil)}
			  else {unshift (@liste3,$teil)}
		  }	
		  if ($liste2[0] ne "") {print "&lt;p&gt;&lt;br&gt;&lt;b&gt;&lt;u&gt;Bevorzugte Produktkategorien&lt;/u&gt;&lt;/b&gt;&lt;br&gt;&lt;p&gt;",join("&lt;br&gt;",@liste2),"&lt;br&gt;"}
	  	  if ($liste3[0] ne "") {print "&lt;p&gt;&lt;br&gt;&lt;b&gt;&lt;u&gt;Hobbys&lt;/u&gt;&lt;/b&gt;&lt;br&gt;&lt;p&gt;",join("&lt;br&gt;",@liste3),"&lt;br&gt;"}
	  }

	#Versandhäuser auflisten
	my @liste5;
	if (@liste4=$query-&gt;param(vh)) {
		while(defined($item=shift @liste4)) {
	       push (@liste5,$dbh-&gt;selectrow_array("select  vh from vhaus where vhnr=$item") );	
		}

		 if ($liste5[0] ne "") {print "&lt;p&gt;&lt;br&gt;&lt;b&gt;&lt;u&gt;Kunde der Versandhäuser&lt;/u&gt;&lt;/b&gt;&lt;br&gt;&lt;p&gt;",join("&lt;br&gt;",@liste5),"&lt;br&gt;"}
	}

	  if ($val{bestjahr}!=0) {
	      print "&lt;TR&gt;&lt;TD&gt;Jahr der letzten Bestellung :&lt;/TD&gt;&lt;TD&gt;$val{bestjahr}&lt;/TD&gt;&lt;/TR&gt;";
	  }


	# Entlohnungsart
	  
	  if ($val{lohnart} eq "Gutschein") {

		  print "&lt;br&gt;&lt;br&gt;Entlohnungsart :Produktgutschein";

		}

	  if ($val{lohnart} eq "Scheck") {

		  print "&lt;br&gt;&lt;br&gt;Entlohnungsart :Verrechnungsscheck";

		}

	  if ($val{lohnart} eq "Überweisung") {
		

		print "&lt;br&gt;&lt;br&gt;&lt;TABLE border=2&gt;";
	    print "&lt;TR&gt;&lt;TD&gt;Entlohnungsart&lt;/TD&gt;&lt;TD&gt;Banküberweisung&lt;/TD&gt;&lt;/TR&gt;";
		print "&lt;TR&gt;&lt;TD&gt;Bankverbindung / Institut&lt;/TD&gt;&lt;TD&gt;$val{bank}&lt;/TD&gt;&lt;/TR&gt;",
				"&lt;TR&gt;&lt;TD&gt;Bankleitzahl&lt;/TD&gt;&lt;TD&gt;$val{blz}&lt;/TD&gt;&lt;/TR&gt;",
				"&lt;TR&gt;&lt;TD&gt;Kontonummer&lt;/TD&gt;&lt;TD&gt;$val{kontonr}&lt;/TD&gt;&lt;/TR&gt;";
		print "&lt;/table&gt;&lt;/font&gt;";

		}


	  print "&lt;br&gt;&lt;hr&gt;&lt;br&gt;&lt;b&gt;&lt;font size=5 face='$conf{stdfont}'&gt;Ihre PIN - Nummer ist :$pin&lt;/font&gt;&lt;br&gt;&lt;br&gt;&lt;br&gt;",
		"&lt;font color='#FF0000'&gt;Sie benötigen sowohl diese Nummer als auch das eingegebene Passwort, um sich für die Umfragen zu identifizieren!&lt;/b&gt;&lt;/font&gt;";
	 
	  print $query-&gt;startform,
 	      "&lt;input type='hidden' name='pin' value='$pin'&gt;",
		  "&lt;center&gt;&lt;input type='submit' name='but' value='Eintrag Löschen'&gt;&amp;nbsp;&amp;nbsp;";

	  print $query-&gt;submit('but','    Ende    '),"&lt;/center&gt;",
	
		  
	  $query-&gt;endform,
	  $query-&gt;end_html, "\n";

$dbh-&gt;disconnect();  # Datenbankverbindung lösen.

exit(0);

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