Commit | Line | Data |
54310121 |
1 | #!/usr/local/bin/perl |
2 | |
3 | use CGI qw(:standard); |
4 | |
5 | @ANIMALS=sort qw/lion tiger bear pig porcupine ferret zebra gnu ostrich |
6 | emu moa goat weasel yak chicken sheep hyena dodo lounge-lizard |
7 | squirrel rat mouse hedgehog racoon baboon kangaroo hippopotamus |
8 | giraffe/; |
9 | |
10 | # Recover the previous animals from the magic cookie. |
11 | # The cookie has been formatted as an associative array |
12 | # mapping animal name to the number of animals. |
13 | %zoo = cookie('animals'); |
14 | |
15 | # Recover the new animal(s) from the parameter 'new_animal' |
16 | @new = param('new_animals'); |
17 | |
18 | # If the action is 'add', then add new animals to the zoo. Otherwise |
19 | # delete them. |
20 | foreach (@new) { |
21 | if (param('action') eq 'Add') { |
22 | $zoo{$_}++; |
23 | } elsif (param('action') eq 'Delete') { |
24 | $zoo{$_}-- if $zoo{$_}; |
25 | delete $zoo{$_} unless $zoo{$_}; |
26 | } |
27 | } |
28 | |
29 | # Add new animals to old, and put them in a cookie |
30 | $the_cookie = cookie(-name=>'animals', |
31 | -value=>\%zoo, |
32 | -expires=>'+1h'); |
33 | |
34 | # Print the header, incorporating the cookie and the expiration date... |
35 | print header(-cookie=>$the_cookie); |
36 | |
37 | # Now we're ready to create our HTML page. |
38 | print start_html('Animal crackers'); |
39 | |
40 | print <<EOF; |
41 | <h1>Animal Crackers</h1> |
42 | Choose the animals you want to add to the zoo, and click "add". |
43 | Come back to this page any time within the next hour and the list of |
44 | animals in the zoo will be resurrected. You can even quit Netscape |
45 | completely! |
46 | <p> |
47 | Try adding the same animal several times to the list. Does this |
48 | remind you vaguely of a shopping cart? |
49 | <p> |
50 | <em>This script only works with Netscape browsers</em> |
51 | <p> |
52 | <center> |
53 | <table border> |
54 | <tr><th>Add/Delete<th>Current Contents |
55 | EOF |
56 | ; |
57 | |
58 | print "<tr><td>",start_form; |
59 | print scrolling_list(-name=>'new_animals', |
60 | -values=>[@ANIMALS], |
61 | -multiple=>1, |
62 | -override=>1, |
63 | -size=>10),"<br>"; |
64 | print submit(-name=>'action',-value=>'Delete'), |
65 | submit(-name=>'action',-value=>'Add'); |
66 | print end_form; |
67 | |
68 | print "<td>"; |
69 | if (%zoo) { # make a table |
70 | print "<ul>\n"; |
71 | foreach (sort keys %zoo) { |
72 | print "<li>$zoo{$_} $_\n"; |
73 | } |
74 | print "</ul>\n"; |
75 | } else { |
76 | print "<strong>The zoo is empty.</strong>\n"; |
77 | } |
78 | print "</table></center>"; |
79 | |
80 | print <<EOF; |
81 | <hr> |
82 | <ADDRESS>Lincoln D. Stein</ADDRESS><BR> |
83 | <A HREF="./">More Examples</A> |
84 | EOF |
85 | ; |
86 | print end_html; |
87 | |
88 | |