#!/usr/bin/perl -w # # # rst_main.pl belongs to the RST Survey Tool series. It allows you to easily create online surveys. # # Look for updates at http://www.hinner.com/rst/ # # Perl-Script by Kajetan Hinner. This program is Mailware, every user should write to its author. # You may use this tool for free in an academic or business environment. # It is encouraged to distribute the RST Survey Tool only as a whole. # You are not allowed to alter and redistribute it then. # Code and Syntax is (c) by Dr. Kajetan Hinner, 1999-2008. It is not allowed to sell this tool. # If you are still not satisfied, then RST is under the Bugroff Licence for you (http://www.geocities.com/SoHo/Cafe/5947/bugroff.html # Bugroff Licence: Sure, No problem. Don't worry, be happy. Now bugger off. # # rst_main.pl was developed using Linux 2.0.36 and Perl 5.004. As editor for large files I recommend nedit or kate. I also recommend the Debian Linux distribution. # RST has also been tested with Linux 2.2.19, 2.4.18, 2.4.27,2.6.x and FreeBSD 4.7 and 4.10 - it should run on all Unix-like systems though. # # Thanks for University of Rostock, Sociology Department, for providing time and space to develop RST # # Changes: 1.0 (19.11.99, 16:46): Start of project # 1.0a (2.12.99, 19:28): First beta version to be tested # 1.1 (5.12.99, 3:00): First productive version # 1.1a (6.12.99, 19:00): Included createsyntax (value labels, SPSS-Syntax) # 1.2 (15.12.99, 22:50): Corrected result sum code (head, tail, mean). Several sort bugs fixed # 1.3 (4.2.2000, 18:00): Minor bug fixes; Text area; Matrix question tabelized. # New: Select questions, Command line mode; Date output readable for Excel # 1.3a (10.4.2000, 17-): Minor bug fixes # 1.3b (17.4.2000, 20-): Corrected Date output for compatibility with german Excel # 1.3c (11.5.2000, 21-): New tags - for Mailing results, errors, etc. # 1.3d (13.5.2000, 20-): Several new commands; bug fix (variable name & &) # 1.3e (21.5.2000, 20-): New "view" command. (_view=1) or view in rst_config # 1.3f ( 2.6.2000, 20-): New {A<...>} command; better error handling. # 1.3g ( 7.6.2000, 17-): Changes in Result output code. # Remove DEVEL ***!!! # 1.3h ( 9.1.2001, 22-): Small error corrected # 1.3i (10.3.2001, 15.30): Official release as 1.3. # 1.3j (29.8.2001, 23.30): Fixed small bug (Unrecognized escape... line 365) # 1.3.1 (1.11.2001, 1am): Reprogrammed automatic numbering of questions, which are printed now; added "!" option # 1.3.2 (7.5.2003, 11pm): Fixed small bugs at the lang files (de and us). # 1.3.3 (13.8.2005, 8pm): Small bugfixes (MAXSIZE->MAXLENGTH), FAQ updates, new example (thanks to Rainer Rapp) # 1.4 (29.8.2007, 2pm): Included filter-command (thanks to Lucian Krille) # 1.4.1 (20.9.2007, 5pm): Small bugfixes (HTML page numbering), thanks to Lucian Krille # 1.4.2 (30.3.2008, 7pm): Name change to RST - Rapid Survey Tool # # How this all works: # # Well, I had a problem: There was a survey, already developed using a word processor. And I wanted to # create an online survey. I tried several tools, and they seemed to work, but not well enough. # Most survey tools ask for information which should be set by default, like: variable name, numbering # of questions, etc. So I tried to develop a program which parses an enriched survey file and outputs # the HTML for the survey. # Not much effort was spent on data output. When the script is invoked at the starting page, a unique # ID is given to the user, which is transmitted all the time so we can track him. This ID is saved in # a temporary data file. If the survey is completed, this file will then stored in the final data file. # If not, the temporary data files can be included with a manual invoked command, so that you can find # out who did not finish the survey. # All files belonging to the Rostock Survey Tool series begin with rst_ # # # All variables get their own data file. These data can finally be concatenated using the "_mode=results" # definition (together with _surveycfg=survey). You can also specify a survey and define the _mode # variable with "view", like ../cgi-bin/rst_main.cgi?_surveycfg=demo.de&_cfgmode=view # Then only viewing of the survey will be allowed, id number will be set to 0 and not increased. # # # # The raw survey document is parsed and the survey is made up on special tags. # # # These are the main tags and short description: # # {survey} Document must start with this tag, otherwise it is not accepted # {createsyntax} writes spss syntax file with variable and labels to output # {newpage} breaks survey into several parts # {} print html code as is (without any line feeds as it would be printed without {<....>} # {Mail test@hinner.com} sends mail when found. This is useful for small surveys or order forms, when # you want to be informed as new users watch or submit the survey. # {quit} Stops parsing. The survey so far will be displayed, the end of survey infile is ignored. # # {Q} Question. Without additional information, all questions are numbered (1,2,3,...) and Simpleradio mode. # # {Qc} Checkbox mode. # {Qm(N,S,O)} Matrix Mode, N represents choices for each answer. S spaces between buttons, O offset for value # {Qd(SIZE=3 Multiple)} Drop-Down like question (selection mode); Code in parentheses is copied as is. # This means 3 options can be seen and user can select more than one entry. Variable name # will be in multiple option appended _m. # # # {Qs} Sequence. Useful for filters, this question has the same number as the one before, # but a letter is attached (a,b,c) by default. # {Q&vname&} Don't autoselect variable name, but give vname for this Question, mostly you will use = option also # {Q=} Do not autonumber variable numbers for this Question (this is useful for questions inserted after an online survey is already running for some time # {Qi} indent. Print four spaces before question text # {Qb} beginning: Do NOT add some generic HTML before this question # {Qe} end: Do NOT add a line feed after this question (if you want next item in the same line) # # # {A} Answer. Belongs to the previous defined {Q}. # Without additional tags the default depends on the previous question's type. # {A_} defines text openfield. {A_20_25} defines width of 20 characters and max length of 25. # {At(rows="3" cols="50")}. Defines a text area input field with 3 rows and 50 Columns. # {A&vname&} Don't autoselect variable name, but define name of variable for this answer # {A=} don't auto number answers # {A+} increase answer number and reset answerseq_no # {Ai} indent: print 4 spaces before answer # {Ab} beginning: Do NOT add some spaces before this question (if you want no indent) # {Ae} end: Do NOT add a line feed after this answer (if you want both in same line) # # {#ABQ(5-3)} prints number of current Answer (A), A-Sequence (B), Question (Q) (automatically increased} # terms in parentheses () will be calculated, like {(Q-1)} prints number of the question before # # # {G} Graphic. Display special HTML-code. # # {Gm} matrix: Displays matrix numbers (on top of or end of matrix battery). Prints correct numbers # of rows and uses spaces as defined between them. # {Ge} end: Do NOT add a line feed after this answer (if you want both in same line) # # # # Note: && may be used for your variable names, but they are not allowed to start with "_" (this marks internal vars) # # # # Author: Kajetan Hinner, www.hinner.com # # Notice: My aim was to write a working program which is reliable and easy to maintain. It was not intended to write # state of the art perl code, which may be hard to read for others. Some remarks are in german. Sorry for that. local $rst_version = "RST 1.4.2 of 24.02.2008"; # look for more documentation at www.hinner.com/rst - there is even a German page. :-) # # use strict; # sonst geht das config file nicht... use Time::Local; use Time::localtime; # override localtime() to access tm_struct. use HTML::Entities; use CGI; #use CGI::Carp; # print CGI error messages on user window # use Fcntl; # for lock files (sysopen, etc.) # if there is a problem for you with the last two modules, get them from CPAN at http://www.perl.com #################################################################### # declare variables and files my $rst_maincfgfile="/etc/rst_surveys.cfg"; # MOST IMPORTANT CONFIG FILE. every survey on the system must my $rst_maincfgfile="rst_surveys.cfg"; # be included here with it's config file. Two possible positions: In /etc or in cgi-bin directory local $rst_script="rst_main.cgi"; # name of script (cgi-bin) local $rst_mailcommand="/usr/bin/mail -s "; # expects "subject sender" to be appended # subject will be defined in $rst_config local $rst_configfile="rst_demo.de.config"; # config file, which stores all other data for survey local $rst_surveycfg="default"; # stores survey name when Script is invoked as CGI # when rst is called this has to be defined (either &_surveycfg="mysurvey" or POST) # in command line mode this can be set using -sc= local $rst_surveyfile; # file from which survey definition file is read local $rst_localefile="rst_locale.de.pl"; local $rst_surveyname; # name of Survey (Plain text) local $rst_surveymaintainer; # person who is responsible for survey (defined in rst_config.pl) local $rst_form_continue="Continue Survey"; # Text for Submit Button (defined in rst_locale.??.pl) local $rst_logfile="/tmp/rst.log"; # logfile; should be defined in configfile local $rst_errorfile="/tmp/rst.error"; # errorfile (prints error messages to) local $rst_datadir="/tmp/"; # directory where data is written too. local $rst_datadir_alt="/tmp/"; # alternative for writing too if first fails local $rst_idnumberfile="/tmp/rst.id"; # id number (for survey participant) local @rst_error; # error strings (defined in locale) my $rst_linenumber; # number of line which is parsed my $rst_invokemode; # how script was started; 1: Command Line; 2: CGI-Script my $rst_mode="survey"; # Survey mode by default # other Modes: "createsyntax", "newpage", "quit" my $rst_cfgmode=""; # Mode in rst_surveys.cfg (or _cfgmode); Only supported mode so far: "view" my $rst_text; # local var, many purposes my $rst_error; # error number local $rst_page_header; # HTML of every survey page (defined in rst_config.pl) - start local $rst_page_footer; # HTML of every survey page (defined in rst_config.pl) - end local $rst_button_type="submit"; # Is always submit... only in View mode this will change to "button" local $rst_eos_header; # HTML of end of survey page (Thank you for filling in the survey...) - start # local $rst_eos_footer; # HTML of end of survey page (Thank you for filling in the survey...) - end local $rst_pagename; # name of HTML page local $rst_page_color; # background color; local %rst_htmls; # hash for html tags concerning (pre code) local %rst_htmle; # hash for html tags concerning (post code) local $rst_qvname; # variable name (of question) my $rst_qvlabel; # variable label (of question) my $rst_qvartext; # variable text (in HTML printed question) local $rst_qautovarname; # variable name: auto variable text local $rst_qautovartext; # variable printing (HTML): auto variable text my $rst_matrixno=0; # Number of Matrix choices my $rst_matrixspaces=2; # number of spaces between Matrix radio buttons my $rst_matrixoffset=0; # start of counter local $rst_avname; # variable name (of answer) my $rst_avlabel; # variable label (of answer) my $rst_avartext; # variable text (in HTML of answer) my $rst_size; my $rst_maxlength; # for text fields my $rst_surveyline; # line of survey input file, which should be started to read (filters, etc.) my $parseline; # line which is parsed actually (from survey input file) local $rst_idnumber; # id number of user (is given at the first invoke; 0 is code for results page) local $rst_html_pagenumber =1; # starting with page 1 # the following four numbering counters count by default ALL questions. This is used for # question output numbering ("Q1: Where have you been?") as well as auto-assigning variable names # if you need to fill in a new question, you have to define your own variable name using {Q&vname&}; local $rst_questionno=0; # number of question in survey (starting by default with 1) local $rst_questionnoseq=""; # sequence numbering local $rst_answerno=1; # number of answer (reset with every question) local $rst_answernoseq=""; # sequence numbering for answers local $rst_filter_conditions=""; # filter conditions (questions and answers separated with "-", followed by filter anchor my $rst_qmode=""; # question mode (radiobutton/matrix/dropdown) my $rst_amode=""; # answer mode (text) my $rst_csquestiontag; # description of question (for create syntax) my $rst_csqvarmode; # my $rst_extrahtml; # HTML defined in {A<...>} local $rst_mail_survey_view = "Survey accessed: \$rst_surveyname"; ################### variables for result mode ################## local $rst_resultspw="rst"; # password to get access to data local @rst_resultspw; # array to allow different passwords for different uses. local $rst_results_file; # file with survey-text for results and password local $rst_results_script=""; # script to calculate and print extensive results my $rst_resultsmode; # mode of result operation local $rst_resultsoutputfile="/tmp/rst_dataoutput.data"; # file to write output to local $rst_resultsoutputfilelink="/var/www"; # this needs to be defined local $rst_mail_survey_submit = "Survey submitted: \$rst_surveyname (Count: \$rst_idnumber)"; local %rst_vars; # array of variables (as in files) ############################################################### # user define section # # # there are several default configurations # # first job: scanning for arguments of invoking command line... # ; name of standard configurations my $rst_script_name = $0; # Name of perl-script ########################################################################################### ################################# ################################# end user define section ################################# # do not alter anything below this line unless you know what you're doing ########################################################################################### my $debug=3; # 1: print serious bugs (default) # 2: print something (for the interested into the internal working of the program) # 3: print everything (for debugging) # # Subroutines sub dummy_avoid_warnings { # this is needed because of html definitions in the locale # file. without this, warnings would be produced. $rst_text=defined $rst_form_continue; # but I still like to get these warnings because of useful hints. $rst_text=defined $rst_page_color; # :) $rst_text=defined $rst_surveymaintainer; $rst_text=defined $rst_summary_html; $rst_text=defined $rst_script; } sub append_log { (my $note) = @_; # text to append if (!(open FILEOUTL, ">>$rst_logfile")) { &append_errorlog(ctime() . " Can't open $rst_logfile: $!\n"); return(0); }; if (!(print FILEOUTL ctime() . " $note")) { &append_errorlog(ctime() . " Can't write to $rst_logfile: $!\n"); return(0); }; close (FILEOUTL); } sub append_errorlog { (my $note) = @_; # text to append open(FILEOUT, ">>$rst_errorfile") or die (ctime() . " Can't open $rst_errorfile: $!\n"); (print FILEOUT ctime() . " $note") or die (ctime() . " Can't open $rst_errorfile: $!\n"); close (FILEOUT); } sub kh_convertdate { # convert Date of ctime() to SPSS readable Format (my $datestring) = @_; # Datestring, like ctime() # all these lines became unnecessary # my %kh_months3 = ("Jan", '01', "Feb", '02', "Mrz", '03', "Apr", '04', "Mai", '05', "Jun", '06', "Jul", '07', "Aug", '08', "Sep", '09', "Okt", 10, "Nov", 11, "Dez", 12); # uncomment this for english import. Don't forget to comment previous line then. (Date Export). # my %kh_months3 = ("Jan", '01', "Feb", '02', "Mar", '03', "Apr", '04', "May", '05', "Jun", '06', "Jul", '07', "Aug", '08', "Sep", '09', "Oct", 10, "Nov", 11, "Dec", 12); $_ = $datestring; # "Tue Jan 25 21:11:31 2000" should become 25-Jan-2000 21:11:31 my $wday; my $month; my $mday; my $time; my $year; ($wday, $month, $mday, $time, $year) = /(\S+) (\S+)\s+(\d+)\s+(\d+:\d+:\d+) (\d+)/; # &append_log ("Found: $wday, $month, $mday, $time, $year - original Date: '$datestring'\n"); return ("$mday-$month-$year $time"); # could have been done with $1, $2, etc. this is for readability } sub rst_htmldie { # print error as html and die (my $note) = @_; # text to append if ($rst_invokemode == 2) # if mode was cgi print html header; else command line mode { print ("Content-type: text/html\n\n"); print ("

