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 |
|
---|