#!/usr/local/bin/perl5 ###################################### # form.cgi (for rescuemuni.org) # Rescue Muni survey form # # To initialize: # (1) chmod 4755 form.cgi # (2) mkdir results # (3) chmod 775 results # The counter will create its own file. # # Make sure not to alternate between running from the web, and running from the Unix prompt. # The file owner could get messed up. # # Search below in this file for "SURVEY DATE", to change the date range of the survey. # # ###################################### # Created 1/30/1999 Mitchell Dyck # # Changes 2/21/1999 MD... # - Add "mode" parameter (to work around Mac submission bug, and pave the way for "test" & other modes) # - Require destination time only if destination is nonblank # - TODO: Submit as 24hr # # Changes 1/9/2000 MD... # - Make it "Y2K compliant". Earlier version of the form assumed all years would be 2 digits long. # - Now allow user to enter no year, 2-digit year, or 4-digit year. (If 2-digit, assume the most likely century.) # - Put all date information into a manageable set of variables ($requiredyear, $display_season, etc.). # # Changes beginning 2/15/2001 AJS # - Add "Clean" field (yes/no) to the fields being queried # - Change "data" flag to something else (data_new) to distinguish from # previously submitted data lines # # Changes completed 2/25/2001 AJS # - Added 24 hour time mode # # Changes completed 2/26/2001 AJS # - Cheap hack to enable dates up to 3/4/2001 # # Changes completed 3/3/2001 AJS # - Fixed bug blocking 00:00 times # # Changes completed 3/4/2001 AJS # - Now "never" is allowed in time muni arrived # # Changes completed 3/16/2001 AJS # - Typing for others mode # # Changes completed 4/1/2002 AJS # - Commented out 3/4/2001 hack (may need to bring back at end of month?) # # Changes completed 4/9/2002 AJS # - Brought back late dates hack (latest is 4/6/2002) # # Changes completed 2/25/2003 AJS # - Updated for 2003 # - Including late dates hack since we'll probably extend anyway # - Made late dates hack less bad (now automatically extended to fourth of next month) # # Changes completed 4/5/2004 AJS # - Updated for 2004 # - Including late dates hack (up to 5/4/04) since we'll probably extend anyway # # TODO nifty stuff: # - visitor counter # - test mode # - more flexible date handling # ###################################### ############################################################## # SURVEY DATE # # Fill in the values below, to change the date of the survey. # # The survey must start on the first of a month, # and finish on or before the last day of that month. ############################################################## # Fill in the year and month (1=January, etc.) of the survey. $requiredyear = 2004; $requiredmonth = 4; # Fill in the day-of-month that is the last day of the survey. $maxday = 30; # Fill in these words, which appear at the top of the page. $display_season = "Spring 2004"; $display_date_range = "April 1-30, 2004"; # Fill in the sample date, which appears at the top of the "date" column. $display_sample_date = "4/1/2004"; # Are we extending the survey to the next month? To what day? $extend = 1; $extendday = 4; ############################################################## ############################################################## # Use modules... use CGI; # in object-oriented style use Fcntl; # file control # Prevent denial-of-service (I got these from http://stein.cshl.org/WWW/software/CGI/cgi_docs.html ) $CGI::POST_MAX=1024 * 100; # max 100K posts $CGI::DISABLE_UPLOADS = 1; # no uploads # ---------------------------------- # Start by printing the HTTP content-type header and HTML head. # (just to be on the safe side, with possible -w warnings) # Get the query $q = new CGI; # print the top of the document # this helps ensure that errors won't result in a totally blank form. print $q->header(), "\n"; # ---------------------------------- # check time ($seconds, $minutes, $hours, $day_of_month, $month, $perl_year) = localtime; $year_4digit = 1900 + $perl_year; # This works because Perl's year was 99 in the year 1999, and 100 in the year 2000. $year_2digit = substr($year_4digit, 2, 2); # This works for years 1901-9999. I hope Muni is rescued by then. $month += 1; # Change Perl's internal format to normal human format $datestamp = $year_4digit * 10000 + $month * 100 + $day_of_month; $timestamp = $datestamp . "." . substr((100 + $hours), 1, 2) . "." . substr((100 + $minutes), 1, 2) . "." . substr((100 + $seconds), 1, 2); # ---------------------------------- # Initialize variables. # this file $thisform = "form.cgi"; $moddate = "4/5/04"; # things we need on the web server $sendmail = '/usr/sbin/sendmail'; # where is sendmail # names related to e-mail $emailrecipient = 'survey@sulli.org'; # who gets the form data $emailsender = 'surveyform@rescuemuni.org'; # sender of the form data $emailsubject = "Riders Survey data from $thisform"; # subject of e-mail containing form data # Persistent filenames $theStem = "./results/surv"; $theTrackPart = "Track"; $theExt = ".txt"; # The "tracker file" remembers the latest date submitted. $theTrackerFile = $theStem . $theTrackPart . $theExt; # Number of rows of data in the form $maxrows = 10; # Field names used for both (1) HTML form and (2) output file # "clean" added 2/15/01 # "formid" added 3/13/01 $dataFileHeader = ($FIELD_name = "Name" ) . "\t" . ($FIELD_phone = "Phone" ) . "\t" . ($FIELD_email = "email" ) . "\t" . ($FIELD_route = "route" ) . "\t" . ($FIELD_date = "date" ) . "\t" . ($FIELD_startloc = "loc" ) . "\t" . ($FIELD_direction = "dir" ) . "\t" . ($FIELD_starttime = "time" ) . "\t" . ($FIELD_vehtime = "arrive" ) . "\t" . ($FIELD_destinloc = "dest" ) . "\t" . ($FIELD_destintime = "getthere" ) . "\t" . ($FIELD_clean = "clean" ) . "\t" . ($FIELD_crowding = "crowd" ) . "\t" . ($FIELD_comment = "comment" ) . "\t" . ($FIELD_comments = "comments" ) . "\t" . ($FIELD_member = "Member" ) . "\t" . ($FIELD_compile = "Compile" ) . "\t" . ($FIELD_typisttime = "entered" ) . "\t" . ($FIELD_typist = "typist" ) . "\t" . ($FIELD_rowtype = "rowtype" ) . "\t" . ($FIELD_formid = "formid" ); # Form field names, used in the form but not in the output file $FIELD_ampm24 = "ampm24"; $FIELD_typing = "typing"; $FIELD_startampm = "timeampm"; $FIELD_vehampm = "arriveampm"; $FIELD_destinampm = "getthereampm"; # Query field names, used in the URL parameters only (not the form nor the data file) $FIELD_mode = "mode"; # Name of the Submit button $submitbuttonvalue = "Submit Results"; # Valid ranges $maxwait_hours = 4; $maxwait = $maxwait_hours * 60; #longest valid wait or journey, in minutes $maxcrowd = 5; #highest valid crowding number (use only single digits) # 1/9/2000: I moved the required date ranges to the top of this file. # Error-related $flasher = '[fix]'; # Initialize error flags. $any_error = ""; $name_etc_blank = ""; $name_etc_blank_msg = "Enter your Name, Phone, and E-mail.
"; $name_flasher = ""; $name_bad = ""; $name_bad_msg = "Enter your real Name.
"; $phone_flasher = ""; $phone_bad = ""; $phone_bad_msg = "Enter your Phone (including area code).
"; $email_flasher = ""; $email_bad = ""; $email_bad_msg = "Enter your E-mail (example: name\@domain.com).
"; $route_etc_blank = ""; $route_etc_blank_msg = "Be sure to enter Route, Date, and Location for each ride.
"; $date_bad = ""; $time_blank = ""; $ampm_wrong = ""; $twentyfour_but_ampm = ""; $twelve_but_over = ""; $time_clock_bad = ""; $time_order_bad = ""; $never_but_arrived = ""; $date_bad_msg = "Check your dates -- they should be in the correct range and format. (For example, $month/$day_of_month or $month/$day_of_month/$year_2digit is okay.)
"; $twentyfour_but_ampm_msg = "You're entering with 24-hour time. Please don't select am/pm for any time entry. Alternatively, you may use 12-hour time format.
"; $twelve_but_over_msg = "You're entering with 12-hour time. Please make sure all times are in 12-hour format."; $time_blank_msg = "Be sure to enter required Times (when you arrived, when vehicle arrived) for each ride.
"; $ampm_wrong_msg = "Check am/pm for each time. Alternatively, you may use 24-hour time format.
"; $time_clock_bad_msg = "Check your times -- they should look like 12:00, or 4:56.
"; $time_order_bad_msg = "Check your times -- they appear to be out of order, or over $maxwait_hours hours apart.
"; $time_clock_twentyfour_bad_msg = "Check your times -- they should look like 12:00, 4:56, or 23:55.
"; $never_but_arrived_msg = "You've included vehicles that never arrived. Make sure you don't include the time you got to your destination for these vehicles.
"; $crowd_bad = ""; $crowd_bad_msg = "Check your Crowding numbers -- only numbers 1 to 5 are allowed.
"; # Used for typing-for-others mode $typist_flasher = ""; $typist_bad = ""; $typist_bad_msg = "Make sure you've entered your name in the typist field.
"; $formid_bad = ""; $formid_bad_msg = "Make sure you've entered the form ID, or none if the form doesn't have an ID.
"; $not_typing_bad = ""; $not_typing_bad_msg = "You're not typing data for others. Leave the fields for your name and form ID blank.
"; for ($i = 1; $i <= $maxrows; $i++) { $row_blank[$i] = 0; $row_error[$i] = ""; } # Initialize other flags $never = 0; $any_query = 0; $twentyfour = 0; #24 hour time flag $typing = 0; #typing for others mode flag #Are we debugging? $DEBUG = 0; #DEBUG initialize this for later $debugMsg = ""; #Here's a little item, for "Y2K" preparations if ($DEBUG) { print "\n\n"; } # ---------------------------------- # Grab form input, if any. $MODE_new = ""; if ($q->param($FIELD_mode)) { if ($q->param($FIELD_mode) eq "new") { $MODE_new = 1; } $q->delete($FIELD_mode); # Remove the "mode" field from the params. This will probably make ($q->param) evaluate to false. } if ($q->param) { #start if-received-query-data $any_query = 1; if ($DEBUG) { print "\n\n" } # Testing the user's input to see whether they want am/pm or 24hr # DON'T hardwire this value. # $VALUE_ampm24 = 0; $VALUE_ampm24 = trim($q->param($FIELD_ampm24)); if ($DEBUG) {print "ampm24 is $VALUE_ampm24

