print MAILOUT "Date_Time: "."$date\n"; # For each form field, print the form field and value. foreach $field (@Field_Order) { print MAILOUT "$field: $Form{$field}\n"; } # Print blank line after each form print MAILOUT "\n"; close(MAILOUT); } else { print "Content-type: text/html\n\n"; print ""; print ""; print " $studyname "; print ""; print ""; print ""; print "
"; print "
"; print "The server is busy.
"; print "Please press the Back button on your browser and try again."; print "
"; print "
"; print "
"; print ""; print ""; close(STDOUT); exit 0; } } # ----------------------------------------------------------------------------- # --------- Remove bookmark and add id=xxx from the end of nexturl link ------- # --------- Format: url?id=xxx ------- # ----------------------------------------------------------------------------- $bookmark=''; $Position = index($nexturl,"#"); if ($Position > 0) { $bookmark = substr($nexturl,$Position+1); $nextpage = substr($nexturl,0,$Position); } else { $nextpage = $nexturl; } $finalurl = $nextpage."?id=".$respondentID; # ------------------------------------------------------------------ # ---- Load the next page and substitute the hidden variable(s) ---- # ------------------------------------------------------------------ # ---- Substitute the hidden fields ---- $P = get($finalurl); $hidden = ""; $substring = "\n"; if ($currentpage > $highestpage) { $highestpage = $currentpage; } $substring .= "\n"; # ----------------------------------------------------------------------------- # ----- Write the retain fields as a hidden field on the next survey page ----- # ---- Format for the retain field is: "/VARNAME/VARNAME/VARNAME/" ----- # ----------------------------------------------------------------------------- foreach $field (@Field_Order) { $lookfor = "/".$field."/"; if ($retain =~ m/$lookfor/i) { $substring .= "\n"; } } $P =~ s/$hidden/$substring/gis; # ------------------------------------------------------------- # -------------- Do a substitution for any pipes -------------- # ------------------------------------------------------------- while (index($P, "\(*") != -1) { $startpos = index($P, "(*"); $endpos = index($P, "*)", startpos); $replacethis = substr($P, $startpos, $endpos - $startpos + 2); $varname = substr($P, $startpos + 2, $endpos - $startpos - 2); # Find the hidden field that contains the current value of $varname $lookfor = "hidden\" name=\"".$varname."\" value=\""; $startpos = index($P, $lookfor); if ($startpos == -1) { $currentvalue = ""; } else { $startpos += length($lookfor); $endpos = index($P, "\"", $startpos); $currentvalue = substr($P, $startpos, $endpos - $startpos); } # Find the $pipe for variable $varname_pipe value field - Format: ^^1=abc^^2=xyz^^ $lookfor = "hidden\" name=\"".$varname."_pipe\" value=\""; $startpos = index($P, $lookfor); if ($startpos == -1) { $pipetext = $currentvalue; } else { $startpos += length($lookfor); $lookfor = "^^".$currentvalue."="; $startpos = index($P, $lookfor, $startpos); if ($startpos == -1) { $pipetext = ""; } else { $startpos += length($lookfor); $endpos = index($P, "^^", $startpos); $pipetext = substr($P, $startpos, $endpos - $startpos); } } $P =~ s/\Q$replacethis/$pipetext\E/gs; } # ----------------------------------------------------------------- # ---- Rotate value labels for radio button rotation variables ---- # ----------------------------------------------------------------- # Variable names to be rotated are stored in $rotate_radio # Format for $rotate-radio is: VARNAMEx^^VARNAMEy^^VARNAMEz^^ # Where the x, y, and z are the number of value labels not rotated (holdouts) # Are there any radio button rotations on this page? $lookfor = "hidden\" name=\"rotate_radio\" value=\""; $startpos = index($P, $lookfor); if ($startpos != -1) { $startpos += length($lookfor); $endpos = index($P, "\"", $startpos); $rotate_vars = substr($P, $startpos, $endpos - $startpos); @rotate_variables = split(/\^\^/,$rotate_vars); $number_rotate_variables = scalar(@rotate_variables); $var_counter = 0; # Do for each variable on this page to be rotated while ($var_counter < $number_rotate_variables) { $varname = $rotate_variables[$var_counter]; $varname =~ s/\^\^//g; # Remove number at end of name (x, y, z) $holdouts = substr($varname,length($varname)-1,1); $varname = substr($varname,0,length($varname)-1); # Do for each occurance of the varname in the html # Find position in html for value and substitute (*RBPos*) # Html example: Yes< $startpos = 0; $sub_counter = 0; while ($startpos != -1) { $lookfor = "radio\" name=\"".$varname."\" value=\""; $startpos = index($P, $lookfor); if ($startpos != -1) { $endpos = index($P, "\<", $startpos); $lookfor = "\ 0) { $tmp = $sub_counter - 1; $lookfor = "(*RBPos".$tmp."*)"; $startpos = index($P, $lookfor); if ($startpos != -1) { $endpos = index($P, "\<", $startpos); $P = substr($P,0,$startpos).$rotatetext[$sub_counter - 1].substr($P,$endpos); $sub_counter = $sub_counter - 1; } $holdouts = $holdouts - 1; } # Initialize $used[] to zero for($counter=0 ; $counter < $sub_counter ; $counter++) { $used[$counter] = 0; } $remaining = $sub_counter; # Generate a random integer between 0 and $sub_counter - 1 # Find (*RBPos?*) in html and substitute the random selection while ($remaining > 0) { $random = int(rand($sub_counter)); if ($used[$random] != 1) { $tmp = $remaining - 1; $lookfor = "(*RBPos".$tmp."*)"; $startpos = index($P, $lookfor); if ($startpos != -1) { $endpos = index($P, "\<", $startpos); $P = substr($P,0,$startpos).$rotatetext[$random].substr($P,$endpos); } $used[$random] = 1; $remaining = $remaining - 1; } } $var_counter += 1; } } # ---------------------------------------------------------- # ---- Rotate variables and value labels for checkboxes ---- # ---------------------------------------------------------- # Variable name of rotation is held in $rotate_checkbox # Format $rotate_checkbox field is: "VARNAME1^^VARNAME2^^VARNAME3^^::VARNAME1^^VARNAME2^^" # # looks like this in the html # Internet
# Magazine or Newsletter
# Word of mouth
# Other< # Are there are any checkbox rotations on this page? $lookfor = "hidden\" name=\"rotate_checkbox\" value=\""; $startpos = index($P, $lookfor); if ($startpos != -1) { $startpos += length($lookfor); $endpos = index($P, "\"", $startpos); $rotate_vars = substr($P, $startpos, $endpos - $startpos); @rotate_groups = split(/\:\:/,$rotate_vars); $number_rotate_groups = scalar(@rotate_groups); $group_counter = 0; # Do for each group of checkbox variables while ($group_counter < $number_rotate_groups) { @rotate_variables = split(/\^\^/,$rotate_groups[$group_counter]); $number_rotate_variables = scalar(@rotate_variables); $var_counter = 0; # Do for each checkbox rotation in this group while ($var_counter < $number_rotate_variables) { $varname = $rotate_variables[$var_counter]; $varname =~ s/\^\^//g; # Find the checkbox tag in the html - "checkbox" name="Hear_1" value="1">Internet<" # Load $rotatetext[] with the current and make it easy to find in the next pass $lookfor = "checkbox\" name=\"".$varname."\" value=\""; $startpos = index($P, $lookfor); if ($startpos != -1) { $endpos = index($P, "\<", $startpos); $lookfor = "\ 0) { $random = int(rand($number_rotate_variables)); if ($used[$random] != 1) { $tmp = $remaining - 1; $lookfor = "(*CBPos".$tmp."*)"; $startpos = index($P, $lookfor); if ($startpos != -1) { $endpos = index($P, "\<", $startpos); $P = substr($P,0,$startpos).$rotatetext[$random].substr($P,$endpos); } $used[$random] = 1; $remaining = $remaining - 1; } } $group_counter += 1; } } # ------------------------------------------------- # ---- Rotate variables in a horizontal format ---- # ------------------------------------------------- # Looks like this: # # 5e. Power and completeness. # # # # # # # Search for: type="radio" name="Power" # Substitute all of them with CBPosX # Variable name of rotation is held in $rotate_radio_horizontal # Format $rotate_checkbox field is: "VARNAME1^^VARNAME2^^VARNAME3^^::VARNAME1^^VARNAME2^^" # # Are there are any radio_horizontal rotations on this page? $lookfor = "hidden\" name=\"rotate_radio_horizontal\" value=\""; $startpos = index($P, $lookfor); if ($startpos != -1) { $startpos += length($lookfor); $endpos = index($P, "\"", $startpos); $rotate_vars = substr($P, $startpos, $endpos - $startpos); @rotate_groups = split(/\:\:/,$rotate_vars); $number_rotate_groups = scalar(@rotate_groups); $group_counter = 0; # Do for each group of horizontal radio buttons while ($group_counter < $number_rotate_groups) { @rotate_variables = split(/\^\^/,$rotate_groups[$group_counter]); $number_rotate_variables = scalar(@rotate_variables); $var_counter = 0; # Do for each checkbox rotation in this group while ($var_counter < $number_rotate_variables) { $varname = $rotate_variables[$var_counter]; $varname =~ s/\^\^//g; # Find the 1st horizonal radio tag in the html # Load $rotatetext[] and make it easy to find in the next pass $lookfor = "radio\" name=\"".$varname."\" value=\""; $startpos = index($P, $lookfor); if ($startpos != -1) { $endpos = index($P, "\<\/tr>", $startpos); $lookfor = "\"; $startpos = rindex($P, $lookfor, $startpos) + 4; if ($endpos != -1) { $rotatetext[$var_counter] = substr($P, $startpos, $endpos - $startpos); $P = substr($P,0,$startpos)."(*HRPos".$var_counter."*)".substr($P,$endpos); # Need to store color and bgcolor so the bar colors can be replaced $lookfor = " color\=\""; $startpos = index($rotatetext[$var_counter], $lookfor); $lookfor = "\""; $endpos = index($rotatetext[$var_counter], $lookfor, $startpos + 8); $color[$var_counter] = substr($rotatetext[$var_counter], $startpos, $endpos - $startpos); $lookfor = " bgcolor\=\""; $startpos = index($rotatetext[$var_counter], $lookfor); $lookfor = "\""; $endpos = index($rotatetext[$var_counter], $lookfor, $startpos + 10); $bgcolor[$var_counter] = substr($rotatetext[$var_counter], $startpos, $endpos - $startpos); } } $var_counter += 1; } # Initialize $used() to zero for($counter=0 ; $counter < $number_rotate_variables ; $counter++) { $used[$counter] = 0; } $remaining = $number_rotate_variables; # Generate a random integer between 0 and $number_rotate_variables - 1 # Find (*HRPos?*) in html and substitute while ($remaining > 0) { $random = int(rand($number_rotate_variables)); if ($used[$random] != 1) { $tmp = $remaining - 1; $lookfor = "(*HRPos".$tmp."*)"; $startpos = index($P, $lookfor); if ($startpos != -1) { $endpos = index($P, "\<", $startpos); # Replace color="xx" in $rotatetext[$random] with $color[$remaining-1] $rotatetext[$random] =~s/$color[$random]/$color[$remaining-1]/g; # Replace bgcolor="xx" in $rotatetext[$random] with $bgcolor[$remaining-1] $rotatetext[$random] =~s/$bgcolor[$random]/$bgcolor[$remaining-1]/g; $P = substr($P,0,$startpos).$rotatetext[$random].substr($P,$endpos); } $used[$random] = 1; $remaining = $remaining - 1; } } $group_counter += 1; } } # ------------------------------------------------------------------- # ---- Substitue "./././" with the full url to the survey folder ---- # ------------------------------------------------------------------- $lookfor = './././'; $P =~ s/\Q$lookfor/$surveyfolder\E/gs; # ----------------------------------------------------------- # ------------------- Show the Next Page -------------------- # ----------------------------------------------------------- print "Content-Type: text/html\n"; if ($cookiecontrol ne "0") { &prepare_cookie; # Write the cookie print 'Set-Cookie: ' . $cookie_name . '=' . $cookie_value . ';'; print ' expires='.$cookie_date.';'; print ' path=/;'; print ' domain='.$cookie_domain.';\n'; } print "\n\n"; # Write the html page print $P; close(STDOUT); exit true; # ------------------------------------ # ---- Show A Perl Script Message ---- # ------------------------------------ sub showerror { print "Content-type: text/html\n\n"; print ""; print ""; print " $studyname "; print ""; print ""; print ""; print "StatPac Survey Processor

