perl5.005_03

9 files changed, 564 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/eg/cgi/RunMeFirst b/gnu/usr.bin/perl/eg/cgi/RunMeFirst
new file mode 100644
index 00000000000..c96d79eb628
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/cgi/RunMeFirst
@@ -0,0 +1,29 @@
+#!/usr/local/bin/perl
+
+# Make a world-writeable directory for saving state.
+$ww = 'WORLD_WRITABLE';
+unless (-w $ww) {
+    $u = umask 0;
+    mkdir $ww, 0777;
+    umask $u;
+}
+
+# Decode the sample image.
+for $bin (qw(wilogo.gif)) {
+    unless (open UU, "$bin.uu") { warn "Can't open $bin.uu: $!\n"; next }
+    unless (open BIN, "> $bin") { warn "Can't create $bin: $!\n"; next }
+    $_ = <UU>;
+    while (<UU>) {
+	chomp;
+	last if /^end/;
+	print BIN unpack "u", $_;
+    }
+    close BIN;
+    close UU;
+}
+
+# Create symlinks from *.txt to *.cgi for documentation purposes.
+foreach (<*.cgi>) {
+    ($target = $_) =~ s/cgi$/txt/;
+    symlink $_, $target unless -e $target;
+}
diff --git a/gnu/usr.bin/perl/eg/cgi/clickable_image.cgi b/gnu/usr.bin/perl/eg/cgi/clickable_image.cgi
new file mode 100644
index 00000000000..81daf09690f
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/cgi/clickable_image.cgi
@@ -0,0 +1,26 @@
+#!/usr/local/bin/perl
+
+use CGI;
+$query = new CGI;
+print $query->header;
+print $query->start_html("A Clickable Image");
+print <<END;
+<H1>A Clickable Image</H1>
+</A>
+END
+print "Sorry, this isn't very exciting!\n";
+
+print $query->startform;
+print $query->image_button('picture',"./wilogo.gif");
+print "Give me a: ",$query->popup_menu('letter',['A','B','C','D','E','W']),"\n"; # 
+print "<P>Magnification: ",$query->radio_group('magnification',['1X','2X','4X','20X']),"\n";
+print "<HR>\n";
+
+if ($query->param) {
+    print "<P>Magnification, <EM>",$query->param('magnification'),"</EM>\n";
+    print "<P>Selected Letter, <EM>",$query->param('letter'),"</EM>\n";
+    ($x,$y) = ($query->param('picture.x'),$query->param('picture.y'));
+    print "<P>Selected Position <EM>($x,$y)</EM>\n";
+}
+
+print $query->end_html;
diff --git a/gnu/usr.bin/perl/eg/cgi/cookie.cgi b/gnu/usr.bin/perl/eg/cgi/cookie.cgi
new file mode 100644
index 00000000000..98adda196ed
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/cgi/cookie.cgi
@@ -0,0 +1,88 @@
+#!/usr/local/bin/perl
+
+use CGI qw(:standard);
+
+@ANIMALS=sort qw/lion tiger bear pig porcupine ferret zebra gnu ostrich
+    emu moa goat weasel yak chicken sheep hyena dodo lounge-lizard
+    squirrel rat mouse hedgehog racoon baboon kangaroo hippopotamus
+    giraffe/;
+
+# Recover the previous animals from the magic cookie.
+# The cookie has been formatted as an associative array
+# mapping animal name to the number of animals.
+%zoo = cookie('animals');
+
+# Recover the new animal(s) from the parameter 'new_animal'
+@new = param('new_animals');
+
+# If the action is 'add', then add new animals to the zoo.  Otherwise
+# delete them.
+foreach (@new) {
+    if (param('action') eq 'Add') {
+	$zoo{$_}++;
+    } elsif (param('action') eq 'Delete') {
+	$zoo{$_}-- if $zoo{$_};
+	delete $zoo{$_} unless $zoo{$_};
+    }
+}
+
+# Add new animals to old, and put them in a cookie
+$the_cookie = cookie(-name=>'animals',
+		     -value=>\%zoo,
+		     -expires=>'+1h');
+
+# Print the header, incorporating the cookie and the expiration date...
+print header(-cookie=>$the_cookie);
+
+# Now we're ready to create our HTML page.
+print start_html('Animal crackers');
+
+print <<EOF;
+<h1>Animal Crackers</h1>
+Choose the animals you want to add to the zoo, and click "add".
+Come back to this page any time within the next hour and the list of 
+animals in the zoo will be resurrected.  You can even quit Netscape
+completely!
+<p>
+Try adding the same animal several times to the list.  Does this
+remind you vaguely of a shopping cart?
+<p>
+<em>This script only works with Netscape browsers</em>
+<p>
+<center>
+<table border>
+<tr><th>Add/Delete<th>Current Contents
+EOF
+    ;
+
+print "<tr><td>",start_form;
+print scrolling_list(-name=>'new_animals',
+		     -values=>[@ANIMALS],
+		     -multiple=>1,
+		     -override=>1,
+		     -size=>10),"<br>";
+print submit(-name=>'action',-value=>'Delete'),
+    submit(-name=>'action',-value=>'Add');
+print end_form;
+
+print "<td>";
+if (%zoo) {			# make a table
+    print "<ul>\n";
+    foreach (sort keys %zoo) {
+	print "<li>$zoo{$_} $_\n";
+    }
+    print "</ul>\n";
+} else {
+    print "<strong>The zoo is empty.</strong>\n";
+}
+print "</table></center>";
+
+print <<EOF;
+<hr>
+<ADDRESS>Lincoln D. Stein</ADDRESS><BR>
+<A HREF="./">More Examples</A>
+EOF
+    ;
+print end_html;
+
+
diff --git a/gnu/usr.bin/perl/eg/cgi/crash.cgi b/gnu/usr.bin/perl/eg/cgi/crash.cgi
new file mode 100644
index 00000000000..64f03c7b3db
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/cgi/crash.cgi
@@ -0,0 +1,6 @@
+#!/usr/local/bin/perl
+
+use CGI::Carp qw(fatalsToBrowser);
+
+# This line invokes a fatal error message at compile time.
+foo bar baz;
diff --git a/gnu/usr.bin/perl/eg/cgi/customize.cgi b/gnu/usr.bin/perl/eg/cgi/customize.cgi
new file mode 100644
index 00000000000..c1c81875144
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/cgi/customize.cgi
@@ -0,0 +1,92 @@
+#!/usr/local/bin/perl
+
+use CGI qw(:standard :html3);
+
+# Some constants to use in our form.
+@colors=qw/aqua black blue fuschia gray green lime maroon navy olive
+    purple red silver teal white yellow/;
+@sizes=("<default>",1..7);
+
+# recover the "preferences" cookie.
+%preferences = cookie('preferences');
+
+# If the user wants to change the background color or her
+# name, they will appear among our CGI parameters.
+foreach ('text','background','name','size') {
+    $preferences{$_} = param($_) || $preferences{$_};
+}
+
+# Set some defaults
+$preferences{'background'} = $preferences{'background'} || 'silver';
+$preferences{'text'} = $preferences{'text'} || 'black';
+
+# Refresh the cookie so that it doesn't expire.  This also
+# makes any changes the user made permanent.
+$the_cookie = cookie(-name=>'preferences',
+			 -value=>\%preferences,
+			 -expires=>'+30d');
+print header(-cookie=>$the_cookie);
+
+# Adjust the title to incorporate the user's name, if provided.
+$title = $preferences{'name'} ? 
+    "Welcome back, $preferences{name}!" : "Customizable Page";
+
+# Create the HTML page.  We use several of Netscape's
+# extended tags to control the background color and the
+# font size.  It's safe to use Netscape features here because
+# cookies don't work anywhere else anyway.
+print start_html(-title=>$title,
+		 -bgcolor=>$preferences{'background'},
+		 -text=>$preferences{'text'}
+		 );
+
+print basefont({SIZE=>$preferences{size}}) if $preferences{'size'} > 0;
+
+print h1($title),<<END;
+You can change the appearance of this page by submitting
+the fill-out form below.  If you return to this page any time
+within 30 days, your preferences will be restored.
+END
+    ;
+
+# Create the form
+print hr(),
+    start_form,
+    
+    "Your first name: ",
+    textfield(-name=>'name',
+	      -default=>$preferences{'name'},
+	      -size=>30),br,
+    
+    table(
+	  TR(
+	     td("Preferred"),
+	     td("Page color:"),
+	     td(popup_menu(-name=>'background',
+			   -values=>\@colors,
+			   -default=>$preferences{'background'})
+		),
+	     ),
+	  TR(
+	     td(''),
+	     td("Text color:"),
+	     td(popup_menu(-name=>'text',
+			   -values=>\@colors,
+			   -default=>$preferences{'text'})
+		)
+	     ),
+	  TR(
+	     td(''),
+	     td("Font size:"),
+	     td(popup_menu(-name=>'size',
+			   -values=>\@sizes,
+			   -default=>$preferences{'size'})
+		)
+	     )
+	  ),
+
+    submit(-label=>'Set preferences'),
+    hr;
+	   
+print a({HREF=>"/"},'Go to the home page');
+print end_html;
diff --git a/gnu/usr.bin/perl/eg/cgi/diff_upload.cgi b/gnu/usr.bin/perl/eg/cgi/diff_upload.cgi
new file mode 100644
index 00000000000..913f9ca1791
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/cgi/diff_upload.cgi
@@ -0,0 +1,68 @@
+#!/usr/local/bin/perl
+
+$DIFF = "/usr/bin/diff";
+$PERL = "/usr/bin/perl";
+
+use CGI qw(:standard);
+use CGI::Carp;
+
+print header;
+print start_html("File Diff Example");
+print "<strong>Version </strong>$CGI::VERSION<p>";
+
+print <<EOF;
+<H1>File Diff Example</H1>
+Enter two files.  When you press "submit" their diff will be
+produced.
+EOF
+    ;
+
+# Start a multipart form.
+print start_multipart_form;
+print "File #1:",filefield(-name=>'file1',-size=>45),"<BR>\n";
+print "File #2:",filefield(-name=>'file2',-size=>45),"<BR>\n";
+print "Diff type: ",radio_group(-name=>'type',
+					-value=>['context','normal']),"<br>\n";
+print reset,submit(-name=>'submit',-value=>'Do Diff');
+print endform;
+
+# Process the form if there is a file name entered
+$file1 = param('file1');
+$file2 = param('file2');
+
+$|=1;				# for buffering
+if ($file1 && $file2) {
+    $realfile1 = tmpFileName($file1);
+    $realfile2 = tmpFileName($file2);
+    print "<HR>\n";
+    print "<H2>$file1 vs $file2</H2>\n";
+
+    print "<PRE>\n";
+    $options = "-c" if param('type') eq 'context';
+    system "$DIFF $options $realfile1 $realfile2 | $PERL -pe 's/>/&gt;/g; s/</&lt;/g;'";
+    close $file1;
+    close $file2;
+    print "</PRE>\n";
+}
+
+print <<EOF;
+<HR>
+<A HREF="../cgi_docs.html">CGI documentation</A>
+<HR>
+<ADDRESS>
+<A HREF="/~lstein">Lincoln D. Stein</A>
+</ADDRESS><BR>
+Last modified 17 July 1996
+EOF
+    ;
+print end_html;
+
+sub sanitize {
+    my $name = shift;
+    my($safe) = $name=~/([a-zA-Z0-9._~#,]+)/;
+    unless ($safe) {
+	print "<strong>$name is not a valid Unix filename -- sorry</strong>";
+	exit 0;
+    }
+    return $safe;
+}
diff --git a/gnu/usr.bin/perl/eg/cgi/file_upload.cgi b/gnu/usr.bin/perl/eg/cgi/file_upload.cgi
new file mode 100644
index 00000000000..1f9eaec3321
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/cgi/file_upload.cgi
@@ -0,0 +1,63 @@
+#!/usr/local/bin/perl
+
+use CGI qw(:standard);
+use CGI::Carp;
+
+print header();
+print start_html("File Upload Example");
+print strong("Version "),$CGI::VERSION,p;
+
+print h1("File Upload Example"),
+    'This example demonstrates how to prompt the remote user to
+    select a remote file for uploading. ',
+    strong("This feature only works with Netscape 2.0 browsers."),
+    p,
+    'Select the ',cite('browser'),' button to choose a text file
+    to upload.  When you press the submit button, this script
+    will count the number of lines, words, and characters in
+    the file.';
+
+@types = ('count lines','count words','count characters');
+
+# Start a multipart form.
+print start_multipart_form(),
+    "Enter the file to process:",
+    filefield('filename','',45),
+    br,
+    checkbox_group('count',\@types,\@types),
+    p,
+    reset,submit('submit','Process File'),
+    endform;
+
+# Process the form if there is a file name entered
+if ($file = param('filename')) {
+    $tmpfile=tmpFileName($file);
+    print hr(),
+          h2($file),
+          h3($tmpfile);
+    my($lines,$words,$characters,@words) = (0,0,0,0);
+    while (<$file>) {
+	$lines++;
+	$words += @words=split(/\s+/);
+	$characters += length($_);
+    }
+    close $file;
+    grep($stats{$_}++,param('count'));
+    if (%stats) {
+	print strong("Lines: "),$lines,br if $stats{'count lines'};
+	print strong("Words: "),$words,br if $stats{'count words'};
+	print strong("Characters: "),$characters,br if $stats{'count characters'};
+    } else {
+	print strong("No statistics selected.");
+    }
+}
+
+print hr(),
+    a({href=>"../cgi_docs.html"},"CGI documentation"),
+    hr,
+    address(
+	    a({href=>'/~lstein'},"Lincoln D. Stein")),
+    br,
+    'Last modified July 17, 1996',
+    end_html;
+
diff --git a/gnu/usr.bin/perl/eg/cgi/frameset.cgi b/gnu/usr.bin/perl/eg/cgi/frameset.cgi
new file mode 100644
index 00000000000..fc86e92e9ac
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/cgi/frameset.cgi
@@ -0,0 +1,81 @@
+#!/usr/local/bin/perl
+
+use CGI;
+$query = new CGI;
+print $query->header;
+$TITLE="Frameset Example";
+
+# We use the path information to distinguish between calls
+# to the script to:
+# (1) create the frameset
+# (2) create the query form
+# (3) create the query response
+
+$path_info = $query->path_info;
+
+# If no path information is provided, then we create 
+# a side-by-side frame set
+if (!$path_info) {
+    &print_frameset;
+    exit 0;
+}
+
+# If we get here, then we either create the query form
+# or we create the response.
+&print_html_header;
+&print_query if $path_info=~/query/;
+&print_response if $path_info=~/response/;
+&print_end;
+
+
+# Create the frameset
+sub print_frameset {
+    $script_name = $query->script_name;
+    print <<EOF;
+<html><head><title>$TITLE</title></head>
+<frameset cols="50,50">
+<frame src="$script_name/query" name="query">
+<frame src="$script_name/response" name="response">
+</frameset>
+EOF
+    ;
+    exit 0;
+}
+
+sub print_html_header {
+    print $query->start_html($TITLE);
+}
+
+sub print_end {
+    print qq{<P><hr><A HREF="../index.html" TARGET="_top">More Examples</A>};
+    print $query->end_html;
+}
+
+sub print_query {
+    $script_name = $query->script_name;
+    print "<H1>Frameset Query</H1>\n";
+    print $query->startform(-action=>"$script_name/response",-TARGET=>"response");
+    print "What's your name? ",$query->textfield('name');
+    print "<P>What's the combination?<P>",
+    $query->checkbox_group(-name=>'words',
+			       -values=>['eenie','meenie','minie','moe']);
+
+    print "<P>What's your favorite color? ",
+    $query->popup_menu(-name=>'color',
+		       -values=>['red','green','blue','chartreuse']),
+    "<P>";
+    print $query->submit;
+    print $query->endform;
+}
+
+sub print_response {
+    print "<H1>Frameset Result</H1>\n";
+    unless ($query->param) {
+	print "<b>No query submitted yet.</b>";
+	return;
+    }
+    print "Your name is <EM>",$query->param(name),"</EM>\n";
+    print "<P>The keywords are: <EM>",join(", ",$query->param(words)),"</EM>\n";
+    print "<P>Your favorite color is <EM>",$query->param(color),"</EM>\n";
+}
+
diff --git a/gnu/usr.bin/perl/eg/cgi/index.html b/gnu/usr.bin/perl/eg/cgi/index.html
new file mode 100644
index 00000000000..9eafd5f1086
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/cgi/index.html
@@ -0,0 +1,111 @@
+<HTML> <HEAD>
+<TITLE>More Examples of Scripts Created with CGI.pm</TITLE>
+</HEAD>
+
+<BODY>
+<H1>More Examples of Scripts Created with CGI.pm</H1>
+
+<H2> Basic Non Sequitur Questionnaire</H2>
+<UL>
+  <LI> <A HREF="tryit.cgi">Try the script</A>
+  <LI> <A HREF="tryit.txt">Look at its source code</A>
+</UL>
+
+<H2> Advanced Non Sequitur Questionnaire</H2>
+<UL>
+  <LI> <A HREF="monty.cgi">Try the script</A>
+  <LI> <A HREF="monty.txt">Look at its source code</A>
+</UL>
+
+<H2> Save and restore the state of a form to a file</H2>
+<UL>
+  <LI> <A HREF="save_state.cgi">Try the script</A>
+  <LI> <A HREF="save_state.txt">Look at its source code</A>
+</UL>
+
+<H2> Read the coordinates from a clickable image map</H2>
+<UL>
+  <LI> <A HREF="clickable_image.cgi">Try the script</A>
+  <LI> <A HREF="clickable_image.txt">Look at its source code</A>
+</UL>
+
+<H2> Multiple independent forms on the same page</H2>
+<UL>
+  <LI> <A HREF="multiple_forms.cgi">Try the script</A>
+  <LI> <A HREF="multiple_forms.txt">Look at its source code</A>
+</UL>
+
+<H2> How to maintain state on a page with internal links</H2>
+<UL>
+  <LI> <A HREF="internal_links.cgi">Try the script</A>
+  <LI> <A HREF="internal_links.txt">Look at its source code</A>
+</UL>
+
+<h2>Echo fatal script errors to the browser</h2>
+<ul>
+  <li><a href="crash.cgi">Try the script</a>
+  <li><a href="crash.txt">Look at its source code</a>
+</ul>
+
+<EM>The Following Scripts only Work with Netscape 2.0 & Internet Explorer only!</EM>
+
+<H2> Prompt for a file to upload and process it</H2>
+<UL>
+  <LI> <A HREF="file_upload.cgi">Try the script</A>
+  <LI> <A HREF="file_upload.txt">Look at its source code</A>
+</UL>
+
+<h2> A Continuously-Updated Page using Server Push</h2>
+<ul>
+  <li><a href="nph-clock.cgi">Try the script</a>
+  <li><a href="nph-clock.txt">Look at its source code</a>
+</ul>
+
+<h2>Compute the "diff" between two uploaded files</h2>
+<ul>
+  <li><a href="diff_upload.cgi">Try the script</a>
+  <li><a href="diff_upload.txt">Look at its source code</a>
+</ul>
+
+<h2>Maintain state over a long period with a cookie</h2>
+<ul>
+  <li><a href="cookie.cgi">Try the script</a>
+  <li><a href="cookie.txt">Look at its source code</a>
+</ul>
+
+<h2>Permanently customize the appearance of a page</h2>
+<ul>
+  <li><a href="customize.cgi">Try the script</a>
+  <li><a href="customize.txt">Look at its source code</a>
+</ul>
+
+<h2> Popup the response in a new window</h2>
+<ul>
+  <li><a href="popup.cgi">Try the script</a>
+  <li><a href="popup.txt">Look at its source code</a>
+</ul>
+
+<h2> Side-by-side form and response using frames</h2>
+<ul>
+  <li><a href="frameset.cgi">Try the script</a>
+  <li><a href="frameset.txt">Look at its source code</a>
+</ul>
+
+<h2>Verify the Contents of a fill-out form with JavaScript</h2>
+<ul>
+  <li><a href="javascript.cgi">Try the script</a>
+  <li><a href="javascript.txt">Look at its source code</a>
+</ul>
+
+<HR>
+<MENU>
+  <LI> <A HREF="../cgi_docs.html">CGI.pm documentation</A>
+  <LI> <A HREF="../CGI.pm.tar.gz">Download the CGI.pm distribution</A>
+</MENU>
+<HR>
+<ADDRESS>Lincoln D. Stein, lstein@genome.wi.mit.edu<br>
+<a href="/">Whitehead Institute/MIT Center for Genome Research</a></ADDRESS>
+<!-- hhmts start -->
+Last modified: Mon Dec  2 06:23:25 EST 1996
+<!-- hhmts end -->
+</BODY> </HTML>