";} # Initialize typing-for-others variables $VALUE_typing = trim($q->param($FIELD_typing)); $VALUE_typist = trim($q->param($FIELD_typist)); $VALUE_formid = trim($q->param($FIELD_formid)); if ($DEBUG) {print "Typing is $VALUE_typing, Typist is $VALUE_typist, Formid is $VALUE_formid

";} # Debug other yes/no fields if ($DEBUG) {print "Member is $VALUE_member, Compile is $VALUE_compile

";} # ---------------------------------- # Validate form data. if (($temp = trim($q->param($FIELD_name))) eq "") { $name_flasher = $flasher; $name_etc_blank = $name_etc_blank_msg; $any_error = 1; } elsif ($temp !~ /[a-zA-Z]/) { #must contain at least one letter $name_flasher = $flasher; $name_bad = $name_bad_msg; $any_error = 1; } if (($temp = trim($q->param($FIELD_phone))) eq "") { $phone_flasher = $flasher; $name_etc_blank = $name_etc_blank_msg; $any_error = 1; } else { # test for a bad $temp phone number $temp =~ s/^\D//; #remove any initial non-digits $temp =~ s/^[01]*//; #remove any initial 1's and 0's if (($temp !~ /^(\d\D*){9}\d(.*)/) || #(not) match nine digits, optionally separated by non-digits, followed by "any characters" (piece #2) (($2 ne "") && #(not) "any characters" (piece #2) is blank, or... ($2 !~ /^\D/))) # "any characters" (piece #2) starts with a non-digit { # Otherwise... $phone_flasher = $flasher; $phone_bad = $phone_bad_msg; $any_error = 1; } } if (($temp = trim($q->param($FIELD_email))) eq "") { $email_flasher = $flasher; $name_etc_blank = $name_etc_blank_msg; $any_error = 1; } elsif ($temp !~ /^[^@\s]+@[^@\s]+$/) { #not match if whitespace or too many @'s # bad $temp email address $email_flasher = $flasher; $email_bad = $email_bad_msg; $any_error = 1; } # See if this is typing-for-others mode. if ($VALUE_typing eq "Yes") {$typing = 1;} if ($typing) { if ($DEBUG) {print "Typing for others mode

