[14489] | 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 |
|
---|