package baseq;

use Carp;
use DBI;
#use strict;

my $POST="POST";         # GET or POST ??

my %konf=( "database" => "mysql",		# Andere sind z.B. adabas, csv, oracle, informix
           "dataname" => "prorata2",    	# Name der Datenbank
           "datahost" => "192.168.98.222",      # Hostname der Datenbank
           "datauser" => "wwwrun",           	# Datenbank - Benutzername
           "datapass" => "softis",      	# Passwort für die Datenbank
           "loglevel" => "4",
           "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 %trans;

my %felder = (
	id => undef ,            # Identifikationsnummer
	name => "" ,             # Bezeichnungsstring
	conf => undef ,          # Konfigurationshash
	parent => undef,
	dbh  => undef ,          # Databasehandle
        vars => undef,           # CGI - Variablenzeiger
	template => 0,		 # Template
	warntext => undef,	 # Überschrift
	query	=> undef,
        RLfontface => \@fontface,
        RLfontcolor => \@Lcolor,
	RHfontcolor => \%Hcolor,
);

####################################################################
####         Konstuktor der Basisklasse
####         Argumente  : -
####         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;
	$self->{dbh}      = $self->{parent}->{dbh};
        $self->{query}    = $self->{parent}->{query};
        $self->{vars}     = $self->{parent}->{vars};
	$self->{sprache}  = $self->{parent}->{sprache}+0;
	$self->readconf;
	return $self;
}

####################################################################
####         Liest die Sprache
####         Argumente  :-
####         Returnwert :-
####################################################################
sub loadq {
	my $self=shift;
	$self->loadsprache($self->{sprache});
}

####################################################################
####         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;}
	
        my ($sec,$min,$hour,$day,$mon,$year) = (localtime(time))[0,1,2,3,4,5];
        $TEXT=sprintf("%2d.%2d %2d:%2d:%2d ",$day,$mon,$hour,$min,$sec) .$TEXT;
	open (FILE, ">>$file") or croak "Konnte '$file' nicht öffnen";
	print FILE "$TEXT\n";
        close FILE;
        if ($emerg==1) {$self->exit("Notausgang !!")}
}

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


####################################################################
####         Liest die Konfigurationsdatei "panel.conf" in den Hash "conf"
####         Argumente  : -
####         Returnwert : -
####################################################################
sub readconf {
	my $self = shift;
	$self->{conf}=\%konf;
	return;
	#open (FILE, "<panel2.conf") or $self->log(1,"Konnte 'panel.conf' nicht öffnen");
	#while (my $line = <FILE>) {
  	#  (my $key, my $val) = ($line =~/^(\S*)\s*=\s*(\S*)/);
    	#  if ($key ne "") { $self->{conf}{$key}=$val ;}
	#}
        #close FILE;
}

####################################################################
####         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);}
    }
    $self->printlog(2,"Datenbankverbindung beim $x ten Versuch von $ENV{REMOTE_ADDR}");
}


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

####################################################################
####         Prüft das Passwort
####         Argumente  : pin und encrypted passwd
####         Returnwert : 1 wenn OK , sonst 0
####################################################################
sub checkkunde {
	my $self = shift;
	my $knr = shift()+0;
	my $pass = shift;
	my $dbpass = $self->sqlselect("select pass from kunden where knr=$knr");
   	$dbpass=crypt($dbpass,"xy");
        if ($dbpass ne $pass) {$self->log(2,"Falsches Passwort von $knr");return 1;}
	return 0;
}


####################################################################
####         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  : pin und encrypted passwd
####         Returnwert : 1 wenn OK , sonst 0
####################################################################
sub sqlprepare {
	my $self = shift;
	my $SQL = shift;

        $self->dbconn;
        $self->log(3, $SQL);
	my $sth=$self->{dbh}->prepare($SQL) || $self->log(2, $self->{dbh}->errstr);
	$sth->execute || $self->log(2, $self->{sth}->errstr);
        return $sth;
}


####################################################################
####         Führt SQL - DO aus
####         Argumente  : pin und encrypted passwd
####         Returnwert : 1 wenn OK , sonst 0
####################################################################
sub sqldo {
	my $self = shift;
	my $SQL = shift;

        $self->dbconn;
        $self->log(3, $SQL);
	my $rows=$self->{dbh}->do($SQL) || $self->log(2, $self->{dbh}->errstr);
	$self->log(3, "Zeilen: $rows");
	return $rows;
}

