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

use benutzer;

$BEN=benutzer-&gt;init;
%val=%{$BEN-&gt;Vars};

$BEN-&gt;loadtmp();
$BEN-&gt;loadsprache(0);

$val{umfid}+=0;
#if ($val{sbut} eq $BEN-&gt;trans("BU11") || $val{lbut} eq $BEN-&gt;trans("BU11")  ) { $BEN-&gt;redirect("http://fs1.prorata.de/admin.htm");}


#############  PASSWORT
$baseq::VARS{umfid}=$val{umfid};

if ($val{lbut} eq $BEN-&gt;trans("BU12") ) {
   $baseq::VARS{pass}=crypt($val{apass},"xy");
   $baseq::VARS{knr}=$val{apin};
}

if ($BEN-&gt;checkpass($baseq::VARS{knr},$baseq::VARS{pass}) != 4) {$BEN-&gt;{knr}==0;$BEN-&gt;login; $BEN-&gt;exit;}

($BEN-&gt;{template},$sprache)=$BEN-&gt;sqlselect("select template,sprache from kunden where knr=$baseq::VARS{knr}");
$BEN-&gt;loadtmp();
$BEN-&gt;loadsprache($sprache);

##############


if ($val{sbut} eq $BEN-&gt;trans("BU1") ){&amp;save;}
if ($val{sbut} eq $BEN-&gt;trans("BU29") ){&amp;deletestprobe;}
if ($val{sbut} eq $BEN-&gt;trans("BU30") ){&amp;selectmail;}
if ($val{sbut} eq $BEN-&gt;trans("BU31") ){&amp;automail("esiemon\@prorata.de\n");}

my $HTML=$BEN-&gt;qfont("Bereits erstellte Stichproben")."\n&lt;BR&gt;\n".
         &amp;stprobtable.$BEN-&gt;afont("Es sind ".&amp;automail." E-Mails in Automail eingetragen")."&lt;BR&gt;\n".
         $BEN-&gt;SMrow(["sbut","sbut","sbut"],["BU29","BU30","BU31"])."&lt;HR&gt;\n".
         &amp;htmltop.  $BEN-&gt;SMrow(["sbut","sbut","sbut"],["BU22","BU11","BU1"]);

if ($val{sbut} eq $BEN-&gt;trans("BU22") ) {$HTML.="&lt;HR&gt;\n".&amp;benutzerliste;}

$BEN-&gt;printhtml("Stichprobe",$HTML);

$BEN-&gt;exit;


