package baseq;

use DBI;
#use strict;

$POST="POST";         # GET or POST ??
%VARS=();             # Eingelesene (uebergebene) Variablen
$SPRACHENR=0;	      # Nummer der Sprache
%SPRACHE={};	      # Hash auf die Übersetzungen
$PATH = "../www.prorata.de";   # Pfad zum HTML Verzeichnis 	
$UMFIMG = "/umfimg/";  # Verzeichnis für die Statistiken.....
$HELPPATH="help/";

$TESTPIN=100;
$TESTPASS="muster";

@VH=("nie bestellt","Neckermann","Quelle","Otto","Schwab","Bauer","Heine","Chic","bon prix","Oppermann","Bader","Walz","Beate Uhse",
		"Schneider","Hach","Viking","hessnatur","Spezialisierte Versandhäuser","Online Versandhäuser","andere" );

@KRIT=("","Auto","Babyprodukte","Babypflege","Bücher","Dienstleistungen","EDV-Hardware","EDV-Software","Getränke","Haushaltspflegeartikel",
	"Haushaltsgeräte","Haushaltsausstattung","Hygieneartikel","Internet","Kosmetikprodukte","Lebensmittel","Reisen","Sportartikel",
	"Spielwaren","Telekommunikation","Tierartikel","Tierfutter","Tiefkühlkost","Zeitschriften","Zeitungen","Aktienhandel","Autos, Motorsport",
	"Ausgehen","Computer,Informationstechnologie","Denk- und Einzelspiele","Fitneß- ,Gesundheitsthemen","Fernsehen, Videofilme",
	"Gäste einladen, Feiern","Gesellschaftsspiele","Ins Kino gehen, Kinofilme","Konzert / Theater /Oper","Kunst / Kultur","Kochen",
	"Lesen, Bücher","Mit Freunden / Bekannten zusammensein","Mit der Familie zusammensein","Mode, Modetrends","Musik hören, CDs,Schaltplatten",
	"Reisen, Urlaub","Sport treiben","Shopping / Einkaufbummel","Tiere / Natur / Garten","Wirtschaftsthemen","Wissenschaftliche Themen, Forschung");

@HF=("","Herr","Frau");
@LA=("","Deutschland","Österreich","Schweiz");
@LK=("","D","A","CH");
@BI=("Keine Angaben","Hauptschule","Realschule","Gymnasium","Fachhochschule","Hochschule","Magister","Promotion"); 
@PR=("","T-Online","AOL","Arcor","Otello","Freenet","Talknet","1 & 1","Netcologne","OWL-Online","Surf Callino","Viag Interkom","Compuserve","Okaynet","Debitel","Nikoma","UU-Net","Germanynet","Uni-Server","FH-Server","Andere");
@FS=("Keine Angaben","Verheiratet","Ledig");
@BS=("Keine Angaben","Vollzeitbeschäftigt","Teilzeitbeschäftigt","Rentner/in","Student/in","Schueler/in","zur Zeit erwerbslos");


my %konf=( "database" => "mysql",	    	# Andere sind z.B. adabas, csv, oracle, informix
           "dataname" => "prorata2",    	# Name der Datenbank
           "datahost" => "sql.prorata.de", 	        # Hostname der Datenbank
           "datauser" => "prorata",       	# Datenbank - Benutzername
           "datapass" => "luca",	      	# Passwort für die Datenbank
           "loglevel" => "2",
           "logfile"  => "/tmp/prorata2.log" );


my @fontface=("Helvetica","Tahoma","Arial","Trebuchet");

my %Hcolor=("#999999","Grau",
	    "#dddddd","Hellgrau",
	    "#333333","Dunkelgrau",
        "#000000","Schwarz",
	    "#ffffff","Weiß",
	    "#ff0000","Rot",
	    "#00ff00","Grün",
	    "#0000ff","Blau",
	    "#ffff00","Gelb"  );

my @Lcolor = keys %Hcolor;