####################################################################
####         Gibt eine Liste mit <TD> und <TR> tags zurück
####         Argumente  : pin und encrypted passwd
####         Returnwert : 1 wenn OK , sonst 0
####################################################################
sub TR {
	my $self = shift;
	my $L= shift;
	return "<TR>\n   <TD>".join ("</TD>\n   <TD>", @$L)."</TD>\n</TR>\n"
}


####################################################################
####         Gibt eine Liste mit <TD> und <TR> tags zurück
####         Argumente  : pin und encrypted passwd
####         Returnwert : 1 wenn OK , sonst 0
####################################################################
sub exit {
	my $self = shift;
	my $L= shift;
	if ($L eq "") {$L="Exit...";}
	$self->log(4,$L);
	$self->dbdisconn;
	exit;
}

####################################################################
####         Gibt die Templates mit Nr als Key im Hashref zurück
####         Argumente  : 0 = alle, 1 = nur eigene
####         Returnwert : -
####################################################################
sub templatehash {
        my $self = shift;
	my $knr="";
	if (shift()==0) {$knr="knr=0 or";}
	my ( $nr, $beschr, %htemp, $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;
        }
        return \%htemp;
}


####################################################################
####         Gibt die Umfragen mit Umfid als Key im Hashref zurück
####         Argumente  : Text
####         Returnwert : -
####################################################################
sub umfragenhash {
        my $self = shift;
        my ( $umfid, $umfrage, %humf, $sql, $sth );
	if ($self->{knr} eq "") {$self->{knr}=0;}
        $sql="select umfid, umfrage from umfragen where knr=$self->{knr}";
        $sth=$self->sqlprepare($sql);
        while(($umfid, $umfrage)=$sth->fetchrow_array){
           $humf{$umfid}=$umfrage;
        }
        return \%humf;
}

####################################################################
####         Gibt die Sprache mit Nummer als Key im Hashref zurück
####         Argumente  : Text
####         Returnwert : -
####################################################################
sub sprachenhash { return \%Hsprache;}
      #  my $self = shift;
      #  my ( $umfid, $umfrage, %humf, $sql, $sth );
      #  $sql="select umfid, umfrage from umfragen where knr=$self->{knr}";
      #  $sth=$self->sqlprepare($sql);
      #  while(($umfid, $umfrage)=$sth->fetchrow_array){
      #     $humf{$umfid}=$umfrage;
      #  }
      #  return \%humf;
#}

####################################################################
####         Lädt die gewünschte Sprache
####         Argumente  : Text
####         Returnwert : -
####################################################################
sub loadsprache {
        my $self = shift;
        my $sprache = shift;
        if ($sprache eq "") {$sprache=0;}
	my ( $umfid, $umfrage, %humf, $sql, $sth );
        $sql="select krz,text from sprachen where sprache=$sprache";
        $sth=$self->sqlprepare($sql);
        while(($krz, $text)=$sth->fetchrow_array){
           $trans{$krz}=$text;
        }
        return ;
}

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

}

####################################################################
####         Formatiert eine Zeit aus der DB
####         Argumente  : Zeit als Zahl
####         Returnwert : Formatierter String
####################################################################
sub timestamp {
        my $self = shift;
        my $st = shift;
	if ($st==0) {return "Keine Angabe";}
        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";

}

####################################################################
####         Übersetzt in die gew. Sprache
####         Argumente  : Krz
####         Returnwert : -
####################################################################
sub duration {
        my $self = shift;
	my ($t, $s, $m, $k);
	my ($ges, $tag, $std, $min, $sek)=$self->timediff(@_);
	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 Zeiten aus der DB
####         Argumente  : Krz
####         Returnwert : Array: (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);
	@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];
	$Z1[2]+=@m[$Z1[1]]+365*$Z1[0];
	for (my $x=2; $x<6; $x++) { $Z[$x]-=$Z1[$x]; }
	if ($Z[5]<0){$Z[5]+=60; $Z[4]-=1;}
	if ($Z[4]<0){$Z[4]+=60; $Z[3]-=1;}
	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;
	return @Z;
}