";} if ($VALUE_typist eq "") { $typist_flasher = $flasher; $typist_bad = $typist_bad_msg; $any_error = 1; } if (($VALUE_formid eq "") || (($VALUE_formid !~ m/^\d+$/) && ($VALUE_formid !~ m/none/i))){ $typist_flasher = $flasher; $formid_bad = $formid_bad_msg; $any_error = 1; } } else { if (($VALUE_typist ne "") || ($VALUE_formid ne "")) { $typist_flasher = $flasher; $not_typing_bad = $not_typing_bad_msg; $any_error = 1; } } # Now validate the forms. for ($i = 1; $i <= $maxrows; $i++) { # First check if this is a blank row. $temp = trim( $q->param("$FIELD_route$i"), $q->param("$FIELD_date$i"), $q->param("$FIELD_startloc$i"), $q->param("$FIELD_direction$i"), $q->param("$FIELD_starttime$i"), $q->param("$FIELD_startampm$i"), $q->param("$FIELD_vehtime$i"), $q->param("$FIELD_vehampm$i"), $q->param("$FIELD_destinloc$i"), $q->param("$FIELD_destintime$i"), $q->param("$FIELD_destinampm$i"), $q->param("$FIELD_clean$i"), $q->param("$FIELD_crowding$i"), $q->param("$FIELD_comment$i") ); if ($temp eq "") { $row_blank[$i] = 1; #not an error } else { #start: row not blank if ($DEBUG) { print "\n\n" } # Check for blank fields if ((trim($q->param("$FIELD_route$i")) eq "") || (trim($q->param("$FIELD_startloc$i")) eq "")) { $route_etc_blank = $route_etc_blank_msg; # Use this error for any of 3 conditions $row_error[$i] = $flasher; $any_error = 1; } # Check for blank fields $temp = trim($q->param("$FIELD_date$i")); $error = 0; if ($temp eq "") { $route_etc_blank = $route_etc_blank_msg; # Use this error for any of 3 conditions $row_error[$i] = $flasher; $any_error = 1; } elsif ( $temp !~ m|^\d+(/\d+){1,2}$| ) { # Check if it's in n/n or n/n/n format (regardless of the length of n) $error = 1; } else { # Format ok; check if numbers are in range @mydate = split("/", $temp); if (($mydate[0] != $requiredmonth) || # 0 is month, 1 is day, 2 (opt.) is year ($mydate[1] < 1) || ($mydate[1] > $maxday) || (($month == $requiredmonth) && ($year_4digit == $requiredyear) && ($mydate[1] > $day_of_month))) # The user has submitted the form during the year and month required for the survey, but has entered a future day (assuming server is in pacific time) # Note: is the following a bug? The user can enter dates in a future month or a future year. It might be a feature b/c it allows testing before the survey starts. { # hack to make dates up to fourth of next month work - modified 4/5/04 - ajs if ( ($mydate[0] != ($requiredmonth + 1)) || ($mydate[1] > $extendday) || ($extend != 1)) { $error = 1; } } # end check-numbers # Checking the year is more complicated, because I allow the user to enter a 2-digit year, a 4-digit year, or no year at all. if (@mydate == 3) { # the user has entered a year, so I need to check its format and value. if ($mydate[2] =~ /^\d\d$/) { # Report an error if the user enters a 2-digit year, which doesn't match the last 2 digits of the required year. if ($mydate[2] != substr($requiredyear, 2, 2)) { $error = 1; } } else { # Report an error if the user enters something other than a 2-digit year, and it doesn't match the 4-digit required year. if ($mydate[2] != $requiredyear) { $error = 1; } } # end user-has-entered-a-year } # end check-year } # end check-format if ($error) { $date_bad = $date_bad_msg; $row_error[$i] = $flasher; $any_error = 1; } # Check for blank time fields (start and vehicle) $temp1 = trim($q->param("$FIELD_starttime$i" )); $temp2 = trim($q->param("$FIELD_vehtime$i" )); $temp3 = trim($q->param("$FIELD_destintime$i")); # use this later if (($temp1 eq "") || ($temp2 eq "")) { $time_blank = $time_blank_msg; $row_error[$i] = $flasher; $any_error = 1; } # See if bus never came if ($temp2 =~ m/never/i) {$never = 1;} else {$never = 0;} if ($DEBUG) {print "never is $never

