#!/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&auml;nnlich","maennlich");
	end_radio();
	prfehl($schulab_fehlt);
	form_radio(50,"Schulab",$schulab,"Welches ist Ihr h&ouml;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&auml;ltnisse?<br>Bitte kreuzen Sie auf der Skala an: von 1 = sehr gering bis 7 = sehr hoch.");
		one_radio_1("1<br>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<br>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&auml;hlen Sie der Reihe nach die Geschwister auf, mit denen Sie gemeinsam aufgewachsen sind. W&auml;hlen Sie dazu im linken Feld f&uuml;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 <u>kurz</u>, wann Sie mit welchen Personen in Ihrer Kindheit (bis zum 14. Lebensjahr) eng zusammengelebt haben und wann es m&ouml;glicherweise Verluste von engen Familienmitgliedern gab.<br>".
		"Beispiel 1:<br>".
		"- bis 1943 mit Bruder und Eltern zusammen<br>".
		"- 1943 Bruder gestorben<br>".
		"Beispiel 2:<br>".
		"- bis 1964 mit Eltern zusammen<br>".
		"- 1964 Geburt meiner Schwester<br>".
		"- 1965 Scheidung der Eltern, Vater zog aus<br>".
		"- 1968 Mutter heiratete wieder<br>".
		"- 1969 Geburt meiner Halbschwester<br>",
		"Familie",16,50,$familie);
	prfehl($bevorzug_fehlt);
	form_radio(50,"Bevorzug",$bevorzug,"Haben Sie das Gef&uuml;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&auml;hrend Ihrer Kindheit oder Jugend st&auml;rkere Konflikte mit Ihren Eltern?<br>Bitte kreuzen Sie an, was Sie f&uuml;r sich zutreffend finden, von 1 = nie st&auml;rkere Konflikte bis 5 = sehr h&auml;ufig st&auml;rkere Konflikte.");
		one_radio_1("1<br>nie",1);
		one_radio_1("2<br>selten",2);
		one_radio_1("3<br>manchmal",3);
		one_radio_1("4<br>oft",4);
		one_radio_1("5<br>sehr h&auml;ufig",5);
	end_radio_1();
	form_num("<b>Nur für Frauen:</b> In welchem Alter hatten Sie Ihre Menarche (Ihre erste Monatsblutung)?<br>Bitte auf den Monat genau angeben (z.B. \"13&nbsp;Jahre und 4&nbsp;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&ouml;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&ouml;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 "
<p>
Sie haben jetzt schon mehr als die H&auml;lfte des Fragebogens ausgef&uuml;llt!
<br>
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&auml;nnlich","maennlich");
	end_radio();
	prfehl($pschulab_fehlt);
	form_radio(50,"pSchulab",$pschulab,"Welches ist der h&ouml;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&auml;ltnisse Ihres Partners/Ihrer Partnerin?<br>Bitte kreuzen Sie auf der Skala an: von 1 = sehr gering bis 7 = sehr hoch.");
		one_radio_1("1<br>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<br>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&auml;hlen Sie der Reihe nach die Geschwister auf, mit denen Ihr Partner/Ihre Partnerin gemeinsam aufgewachsen ist. W&auml;hlen Sie bitte auch hier wieder die Art des Geschwisters aus und geben Sie das entsprechende Geburtsjahr ein, oder sch&auml;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 "
<p>
Wie zufrieden sind bzw. waren Sie mit Ihrem Partner/Ihrer Partnerin?
<br>
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&auml;ne, Kinderversorgung etc.)");
		one_radio_1("1<br>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<br>sehr zufrieden",7);
	end_radio_1();
	prfehl($zufsex_fehlt);
	form_radio_1(7,"Zufsex",$zufsex,"Zufriedenheit mit der sexuellen Beziehung (Erf&uuml;lltheit, H&auml;ufigkeit, Abwechslung etc.)");
		one_radio_1("1<br>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<br>sehr zufrieden",7);
	end_radio_1();
	prfehl($zufver_fehlt);
	form_radio_1(7,"Zufver",$zufver,"Zufriedenheit mit dem gegenseitigen Verst&auml;ndnis (Gespr&auml;che, Aufmerksamkeit, Unterst&uuml;tzung etc.)");
		one_radio_1("1<br>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<br>sehr zufrieden",7);
	end_radio_1();
	if ($az) {
		print "<p>Wie bewerten Sie insgesamt die Zufriedenheit mit Ihrer Partnerschaft &uuml;ber die Zeitspanne Ihrer Beziehungsdauer hinweg?<br>\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&auml;hlich immer mehr zu.","steigend");
		one_radio("...nahm allm&auml;hlich immer mehr ab.","fallend");
		one_radio("...blieb &uuml;ber die Zeit immer gleich.","konstant");
		one_radio("...kann am besten als Auf und Ab beschrieben werden.","zickzack");
	end_radio();

	if ($az) {
		print "<p>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:<br>".
	"- Ihrer Mutter,<br>".
	"- der Mutter Ihres Partners/Ihrer Partnerin,<br>".
	"- Ihres Vaters,<br>".
	"- des Vaters Ihres Partners/Ihrer Partnerin.<br>\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?<br>
Bitte kreuzen Sie auf der jeweiligen Skala von 1 bis 5 an,
wie treffend jede Aussage f&uuml;r Sie pers&ouml;nlich ist,
von&nbsp;1&nbsp;=&nbsp;sehr unzutreffend bis 5&nbsp;=&nbsp;sehr zutreffend.<br>
<table width="100%" cellspacing=0 cellpadding=4 border=0 cols=6 bgcolor=#F0F0F0>
EOT
	scale_radio_5_all(1,"<b>Ich halte mich f&uuml;r jemanden, der...</b>");
	form_radio_5(0,$b2ea_fehlt,"b2ea",$b2ea,"...dazu neigt, andere zu kritisieren.");
	form_radio_5(1,$b2eb_fehlt,"b2eb",$b2eb,"...Aufgaben gr&uuml;ndlich erledigt.");
	form_radio_5(0,$b2ec_fehlt,"b2ec",$b2ec,"...hilfsbereit und selbstlos gegen&uuml;ber anderen ist.");
	form_radio_5(1,$b2ed_fehlt,"b2ed",$b2ed,"...manchmal etwas nachl&auml;ssig ist.");
	form_radio_5(0,$b2ee_fehlt,"b2ee",$b2ee,"...h&auml;ufig Streitereien mit anderen beginnt.");
	form_radio_5(1,$b2ef_fehlt,"b2ef",$b2ef,"...zuverl&auml;ssig und gewissenhaft arbeitet.");
	form_radio_5(0,$b2eg_fehlt,"b2eg",$b2eg,"...nicht nachtragend ist, anderen leicht vergibt.");
	form_radio_5(1,$b2eh_fehlt,"b2eh",$b2eh,"...eher unordentlich ist.");
	form_radio_5(0,$b2ei_fehlt,"b2ei",$b2ei,"...anderen Vertrauen schenkt, an das Gute im Menschen glaubt.");
	form_radio_5(1,$b2ej_fehlt,"b2ej",$b2ej,"...bequem ist, zur Faulheit neigt.");
	form_radio_5(0,$b2ek_fehlt,"b2ek",$b2ek,"...sich kalt und distanziert verhalten kann.");
	scale_radio_5_all(0,"");
	form_radio_5(0,$b2el_fehlt,"b2el",$b2el,"...solange an einer Aufgabe arbeitet, bis sie erledigt ist, auch wenn dies noch so lange dauert.");
	form_radio_5(1,$b2em_fehlt,"b2em",$b2em,"...r&uuml;cksichtsvoll und freundlich gegen&uuml;ber anderen ist.");
	form_radio_5(0,$b2en_fehlt,"b2en",$b2en,"...t&uuml;chtig ist und flott arbeitet.");
	form_radio_5(1,$b2eo_fehlt,"b2eo",$b2eo,"...sich manchmal schroff und abweisend gegen&uuml;ber anderen verh&auml;lt.");
	form_radio_5(0,$b2ep_fehlt,"b2ep",$b2ep,"...Pl&auml;ne macht und diese dann auch durchf&uuml;hrt.");
	form_radio_5(1,$b2eq_fehlt,"b2eq",$b2eq,"...kooperativ ist, die Zusammenarbeit dem Wettbewerb vorzieht.");
	form_radio_5(0,$b2er_fehlt,"b2er",$b2er,"...leicht ablenkbar ist, nicht bei der Sache bleibt.");
	form_radio_5(1,$b2es_fehlt,"b2es",$b2es,"...ein geringes Selbstwertgef&uuml;hl hat.");
	et();
	form_lastquest($e2e1_fehlt,"e2e1",$e2e1,"Wie f&auml;nden Sie es, wenn homosexuelle Paare Kinder adoptieren k&ouml;nnten?");
	form_lastquest($e2e3_fehlt,"e2e3",$e2e3,"Wenn z.B. der brasilianische Fu&szlig;ballverband beschlossen h&auml;tte, zur n&auml;chsten Weltmeisterschaft mit einer hochqualifizierten Frauen-Fu&szlig;ballmannschaft anzutreten, wie w&uuml;rden Sie das finden?");
	form_lastquest($e2e4_fehlt,"e2e4",$e2e4,"Wie würden Sie es finden, wenn die Staaten innerhalb der EU abgeschafft w&uuml;rden und es statt dessen einen einzigen Gesamtstaat \"Europa\" g&auml;be?");
	form_lastquest($e2e2_fehlt,"e2e2",$e2e2,"Wie w&auml;re es Ihrer Meinung nach, wenn die Droge Marihuana (Haschisch) als legal freigegeben werden w&uuml;rde?");

	print <<"EOT";
<p>
Die H&auml;lfte des 2.&nbsp;Teils haben Sie jetzt schon ausgef&uuml;llt;
nun kommt der letzte Abschnitt:
<p>
Wie sch&auml;tzen Sie Ihren
<u>derzeitigen bzw. letzten Partner/Ihre Partnerin</u> ein?<br>
Bitte kreuzen Sie auf der jeweiligen Skala von 1 bis 5 an,
wie sehr jede Aussage auf Ihren Partner/Ihre Partnerin zutrifft,
von&nbsp;1&nbsp;=&nbsp;sehr unzutreffend bis 5&nbsp;=&nbsp;sehr zutreffend.<br>
<table width="100%" cellspacing=0 cellpadding=4 border=0 cols=6 bgcolor=#F0F0F0>
EOT
	scale_radio_5_all(1,"<b>Ich halte meinen Partner/meine Partnerin f&uuml;r jemanden, der/die...</b>");
	form_radio_5(0,$b2pa_fehlt,"b2pa",$b2pa,"...dazu neigt, andere zu kritisieren.");
	form_radio_5(1,$b2pb_fehlt,"b2pb",$b2pb,"...Aufgaben gr&uuml;ndlich erledigt.");
	form_radio_5(0,$b2pc_fehlt,"b2pc",$b2pc,"...hilfsbereit und selbstlos gegen&uuml;ber anderen ist.");
	form_radio_5(1,$b2pd_fehlt,"b2pd",$b2pd,"...manchmal etwas nachl&auml;ssig ist.");
	form_radio_5(0,$b2pe_fehlt,"b2pe",$b2pe,"...h&auml;ufig Streitereien mit anderen beginnt.");
	form_radio_5(1,$b2pf_fehlt,"b2pf",$b2pf,"...zuverl&auml;ssig und gewissenhaft arbeitet.");
	form_radio_5(0,$b2pg_fehlt,"b2pg",$b2pg,"...nicht nachtragend ist, anderen leicht vergibt.");
	form_radio_5(1,$b2ph_fehlt,"b2ph",$b2ph,"...eher unordentlich ist.");
	form_radio_5(0,$b2pi_fehlt,"b2pi",$b2pi,"...anderen Vertrauen schenkt, an das Gute im Menschen glaubt.");
	form_radio_5(1,$b2pj_fehlt,"b2pj",$b2pj,"...bequem ist, zur Faulheit neigt.");
	form_radio_5(0,$b2pk_fehlt,"b2pk",$b2pk,"...sich kalt und distanziert verhalten kann.");
	scale_radio_5_all(0,"");
	form_radio_5(0,$b2pl_fehlt,"b2pl",$b2pl,"...solange an einer Aufgabe arbeitet, bis sie erledigt ist, auch wenn dies noch so lange dauert.");
	form_radio_5(1,$b2pm_fehlt,"b2pm",$b2pm,"...r&uuml;cksichtsvoll und freundlich gegen&uuml;ber anderen ist.");
	form_radio_5(0,$b2pn_fehlt,"b2pn",$b2pn,"...t&uuml;chtig ist und flott arbeitet.");
	form_radio_5(1,$b2po_fehlt,"b2po",$b2po,"...sich manchmal schroff und abweisend gegen&uuml;ber anderen verh&auml;lt.");
	form_radio_5(0,$b2pp_fehlt,"b2pp",$b2pp,"...Pl&auml;ne macht und diese dann auch durchf&uuml;hrt.");
	form_radio_5(1,$b2pq_fehlt,"b2pq",$b2pq,"...kooperativ ist, die Zusammenarbeit dem Wettbewerb vorzieht.");
	form_radio_5(0,$b2pr_fehlt,"b2pr",$b2pr,"...leicht ablenkbar ist, nicht bei der Sache bleibt.");
	form_radio_5(1,$b2ps_fehlt,"b2ps",$b2ps,"...ein geringes Selbstwertgef&uuml;hl hat.");
	et();
	print <<"EOT";
<p>
Versetzen Sie sich abschlie&szlig;end noch einmal
in die Person Ihres derzeitigen bzw. letzten Partners/Ihrer Partnerin
und beantworten Sie bitte die letzten vier Fragen:
EOT
	form_lastquest($e2p1_fehlt,"e2p1",$e2p1,"Wie w&uuml;rde es Ihr Partner/Ihre Partnerin finden, wenn homosexuelle Paare Kinder adoptieren k&ouml;nnten?");
	form_lastquest($e2p3_fehlt,"e2p3",$e2p3,"Wenn z.B. der brasilianische Fu&szlig;ballverband beschlossen h&auml;tte, zur n&auml;chsten Weltmeisterschaft mit einer hochqualifizierten Frauen-Fu&szlig;ballmannschaft anzutreten, wie w&uuml;rde Ihr Partner/Ihre Partnerin das finden?");
	form_lastquest($e2p4_fehlt,"e2p4",$e2p4,"Wie würde Ihr Partner/Ihre Partnerin es finden, wenn die Staaten innerhalb der EU abgeschafft w&uuml;rden und es statt dessen einen einzigen Gesamtstaat \"Europa\" g&auml;be?");
	form_lastquest($e2p2_fehlt,"e2p2",$e2p2,"Wie w&auml;re es der Meinung Ihres Partners/Ihrer Partnerin nach, wenn die Droge Marihuana (Haschisch) als legal freigegeben werden w&uuml;rde?");

	form_free("Hier k&ouml;nnen Sie Bemerkungen eintragen, wenn Sie m&ouml;chten:",
		"Bemerkung",3,50,$bemerk);

	formtail("Cont2","<b>Ganz wichtig:</b>","<p>Herzlichen Dank f&uuml;r Ihre Mitarbeit!");
}


$request_type=$ENV{REQUEST_METHOD};
$mail_recipient="schirmer-kd-cgi\@sample.xxx";
$mail_sender="schirmer-kd-auto\@sample.xxx";
$mail_subject1="Fragebogen eins";
$mail_subject2="Fragebogen zwei";
$cgifile="./kd.cgi";
$logfile="./kd.log";

init_fields();
if ($request_type eq "GET")
{
	$starttime = gmtime();
	prhead("Fragebogen");
	prtext();
	prform(0);
	prtail();
	exit(0);
} elsif ($request_type eq "POST")
{
	read STDIN, $query, $ENV{CONTENT_LENGTH} or do {
		print "FATAL ERROR kd.cgi: cannot read formular (POST).\n";
		exit(2);
	};
	if (0) {
		print "Raw input data:\n<br>$query\n<br>\n";
	}
	$fields=query2fields($query);
	$continue=defined($x=$fields->{"Continue"})?$x:undef;
	$cont2=defined($x=$fields->{"Cont2"})?$x:undef;
	get_fields();
	if (defined($continue)) {
		if (check_data(1)) {
			prhead("Fragebogen, bitte vervollst&auml;ndigen");
			prcheck();
			prform(1);
			prtail();
			exit(0);
		}
		@mail_body=make_mail(1);
		open (LOG, ">>$logfile") or warn "logfile: can't open $logfile";
		foreach my $line (@mail_body) {
			print LOG "$line";
		}
		close LOG or warn "logfile: can't close $logfile";
		if (send_mail($mail_recipient, $mail_sender, $mail_subject1, @mail_body)) {
			print "Die &Uuml;bermittlung des Fragebogens hat wegen eines technischen Fehlers nicht geklappt.<br>Tut mir leid.\n";
			exit(4);
		}
		prhead("Fragebogen, Teil 2");
		prtext2();
		prform2(0);
		prtail();
		exit(0);
	}
	elsif (defined($cont2)) {
		if (check_data(2)) {
			prhead("Fragebogen Teil 2, bitte vervollst&auml;ndigen");
			prcheck();
			prform2(1);
			prtail();
			exit(0);
		}
		@mail_body=make_mail(2);
		open (LOG, ">>$logfile") or warn "logfile: can't open $logfile";
		foreach my $line (@mail_body) {
			print LOG "$line";
		}
		close LOG or warn "logfile: can't close $logfile";
		if (send_mail($mail_recipient, $mail_sender, $mail_subject2, @mail_body)) {
			print "Die &Uuml;bermittlung des Fragebogens hat wegen eines technischen Fehlers nicht geklappt.<br>Tut mir leid.\n";
			exit(4);
		}

		prhead("Fragebogen fertig!");
		prdanke();
		prtail();
		exit(0);
	}
}
exit(1);

# param: frame_title
sub prhead
{
	my($title)=@_;
	print <<"EOT";
<!DOCTYPE HTML>
<html>
<head>
<title>$title</title>
<META http-equiv="content-type" content="text/html; charset=iso-8859-1">
<META name="description" content="Fragebogen zu Geburtenrang und Partnerwahl">
<META name="keywords" content="Geburtenrang Partner Partnerwahl Geschlecht Sex Fragebogen">
</head>
<body text=#000000 bgcolor=#e0e0e0 link=#0000ee vlink=#000088 alink=#000088>
EOT
}

sub prtext
{
	print <<"EOT";
<center>
Untersuchung zum Thema<br>
<b><h2>Geschwister und Partnerwahl</h2></b><br>
<b><i><h3>Wollen Sie mitmachen?</h3></i></b><br>
Hier k&ouml;nnen Sie einen interessanten Fragebogen ausf&uuml;llen,
der im Fachbereich Psychologie
an der Universit&auml;t Kassel unter der Leitung von
Prof.&nbsp;Harald&nbsp;A.&nbsp;Euler
durchgef&uuml;hrt wird und rein wissenschaftlichen Zwecken dient.
</center>
<ul>
<li> <b>Teilnehmer</b>:
Erwachsene, die in einer Partnerschaft leben
oder gelebt haben.
<li> <b>Anonymit&auml;t</b>:
Es wird keine Adresse o.&auml;. erfragt,
und da der Fragebogen auf Perl basiert statt auf Java,
besteht keine direkte Verbindung zu Ihrem Computer.
<li> <b>Dauer</b>:
ca. 12 Minuten f&uuml;r den 1. Teil,
ca. 10 Minuten f&uuml;r den 2. Teil.
<li> <b>Inhalt</b>:
Es erwarten Sie Fragen zu
Ihrer Person, Partner, Partnerschaft,
Herkunftsfamilie, Einstellungen und Pers&ouml;nlichkeit.
<li> <b>Hinweise</b>:
<ul>
<li>F&uuml;r die Untersuchung w&auml;re es von gro&szlig;em
Nutzen, wenn <b>Ihr Partner/Ihre Partnerin</b> den Fragebogen
ebenfalls ausf&uuml;llen k&ouml;nnte.
<li>Wenn Sie momentan <b>nicht</b> in einer Beziehung leben,
machen Sie die Angaben bitte zu Ihrer <b>letzten</b> Partnerschaft.
<li>Es ist jedoch in jedem Fall sehr wichtig,
dass Sie die Angaben <b>ohne</b> Absprache mit
Ihrem Partner/Ihre Partnerin machen.
<li>Nehmen Sie bitte nur <b>einmal</b> an dieser Untersuchung teil.
<li>Sie k&ouml;nnen diesen Fragebogen auch herunterladen
und ausdrucken: <a href="../../k/ksfrageb.pdf">PDF-Dokument</a>
</ul>
<li> <b>Kontakt</b>: Bei R&uuml;ckfragen schreiben Sie bitte an:
<a href=mailto:konstanze-schirmer\@sample.xxx>konstanze-schirmer\@sample.xxx</a>
</ul>
<center>
Bitte lesen Sie sich alle Fragen aufmerksam durch
und versuchen Sie bitte, so genau und so ehrlich wie m&ouml;glich zu
antworten.
<p>
Vielen Dank f&uuml;r Ihre M&uuml;he!
<p>
***
</center>
EOT
}

sub prtext2
{
	print <<"EOT";
<center>
Dies ist der <b>zweite</b> Teil des Fragebogens
mit Pers&ouml;nlichkeits- und Einstellungsfragen.
<p>
Sie ben&ouml;tigen nur etwa <b>10 Minuten</b> zum Ausf&uuml;llen.
<br>
Bitte lesen Sie sich die Fragen aufmerksam durch.
<p>
***
</center>
EOT
}

sub prcheck
{
	print <<"EOT";
Einige Felder sind unvollst&auml;ndig ausgef&uuml;llt.
<br>
Bitte &uuml;berpr&uuml;fen Sie Ihre Angaben bei den
<font color=#FF0000><b>rot</b></font> markierten Fragen.
<p>
Vielen Dank.
<p>
EOT
}

sub prfehl
{
	my($f)=@_;
	$fehlcolor=$f;
	if (not $fehlfarben) {
		$fehlcolor=0;
	}
}

sub prfbeg
{
	if ($fehlcolor) {
		print "<font color=#FF0000><b>\n";
	}
}

sub prfend
{
	if ($fehlcolor) {
		print "</b></font>\n";
	}
	$fehlcolor=0;
}

sub bt
{
	my($cols)=@_;
	print "<p><table width=\"100%\" cellspacing=0 cellpadding=4 border=0".
		" cols=".$cols." bgcolor=white>\n";
}

sub et
{
	print "</table>\n";
}

sub btr
{
	print "<tr>\n";
}

sub etr
{
	print "</tr>\n";
}

sub btd
{
	my($colspan,$width,$align)=@_;
	print "<td bgcolor=#F0F0F0 align=".$align." valign=top";
	if ($colspan > 1) {
		print " colspan=".$colspan;
	}
	if ($width > 0) {
		print " width=\"".$width."%\"";
	}
	print ">\n";
}

sub etd
{
	print "</td>\n";
}

sub finput
{
	my($t)=@_;
	if ($az == 0) {
		$t = "hidden";
	}
	print "<input type=".$t." name=";
}

sub form_radio
{
	my($B,$n,$v,$t)=@_;
	$radio_name=$n;
	$radio_value=$v;
	if ($az) {
		bt(2);
		btr();
		btd(1,$B,"center");
		prfbeg();
		print $t."<br>\n";
		prfend();
		etd();
		btd(1,100-$B,"left");
	} else {
		finput("radio");
		print $radio_name." value=".$radio_value.">\n";
	}
}

sub one_radio
{
	my($V,$v)=@_;
	my($f);
	if ($az) {
		$f="";
		$f="checked" if ($radio_value eq $v);
		finput("radio");
		print $radio_name." value=".$v." ".$f.">";
		print " ".$V."<br>\n";
	}
}

sub end_radio
{
	if ($az) {
		etd();
		etr();
		et();
	}
}

sub form_lastquest
{
	my($F,$n,$v,$t)=@_;
	prfehl($F);
	form_radio(64,$n,$v,$t);
	one_radio("auf jeden Fall gut","aufjedenfallgut");
	one_radio("eher gut","ehergut");
	one_radio("weder gut noch schlecht","wedergutnochschlecht");
	one_radio("eher schlecht","eherschlecht");
	one_radio("auf jeden Fall schlecht","aufjedenfallschlecht");
	end_radio();
}

sub form_radio_1
{
	my($N,$n,$v,$t)=@_;
	$radio_name=$n;
	$radio_value=$v;
	$radio_part= 100 / $N;
	if ($az) {
		bt($N);
		btr();
		btd($N,0,"center");
		prfbeg();
		print $t."\n";
		prfend();
		etd();
		etr();
		btr();
	} else {
		finput("radio");
		print $radio_name." value=".$radio_value.">\n";
	}
}

sub one_radio_1
{
	my($V,$v)=@_;
	my($f);
	if ($az) {
		$f="";
		$f="checked" if ($radio_value eq $v);
		btd(1,$radio_part,"center");
		finput("radio");
		print $radio_name." value=".$v." ".$f.">";
		print "<br>".$V."<br>\n";
		etd();
	}
}

sub end_radio_1
{
	if ($az) {
		etr();
		et();
	}
}

sub scale_radio_5
{
	my($T,$N)=@_;
	print "<td align=center valign=top width=\"13%\">";
	if ($N > 0) {
		print $N."<br>";
	}
	print "<b>".$T."</b><br></td>\n";
}

sub scale_radio_5_all
{
	my($w,$t)=@_;
	if ($az) {
		print "<tr><td align=left valign=bottom width=\"35%\">".
			$t."<br></td>\n";
		scale_radio_5("sehr<br>unzutreffend",1*$w);
		scale_radio_5("eher<br>unzutreffend",2*$w);
		scale_radio_5("weder zutreffend<br>noch unzutreffend<br>&nbsp;",
			3*$w);
		scale_radio_5("eher<br>zutreffend",4*$w);
		scale_radio_5("sehr<br>zutreffend",5*$w);
		print "</tr>";
	}
}

sub form_radio_5
{
	my($C,$F,$n,$v,$t)=@_;
	$radio_name=$n;
	$radio_value=$v;
	if ($az) {
		prfehl($F);
		print "<tr bgcolor=#";
		if ($C) {
			print "F0F0F0";
		} else {
			print "E0E0E0";
		}
		print "><td align=left valign=top width=\"35%\">\n";
		prfbeg();
		print $t."\n";
		prfend();
		etd();
		one_radio_5(1,1);
		one_radio_5(2,2);
		one_radio_5(3,3);
		one_radio_5(4,4);
		one_radio_5(5,5);
		etr();
	} else {
		finput("radio");
		print $radio_name." value=".$radio_value.">\n";
	}
}

sub one_radio_5
{
	my($V,$v)=@_;
	my($f);
	$f="";
	$f="checked" if ($radio_value eq $v);
	print "<td align=center valign=top width=\"13%\">\n".$V." ";
	finput("radio");
	print $radio_name." value=".$v." ".$f.">\n";
	etd();
}

sub form_selmul
{
	my($t,$N,$Y,$v,%r)=@_;
	%ref_select=%r;
	if ($az) {
		bt(2);
		btr();
		btd(1,50,"center");
		prfbeg();
		print $t."<br>\n";
		prfend();
		etd();
		btd(1,50,"center");
	}
	selmul_1($N,$v,$Y);
}

sub selmul_1
{
	my($N,$v,$Y)=@_;
	if ($az) {
		print "<select name=".$N." class=katform>\n";
	} else {
		finput("");
		print $N." value=";
	}
	$selmul_value=$v;
	$selmul_Y=$Y;
}

sub one_selmul
{
	my($V,$v)=@_;
	if ($az) {
		print "<option value=".$v." ".
			$ref_select{$v}.">".$V."</option>\n";
	} elsif ($ref_select{$v} eq "selected") {
		print $v;
	}
}

sub selmul_0
{
	if ($az) {
		print "</select>\n";
	} else {
		print " >\n";
	}
	finput("text");
	print $selmul_Y." size=4 maxlength=4 value=\"".$selmul_value.
		"\" class=katform>\n";
}

sub next_selmul
{
	my($N,$Y,$v,%r)=@_;
	%ref_select=%r;
	selmul_0();
	if ($az) {
		print "<br>\n";
	}
	selmul_1($N,$v,$Y);
}

sub end_selmul
{
	selmul_0();
	if ($az) {
		print "<br>\n";
		etd();
		btd(1,25,"center");
		etd();
		etr();
		et();
	}
}

sub geschw_selmul
{
	one_selmul("---","kein");
	one_selmul("Schwester","schwester");
	one_selmul("Bruder","bruder");
	one_selmul("Zwillingsschwester","zwillingsschwester");
	one_selmul("Zwillingsbruder","zwillingsbruder");
	one_selmul("Halbschwester","halbschwester");
	one_selmul("Halbbruder","halbbruder");
	one_selmul("Stiefschwester","stiefschwester");
	one_selmul("Stiefbruder","stiefbruder");
	one_selmul("Adoptivschwester","adoptivschwester");
	one_selmul("Adoptivbruder","adoptivbruder");
}

sub form_num
{
	my($t,$N,$l,$v,$L,$L2,$align)=@_;
	if ($az) {
		if ($L2+$L < 100) {
			bt(3);
		} else {
			bt(2);
		}
		btr();
		btd(1,$L,$align);
		prfbeg();
		print $t."\n";
		prfend();
		etd();
		btd(1,$L2,"center");
	}
	finput("text");
	print $N." size=".$l." maxlength=".$l." value=\"".$v.
		"\" class=katform>\n";
	if ($az) {
		etd();
		if ($L2+$L < 100) {
			btd(1,100 - ($L2+$L),"center");
			print "&nbsp;";
			etd();
		}
		etr();
		et();
	}
}

sub form_free
{
	my($t,$N,$r,$c,$v)=@_;
	if ($az) {
		bt(2);
		btr();
		btd(1,50,"left");
		prfbeg();
		print $t."\n";
		prfend();
		etd();
		btd(1,50,"center");
		print "<textarea type=text name=".$N." rows=".$r." cols=".$c.
			" class=katform>".$v."</textarea>\n";
		etd();
		etr();
		et();
	} else {
		print "<input type=hidden name=".$N." value=\"".$v."\">\n";
	}
}

sub formhead
{
	print "
<FORM method=post action=$cgifile name=KD_name><p>
<input type=hidden name=Time value=\"".$starttime."\">\n";
}

sub formtail
{
	my($knopf,$vor,$text)=@_;
	if ($az) {
		print "<p><center>".$vor.
		" &nbsp; <input type=submit name=".$knopf.
		" value=Absenden class=katform> &nbsp; ".$text.
		"</center>\n</FORM>\n<p>\n";
	}
}

sub prdanke
{
	print <<"EOT";
<center>
Die Frageb&ouml;gen werte ich im Rahmen meiner Diplomarbeit aus.<br>
Voraussichtlich ab Februar 2003
k&ouml;nnen Sie diese auf meiner Internetseite abrufen:<br>
<a href=http://scara.com/~schirmer/k>http://scara.com/~schirmer/k</a>
<p>
F&uuml;r die Unterst&uuml;tzung danke ich<br>
<a href="http://www.uni-kassel.de/fb3/psych/pers/euler/">Prof.&nbsp;Harald&nbsp;A.&nbsp;Euler</a>
und
<a href="http://www.uni-kassel.de/fb3/psych/pers/hoier/">Sabine Hoier</a>
<p>
Sie k&ouml;nnen diesen Fragebogen auch herunterladen
und ausdrucken: <a href="../k/ksfrageb.pdf">PDF-Dokument</a>
<br>
Haben Sie noch Fragen? Schreiben Sie bitte an: <a href=mailto:konstanze-schirmer\@sample.xxx>konstanze-schirmer\@sample.xxx</a>
</center>
EOT
}

sub prtail
{
	print <<"EOT";
</body>
</html>
EOT
}

sub send_mail
{
	my ($to,$from,$subject,@body) = @_;
	$to=~s/@/\@/;
	$from=~s/@/\@/;
	open (MAIL, "|/usr/sbin/sendmail -t") or warn
		"send_mail(): Could not open sendmail: $!";
	print MAIL "To: $to\n";
	print MAIL "From: $from\n";
	print MAIL "Subject: $subject\n\n";
	foreach my $line (@body) {
		$line=~ s/\r/\n/g;
		$line=~ s/\n\n/\n/g;
		$line=~ s/\n\.\n/\n_.\n/g;
		$line=~ s/\n\.\$/\n_.\n/g;
		$line=~ s/^\.\n/\n_.\n/g;
		$line=~ s/^\.\$/\n_.\n/g;
		print MAIL "$line";
	}
	print MAIL "\n.\n";
	close MAIL or return 1;
	return 0;
}

sub decode
{
	my($string)=@_;
	$string=~s/\+/ /g;
	$string=~s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/ge;
	$string=~s/\"//g;
	return $string;
}

sub query2fields
{
	my($query)=@_;
	my($piece, $key, $val, %fields);
	%fields=();
	foreach $piece (split /\&/, $query)
	{
		$piece=~/^([^=]+)=(.*)$/ or next;
		($key, $val)=($1,$2);
		($key, $val)=(decode($key),decode($val));
		$fields{$key}=$val;
	}
	return \%fields;
}	