"; print "
"; print ""; print "$_[0]\n\n"; print ""; print ""; print ""; close(STDOUT); exit 0; } # ------------------------------- # --------- Read Cookie --------- # ------------------------------- sub read_cookie { $cookie_value = ''; if ($ENV{'HTTP_COOKIE'} ne '') { $cookie_value = $ENV{'HTTP_COOKIE'}; $Position = index($cookie_value, $cookie_name."\="); if ($Position != -1) { $cookie_value = substr($cookie_value, $Position + length($cookie_name) + 1); $Position = index($cookie_value, "\;"); $cookie_value = substr($cookie_value, 0, $Position); } # Decode cookie from hex to ASCII $cookie_value =~ tr/+/ /; $cookie_value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # Convert cookie values from: ^^ to = and :: to & $cookie_value =~ s/\^\^/=/g; $cookie_value =~ s/\:\:/&/g; #Split the cookie name=value&name=value into pairs @namval = sort(split(/&/,$cookie_value)); foreach (@namval) { tr/+/ /; s/=/ = /; s/%(..)/pack("C",hex($1))/ge; ($cnam, $cval) = split(/ = /,$_,2); $cookie{$cnam} = $cval; } } } # -------------------------------------------------------------------------------------- # ---- Prepare a cookie with respondent_ID, highest_page, and all the retain values ---- # -------------------------------------------------------------------------------------- sub prepare_cookie { # Get domain with a leading period as in .statpac.com $cookie_domain = $ENV {'SERVER_NAME'}; $cookie_domain =~ s/^www//i; if ($cookie_domain == "") { $url = $ENV {'HTTP_REFERER'}; $url =~ s/^http:\/\///i; $url =~ s/^https:\/\///i; $url =~ s/^www//i; $slash = index($url, "\/"); $cookie_domain = substr($url, 0, $slash); } # Format for cookie_date is: Wdy, DD-Mon-YYYY HH:MM:SS GMT @days = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); @months = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6]; $time = sprintf("%02d:%02d:%02d",$hour,$min,$sec); if ($mday < 10) {$mday = "0".$mday;} $year += 1900 + 2; #Sets cookie expiration to 2 years $cookie_date = "$days[$wday], $mday-$months[$mon]-$year $time GMT"; #cookie uses "^^ as =" and ":: as &" $cookie_value = 'Respondent_ID^^'.$respondentID; $cookie_value .= '::'.'highestpage^^'.$highestpage; foreach $field (@Field_Order) { $lookfor = "/".$field."/"; if ($retain =~ m/$lookfor/i) { $cookie_value .= '::'.$field.'^^'.$dat{$field}; } } # Encode characters that can cause problems with cookie values $cookie_value =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg; $cookie_value =~ tr/ /+/; } # ------------------------------- # ---- Process the html form ---- # ------------------------------- sub process_form { # Define the configuration array for special fields # These fields will not be written to the response file %Config = ('recipient','', 'method','', 'directory','', 'studyname','', 'nexturl','', 'currentpage','', 'cache','', 'thankyoupage','', 'retain','', 'cookiecontrol','', 'button','', 'highestpage','', 'FileExt','', 'Respondent_ID','', 'basename',''); @pairs = split(/&/, $buffer); # Do for each name-value pair foreach $pair (@pairs) { # Split up the pair local($name, $value) = split(/=/, $pair); # Decode the form encoding $name =~ tr/+/ /; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # Erase any server side includes $value =~ s///g; # Erase any embedded carriage returns, tabs, line feed, & form feed characters $value =~ s/[\r\t\n\f]/ /g; # delete ^M's $value =~ s/\cM//g; # Erase any html tags $value =~ s//>/g; # Change double quote marks to single quote marks $value =~ s/\"/\'/g; # Put special field names in the %Config array & others in the %Form array # Save the order of the form fields in the @Field_Order array if (defined($Config{$name})) { $Config{$name} = $value; } else { if ($Form{$name} && $value) { $Form{$name} = "$Form{$name}, $value"; } elsif ($value || ($value eq '0')) { push(@Field_Order,$name); $Form{$name} = $value; } } } }