contrib/perl5/eg/cgi/save_state.cgi

   1 #!/usr/local/bin/perl
   2
   3 use CGI;
   4 $query = new CGI;
   5
   6 print $query->header;
   7 print $query->start_html("Save and Restore Example");
   8 print "<H1>Save and Restore Example</H1>\n";
   9
  10 # Here's where we take action on the previous request
  11 &save_parameters($query)              if $query->param('action') eq 'SAVE';
  12 $query = &restore_parameters($query)  if $query->param('action') eq 'RESTORE';
  13
  14 # Here's where we create the form
  15 print $query->start_multipart_form;
  16 print "Popup 1: ",$query->popup_menu('popup1',[qw{red green purple magenta orange chartreuse brown}]),"\n";
  17 print "Popup 2: ",$query->popup_menu('popup2',[qw{lion tiger bear zebra potto wildebeest frog emu gazelle}]),"\n";
  18 print "<P>";
  19 $default_name = $query->remote_addr . '.sav';
  20 print "Save/restore state from file: ",$query->textfield('savefile',$default_name),"\n";
  21 print "<P>";
  22 print $query->submit('action','SAVE'),$query->submit('action','RESTORE');
  23 print "<P>",$query->defaults;
  24 print $query->endform;
  25
  26 # Here we print out a bit at the end
  27 print $query->end_html;
  28
  29 sub save_parameters {
  30     local($query) = @_;
  31     local($filename) = &clean_name($query->param('savefile'));
  32     if (open(FILE,">$filename")) {
  33         $query->save(FILE);
  34         close FILE;
  35         print "<STRONG>State has been saved to file $filename</STRONG>\n";
  36         print "<P>If you remember this name you can restore the state later.\n";
  37     } else {
  38         print "<STRONG>Error:</STRONG> couldn't write to file $filename: $!\n";
  39     }
  40 }
  41
  42 sub restore_parameters {
  43     local($query) = @_;
  44     local($filename) = &clean_name($query->param('savefile'));
  45     if (open(FILE,$filename)) {
  46         $query = new CGI(FILE);  # Throw out the old query, replace it with a new one
  47         close FILE;
  48         print "<STRONG>State has been restored from file $filename</STRONG>\n";
  49     } else {
  50         print "<STRONG>Error:</STRONG> couldn't restore file $filename: $!\n";
  51     }
  52     return $query;
  53 }
  54
  55
  56 # Very important subroutine -- get rid of all the naughty
  57 # metacharacters from the file name. If there are, we
  58 # complain bitterly and die.
  59 sub clean_name {
  60    local($name) = @_;
  61    unless ($name=~/^[\w\._\-]+$/) {
  62       print "<STRONG>$name has naughty characters.  Only ";
  63       print "alphanumerics are allowed.  You can't use absolute names.</STRONG>";
  64       die "Attempt to use naughty characters";
  65    }
  66    return "WORLD_WRITABLE/$name";
  67 }