#!/usr/bin/perl -w

####!/localhost/Perl


#/////////////////////////////////////////////////////////////////////////////////////////#

# Filename:lcorney.pl                                                                     #

#                                                                                         #

# Student: Lee B. Corney                       Due Date: 29 Nov 2000                      #

# Program: Class Project #4                    Instructor: Dr. Bruce Maxim                #

#   Class: CIS525                              Editor: WinEdit                            #

#    Term: Fall 2000                                                                      #

#                                                                                         #

# Purpose:  This program was written as an exercise in the use of Perl and a web CGI      #

# Bin application.  This program runs a simple survey, keeps results on the server,       #

# then displays summaries of the results in a friendly format.  The survey is updated     #

# with write in answers converted to radio buttons for future surveys.                    #

#                                                                                         #

#                                                                                         #

#/////////////////////////////////////////////////////////////////////////////////////////#


open(STDERR, '<&STDOUT'); $| = 1;


&PRINT_WEB_HEADER;  # Do this here to enable print out of error messages from &GET_DATA_FROM_FORM()


# Use same program for all applications 1) Display Survey 2) Process Survey and Display Results


# Analyse Get Data:  If null, then display survey...

# Reminder, Get Data is in form of URL?Variable1=xyz&Variable2=abc

# Spaces appear as %20, 


if (! &GET_DATA_FROM_FORM(*data))

# that is if there is no data... then Display the Survey!

{ 

     #  &PRINT_WEB_HEADER;

			

     print "<CENTER><H1>Sample Survey -- CGI-Bin using Perl</H1></CENTER>";

     print "<HR ALIGN='center' WIDTH='90%'>";

     

     print "<FORM ACTION='./lcorney.pl' METHOD='GET'>";

     print "<TABLE ALIGN='center' BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH='90%'>";

     

     print "<TR ALIGN='left' VALIGN='middle'>";

     print "<TH>What is your favorite breakfast cereal?</TH></TR>";

     

     print "<TR ALIGN='left' VALIGN='middle'>";

     #for loop, read input from file here.

     

     print "<TD>";


     # Get Radio Button Names from questionaire.txt file...

     open (Q_FILE, "questionaire.txt");         #Open to read

     while (<Q_FILE>) # Top of read file loop.

     {

          $button_name = $_;

          # Next two commands won't work with two word cereal names!

          # $button_name =~ s/^\s+//;  # remove any leading whitespace, and delete it.

          # $button_name =~ s/\s+//;  # remove any trailing whitespace, and delete it.


          $button_name =~ s/\n+//;  # remove any trailing whitespace, and delete it.

          #testing revealed that the trailing \n newline character made a mess of things!


          print "<DD><DD><INPUT TYPE = 'RADIO' NAME='CEREAL' Value='$button_name'> $button_name <BR>";

     }

     close (Q_FILE);


     print "<DD><DD><INPUT TYPE = 'RADIO' NAME='CEREAL' Value='ADDTEXT'>";

     print "<INPUT TYPE = 'TEXT' NAME='CEREALTEXT' > ";

     print "<BR> <BR>";

     print "</TD></TR>";

     print "<TR ALIGN='left' VALIGN='middle'>";

     print "<TH>In what city were you born?</TH></TR>";

     print "<TR ALIGN='left' VALIGN='middle'>";

     print "<TD>";

     print "<DD><DD>City: <INPUT TYPE = 'TEXT' NAME='CITY' > ";

     print " US State/Canadian Province/Foreign Country?: <INPUT TYPE = 'TEXT' NAME='STATE' > ";

     # print "<INPUT TYPE = 'CHECKBOX' NAME = 'INUSA' CHECKED> In USA or Canada?";

     # Big ouch!  If this box is NOT checked, then no value is sent with the GET string

     # This has weird consequences... since I am not using this value anyway, let's not 

     # us it. Remark out the entire line! -- LBC 26 Nov 00.

     print "<BR><BR>";

     print "</TD></TR>";

     print "<TR ALIGN='left' VALIGN='middle'>";

     print "<TH>What is your favorite color?</TH></TR>";

     print "<TR ALIGN='left' VALIGN='middle'>";

     print "<TD>";

     print "<DD><DD><SELECT NAME='COLOR'>";

          print "<OPTION VALUE='Black'> Black";

          print "<OPTION VALUE='Silver'> Silver";

          print "<OPTION VALUE='Gray'> Gray";

          print "<OPTION VALUE='White'> White";

          print "<OPTION VALUE='Maroon'> Maroon";

          print "<OPTION VALUE='Red'> Red";

          print "<OPTION VALUE='Purple'> Purple";

          print "<OPTION VALUE='Fuschia'> Fuschia";

          print "<OPTION VALUE='Green'> Green";

          print "<OPTION VALUE='Lime'> Lime";

          print "<OPTION VALUE='Olive'> Olive";

          print "<OPTION VALUE='Yellow'> Yellow";

          print "<OPTION VALUE='Blue'> Blue";

          print "<OPTION VALUE='Navy'> Navy";

          print "<OPTION VALUE='Teal'> Teal";

          print "<OPTION VALUE='Aqua'> Aqua";

          print "</SELECT>";

     print "<BR><BR>";

     print "</TD></TR>";

     print "<TR ALIGN='left' VALIGN='middle'>";

     print "<TH>What is your favorite freetime activity?</TH></TR>";

     print "<TR ALIGN='left' VALIGN='middle'>";

     print "<TD>";

     print "<DD><DD><INPUT TYPE = 'TEXT' NAME='FREETIME' SIZE='40'> ";

     print "<BR><BR>";

     print "</TD></TR>";

     print "</TABLE>";

     print "<CENTER>";

     print "<INPUT TYPE = 'SUBMIT' VALUE = 'Submit Survey'>";

     &PRINT_WEB_CLOSING;

}


