$TITLE

#!/usr/bin/perl5 my $TITLE = "Send message"; my $BGCOLOR = "#FFFFFF"; my $TEXT_COLOR_NORMAL = "#000000"; my $REQUIRED_TEXT_COLOR = "#000000"; my $BACKGROUND_URL = ""; my $CGI_DIR = "/cgi-bin"; my $SENDMAIL = "/usr/sbin/sendmail"; ## my $SENDMAIL = "/usr/lib/sendmail"; my $IMAGE_DIR = "http://research.cirp.org/images"; ## my $CC_EMAIL = "harrisond\@telus.net"; my $CC_EMAIL = ""; my $MODULE = "feedbk2.cgi"; &get_form_data; if (!$FORM_DATA{'mail'}) { &print_header; &print_html_form; } else { $error = 0; &print_header; &check_form_data; if (!$error) { &send_mail; &reply_to_user; } } exit(0); ######## THE SUBROUTINES ######## ######## # #sub get_form_data # # Gets the information submitted, decodes it, and puts it # into the $FORM_DATA associative array. # ######### sub get_form_data { $request_method = $ENV{'REQUEST_METHOD'}; if ($request_method eq "GET") { $form_info = $ENV{'QUERY_STRING'}; } else { $size_of_form_information = $ENV{'CONTENT_LENGTH'}; read (STDIN, $form_info, $size_of_form_information); } @key_value_pairs = split (/&/, $form_info); foreach $key_value (@key_value_pairs) { ($key, $value) = split (/=/, $key_value); $value =~ tr/+/ /; $value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg; if (defined($FORM_DATA{$key})) { $FORM_DATA{$key} = join (", ", $FORM_DATA{$key}, $value); } else { $FORM_DATA{$key} = $value; } } } #get_form_data ######## # #sub print_header # # Prints out HTML page headers. # ######## sub print_header { print ("Content-type: text/html\n\n"); print <<__END_OF_HTML_CODE__; \ \<\!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"\> \ \n\n$TITLE __END_OF_HTML_CODE__ }#print_header ######## # #sub print_html_form # # This subroutine prints out the HTML form the user fills in to # send an email message. # ######### sub print_html_form { print <<__END_OF_HTML_CODE__;

Ridged Band

SPECIALIZED TISSUE OF THE PENIS

Home

Questionnaire

QUESTIONNAIRE

Previous scientific papers published in the British Journal of Urology and BJU International dealt with the anatomy of the foreskin and its ridged band. However, there is still a great deal to be learned about the anatomy and function of the penis.

Instructions:

Repeat these tests until you think you have reliable answers. Don’t rush. Do the tests with penis flaccid (soft).

Try to relax. Contract your bulb muscles as quickly and firmly as you can. (The bulb muscles are the ones that squeeze the back end of the penis after urination.) Repeat the squeeze 5 -10 times so that you remember how hard or how easy it is to finish urination in the usual way. Can you feel the contraction?
Yes No
Repeat the above test, this time gently squeezing the urethra between thumb and forefinger at a point midway along the penis.
What effect does compression of the urethra have on bulb muscle contraction?

It makes no difference.

It makes it EASIER (less difficult, shorter time to full contraction).

It makes it MORE DIFFICULT (longer time to full contraction).
Your age:
18-29 30-39 40-49 50-59 60+
Were the instructions easy to understand?
Yes No

Your email address:

Your name (optional):

Additional comments:

Thank you for your assistance!

__END_OF_HTML_CODE__ } #print_html_form ######## # #sub check_form_data # # This subroutine checks the information submitted via the # html form to make sure it has all the required information. # ######## sub check_form_data { $FORM_DATA{"users_email"} = &escape_input($FORM_DATA{"users_email"}) ; $FORM_DATA{"users_name"} = &escape_input($FORM_DATA{"users_name"}) ; $FORM_DATA{"message"} = &escape_input($FORM_DATA{"message"}) ; #The array which holds all the error code numbers, and the error message #associated with that code number. my %error_codes = ( "1" => "Email address is blank.", "2" => "Email address must contain @.", "3" => "Referring Web page is blank.", "4" => "Unknown referring Web page.", "5" => "Comments must not contain urls."); if ($FORM_DATA{'users_email'} !~ /\w/) { $error = 1; } elsif ($FORM_DATA{'users_email'} !~ /@/) { $error = 2; } elsif ($FORM_DATA{'referrer'} !~ /\w/) { $error = 3; } elsif ($FORM_DATA{'referrer'} =~ /Unknown/) { $error = 4; } elsif ($FORM_DATA{'message'} =~ /href/) { $error = 5; } if ($error) { print <<__END_OF_HTML_CODE__;

Ridged Band
SPECIALIZED TISSUE OF THE PENIS

The form you submitted contained the following error: $error_codes{$error} Please click on your browser’s Back button to correct your input.

__END_OF_HTML_CODE__ } if ($FORM_DATA{'cc'} ne "") { $CC_EMAIL = $FORM_DATA{'cc'}; } } #check_form_data ######## # #sub send_mail # # This subroutine writes and sends the email message. # ######## sub send_mail { open (MESSAGE, "| $SENDMAIL -t -oi "); print MESSAGE <<__END_OF_MESSAGE__; To: no_circ\@sbcglobal.net From: research\@cirp.org Subject: RB survey result Cc: harrisond\@telus.net __END_OF_MESSAGE__ print MESSAGE ("Respondent: $FORM_DATA{'users_email'}\n"); print MESSAGE ("Name: $FORM_DATA{'users_name'}\n\n"); print MESSAGE ("Can you feel the bulb muscle contraction? $FORM_DATA{'Q1'}\n\n"); print MESSAGE ("With compression of urethra:\ $FORM_DATA{'Q2'}\n"); print MESSAGE ("Age: $FORM_DATA{'Q3'}\n"); print MESSAGE ("Questions easy to understand? $FORM_DATA{'Q4'}\n\n"); print MESSAGE ("Additional comments:\n"); print MESSAGE ("$FORM_DATA{'message'}"); print MESSAGE ("\n###\n"); print MESSAGE ("SYSTEM INFORMATION\n"); print MESSAGE ("Browser: $FORM_DATA{'browserName'}\n"); print MESSAGE ("Version: $FORM_DATA{'browserVersion'}\n"); print MESSAGE ("Screen Resolution: $FORM_DATA{'screenSize'}\n"); print MESSAGE ("Operating System: $FORM_DATA{'platform'}\n"); print MESSAGE ("System Language: $FORM_DATA{'systemLanguage'}\n"); print MESSAGE ("referrer: $FORM_DATA{'referrer'}\n"); close (MESSAGE); } #send_mail ######## # #sub reply_to_user # # Provided everything submitted from the form checks out ok, # this subroutine returns an acknowledgement to the user. # ######## sub reply_to_user { print <<__END_OF_HTML_CODE__;