#!/usr/bin/perl -w
# Fragebogen
# Author: Oskar Schirmer (c)2002 GPL/GNU Public License
# special thanks to perl-master Thorsten!
# we are going to produce HTML output now:
print "Content-type: text/html\n\n";
# all variables must be declared before usage:
use strict;
use vars '$request_type', '$query', '$fields',
'$logfile', '$cgifile', '$starttime',
'$fehlcolor', '$fehlfarben',
'$radio_name', '$radio_value', '%ref_select', '$radio_part',
'$selmul_value', '$selmul_Y',
'%def_geschw',
'$continue', '$cont2',
'$x', '$az',
'$mail_recipient', '$mail_sender', '@mail_body',
'$mail_subject1', '$mail_subject2',
#radio buttons
'$geschlecht', '$geschlecht_fehlt',
'$schulab', '$schulab_fehlt',
'$bevorzug', '$bevorzug_fehlt',
'$partsch', '$partsch_fehlt',
'$haushalt', '$haushalt_fehlt',
'$pgeschlecht', '$pgeschlecht_fehlt',
'$pschulab', '$pschulab_fehlt',
'$zufdyn', '$zufdyn_fehlt',
#radio_1 buttons
'$einkom', '$einkom_fehlt',
'$peinkom', '$peinkom_fehlt',
'$konflikt', '$konflikt_fehlt',
'$zuforg', '$zuforg_fehlt',
'$zufsex', '$zufsex_fehlt',
'$zufver', '$zufver_fehlt',
#selmul
'$gaschw', '%sel_gaschw', '$gayschw', '$gayschw_fehlt',
'$gbschw', '%sel_gbschw', '$gbyschw', '$gbyschw_fehlt',
'$gcschw', '%sel_gcschw', '$gcyschw', '$gcyschw_fehlt',
'$gdschw', '%sel_gdschw', '$gdyschw', '$gdyschw_fehlt',
'$geschw', '%sel_geschw', '$geyschw', '$geyschw_fehlt',
'$gfschw', '%sel_gfschw', '$gfyschw', '$gfyschw_fehlt',
'$pgaschw', '%sel_pgaschw', '$pgayschw', '$pgayschw_fehlt',
'$pgbschw', '%sel_pgbschw', '$pgbyschw', '$pgbyschw_fehlt',
'$pgcschw', '%sel_pgcschw', '$pgcyschw', '$pgcyschw_fehlt',
'$pgdschw', '%sel_pgdschw', '$pgdyschw', '$pgdyschw_fehlt',
'$pgeschw', '%sel_pgeschw', '$pgeyschw', '$pgeyschw_fehlt',
'$pgfschw', '%sel_pgfschw', '$pgfyschw', '$pgfyschw_fehlt',
#numeric
'$zuordnen', '$zuordnen_fehlt',
'$geburtsjahr', '$geburtsjahr_fehlt',
'$menarche',
'$partzeit', '$partzeit_fehlt',
'$hochzeit', '$hochzeit_fehlt',
'$pgeburtsjahr', '$pgeburtsjahr_fehlt',
#part2
'$b2ea', '$b2ea_fehlt',
'$b2eb', '$b2eb_fehlt',
'$b2ec', '$b2ec_fehlt',
'$b2ed', '$b2ed_fehlt',
'$b2ee', '$b2ee_fehlt',
'$b2ef', '$b2ef_fehlt',
'$b2eg', '$b2eg_fehlt',
'$b2eh', '$b2eh_fehlt',
'$b2ei', '$b2ei_fehlt',
'$b2ej', '$b2ej_fehlt',
'$b2ek', '$b2ek_fehlt',
'$b2el', '$b2el_fehlt',
'$b2em', '$b2em_fehlt',
'$b2en', '$b2en_fehlt',
'$b2eo', '$b2eo_fehlt',
'$b2ep', '$b2ep_fehlt',
'$b2eq', '$b2eq_fehlt',
'$b2er', '$b2er_fehlt',
'$b2es', '$b2es_fehlt',
'$b2pa', '$b2pa_fehlt',
'$b2pb', '$b2pb_fehlt',
'$b2pc', '$b2pc_fehlt',
'$b2pd', '$b2pd_fehlt',
'$b2pe', '$b2pe_fehlt',
'$b2pf', '$b2pf_fehlt',
'$b2pg', '$b2pg_fehlt',
'$b2ph', '$b2ph_fehlt',
'$b2pi', '$b2pi_fehlt',
'$b2pj', '$b2pj_fehlt',
'$b2pk', '$b2pk_fehlt',
'$b2pl', '$b2pl_fehlt',
'$b2pm', '$b2pm_fehlt',
'$b2pn', '$b2pn_fehlt',
'$b2po', '$b2po_fehlt',
'$b2pp', '$b2pp_fehlt',
'$b2pq', '$b2pq_fehlt',
'$b2pr', '$b2pr_fehlt',
'$b2ps', '$b2ps_fehlt',
'$e2e1', '$e2e1_fehlt',
'$e2e2', '$e2e2_fehlt',
'$e2e3', '$e2e3_fehlt',
'$e2e4', '$e2e4_fehlt',
'$e2p1', '$e2p1_fehlt',
'$e2p2', '$e2p2_fehlt',
'$e2p3', '$e2p3_fehlt',
'$e2p4', '$e2p4_fehlt',
#freetext
'$familie', '$familie_fehlt',
'$bemerk';
sub init_fields
{
$az=1;
#radio buttons
$geschlecht="";
$schulab="";
$bevorzug="";
$partsch="";
$haushalt="";
$pgeschlecht="";
$pschulab="";
$zufdyn="";
#radio_1 buttons
$einkom="";
$peinkom="";
$konflikt="";
$zuforg="";
$zufsex="";
$zufver="";
#selmul
%def_geschw=("---"=>"",
"Schwester"=>"", "Bruder"=>"",
"Zwillingsschwester"=>"", "Zwillingsbruder"=>"",
"Halbschwester"=>"", "Halbbruder"=>"",
"Stiefschwester"=>"", "Stiefbruder"=>"",
"Adoptivschwester"=>"", "Adoptivbruder"=>"");
$gaschw=""; %sel_gaschw=%def_geschw; $gayschw="";
$gbschw=""; %sel_gbschw=%def_geschw; $gbyschw="";
$gcschw=""; %sel_gcschw=%def_geschw; $gcyschw="";
$gdschw=""; %sel_gdschw=%def_geschw; $gdyschw="";
$geschw=""; %sel_geschw=%def_geschw; $geyschw="";
$gfschw=""; %sel_gfschw=%def_geschw; $gfyschw="";
$pgaschw=""; %sel_pgaschw=%def_geschw; $pgayschw="";
$pgbschw=""; %sel_pgbschw=%def_geschw; $pgbyschw="";
$pgcschw=""; %sel_pgcschw=%def_geschw; $pgcyschw="";
$pgdschw=""; %sel_pgdschw=%def_geschw; $pgdyschw="";
$pgeschw=""; %sel_pgeschw=%def_geschw; $pgeyschw="";
$pgfschw=""; %sel_pgfschw=%def_geschw; $pgfyschw="";
#numeric
$zuordnen="";
$geburtsjahr="";
$menarche="";
$partzeit="";
$hochzeit="";
$pgeburtsjahr="";
#freetext
$familie="";
$bemerk="";
#part2
$b2ea="";
$b2eb="";
$b2ec="";
$b2ed="";
$b2ee="";
$b2ef="";
$b2eg="";
$b2eh="";
$b2ei="";
$b2ej="";
$b2ek="";
$b2el="";
$b2em="";
$b2en="";
$b2eo="";
$b2ep="";
$b2eq="";
$b2er="";
$b2es="";
$b2pa="";
$b2pb="";
$b2pc="";
$b2pd="";
$b2pe="";
$b2pf="";
$b2pg="";
$b2ph="";
$b2pi="";
$b2pj="";
$b2pk="";
$b2pl="";
$b2pm="";
$b2pn="";
$b2po="";
$b2pp="";
$b2pq="";
$b2pr="";
$b2ps="";
$e2e1="";
$e2e2="";
$e2e3="";
$e2e4="";
$e2p1="";
$e2p2="";
$e2p3="";
$e2p4="";
}
sub get_fields
{
$starttime=$fields->{"Time"};
#radio buttons
$geschlecht=$fields->{"Geschlecht"};
$schulab=$fields->{"Schulab"};
$bevorzug=$fields->{"Bevorzug"};
$partsch=$fields->{"Partsch"};
$haushalt=$fields->{"Haushalt"};
$pgeschlecht=$fields->{"pGeschlecht"};
$pschulab=$fields->{"pSchulab"};
$zufdyn=$fields->{"zufdyn"};
#radio_1 buttons
$einkom=$fields->{"Einkommen"};
$peinkom=$fields->{"pEinkommen"};
$konflikt=$fields->{"Konflikt"};
$zuforg=$fields->{"Zuforg"};
$zufsex=$fields->{"Zufsex"};
$zufver=$fields->{"Zufver"};
#selmul
$gaschw=$fields->{"gaschw"}; $sel_gaschw{$gaschw}="selected"; $gayschw=$fields->{"gayschw"};
$gbschw=$fields->{"gbschw"}; $sel_gbschw{$gbschw}="selected"; $gbyschw=$fields->{"gbyschw"};
$gcschw=$fields->{"gcschw"}; $sel_gcschw{$gcschw}="selected"; $gcyschw=$fields->{"gcyschw"};
$gdschw=$fields->{"gdschw"}; $sel_gdschw{$gdschw}="selected"; $gdyschw=$fields->{"gdyschw"};
$geschw=$fields->{"geschw"}; $sel_geschw{$geschw}="selected"; $geyschw=$fields->{"geyschw"};
$gfschw=$fields->{"gfschw"}; $sel_gfschw{$gfschw}="selected"; $gfyschw=$fields->{"gfyschw"};
$pgaschw=$fields->{"pgaschw"}; $sel_pgaschw{$pgaschw}="selected"; $pgayschw=$fields->{"pgayschw"};
$pgbschw=$fields->{"pgbschw"}; $sel_pgbschw{$pgbschw}="selected"; $pgbyschw=$fields->{"pgbyschw"};
$pgcschw=$fields->{"pgcschw"}; $sel_pgcschw{$pgcschw}="selected"; $pgcyschw=$fields->{"pgcyschw"};
$pgdschw=$fields->{"pgdschw"}; $sel_pgdschw{$pgdschw}="selected"; $pgdyschw=$fields->{"pgdyschw"};
$pgeschw=$fields->{"pgeschw"}; $sel_pgeschw{$pgeschw}="selected"; $pgeyschw=$fields->{"pgeyschw"};
$pgfschw=$fields->{"pgfschw"}; $sel_pgfschw{$pgfschw}="selected"; $pgfyschw=$fields->{"pgfyschw"};
#numeric
$zuordnen=$fields->{"zuordnen"};
$geburtsjahr=$fields->{"Geburtsjahr"};
$menarche=$fields->{"Menarche"};
$partzeit=$fields->{"Partzeit"};
$hochzeit=$fields->{"Hochzeit"};
$pgeburtsjahr=$fields->{"pGeburtsjahr"};
#freetext
$familie=$fields->{"Familie"};
$familie=~ s/\r/\n/g;
$familie=~ s/\n\n/\n/g;
$bemerk=$fields->{"Bemerkung"};
$bemerk=~ s/\r/\n/g;
$bemerk=~ s/\n\n/\n/g;
#part2
$b2ea=$fields->{"b2ea"};
$b2eb=$fields->{"b2eb"};
$b2ec=$fields->{"b2ec"};
$b2ed=$fields->{"b2ed"};
$b2ee=$fields->{"b2ee"};
$b2ef=$fields->{"b2ef"};
$b2eg=$fields->{"b2eg"};
$b2eh=$fields->{"b2eh"};
$b2ei=$fields->{"b2ei"};
$b2ej=$fields->{"b2ej"};
$b2ek=$fields->{"b2ek"};
$b2el=$fields->{"b2el"};
$b2em=$fields->{"b2em"};
$b2en=$fields->{"b2en"};
$b2eo=$fields->{"b2eo"};
$b2ep=$fields->{"b2ep"};
$b2eq=$fields->{"b2eq"};
$b2er=$fields->{"b2er"};
$b2es=$fields->{"b2es"};
$b2pa=$fields->{"b2pa"};
$b2pb=$fields->{"b2pb"};
$b2pc=$fields->{"b2pc"};
$b2pd=$fields->{"b2pd"};
$b2pe=$fields->{"b2pe"};
$b2pf=$fields->{"b2pf"};
$b2pg=$fields->{"b2pg"};
$b2ph=$fields->{"b2ph"};
$b2pi=$fields->{"b2pi"};
$b2pj=$fields->{"b2pj"};
$b2pk=$fields->{"b2pk"};
$b2pl=$fields->{"b2pl"};
$b2pm=$fields->{"b2pm"};
$b2pn=$fields->{"b2pn"};
$b2po=$fields->{"b2po"};
$b2pp=$fields->{"b2pp"};
$b2pq=$fields->{"b2pq"};
$b2pr=$fields->{"b2pr"};
$b2ps=$fields->{"b2ps"};
$e2e1=$fields->{"e2e1"};
$e2e2=$fields->{"e2e2"};
$e2e3=$fields->{"e2e3"};
$e2e4=$fields->{"e2e4"};
$e2p1=$fields->{"e2p1"};
$e2p2=$fields->{"e2p2"};
$e2p3=$fields->{"e2p3"};
$e2p4=$fields->{"e2p4"};
}
sub good_year
{
my($y)=@_;
return ((length($y) != 0) and (length($y) != 2) and ((length($y) != 4) or ($y < 1900) or ($y > 1999)));
}
sub check_data
{
my($part)=@_;
#radio buttons
$geschlecht_fehlt = (not defined($geschlecht));
$schulab_fehlt = (not defined($schulab));
$bevorzug_fehlt = (not defined($bevorzug));
$partsch_fehlt = (not defined($partsch));
$haushalt_fehlt = (not defined($haushalt));
$pgeschlecht_fehlt = (not defined($pgeschlecht));
$pschulab_fehlt = (not defined($pschulab));
$zufdyn_fehlt = (not defined($zufdyn));
#radio_1 buttons
$einkom_fehlt = (not defined($einkom));
$peinkom_fehlt = (not defined($peinkom));
$konflikt_fehlt = (not defined($konflikt));
$zuforg_fehlt = (not defined($zuforg));
$zufsex_fehlt = (not defined($zufsex));
$zufver_fehlt = (not defined($zufver));
#selections
#selmul
$gayschw_fehlt = good_year($gayschw);
$gbyschw_fehlt = good_year($gbyschw);
$gcyschw_fehlt = good_year($gcyschw);
$gdyschw_fehlt = good_year($gdyschw);
$geyschw_fehlt = good_year($geyschw);
$gfyschw_fehlt = good_year($gfyschw);
$pgayschw_fehlt = good_year($pgayschw);
$pgbyschw_fehlt = good_year($pgbyschw);
$pgcyschw_fehlt = good_year($pgcyschw);
$pgdyschw_fehlt = good_year($pgdyschw);
$pgeyschw_fehlt = good_year($pgeyschw);
$pgfyschw_fehlt = good_year($pgfyschw);
#numeric
$zuordnen_fehlt = (length($zuordnen) < 4);
$geburtsjahr_fehlt = ((length($geburtsjahr) != 2)
and ((length($geburtsjahr) != 4)
or ($geburtsjahr < 1900)
or ($geburtsjahr > 1999)));
$partzeit_fehlt = (length($partzeit) < 1);
$hochzeit_fehlt = (length($hochzeit) < 1);
$pgeburtsjahr_fehlt = ((length($pgeburtsjahr) != 2)
and ((length($pgeburtsjahr) != 4)
or ($pgeburtsjahr < 1900)
or ($pgeburtsjahr > 1999)));
#freetext
$familie_fehlt = (length($familie) < 1);
#part2
$b2ea_fehlt = (not defined($b2ea));
$b2eb_fehlt = (not defined($b2eb));
$b2ec_fehlt = (not defined($b2ec));
$b2ed_fehlt = (not defined($b2ed));
$b2ee_fehlt = (not defined($b2ee));
$b2ef_fehlt = (not defined($b2ef));
$b2eg_fehlt = (not defined($b2eg));
$b2eh_fehlt = (not defined($b2eh));
$b2ei_fehlt = (not defined($b2ei));
$b2ej_fehlt = (not defined($b2ej));
$b2ek_fehlt = (not defined($b2ek));
$b2el_fehlt = (not defined($b2el));
$b2em_fehlt = (not defined($b2em));
$b2en_fehlt = (not defined($b2en));
$b2eo_fehlt = (not defined($b2eo));
$b2ep_fehlt = (not defined($b2ep));
$b2eq_fehlt = (not defined($b2eq));
$b2er_fehlt = (not defined($b2er));
$b2es_fehlt = (not defined($b2es));
$b2pa_fehlt = (not defined($b2pa));
$b2pb_fehlt = (not defined($b2pb));
$b2pc_fehlt = (not defined($b2pc));
$b2pd_fehlt = (not defined($b2pd));
$b2pe_fehlt = (not defined($b2pe));
$b2pf_fehlt = (not defined($b2pf));
$b2pg_fehlt = (not defined($b2pg));
$b2ph_fehlt = (not defined($b2ph));
$b2pi_fehlt = (not defined($b2pi));
$b2pj_fehlt = (not defined($b2pj));
$b2pk_fehlt = (not defined($b2pk));
$b2pl_fehlt = (not defined($b2pl));
$b2pm_fehlt = (not defined($b2pm));
$b2pn_fehlt = (not defined($b2pn));
$b2po_fehlt = (not defined($b2po));
$b2pp_fehlt = (not defined($b2pp));
$b2pq_fehlt = (not defined($b2pq));
$b2pr_fehlt = (not defined($b2pr));
$b2ps_fehlt = (not defined($b2ps));
$e2e1_fehlt = (not defined($e2e1));
$e2e2_fehlt = (not defined($e2e2));
$e2e3_fehlt = (not defined($e2e3));
$e2e4_fehlt = (not defined($e2e4));
$e2p1_fehlt = (not defined($e2p1));
$e2p2_fehlt = (not defined($e2p2));
$e2p3_fehlt = (not defined($e2p3));
$e2p4_fehlt = (not defined($e2p4));
if ($part == 1) {
if ( $zuordnen_fehlt or
$geburtsjahr_fehlt or
$geschlecht_fehlt or
$schulab_fehlt or
$einkom_fehlt or
$peinkom_fehlt or
$gayschw_fehlt or
$gbyschw_fehlt or
$gcyschw_fehlt or
$gdyschw_fehlt or
$geyschw_fehlt or
$gfyschw_fehlt or
$familie_fehlt or
$bevorzug_fehlt or
$konflikt_fehlt or
$partsch_fehlt or
$partzeit_fehlt or
$haushalt_fehlt or
$hochzeit_fehlt or
$pgeburtsjahr_fehlt or
$pgeschlecht_fehlt or
$pschulab_fehlt or
$pgayschw_fehlt or
$pgbyschw_fehlt or
$pgcyschw_fehlt or
$pgdyschw_fehlt or
$pgeyschw_fehlt or
$pgfyschw_fehlt or
$zuforg_fehlt or
$zufsex_fehlt or
$zufver_fehlt)
{
return 1;
}
} else {
if ( $b2ea_fehlt or
$b2eb_fehlt or
$b2ec_fehlt or
$b2ed_fehlt or
$b2ee_fehlt or
$b2ef_fehlt or
$b2eg_fehlt or
$b2eh_fehlt or
$b2ei_fehlt or
$b2ej_fehlt or
$b2ek_fehlt or
$b2el_fehlt or
$b2em_fehlt or
$b2en_fehlt or
$b2eo_fehlt or
$b2ep_fehlt or
$b2eq_fehlt or
$b2er_fehlt or
$b2es_fehlt or
$b2pa_fehlt or
$b2pb_fehlt or
$b2pc_fehlt or
$b2pd_fehlt or
$b2pe_fehlt or
$b2pf_fehlt or
$b2pg_fehlt or
$b2ph_fehlt or
$b2pi_fehlt or
$b2pj_fehlt or
$b2pk_fehlt or
$b2pl_fehlt or
$b2pm_fehlt or
$b2pn_fehlt or
$b2po_fehlt or
$b2pp_fehlt or
$b2pq_fehlt or
$b2pr_fehlt or
$b2ps_fehlt or
$e2e1_fehlt or
$e2e2_fehlt or
$e2e3_fehlt or
$e2e4_fehlt or
$e2p1_fehlt or
$e2p2_fehlt or
$e2p3_fehlt or
$e2p4_fehlt)
{
return 1;
}
}
return 0;
}
sub make_mail
{
my($part)=@_;
my (@body);
@body=(
"TIME.LOG (".$starttime." .. ".gmtime().")\n",
"ZUORDNEN: ", $zuordnen."\n",
"GEBURTSJAHR: ", $geburtsjahr."\n",
"GESCHLECHT: ", $geschlecht."\n",
"SCHULABSCHL.:", $schulab."\n",
"EINKOMMEN: ", $einkom."\n",
"GESCHWISTER1:", $gaschw.", ".$gayschw."\n",
"GESCHWISTER2:", $gbschw.", ".$gbyschw."\n",
"GESCHWISTER3:", $gcschw.", ".$gcyschw."\n",
"GESCHWISTER4:", $gdschw.", ".$gdyschw."\n",
"GESCHWISTER5:", $geschw.", ".$geyschw."\n",
"GESCHWISTER6:", $gfschw.", ".$gfyschw."\n",
"FAMILIE:\n", $familie."\n\n",
"BEVORZUGUNG: ", $bevorzug."\n",
"KONFLIKT: ", $konflikt."\n",
"MENARCHE: ", $menarche."\n",
"PARTNERDAUER:", $partzeit."\n",
"GEM.HAUSHALT:", $haushalt."\n",
"VERHEIRATET: ", $hochzeit."\n",
"PARTNERSCH.: ", $partsch."\n",
"P-GEBURTSJAHR: ", $pgeburtsjahr."\n",
"P-GESCHLECHT: ", $pgeschlecht."\n",
"P-SCHULABSCHL.:", $pschulab."\n",
"P-EINKOMMEN: ", $peinkom."\n",
"P-GESCHWISTER1:", $pgaschw.", ".$pgayschw."\n",
"P-GESCHWISTER2:", $pgbschw.", ".$pgbyschw."\n",
"P-GESCHWISTER3:", $pgcschw.", ".$pgcyschw."\n",
"P-GESCHWISTER4:", $pgdschw.", ".$pgdyschw."\n",
"P-GESCHWISTER5:", $pgeschw.", ".$pgeyschw."\n",
"P-GESCHWISTER6:", $pgfschw.", ".$pgfyschw."\n",
"ZUFR.ORGANIS.: ", $zuforg."\n",
"ZUFRIEDEN.SEX: ", $zufsex."\n",
"ZUFR.VERSTAEND:", $zufver."\n",
"ZUFR.DYNAMIK.: ", $zufdyn."\n",
"END-OF-PART1\n");
if ($part > 1) {
@body=( @body,
"PERS01.DAZUNEI:", $b2ea."\n",
"PERS02.AUFGABE:", $b2eb."\n",
"PERS03.HILFSBE:", $b2ec."\n",
"PERS04.MANCHMA:", $b2ed."\n",
"PERS05.HAEUFIG:", $b2ee."\n",
"PERS06.ZUVERLA:", $b2ef."\n",
"PERS07.NICHTNA:", $b2eg."\n",
"PERS08.EHERUNO:", $b2eh."\n",
"PERS09.ANDEREN:", $b2ei."\n",
"PERS10.BEQUEMI:", $b2ej."\n",
"PERS11.SICHKAL:", $b2ek."\n",
"PERS12.SOLANGE:", $b2el."\n",
"PERS13.RUECKSI:", $b2em."\n",
"PERS14.TUECHTI:", $b2en."\n",
"PERS15.SICHMAN:", $b2eo."\n",
"PERS16.PLAENEM:", $b2ep."\n",
"PERS17.KOOPERA:", $b2eq."\n",
"PERS18.LEICHTA:", $b2er."\n",
"PERS19.EINGERI:", $b2es."\n",
"PART01.DAZUNEI:", $b2pa."\n",
"PART02.AUFGABE:", $b2pb."\n",
"PART03.HILFSBE:", $b2pc."\n",
"PART04.MANCHMA:", $b2pd."\n",
"PART05.HAEUFIG:", $b2pe."\n",
"PART06.ZUVERLA:", $b2pf."\n",
"PART07.NICHTNA:", $b2pg."\n",
"PART08.EHERUNO:", $b2ph."\n",
"PART09.ANDEREN:", $b2pi."\n",
"PART10.BEQUEMI:", $b2pj."\n",
"PART11.SICHKAL:", $b2pk."\n",
"PART12.SOLANGE:", $b2pl."\n",
"PART13.RUECKSI:", $b2pm."\n",
"PART14.TUECHTI:", $b2pn."\n",
"PART15.SICHMAN:", $b2po."\n",
"PART16.PLAENEM:", $b2pp."\n",
"PART17.KOOPERA:", $b2pq."\n",
"PART18.LEICHTA:", $b2pr."\n",
"PART19.EINGERI:", $b2ps."\n",
"EINSTEGO1.HOMO:", $e2e1."\n",
"EINSTEGO3.FRAU:", $e2e3."\n",
"EINSTEGO4.EURO:", $e2e4."\n",
"EINSTEGO2.DROG:", $e2e2."\n",
"EINSTPRT1.HOMO:", $e2p1."\n",
"EINSTPRT3.FRAU:", $e2p3."\n",
"EINSTPRT4.EURO:", $e2p4."\n",
"EINSTPRT2.DROG:", $e2p2."\n",
"BEMERKUNG:\n", $bemerk."\n\n",
"END-OF-MAIL\n");
}
return @body;
}
sub prform
{
my($f)=@_;
$fehlfarben=$f;
formhead();
prfehl($geburtsjahr_fehlt);
form_num("In welchem Jahr sind Sie geboren?","Geburtsjahr",4,$geburtsjahr,50,15,"center");
prfehl($geschlecht_fehlt);
form_radio(50,"Geschlecht",$geschlecht,"Welches Geschlecht haben Sie?");
one_radio("weiblich","weiblich");
one_radio("männlich","maennlich");
end_radio();
prfehl($schulab_fehlt);
form_radio(50,"Schulab",$schulab,"Welches ist Ihr höchster Schulabschluss?");
one_radio("Hauptschule","hauptschule");
one_radio("Realschule","realschule");
one_radio("Abitur","abitur");
one_radio("Hochschule, nicht abgeschlossen","nichtabghochschule");
one_radio("Hochschule, abgeschlossen","abghochschule");
end_radio();
prfehl($einkom_fehlt);
form_radio_1(7,"Einkommen",$einkom,"Wie hoch sind Ihre Einkommensverhältnisse?
Bitte kreuzen Sie auf der Skala an: von 1 = sehr gering bis 7 = sehr hoch.");
one_radio_1("1
sehr gering",1);
one_radio_1(2,2);
one_radio_1(3,3);
one_radio_1(4,4);
one_radio_1(5,5);
one_radio_1(6,6);
one_radio_1("7
sehr hoch",7);
end_radio_1();
prfehl($gayschw_fehlt or $gbyschw_fehlt or $gcyschw_fehlt or $gdyschw_fehlt or $geyschw_fehlt or $gfyschw_fehlt);
form_selmul("Bitte zählen Sie der Reihe nach die Geschwister auf, mit denen Sie gemeinsam aufgewachsen sind. Wählen Sie dazu im linken Feld für jedes einzelne Ihrer Geschwister aus, um welche Geschwisterart es sich dabei handelt, und tragen Sie im rechten Feld das entsprechende Geburtsjahr ein.",
"gaschw","gayschw",$gayschw,%sel_gaschw);
geschw_selmul();
next_selmul("gbschw","gbyschw",$gbyschw,%sel_gbschw);
geschw_selmul();
next_selmul("gcschw","gcyschw",$gcyschw,%sel_gcschw);
geschw_selmul();
next_selmul("gdschw","gdyschw",$gdyschw,%sel_gdschw);
geschw_selmul();
next_selmul("geschw","geyschw",$geyschw,%sel_geschw);
geschw_selmul();
next_selmul("gfschw","gfyschw",$gfyschw,%sel_gfschw);
geschw_selmul();
end_selmul();
prfehl($familie_fehlt);
form_free("Bitte beschreiben Sie kurz, wann Sie mit welchen Personen in Ihrer Kindheit (bis zum 14. Lebensjahr) eng zusammengelebt haben und wann es möglicherweise Verluste von engen Familienmitgliedern gab.
".
"Beispiel 1:
".
"- bis 1943 mit Bruder und Eltern zusammen
".
"- 1943 Bruder gestorben
".
"Beispiel 2:
".
"- bis 1964 mit Eltern zusammen
".
"- 1964 Geburt meiner Schwester
".
"- 1965 Scheidung der Eltern, Vater zog aus
".
"- 1968 Mutter heiratete wieder
".
"- 1969 Geburt meiner Halbschwester
",
"Familie",16,50,$familie);
prfehl($bevorzug_fehlt);
form_radio(50,"Bevorzug",$bevorzug,"Haben Sie das Gefühl, dass Sie im Vergleich zu Ihren Geschwistern von Ihren Eltern bevorzugt wurden?");
one_radio("ja","ja");
one_radio("nein","nein");
one_radio("bin Einzelkind","einzelkind");
end_radio();
prfehl($konflikt_fehlt);
form_radio_1(5,"Konflikt",$konflikt,"Hatten Sie während Ihrer Kindheit oder Jugend stärkere Konflikte mit Ihren Eltern?
Bitte kreuzen Sie an, was Sie für sich zutreffend finden, von 1 = nie stärkere Konflikte bis 5 = sehr häufig stärkere Konflikte.");
one_radio_1("1
nie",1);
one_radio_1("2
selten",2);
one_radio_1("3
manchmal",3);
one_radio_1("4
oft",4);
one_radio_1("5
sehr häufig",5);
end_radio_1();
form_num("Nur für Frauen: In welchem Alter hatten Sie Ihre Menarche (Ihre erste Monatsblutung)?
Bitte auf den Monat genau angeben (z.B. \"13 Jahre und 4 Monate\").","Menarche",42,$menarche,50,50,"center");
prfehl($partzeit_fehlt);
form_num("Wie lange sind Sie schon bzw. waren Sie mit Ihrem Partner/Ihrer Partnerin zusammen? Angabe in Monaten oder Jahren möglich (z.B. 10 Monate, 3 1/2 Jahre, 25 Jahre).","Partzeit",24,$partzeit,50,25,"center");
prfehl($haushalt_fehlt);
form_radio(50,"Haushalt",$haushalt,"Leben oder lebten Sie mit Ihrem Partner/Ihrer Partnerin zusammen in einem gemeinsamen Haushalt?");
one_radio("ja","ja");
one_radio("nein","nein");
one_radio("zeitweise","zeitweise");
end_radio();
prfehl($hochzeit_fehlt);
form_num("Wie lange sind Sie schon bzw. waren Sie mit Ihrem Partner/Ihrer Partnerin verheiratet? Angabe in Monaten oder Jahren möglich (z.B. 8 Monate, 2 1/2 Jahre, 20 Jahre, gar nicht).","Hochzeit",24,$hochzeit,50,25,"center");
prfehl($partsch_fehlt);
form_radio(50,"Partsch",$partsch,"Sind Sie mit diesem Partner/dieser Partnerin noch zusammen?");
one_radio("ja","ja");
one_radio("nein","nein");
end_radio();
if ($az) {
print "
Sie haben jetzt schon mehr als die Hälfte des Fragebogens ausgefüllt!
Nun geht es um Angaben zu Ihrem derzeitigen bzw. letzten Partner/Ihrer derzeitigen bzw. letzten Partnerin:
";
}
prfehl($pgeburtsjahr_fehlt);
form_num("In welchem Jahr ist Ihr Partner/Ihre Partnerin geboren?","pGeburtsjahr",4,$pgeburtsjahr,50,15,"center");
prfehl($pgeschlecht_fehlt);
form_radio(50,"pGeschlecht",$pgeschlecht,"Welches Geschlecht hat Ihr Partner/Ihre Partnerin?");
one_radio("weiblich","weiblich");
one_radio("männlich","maennlich");
end_radio();
prfehl($pschulab_fehlt);
form_radio(50,"pSchulab",$pschulab,"Welches ist der höchste Schulabschluss Ihres Partners/Ihrer Partnerin?");
one_radio("Hauptschule","hauptschule");
one_radio("Realschule","realschule");
one_radio("Abitur","abitur");
one_radio("Hochschule, nicht abgeschlossen","nichtabghochschule");
one_radio("Hochschule, abgeschlossen","abghochschule");
end_radio();
prfehl($peinkom_fehlt);
form_radio_1(7,"pEinkommen",$peinkom,"Wie hoch sind die Einkommensverhältnisse Ihres Partners/Ihrer Partnerin?
Bitte kreuzen Sie auf der Skala an: von 1 = sehr gering bis 7 = sehr hoch.");
one_radio_1("1
sehr gering",1);
one_radio_1(2,2);
one_radio_1(3,3);
one_radio_1(4,4);
one_radio_1(5,5);
one_radio_1(6,6);
one_radio_1("7
sehr hoch",7);
end_radio_1();
prfehl($pgayschw_fehlt or $pgbyschw_fehlt or $pgcyschw_fehlt or $pgdyschw_fehlt or $pgeyschw_fehlt or $pgfyschw_fehlt);
form_selmul("Bitte zählen Sie der Reihe nach die Geschwister auf, mit denen Ihr Partner/Ihre Partnerin gemeinsam aufgewachsen ist. Wählen Sie bitte auch hier wieder die Art des Geschwisters aus und geben Sie das entsprechende Geburtsjahr ein, oder schätzen Sie es bitte.",
"pgaschw","pgayschw",$pgayschw,%sel_pgaschw);
geschw_selmul();
next_selmul("pgbschw","pgbyschw",$pgbyschw,%sel_pgbschw);
geschw_selmul();
next_selmul("pgcschw","pgcyschw",$pgcyschw,%sel_pgcschw);
geschw_selmul();
next_selmul("pgdschw","pgdyschw",$pgdyschw,%sel_pgdschw);
geschw_selmul();
next_selmul("pgeschw","pgeyschw",$pgeyschw,%sel_pgeschw);
geschw_selmul();
next_selmul("pgfschw","pgfyschw",$pgfyschw,%sel_pgfschw);
geschw_selmul();
end_selmul();
if ($az) {
print "
Wie zufrieden sind bzw. waren Sie mit Ihrem Partner/Ihrer Partnerin?
Bitte kreuzen Sie auf den folgenden drei Skalen jeweils von 1 (sehr unzufrieden) bis 7 (sehr zufrieden) an:
";
}
prfehl($zuforg_fehlt);
form_radio_1(7,"Zuforg",$zuforg,"Zufriedenheit mit der Organisation des Alltags (Arbeitsteilung, Zeitpläne, Kinderversorgung etc.)");
one_radio_1("1
sehr unzufrieden",1);
one_radio_1(2,2);
one_radio_1(3,3);
one_radio_1(4,4);
one_radio_1(5,5);
one_radio_1(6,6);
one_radio_1("7
sehr zufrieden",7);
end_radio_1();
prfehl($zufsex_fehlt);
form_radio_1(7,"Zufsex",$zufsex,"Zufriedenheit mit der sexuellen Beziehung (Erfülltheit, Häufigkeit, Abwechslung etc.)");
one_radio_1("1
sehr unzufrieden",1);
one_radio_1(2,2);
one_radio_1(3,3);
one_radio_1(4,4);
one_radio_1(5,5);
one_radio_1(6,6);
one_radio_1("7
sehr zufrieden",7);
end_radio_1();
prfehl($zufver_fehlt);
form_radio_1(7,"Zufver",$zufver,"Zufriedenheit mit dem gegenseitigen Verständnis (Gespräche, Aufmerksamkeit, Unterstützung etc.)");
one_radio_1("1
sehr unzufrieden",1);
one_radio_1(2,2);
one_radio_1(3,3);
one_radio_1(4,4);
one_radio_1(5,5);
one_radio_1(6,6);
one_radio_1("7
sehr zufrieden",7);
end_radio_1();
if ($az) {
print "
Wie bewerten Sie insgesamt die Zufriedenheit mit Ihrer Partnerschaft über die Zeitspanne Ihrer Beziehungsdauer hinweg?
\nBitte kreuzen Sie die Antwort an, die Ihrer Meinung nach am ehesten zutrifft:\n";
}
prfehl($zufdyn_fehlt);
form_radio(50,"zufdyn",$zufdyn,"Die Zufriedenheit mit meiner Partnerschaft...");
one_radio("...nahm allmählich immer mehr zu.","steigend");
one_radio("...nahm allmählich immer mehr ab.","fallend");
one_radio("...blieb über die Zeit immer gleich.","konstant");
one_radio("...kann am besten als Auf und Ab beschrieben werden.","zickzack");
end_radio();
if ($az) {
print "
Die letzte Frage soll der anonymen Fragebogenzuordnung des Partners dienen:\n";
}
prfehl($zuordnen_fehlt);
form_num("Tragen Sie bitte in das nebenstehende Feld die Anfangsbuchstaben der Vornamen folgender vier Personen hintereinander ein, und zwar:
".
"- Ihrer Mutter,
".
"- der Mutter Ihres Partners/Ihrer Partnerin,
".
"- Ihres Vaters,
".
"- des Vaters Ihres Partners/Ihrer Partnerin.
\n".
"Falls Ihnen ein Name unbekannt ist, tragen Sie statt dessen bitte jeweils ein Fragezeichen ein.","zuordnen",4,$zuordnen,75,25,"left");
formtail("Continue","Vielen Dank!","Es folgt Teil 2");
}
sub prform2
{
my($f)=@_;
$az=0;
prform(0);
$az=1;
$fehlfarben=$f;
print <<"EOT";
Inwieweit treffen die folgenden Aussagen auf Sie zu?
Bitte kreuzen Sie auf der jeweiligen Skala von 1 bis 5 an,
wie treffend jede Aussage für Sie persönlich ist,
von 1 = sehr unzutreffend bis 5 = sehr zutreffend.
\n"; } } sub prdanke { print <<"EOT";
Für die Unterstützung danke ich
Prof. Harald A. Euler
und
Sabine Hoier
Sie können diesen Fragebogen auch herunterladen
und ausdrucken: PDF-Dokument
Haben Sie noch Fragen? Schreiben Sie bitte an: konstanze-schirmer\@sample.xxx