else

# there was data... now process it!


{

     #  &PRINT_WEB_HEADER;

     

    

     

     # TEST_PRINT();


     #If CEREALTEXT, Then add entry to CEREAL, also add to the Questionaire file

     # The Questionaire file is used to set up Radio Buttons.

     #if ($data{'CEREAL'}eq "ADDTEXT")   # don't forget we are using Firstlettercap capitalization case!!

     if ($data{'CEREAL'}eq "Addtext") 

     {

          $data{'CEREAL'} = $data{'CEREALTEXT'};


          # Go thru file, ensure that we are not adding a duplicate entry 

          # this occurs when the user keeps hitting the entry key without retyping his 

          # selections each time.


          $duplicate_flag = 0;        

          open (Q_FILE, "questionaire.txt");         #Open to read

          while (<Q_FILE>) # Top of read file loop.

          {

                $button_name = $_;

                $button_name =~ s/\n+//;  # remove any trailing whitespace, and delete it.

                if ($button_name eq $data{'CEREALTEXT'} ) 

                {

                    $duplicate_flag++;

                }

          } # go thru entire file...

          close (Q_FILE);


          if($data{'CEREALTEXT'} eq "")

          {

               $duplicate_flag++;

          }


          if ($duplicate_flag == 0)

          {

               open (Q_FILE, ">>questionaire.txt");         #Open for output(append, or create)

               print Q_FILE $data{'CEREALTEXT'}, "\n" ;     #add entry, newline character   

               close (Q_FILE);        

          }         


          # print "<H1> TEST PRINT -- Add Text to file routine... </H1>"

     }

     

     # TEST_PRINT();


     # Add entry to the SurveyResults File

     open (SURVEY_RESULTS_FILE, ">>surveyresults.txt");   #Open for output (append, or create)

     print SURVEY_RESULTS_FILE $data{'CEREAL'} , "%";

     print SURVEY_RESULTS_FILE $data{'CITY'} , "%";

     print SURVEY_RESULTS_FILE $data{'STATE'} , "%";

     # print SURVEY_RESULTS_FILE $data{'INUSA'} , "%";   # We're not going to use this variable.  See above.

     print SURVEY_RESULTS_FILE $data{'COLOR'} , "%";

     print SURVEY_RESULTS_FILE $data{'FREETIME'} ,"%", "\n";

     close (SURVEY_RESULTS_FILE);


     # Analyse SurveyResults File, Print out Survey Results.

     print "<CENTER><H1>Sample Survey Results -- CGI-Bin using Perl</H1></CENTER>";

     print "<HR ALIGN='center' WIDTH='90%'>";

  

     # Set up TABLE for output. 

     print "<TABLE ALIGN='center' BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH='90%'>";


     # Echo User's selections.

     print "<TR ALIGN='left' VALIGN='middle'>";   # Set up row

     print "<TH>You Selected the Following Values: </TH></TR>";

     print "<TR ALIGN='left' VALIGN='middle'>";

     print "<TD><BR><PRE>";

     print "<DD><DD>Favorite Cereal:            ",  $data{'CEREAL'}, "<BR>" ; #headr = 23 char

     $temp = uc($data{'STATE'});  # Convert states/provinces to all caps, See pg. 19 in 

                                  # PERL Cookbook, Christiansen and Torkington

     print "<DD><DD>You were born in:           ",  $data{'CITY'}, ", ",$temp, "<BR>" ;

     print "<DD><DD>Favorite Color:             ",  $data{'COLOR'}, "<BR>" ;

     print "<DD><DD>Favorite Freetime Activity: ",  $data{'FREETIME'}, "<BR>" ; 

     print "</PRE><BR>";

     print "</TD></TR>";


     # Read thru SurveyResults File, get a count of # of entries.

     open (SURVEY_RESULTS_FILE, "surveyresults.txt");   #Open to read


     while (<SURVEY_RESULTS_FILE>)  # Top of read file loop

     {

          $input_text_line = $_;  

          # Remember $BP3 = INUSA ? Do NOT use the next line!!

          # ($cereal, $BP1, $BP2, $BP3, $color, $freetime) = split(/%/,$input_text_line); 

          ($cereal, $BP1, $BP2, $color, $freetime) = split(/%/,$input_text_line); 

          #count cereal

          $cereal_array{$cereal}++;


          #count Birthplaces 

          $BP2 =~ tr/a-z/A-Z/;   #Oops... change case back on state/province/country

          $BP_sum = join (", ", $BP1, $BP2);      #add city + comma + state

          $BP_array{$BP_sum}++;


          #count color

          $color_array{$color}++;


          #count Freetime Activity

          $freetime_array{$freetime}++;

     }


     #  @total_cereal = %cereal_array;       # Test line only... remark out for production version..

     #  print "Test Print ", join(' --  ',@total_cereal), " <BR>";  # Test Line Only    

  

     # 1-- Print Out Cereal Responses, form = Bar Chart, sort alphabetical

     

          print "<TR ALIGN='left' VALIGN='middle'>";   # Set up row

          print "<TH>Responses -- What is your favorite breakfast cereal? (Pareto Format -- ABC Sort)</TH></TR>";

          print "<TR ALIGN='left' VALIGN='middle'>";

          print "<TD>";

          $total = 0;

          $maxnamelength = 0;

          $barwidth = 600;

          foreach $index (keys %cereal_array)

          {

               $total += $cereal_array{$index};

               if (length($index)>$maxnamelength)

               {

                    $maxnamelength=length($index);

               }

          }

          print "<BR>";

          #oops.. printf is about worthless in HTML unless you use PRE command...

          printf "<PRE>";

          printf "<DD><DD> %${maxnamelength}s  Cereal Name<BR> <BR>";

          foreach $index (sort keys %cereal_array)

          {         

               # print "<DD><DD>Cereal: ", " count is ", $cereal_array{$index}, " . ";

               

               printf "<DD><DD> %-${maxnamelength}s ",$index,  ' ' ;

               $percent = $cereal_array{$index} / $total; 

               #print "Test Print, Percent =", $percent, "Percent * barwidth =", int($percent*$barwidth);

               print "<img src='yellowbar.jpg' width=", int($percent*$barwidth);   #line continued next...

               print " height=15 border=1 align='' hspace=0 vspace=0>";

               print " (", int($percent*100),"%)";

               print "<BR>";

               

          }

          print "<BR>";

          print "</PRE></TD></TR>";

          

     # 2-- Print Out BirthPlace (form = text) sort by take rate


          print "<TR ALIGN='left' VALIGN='middle'>";   # Set up row

          print "<TH>Responses -- In what city were you born? (Text Output, %, Raw Count -- ABC Sort)<BR></TH></TR>";

          print "<TR ALIGN='left' VALIGN='middle'>";

          print "<TD><BR>";

          $total = 0;

          $maxnamelength = 0;

          foreach $index (keys %BP_array)

          {

               $total += $BP_array{$index};

               if (length($index)>$maxnamelength)

               {

                    $maxnamelength=length($index);

               }

          }

          printf "<PRE>";

          foreach $index (sort keys %BP_array)

          {    

               $percent = int($BP_array{$index} / $total *100); 

               printf "<DD><DD> %-${maxnamelength}s ",$index,  '   ' ;

               printf "%-2i", $percent;

               print "% ($BP_array{$index})";

          }

          print "</PRE>";

          print "</TD></TR>";


     # 3-- Print Out Color Response, form = %percent text, do not sort 


          print "<TR ALIGN='left' VALIGN='middle'>";   # Set up row

          print "<TH>Responses -- What is your favorite color? (Pareto Format -- Pareto Sort)</TH></TR>";

          print "<TR ALIGN='left' VALIGN='middle'>";

          print "<TD>";

          $total = 0;

          $maxnamelength = 0;

          $barwidth = 600;

          foreach $index (keys %color_array)

          {

               $total += $color_array{$index};

               if (length($index)>$maxnamelength)

               {

                    $maxnamelength=length($index);

               }

          }

          print "<BR>";

          #oops.. printf is about worthless in HTML unless you use PRE command...

          printf "<PRE>";

          printf "<DD><DD> %${maxnamelength}s  Color<BR> <BR>";

          # for sort by associated value, see PERL Cookbook, Christiansen & Torkington

          # pg. 144, Sorting a hash...    See also p.115 for numerical compare operator

          # Note:  If you want an ascending order, swap $a and $b...

          foreach $index (sort { $color_array{$b} <=> $color_array{$a} }

                          keys %color_array )

          {         

               # print "<DD><DD>color: ", " count is ", $color_array{$index}, " . ";

               

               printf "<DD><DD> %-${maxnamelength}s ",$index,  '   ' ;

               $percent = $color_array{$index} / $total; 

               #print "Test Print, Percent =", $percent, "Percent * barwidth =", int($percent*$barwidth);

               print "<img src='redbar.jpg' width=", int($percent*$barwidth);   #line continued next...

               print " height=15 border=1 align='' hspace=0 vspace=0>";

               print " (", int($percent*100),"%)";

               print "<BR>";       

          }

          print "<BR>";

          print "</PRE></TD></TR>";


     # 4-- Print Out Freetime Activity (form = text) sort by take rate

     

          print "<TR ALIGN='left' VALIGN='middle'>";   # Set up row

          print "<TH>Responses -- What is your favorite freetime activity? (Text Output, %, Raw Count -- Pareto Sort)<BR></TH></TR>";


          print "<TR ALIGN='left' VALIGN='middle'>";

          print "<TD><BR>";

          $total = 0;

          $maxnamelength = 0;

          foreach $index (keys %freetime_array)

          {

               $total += $freetime_array{$index};

               if (length($index)>$maxnamelength)

               {

                    $maxnamelength=length($index);

               }

          }

          printf "<PRE>";

          

          # for sort by associated value, see PERL Cookbook, Christiansen & Torkington

          # pg. 144, Sorting a hash...    See also p.115 for numerical compare operator

          # Note:  If you want an ascending order, swap $a and $b...

          foreach $index (sort { $freetime_array{$b} <=> $freetime_array{$a} }

                          keys %freetime_array )

          {    

               $percent = int($freetime_array{$index} / $total *100); 

               #Note the minor variation in format.  Which is better?

               #clearly the % is a tough symbol to play with.

               printf "<DD><DD> %-${maxnamelength}s ",$index,  ' ' ;

               print " $percent% ($freetime_array{$index})";

          }

          print "</PRE>";

          print "</TD></TR>";


     

     # Close TABLE Format

     print "</TABLE>";

     print "<BR><BR>";


     VERTICAL_BAR_PARETO(); # Let's try to print out 

     

     &PRINT_WEB_CLOSING;

}

