package pdat;
use template;
use kasse;
use grafik;
@ISA = qw ( template );
####################################################################
#### Konstruktor der Teilnehmerklasse
#### Argumente : -
#### Returnwert : -
####################################################################
sub init {
my $that = shift;
my $class = ref($that) || $that;
my $self = template->init(@_);
bless $self, $class;
$self->{pass} = "";
$self->{pass1} = "";
$self->{prpass} = "";
$self->{template} = 0;
$self->{anrede}=1;
$self->{vname}= "";
$self->{nname}= "";
$self->{strasse}= "";
$self->{stadt}= "";
$self->{plz} = 0;
$self->{nl} = "";
$self->{land}= 1;
$self->{email}= "";
$self->{tel}= "";
$self->{tel2}= "";
$self->{gdat}= "1800-01-01";
$self->{bildung}= 0;
$self->{famstand}= 0;
$self->{arbeit}= 0;
$self->{berufsstand}= 0;
$self->{pers3} = 0;
$self->{pers12}= 0;
$self->{pers22}= 0;
$self->{pers54}= 0;
$self->{pers55}= 0;
$self->{lohnart}= 0;
$self->{bank}= "";
$self->{blz}= "";
$self->{kontonr}= "";
$self->{provider}=0;
$self->{bsystem} = 0;
$self->{knr} = 1;
$self->{herkunft}= 0;
$self->{bestjahr}= 0;
$self->{changed} = 0;
$self->{werbpin} = 0;
$self->{gebclusn} = 0;
$self->{plzcod} = 0;
$self->{krit} = [];
return $self;
}
####################################################################
#### Teilnehmerdaten fom Formular
#### Argumente : -
#### Returnwert : -
####################################################################
sub getvars {
my $self = shift;
$self->log(4,"Entering: pdat:getvars");
$self->{id} = $baseq::VARS{pin}+0;
$self->{pass} = $self->fclean($baseq::VARS{pass});
$self->{pass1} = $self->fclean($baseq::VARS{pass1});
$self->{anrede}= $baseq::VARS{anrede}+0;
$self->{vname}= $self->fclean($baseq::VARS{vname});
$self->{nname}= $self->fclean($baseq::VARS{nname});
$self->{strasse}= $self->fclean($baseq::VARS{strasse});
$self->{stadt}= $self->fclean($baseq::VARS{stadt});
$self->{plz} = $baseq::VARS{plz}+0;
$self->{nl}= $self->fclean($baseq::VARS{nl});
$self->{land}= $baseq::VARS{land}+0;
$self->{email}= $self->fclean($baseq::VARS{email});
$self->{tel}= $self->fclean($baseq::VARS{tel});
$self->{tel2}= $self->fclean($baseq::VARS{tel2});
$self->{gdat}=$self->getDatehtml("01");
$self->log(4,"Gebdat:".$self->{gdat});
($self->{jahr},$self->{monat},$self->{tag})= split /-/, $self->{gdat},3;
$self->{bildung}= $baseq::VARS{bildung}+0;
$self->{famstand}= $baseq::VARS{famstand}+0;
$self->{berufsstand}= $baseq::VARS{berufsstand}+0;
$self->{arbeit}= $baseq::VARS{arbeit}+0;
$self->{pers3} = $baseq::VARS{pers3}+0;
$self->{pers12}= $baseq::VARS{pers12}+0;
$self->{pers22}= $baseq::VARS{pers22}+0;
$self->{pers54}= $baseq::VARS{pers54}+0;
$self->{pers55}= $baseq::VARS{pers55}+0;
$self->{lohnart}= $baseq::VARS{lohnart}+0;
$self->{bank}= $self->fclean($baseq::VARS{bank});
$self->{blz}= $self->fclean($baseq::VARS{blz});
$self->{kontonr}= $self->fclean($baseq::VARS{kontonr});
$self->{provider}= $baseq::VARS{provider}+0;
$self->{bsystem} = $baseq::VARS{bsystem}+0;
$self->{herkunft}= $baseq::VARS{herkunft}+0;
$self->{bestjahr}= $baseq::VARS{bestjahr}+0;
$self->{werbpin} = 0;
#$self->{werbpin}= $baseq::VARS{werbpin}+0;
$self->log(4,"GebJahr: ".$self->{jahr});
$self->{gebclusn}=$self->gebcl($self->{jahr});
$self->{plzcod}=$self->plzc($self->{plz});
$self->log(4,"plzcode: ".$self->{plzcod});
$self->log(4,"gebclusn: ".$self->{gebclusn});
my $x=($#baseq::KRIT+1);
my $y=($#baseq::HOB+1);
my $z=($#baseq::VH+1);
my $zahl;
if ($x>$y) {
$zahl=$x;
if($x<$z){$zahl=$z;}
}
if ($x<$y) {
$zahl=$y;
if ($y<$z) {$zahl=$z;}
}
foreach $typ (1..3) {
foreach $nr (0..$zahl) {
my $kri="krit$typ-$nr";
$self->{krit}[$typ][$nr] = $baseq::VARS{$kri};
$self->log(5,"KRIT=$kri -> '".$baseq::VARS{$kri}."'");
}
}
return $self;
}
####################################################################
#### Schreibt ins Logfile
#### Argumente : Emergency und Logtext
#### Returnwert : -
####################################################################
sub log {
my $self = shift;
my $emer = shift;
my $TEXT = shift;
$self->printlog($emer, "[Teilnehmer] $TEXT");
}
####################################################################
#### werbpinlader der Online - Panelisten
#### Argumente : pin, pass
#### Returnwert : -
####################################################################
sub loadwerbpin {
my $self = shift;
$self->log(4,"Entering: pdat:load");
# Teilnehmer aus der Datenbank laden
my $sql = "select werbpin from benutzer where pin=$self->{id}";
my $werbpin = $self->sqlselect($sql);
return $werbpin;
}
####################################################################
#### werbpin der Online - Panelisten überprüfen
#### Argumente : pin, pass
#### Returnwert : -
####################################################################
sub werbpinexist {
my $self = shift;
$self->log(4,"Entering: pdat:load");
# Teilnehmer aus der Datenbank laden
my $sql = "select pin from benutzer where pin=$self->{werbpin}";
$self->{werbpin1} = $self->sqlselect($sql);
my $werbpin=$self->{werbpin1};
$self->log(4,"Entering: pdat: werbepinexist $werbpin".$werbpin);
return $werbpin;
}
####################################################################
#### Datenbanklader der Online - Panelisten
#### Argumente : pin, pass
#### Returnwert : -
####################################################################
sub load {
my $self = shift;
$self->log(4,"Entering: pdat:load");
# Teilnehmer aus der Datenbank laden
$sql = "select anrede, vname, nname, strasse, stadt, plz, land, email, ".
"tel, gdat, bildung, famstand, arbeit, pers3, pers12, pers22, pers54, pers55, pass, ".
"lohnart, bank, blz, kontonr, provider, herkunft, bestjahr, tel2, bsystem, berufsstand, werbpin, nl from benutzer where pin=$self->{id}";
($self->{anrede}, $self->{vname}, $self->{nname}, $self->{strasse},
$self->{stadt}, $self->{plz}, $self->{land}, $self->{email}, $self->{tel},
$self->{gdat}, $self->{bildung}, $self->{famstand}, $self->{arbeit},
$self->{pers3}, $self->{pers12}, $self->{pers22}, $self->{pers54}, $self->{pers55},$self->{pass},
$self->{lohnart}, $self->{bank}, $self->{blz}, $self->{kontonr}, $self->{provider},
$self->{herkunft},$self->{bestjahr}, $self->{tel2}, $self->{bsystem}, $self->{berufsstand}, $self->{werbpin}, $self->{nl}) = $self->sqlselect($sql);
if (! defined $self->{id}) {$self->log(2,"Teilnehmer ist nicht vorhanden");$self->{warntext}="Teilnehmer ist nicht vorhanden";return $self->{warntext};}
$sql="select typ,nummer from kriterien where pin = $self->{id}";
my $sth=$self->sqlprepare($sql);
while (($typ,$nr)=$sth->fetchrow_array) {
$self->{krit}[$typ][$nr]=1;
}
$self->{prpass}=$self->{pass};
$self->{pass1}=$self->{pass};
$self->loadtmp;
return $self;
}
####################################################################
#### Ermittelt eine gebclusn
#### Argumente : -
#### !! Returnwert : -
####################################################################
sub gebcl{
my $self = shift;
my $gebc = shift;
my $gebclus;
##$self->log(4,"Entering: pdat->gebc");
##$self->log(4,"Entering: gebc=$gebc");
#############################################
#Alte Verteilung:
#if ($gebc>=1981 && $gebc<=1999){$gebclus=1;}
#if ($gebc>=1971 && $gebc<=1980){$gebclus=2;}
#if ($gebc>=1961 && $gebc<=1970){$gebclus=3;}
#if ($gebc>=1951 && $gebc<=1960){$gebclus=4;}
#if ($gebc>=1936 && $gebc<=1950){$gebclus=5;}
#if ($gebc>=1900 && $gebc<=1935){$gebclus=6;}
#if ($gebc==0){$gebclus=0;}
#############################################
#Neue Verteilung:
if ($gebc>=1987 && $gebc<=2004){$gebclus=1;}
if ($gebc>=1980 && $gebc<=1986){$gebclus=2;}
if ($gebc>=1970 && $gebc<=1979){$gebclus=3;}
if ($gebc>=1950 && $gebc<=1969){$gebclus=4;}
if ($gebc>=1900 && $gebc<=1949){$gebclus=5;}
if ($gebc==0){$gebclus=0;}
#$self->log(4,"Entering: gebclus=$gebclus");
return $gebclus;
}
####################################################################
#### Ermittelt eine plzcode
#### Argumente : -
#### !! Returnwert : -
####################################################################
sub plzc{
my $self = shift;
my $plzco = shift;
my $plzcd;
#$self->log(4,"Entering: pdat->plzc");
#$self->log(4,"Entering: plzco=$plzco");
if ($plzco>=0 && $plzco<=9999){$plzcd=0;}
if ($plzco>=10000 && $plzco<=19999){$plzcd=1;}
if ($plzco>=20000 && $plzco<=29999){$plzcd=2;}
if ($plzco>=30000 && $plzco<=39999){$plzcd=3;}
if ($plzco>=40000 && $plzco<=49999){$plzcd=4;}
if ($plzco>=50000 && $plzco<=59999){$plzcd=5;}
if ($plzco>=60000 && $plzco<=69999){$plzcd=6;}
if ($plzco>=70000 && $plzco<=79999){$plzcd=7;}
if ($plzco>=80000 && $plzco<=89999){$plzcd=8;}
if ($plzco>=90000 && $plzco<=99999){$plzcd=9;}
#$self->log(4,"Entering: plzcd=$plzcd");
return $plzcd;
}
####################################################################
#### Ermittelt eine neue pin und speichert sich
#### Argumente : -
#### !! Returnwert : -
####################################################################
sub new {
my $self = shift;
$self->log(4,"Entering: pdat:new");
my $sql = "select max(pin) from benutzer";
my $gebjahr = (split (/-/ , $self->{gdat}))[0];
($self->{id}) = ($self->sqlselect($sql))+1;
my $sql2 = "insert into benutzer values ($self->{anrede}, '$self->{vname}', '$self->{nname}', '$self->{strasse}',".
"'$self->{stadt}', $self->{plz}, $self->{land}, '$self->{email}', '$self->{tel}', ".
"'$self->{gdat}', $self->{bildung}, $self->{famstand}, $self->{arbeit}, ".
"$self->{pers3}, $self->{pers12}, $self->{pers22}, $self->{pers54}, $self->{pers55}, '$self->{pass}', ".
"$self->{id}, $self->{lohnart}, '$self->{bank}', '$self->{blz}', '$self->{kontonr}', $self->{provider}, ".
"$self->{herkunft}, $self->{bestjahr}, $gebjahr, NULL, '$self->{tel2}', $self->{bsystem}, ".
"$self->{knr}, $self->{berufsstand}, $self->{werbpin}, '$self->{nl}',$self->{gebclusn}, $self->{plzcod})";
$self->sqldo($sql2);
my $x=($#baseq::KRIT+1);
my $y=($#baseq::HOB+1);
my $z=($#baseq::VH+1);
my $zahl;
if ($x>$y) {
$zahl=$x;
if($x<$z){$zahl=$z;}
}
if ($x<$y) {
$zahl=$y;
if ($y<$z) {$zahl=$z;}
}
foreach $typ (1..3) {
foreach $nr (0..$zahl) {
if ($self->{krit}[$typ][$nr]) {
$sql="insert into kriterien values ($typ, $self->{id}, $nr)";
$self->sqldo($sql);
}
}
}
$self->htmlbest;
}
####################################################################
#### Speichert sich mit Update
#### Argumente : -
#### Returnwert : -
####################################################################
sub store {
my $self = shift;
$self->log(4,"Entering: pdat:store");
my $gebjahr = (split (/-/ , $self->{gdat}))[0];
my $sql = "update benutzer set anrede=$self->{anrede}, vname='$self->{vname}', nname='$self->{nname}', strasse='$self->{strasse}',".
"stadt='$self->{stadt}', plz=$self->{plz}, land=$self->{land}, email='$self->{email}', tel='$self->{tel}', ".
"gdat='$self->{gdat}', bildung=$self->{bildung}, famstand=$self->{famstand}, arbeit=$self->{arbeit}, ".
"pers3=$self->{pers3}, pers12=$self->{pers12}, pers22=$self->{pers22}, pers54=$self->{pers54}, pers55=$self->{pers55}, pass='$self->{pass}', ".
"pin=$self->{id}, lohnart=$self->{lohnart}, bank='$self->{bank}', blz='$self->{blz}', kontonr='$self->{kontonr}', provider=$self->{provider}, ".
"herkunft=$self->{herkunft}, bestjahr=$self->{bestjahr}, geb=$gebjahr, changed=NULL, tel2='$self->{tel2}', bsystem=$self->{bsystem}, ".
"knr=$self->{knr}, berufsstand=$self->{berufsstand}, werbpin=$self->{werbpin}, nl='$self->{nl}', gebclusn=$self->{gebclusn}, plzcod=$self->{plzcod} where pin=$self->{id}";
$self->sqldo($sql);
$sql="delete from kriterien where pin= $self->{id}";
$self->sqldo($sql);
my $x=($#baseq::KRIT+1);
my $y=($#baseq::HOB+1);
my $z=($#baseq::VH+1);
my $zahl;
if ($x>$y) {
$zahl=$x;
if($x<$z){$zahl=$z;}
}
if ($x<$y) {
$zahl=$y;
if ($y<$z) {$zahl=$z;}
}
$self->log(4,"Entering: pdat:store x=$x");
$self->log(4,"Entering: pdat:store y=$y");
$self->log(4,"Entering: pdat:store z=$z");
$self->log(4,"Entering: pdat:store zahl=$zahl");
foreach $typ (1..3) {
foreach $num (0..$zahl) {
if ($self->{krit}[$typ][$num]) {
$sql="insert into kriterien values ($typ, $self->{id}, $num)";
$self->sqldo($sql);
}
}
}
}
####################################################################
#### Versuchen wir mal alles zusammen zu checken
#### Argumente : -
#### Returnwert : 0=OK, 1=nicht OK -WA23
####################################################################
sub checkalles {
my $self = shift;
$self->log(4,"Entering: pdat:checkalles");
my $TITLE="Überprüfen Sie bitte Ihre Angaben";
$self->{buttonwidth}=21;
my @WARNHTML=();
my $werbpin1 = $self->loadwerbpin;
$self->log(4,"CHECKHIER: werbpin1: ".$werbpin1);
#Pflichtfelder
if ( $self->{vname} eq "" ||
$self->{nname} eq "" ||
$self->{strasse} eq "" ||
$self->{plz} eq "" ||
$self->{land} eq "" ||
$self->{email} eq "" ||
$self->{tel} eq "" ||
$self->{tag} == 0 ||
$self->{jahr} == 0
)
{push @WARNHTML,$self->trans("WA23"); $self->log(4,$self->trans("WA23")); }
if($self->{tag} !~/^\d{1,2}$/ || $self->{tag}>31)
{push @WARNHTML,$self->trans("WA32"); $self->log(4,$self->trans("WA32"));}
if($self->{jahr} !~/^\d{4,4}$/ || $self->{jahr}>1993 || $self->{jahr}<1910)
{push @WARNHTML,$self->trans("WA32"); $self->log(4,$self->trans("WA32"));}
if ($self->{email} !~/.+@.+\.([a-z|A-Z]){2,3}$/) #Email-Adresse
{push @WARNHTML,$self->trans("WA24"); $self->log(4,$self->trans("WA24"));}
if ($self->{land} !=4 && $self->{plz} !~/^\d{4,5}$/) #PLZ
{push @WARNHTML,$self->trans("WA25"); $self->log(4,$self->trans("WA25")); }
#if ($self->{land} == 4 && $self->{plz}!~/^\d{4}.+\s\.+\.([a-z|A-Z]){2}$/)
if ($self->{land} ==4){
if($self->{plz} !~/^\d{4}$/ || $self->{nl} !~/^[a-z|A-Z]{2}$/)
{push @WARNHTML,$self->trans("WA45"); $self->log(4,$self->trans("WA45")); }
}
#Ort######################################################################
if ( $self->{plz}!=0 && $self->{stadt} eq ""){
my $sql = "select ort from plz where plz=$self->{plz} and land='$baseq::LK[$self->{land}]'";
$self->{stadt} = $self->sqlselect($sql);
if($self->{stadt} eq "")
{push @WARNHTML,$self->trans("WA26"); $self->log(4,$self->trans("WA26")); }
}
###########################################################################
#Telefonnr 1 korrekt?
$self->{tel}=~s/\D//g; #Löscht alle nicht digits aus der Telefonnummer
if ($self->{tel} !~/0\d{5,}/)
{push @WARNHTML,$self->trans("WA27"); $self->log(4,$self->trans("WA27")); }
#Telefonnr 2 korrekt?
if($self->{tel2} ne ""){
$self->{tel2}=~s/\D//g;
if ($self->{tel2} !~/0\d{5,}/) {push @WARNHTML,$self->trans("WA36"); $self->log(4,$self->trans("WA36")); }
}
##########################################################################
#Angaben für Anzahl Personen im Haushalt überprüfen:
if($self->{pers3} != 0){
$self->{pers3}=~s/\D//g;
if ($self->{pers3} > 3 ) {push @WARNHTML,$self->trans("WA32a"); $self->log(4,$self->trans("WA32a")); }
}
if($self->{pers12} != 0){
$self->{pers12}=~s/\D//g;
if ($self->{pers12} > 10) {push @WARNHTML,$self->trans("WA32b"); $self->log(4,$self->trans("WA32b")); }
}
if($self->{pers22} != 0){
$self->{pers22}=~s/\D//g;
if ($self->{pers22} > 10 ) {push @WARNHTML,$self->trans("WA32c"); $self->log(4,$self->trans("WA32c")); }
}
if($self->{pers54} != 0){
$self->{pers54}=~s/\D//g;
if ($self->{pers54} > 4) {push @WARNHTML,$self->trans("WA32d"); $self->log(4,$self->trans("WA32d")); }
}
if($self->{pers55} != 0){
$self->{pers55}=~s/\D//g;
if ($self->{pers55} > 4) {push @WARNHTML,$self->trans("WA32e"); $self->log(4,$self->trans("WA32e")); }
}
###########################################################################
#Überweisung oder Scheck?
if (($self->{lohnart} ==1 ) && (($self->{bank} eq "") || ($self->{blz} eq "") || ($self->{kontonr} eq "")))
{push @WARNHTML,$self->trans("WA29"); $self->log(4,$self->trans("WA29")); }
if ($self->{blz} ne "") {
$self->{blz}=~s/\D//g;
if ($self->{land} !=2){
if ($self->{blz} !~/^\d{8,15}$/) #testet auf 8-15 stellige Zahl
{push @WARNHTML,$self->trans("WA30"); $self->log(4,$self->trans("WA30")); }
}else{
# Teilnehmer kommt aus Österreich
if ($self->{blz} !~/^\d{5,15}$/) #testet auf 8-15 stellige Zahl
{push @WARNHTML,$self->trans("WA30"); $self->log(4,$self->trans("WA30")); }
}
}
#Überweisung && ist kontonr OK?
if ($self->{kontonr} ne "") {
$self->{kontonr}=~s/\D//g;
if ($self->{kontonr} !~/^\d{4,15}$/) #testet auf 8-15 stellige Zahl
{push @WARNHTML,$self->trans("WA31"); $self->log(4,$self->trans("WA31")); }
}
#DEFAULT-Scheck
if (($self->{bank} eq "") || ($self->{blz} eq "") || ($self->{kontonr} eq "")) { $self->{lohnart} =2; }
############################################################################
#Empfehlung eines anderen Online-Panelisten
if ($werbpin1 == 0 && $self->{werbpin} != 0) {$self->log(4,"HIER muss kein werbpin1 geben: werbpin1: ".$werbpin1." self->{werbpin}: ".$self->{werbpin} );
if($self->{werbpin} == $self->{id}){$self->{werbpin}=0;$self->log(4,"HIER: So -So, wir haben uns selbst beworben!" );}
my $y = $self->{werbpin};
$self->log(4,"HIER muss werbpinexistenz überprüft werden: self->werbpinexist(".$y.")) noch hier" );
if (!defined $self->werbpinexist($y)) {push @WARNHTML,$self->trans("WA44"); $self->log(4,$self->trans("WA44")); }
$self->{herkunft} =6;
}
if ($werbpin1 != 0) {
$self->{werbpin} = $werbpin1; $self->log(4,"HIER: werbpin1: ".$werbpin1." self->{werbpin}: ".$self->{werbpin} );
}
# if ($self->{herkunft} != 1 && $self->{herkunft} !=6) {
# if ($werbpin1 ==0) {
# $self->{werbpin} =0;
# }
#}
##############################################################################
#Jahr der letzten Bestellung
if ($self->{bestjahr} !=0 ) {
$self->{bestjahr}=~s/\D//g;
if ($self->{bestjahr} < 2){$self->{bestjahr}=$self->{bestjahr}+2000;}
if ($self->{bestjahr} > 1 && $self->{bestjahr} <100){$self->{bestjahr}=$self->{bestjahr}+1900;}
if ($self->{bestjahr} !~/^\d{2,4}$/)
{push @WARNHTML,$self->trans("WA33"); $self->log(4,$self->trans("WA33")); }
if ($self->{bestjahr} < 1980 || $self{bestjahr} > 2001)
{push @WARNHTML,$self->trans("WA37"); $self->log(4,$self->trans("WA37")); }
}
$self->log(4,"WARNHTML: ".@WARNHTML." und pin11111: ".$self->{id}." and pass: ".$self->{pass}." and werbpin1: ".$self->{werbpin1});
#############################################################################
#Passwort 1 und Passwort 2
if ($self->{id} == 0) {
if ($self->{pass} !~/^\S{5,8}$/)
{push @WARNHTML,$self->trans("WA35"); $self->log(4,$self->trans("WA35")); }
if (($self->{pass} ne $self->{pass1}) || ($self->{pass1} eq ""))
{push @WARNHTML,$self->trans("WA34"); $self->log(4,$self->trans("WA34")); }
}
$self->log(4,"WARNHTML: ".@WARNHTML." und pin11111: ".$self->{id}." and pass: ".$self->{pass}." and prpass: ".$self->{prpass});
###################################################
#Alter Benutzer -> neues Passwort
if ($self->{id} != 0){
if (($self->{prpass} ne $self->{pass}) && ($self->{pass} ne $self->{pass1}))
{ push @WARNHTML,$self->trans("WA39"); $self->log(4,$self->trans("WA39"));
if ($self->{pass} !~/^\S{5,8}$/)
{ push @WARNHTML,$self->trans("WA35"); $self->log(4,$self->trans("WA35"));
}
}
}
##################################################################
if(@WARNHTML == 0){
if($self->{id} == 0){
my $sql = "select vname,nname,email from benutzer where vname='$self->{vname}' and nname='$self->{nname}' and email='$self->{email}'";
if (defined($row = $self->sqlselect($sql)))
{push @WARNHTML,$self->trans("WA28"); $self->log(4,$self->trans("WA28")); }
}
$warn= join("
",@WARNHTML);
}
####################################################
if(@WARNHTML > 0){
$warn="Achtung! Nicht gespeichert!
". join("
",@WARNHTML)."";
}
return $warn;
}
####################################################################
#### 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->{anrede};}
for ($x=1; $x<($#baseq::HF+1); $x++) {push @L,$x; $H{$x}=$baseq::HF[$x];}
return $self->DD($name,\@L,$val,\%H);
}
####################################################################
#### Gibt eine Dropdown der Länder zurueck
#### Argumente : -
#### Returnwert : -
####################################################################
sub DDland {
my ($self, $name, $val)=@_;
my ($x, @L, %H);
if ($name eq "") {$name="land";}
if ($val eq "") {$val=$self->{land};}
for ($x=1; $x<($#baseq::LA+1); $x++) {push @L,$x; $H{$x}=$baseq::LA[$x];}
return $self->DD($name,\@L,$val,\%H);
}
####################################################################
#### Gibt eine Dropdown der Provider zurueck
#### Argumente : -
#### Returnwert : -
####################################################################
sub DDprovider {
my ($self, $name, $val)=@_;
my ($x, @L, %H);
if ($name eq "") {$name="provider";}
if ($val eq "") {$val=$self->{provider};}
for ($x=0; $x<($#baseq::PR+1); $x++) {push @L,$x; $H{$x}=$baseq::PR[$x];}
return $self->DD($name,\@L,$val,\%H);
}
####################################################################
#### Gibt eine Dropdown Herkunft zurueck(v.wo kommen die Teilnehmer her?)
#### Argumente : -
#### Returnwert : -
####################################################################
sub DDmonat{
my ($self, $name, $val)=@_;
my ($x, @L, %H);
if ($name eq "") {$name="monat";}
if ($val eq "") {$val=$self->{monat};}
for ($x=1; $x<($#baseq::MO+1); $x++) {push @L,$x; $H{$x}=$baseq::MO[$x];}
return $self->DD($name,\@L,$val,\%H);
}
####################################################################
#### Gibt eine Dropdown der Provider zurueck
#### Argumente : -
#### Returnwert : -
####################################################################
sub DDherkunft {
my ($self, $name, $val)=@_;
my ($x, @L, %H);
if ($name eq "") {$name="herkunft";}
if ($val eq "") {$val=$self->{herkunft};}
for ($x=0; $x<($#baseq::HK+1); $x++) {push @L,$x; $H{$x}=$baseq::HK[$x];}
return $self->DD($name,\@L,$val,\%H);
}
####################################################################
#### Gibt eine Dropdown der Familienstaende zurueck
#### Argumente : -
#### Returnwert : -
####################################################################
sub DDfamstand {
my ($self, $name, $val)=@_;
my ($x, @L, %H);
if ($name eq "") {$name="famstand";}
if ($val eq "") {$val=$self->{famstand};}
for ($x=0; $x<($#baseq::FS+1); $x++) {push @L,$x; $H{$x}=$baseq::FS[$x];}
return $self->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->{bildung};}
for ($x=0; $x<($#baseq::BI+1); $x++) {push @L,$x; $H{$x}=$baseq::BI[$x];}
return $self->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->{arbeit};}
for ($x=0; $x<($#baseq::BS+1); $x++) {push @L,$x; $H{$x}=$baseq::BS[$x];}
return $self->DD($name,\@L,$val,\%H);
}
####################################################################
#### Gibt eine Dropdown der Berufsstand zurueck
#### Argumente : -
#### Returnwert : -
####################################################################
sub DDberufsstand{
my ($self, $name, $val)=@_;
my ($x, @L, %H);
if ($name eq "") {$name="berufsstand";}
if ($val eq "") {$val=$self->{berufsstand};}
for ($x=0; $x<($#baseq::BST+1); $x++) {push @L,$x; $H{$x}=$baseq::BST[$x];}
return $self->DD($name,\@L,$val,\%H);
}
####################################################################
#### Gibt eine Dropdown der Lohnarten zurueck
#### Argumente : -
#### Returnwert : -
####################################################################
sub DDlohn {
my ($self, $name, $val)=@_;
my ($x, @L, %H);
if ($name eq "") {$name="lohnart";}
if ($val eq "") {$val=$self->{lohnart};}
for ($x=1; $x<($#baseq::LO+1); $x++) {push @L,$x; $H{$x}=$baseq::LO[$x];}
return $self->DD($name,\@L,$val,\%H);
}
####################################################################
#### Gibt eine Dropdown der Betriebsystemen zurueck
#### Argumente : -
#### Returnwert : -
####################################################################
sub DDbsystem {
my ($self, $name, $val)=@_;
my ($x, @L, %H);
if ($name eq "") {$name="bsystem";}
if ($val eq "") {$val=$self->{bsystem};}
for ($x=0; $x<($#baseq::BSYS+1); $x++) {push @L,$x; $H{$x}=$baseq::BSYS[$x];}
return $self->DD($name,\@L,$val,\%H);
}
####################################################################
#### Gibt eine Dropdown Herkunft zurueck(v.wo kommen die Teilnehmer her?)
#### Argumente : -
#### Returnwert : -
####################################################################
sub DDherkunft{
my ($self, $name, $val)=@_;
my ($x, @L, %H);
if ($name eq "") {$name="herkunft";}
if ($val eq "") {$val=$self->{herkunft};}
for ($x=0; $x<($#baseq::HK+1); $x++) {push @L,$x; $H{$x}=$baseq::HK[$x];}
return $self->DD($name,\@L,$val,\%H);
}
####################################################################
#### Gibt die Produktkategorien-Tabelle zurueck
#### Argumente : -
#### Returnwert : Produktkategorien
####################################################################
sub krittable {
my ($self )=@_;
my $krit;
my $ret="\n";
my $xa=3; my @L=();
my $y=($#baseq::KRIT+1);
for ($x=1; $x<25;$x++) {
if ($baseq::KRIT[$x] eq "") {next}
push @L, $self->sfont($self->CB("krit1-$x",1,$self->{krit}[1][$x]).$baseq::KRIT[$x]);
$xa--;
if ($xa==0) {$xa=3; $ret.=$self->TR(\@L); @L=();}
}
if ($#L!=0) {$ret.=$self->TR(\@L); }
return $ret."
\n";
}
####################################################################
#### Gibt die Hobbys-Tabelle zurueck
#### Argumente : -
#### Returnwert : Hobbys
####################################################################
sub hobtable {
my ($self, $klicked)=@_;
my $hob;
my $ret="\n";
my $xa=3; my @L=();
my $y=($#baseq::HOB+1);
$self->log(4,"Entering: pdat: hobbytable-load y= $y");
for ($x=1; $x<$y;$x++) {
if ($baseq::HOB[$x] eq "") {next}
push @L, $self->sfont($self->CB("krit2-$x",1,$self->{krit}[2][$x]).$baseq::HOB[$x]);
$xa--; if ($xa==0) {$xa=3; $ret.=$self->TR(\@L); @L=()}
}
if ($#L!=0) {$ret.=$self->TR(\@L); }
return $ret."
\n";
}
####################################################################
#### Gibt die Versandhaus-Tabelle zurueck
#### Argumente : -
#### Returnwert : Versandhauser
####################################################################
sub vhtable {
my ($self, $klicked)=@_;
my $vh;
my $ret="\n";
my $xa=3; my @L=();
for ($x=0; $x<($#baseq::VH+1);$x++) {
if ($baseq::VH[$x] eq "") {next}
push @L, $self->sfont($self->CB("krit3-$x",1,$self->{krit}[3][$x]).$baseq::VH[$x]);
$xa--; if ($xa==0) {$xa=3; $ret.=$self->TR(\@L); @L=()}
}
#if ($L!=0) {$ret.=$self->TR(\@L); }
if ($#L!=0) {$ret.=$self->TR(\@L); }
return $ret."
\n";
}
####################################################################
#### Gibt die Standardmaske aus
#### Argumente : Emergency und Logtext
#### Returnwert : -
####################################################################
sub htmlbearb {
my $self = shift;
$self->{buttonwidth}=21;
$self->log(4,"Entering: pdat:htmlbearb");
my $TITLE=$self->trans("TI1");
$self->log(4,$self->{warntext});
$HTML="\n".
$self->TR([ $self->sfont("".$self->trans("HI53").": ").$self->sfont($self->{id}),"".$self->SM("bbut","BU35")."
" ]).
"
\n
".$self->sfont($self->trans("HI54"))."\n".
"
\n\n".
$self->TR([ "***",$self->afont($self->trans("HI55")),$self->DDanrede('anrede',$self->{anrede}) ]).
$self->TR([ "***",$self->afont($self->trans("HI56")),$self->TF("vname",$self->{vname},25,100)]).
$self->TR([ "***",$self->afont($self->trans("HI57")),$self->TF("nname",$self->{nname},25,100)]).
$self->TR([ "***",$self->afont($self->trans("HI58")),$self->TF("strasse",$self->{strasse},25,100)]).
$self->TR([ "***",$self->afont($self->trans("HI59")),$self->TF("plz",$self->{plz},25,100)."-".$self->TF("nl",$self->{nl},2,2)." ".$self->afont($self->trans("HI109"))]).
$self->TR([ " ",$self->afont($self->trans("HI60")),$self->TF("stadt",$self->{stadt},25,100)]).
$self->TR([ " ",$self->afont($self->trans("HI61")),$self->DDland('land',$self->{land}) ]).
$self->TR([ "***",$self->afont($self->trans("HI62")),$self->TF("email",$self->{email},25,100)]).
$self->TR([ " ",$self->afont($self->trans("HI63")),$self->DDprovider('provider',$self->{provider}) ]).
$self->TR([ " ",$self->afont($self->trans("HI90")),$self->DDbsystem ('bsystem',$self->{bsystem})]).
$self->TR([ "***",$self->afont($self->trans("HI64")),$self->TF("tel",$self->{tel},25,100)]).
$self->TR([ " ",$self->afont($self->trans("HI65")),$self->TF("tel2",$self->{tel2},25,100)]).
$self->TR([ "***",$self->afont($self->trans("HI66")),$self->Datehtml("01",$self->{gdat}).$self->afont($self->trans("HI67")) ]).
$self->TR([ " ",$self->afont($self->trans("HI68")),$self->DDbildung('bildung',$self->{bildung}) ]).
$self->TR([ " ",$self->afont($self->trans("HI69")),$self->DDfamstand('famstand',$self->{famstand}) ]).
$self->TR([ " ",$self->afont($self->trans("HI70")),$self->DDarbeit('arbeit',$self->{arbeit}) ]).
$self->TR([ " ",$self->afont($self->trans("HI70b")),$self->DDberufsstand('berufsstand',$self->{berufsstand}) ])."
\n".
"
".$self->afont($self->trans("HI81"))."
".
"".$self->DDherkunft('herkunft',$self->{herkunft})."
".
#########! WERBEPIN: $self->afont($self->trans("HI107"))."
".$self->TF("werbpin",$self->{werbpin},6,6)."
".
"
".$self->afont($self->trans("HI71"))."
".
"\n".
$self->TR([$self->afont($self->trans("HI72")),$self->afont($self->trans("HI73")), $self->afont($self->trans("HI74")),$self->afont($self->trans("HI75")),$self->afont($self->trans("HI76"))]).
$self->TR([$self->TF("pers3",$self->{pers3},5,5),$self->TF("pers12",$self->{pers12},5,5),
$self->TF("pers22",$self->{pers22},5,5),$self->TF("pers54",$self->{pers54},5,5),$self->TF("pers55",$self->{pers55},5,5) ]).
"\n
".
"
".$self->afont($self->trans("HI77"))."
\n".
"
\n".$self->krittable.
"
".$self->afont($self->trans("HI78"))."
\n".
"
\n".$self->hobtable.
"
".$self->afont($self->trans("HI79"))."
\n".
"
\n".$self->vhtable.
"
\n".
"\n".
$self->TR([$self->afont($self->trans("HI80")),$self->TF("bestjahr",$self->{bestjahr},4,11) ]).
"\n
".
"
".$self->afont($self->trans("HI83"))."
".
"".$self->DDlohn('lohnart',$self->{lohnart})."".
"
".$self->afont($self->trans("HI91"))."
".
"\n".
$self->TR([$self->afont($self->trans("HI84")),$self->TF("bank",$self->{bank},100,100) ]).
$self->TR([$self->afont($self->trans("HI85")),$self->TF("blz",$self->{blz},20,20) ]).
$self->TR([$self->afont($self->trans("HI86")),$self->TF("kontonr",$self->{kontonr},20,20) ]).
"\n
".
"
".$self->afont($self->trans("HI87"))."
".
"".
"
\n".
$self->SMrow( ["bbut","bbut","bbut"] , ["BU38","BU1","BU11"] );
return ($TITEL,$HTML);
#$self->printhtml($TITLE,$HTML);
#$self->exit;
}
####################################################################
#### Gibt die Standardmaske aus
#### Argumente : Emergency und Logtext
#### Returnwert : -
####################################################################
sub getbearb {
my $self = shift;
my ($pin, $pass, $trans);
$self->log(4,"Entering: pdat:getbearb");
#Zugangsdaten vergessen -Vorname, Name, Telefon. Button "Anfordern"
if ($baseq::VARS{bbut} eq $self->trans("BU39")) {$self->anfordern;$self->exit;}
#################################################################
#Neue Teilnehmer / Original
#if ($baseq::VARS{bbut} eq $self->trans("BU37")) {$self->printhtml($self->htmlbearb);$self->exit;}
#################################################################
#Neue Teilnehmer
if ($baseq::VARS{bbut} eq $self->trans("BU37")) {
$self->{herkunft}= $baseq::VARS{herkunft}+0;
$self->{werbpin}= $baseq::VARS{werbpin}+0;
$self->printhtml($self->htmlbearb);$self->exit;
}
#Neue Teilnehmer per refferer-Link
if ($baseq::VARS{bbut} eq "link") {
$self->{herkunft}= $baseq::VARS{herkunft}+0;
$self->{werbpin}= $baseq::VARS{werbpin}+0;
$self->printhtml($self->htmlbearb);$self->exit;
}
#Konto abrufen
if ($baseq::VARS{bbut} eq $self->trans("BU35")) {
if ($baseq::VARS{pin} == 0 ) {$self->printhtml($self->htmlbearb);$self->exit;}
$self->log(4,"Kontostand wird abgerufen");
$kasse=kasse->init($self);
$kasse->{warntext}=$kasse->trans("WA22");
$HTML.=$kasse->kontohtml($baseq::VARS{pin}+0)."
\n";
$kasse->printhtml("Kontostand",$HTML);
$self->exit;
}
#Beenden
if ($baseq::VARS{bbut} eq $self->trans("BU11")) {
my $exiturl='http://www.prorata.de';
#my $exiturl='../webhaup1.htm';
$self->redirect($exiturl);
}
#Existierende Teilnehmer - Loginmaske
if ($baseq::VARS{bbut} eq $self->trans("BU6")) {
$self->login;$self->exit;}
#Button Anmelden
if ($baseq::VARS{lbut} eq $self->trans("BU12")) {
$self->{id}=$baseq::VARS{apin};
$baseq::VARS{pin}=$baseq::VARS{apin};
$baseq::VARS{pass}=crypt($baseq::VARS{apass},"xy");
$res=$self->checkpass($baseq::VARS{pin}, $baseq::VARS{pass});
if ($res != 0 && $res != 2) {$baseq::VARS{pin}=0; $self->login; $self->exit;};
$self->load;
$self->printhtml($self->htmlbearb);
$self->exit;
}
#Speichern
if ($baseq::VARS{bbut} eq $self->trans("BU1")) {
$self->log(4,"Speichern");
$self->getvars;
my $werbpin1=$self->{werbpin1};
$warn=$self->checkalles;
$self->{warntext}=$warn;
$self->log(4,"werbpin1");
#Neuen Benutzer Speichern
if ($warn eq "" && $self->{id} == 0) {
if ($self->{werbpin} == 0) {$self->log(4,"Keine Kassenbestandaktualisierung");$self->new;}
#$kasse->kontohtml($baseq::VARS{pin})
if ($self->{werbpin} != 0) {
$kasse=kasse->init($self);
$self->log(4,"Kassenbestand wird aktualisiert");
$kasse->habenwerb($self->{werbpin});
$self->new;
}
}
#Existierenden Benutzer updaten
if ($warn eq "" && $self->{id} != 0) {
#Wurde werbpin früher angegeben?
my $x = $self->loadwerbpin;
$self->log(4,"Wurde werbpin früher angegeben? $x= ".$x);
if ($x == 0) {
$kasse=kasse->init($self);
$self->log(4,"Kassenbestand wird aktualisiert");
$kasse->habenwerb($self->{werbpin});
$self->store;
$self->load;
$self->printhtml($self->htmlbearb);
$self->exit;
}
if ($x != 0) {
$self->store;
$self->load;
$self->printhtml($self->htmlbearb);
$self->exit;
}
}
else {$self->printhtml($self->htmlbearb);$self->exit;}
}
#Kein Button:
else {
$self->{id}=$baseq::VARS{apin};
$baseq::VARS{pin}=$baseq::VARS{apin};
$baseq::VARS{pass}=crypt($baseq::VARS{apass},"xy");
$res=$self->checkpass($baseq::VARS{pin}, $baseq::VARS{pass});
if ($res != 0 && $res != 2) {$baseq::VARS{pin}=0; $self->login; $self->exit;};
$self->load;
$self->printhtml($self->htmlbearb);
$self->exit;
}
}
####################################################################
#### Gibt die Bestätigungmaske aus
#### Argumente : Emergency und Logtext
#### Returnwert : -
####################################################################
sub htmlbest {
my $self = shift;
$self->{buttonwidth}=21;
$self->log(4,"Entering: pdat:htmlbest");
my $TITLE=$self->trans("TI21");
$HTML="\n".
#$self->TR([ $self->afont("".$self->trans("HI53").": ").$self->sfont($self->{id}) ])."".
$self->TR([ "".$self->afont($self->trans("HI53"))."",$self->qfont($self->{id}) ]).
#"".
#"
\n\n".
$self->TR([ $self->afont($self->trans("HI55")),$baseq::HF[$self->{anrede}] ]).
$self->TR([ $self->afont($self->trans("HI56")),$self->{vname} ]).
$self->TR([ $self->afont($self->trans("HI57")),$self->{nname} ]).
$self->TR([ $self->afont($self->trans("HI58")),$self->{strasse} ]).
$self->TR([ $self->afont($self->trans("HI59")),$self->{plz}." ".$self->{nl} ]).
$self->TR([ $self->afont($self->trans("HI60")),$self->{stadt} ]).
$self->TR([ $self->afont($self->trans("HI62")),$self->{email}]).
$self->TR([ $self->afont($self->trans("HI64")),$self->{tel}]);
if($self->{tel2}){$HTML.=$self->TR([ $self->afont($self->trans("HI65")),$self->{tel2}])};
$HTML.="
\n
\n".$self->sfont($self->trans("HI98"))."
".
#"
".
$self->SM("bbut","BU11");
$self->printhtml($TITLE,$HTML);
$self->sendmail;
$self->log(4,"Entering: pdat:sendmail");
$self->exit;
#return
}
####################################################################
#### 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;
}
####################################################################
#### Stellt die Bestätigungsmail zusammen
#### Argumente :
#### Returnwert : -
####################################################################
sub sendmail{
my $self = shift;
my $email="";
my $mailprog = '/usr/sbin/sendmail';
my $referer="anmeldedaten\@prorata.de";
my $subject=$self->trans("HI97");
open (MAIL,"|$mailprog -t");
$email="To: ".$self->{email}."\n".
"From: $referer\n".
"Subject: $subject\n\n".
$self->trans("HI92")." ".$self->getdate."\n".
"-" x 75 . "\n".$self->trans("TI20")."\n\n".
$self->trans("HI53").": ".$self->{id}."\n".
$self->trans("HI18").": ".$self->{pass}."\n".
"\n"."-" x 75 . "\n\n".
$self->trans("HI55").": ".$baseq::HF[$self->{anrede}]."\n".
$self->trans("HI56").": ".$self->{vname}."\n".
$self->trans("HI57").": ".$self->{nname}."\n".
$self->trans("HI58a").": ".$self->{strasse}."\n".
$self->trans("HI59").": ".$self->{plz}." ".$self->{nl}."\n".
$self->trans("HI60").": ".$self->{stadt}."\n".
$self->trans("HI62").": ".$self->{email}."\n".
$self->trans("HI64").": ".$self->{tel}."\n";
if($self->{tel2}) { $email.=$self->trans("HI65").": ".$self->{tel2}."\n"; }
$email.=$self->trans("HI66").": ".$self->{gdat}."\n\n";
if($self->{bildung} != 0) {$email.=$self->trans("HI68").": ".$baseq::BI[$self->{bildung}]."\n"; }
if($self->{famstand} != 0) { $email.=$self->trans("HI69").": ".$baseq::FS[$self->{famstand}]."\n"; }
if($self->{arbeit} != 0) { $email.=$self->trans("HI70a").": ".$baseq::BS[$self->{arbeit}]."\n"; }
if($self->{berufsstand} != 0) { $email.=$self->trans("HI70b").": ".$baseq::BST[$self->{berufsstand}]."\n"; }
if($self->{pers3} !=0 ||$self->{pers12} !=0 || $self->{pers22} !=0 || $self->{pers54} !=0 || $self->{pers55} !=0){
$email.="\n".$self->trans("HI71")."\n";
if($self->{pers3} !=0) {$email.=$self->trans("HI72").": ".$self->{pers3}."\n";}
if($self->{pers12} !=0){$email.=$self->trans("HI73").": ".$self->{pers12}."\n";}
if($self->{pers22} !=0){$email.=$self->trans("HI74").": ".$self->{pers22}."\n";}
if($self->{pers54} !=0){$email.=$self->trans("HI75").": ".$self->{pers54}."\n";}
if($self->{pers55} !=0){$email.=$self->trans("HI76").": ".$self->{pers55}."\n";}
$email.="\n";
}
if($self->{provider} != 0) { $email.=$self->trans("HI63").": ".$baseq::PR[$self->{provider}]."\n"; }
if($self->{bsystem} != 0) { $email.=$self->trans("HI90").": ".$baseq::BSYS[$self->{bsystem}]."\n"; }
if($self->{herkunft} != 0) { $email.=$self->trans("HI81")."\n\n - ".$baseq::HK[$self->{herkunft}]."\n";}
if($self->{werbpin} != 0) { $email.="\n".$self->trans("HI108").": ".$self->{werbpin}."\n"; }
$email.="\n"."-" x 75 . "\n\n";
$email.=$self->trans("HI83a")."\n\n - ".$baseq::LO[$self->{lohnart}]."\n";
if($self->{lohnart}==1){
$email.="\n";
$email.=$self->trans("HI84").": ".$self->{bank}."\n";
$email.=$self->trans("HI85").": ".$self->{blz}."\n";
$email.=$self->trans("HI86").": ".$self->{kontonr}."\n";
}
#Kriterien
$email.="\n"."-" x 75 . "\n";
$email.=$self->trans("HI77a").":\n\n";
for ($x=1; $x<25 ;$x++) { if($self->{krit}[1][$x]) {$email.=" - ".$baseq::KRIT[$x]."\n";}}
#Hobbys
$email.="\n"."-" x 75 . "\n";
$email.=$self->trans("HI78").":\n\n";
for ($x=1; $x<25 ;$x++) { if($self->{krit}[2][$x]) {$email.=" - ".$baseq::HOB[$x]."\n";}}
#Versandhäuser
$email.="\n"."-" x 75 . "\n";
$email.=$self->trans("HI79a").":\n\n";
for ($x=0; $x<25 ;$x++) { if($self->{krit}[3][$x]) {$email.=" - ".$baseq::VH[$x]."\n";}}
if ($self->{bestjahr}!=0) {$email.="\n".$self->trans("HI80").": ".$self->{bestjahr}."\n";}
$email.="\n"."-" x 75 . "\n".$self->trans("HI96")."\n".$self->trans("HI94");
print MAIL $email;
close (MAIL);
}
####################################################################
#### Gibt die Standardmaske aus
#### Argumente : Emergency und Logtext
#### Returnwert : -
####################################################################
sub anfordern {
my $self = shift;
$self->{buttonwidth}=21;
$self->log(4,"Entering: pdat:anfordern");
my $TITLE=$self->trans("TI1");
$self->log(4,$self->{warntext});
$self->{anrede2}= $self->{anrede}= $self->fclean($baseq::VARS{anrede});
$self->{vname2} = $self->{vname}= $self->fclean($baseq::VARS{vname});
$self->{nname2} = $self->{nname}= $self->fclean($baseq::VARS{nname});
$self->{tel2} = $self->{tel}= $self->fclean($baseq::VARS{tel});
$self->{tel}=~s/\D//g;
my $sql = "select vname, nname, email, pin, pass, tel from benutzer where ".
"vname='$self->{vname}' and nname='$self->{nname}' and (tel='$self->{tel}' or tel2='$self->{tel}')";
($self->{vname}, $self->{nname}, $self->{email}, $self->{id}, $self->{pass}, $self->{tel}) = $self->sqlselect($sql);
if (! defined $self->{id}){
$self->{anrede} = $self->{anrede2};
$self->{vname} = $self->{vname2};
$self->{nname} = $self->{nname2};
$self->{tel} = $self->{tel2};
$self->{tel}=~s/\D//g;
$text =$self->trans("WA42");
$self->htmlantw;
$self->exit;}
else{
$self->anfmail;
$text=$self->trans("HI99");
$self->htmlantw;
$self->exit;}
}
####################################################################
#### Stellt die Anforderungsmail zusammen
#### Argumente :
#### Returnwert : -
####################################################################
sub anfmail {
my $self = shift;
my $email="";
my $mailprog = '/usr/sbin/sendmail';
my $referer="anmeldedaten\@prorata.de";
my $subject=$self->trans("TI20");
open (MAIL,"|$mailprog -t");
$email="To: ".$self->{email}."\n".
"From: $referer\n".
"Subject: $subject\n\n".
$self->trans("HI92")." ".$self->getdate."\n".
"-" x 75 . "\n".
$self->trans("HI95")."\n\n".
$self->trans("HI53").": ".$self->{id}."\n".
$self->trans("HI18").": ".$self->{pass}."\n".
$self->trans("HI93")."\n\n".$self->trans("HI94");
print MAIL $email;
close (MAIL);
}
####################################################################
#### Gibt die Antwortmaske, wenn die vergessene Zugangsdaten angefordern werden
#### Argumente : Emergency und Logtext
#### Returnwert : -
####################################################################
sub htmlantw {
my $self = shift;
$self->{buttonwidth}=21;
$self->log(4,"Entering: pdat:htmlantw");
my $TITLE=$self->sfont($self->trans("TI19"));
$self->log(4,$self->{warntext});
my $HTML="\n".
"\n\n";
if($self->{id}){$HTML.=$self->TR([ $self->afont($self->trans("HI53")),$self->sfont($self->{id})]);}
$HTML.=$self->TR([ $self->afont($self->trans("HI55")),$self->sfont($self->{anrede})]).
$self->TR([ $self->afont($self->trans("HI56")),$self->sfont($self->{vname}) ]).
$self->TR([ $self->afont($self->trans("HI57")),$self->sfont($self->{nname}) ]).
$self->TR([ $self->afont($self->trans("HI64")),$self->sfont($self->{tel}) ]);
if($self->{email}){$HTML.=$self->TR([ $self->afont($self->trans("HI62")),$self->sfont($self->{email}) ]);}
$HTML.="
\n\n".$self->sfont($text)."
".
$self->SM("bbut","BU11");
$self->printhtml($TITLE,$HTML);
$self->exit;
}
####################################################################
#### Online - Panel Statistik
#### Argumente : Emergency und Logtext
#### Returnwert : -
####################################################################
sub statistik{
my $self = shift;
$self->log(4, "Entering: pdat - Statistik");
my $TITLE=$self->trans("TI23");
my $HTML.="\n".$self->afont($self->trans("TI23"))."\n".
#Anzahl allen Benutzer
"
|
\n";
$HTML.="| | | ".
" | | |
";
my $alcount = $self->sqlselect("select count(pin) from benutzer");
$HTML.=$self->TR([ $self->afont("Anzahl Teilnehmer")," | ",$self->afont($alcount)," | ",$self->afont("100 %") ]);
$HTML.="
\n";
#Geschlecht
$HTML.=$self->TR([$self->afont("".$self->trans("HI55")."")]);
$HTML.="";
$HTML.="| | | ".
" | | |
";
for ($x=1; $x<($#baseq::HF+1); $x++) {
$lcount= $self->sqlselect("select count(pin) from benutzer where anrede=$x");
$HTML.=$self->TR([ $self->afont($baseq::HF[$x])," | ",
$self->afont($lcount)," | ",
$self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
}
$HTML.="
\n";
#Land
$HTML.=$self->TR([$self->afont("Teilnehmer aus")]);
$HTML.="";
$HTML.="| | | ".
" | | |
";
for ($x=1; $x<($#baseq::LA+1); $x++) {
$lcount= $self->sqlselect("select count(pin) from benutzer where land=$x");
$HTML.=$self->TR([ $self->afont($baseq::LA[$x])," | ",
$self->afont($lcount)," | ",
$self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
}
$HTML.="
\n";
#Ausbildung
$HTML.=$self->TR([$self->afont("".$self->trans("HI68")."")]);
$HTML.="";
$HTML.="| | | ".
" | | |
";
for ($x=0; $x<($#baseq::BI+1); $x++) {
$lcount= $self->sqlselect("select count(pin) from benutzer where bildung=$x");
$HTML.=$self->TR([ $self->afont($baseq::BI[$x])," | ",
$self->afont($lcount)," | ",
$self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
}
$HTML.="
\n";
#Beschäftigung
$HTML.=$self->TR([$self->afont("".$self->trans("HI70")."")]);
$HTML.="";
$HTML.="| | | ".
" | | |
";
for ($x=0; $x<($#baseq::BS+1); $x++) {
$lcount= $self->sqlselect("select count(pin) from benutzer where arbeit=$x");
$HTML.=$self->TR([ $self->afont($baseq::BS[$x])," | ",
$self->afont($lcount)," | ",
$self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
}
$HTML.="
\n";
#Berufsstand
$HTML.=$self->TR([$self->afont("".$self->trans("HI70b")."")]);
$HTML.="";
$HTML.="| | | ".
" | | |
";
for ($x=0; $x<($#baseq::BST+1); $x++) {
$lcount= $self->sqlselect("select count(pin) from benutzer where berufsstand=$x");
$HTML.=$self->TR([ $self->afont($baseq::BST[$x])," | ",
$self->afont($lcount)," | ",
$self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
}
$HTML.="
\n";
#Familienstand
$HTML.=$self->TR([$self->afont("".$self->trans("HI69")."")]);
$HTML.="";
$HTML.="| | | ".
" | | |
";
for ($x=0; $x<($#baseq::FS+1); $x++) {
$lcount= $self->sqlselect("select count(pin) from benutzer where famstand=$x");
$HTML.=$self->TR([ $self->afont($baseq::FS[$x])," | ",
$self->afont($lcount)," | ",
$self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
}
$HTML.="
\n";
#Anzahl Personen in der Familie
$HTML.=$self->TR([$self->afont("".$self->trans("HI71")."")]);
$HTML.="";
$HTML.="| | | ".
" | | |
";
$sql="select distinct sum(pers3+pers12+pers22+pers54+pers55) from benutzer group by pin";
my $sth= $self->sqlprepare($sql);
$cnt=0;
while ( ($dummie)=$sth->fetchrow_array) {
$hash[$cnt]->{leute}=$dummie;
$hash[$cnt]->{anzahl}=$self->sqldo("SELECT pin FROM benutzer GROUP BY pin HAVING (((Sum(pers3+pers12+pers22+pers54+pers55))=$hash[$cnt]->{leute}))");
#$self->log(4,"Leute=$hash[$cnt]->{leute}, Anzahl=$hash[$cnt]->{anzahl}");
$cnt++;
}
sub sof {$a->{leute} <=> $b->{leute} };
@nlist = sort sof @hash;
foreach $hash (@nlist) {
#$self->log(4,"--- Leute=".$hash->{leute}.", Anzahl=".$hash->{anzahl});
%hash=%$hashre;
$HTML.=$self->TR([$self->afont($hash->{leute}." Personen")," | ",
$self->afont($hash->{anzahl})," | ",
$self->afont(sprintf("%0.1f %",($hash->{anzahl}*100/$alcount)))]);
}
$HTML.="
\n";
#####################################################################################################
#Altersgruppen
$HTML.=$self->TR([$self->afont("".$self->trans("HI111")."")]);
$HTML.="";
$HTML.="| | | ".
" | | |
";
my $maxgebclus=$self->sqlselect("select max(gebclusn) from benutzer");
for ($x=0; $x<=($maxgebclus); $x++) {
$lcount= $self->sqlselect("select count(pin) from benutzer where gebclusn=$x");
$HTML.=$self->TR([ $self->afont($baseq::ALT[$x])," | ",
$self->afont($lcount)," | ",
$self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
}
$HTML.="
\n";
###############################################################################################
#PLZ-Gebiete
$HTML.=$self->TR([$self->afont("".$self->trans("HI112")."")]);
$HTML.="";
$HTML.="| | | ".
" | | |
";
my $maxplzcod=$self->sqlselect("select max(plzcod) from benutzer");
for ($x=0; $x<=($maxplzcod); $x++) {
$lcount= $self->sqlselect("select count(pin) from benutzer where plzcod=$x");
$HTML.=$self->TR([ $self->afont($baseq::PLZ[$x])," | ",
$self->afont($lcount)," | ",
$self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
}
$HTML.="
\n";
######################################################################################################
# ##Entlohnungsart
# $HTML.=$self->TR([ $self->afont("".$self->trans("HI83a")."")]);
# $HTML.="";
# $HTML.="| | | ".
# " | | |
";
#
# for ($x=0; $x<($#baseq::LO+1); $x++) {
# $lcount= $self->sqlselect("select count(pin) from benutzer where lohnart=$x");
# $HTML.=$self->TR([ $self->afont($baseq::LO[$x])," | ",
# $self->afont($lcount)," | ",
# $self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
# }
# $HTML.="
\n";
#
###############################################################################################
# Ab 2004 nicht Verfügbar
# #Betriebsystem
# $HTML.=$self->TR([$self->afont("".$self->trans("HI90")."")]);
# $HTML.="";
# $HTML.="| | | ".
# " | | |
";
#
# for ($x=0; $x<($#baseq::BSYS+1); $x++) {
# $lcount= $self->sqlselect("select count(pin) from benutzer where bsystem=$x");
# $HTML.=$self->TR([ $self->afont($baseq::BSYS[$x])," | ",
# $self->afont($lcount)," | ",
# $self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
# }
# $HTML.="
\n";
#
#
# #Provider
# $HTML.=$self->TR([$self->afont("".$self->trans("HI63")."")]);
# $HTML.="";
# $HTML.="| | | ".
# " | | |
";
#
# for ($x=0; $x<($#baseq::PR+1); $x++) {
# $lcount= $self->sqlselect("select count(pin) from benutzer where provider=$x");
# $HTML.=$self->TR([ $self->afont($baseq::PR[$x])," | ",
# $self->afont($lcount)," | ",
# $self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
# }
# $HTML.="
\n";
#
#
# #Herkunft - wie sind Sie auf unsere Seite gekommen
# $HTML.=$self->TR([$self->afont("".$self->trans("HI81")."")]);
# $HTML.="";
# $HTML.="| | | ".
# " | | |
";
#
# for ($x=0; $x<($#baseq::HK+1); $x++) {
# $lcount= $self->sqlselect("select count(pin) from benutzer where herkunft=$x");
# $HTML.=$self->TR([ $self->afont($baseq::HK[$x])," | ",
# $self->afont($lcount)," | ",
# $self->afont(sprintf("%0.1f %",($lcount*100/$alcount))) ]);
# }
# $HTML.="
\n \n";
#
###################################################################################################################
$HTML.="\n\n";
return $HTML;
}