";} # if bus never came, make sure there's no arrival time if ($never && ($temp3 ne "")) { $never_but_arrived = $never_but_arrived_msg; $row_error[$i] = $flasher; $any_error = 1; } # Check am/pm selection, in both 12 and 24 hour case $temp1ampm = $q->param("$FIELD_startampm$i" ); $temp2ampm = $q->param("$FIELD_vehampm$i" ); $temp3ampm = $q->param("$FIELD_destinampm$i"); if ($DEBUG) {print "temp1 is $tempampm; temp2 is $temp2ampm; temp3 is $tempampm

";} # 24 hour case: Make sure all ampm fields are blank if ($VALUE_ampm24 eq "24 Hour") { $twentyfour = 1; if (($temp1ampm !~ /^\s*$/) || ($temp2ampm !~ /^\s*$/) || ($temp3ampm !~ /^\s*$/)) { $twentyfour_but_ampm = $twentyfour_but_ampm_msg; $row_error[$i] = $flasher; $any_error = 1; } } else { # end 24 hour case # 12 hour case: Check for blank ampm fields (start and vehicle; and destination if # nonblank) or unnecessary ampm field (destination if blank) $twentyfour = 0; if (($temp1ampm =~ /^\s*$/) || ((!$never) && ($temp2ampm =~ /^\s*$/)) || # no am/pm is okay if "never" (($temp3 ne "") && ($temp3ampm =~ /^\s*$/)) || (($temp3 eq "") && ($temp3ampm !~ /^\s*$/))) { $ampm_wrong = $ampm_wrong_msg; $row_error[$i] = $flasher; $any_error = 1; } # end 12 hour case } # end ampm check # If no required times are blank and no required ampm's are blank, then check validity of numbers. if (!$time_blank && !$ampm_wrong) { if ($DEBUG) {print "temp1 is $temp1; temp2 is $temp2; temp3 is $temp3

";} if ($twentyfour) { if (($temp1 !~ /^(0?[0-9]|1[0-9]|2[0-3]):[0-5][0-9]$/) || # data up to 23:59 OK (($temp2 !~ /^(0?[0-9]|1[0-9]|2[0-3]):[0-5][0-9]$/) && !$never) || # okay time or "never" (($temp3 ne "") && ($temp3 !~ /^(0?[0-9]|1[0-9]|2[0-3]):[0-5][0-9]$/))) { $time_clock_bad = $time_clock_twentyfour_bad_msg; if ($DEBUG) { print "Bad time format, 24 hour version

"; if ($temp1 !~ /^(0?[0-9]|1[0-9]|2[0-3]):[0-5][0-9]$/) {print "temp1 bad: $temp1

";} if ($temp2 !~ /^(0?[0-9]|1[0-9]|2[0-3]):[0-5][0-9]$/) {print "temp2 bad: $temp2

";} if ($temp3 !~ /^(0?[0-9]|1[0-9]|2[0-3]):[0-5][0-9]$/) {print "temp3 bad: $temp3

";} } $row_error[$i] = $flasher; $any_error = 1; } else {if ($DEBUG) {print "Good time format, 24 hour version

";}} } else { # end 24 hour case if (($temp1 !~ /^(0?[1-9]|1[0-2]):[0-5][0-9]$/) || # data up to 12:59 OK (($temp2 !~ /^(0?[1-9]|1[0-2]):[0-5][0-9]$/) && !$never) || # okay time or "never" (($temp3 ne "") && ($temp3 !~ /^(0?[1-9]|1[0-2]):[0-5][0-9]$/))) { $time_clock_bad = $time_clock_bad_msg; if ($DEBUG) {print "Bad time format, 12 hour version