####################################################################
####         Gibt einen String mit den Auswahlfeldern zurueck
####         Argumente  : -
####         Returnwert : HTML-String
####################################################################
sub htmltop {
        $BEN-&gt;{warntext}="Teilnehmerselection für Umfragenummer $val{umfid}";

        #--------------------------------------------------------------------------------------------------------
        #Liste der Einzelkriterien;
        my $HTML=
        "&lt;TABLE BORDER=1&gt;".
        $BEN-&gt;TR([$BEN-&gt;CB("anzahl",1,$val{anzahl}),"Personen",$BEN-&gt;TF("Personen",$val{Personen},5) ]).
        $BEN-&gt;TR([$BEN-&gt;CB("calterv",1,$val{calterv}),"von",$BEN-&gt;TF("alterv",$val{alterv},5) ]).
        $BEN-&gt;TR([$BEN-&gt;CB("calterb",1,$val{calterb}),"bis",$BEN-&gt;TF("alterb",$val{alterb},5) ]).
        $BEN-&gt;TR([$BEN-&gt;CB("cbis3",1,$val{cbis3}),"Anzahl 0-3 jährige",$BEN-&gt;TF("bis3",$val{bis3},5) ]).
        $BEN-&gt;TR([$BEN-&gt;CB("cbis12",1,$val{cbis12}),"Anzahl 4-12 jährige",$BEN-&gt;TF("bis12",$val{bis12},5) ]).
        $BEN-&gt;TR([$BEN-&gt;CB("cbis22",1,$val{cbis22}),"Anzahl 13-22 jährige",$BEN-&gt;TF("bis22",$val{bis22},5) ]).
        $BEN-&gt;TR([$BEN-&gt;CB("cbis55",1,$val{cbis55}),"Anzahl 23-54 jährige",$BEN-&gt;TF("bis55",$val{bis55},5) ]).
        $BEN-&gt;TR([$BEN-&gt;CB("cab55",1,$val{cab55}),"Anzahl ab 55",$BEN-&gt;TF("ab55",$val{ab55},5) ]).
        $BEN-&gt;TR([$BEN-&gt;CB("sex",1,$val{sex}),"Anrede",$BEN-&gt;DDanrede("anrede",$val{anrede}) ]).
        $BEN-&gt;TR([$BEN-&gt;CB("fam",1,$val{fam}),"Familienstand", $BEN-&gt;DDfamilie("famstand",$val{famstand}) ]).
        $BEN-&gt;TR([$BEN-&gt;CB("bild",1,$val{bild}),"Ausbildung", $BEN-&gt;DDbildung("bildung",$val{bildung}) ]) .
        $BEN-&gt;TR([$BEN-&gt;CB("besch",1,$val{besch}),"Besch&amp;auml;ftigung", $BEN-&gt;DDarbeit('arbeit',$val{arbeit}) ]) .
        "&lt;/TABLE&gt;&lt;BR&gt;\n";

        #--------------------------------------------------------------------------------------------------------
        #Ausgewählte Produktkategorien &amp; Hobbys
        ($krit, $hobby)= $BEN-&gt;krittable;
        $HTML.= $BEN-&gt;qfont("Ausgewählte Produktkategorien")."\n&lt;BR&gt;\n". $krit . "&lt;BR&gt;\n" .
               $BEN-&gt;qfont("Hobbys")."\n&lt;BR&gt;\n". $hobby . "&lt;BR&gt;\n";

        #--------------------------------------------------------------------------------------------------------
        #Angegebene Versand-Haeuser
        $HTML.= $BEN-&gt;qfont("Versandh&amp;auml;user")."&lt;BR&gt;\n".
        "&lt;TABLE BORDER=1&gt;\n".
        $BEN-&gt;TR([$BEN-&gt;RB("vhtest",1,$val{vhtest})."AND",$BEN-&gt;RB("vhtest",0,$val{vhtest}==0)."OR",$BEN-&gt;CB("vhtestx",1,$val{vhtestx})."NICHT" ]).
        "&lt;/TABLE&gt;\n".
        $BEN-&gt;vhtable;
        return $HTML;
}