my %Hsprache=("0" => "Deutsch",
	      "1" => "English",
	      "2" => "Italiano",
	      "3" => "Magyar"	 );

my %felder = (
	id => undef ,            # Identifikationsnummer
	name => "" ,             # Bezeichnungsstring
	conf => undef ,          # Konfigurationshash
	parent => undef,         # Vaterobjekt
	dbh  => undef ,          # Databasehandle
    vars => undef,           # CGI - Variablenzeiger
	template => 0,		 # Template
	warntext => undef,	 # Überschrift
	query	=> undef,
    RLfontface => \@fontface,    # Zeiger auf die Fontfaces	
    RLfontcolor => \@Lcolor,     # Liste der Fontfarben
	RHfontcolor => \%Hcolor,     # Hash mit den Farbenbezeichnungen
                                  # werden ueberladen aus der Farbtabelle
);

####################################################################
####         Konstuktor der Basisklasse
####         Argumente  : parent und id
####         Returnwert : Referenz auf das neue Basisobjekt
####################################################################
sub init {
	my $that = shift;
	my $class = ref($that) || $that;
	my $self = { %felder };
	bless $self, $class;
	$self->{parent}   = shift;
        $self->{id}	  = shift;
	if ($self->{id} eq "") {$self->{id}=0;}
	$self->{dbh}      = $self->{parent}->{dbh};
	$self->{sprache}  = $self->{parent}->{sprache}+0;
	$self->{conf}=\%konf;
        $self->loadsprache($self->{sprache});
	return $self;
}

####################################################################
####         Schreibt Sprüche ins Logfile
####         Argumente  : EmergencyNR , Text
####         Returnwert : -
####################################################################
sub printlog {
	my $self= shift;
	my $emerg=shift;
	my $TEXT= shift;
	my $file=$self->{conf}{logfile};
	my $loglevel=$self->{conf}{loglevel};
	if ($loglevel < $emerg) {return;} # Wenn der oben eingestellte Loglevel niedriger ist...
	
        my ($sec,$min,$hour,$day,$mon,$year) = (localtime(time))[0,1,2,3,4,5];      # Datum und Zeit holen
        $TEXT=sprintf("%2d.%2d %2d:%2d:%2d ",$day,$mon+1,$hour,$min,$sec) .$TEXT;   # Datum formatieren
	open (FILE, ">>$file") or print "Content-type: text/plain\n\nFehler mit der Logdatei";
	print FILE "$TEXT\n";
        close FILE;
        if ($emerg==1) {$self->exit("Notausgang !!")}
	return;
}

####################################################################
####         Schreibt ins Logfile
####         Argumente  : Emergency und Logtext
####         Returnwert : -
####################################################################
sub log {
	my $self = shift;
        my $emer = shift;
	my $TEXT = shift;
	$self->printlog($emer, "[Baseq] $TEXT");
}

####################################################################
####         Verbindet mit der Datenbank und setzt $dbh
####         Argumente  : -
####         Returnwert : -
####################################################################
sub dbconn {
    my $self = shift;
    my $DB_DSN      = "DBI:$self->{conf}{database}:$self->{conf}{dataname}:$self->{conf}{datahost}";
    my $DB_USER     = "$self->{conf}{datauser}";
    my $DB_PASSWD   = "$self->{conf}{datapass}";
    if ( defined $self->{dbh} ) { return ; }  # Wenn Verbindung schon steht.....
    my $x=1; $self->{dbh} = undef;
    while ($x<6 && ! defined $self->{dbh})  # ansonsten 4 mal versuchen zu verbinden........
	{
	  $self->{dbh} = DBI->connect($DB_DSN, $DB_USER,$DB_PASSWD) || $self->log(1, $DBI::errstr);
      if (! ref $self->{dbh} )  {sleep(1);}    # Warten.....
    }
    $self->log(2,"Datenbankverbindung beim $x ten Versuch von $ENV{REMOTE_ADDR}");
    return;	
}