";} $row_error[$i] = $flasher; $any_error = 1; } # end 12 hour case } # end time format check # Each time is valid; now compare them. if (!$time_clock_bad) { @temp = split(":", $temp1); #Split the time into hours (0) and minutes (1) if (!$twentyfour && ($temp[0] == 12)) {$temp[0] = 0} #Make the math work if hour=12 $t1 = $temp[0] * 60 + $temp[1]; #Convert hours-and-minutes into just minutes @temp = split(":", $temp2); #same... if (!$twentyfour && ($temp[0] == 12)) {$temp[0] = 0} $t2 = $temp[0] * 60 + $temp[1]; if ($temp3 ne "") { @temp = split(":", $temp3); #same... if (!$twentyfour && ($temp[0] == 12)) {$temp[0] = 0} $t3 = $temp[0] * 60 + $temp[1]; } else { $t3 = $t2; #hack if destination time is blank; this works assuming instantaneous travel is allowed $temp3ampm = $temp2ampm; } # make sure 12 hour times are 11:59 or below # this is currently superfluous, but may be useful at a later date if ((!$twentyfour) && ( ($t1 > 719) || ($t2 > 719) || ($t3 > 719) ) ){ if ($DEBUG) {print ("Twelve but over

");} $twelve_but_over = $twelve_but_over_msg; $row_error[$i] = $flasher; $any_error = 1; } if (!$twentyfour && ($temp1ampm eq "pm")) {$t1 += 12 * 60} if (!$twentyfour && ($temp2ampm eq "pm")) {$t2 += 12 * 60} if (!$twentyfour && ($temp3ampm eq "pm")) {$t3 += 12 * 60} # Don't try to get smart here, or we'll have to test for blank destination time again if ($DEBUG) { print("") } if (!$never && (!((0 <= $t2 - $t1) && ( $t2 - $t1 <= $maxwait)) && !((0 <= 24 * 60 + $t2 - $t1) && (24 * 60 + $t2 - $t1 <= $maxwait)))) { $time_order_bad = $time_order_bad_msg; $row_error[$i] = $flasher; $any_error = 1; if ($DEBUG) { print("") } } if (!$never && (!((0 <= $t3 - $t2) && ( $t3 - $t2 <= $maxwait)) && !((0 <= 24 * 60 + $t3 - $t2) && (24 * 60 + $t3 - $t2 <= $maxwait)))) { $time_order_bad = $time_order_bad_msg; $row_error[$i] = $flasher; $any_error = 1; if ($DEBUG) { print("") } } } } # Check for bad crowding field $crowdrange = "1-" . $maxcrowd; $temp = $q->param("$FIELD_crowding$i"); if (($temp ne "") && ($temp !~ /[$crowdrange]/)) { $crowd_bad = $crowd_bad_msg; $row_error[$i] = $flasher; $any_error = 1; } } #end: row not blank } #end for ################################################### # Build the output if (!$any_error) { if ($DEBUG) { print("\n") } $newData = ""; # Grab non-looping values $VALUE_name = trim($q->param($FIELD_name)); $VALUE_phone = trim($q->param($FIELD_phone)); $VALUE_email = trim($q->param($FIELD_email)); $VALUE_comments = trim($q->param($FIELD_comments)); $VALUE_member = trim($q->param($FIELD_member)); $VALUE_compile = trim($q->param($FIELD_compile)); # $VALUE_typist = ""; # Start with non-looping content (Make a comment row) $repeater = $VALUE_name . "\t" . $VALUE_phone . "\t" . $VALUE_email . "\t" ; $newData .= $repeater . "\t\t\t\t\t\t\t\t\t\t\t" . $VALUE_comments . "\t" . $VALUE_member . "\t" . $VALUE_compile . "\t" . $timestamp . "\t" . # _time $VALUE_typist . "\t" . "comment\t" . # _rowtype $VALUE_formid . "\n"; # Loop through row data and append it. $VALUE_rowtype = "Data"; for ($i = 1; $i <= $maxrows; $i++) { if (!$row_blank[$i]) { # Build "time-full" field for each needed time $VALUE_startTFUL = trim($q->param("$FIELD_starttime$i" ) . " " . $q->param("$FIELD_startampm$i" )); $VALUE_vehTFUL = trim($q->param("$FIELD_vehtime$i" ) . " " . $q->param("$FIELD_vehampm$i" )); $VALUE_destinTFUL = trim($q->param("$FIELD_destintime$i" ) . " " . $q->param("$FIELD_destinampm$i" )); # Name, phone, e-mail $newData .= $repeater; # Row data $newData .= trim($q->param("$FIELD_route$i" )) . "\t"; $newData .= trim($q->param("$FIELD_date$i" )) . "\t"; $newData .= trim($q->param("$FIELD_startloc$i" )) . "\t"; $newData .= trim($q->param("$FIELD_direction$i" )) . "\t"; $newData .= $VALUE_startTFUL . "\t"; $newData .= $VALUE_vehTFUL . "\t"; $newData .= trim($q->param("$FIELD_destinloc$i" )) . "\t"; $newData .= $VALUE_destinTFUL . "\t"; $newData .= trim($q->param("$FIELD_clean$i" )) . "\t"; $newData .= trim($q->param("$FIELD_crowding$i" )) . "\t"; $newData .= trim($q->param("$FIELD_comment$i" )) . "\t"; # Skip comments, member y/n, and compile y/n. $newData .= "\t\t\t"; # Final repeater $newData .= $timestamp . "\t"; $newData .= $VALUE_typist . "\t"; $newData .= $VALUE_rowtype . "\t"; $newData .= $VALUE_formid . "\n"; } # end if (non-blank) } # end for } # end no-error } #end if-received-query-data ############################################################################## # start writing data ############################################################################## if ($any_query && !$any_error) { #if query-is-error-free if ($DEBUG) { print ("\n"); print ("\n"); } # ---------------------------------- # Open the date tracker file. sysopen(TRACKER, $theTrackerFile, O_RDWR|O_CREAT, 0644) or byebye("can't open tracker file $theTrackerFile: $!"); flock(TRACKER, 2) or byebye("can't LOCK_EX tracker file $theTrackerFile: $!"); # ---------------------------------- # Read the date tracker file $priorDateStamp = $datestamp; # default, in case the tracker file is empty $pTrackerFileFound = 0; # Read the last line (I expect the line count is 0 or 1) while () { $priorDateStamp = $_; $pTrackerFileFound = 1; } # ---------------------------------- # This is a good time to check whether it's a new day. # It's a new day when (there is a tracker file) && (datestamp > tracker) $pNewDay = 0; # default, unless... if (($pTrackerFileFound) && ($datestamp gt $priorDateStamp)) { $pNewDay = 1; } # ---------------------------------- # See whether it's time to increment the date tracker. # If this is a new tracker file, or it's a new day, write the date to the tracker file. if (($pTrackerFileFound == 0) || $pNewDay) { seek(TRACKER, 0, 0) or byebye("can't rewind tracker file $theTrackerFile: $!"); truncate(TRACKER, 0) or byebye("can't truncate tracker file $theTrackerFile: $!"); print TRACKER $datestamp or byebye("can't print to tracker file $theTrackerFile: $!"); } close(TRACKER) or byebye("can't close $theTrackerFile: $!"); # ---------------------------------- # Load the old data file # Open the old data file, or create a new one $theDataFile = $theStem . $priorDateStamp . $theExt; sysopen(DATA, $theDataFile, O_RDWR|O_CREAT, 0644) or byebye("can't open data file $theDataFile: $!"); flock(DATA, 2) or byebye("can't LOCK_EX data file $theDataFile: $!"); # Read the whole data file (zero or more lines) $theData = ""; while () { $theData .= $_; } # ---------------------------------- # Two possible cases... # ---------------------------------- # Case 1: It's not a new day. Write to old data file and close it. if ($pNewDay == 0) { # If for some reason the data file is empty, we'll start by adding a header # at the top (column headings) # (For example, this is our first run of the season, or else today's data file got moved.) if ($theData eq "") { $theData = "$dataFileHeader\n"; if ($DEBUG) { $debugMsg .= "Warning! For some reason the new data file \"$theDataFile\" was not blank.\n" } } # Add new data to old $theData .= $newData; if ($DEBUG) { $debugMsg .= "in Case 1: not a new day\n" } # Write back all data and close the file seek(DATA, 0, 0) or byebye("can't rewind data file $theDataFile: $!"); truncate(DATA, 0) or byebye("can't truncate data file $theDataFile: $!"); print DATA $theData or byebye("can't print to data file $theDataFile: $!"); close(DATA) or byebye("can't close data file $theDataFile: $!"); } else { # ---------------------------------- # Case 2: It's a new day. Close the old file, email it, then write a new data file. # Close the old data file. close(DATA) or byebye("can't close data file $theDataFile: $!"); # Mail the old data file. open(MAIL, "|$sendmail -oi -t") or byebye("Can't open pipe to $sendmail: $!"); print MAIL "To: $emailrecipient\n"; print MAIL "From: $emailsender\n"; $emailsubject .= " " . $priorDateStamp; print MAIL "Subject: $emailsubject\n\n"; print MAIL "$theData"; close(MAIL) or byebye("Can't close pipe to $sendmail: $!"); # Open a new data file. $theDataFile = $theStem . $datestamp . $theExt; sysopen(DATA, $theDataFile, O_RDWR|O_CREAT, 0644) or byebye("can't open data file $theDataFile: $!"); flock(DATA, 2) or byebye("can't LOCK_EX data file $theDataFile: $!"); # If for some reason there was already data in the new data file, read it in. # (For example, the date in the tracker file somehow got out of sync with the filename of the data file.) $theData = ""; while () { $theData .= $_; } # If the new data file is blank, write the header at the top. if ($theData eq "") { $theData = "$dataFileHeader\n"; } else { $debugMsg .= "Warning! For some reason the new data file \"$theDataFile\" was not blank.\n"; } # Add new data to old $theData .= $newData; if ($DEBUG) { $debugMsg .= "in Case 2: it's a new day; I just appended newData\n" } # Write back all data and close the file seek(DATA, 0, 0) or byebye("can't rewind data file $theDataFile: $!"); truncate(DATA, 0) or byebye("can't truncate data file $theDataFile: $!"); print DATA $theData or byebye("can't print to data file $theDataFile: $!"); close(DATA) or byebye("can't close data file $theDataFile: $!"); } # end if (two cases). ############################################## # Write success message ############################################## $title = "Confirmation"; print $q->start_html(-title=>$title, -BGCOLOR=>"#FFFFFF", -LINK=>"#FF3300", -VLINK=>"#AA0000", -ALINK=>"#FFFF00"); if ($DEBUG) { print ("\n\n"); $debugMsg = ""; } print <<"EOF";