exit;



#/////////////////////////////////////////////////////////////////////////////////////////#

#   Subroutine: GET_DATA_FROM_FORM

#/////////////////////////////////////////////////////////////////////////////////////////#

sub GET_DATA_FROM_FORM 

{

     #This routine is borrowed heavily from both CGI-LIB.PL, referenced in www.cclabs.missouri.edu/

     #things/instruction/perl/perlcourse.html, Sect. 14.  The CGI-LIB.PL is actually found @ 

     #http://cgi-lib.berkeley.edu/1/14/cgi-lib.pl.txt   Additionally, the subroutine GET_FORM_DATA

     #from www.jdonohue.com/perl2/cgi-bin/selfscre.txt (Net Addiction Self Scoring Form) is also

     #used as a reference here.

     

     #This routine reads in GET data, converts it to usable text, then stores the data

     #in %in, (data pairs).  This routine returns true if there was any data, else returns false.

     

     local (*in) = @_ if @_ ;   #reminder @_ = implicit whole list 

                                # (See MU Intro to Perl Name Conventions)

     local ($i, $name, $value);

                                #reminder local() is not what you think it is.  See PERL Cookbook

                                # by Christiansen and Torkington, pg. 353 (Subroutine Chapter)

     

     #verify GET DATA

     if ($ENV{'REQUEST_METHOD'} eq "GET")

     {

          $in=$ENV{'QUERY_STRING'};

     }


     @in = split(/[&;]/ , $in );  # split the data line into indiv. blocks at each & or ; symbol.


     foreach $i (0 .. $#in)

     {

          #convert plus's to spaces

          $in[$i] =~ s/\+/ /g;     #alternate form...  =~ s/\x2b/\/x20/g;   Not intuitive, is it?


          #convert %XX from hex numbers to alphanumeric

          $in[$i] =~ s/%2C/\x2c/g; #  Convert '

          $in[$i] =~ s/%28/\x28/g; #  Convert (

          $in[$i] =~ s/%29/\x29/g; #  Convert )


          #alternate form  (do AFTER = sign split!!)

          # $in[$i] =~ s/%(..)/pack("c",hex($1))/ge ;


          #split into key-name and value.

          ($name, $value) = split(/=/,$in[$i],2);  #split on the first = sign.

          # Reminder: The split function takes three arguments: 

          # Pattern (the field seperator)

          # Expression (the string value to split at)

          # Limit (max number of fields to split into) 


          # Control Capitalization         

          $value = &CHANGE_CASE($value); 

          #$value=~ tr/a-z/A-Z/;

 

          #associate key-name and value.

          $in{$name} .= "\0" if (defined($in{$name})); # \0 is the multiple separator

          $in{$name} .= $value;

     }


     return scalar(@in);

}


sub PRINT_WEB_HEADER

{

     # Headers terminate with a null line (See Intro to PERL, Univ. of Missouri Web site)

     print "Content-type: text/html\n\n";

     print " <HTML><HEAD>";

     print "<title>LCorney Sample Survey -- CGI-Bin using PERL</title>";

     print "</HEAD>"; 

     print "<BODY TEXT='#000000' BGCOLOR='#b0fff' >";    #Use for printing!

}


sub PRINT_WEB_CLOSING

{

     print "</BODY></HTML>";

}


sub TEST_PRINT

{

     print "<H1>This is a test...  </H1> <BR>" ;

     print join('<BR>',@data);  #Test Print

     print "<BR> <BR>";

     

     print "TEST Print, Cereal = ", $data{'CEREAL'}, "<BR>";

     print "TEST print, CerealText = ", $data{'CEREALTEXT'}, "<BR>";

     print "TEST Print, City = ", $data{'CITY'}, "<BR>";

     print "TEST print, State = ", $data{'STATE'}, "<BR>";

     print "TEST Print, InUsa = ", $data{'INUSA'}, "<BR>";

     print "TEST print, Color = ", $data{'COLOR'}, "<BR>";

     print "TEST Print, FreeTime = ", $data{'FREETIME'}, "<BR>";     

     print "<BR><BR>";    

     

     # note... Obviously, @data is NOT the same as %data (which is made up of many $data...)

}


sub CHANGE_CASE

{

     my ($in) = @_ ;   #reminder @_ = implicit whole list (See MU Intro to Perl Name Conventions)

     #$in =~ tr/a-z/A-Z/;         # Test line

     $in =~ s/(\w+)/\u\L$1/g;   # I really hate commands like this.  This is not intuitive

                                # See "Perl Cookbook" by Christiansen & Torkington, pg. 20

                                # it kinda means 1) search for a word (\w+) (store it in $1 implied) 

                                # 2) convert first letter to upper case

                                # 3) convert the rest of the word ($1) to lower case

     return $in;

     # return $in implied...  Perl is a strange language

}


sub VERTICAL_BAR_PARETO

{    

     # print out freetime activity in vertical pareto chart...

     

     # The idea is okay, but this looks lousy in practice.

     # In order to get the thing to look pretty, you pretty much have to use

     # tables, with one entry for each vertical bar.  Unfortunately, when 

     # one uses the defaults, the system doesn't evenly space out the columns

     # first column = 1/2, 2nd column = 1/4, 3rd = 1/8, etc...

     # One can spend lots of time here with calculates, divides, etc... but

     # there is probably not an effective way to display a pretty pareto

     # with a variable number of columns from One or Two up to 50.  You could 

     # start with 1/8 segments, then calculate column width, but then you have

     # problems with headers not showing up... ouch!  Let's hold this off till 

     # another time, with # of table columns at a "near" fixed value.

    

     print "<BR><BR>";

     print "<TABLE ALIGN='center' BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH='90%'>";

     print "<TR ALIGN='center' VALIGN='middle'>";   # Set up row

     print "<TH>Responses -- What is your favorite freetime activity? (Alternate Format) <BR><BR></TH></TR>";

     print "</TABLE> ";   #Make header look nice across the entire table...

     

     print "<TABLE ALIGN='center' BORDER=1 CELLSPACING=0 CELLPADDING=0 WIDTH='90%'>";

     $total = 0;

     foreach $index (sort keys %freetime_array)

     {    

          $total += $freetime_array{$index};

     }

  

     print "<TR ALIGN='center' VALIGN='bottom'>";   # Set up row

     foreach $index (sort keys %freetime_array)

     {

          print "<TD ALIGN='middle' width=80>";     

          $percent = $freetime_array{$index} / $total; 

          print "<img src='greenbar.jpg' width=15, height=", int($percent*$barwidth);  

          print "border=1 align='bottom' hspace=0 vspace=0>";   #continued from above...

          print "</TD>";

     }

     print "</TR>";

  

     

     print "<TR ALIGN='center' VALIGN='bottom'>";   # Set up row

     foreach $index (sort keys %freetime_array)

     {    

          $percent = $freetime_array{$index} / $total; 

          print "<TD> $index  (", int($percent*100),"%) </TD>";

     }

     print "</TR>";


     print "</TABLE>";

 }


# Improvements for next time:

#  --Throw Javascript box up with states and Canadian Province abbreviations (see mapquest.com)

#  --Add semaphore or other control on input/output files.