####################################################################
####         Beendet die Datenbankverbindung
####         Argumente  : -
####         Returnwert : -
####################################################################
sub dbdisconn {
	my $self = shift;
	$self->{dbh}->disconnect; 
        $self->log(2,"Datenbankverbindung wurde getrennt von $ENV{REMOTE_ADDR}");
        return;
}

####################################################################
####         Führt SQL - Select aus
####         Argumente  : SQL Statement
####         Returnwert : SELECT..
####################################################################
sub sqlselect {
	my $self = shift;
	my $SQL = shift;
        $self->dbconn;
        $self->log(3, $SQL);
	return $self->{dbh}->selectrow_array($SQL);
}

####################################################################
####         Führt SQL - Prepare und execute aus
####         Argumente  : SQL Statement
####         Returnwert : Handle
####################################################################
sub sqlprepare {
	my $self = shift;
	my $SQL = shift;
        $self->dbconn;
        $self->log(3, $SQL);
	my $sth=$self->{dbh}->prepare($SQL) || $self->log(2, "DBH-Error: ".$self->{dbh}->errstr);
	if (! ref $sth) {$self->log(1, "Kein STH - Handle bekommen; SQL war: $SQL");}
	$sth->execute || $self->log(2, "STH-Error: ".$sth->errstr);
        return $sth;
}


####################################################################
####         Führt SQL - DO aus
####         Argumente  : SQL Statement
####         Returnwert : Anzahl der betroffenen Zeilen
####################################################################
sub sqldo {
	my $self = shift;
	my $SQL = shift;
        $self->dbconn;
        $self->log(3, $SQL);
	my $rows=$self->{dbh}->do($SQL) || $self->log(2, "DBH-Error: ".$self->{dbh}->errstr);
	$self->log(3, "Zeilen: $rows");
	return $rows;
}

####################################################################
####         Ersetzt ' durch "
####         Argumente  : Text
####         Returnwert : Text
####################################################################
sub rep {
	my $self = shift;
	return @_[0]=~s/'/"/g;
}