Thanks!

We appreciate your time on this project.

From this page, you can:

Or click on your browser's "Back" button. EOF # End the document myfooter(); print $q->end_html(); ############################################################################## # start form ############################################################################## } else { if ($DEBUG) { print "\n" } if ($DEBUG) { print "\nTesting typist and formid Fields" } # print some greetings and instructions $title = "Riders' Survey Submission Form"; print $q->start_html(-title=>$title, -BGCOLOR=>"#FFFFFF", -LINK=>"#FF3300", -VLINK=>"#AA0000", -ALINK=>"#FFFF00"), $q->start_form(-action=>$thisform); print <<"EOF";

$display_season
Muni Riders' Survey
$display_date_range

Submission form


Please submit your survey results with this form. If you have more than 10 data points, please submit multiple forms.

EOF # ---------------------------------- # Print any error message if ($any_error) { print "

$flasher" . "Please fix these errors.
\n"; print "$name_etc_blank\n"; print "$name_bad\n"; print "$phone_bad\n"; print "$email_bad\n"; print "$route_etc_blank\n"; print "$date_bad\n"; print "$time_blank\n"; print "$ampm_wrong\n"; print "$time_clock_bad\n"; print "$time_order_bad\n"; print "$twentyfour_but_ampm\n"; print "$twelve_but_over\n"; print "$never_but_arrived\n"; print "$crowd_bad\n"; print "$typist_bad\n"; print "$formid_bad\n"; print "$not_typing_bad"; print "

