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 = "/prorataweb/umfimg/";  # Verzeichnis für die Statistiken.....
$HELPPATH="../www.prorata.de/prorataweb/help/";
$TEMPLATES="../www.prorata.de/prorataweb/templates/";

$TESTPIN=100;
$TESTPASS="muster";
%TITLE = (HF => "Geschlecht", BI => "Bildungsstand", FS => "Familienstand", BS => "Beschäftigungsverhältnis",
			 ALT => "Altersgruppen", PLZ => "PLZ der Wohnorte", FID => "Beantwortete Fragen");

@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");

@HOB=("","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","Natur / Garten","Wirtschaftsthemen","Wissenschaftliche Themen, Forschung","Katzen","Hunde","andere Tiere");
@HF=("","Herr","Frau");
@LA=("","Deutschland","Österreich","Schweiz","Niederlande");
@LK=("","D","A","CH");
@BI=("Keine Angaben","Hauptschulabschluß","Realschulabschluß","Abitur/Fachhochschulreife","Fachhochschulabschluß","Universitätsabschluß","Promotion"); 
@PR=("Keine Angaben","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","Hausfrau/-mann");
@BST=("Keine Angaben","Selbständig","Angestellt","Anderes");
@LO=("Keine Angaben","Überweisung","Scheck");
@KT=("","Produkt Kategorien","Hobbys","Versandhäuser");
@BSYS=("Keine Ahnung","Windows 3.1", "Windows 95/98/ME", "Windows NT/2000/XP","BeOS","Mac","OS-2", "Linux","NeXt","Solaris","HP-UX","anderes Unix"); 
@HK=("Keine Angaben", "Durch Bekannte, Verwandte, Freunde", "Zufällig, durch das Surfen im Internet", "Prorata Sonderaktion","Über Hinweise aus Chat-Rooms, best. Seiten im Internet", "Über Bannerwerbung","Auf Empfehlung eines anderen Online-Panelisten");
@MO=("","Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember");

#1.
#@ALT=("bis 20 Jahre", "21 bis 25 Jahre", "26 bis 30 Jahre", "31 bis 40 Jahre", "41 bis 50 Jahre", "51 bis 65 Jahre", "über 65 Jahre");
#2.
#@ALT=("keine Angabe","unter 18", "18 bis 24 Jahre", "25 bis 34 Jahre", "35 bis 54 Jahre", "über 54 Jahre");
#new
#@ALT=("keine Angabe","unter 14","14 bis 18 Jahre", "19 bis 29 Jahre", "30 bis 45 Jahre", "46 Jahre und Älter");
@ALT=("keine Angabe","unter 16","16 bis 20 Jahre", "21 bis 40 Jahre", "41 bis 55 Jahre", "56 bis 65 Jahre",  "66 Jahre und Älter");
#

@PLZ=("00000-09999", "10000-19999", "20000-29999", "30000-39999", "40000-49999", "50000-59999", "60000-69999", "70000-79999", "80000-89999", "90000-99999");


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


my @fontface=("News Gothic","Helvetica","Tahoma","Arial","Trebuchet","Times New Roman");

my %Hcolor=("#006666","Türkisdunkel",
	    "#99cccc","Türkishell",
	    "#999999","Grau",
	    "#dddddd","Hellgrau",
	    "#333333","Dunkelgrau",
	    "#000000","Schwarz",
	    "#ffffff","Weiß",
	    "#ff0000","Rot",
	    "#00ff00","Grün",
	    "#0000ff","Blau",
	    "cc00cc","Lila",
	    "#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;
	if ($L2 ne "") {$L2=" ".$L2}
	for ($x=0; $x<=$#LI; $x++) { $LI[$x]=$$L1[$x].$L2.">".$LI[$x]; }
	return "<TR>\n   <TD valign=\"center\" ".join ("</TD>\n   <TD valign=\"middle\" ", @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"; # mysql4.0  auf sql2
	return "$st";	# mysql4.1 auf ns2;

}

####################################################################
####         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) = @_;
  if ($ch > 0) {$ch=" CHECKED";}	
  $self->log(4,"Entering: Baseq:CB N=$name V=$val CH=$ch" );
  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\" style=\"position: relative; top: 0\">";
}

####################################################################
####         gibt einen Submitbutton zurueck
####         Argumente  : $name, $value
####         Returnwert : HTMLstring
####################################################################
sub SM {
  my ($self, $name, $val, $width) = @_;
  my ($li,$re);
  my $value=$self->trans($val);
  my $type="SUBMIT";	
  if ($val eq "BU38") {$type="RESET";}
  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=\"$type\" 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, $status) = @_;
    my ( $umfid, $umfrage, %humf, @lumf, $sql, $sth );
	$self->log(4,"Entering: Baseq:DDumfrage");
	$status+=0;
	if ($self->{knr} eq "") {$self->{knr}=0;}
    $sql="select umfid, umfrage from umfragen where knr=$self->{knr} and status='$status' 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 templatehtm 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  : $img
####         Returnwert : HTMLstring
####################################################################
sub IMG {
  my ($self, $img) = @_;
  $self->log(4,"Entering: Baseq:IMG Bild=$img");
  return "<IMG SRC=\"$img\" BORDER=0>\n";
}

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

####################################################################
####         Gibt die locale Zeit aus
####         Argumente  :
####         Returnwert : -
####################################################################

sub getdate {

    @days   = ('Sonntag','Montag','Dienstag','Mittwoch',
               'Donnerstag','Freitag','Samstag');
    @months = ('Januar','Februar','März','April','Mai','Juni','Juli',
	         'August','September','Oktober','November','Dezember');

    ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6];
    $time = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
    $year += 1900;
                                                   
    $date = "$days[$wday], $months[$mon] $mday, $year um $time";
	return $date;
}

####################################################################
####         gibt ein Datumseingabefeld (Tag, Monat, Jahr) zurück
####         Argumente  : Bezeichnung , 1999-09-23
####         Returnwert : HTMLstring
####################################################################
sub Datehtml {
  my ($self, $nr, $date) = @_;
  $self->log(4,"Entering: Baseq:Datehtml Nr=$nr, Date=$date");
  my ($j,$m,$t) = split /-/ , $self->{gdat};
  return $self->TF("bqtag".$nr,$t+0,2,2).$self->DDmonat("bqmonat".$nr,$m+0).
		 $self->TF("bqjahr".$nr,$j+0,4,4);
}

####################################################################
####         gibt ein Datumseingabefeld (1999-09-23) zurück
####         Argumente  : Bezeichnung 
####         Returnwert : 1999-09-23
####################################################################
sub getDatehtml {
  my ($self, $nr, $date) = @_;
  if(($VARS{"bqjahr".$nr}+0)<100){$VARS{"bqjahr".$nr}+=1900;}
  my $date=$VARS{"bqjahr".$nr}."-".($VARS{"bqmonat".$nr}+0)."-".($VARS{"bqtag".$nr}+0);
  $self->log(4,"Entering: Baseq:getDatehtml Nr=$nr, Date=$date");
  return $date;
}

####################################################################
####         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 target=top');
}


####################################################################
####         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;
}