####################################################################
####         Gibt eine Liste mit <TD> und <TR> tags zurück
####         Argumente  : Zeiger auf Liste der Zellenstrings, Standard TD-inhalt, Zeiger auf  TD-inhalte 
####         Returnwert : HTML STRING der Zeile
####################################################################
sub TR {
	my ( $self , $L , $L2, $L1 ) = @_;
	if (! defined $L1) {$L1=[];}
	my @LI=@$L;
	for ($x=0; $x<=$#LI; $x++) { $LI[$x]=$$L1[$x]." ".$L2.">".$LI[$x]; }
	return "<TR>\n   <TD ".join ("</TD>\n   <TD ", @LI)."</TD>\n</TR>\n";
}


####################################################################
####         Verlässt das Programm mit Verabschiedung...
####         Argumente  : Abschiedsbrief :-)
####         Returnwert : -
####################################################################
sub exit {
	my $self = shift;
	my $L= shift;
	if ($L eq "") {$L="Exit...";}
	$self->log(4,$L);
	$self->dbdisconn;
	exit;
}

####################################################################
####         Lädt die gewünschte Sprache und setzt die globalen
####         Variablen  $SPRACHENR und $SPRACHE
####         Argumente  : Sprachen nummer
####         Returnwert : -
####################################################################
sub loadsprache {
        my $self = shift;
        my $sprache = shift;
        if ($sprache eq "") {$sprache=0;}            # Defaultsprache
        # Wenn diese Sprache bereits aktiv und geladenb ist gibt es nichts zu tun !
	if ( ($SPRACHENR == $sprache) && ($SPRACHE{BU1} ne "") ) {return;}
	$SPRACHENR=$sprache;
	$self->log(4,"Baseq:Loading Sprache $sprache");
	my ( $umfid, $umfrage, $krz, $text, %humf, $sql, $sth );
        $sql="select krz,text from sprachen where sprache=$sprache";
        $sth=$self->sqlprepare($sql);
        while(($krz, $text)=$sth->fetchrow_array){
           $SPRACHE{$krz}=$text;
        }
        return ;
}

####################################################################
####         Übersetzt in die gew. Sprache
####         Argumente  : Krz
####         Returnwert : Text zum Kuerzel...
####################################################################
sub trans {
        my $self = shift;
        my $krz = shift;
        return $SPRACHE{$krz};
}

####################################################################
####         Formatiert einen Timestamp aus der DB
####         Argumente  : Zeit als Zahl  (20001125130657)
####         Returnwert : Formatierter String (25.11.2000 13:06:57)
####################################################################
sub timestamp {
        my $self = shift;
        my $st = shift;
	$self->log(4,"Entering: Baseq:Timestamp");
	if ($st==0) {return "Keine Angabe";}    # Wenn der Timestamp leer ist.....
        my $jahr=substr($st,0,4);
	my $mon=substr($st,4,2);
	my $tag=substr($st,6,2);
	my $std=substr($st,8,2);
	my $min=substr($st,10,2);
	my $sek=substr($st,12,2);
   	return "$tag.$mon.$jahr $std:$min:$sek";

}

####################################################################
####         Zeitdauer in tage, stunden, minuten und sekunden
####         zweier Zeiten
####         Argumente  : Timestamp1 , Timestamp2
####         Returnwert : Zeidifferenz (5 Tage 4 Stunden 10 Minuten 1 Sekunde)
####################################################################
sub duration {
        my $self = shift;
	my ($t, $s, $m, $k);
	my ($ges, $tag, $std, $min, $sek)=$self->timediff(@_);
	$self->log(4,"Entering: Baseq:duration");
	if ($tag==1){$t="1 Tag";}
	if ($tag>1){$t="$tag Tage";}
	if ($std==1){$s="1 Stunde";}
	if ($std>1){$s="$std Stunden";}
	if ($min==1){$m="1 Minute";} 
	if ($min>1){$m="$min Minuten";} 
	if ($sek==1){$k="1 Sekunde";} 
	if ($sek>1){$k="$sek Sekunden";} 
   	return "$t $s $m $k";
	
}

####################################################################
####         Subtrahiert 2 Timestamps aus der DB
####         Argumente  : Stamp1 und Stamp2
####         Returnwert : Array: (Gesamtsek, Tage, Std, Min, Sek)
####################################################################
sub timediff {
        my $self = shift;
        my $st1 = shift;
        my $st = shift;
	my ($t,$s,$m,$k);
        my (@Z, @Z1);
        my @m=(0,0,31,59,90,120,151,181,212,243,273,304,334);  # Tage bis zum 1. diesen Monats
	$self->log(4,"Entering: Baseq:Timediff");
	@Z =$st =~/(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/;
        @Z1=$st1=~/(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/;
	$Z[2] +=@m[$Z[1]] +365*$Z[0];  # Monate und Jahre zu den Tagen addieren
	$Z1[2]+=@m[$Z1[1]]+365*$Z1[0];
	for (my $x=2; $x<6; $x++) { $Z[$x]-=$Z1[$x]; }    # Subtrahieren
	if ($Z[5]<0){$Z[5]+=60; $Z[4]-=1;}
	if ($Z[4]<0){$Z[4]+=60; $Z[3]-=1;}     # Uebertraege
	if ($Z[3]<0){$Z[3]+=24; $Z[2]-=1;}
	shift @Z; 
	$Z[0]=$Z[4]+60*$Z[3]+3600*$Z[2]+$Z[1]*86400;   # Sekunden berechnen
	return @Z;
}

####################################################################
####         Liest die Umgebungsvariablen
####         Argumente  : -
####         Returnwert : \%Vars
####################################################################
sub Vars {
  my $self=shift;
  my ($in, $key, $val, $pair, @ins);
  if ($ENV{'REQUEST_METHOD'} eq "GET") {                  # Per GET Methode
       $in=$ENV{'QUERY_STRING'};
       @ins=split(/&/,$in);
  }
  elsif ($ENV{'REQUEST_METHOD'} eq "POST"){               # Per POST uebergebene
       read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
       @ins=split(/&/,$in);
  }
  else {@ins=@ARGV; }					  # Von der Kommandozeile uebergebene

  foreach $pair (@ins) {				  # Vorverarbeitung
	($key, $val)=split(/=/,$pair);
	$val =~ tr/+/ /;                                  # Aufspaltung in KEY und VALUE
	$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;   #Sonderzeichen aufdroeseln
	$val =~s/^ +//;
    $val =~s/ +$//;
	$VARS{$key}=$val;
  }
  return \%VARS;
}

####################################################################
####         Gibt eine DropDownliste zurueck
####         Argumente  : $name, \@Elemente, $selected, \%Labelhash
####         Returnwert : HTMLstring
####################################################################
sub DD {
  my ($self, $name, $elem, $sele, $label)=@_;
  my ($opt, $val, $sel);
  my @eleme=@$elem;
  my $HTML="\n <SELECT NAME=\"$name\">\n";	
  $self->log(4,"Entering: Baseq:DD Name=$name");
  foreach $opt (@eleme) {
	$val=""; $sel="";
	if ($sele eq $opt) {$sel=" SELECTED";}
	if ($$label{$opt} ne "") {$val=" VALUE=\"$opt\""; $opt=$$label{$opt};}
	$HTML.="    <OPTION$sel$val>$opt\n";
  }
  return $HTML." </SELECT>\n";	
}

####################################################################
####         gibt eine Checkbox zurueck
####         Argumente  : $name, $value, Zahl > 0 wenn checked
####         Returnwert : HTMLstring
####################################################################
sub CB {
  my ($self, $name, $val, $ch) = @_;
  $self->log(4,"Entering: Baseq:CB N=$name V=$val");
  if ($ch > 0) {$ch=" CHECKED";}	
  return "<INPUT TYPE=\"checkbox\"$ch NAME=\"$name\" VALUE=\"$val\">";
}

####################################################################
####         gibt einen Radiobutton zurueck
####         Argumente  : $name, $value
####         Returnwert : HTMLstring
####################################################################
sub RB {
  my ($self, $name, $val, $ch) = @_;
  $self->log(4,"Entering: Baseq:RB N=$name V=$val");
  if ($ch ne "") {$ch=" CHECKED"}	
  return "<INPUT TYPE=\"radio\"$ch NAME=\"$name\" VALUE=\"$val\">";
}

####################################################################
####         gibt einen Submitbutton zurueck
####         Argumente  : $name, $value
####         Returnwert : HTMLstring
####################################################################
sub SM {
  my ($self, $name, $val, $width) = @_;
  my ($li,$re);
  my $value=$self->trans($val);
  if ($width<1) {$width=$self->{buttonwidth};}
  $self->log(4,"Entering: Baseq:SM N=$name V=$val");
  $width -= length($value);
  if ($width>0) {
     $li=$re=$width>>1;$re+=$width%2;
     $self->log(4,"Überbreite=$width, Links=$li, Rechts=$re");
     $value=(" " x $li) .$value.( " " x $re); 
  }
  return "<INPUT TYPE=\"submit\" NAME=\"$name\" VALUE=\"$value\" style=\"font-family: Fixedsys\">";
}

####################################################################
####         gibt eine Submitbutton - Leiste
####         Argumente  : $name, $value
####         Returnwert : HTMLstring
####################################################################
sub SMrow {
  my ($self, $names, $vals) = @_;
  my ($val,$name, @L);
  $self->log(4,"Entering: Baseq:SMrow N=$name V=$val");
  for (my $x=0; $x<@$vals; $x++) {
    push @L, $self->SM($$names[$x], $$vals[$x]);
  }
  return "<TABLE cellspacing=10>\n".$self->TR(\@L)."</TABLE>\n";
}

####################################################################
####         gibt eine DropDownliste der Sprachen zurueck
####         Argumente  : -
####         Returnwert : HTMLstring
####################################################################
sub DDsprache {
  my ($self, $name, $sel) = @_;
  $self->log(4,"Entering: Baseq:DDsprache N=$name");
  return $self->DD($name,[0,1,2,3],$sel,\%Hsprache);
}

####################################################################
####         Gibt eine DropDownliste der Umfragen zurück
####         Argumente  : Text
####         Returnwert : -
####################################################################
sub DDumfrage {
        my ($self, $name, $sel) = @_;
        my ( $umfid, $umfrage, %humf, @lumf, $sql, $sth );
	$self->log(4,"Entering: Baseq:DDumfrage");
	if ($self->{knr} eq "") {$self->{knr}=0;}
        $sql="select umfid, umfrage from umfragen where knr=$self->{knr} order by umfid";
        $sth=$self->sqlprepare($sql);
        while(($umfid, $umfrage)=$sth->fetchrow_array){
           $humf{$umfid}=$umfrage;
	   push @lumf, $umfid;
        }
        return $self->DD($name,\@lumf,$sel,\%humf);
}

####################################################################
####         Gibt die Template DropDownliste zurueck
####         Argumente  : $name, $val, und 0 = alle, 1 = nur eigene
####         Returnwert : HTML string
####################################################################
sub DDtemp {
        my ($self, $name, $val) = @_;
	my $knr="";
	$self->log(4,"Entering: Baseq:DDtemp N=$name V=$val");
	if (shift()==0) {$knr="knr=0 or";}
	my ( $nr, $beschr, %htemp, @ltemp, $sql, $sth );
	if ($self->{knr} eq "") {$self->{knr}=0;}
        $sql="select nr, beschr from template where $knr knr=$self->{knr}";
        $sth=$self->sqlprepare($sql);
        while(($nr, $beschr)=$sth->fetchrow_array){
           $htemp{$nr}=$beschr;
           push @ltemp, $nr;
	}
        return $self->DD($name,\@ltemp,$val,\%htemp);
}


####################################################################
####         gibt eine Textfield zurueck
####         Argumente  : $name, $value
####         Returnwert : HTMLstring
####################################################################
sub TF {
  my ($self, $name, $val, $size, $maxsize) = @_;
  $self->log(4,"Entering: Baseq:TF N=$name V=$val");
  if ($size>0) {$size=" SIZE=\"$size\"";}
  if ($maxsize>0) {$maxsize=" MAXSIZE=\"$maxsize\"";}	
  return "<INPUT TYPE=\"text\" NAME=\"$name\" VALUE='$val'$size$maxsize>";
}

####################################################################
####         gibt ein Hiddenfield zurueck
####         Argumente  : $name, $value
####         Returnwert : HTMLstring
####################################################################
sub HD {
  my ($self, $name, $val) = @_;
  $self->log(4,"Entering: Baseq:HD N=$name V=$val");
  if ($val eq "") {return;}
  return "<INPUT TYPE=\"hidden\" NAME=\"$name\" VALUE='$val'>\n";
}

####################################################################
####         gibt ein A HREF zurueck
####         Argumente  : $name, $value
####         Returnwert : HTMLstring
####################################################################
sub AH {
  my ($self, $link, $name) = @_;
  $self->log(4,"Entering: Baseq:AH Link=$link");
  return "<A HREF=\"$link\">$name</A>\n";
}

####################################################################
####         gibt ein Image Tag zurueck
####         Argumente  : $name, $value
####         Returnwert : HTMLstring
####################################################################
sub IMG {
  my ($self, $img) = @_;
  $self->log(4,"Entering: Baseq:IMG Bild=$img");
  return "<IMG SRC=\"$img\" BORDER=0>\n";
}

####################################################################
####         gibt Ticks ' und allen htmltags außer <A HREF...>
####         gereinigten String zurueck
####         Argumente  : Dreckiger String
####         Returnwert : Sauberer string
####################################################################
sub clean {
  my $self=shift;
  my $a=shift;
  $a=$self->tclean($a);
  $a=~s/<([^aAbB\/][^rR>]*)>/[$1]/g;
  $a=~s/<(\/[^aAbB][^>]*)>/[$1]/g;
  return $a;
}

####################################################################
####         gibt einen von  ticks  ' gereinigten String zurueck
####         Argumente  : Dreckiger String
####         Returnwert : Sauberer string
####################################################################
sub tclean {
  my $self=shift;
  my $a=shift;
  $a=~s/[´`']/"/g;
  return $a;
}

####################################################################
####         gibt einen vollstaendig von HTML-Tags und Anfuehrungstrichen
####         gereinigten String zurueck
####         Argumente  : Dreckiger String
####         Returnwert : Sauberer string
####################################################################
sub fclean {
  my $self=shift;
  my $a=shift;
  $a=~s/</[/g;
  $a=~s/>/]/g;
  $a=~s/[´`'"]/\*/g;
  return $a;
}

####################################################################
####         Gibt eine Login Maske aus
####         Argumente  : -
####         Returnwert : -
####################################################################
sub login {
   my $self = shift;
   $self->{buttonwidth}=9;
   $self->log(4,"Entering: Baseq:login");
   if ($self->{warntext} eq "") {$self->{warntext}=$self->trans("WA3");}
	my $HTML = "<TABLE>\n".
	        $self->TR([$self->sfont("PIN"),$self->TF('apin') ]) .
		$self->TR([$self->sfont($self->trans("HI18")), " <INPUT TYPE='password' NAME='apass'>" ]) .
		"</TABLE>\n<BR><BR>\n".
	    	$self->SMrow( ["lbut","lbut"] , ["BU12","BU11"] );

	$self->printhtml($self->trans("TI3"), $HTML);
}

####################################################################
####         Führt einen sicheren Redirect aus
####         Argumente  : -
####         Returnwert : -
####################################################################
sub redirect {
	my $self = shift;
    my $xexu=shift;
	my $exu="http://www.prorata.de";
	$self->log(4,"Entering: Baseq:redirect");
    if ($self->{exiturl}=~/^http:\/\/.*/i) {$exu=$self->{exiturl};}
    if ($xexu=~/^http:\/\/.*/i) {$exu=$xexu;}
	print "Status: 302 Moved\nLocation: $exu\n\n";
    $self->exit("Redirect to: $exu");
}


####################################################################
####         Prüft das Passwort
####         Argumente  : pin und encrypted passwd
####         Returnwert : 0=OK, 1=Pass falsch,
####         2=userpass ok, aber nicht in umfidpin, 3=Statistik ok,
####	     4=Kunde ok		
####################################################################
sub checkpass {
	my $self = shift;
	my $pin = shift;
	my $pass = shift;
	$self->log(4,"Entering: Baseq:checkpass");
       	if ($pin eq "") {return 1;}
	
	# Statistikanmeldung
	if (($self->{uname} eq $pin) && (crypt($self->{upass},"xy")) eq $pass){return 3;}
	$pin+=0;
	$self->log(4,"Testpin=$TESTPIN, Passwort=$pass");

	# Musteranmeldung
	if ( ($pin == $TESTPIN) && ( $pass eq crypt($TESTPASS,"xy") ) ) {$self->log(4,"Musteranmeldung"); return 0;}

	# Benutzeranmeldung
	my $dbpass = $self->sqlselect("select pass from benutzer where pin=$pin");
   	$dbpass=crypt($dbpass,"xy");
        if ($dbpass ne $pass) {$self->log(2,"Falsches Benutzerpasswort von $pin");}
        else {
	  # Umfidpin ?
	  my $teil = $self->sqlselect("select pin from umfidpin where umfid=$self->{id} and pin=$pin");
          if ($teil<1) {$self->log(2,"$pin war nicht in Umfidpin");return 2;}
          else {return 0;}
	}

	my $dbpass = $self->sqlselect("select pass from kunden where knr=$pin");
   	$dbpass=crypt($dbpass,"xy");
        if ($dbpass ne $pass) {$self->log(2,"Falsches Kundenpasswort von $pin");}
	else {return 4;}
	
	return 1;
}