$note

\n"); } else { die ("$note\n"); } &append_errorlog ($note); die ($note); } # print error as html sub rst_htmlerror { (my $note) = @_; # text to append # print ("Content-type: text/html\n\n"); if (!$note) {$note=""}; # to avoid undef error print $rst_htmls{T}{error}; print $note; print $rst_htmle{T}{error}; } sub rst_readconfig { # $rst_errorfile="/tmp/rst.error"; # error log for first use # print ("1 config- und localefile: '$rst_configfile', '$rst_localefile'\n"); if (! -e $rst_configfile) {&rst_htmldie ("No config file (undefined _surveycfg) - check Manual at http://www.hinner.com/rst/")}; do $rst_configfile; if ($@) { &rst_htmldie ("Error reading config file: $@ \n") }; # print ("Reading Configfile '$rst_configfile'. Return: '$rst_error'\n"); if (!$rst_localefile) { &rst_htmldie ("No locale file or config file ($rst_configfile) undefined.

This is Rostock Survey Tool $rst_version. Dying.")}; print ("Reading Locale file: '$rst_localefile'\n\n") if ($debug > 2); do $rst_localefile; if ($@) { &rst_htmldie ("Error reading locale file: $@ \n") }; # print ("Error test... $rst_error[1]\n") if ($debug > 2); if (!$rst_surveyfile) # quit if survey file is not defined { &rst_htmldie ("Fatal error ($rst_surveyfile): $rst_error[1] \n"); } # if standard files were not defined, set them if (!$rst_logfile) {$rst_logfile="$rst_surveyfile/.log"}; # output log (error messages, etc.) if (!$rst_errorfile) {$rst_errorfile="$rst_surveyfile/.error"}; # error log if (!$rst_datadir) {$rst_datadir="/tmp/"}; # directory where data variables are $rst_datadir .= "/" unless ($rst_datadir =~ /\/$/); # written to. append / if (!-d $rst_datadir) { $rst_error = mkdir ($rst_datadir, 0755); # create data dir if needed if (!$rst_error) {$rst_error = 0}; if ($rst_error) { &append_errorlog("$rst_error[2] ($rst_datadir)\n"); } } } sub rst_printpageheader { ($rst_pagename) = &encode_entities(@_); # www page name # $text =~ s/\$(\w+)/${$1}/g; # expand variable names # only for developer version! *** # $rst_script="http://bompf.soziologie.uni-rostock.de/cgi-bin/rst_devel.cgi"; my $text=$rst_page_header; $text =~ s/\$(\w+)/${$1}/g; # print ("header: '$text'\n"); if ($rst_invokemode == 1) # command line mode - print output { print (CLOUTFILE $text) or &rst_htmldie("$rst_error[7] ($rst_outfile)"); # print html output } else { print ($text); # expands variable names and prints header } } sub rst_printpagefooter { # (my $pagename) = @_; # www page name my $text=$rst_page_footer; $text =~ s/\$(\w+)/${$1}/g; if ($rst_invokemode == 1) # command line mode - print output { print (CLOUTFILE $text) or &rst_htmldie("$rst_error[7] ($rst_outfile)"); # print html output } else { print ($text); # expands variable names and prints header } } sub rst_calc { ($_) = @_; # sequence to calculate # print ("Calculating $_\n"); s/\0//g; # remove 0 code (security) s/A/$rst_answerno/g; # expand Variables A and Q s/B/$rst_answernoseq/g; # expand Variables A and Q s/Q/$rst_questionno/g; s/(\(.*?\))/$1/gee; # calculate what is inside (), global eval s/i/$rst_htmls{i}{all}/g; # expand ident code return $_; } # my $code; # foreach $code (split (/\s*(\([^\)]*\))\s*/)/, $tag)) # { # print ("\$code: '$code'\n") if ($debug > 2); # if ($code eq "A") # print number of answer # { # $outputs .= "$rst_answerno$rst_answernoseq"; # } # # elsif ($code eq "Q") # print number of answer # { # $outputs .= "$rst_questionno$rst_questionnoseq"; # } # ($outputs .= $rst_htmls{i}{all}) if ($code eq "i"); # } # prints spss syntax for answer, depending on question and answer mode sub rst_cs_answerout { if ($rst_amode eq "text") { # this should be solved in a better way: The computer doesn't know which type of var # so we assume numeric in the most cases. # print (SYNTAXOUT "STRING $rst_avname (A$rst_maxlength).\n"); print (SYNTAXOUT "COMPUTE $rst_avname =0.\n"); print (SYNTAXOUT "VARIABLE LABELS $rst_avname \"$rst_csquestiontag\".\n"); } elsif (($rst_amode eq "simpleradio") || ($rst_amode eq "checkbox") || ($rst_amode eq "matrix")) { if ($rst_csqvarmode) # check if in variable label was already written { print (SYNTAXOUT "COMPUTE $rst_avname =0.\n"); print (SYNTAXOUT "VARIABLE LABELS $rst_avname \"$rst_csquestiontag\".\n"); $rst_csqvarmode=""; } else { print (SYNTAXOUT "VALUE LABELS $rst_avname\n"); print (SYNTAXOUT " \"$rst_text\".\n"); } } } sub rst_parseline { (my $rst_line) = @_; # line which is parsed my $tag; # command string (all between {...}) my $rst_tagcounter=0; # counts tags my $command; # first character of Tag my $rst_cmd_options; # command options my $rst_cmode=""; # mode of command my $rst_filter_aname=""; # filter label in answer $rst_csqvarmode=1; # create syntax: print variable label of question only at definition of var. my $outputs=""; # starting of html my $outpute=""; # end codes of html if (!$rst_line) {return}; # return on empty lines... $_=$rst_line; if (/^\#/ || /^\s+$/) {return}; # line starting with # or empty line # { to correct next line # @fields=split (/\s*({[^}]*})\s*/, $line); # command to split the line in tags and fields inbeetween # {{ to correct next line for matching brackets # foreach $tag (split (/\s*({[^}]*})\s*/)) foreach $tag (split (/({[^}]*})/)) { $tag =~ s/\r?\n?$//; # get rid of new lines, and carriage returns at the end of string etc. if (!$tag) {next}; # first field seems to be empty if ($tag =~ /^\s+$/) {next}; # only white spaces # &append_log ("Found '$tag' at line $rst_linenumber \n"); $rst_tagcounter++; # count number of tags in line if ($tag =~ /{.*}/) # command text or plain text? { $command = substr ($tag, 1, 1); # get first character (command) $_=$tag; s/\(.*\)//g; # get rid of everything inside brackets s/&.*&//; # get rid of variable name in tag field. $rst_cmd_options = $_; # command options are left # &append_log ("Found '$tag' and '$rst_cmd_options' after cleaning \n"); if ($command eq "Q") # Question { if ($rst_qmode eq "dropdown") # if we were in dropdown mode, print end of selection list tag { $outputs .= "\n"; $outputs .= "$rst_htmle{A}{$rst_qmode}"; # nesting end code of html output } if ($rst_qmode eq "matrix") # if we were in matrix mode, print end of table definition { $outputs .= "
\n"; } $rst_answerno=1; # reset numbering for answers $rst_answernoseq=""; $rst_csqvarmode=1; # for create syntax mode; set flag (to print variable label) $rst_cmode = "question"; # command mode $rst_qmode = "simpleradio"; # radiobutton-like questions are default $rst_amode = ""; # new question - reset answermode if (($rst_qvname) = ($tag =~ /&(.*)&/)) # check if variable name is given { # &append_log ("Found given variable name for question: '$rst_qvname' in line $rst_linenumber\n"); # $rst_qvartext=""; # erase auto variable text - (for printed variable numbering in HTML) $tag =~ s/&.*&//; # get rid of variable name in tag field. } if (!($rst_cmd_options =~ /b/)) # don't add generic code before each question { $outputs = $rst_htmls{Q}{all} . $outputs; } if (!($rst_cmd_options =~ /e/)) # don't add generic code before after question { $outpute .= $rst_htmle{Q}{all}; } $outputs .= ($rst_htmls{i}{all} x $rst_cmd_options =~ tr/i//); # doesn't work (should count i's) if ($rst_cmd_options =~ /s/) # check if there is code "s" (sequence numbering) { # sequenced numbering # $outputs .= $rst_htmls{i}{all}; # indent (two characters) if ($rst_questionnoseq eq "") { $rst_questionnoseq = "a"; # set question sequence to first number } else { $rst_questionnoseq++; # increase number of sequence question (i.e. filter) } } elsif (!($rst_cmd_options =~ /=/)) # check if there is not code "=" (no autonumbering) { # we need to check first if this "=" is inside brackets which specify the question $rst_questionnoseq = ""; # question sequence off (only "s" can give it life) $rst_questionno++; # increase number of question (by default) # print ("Autonumbering questions, \$rst_questionno: $rst_questionno") if ($debug > 2) }; if (!($rst_cmd_options =~ /\!/)) # check if there is no code "!" (do not print question number prior to question text) { $rst_qvartext = $rst_qautovartext; # also using auto variable text $rst_qvartext =~ s/\$(\w+)/${$1}/g; # ($rst_qautonvarame="Q$rst_questionno") in rst_config.pl # print ("Using auto-creation for question text: \$rst_qvname = '$rst_qvname' and \$rst_qvartext = '$rst_qvartext'\n") if ($debug > 2); } else # if so, there is no question text then. { $rst_qvartext = ""; } if (!$rst_qvname) # if variable name for question is not set, use auto creation { $rst_qvname = $rst_qautovarname; # question variable name is auto created (no and no seq) $rst_qvname =~ s/\$(\w+)/${$1}/g; # ($rst_qautonvarame="Q$rst_questionno") in rst_config.pl } ($rst_qmode = "checkbox") if ($tag =~ /c/); # Enter checkbox mode if "c" found if ($rst_cmd_options =~ /m/) # Matrix mode { ($rst_text) = ($tag =~ /m\((.*)\)/); # extract (matrixno, spaces, offset), which must follow m if (!$rst_text) { &append_errorlog ("$rst_error[6] in line $rst_linenumber \n"); next} ($rst_matrixno, $rst_matrixspaces, $rst_matrixoffset) = ($rst_text =~ /(\d+)\,?(\d*)\,?(\d*)/); # print ("Found Matrix definition '$text' with $rst_matrixno buttons and $rst_matrixspaces space between them\n"); ($rst_matrixspaces = 2) unless $rst_matrixspaces; # default 2 ($rst_matrixoffset = 0) unless $rst_matrixoffset; # default 0 $rst_qmode = "matrix"; } elsif ($rst_cmd_options =~ /d/) # drop down - selection list { ($_) = ($tag =~ /d\((.*)\)/); # extract extra information, which can follow if (!$_) {$_="";} if (/Multiple/) { if (length($rst_qvname) > 6) { &append_errorlog ("$rst_error[22] '$rst_qvname' in line $rst_linenumber\n"); $rst_qvname=substr($rst_qvname, 0, 6); } $rst_qvname .= "_m"; }; # append _M at variable name when Multiple mode $outpute = ">" . $outpute; # append > (select end tag and additional info to end of $rst_qmode= "dropdown"; # select tag - which follows question text. } $rst_text = $rst_htmls{Q}{$rst_qmode} . $rst_qvartext; # Create HTML for Question $rst_text =~ s/\$(\w+)/${$1}/g; # expanding variables $outputs .= $rst_text; # nesting start output # embedding real time calc vars. $rst_text = $rst_htmle{Q}{$rst_qmode}; $rst_text =~ s/\$(\w+)/${$1}/g; # expanding variables $outpute = $rst_text . $outpute; # nesting end code of html output } elsif ($command eq "A") # Answer { # Answer tags $rst_cmode="answer"; # command mode if (($rst_avname) = ($tag =~ /&(.*)&/)) # check if variable name is given { # &append_log ("Found given variable name for answer: '$rst_avname' in line $rst_linenumber\n"); $rst_avartext=""; # erase auto variable text - (for printed variable numbering in HTML) $tag =~ s/&.*&//; # get rid of variable name in tag field. } if (($rst_extrahtml) = ($tag =~ /\<(.*)\>/)) # check if there is extra html { $tag =~ s/\<.*\>//; # get rid of extra html in tag field. # &append_log ("Found extra html for answer: '$rst_extrahtml' in line $rst_linenumber, which is now '$tag'\n"); $rst_cmd_options =~ s/\<.*\>//; # and in the command options field } else {$rst_extrahtml = ""}; # avoid undefined error if (($rst_filter_aname) = ($tag =~ /f-(.*)-/)) # check if there is filter and save filter_anchor to variable { &append_log ("Found filter for answer: '$rst_filter_aname' in line $rst_linenumber, which is now '$tag'\n"); $tag =~ s/f-.*-//; # get rid of filter name in tag field. $rst_cmd_options =~ s/f-.*-//; # and in the command options field $rst_filter_conditions .= $rst_qvname . "_§" . $rst_answerno . "_§" . $rst_answernoseq . "_§" . $rst_filter_aname . "__§§"; } # if ($rst_answerno += ($tag =~ tr/+//); # count "+" and increase answer number if ($rst_cmd_options =~ /\+/) { # increase answer no and reset answernoseq. $rst_answerno++; $rst_answernoseq=""; } if (!($rst_cmd_options =~ /b/)) # unless constr.! { # don't add generic code before each answer $outputs = $rst_htmls{A}{all} . $outputs; } if ((!($rst_cmd_options =~ /e/)) && ($rst_qmode ne "dropdown") ) { # don't add generic code after each answer $outpute .= $rst_htmle{A}{all}; } $outputs .= ($rst_htmls{i}{all} x $rst_cmd_options =~ tr/i/i/); # count indents and add 4 spaces for every i # if ($tag =~ /i/) # { # indent, add 4 spaces # $outputs .= $rst_htmls{i}{all}; # } # install sequence numbering if Code "s" if ($rst_cmd_options =~ /s/) {$rst_answernoseq ? $rst_answernoseq++ : ($rst_answernoseq = "a")} elsif ($rst_answernoseq) { # if there was sequence mode some answers before and now it stopped $rst_answernoseq=""; # we need to reset sequence mode and increase var no to avoid two $rst_answerno++; # variables with the same name! } if ($rst_cmd_options =~ /_/) { # text field $rst_amode = "text"; ($rst_size, $rst_maxlength) = ($tag =~ /^.*_+(\d+)_+(\d+)/); # extract information # &append_log ("Extracted from tag $tag sizes: '$rst_size' and maxlength '$rst_maxlength'\n"); if (!$rst_size) { $rst_size = tr/_//; }; # count "_" for length of inputfield if (!$rst_avname) # if variable was not given, define it. { $rst_avname = "Q$rst_questionno$rst_questionnoseq"; # $rst_avname = $rst_qvname; if (($rst_answerno > 1) || $rst_answernoseq) { $rst_avname .= "_$rst_answerno$rst_answernoseq"}; } $rst_text = $rst_htmls{A}{$rst_amode}; $rst_text =~ s/\$(\w+)/${$1}/g; # expand vars in html $outputs .= $rst_text . "SIZE=\"$rst_size\" " . ($rst_maxlength ? "MAXLENGTH=\"$rst_maxlength\">" : ">"); $outpute = $rst_htmle{A}{$rst_amode} . $outpute; # nesting end code of html output } # end if _ text field elsif ($rst_cmd_options =~ /t/) { # text field $rst_amode = "textarea"; ($rst_text) = ($tag =~ /t\((.*)\)/); # extract information if (!$rst_avname) # if variable was not given, define it. { # $rst_avname = "Q$rst_questionno$rst_questionnoseq"; $rst_avname = $rst_qvname; if (($rst_answerno > 1) || $rst_answernoseq) { $rst_avname .= "_$rst_answerno$rst_answernoseq"}; } $outputs .= "\n" . $outpute; # nesting end code of html output } # end if t textarea field elsif (1) # no _ (text) answer mode; -> depends on question... { if ($rst_qmode eq "simpleradio") { $rst_amode="simpleradio"; # answer mode is simple radio too if (!$rst_avname) { $rst_avname = ($rst_answernoseq ? $rst_answerno . "_" . $rst_answernoseq : $rst_answerno); } $rst_text = $rst_htmls{A}{$rst_qmode}; $rst_text =~ s/\$(\w+)/${$1}/g; $outputs .= "$rst_text $rst_extrahtml >"; $outpute = $rst_htmle{A}{$rst_qmode} . $outpute; # nesting end code of html output } elsif ($rst_qmode eq "checkbox") { $rst_amode="checkbox"; # answer mode is checkbox too if (!$rst_avname) { $rst_avname = ($rst_answernoseq ? "$rst_qvname" . "_" . "$rst_answerno" : "$rst_qvname" . "_" . "$rst_answerno$rst_answernoseq"); } $rst_text = $rst_htmls{A}{$rst_qmode}; $rst_text =~ s/\$(\w+)/${$1}/g; $outputs .= $rst_text; $outpute = $rst_htmle{A}{$rst_qmode} . $outpute; # nesting end code of html output } elsif ($rst_qmode eq "matrix") { if ($rst_amode ne "matrix") # is this the first answer of an matrix question? { $outputs .= $rst_htmls{A}{matrixtable}; # if so, define table } $rst_amode="matrix"; # set answer mode if (!$rst_avname) { $rst_avname = ($rst_answernoseq ? "$rst_qvname" . "_" . "$rst_answerno" : "$rst_qvname" . "_" . "$rst_answerno$rst_answernoseq"); } my $counter =0; # iterations (number of matrix answers) $outputs .= ""; while ($counter < $rst_matrixno) { $outputs .= ""; $counter++; } $outputs .= ""; $outpute = "\n"; # define text after cell } elsif ($rst_qmode eq "dropdown") { $rst_amode="dropdown"; # answer mode is dropdown if (!$rst_avname) { $rst_avname = ($rst_answernoseq ? $rst_answerno . "_" . $rst_answernoseq : $rst_answerno); } $rst_text = $rst_htmls{A}{$rst_qmode}; $rst_text =~ s/\$(\w+)/${$1}/g; $outputs .= $rst_text . ">"; # $outpute = $rst_htmle{A}{$rst_qmode} . $outpute; # nesting end code of html output } else { # unknown question mode &append_errorlog ("$rst_error[5] '$rst_qmode' while answer mode ' in Line $rst_line of file $rst_surveyfile\n"); die(); } } if (!$rst_answernoseq && !($rst_cmd_options =~ /=/) ) # check if there is not code "=" (no autonumbering) {$rst_answerno++}; # increase number of answer # if (!($tag =~ /s/) && !($tag =~ /=/) ) # # check if there is not code "=" (no autonumbering) # {$rst_answerno++}; # increase number of answer } # end if command was "A" elsif ($command eq "#") { $tag =~ s/{#(.*)}$/$1/; # print ("\$tag: '$tag'\n") if ($debug > 2); $outputs .= &rst_calc($tag); } # end if command was "#" elsif ($command eq "G") # Graphics { $rst_cmode="graphics"; # define mode # $tag =~ s/{.*}//; # get rid of {} in tag field. if ($tag =~ /m/) # print matrix number codes (0 1 2 3 4) { if ($rst_amode ne "matrix") # is this the first answer of an matrix question? { $outputs .= $rst_htmls{A}{matrixtable}; # if so, define table } $rst_amode="matrix"; # set answer mode my $counter =0; # iterations (number of matrix answers) $outputs .= ""; while ($counter < $rst_matrixno) { $outputs .= "" . ($counter+$rst_matrixoffset) . ""; $counter++; } $outputs .= "\n"; } ($outputs .= $rst_htmle{G}{all}) if ($tag =~ /e/); } elsif ($rst_cmd_options =~ /^{survey}$/i) { $rst_mode="survey"; } elsif ($rst_cmd_options =~ /^{createsyntax}$/i) { $rst_mode="createsyntax"; } elsif ($rst_cmd_options =~ /^{newpage}$/i) { &append_log ("Found NEWPAGE. Aborting in line $rst_linenumber\n") if ($debug > 2); # $rst_mode="newpage"; $rst_html_pagenumber++; # increase number of page - will be printed as HTML title return (2); } elsif ($rst_cmd_options =~ /^{lastanswer}$/i) { &append_log ("Found LASTANSWER. Printing answer end-HTML (line $rst_linenumber)\n") if ($debug > 2); if ($rst_qmode eq "dropdown") # if we were in dropdown mode, print end of selection list tag { $outputs .= "\n"; $outputs .= "$rst_htmle{A}{$rst_qmode}"; # nesting end code of html output } if ($rst_qmode eq "matrix") # if we were in matrix mode, print end of table definition { $outputs .= "
\n"; } $rst_answerno=1; # reset numbering for answers $rst_answernoseq=""; $rst_csqvarmode=1; # for create syntax mode; set flag (to print variable label) $rst_cmode = "lastanswer"; # command mode $rst_qmode = ""; # reset questionmode $rst_amode = ""; # new question - reset answermode } elsif (($rst_text) = ($tag =~ /^{(<.*>)}$/i)) # include html (<>) { # $rst_mode="html"; $outputs .= $rst_text; } elsif ($tag =~ /^{mail/i) # send mail when survey is opened or viewed { $rst_cmode="mail"; my $rst_email; ($rst_email) = ($tag =~ /^{mail (.*)}$/i); # extract mail address &append_log ("Found Mail. Sending to '$rst_email'\n"); $rst_text = $rst_mail_survey_view; $rst_text =~ s/\$(\w+)/${$1}/g; # expanding variables qx {$rst_mailcommand \"$rst_text\" $rst_email}; } elsif ($tag =~ /filteranchor_/) { &append_log ("Found filteranchor $tag in line $rst_linenumber\n") if ($debug > 2); # do nothing because we only need this to jump to } elsif ($tag =~ /quit/) { &append_log ("Found QUIT. Aborting in line $rst_linenumber\n") if ($debug > 2); $rst_mode="quit"; return (1); } } # end if tag contains {} else # no {} tag, so we have plain text { if ($rst_mode eq "createsyntax") { # check mode before $rst_text=$tag; if (length ($rst_text) > 25) # take 15 characters only { $rst_text=substr($rst_text,0,22) . "..."; # take first 22 chars and add "..." } if ($rst_cmode eq "question") { $rst_csquestiontag=$rst_text; # remember explanation of question for variable label print (SYNTAXOUT "\n"); } elsif ($rst_cmode eq "answer") { &rst_cs_answerout; } } # end if we are in create syntax mode # we just have plain text... # if ($rst_qmode eq "matrix") # { # $rst_cmode = "textmatrix"; # } # # else # { $rst_cmode = "text"; # set mode # } $outputs .= &encode_entities($tag); # if it's plain text, just append it to output. } # end else (means: $tag was not {}) } # end for each (cycle across all tags) # &append_log ("end of cycling... \$rst_tagcounter='$rst_tagcounter' and \$tag='$tag' and \$rst_cmode='$rst_cmode'\n"); if (($rst_tagcounter == 1) && ($rst_cmode eq "text")) { # defined in rst_config.pl : # $rst_htmls{T} = ''; # $rst_htmle{T} = '
'; if ($rst_qmode ne "matrix") { $outputs = $rst_htmls{T}{all} . $outputs; # wrap plain text with