####################################################################
####         erstellt die SQL-clause und INSERT-Listen anhand der
####         uebergebenen Variablen
####         Argumente  : -
####         Returnwert : sql,sqllist1,sqllist2
####################################################################
sub createlisten {
   my (@chk, @chk1, $sqlist, $sqlist2,$x);
   my $rlist;
   my $jahr = (localtime)[5]+1900;
   unshift @chk,"pin&gt;0";
   if (!$val{anzahl})  {$val{Personen}=-1}
   if ($val{calterv})	{$geb=$jahr-$val{alterv}; unshift @chk,"gdat&lt;'$geb-12-31'" }else{$val{alterv}=-1}
   if ($val{calterb})	{$geb=$jahr-$val{alterb}; unshift @chk,"gdat&gt;'$geb-01-01'" }else{$val{alterb}=-1}
   if ($val{cbis3})	{unshift @chk,"pers3=$val{bis3}" }else{$val{bis3}=-1}
   if ($val{cbis12})	{unshift @chk,"pers12=$val{bis12}" }else{$val{bis12}=-1}
   if ($val{cbis22})	{unshift @chk,"pers22=$val{bis22}" }else{$val{bis22}=-1}
   if ($val{cbis55})	{unshift @chk,"pers54=$val{bis55}" }else{$val{bis55}=-1}
   if ($val{cab55})	{unshift @chk,"pers55=$val{ab55}" }else{$val{ab55}=-1}
   if ($val{sex})	{unshift @chk,"anrede='$val{anrede}'" }else{$val{anrede}=-1}
   if ($val{fam}){unshift @chk,"famstand='$val{famstand}'" }else{$val{famstand}=-1}
   if ($val{bild})	{unshift @chk,"bildung='$val{bildung}'" }else{$val{bildung}=-1}
   if ($val{besch})	{unshift @chk,"arbeit='$val{arbeit}'" }else{$val{arbeit}=-1}

        #-------------------------------------------------
        #  Kriterien
        for ($x=1; $x&lt;49 ;$x++ ) {
                if ($val{"pk$x"}) {
                        $sqlist.= ",1";                         # String für insert into stprobe..........
                        push @chk, "pk$x=1";
                }
                else {$sqlist.= ",0"};
        }

        foreach $a (@chk) {push @chk1,"benutzer.".$a;}
        @chk=();
        #  Versandhaeuser
        for($x=0; $x&lt;20;$x++){
                if ($val{"vh$x"}) {
                        $sqlist2.= ",1";
           push @chk, "vh$x=1";
        }
        else {$sqlist2.= ",0"};
}

  if ($chk[0] ne "" ) { $rlist2=" and ".("","not")[$val{vhtestx}]." ( ".join( (" or "," and ")[$val{vhtest}], @chk ) ." ) "; } # AND/OR Versandhaus...... NOT

  my $sql="select benutzer.PIN, benutzer.anrede, benutzer.VNAME, benutzer.NNAME, count(ergebnis.pin) CNT ".
           "from benutzer left join ergebnis using (pin) left join umfidpin on benutzer.pin=umfidpin.pin and umfidpin.umfid=$val{umfid} where " .
           "umfidpin.umfid is NULL and ".join(" and ",@chk1) . $rlist2 . " group by benutzer.pin order by CNT limit $val{Personen}";
  return $sql , $sqlist, $sqlist2;
}

####################################################################
####         erstellt eine HTML-Tabelle mit den Stichproben
####         uebergebenen Variablen zurueck
####         Argumente  : -
####         Returnwert : -
####################################################################
sub stprobtable {
  my $sql="select * from stprobe where umfid=$val{umfid} order by stpro";
  my $sth = $BEN-&gt;sqlprepare($sql);
  my ($x, @result, @neue);
  my $tab=$BEN-&gt;TR(["","Anz.","Von","Bis","0-3","4-13","13-22","23-55","ab 55","Geschl.","Familie","Bildung","Arbeit","Kriterien"]);
  while (@result = $sth-&gt;fetchrow_array) {
         @neue=();
         for ($x=1; $x&lt;13; $x++) {
            if ($result[$x] == -1) {$result[$x]="&amp;nbsp;";}
            else {
               if ($x==9) {$result[9]=$baseq::HF[$result[9]];}
               if ($x==10) {$result[10]=$baseq::FS[$result[10]];}
               if ($x==11) {$result[11]=$baseq::BI[$result[11]];}
               if ($x==12) {$result[12]=$baseq::BS[$result[12]];}
            }
            push @neue,$result[$x];
         }
         for ($x=13; $x&lt;61; $x++) {
            if ( $result[$x] ) {push @neue,$baseq::KRIT[$x-12];}
         }
       unshift @neue, $BEN-&gt;CB("chostpro".$result[61],$result[61],$result[61]==$val{"chostpro".$result[61]} );
       $tab.=$BEN-&gt;TR(\@neue);
  }
  if ($tab ne "") {return  "&lt;TABLE BORDER=1&gt;\n".$tab."&lt;/TABLE&gt;\n";}
  return;
}

####################################################################
####         speichert eine Stichprobe in stprobe und umfidpin
####         uebergebenen Variablen zurueck
####         Argumente  : -
####         Returnwert : -
####################################################################
sub save {
   ($sql, $sqlist1, $sqlist2)=&amp;createlisten;
   my $sth=$BEN-&gt;sqlprepare($sql);
   my $za=0;
   while (@result=$sth-&gt;fetchrow_array) {push @L,$result[0];}
   my $stpro=($BEN-&gt;sqlselect("select max(stpro) from stprobe"))+1;
   foreach $pin (@L) {$za+= $BEN-&gt;sqldo("insert into umfidpin values ($val{umfid}, $pin, $stpro)");}
   my $sql1="insert into stprobe values ( $val{umfid},$za,$val{alterv},$val{alterb},$val{bis3},$val{bis12},$val{bis22},$val{bis55},$val{ab55},'$val{anrede}','$val{famstand}','$val{bildung}','$val{arbeit}' $sqlist1 , $stpro, 0 $sqlist2)" ;
   if ($za&gt;0) {$BEN-&gt;sqldo($sql1);}
   return $za;
}