"; } # ---------------------------------- # Print the bulk of the form # Print the first table, with questions that are general to the entire form $VALUE_name = $q->escapeHTML($q->param($FIELD_name )); $VALUE_phone = $q->escapeHTML($q->param($FIELD_phone)); $VALUE_email = $q->escapeHTML($q->param($FIELD_email)); $VALUE_typist = $q->escapeHTML($q->param($FIELD_typist )); $VALUE_formid = $q->escapeHTML($q->param($FIELD_formid )); print <<"EOF";

Contact info (required):

$name_flasherName:
$phone_flasherPhone:  $email_flasherE-mail:
EOF # Ask if 12 or 24 hour time. print("

Are you entering with 12 or 24 hour time? "); print($q->radio_group(-name=>"$FIELD_ampm24", -values=>["12 Hour", "24 Hour"], -default=>$VALUE_ampm24)); # Debugging 12-24. if ($DEBUG) {print ("12-24 field is $VALUE_ampm24; twentyfour is $twentyfour
"); } # Ask if typing for someone else. print ("

Are you typing in data from someone else's form? "); print($q->radio_group(-name=>"$FIELD_typing", -values=>["Yes", "No"], -default=>$VALUE_typing)); if ($DEBUG) {print ("Typing value is $VALUE_typing; typing is $typing
"); } print <<"EOF";
$typist_flasher If so, please enter: Your name: Form ID:
EOF # Print top of table. print <<"EOF";

Note: If you're entering with 24 hour time, don't select am/pm in any data field.

EOF # Print the table rows. for ($i = 1; $i <= $maxrows; $i++) { $VALUE_route = $q->escapeHTML($q->param("$FIELD_route$i" )); $VALUE_date = $q->escapeHTML($q->param("$FIELD_date$i" )); $VALUE_startloc = $q->escapeHTML($q->param("$FIELD_startloc$i" )); $VALUE_direction = $q->escapeHTML($q->param("$FIELD_direction$i" )); $VALUE_starttime = $q->escapeHTML($q->param("$FIELD_starttime$i" )); $VALUE_startampm = $q->escapeHTML($q->param("$FIELD_startampm$i" )); $VALUE_vehtime = $q->escapeHTML($q->param("$FIELD_vehtime$i" )); $VALUE_vehampm = $q->escapeHTML($q->param("$FIELD_vehampm$i" )); $VALUE_destinloc = $q->escapeHTML($q->param("$FIELD_destinloc$i" )); $VALUE_destintime = $q->escapeHTML($q->param("$FIELD_destintime$i")); $VALUE_destinampm = $q->escapeHTML($q->param("$FIELD_destinampm$i")); $VALUE_clean = $q->escapeHTML($q->param("$FIELD_clean$i" )); $VALUE_crowding = $q->escapeHTML($q->param("$FIELD_crowding$i" )); $VALUE_comment = $q->escapeHTML($q->param("$FIELD_comment$i" )); if ($VALUE_direction eq "") { $VALUE_direction = " "; } if ($VALUE_startampm eq "") { $VALUE_startampm = " "; } if ($VALUE_vehampm eq "") { $VALUE_vehampm = " "; } if ($VALUE_destinampm eq "") { $VALUE_destinampm = " "; } print(""); print $q->th("$row_error[$i]$i"), $q->td($q->textfield(-name=>"$FIELD_route$i", -size=>5, -maxlength=>5, -default=>$VALUE_route)), $q->td($q->textfield(-name=>"$FIELD_date$i", -size=>8, -maxlength=>10, -default=>$VALUE_date)), $q->td($q->textfield(-name=>"$FIELD_startloc$i", -size=>10, -maxlength=>20, -default=>$VALUE_startloc)), $q->td($q->popup_menu(-name=>"$FIELD_direction$i", -values=>[" ", "in", "out", "n", "s", "e", "w"], -default=>$VALUE_direction)), $q->td($q->textfield(-name=>"$FIELD_starttime$i", -size=>5, -maxlength=>5, -default=>$VALUE_starttime) . $q->popup_menu(-name=>"$FIELD_startampm$i", -values=>[" ", "am", "pm"], -default=>$VALUE_startampm)), $q->td($q->textfield(-name=>"$FIELD_vehtime$i", -size=>5, -maxlength=>5, -default=>$VALUE_vehtime) . $q->popup_menu(-name=>"$FIELD_vehampm$i", -values=>[" ", "am", "pm"], -default=>$VALUE_vehampm)), $q->td($q->textfield(-name=>"$FIELD_destinloc$i", -size=>10, -maxlength=>20, -default=>$VALUE_destinloc)), $q->td($q->textfield(-name=>"$FIELD_destintime$i", -size=>5, -maxlength=>5, -default=>$VALUE_destintime) . $q->popup_menu(-name=>"$FIELD_destinampm$i", -values=>[" ", "am", "pm"], -default=>$VALUE_destinampm)), $q->td($q->popup_menu(-name=>"$FIELD_clean$i", -values=>[" ", "Y", "N"], -default=>$VALUE_clean)), $q->td($q->textfield(-name=>"$FIELD_crowding$i", -size=>2, -maxlength=>1, -default=>$VALUE_crowding)), $q->td($q->textfield(-name=>"$FIELD_comment$i", -size=>8, -maxlength=>40, -default=>$VALUE_comment)); print(""); } # end for # Print end of table. print "