tags (by default) } $outpute = $rst_htmle{T}{all} . $outpute; } if ($rst_mode eq "survey") { if ($rst_invokemode == 1) # command line mode - print output { print (CLOUTFILE "$outputs$outpute") or &rst_htmldie("$rst_error[7] ($rst_outfile)"); # print html output } else { print ("$outputs$outpute"); # print html output } } elsif ($rst_mode eq "createsyntax") ##################create syntax ###################### { if (($rst_cmode eq "answer") && ($rst_amode eq "text")) # catch special case: text answer tag at end of line (not covered above) { # there are two possibilities... string variables or numeric. we assume numeric above, string here # print (SYNTAXOUT "COMPUTE $rst_avname =0.\n"); print (SYNTAXOUT "STRING $rst_avname (A$rst_maxlength).\n"); print (SYNTAXOUT "VARIABLE LABELS $rst_avname \"$rst_csquestiontag\".\n"); } elsif (($rst_tagcounter == 1) && ($rst_cmode eq "answer")) { &rst_cs_answerout; } } return (0); } # end sub # print part of survey. you must tell this sub from which line of the file to start with # it will return 0, if everything went ok, the survey reached its end or {quit} was found # only if {newpage} was found, there will be a return code: the line # sub rst_printsurveypart { ($rst_linenumber) = @_; # number of line we are beginning with my @surveyfile; # contains the whole file my $rst_psp_error; my $rst_fanswerno; # filter answer number to be checked my $rst_fanswernoseq; # filter sequence answer number to be checked print ("Trying to open surveyfile '$rst_surveyfile'\n

\n") if ($debug > 2); open (SURVEY, $rst_surveyfile) or do { &append_errorlog ("Error while reading survey file: $rst_surveyfile. $!"); return(0); }; # open (FILE, "$savedir$number.html") or die ("Error while reading $savedir$number.html. $!\n"); @surveyfile = ; # read file in one big slurp. close (SURVEY); # or return ("Error while closing survey file: $rst_surveyfile. $!"); # print ("Survey file successfully read \n") if ($debug > 2); # check if there has been a filter defined if ($rst_filter_conditions) { &append_log ("We are in Filter mode - checking '$rst_filter_conditions' for filters\n") if ($debug > 2); foreach $rst_text (split ("__§§", $rst_filter_conditions)) { &append_log ("Extracting '$rst_text'\n") if ($debug > 2); ($rst_qvname,$rst_fanswerno,$rst_fanswernoseq,$rst_filter_aname) = ($rst_text =~ /^(.*)_§(.*)_§(.*)_§(.*)$/); &append_log ("Found '$rst_qvname,$rst_fanswerno,$rst_fanswernoseq,$rst_filter_aname'\n") if ($debug > 2); &append_log ("Trying to get variable '$rst_qvname'\n") if ($debug > 2); $rst_error = &rst_getvar ($rst_qvname); # get variable from file; error in human readable format if ($rst_error) {&append_errorlog ($rst_error); return;} # if there is any error quit &append_log ("Got variable '$rst_qvname' und checke '$rst_vars{$rst_qvname}{$rst_idnumber}' auf '$rst_fanswerno$rst_fanswernoseq'\n") if ($debug > 2); if ($rst_vars{$rst_qvname}{$rst_idnumber} eq "$rst_fanswerno$rst_fanswernoseq") { # filter in effect # search through survey file for filter anchor &append_log ("Filter found! '$rst_fanswerno$rst_fanswernoseq'... searching for Anchor\n") if ($debug > 2); for ($rst_text=0; $rst_text < @surveyfile; $rst_text++) { if (($_) = ($surveyfile[$rst_text] =~ /^\{filteranchor_(.*)}/)) { &append_log ("Found Filteranchor in line $rst_text: '$surveyfile[$rst_text]', extrahiert: '$_'\n") if ($debug > 2); if ($rst_filter_aname eq $_) { $rst_linenumber = $rst_text; &append_log ("Found matching Filteranchor in line $rst_text, continuing survey at line $rst_linenumber'\n") if ($debug > 2); # Calculating Variable name to continue with $rst_questionno=0; &append_log ("Setze \$rst_questionno auf 0'\n") if ($debug > 2); for ($rst_text=0; $rst_text < $rst_linenumber; $rst_text++) { $_=$surveyfile[$rst_text]; if (!/^{Q/) {next}; if (/^{Q.*=/) { &append_log ("Q gefunden mit = \n") if ($debug > 2); next; } else { $rst_questionno++; &append_log ("Zähle \$rst_questionno hoch'\n") if ($debug > 2); } } last; } } } # filter anchor not found - print error and give up $_ = @surveyfile; &append_log ("Zähler: '$rst_text' und '$_'\n") if ($debug > 2); if ($rst_text == @surveyfile) # Schleife ganz durchlaufen -> Fehlermeldung { &append_errorlog ("$rst_error[24] ($rst_filter_aname)\n"); &rst_htmlerror ("$rst_error[24]: ($rst_filter_aname)\n"); die(); } } } $rst_filter_conditions=""; # reset filter conditions $rst_filter_aname=""; # reset filter anchor } while (1) { $parseline=$surveyfile[$rst_linenumber]; # get line number &append_log ("Found at line $rst_linenumber: '$parseline'\n") if ($debug > 2); $rst_psp_error= &rst_parseline($parseline); # parseline, 0: no error # &append_log ("Error after parsing: $rst_error\n") if ($debug > 2); if ($rst_psp_error) { if ($rst_psp_error == 1) # {quit} found { return (0); # quit command, return code for this # end of survey (or quit);return {newpage} *** } elsif ($rst_psp_error ==2) # {newpage} found { return ($rst_linenumber+1); # return line number to continue with } # undefined return code append_errorlog ("$rst_error[3]: $rst_psp_error in line $rst_linenumber \n"); last; } $rst_linenumber++; # increase line number if ($rst_linenumber >= scalar @surveyfile) {return(0)}; # read last line, return 0 code } return (0); } # # $rst_psmode can be: 1 (print survey until end) / 2 (print until {newpage} # # sub rst_printsurvey { (my $rst_psmode, my $rst_psidnumber) = @_; # print mode (all, part); number of survey user (for tracking) my $rst_psretline; # line which was lastly parsed if ($rst_mode eq "survey") { &rst_printpageheader("$rst_surveyname - $rst_html_pagenumber"); } $rst_psretline = &rst_printsurveypart($rst_surveyline); if ($rst_mode eq "survey") { if ($rst_invokemode == 1) # command line mode - print output { print (CLOUTFILE "\n\n") or &rst_htmldie("$rst_error[7] ($rst_outfile)"); # print html output print (CLOUTFILE "\n") or &rst_htmldie("$rst_error[7] ($rst_outfile)"); # print html output } else # not command line mode { # print current line to continue with print ("\n\n"); # print questionnumber to continue with print ("\n"); # print number of survey page to continue with print ("\n"); print ("\n"); print ("\n"); } # change button in last survey page, if we are in view mode. if (($rst_cfgmode eq "view") && ($rst_psretline == 0)) {$rst_button_type = "button"}; &rst_printpagefooter(); } } sub rst_increaseID { # get and increase id number (of participant) use Fcntl; sysopen(FH, $rst_idnumberfile, O_RDWR|O_CREAT, 0644) or return (10); # $rst_error= O_RDWR; # print ("mode for file open: $rst_error '\n"); flock(FH, 2) or return (11); $rst_idnumber = || 0; seek(FH, 0, 0) or return (12); truncate(FH, 0) or return (13); $rst_idnumber++; (print FH $rst_idnumber, "\n") or return (14); # write increased number # DO NOT UNLOCK THIS UNTIL YOU CLOSE close FH or return (15); # flock(FH, 8) or return (16); return(0); } sub rst_writedatafile { (my $file, my $text) = @_; $file =~ s/\0\|//g; # remove 0 code, pipe code (security) open (FH, ">>$file") or return (1); flock(FH, 6) or return (2); # exclusive lock, return now. "can't flock numfile: $!"; (print FH $text, "\n") or return (3); # "can't write numfile: $!"; close FH or return (4); # "can't close numfile: $!"; # flock(FH, 8) or return (5); # can't unlock return (0); } sub rst_writedata { # write data to file # write to normal dir (defined in config), if this doesn't work, write to alternative dir (my $var, my $val) = @_; my $counter=3; while ($counter--) { $rst_error = &rst_writedatafile ($rst_datadir . $var, $val); if (!$rst_error) {last}; # if there was no error, exit sleep (1); next; } if ($rst_error) { &append_errorlog("$rst_error[7] $rst_error ($rst_datadir$var): $val - Check $rst_datadir_alt\n"); if (&rst_writedatafile ($rst_datadir_alt . $var, $val)) { &append_errorlog("$rst_error[7] ($rst_datadir_alt$var): $val\n"); } } } ##########################################print results################################### sub rst_printresults { (my $datadir, my $outputfile) = @_; my $line; my %data; my @vars; my @ids; while (<$datadir*>) # cycling through all filenames in data dir { # print ("Found dir: '$_'\n"); ($var)=/([^\/]+)$/; # print ("Found var '$var'\n"); push @vars, $var; open (FH, "<$_") or return (8); # can't open directory while () { next if (/^#/ || /^\s*\n?$/); # skip comments and empty lines # print ("Found line: '$_' in file $var\n"); ($id, $val) = /(\d+)\s+(.*)/; if ($data{$id}{$var}) {&append_log ("ERROR - ID ($id) multiple defined in $var\n")}; # print ("Found id '$id' and '$val' in file $var\n"); $data{$id}{$var}=$val; } close (FH); } # all read, now output, first sort vars # problem: Q7_13 Q8 Q8_1 Q8_2 Q19_7 Q20_1 Q20_10 Q20_11 Q20_12 # known bug: Q8 not sorted in correctly @vars = sort { (($a=~/^.(\d+)/)[0] or 0) <=> (($b=~/^.(\d+)/)[0] or 0) || ((($a=~/.*\D+(\d+)/)[0]) || 1) <=> ((($b=~/.*\D+(\d+)/)[0]) || 1) } @vars; open (FILEOUT, ">$outputfile") or return (9); # print all variables with tabs print (FILEOUT "id") or return (17); foreach $var ( @vars) { print (FILEOUT "\t$var") or return (17); } print (FILEOUT "\n") or return (17); foreach $id (sort {$a <=> $b} keys %data) { print (FILEOUT $id) or return (17); foreach $var (@vars) { print (FILEOUT "\t") or return (17); $_=$data{$id}{$var}; if (defined $_) { if ($var =~ /_time./) # convert time to excel readable format { my $rst_text = $_; $_=&kh_convertdate($_); # &append_log ("Calculated date: '$_' (original: $rst_text)\n") if ($debug > 2); } print FILEOUT $_ or return (17) }; } print (FILEOUT "\n") or return (17); } close (FILEOUT) or return (18); return (0); } #################################################end of print results################################ # print html of outputfile offer sub rst_outputfile { $|=1; print ("Content-type: text/html\n\n"); print ("

Click here to get file (be sure to do Shift-Reload to avoid caching)


But hurry up, it will be deleted in two minutes!

\n"); print ("\n
\n\n"); # print ("Content-type: text/html\n\n"); # sleep (120); # wait two minutes # unlink $rst_resultsoutputfile; # delete file for security reasons # system ("cat $rst_resultsoutputfile"); } sub rst_getvar { (my $var) = @_; open (VARFILE, "<$rst_datadir$var") or return ("$rst_error[8] ($rst_datadir$var)\n"); my @buffer = ; close (VARFILE); # $rst_vars{$var}=1; # set flag so that each needed variable is only read once my $line; my $rid; my $value; foreach (@buffer) { if (($id, $value) = /\s*(\d+)\s+(.*)/) { # i should check if var is already existing $rst_vars{$var}{$id}=$value; # &append_log ("get var: reading for var $var id $id and value $value\n"); } } return (0); } sub rst_calc_summary { # subroutine for calculations in result mode (my $line) = @_; my $val; my $var; my $id; $_ = $line; if (/^mail/i) # send mail command { my $rst_email; ($rst_email) = /^mail (.*)$/i; # extract mail address &append_log ("Found Mail. Sending to '$rst_email'\n"); $rst_text = $rst_mail_survey_submit; $rst_text =~ s/\$(\w+)/${$1}/g; # expanding variables qx {$rst_mailcommand \"$rst_text\" $rst_email}; } elsif (($val, $var) = /tail\((\d+),\s*(.+)\)/) # last $val lines of variable { if (!$rst_vars{$var}) { $rst_error = &rst_getvar ($var); # error in human readable format if ($rst_error) {&append_errorlog ($rst_error); return;} } my $alength = keys %{$rst_vars{$var} }; if ($val > $alength) {$val = $alength}; $val--; for $id ( (reverse sort {$a <=> $b} keys %{ $rst_vars{$var} })[0..$val] ) { if (!$id) {next}; if (exists ($rst_vars{$var}{$id})) { print ("$rst_vars{$var}{$id}
\n"); } } } elsif (($val, $var) = /head\((\d+),\s*(.+)\)/) # first $val lines of variable { if (!$rst_vars{$var}) { $rst_error = &rst_getvar ($var); # error in human readable format if ($rst_error) {&append_errorlog ($rst_error); return;} } # my $alength = scalar @{$rst_vars{$var}}; $alength = keys %{ $rst_vars{$var} }; if ($val > $alength) {$val = $alength}; $val--; for $id ( (sort {$a <=> $b} keys %{ $rst_vars{$var} })[0..$val] ) { if (!$id) {next}; if (exists $rst_vars{$var}{$id}) { print ("$rst_vars{$var}{$id}
\n"); } } } elsif (($var) = /mean\((.*)\)/) # calculate mean of variable { if (!$rst_vars{$var}) { $rst_error = &rst_getvar ($var); # error in human readable format if ($rst_error) {&append_errorlog ($rst_error); return;} } my $sum=0; my $num=0; for $val (sort keys %{ $rst_vars{$var} }) { if ($rst_vars{$var}{$val} =~ /^\d+$/) { $sum += $rst_vars{$var}{$val}; $num++; } } # &append_log ("mean (\$sum= $sum) and \$num = $num\n"); print ($num ? ($sum/$num) : "no data"); } elsif (($var) = /maxindex\((.*)\)/) # max index (that is biggest number of ID) { if (!$rst_vars{$var}) { $rst_error = &rst_getvar ($var); # error in human readable format if ($rst_error) {&append_errorlog ($rst_error); return;} } $val = keys %{ $rst_vars{$var} }; print ($val ? $val : "no data"); } elsif (($var) = /max\((.*)\)/) # max (most frequent value) { if (!$rst_vars{$var}) { $rst_error = &rst_getvar ($var); # error in human readable format if ($rst_error) {&append_errorlog ($rst_error); return;} } my $max=0; for $val (sort keys %{ $rst_vars{$var} }) { $_=$rst_vars{$var}{$val}; if (/^\d+$/) { if ($_ > $max) {$max=$_}; } } print ($max ? $max : "no data"); } return (0); } sub rst_parse_summary { (my $format_text) = @_; my @lines = split ("\n", $format_text); my $tag; foreach (@lines) { s/\$(\w+)/${$1}/g; # expand variable names ; ${ to equalize next line # &append_log ("Found line: '$_'\n"); foreach $tag (split (/({[^}]*})/)) { # example of tag: {tail(10, Q1)} if ($tag =~ /{(.*)}/) { &rst_calc_summary ($1) } elsif ($tag) {print ("$tag")}; } print ("\n"); } ################for debugging.... print all read arrays ########################################## # # # print the whole thing sorted by number of values # foreach $var ( sort { keys %{$rst_vars{$b}} <=> keys %{$rst_vars{$a}} } keys %rst_vars ) { # print "$var: { "; # for $val ( sort keys %{ $rst_vars{$var} } ) { # print "$val=$rst_vars{$var}{$val} "; # } # print "}
\n"; # } } sub rst_printhelp { if (defined $rst_error[0]) {print $rst_error[0];} # print error message in locale language else { # print english error message by default print < 2); my $rst_ostype = $^O; # find out operating system type print ("Operating System: '$rst_ostype'\n") if ($debug > 2); my $rst_self=$0; # name of script print ("I am '$rst_self'\n") if ($debug > 2); # my $var, my $val; # print environment variables. (comment out for testing) # foreach $var (keys %ENV) # { # print ("'$var' = $ENV{$var}
\n"); # } if ($ENV{"REMOTE_ADDR"}) # check for cgi mode { $rst_invokemode=2; # CGI-Script print ("\n CGI invoked...
\n") if ($debug > 2); my $query=new CGI; @rst_cgi_postdata = $query->param; my $var; my $val; $rst_text= $query->param("_surveycfg"); # not included in next line to avoid "use of uninitialized value" warning in apache error log if (!$rst_text) {$rst_text = ""}; if ($rst_text) # get config mode... ######################### { $rst_surveycfg=$rst_text; # save survey config # &append_log ("found surveycfgfile '$rst_text'\n"); open (CFGFILE, "<$rst_maincfgfile") or open (CFGFILE, "<$rst_maincfgfile2") or &rst_htmldie ("Fatal error while opening maincfgfile '$rst_maincfgfile': $!"); my @buffer= or &rst_htmldie ("Fatal error while opening maincfgfile '$rst_maincfgfile': $!"); close (CFGFILE) or &rst_htmldie ("Fatal error while opening maincfgfile '$rst_maincfgfile': $!"); my $survey; my $path; foreach (@buffer) # read main config file and search for survey { # &append_log ("found line '$_'\n"); next if (/^#/ || /^\s*\n?$/); ($survey, $path)=/^(\S+)\s+(\S+)/; # get first two arguments ($rst_cfgmode)=/^\S+\s+\S+\s+(\S+)/; # get last argument, if set. currently mode. if (!$rst_cfgmode) {$rst_cfgmode = ""}; # &append_log ("found survey, path '$survey', '$path' and mode: '$rst_cfgmode'\n"); if ($survey && $survey eq $rst_surveycfg) { $rst_configfile = $path; last; }; } } # if it was not defined, let's hope it will be found somehow... *** &rst_readconfig(); $rst_text= $query->param("_cfgmode"); # not included in next line to avoid "use of uninitialized value" warning in apache error log if (!$rst_text) {$rst_text = ""}; if ($rst_text eq "view") {$rst_cfgmode="view"}; # set view only mode $rst_text= $query->param("_mode"); # not included in next line to avoid "use of uninitialized value" warning in apache error log if (!$rst_text) {$rst_text = ""}; if ($rst_text eq "results") # result mode... ######################### { $rst_idnumber = 0; my $rst_password = $query->param("_password"); # transmitted password my $rst_resaction = $query->param("_resaction"); # result action my $rst_resultmode = $query->param("_resultmode"); # result mode if (!$rst_password) {$rst_password = ""}; if (!$rst_resaction) {$rst_resaction = ""}; # to avoid warnings if (!$rst_resultmode) {$rst_resultmode = ""}; if (!$rst_resultspw[1]) {$rst_resultspw[1] = $rst_resultspw}; # to ensure upward compatibility if (!$rst_resultspw[2]) {$rst_resultspw[2] = $rst_resultspw}; # if old passwords are not set # if ($rst_resultspw ne ($query->param("_password") or 0)) # check if password is correct. if not, continue # { # # print ("Password: " . $query->param("_password") . "\n
"); # $rst_surveyfile = $rst_results_file; # return (1); # return code for beginning survey # } if (($rst_resaction == 1) && ($rst_resultmode == 1) && ($rst_resultspw[1] eq $rst_password)) { # print excel formatted data $|=1; # print ("Content-type: multipart/x-mixed-replace; boundary=wait_next\n\n"); # print ("\n--wait_next\n\n"); $rst_error = &rst_printresults ($rst_datadir, $rst_resultsoutputfile); # print ("\n--wait_next\n\n"); if ($rst_error) { &rst_htmlerror ("An error occurred while trying to create outputfile: $rst_error[$rst_error]\n
Datadir was $rst_datadir and output file was $rst_resultsoutputfile"); &append_errorlog ("$rst_error[$rst_error] while trying to create resultsoutputfile $rst_resultsoutputfile\n"); return (4); } &rst_outputfile(); # print offer for outputfile return(4); # end script } elsif (($rst_resaction == 1) && ($rst_resultmode == 2) && ($rst_resultspw[1] eq $rst_password)) { # create spss syntax $rst_mode="createsyntax"; open (SYNTAXOUT, ">$rst_resultsoutputfile") or &append_errorlog("$rst_error[19]\n"); print (SYNTAXOUT "/* SPSS Syntax, created by RST Survey Tool, (c) Kajetan Hinner, Version: $rst_version*/") or &append_errorlog("$rst_error[20]\n"); print (SYNTAXOUT "\nSAVE OUTFILE='$rst_surveyname.sav'\n /COMPRESSED.\n\n"); &rst_printsurvey (2, 0); # print whole survey, using ($rst_idnumber) = 0 print (SYNTAXOUT "\nEXECUTE.\n\n"); close (SYNTAXOUT) or &append_errorlog("$rst_error[21]\n"); &rst_outputfile(); # print offer for outputfile return(4); # end script } elsif (($rst_resaction == 2) && ($rst_resultspw[2] eq $rst_password)) { # print summary &rst_parse_summary ($rst_summary_html); return (4); # end script } elsif (($rst_resaction == 3) && ($rst_resultspw[3] eq $rst_password)) { # execute user program for summary do $rst_results_script; if ($@) { &rst_htmldie ("$rst_error[23] ($@)\n") }; return (4); # end script } # else # { # print ("Content-type: text/html\n\n"); # print ("
Not implemented yet. Please go back and select something else..."); # print ("
"); # return (4); # } $rst_surveyfile = $rst_results_file; # password was incorrect or unknown mode return (1); # return code for beginning survey } # end if results mode elsif ($rst_text = $query->param("_version")) # if version set. get and write variables ########### { if ($rst_text =~ /^RST/) # check if invoked by RST # different version checking should be here. { if ($rst_cfgmode ne "view") # if we are in view mode, skip var write { $rst_idnumber = $query->param("_idnumber"); # get number of survey hit foreach $var (@rst_cgi_postdata) { if ($var =~ /^_/) # check for special vars { if ($var eq "_idnumber") {next}; # those variables won't be written if ($var eq "_surveycfg") {next}; # check for special variables if ($var eq "_cfgmode") {next}; # Config mode (i.e. view) if ($var eq "_continueline") { $rst_surveyline = $query->param("$var"); # number of line to continue with (0 means end) }; if ($var eq "_questionno") { $rst_questionno = $query->param($var); # number of line to continue with (0 means end) }; if ($var eq "_pagenumber") { $rst_html_pagenumber = $query->param($var); if ($rst_html_pagenumber =~ /\D+/) {$rst_html_pagenumber = "Please check rst_html_pagenumber code"}; # Sanity check: only digits # get html page number (printed in the HTML page title) }; if ($var eq "_filtercons") { $rst_filter_conditions= $query->param($var); if (!$rst_filter_conditions) {$rst_filter_conditions= ""}; }; } else # not a special (internal) var; write it to file { if (defined ($_=$query->param($var))) # get value of variable { if ($var =~ /_m$/) # include code for multiple select answers! { &append_log ("found _m variable '$var'\n"); @_=$query->param($var); # read value in array &append_log ("getting values, first element of \@_ is now '$_[0]'\n"); $_=join (",", @_); &append_log ("getting values, \$_ is now '$_'\n"); } s/\n/
/g; # new lines will be replaced by
(html break code) s/\r//g; # returns will be replaced by carriage return code &rst_writedata($var, "$rst_idnumber\t$_\n"); # write data } } # print ("Variable: '$var', Value: " . $query->param($var) . "\n
\n"); # print output } # end for each all transmitted variables return (2); # return code for continue with survey } # end if we are not in view mode } # end if version began with rst } # end if version was set else # no id number so far; create one ###beginning of survey### { if ($rst_cfgmode ne "view") # are we in view only mode? { $rst_error = &rst_increaseID(); if ($rst_error) { &append_errorlog ("$rst_error[$rst_error] ($rst_idnumberfile) $!\n"); &rst_htmlerror ("$rst_error[$rst_error]: ($rst_idnumberfile) $!\n"); die(); } &rst_writedata("_timeb", "$rst_idnumber\t" . ctime() ."\n"); # write begin time for user id } else # we are in view only mode { $rst_idnumber = 0; # set ID number to zero. } return(1); # return code for beginning survey } } # end if cgi mode my $rst_argv = @ARGV; my $rst_arg; if ($rst_argv == 0) { &rst_printhelp(); return (4); # quit } else { print ("\nCommand line arguments: $rst_argv\n"); foreach (@ARGV) { print ("Argument: '$_'\n"); if (/^-h/) {&rst_printhelp(); return(4);} # print help if (/^-c/) # config file { ($rst_configfile) = /^-c(.*)/; print ("Configfile: $rst_configfile\n"); } elsif (/^-l/) { ($rst_localefile) = /^-l(.*)/; print ("Localefile: $rst_localefile\n"); } elsif (/^-s/) { ($rst_surveycfg) = /^-s(.*)/; print ("rst_surveycfg: $rst_surveycfg\n"); } elsif (!$rst_surveyfile) { $rst_surveyfile = $_; } elsif (!$rst_outfile) # file to write HTML survey code to. { $rst_outfile = $_; } } if (! -e $rst_configfile) # If config file doesn't exist, search for an alternative { $rst_configfile="rst_demo.us.config"; } if (!$rst_outfile) # If user did not define outfile, we will do it. { $rst_outfile=$rst_configfile . ".html"; } } print ("Config File: $rst_configfile\n"); print ("Output File: $rst_outfile\n"); $rst_invokemode=1; # code for command line &rst_readconfig(); # read configuration return(3); # code for command line mode } ################### main ################### print ("Content-type: text/html\n\n\n\n") if ($debug); # results d/l file won't work then print ("Debug Mode On ($debug)\n") if ($debug); print ("Starting...\n") if ($debug > 2); # started for the first time $rst_idnumber = 1; # temp. number of user $rst_surveyline = 1; # parse and print survey starting with line# # &rst_readconfig(); # get environment, read config and return what follows next... $rst_error=&rst_getenvironment(); # 1: print survey from beginning # 2: continue survey # 3: command line mode # 4: quit # print ("Return of getenvironment(): $rst_error
\n") if ($debug > 2); if ($rst_error == 1) { &rst_printsurvey(2, $rst_idnumber); } elsif ($rst_error == 2) # continue survey { if ($rst_surveyline) # yes, we have some more survey text... print this { &rst_printsurvey(2, $rst_idnumber); } else # no, end reached { # write time, when survey was completed &rst_writedata("_timee", "$rst_idnumber\t" . ctime() ."\n"); # write time end &rst_parse_summary ($rst_eos_header); # $rst_text = $rst_eos_header; $rst_text =~ s/\$(\w+)/${$1}/g; # print $rst_text; # print $rst_eos_footer; # print end of survey output... if ($rst_eos_commands) # are there some commands which should be executed? { eval $rst_eos_commands; } } } elsif ($rst_error == 3) # command line mode. print survey in file, errors on stdout() { open (CLOUTFILE, ">$rst_outfile") or &rst_htmldie("$rst_error[7] ($rst_outfile)"); &rst_printsurvey(1, $rst_idnumber); close (CLOUTFILE) or &rst_htmldie("$rst_error[7] ($rst_outfile)"); } elsif ($rst_error == 4) # end survey. done- { exit(0); } # &rst_printsurvey($rst_idnumber); # that's it.