1  #!/usr/bin/perl -Tw
2  use strict;
3  $|++;
4
5  use CGI qw(:all);
6
7  ## set up the cache
8
9  use File::Cache;
10  my $cache = File::Cache->new({namespace => 'surveyonce',
11                                username => 'nobody',
12                                filemode => 0666,
13                                expires_in => 3600, # one hour
14                               });
15
16  unless ($cache->get(" _purge_ ")) { # cleanup?
17    $cache->purge;
18    $cache->set(" _purge_ ", 1);
19  }
20
21  my $SCRIPT_ID = join ".", (stat $0)[0,1,10];
22
23  print header, start_html("Survey"), h1("Survey");
24
25  if (param) {
26    ## returning with form data
27
28    ## verify first submit of this form data,
29    ## and from the form generated by this particular script only
30    my $session = param('session');
31    if (defined $session and do {
32      my $id = $cache->get($session);
33      $cache->remove($session);   # let this be the only one
34      $id and $id eq $SCRIPT_ID;
35    }) {
36      ## good session, process form data
37      print h2("Thank you");
38      print "Your information has been processed.";
39      my $name = param('name');
40      $name = "(Unspecified)" unless defined $name and length $name;
41      my ($color) = grep $_ ne '-other-', param('color');
42      $color = "(Unspecified)" unless defined $color and length $color;
43      print p, "Your name is ", b(escapeHTML($name));
44      print " and your favorite color is ", b(escapeHTML($color)), ".";
45    } else {
46      print h2("Error"), "Hmm, I can't process your input.  Please ";
47      print a({href => script_name()}, "start over"),".";
48    }
49  } else {
50    ## initial invocation ? print form
51
52    ## get unique non-guessable stamp for this form
53    require MD5;
54    param('session',
55          my $session = MD5->hexhash(MD5->hexhash(time.{}.rand().$$)));
56
57    ## store session key in cache
58    $cache->set($session, $SCRIPT_ID);
59
60    ## print form
61    print hr, start_form;
62    print "What's your name? ",textfield('name'), br;
63    print "What's your favorite color? ";
64    print popup_menu(-name=>'color',
65           -values=>[qw(-other- red orange yellow green blue purple)]);
66    print " if -other-: ", textfield('color'), br;
67    print hidden('session');
68    print submit, end_form, hr;
69
70  }
71
72  print end_html;