####################################################################
####         Gibt eine Tabelle der ausgewaehlten benutzer zurück
####         uebergebenen Variablen zurueck
####         Argumente  : -
####         Returnwert : -
####################################################################
sub benutzerliste {
  ($sql, $sqlinsert)=&amp;createlisten;
  my $sth = $BEN-&gt;sqlprepare($sql);
  my $HTML= $BEN-&gt;qfont("Gefundene &amp;Uuml;bereinstimmungen: ". $sth-&gt;rows ) .
  "&lt;TABLE BORDER=1&gt;\n".
  $BEN-&gt;TR(["PIN","Anrede","Vorname","Name","Count"],"align=\"center\"");
  while (@result = $sth-&gt;fetchrow_array) {
    $result[1]=$baseq::HF[$result[1]];
    $HTML.=$BEN-&gt;TR(\@result);
  }
  return $HTML."&lt;/TABLE&gt;\n";
}


####################################################################
####         Schreibt mit RSH in die .qmail-automail datei...
####         oder holt die Anzahl der eingetragenen
####         Argumente  : einzutragender String
####         Returnwert : Zeilen in Automail
####################################################################
sub automail {
     my $AUTOMAIL=".qmail-automail"; my $HOST="proxy"; my $ssh="/usr/local/bin/ssh";
     my $OUT="|$ssh -l automail $HOST \"tee $AUTOMAIL &gt;/dev/null\"";
     my $IN ="$ssh -l automail $HOST \"cat $AUTOMAIL|wc -l\" |";
     my $tring=shift;
     if ($tring eq ""){
        open (FILE, $IN);
        $num=&lt;FILE&gt;;
        close FILE;
        chomp $num;
        $num=~s/\s//g;
        $BEN-&gt;log(4,"READ from automail: $num Mails");
        return $num;
     }
     else {
        open (FILE, $OUT);
        $BEN-&gt;log(4,"Opening: $OUT");
        print FILE $tring;
        close FILE;
     }
}

####################################################################
####         Selectiert die Emails und schreibt sie mit &amp;automail
####         Argumente  : einzutragender String
####         Returnwert : Zeilen in Automail
####################################################################
sub selectmail {
        my $sql="select benutzer.email from umfidpin left join benutzer using (pin) where ";
        my @wh=(); my $MAILS="";
        foreach $x (keys %val) {
          if ($x=~/^chostpro(\d{1,4})$/) {push @wh,"umfidpin.stprobe=$1";}
        }
        if ($wh[0] eq ""){return;}
        my $sth=$BEN-&gt;sqlprepare($sql.join(" or ",@wh));
        while ($mail=$sth-&gt;fetchrow_array) {$MAILS.=$mail."\n";}
        #$BEN-&gt;log(4,"MAILS=$MAILS");
        &amp;automail($MAILS);
        return;
}

####################################################################
####         Loescht eine oder mehrere Stichprobe(n)
####         Argumente  : einzutragender String
####         Returnwert : Zeilen in Automail
####################################################################
sub deletestprobe {
       my $sql="delete from stprobe where ";
       my $sql1="delete from umfidpin where ";
       my @wh=(); my @wh1=(); my $MAILS="";
       foreach $x (keys %val) {
          if ($x=~/^chostpro(\d{1,4})$/) {push @wh,"stprobe=$1"; push @wh1,"stpro=$1";}
        }
       if ($wh[0] eq ""){return;}
       $BEN-&gt;sqldo($sql.join(" or ",@wh1));
       $BEN-&gt;sqldo($sql1.join(" or ",@wh));
}
</pre></body></html>