#!/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.
EOT scale_radio_5_all(1,"Ich halte mich für jemanden, der..."); form_radio_5(0,$b2ea_fehlt,"b2ea",$b2ea,"...dazu neigt, andere zu kritisieren."); form_radio_5(1,$b2eb_fehlt,"b2eb",$b2eb,"...Aufgaben gründlich erledigt."); form_radio_5(0,$b2ec_fehlt,"b2ec",$b2ec,"...hilfsbereit und selbstlos gegenüber anderen ist."); form_radio_5(1,$b2ed_fehlt,"b2ed",$b2ed,"...manchmal etwas nachlässig ist."); form_radio_5(0,$b2ee_fehlt,"b2ee",$b2ee,"...häufig Streitereien mit anderen beginnt."); form_radio_5(1,$b2ef_fehlt,"b2ef",$b2ef,"...zuverlä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ücksichtsvoll und freundlich gegenüber anderen ist."); form_radio_5(0,$b2en_fehlt,"b2en",$b2en,"...tüchtig ist und flott arbeitet."); form_radio_5(1,$b2eo_fehlt,"b2eo",$b2eo,"...sich manchmal schroff und abweisend gegenüber anderen verhält."); form_radio_5(0,$b2ep_fehlt,"b2ep",$b2ep,"...Pläne macht und diese dann auch durchfü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ühl hat."); et(); form_lastquest($e2e1_fehlt,"e2e1",$e2e1,"Wie fänden Sie es, wenn homosexuelle Paare Kinder adoptieren könnten?"); form_lastquest($e2e3_fehlt,"e2e3",$e2e3,"Wenn z.B. der brasilianische Fußballverband beschlossen hätte, zur nächsten Weltmeisterschaft mit einer hochqualifizierten Frauen-Fußballmannschaft anzutreten, wie würden Sie das finden?"); form_lastquest($e2e4_fehlt,"e2e4",$e2e4,"Wie würden Sie es finden, wenn die Staaten innerhalb der EU abgeschafft würden und es statt dessen einen einzigen Gesamtstaat \"Europa\" gäbe?"); form_lastquest($e2e2_fehlt,"e2e2",$e2e2,"Wie wäre es Ihrer Meinung nach, wenn die Droge Marihuana (Haschisch) als legal freigegeben werden würde?"); print <<"EOT";

Die Hälfte des 2. Teils haben Sie jetzt schon ausgefüllt; nun kommt der letzte Abschnitt:

Wie schätzen Sie Ihren derzeitigen bzw. letzten Partner/Ihre Partnerin ein?
Bitte kreuzen Sie auf der jeweiligen Skala von 1 bis 5 an, wie sehr jede Aussage auf Ihren Partner/Ihre Partnerin zutrifft, von 1 = sehr unzutreffend bis 5 = sehr zutreffend.

EOT scale_radio_5_all(1,"Ich halte meinen Partner/meine Partnerin für jemanden, der/die..."); form_radio_5(0,$b2pa_fehlt,"b2pa",$b2pa,"...dazu neigt, andere zu kritisieren."); form_radio_5(1,$b2pb_fehlt,"b2pb",$b2pb,"...Aufgaben gründlich erledigt."); form_radio_5(0,$b2pc_fehlt,"b2pc",$b2pc,"...hilfsbereit und selbstlos gegenüber anderen ist."); form_radio_5(1,$b2pd_fehlt,"b2pd",$b2pd,"...manchmal etwas nachlässig ist."); form_radio_5(0,$b2pe_fehlt,"b2pe",$b2pe,"...häufig Streitereien mit anderen beginnt."); form_radio_5(1,$b2pf_fehlt,"b2pf",$b2pf,"...zuverlä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ücksichtsvoll und freundlich gegenüber anderen ist."); form_radio_5(0,$b2pn_fehlt,"b2pn",$b2pn,"...tüchtig ist und flott arbeitet."); form_radio_5(1,$b2po_fehlt,"b2po",$b2po,"...sich manchmal schroff und abweisend gegenüber anderen verhält."); form_radio_5(0,$b2pp_fehlt,"b2pp",$b2pp,"...Pläne macht und diese dann auch durchfü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ühl hat."); et(); print <<"EOT";