Survey results:

# route date

stop location

direction

time
you arrived
at stop
*
time
vehicle
arrived
*
destination

time you
got there

clean? crowd-
ing **

comments

0

J

$display_sample_date

24/Church

in

8:15  am

8:24  am

Embarcadero

8:58  am

Y

4

crowded

"; # Print bottom, general questions in form $VALUE_comments = $q->escapeHTML($q->param($FIELD_comments )); $VALUE_member = $q->escapeHTML($q->param($FIELD_member )); $VALUE_compile = $q->escapeHTML($q->param($FIELD_compile )); # If the radio buttons are to be unchecked, set their value to a nonexistent name. if(!$VALUE_member ) { $VALUE_member = "-" } if(!$VALUE_compile) { $VALUE_compile = "-" } print <<"EOF";

* Please make sure to report time with am/pm. Thanks!

** Please assess crowding (1=empty, 3=standing room only, 5-crush-loaded).

General comments:
EOF print($q->textarea(-name=>"$FIELD_comments", -rows=>6, -cols=>50, wrap=>"Physical", -default=>$VALUE_comments)); print("

\n"); print("

Are you a member of RESCUE MUNI? "); print($q->radio_group(-name=>"$FIELD_member", -values=>["Yes", "No"], -default=>$VALUE_member)); print("
Would you like to help us compile and publish survey results? "); print($q->radio_group(-name=>"$FIELD_compile", -values=>["Yes", "No"], -default=>$VALUE_compile)); print("


"); # Submit buttons. print $q->p, $q->submit(-value=>$submitbuttonvalue), " ", $q->reset(-value=>'Reset Form'); # ---------------------------------- # Print information at the end of the form print <<"EOF";

Thank you very much for your help!


?s/!s call:
Andrew Sullivan
415-673-0626
andrew\@sulli.org
RESCUE MUNI
415-273-1558
transit1\@rescuemuni.org

[ RESCUE MUNI Home Page ]

EOF # End the document myfooter(); print $q->end_form(), $q->end_html(); } #end form ################################################ ################################################ # Subroutines ################################################ ################################################ # Take all parms, "trim" whitespace, and return concatenated. sub trim { my $result = ""; foreach $parm (@_) { $parm =~ s/\s+/ /g ; # Replace duplicate whitespace with a single space $parm =~ s/^\s+// ; # Remove initial whitespace $parm =~ s/\s+$// ; # Remove trailing whitespace $result .= $parm; } return $result; } ################################################ # Handle a file error, while trying to write the data. sub byebye { $theMessage = ""; # default if (@_) { $theMessage = $_[0] } # if parms, use first as error string $title = "Confirmation"; # Finish up the HTML output, with a brief error message. print $q->start_html(-title=>$title, -BGCOLOR=>"#FFFFFF", -LINK=>"#FF3300", -VLINK=>"#AA0000", -ALINK=>"#FFFF00"); if ($DEBUG) { print ("\n\n"); $debugMsg = ""; } print <<"EOF";

Server Error

The server was temporarily unable to receive your submission.
Please press your browser's "Back" button, then press "$submitbuttonvalue" to try again.


Error message:
$theMessage




RESCUE MUNI home page EOF # End the document myfooter(); print $q->end_html(); # End it all die "$theMessage\n"; # Never happens... return 0; } # end byebye ################################################ # Print a standard footer, which should appear at the bottom of each page. sub myfooter { print <<"EOF";



Copyright © 2001 RESCUE MUNI. All rights reserved.
This page was updated by
Andrew Sullivan.
Questions? Send us
email.
Last updated $moddate.
EOF } # end myfooter