Versetzen Sie sich abschließ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ürde es Ihr Partner/Ihre Partnerin finden, wenn homosexuelle Paare Kinder adoptieren könnten?"); form_lastquest($e2p3_fehlt,"e2p3",$e2p3,"Wenn z.B. der brasilianische Fußballverband beschlossen hätte, zur nächsten Weltmeisterschaft mit einer hochqualifizierten Frauen-Fußballmannschaft anzutreten, wie wü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ürden und es statt dessen einen einzigen Gesamtstaat \"Europa\" gäbe?"); form_lastquest($e2p2_fehlt,"e2p2",$e2p2,"Wie wäre es der Meinung Ihres Partners/Ihrer Partnerin nach, wenn die Droge Marihuana (Haschisch) als legal freigegeben werden würde?"); form_free("Hier können Sie Bemerkungen eintragen, wenn Sie möchten:", "Bemerkung",3,50,$bemerk); formtail("Cont2","Ganz wichtig:","

Herzlichen Dank fü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
$query\n
\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ä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 Übermittlung des Fragebogens hat wegen eines technischen Fehlers nicht geklappt.
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ä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 Übermittlung des Fragebogens hat wegen eines technischen Fehlers nicht geklappt.
Tut mir leid.\n"; exit(4); } prhead("Fragebogen fertig!"); prdanke(); prtail(); exit(0); } } exit(1); # param: frame_title sub prhead { my($title)=@_; print <<"EOT"; $title EOT } sub prtext { print <<"EOT";

Untersuchung zum Thema

Geschwister und Partnerwahl


Wollen Sie mitmachen?


Hier können Sie einen interessanten Fragebogen ausfüllen, der im Fachbereich Psychologie an der Universität Kassel unter der Leitung von Prof. Harald A. Euler durchgeführt wird und rein wissenschaftlichen Zwecken dient.
Bitte lesen Sie sich alle Fragen aufmerksam durch und versuchen Sie bitte, so genau und so ehrlich wie möglich zu antworten.

Vielen Dank für Ihre Mühe!

***

EOT } sub prtext2 { print <<"EOT";
Dies ist der zweite Teil des Fragebogens mit Persönlichkeits- und Einstellungsfragen.

Sie benötigen nur etwa 10 Minuten zum Ausfüllen.
Bitte lesen Sie sich die Fragen aufmerksam durch.

***

EOT } sub prcheck { print <<"EOT"; Einige Felder sind unvollständig ausgefüllt.
Bitte überprüfen Sie Ihre Angaben bei den rot markierten Fragen.

Vielen Dank.

EOT } sub prfehl { my($f)=@_; $fehlcolor=$f; if (not $fehlfarben) { $fehlcolor=0; } } sub prfbeg { if ($fehlcolor) { print "\n"; } } sub prfend { if ($fehlcolor) { print "\n"; } $fehlcolor=0; } sub bt { my($cols)=@_; print "

\n"; } sub et { print "
\n"; } sub btr { print "\n"; } sub etr { print "\n"; } sub btd { my($colspan,$width,$align)=@_; print " 1) { print " colspan=".$colspan; } if ($width > 0) { print " width=\"".$width."%\""; } print ">\n"; } sub etd { print "\n"; } sub finput { my($t)=@_; if ($az == 0) { $t = "hidden"; } print "\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."
\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 "
".$V."
\n"; etd(); } } sub end_radio_1 { if ($az) { etr(); et(); } } sub scale_radio_5 { my($T,$N)=@_; print ""; if ($N > 0) { print $N."
"; } print "".$T."
\n"; } sub scale_radio_5_all { my($w,$t)=@_; if ($az) { print "". $t."
\n"; scale_radio_5("sehr
unzutreffend",1*$w); scale_radio_5("eher
unzutreffend",2*$w); scale_radio_5("weder zutreffend
noch unzutreffend
 ", 3*$w); scale_radio_5("eher
zutreffend",4*$w); scale_radio_5("sehr
zutreffend",5*$w); print ""; } } sub form_radio_5 { my($C,$F,$n,$v,$t)=@_; $radio_name=$n; $radio_value=$v; if ($az) { prfehl($F); print "\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 "\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."
\n"; prfend(); etd(); btd(1,50,"center"); } selmul_1($N,$v,$Y); } sub selmul_1 { my($N,$v,$Y)=@_; if ($az) { print "\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 "
\n"; } selmul_1($N,$v,$Y); } sub end_selmul { selmul_0(); if ($az) { print "
\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 " "; 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 "\n"; etd(); etr(); et(); } else { print "\n"; } } sub formhead { print "

\n"; } sub formtail { my($knopf,$vor,$text)=@_; if ($az) { print "

".$vor. "     ".$text. "
\n
\n

\n"; } } sub prdanke { print <<"EOT";

Die Fragebögen werte ich im Rahmen meiner Diplomarbeit aus.
Voraussichtlich ab Februar 2003 können Sie diese auf meiner Internetseite abrufen:
http://scara.com/~schirmer/k

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

EOT } sub prtail { print <<"EOT"; 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; }