summaryrefslogtreecommitdiff
path: root/lib/CGI/eg
diff options
context:
space:
mode:
authorCharles Bailey <bailey@newman.upenn.edu>2000-10-20 04:44:37 +0000
committerbailey <bailey@newman.upenn.edu>2000-10-20 04:44:37 +0000
commit22d4bb9ccb8701e68f9243547d7e3a3c55f70908 (patch)
treed2e7714cc660a21e8bf2624c99646b0cb001e40c /lib/CGI/eg
parent4b19af017623bfa3bb72bb164598a517f586e0d3 (diff)
downloadperl-22d4bb9ccb8701e68f9243547d7e3a3c55f70908.tar.gz
SYN SYN
p4raw-id: //depot/vmsperl@7375
Diffstat (limited to 'lib/CGI/eg')
-rwxr-xr-xlib/CGI/eg/RunMeFirst36
-rw-r--r--lib/CGI/eg/caution.xbm12
-rw-r--r--lib/CGI/eg/clickable_image.cgi26
-rw-r--r--lib/CGI/eg/cookie.cgi88
-rw-r--r--lib/CGI/eg/crash.cgi6
-rw-r--r--lib/CGI/eg/customize.cgi92
-rw-r--r--lib/CGI/eg/diff_upload.cgi68
-rw-r--r--lib/CGI/eg/dna_small_gif.uu63
-rw-r--r--lib/CGI/eg/file_upload.cgi71
-rw-r--r--lib/CGI/eg/frameset.cgi81
-rw-r--r--lib/CGI/eg/index.html119
-rw-r--r--lib/CGI/eg/internal_links.cgi33
-rw-r--r--lib/CGI/eg/javascript.cgi105
-rwxr-xr-xlib/CGI/eg/make_links.pl8
-rw-r--r--lib/CGI/eg/monty.cgi84
-rw-r--r--lib/CGI/eg/multiple_forms.cgi54
-rw-r--r--lib/CGI/eg/nph-clock.cgi18
-rwxr-xr-xlib/CGI/eg/nph-multipart.cgi10
-rw-r--r--lib/CGI/eg/popup.cgi32
-rw-r--r--lib/CGI/eg/save_state.cgi67
-rw-r--r--lib/CGI/eg/tryit.cgi37
-rw-r--r--lib/CGI/eg/wilogo_gif.uu13
22 files changed, 1123 insertions, 0 deletions
diff --git a/lib/CGI/eg/RunMeFirst b/lib/CGI/eg/RunMeFirst
new file mode 100755
index 0000000000..018b11b718
--- /dev/null
+++ b/lib/CGI/eg/RunMeFirst
@@ -0,0 +1,36 @@
+#!/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 $uu (<*.uu>) {
+ unless (open UU, "<$uu") { warn "Can't open $uu: $!\n"; next }
+ while (<UU>) {
+ chomp;
+ if (/^begin\s+\d+\s+(.+)$/) {
+ $bin = $1;
+ last;
+ }
+ }
+ unless (open BIN, "> $bin") { warn "Can't create $bin: $!\n"; next }
+ binmode BIN;
+ 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/i;
+ symlink $_, $target unless -e $target;
+}
diff --git a/lib/CGI/eg/caution.xbm b/lib/CGI/eg/caution.xbm
new file mode 100644
index 0000000000..87fcdbef8a
--- /dev/null
+++ b/lib/CGI/eg/caution.xbm
@@ -0,0 +1,12 @@
+#define caution_width 32
+#define caution_height 32
+static char caution_bits[] = {
+ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0x00,0x00,0x00,0x10,0x01,
+ 0x00,0x00,0x08,0x07,0x00,0x00,0x08,0x0e,0x00,0x00,0x04,0x0e,0x00,0x00,0x04,
+ 0x1c,0x00,0x00,0x02,0x1c,0x00,0x00,0xe2,0x38,0x00,0x00,0xf1,0x39,0x00,0x00,
+ 0xf1,0x71,0x00,0x80,0xf0,0x71,0x00,0x80,0xf0,0xe1,0x00,0x40,0xf0,0xe1,0x00,
+ 0x40,0xf0,0xc1,0x01,0x20,0xf0,0xc1,0x01,0x20,0xf0,0x81,0x03,0x10,0xe0,0x80,
+ 0x03,0x10,0xe0,0x00,0x07,0x08,0xe0,0x00,0x07,0x08,0xe0,0x00,0x0e,0x04,0x00,
+ 0x00,0x0e,0x04,0xe0,0x00,0x1c,0x02,0xf0,0x01,0x1c,0x02,0xf0,0x01,0x38,0x01,
+ 0xe0,0x00,0x38,0x01,0x00,0x00,0x70,0x01,0x00,0x00,0x70,0xff,0xff,0xff,0x7f,
+ 0xf8,0xff,0xff,0x3f,0x00,0x00,0x00,0x00};
diff --git a/lib/CGI/eg/clickable_image.cgi b/lib/CGI/eg/clickable_image.cgi
new file mode 100644
index 0000000000..81daf09690
--- /dev/null
+++ b/lib/CGI/eg/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/lib/CGI/eg/cookie.cgi b/lib/CGI/eg/cookie.cgi
new file mode 100644
index 0000000000..98adda196e
--- /dev/null
+++ b/lib/CGI/eg/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/lib/CGI/eg/crash.cgi b/lib/CGI/eg/crash.cgi
new file mode 100644
index 0000000000..64f03c7b3d
--- /dev/null
+++ b/lib/CGI/eg/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/lib/CGI/eg/customize.cgi b/lib/CGI/eg/customize.cgi
new file mode 100644
index 0000000000..c1c8187514
--- /dev/null
+++ b/lib/CGI/eg/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/lib/CGI/eg/diff_upload.cgi b/lib/CGI/eg/diff_upload.cgi
new file mode 100644
index 0000000000..913f9ca179
--- /dev/null
+++ b/lib/CGI/eg/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/lib/CGI/eg/dna_small_gif.uu b/lib/CGI/eg/dna_small_gif.uu
new file mode 100644
index 0000000000..1745c73761
--- /dev/null
+++ b/lib/CGI/eg/dna_small_gif.uu
@@ -0,0 +1,63 @@
+begin 444 dna_small.gif
+M1TE&.#=A)0`J`.<``+9%&Y<R0M<F'ID\,!<07%<G1:P<0Q`A2Q`P;"L9/L$:
+M,"480N5"&RL7:4LD0T,G144[7BHL2B4?3\0I+"</)BQ.9KD0/S878\96$Z\@
+M(:\1*RL:3L0W&QL?2#4?9>@_&A$_5<I"&C`A3*,3-A`//9X<)\@Q(L`@.#\E
+M7K,R*R\T6)H++1L72T8=4207:T`G=JX..MD^&!$_;^)2$#T=7S`79AL7.A$3
+M1-=%#^,Q&QT_:C8=1!L86]\R#4M":4H76R,515HZ4"477G@T,J\;(X(@/$\7
+M."4A2N9;$"DZ6RL34-8I$34A73P86I84/\87%1`0/V,B2"0<0N!(%QPH91<6
+M2=!5$3(=73(E23`/,!L4.=$Z'-MH%>`Y#3$=2"=#59M((H88,GP\/]X^&+$R
+M$"(79"DF33(93"$86=%;&"T4/=Y"&\\A$Q4Z4!`62*T4-Q4B9+X1*BH96SP?
+M1<0D/3(F<-TM$!`=5:H.(!<64C$W?#8J3*`S(S<@3=8V%K$](QT.6Q`43AL4
+M1:$D,;<0,\X9&,8])\@=$A(U244S5U,D6Q<V;]\I&&<K/8!*.R044>=/#YH>
+M08$I1B,09S$35R(:4C0?<19$7<D^#Q`>5!()-;4702M`=;56)A`25,0K%"X<
+M83`N>K`H'HDS*1`40,M&%!<@7M,_$A<N2L)%%18E4^<M$A@=5=0Q$Q`E311*
+M2L8E&2D<7Q\A7P\80B48,%E/8[1-'J4/-"H<3"PA1$,T?Q<15R44,R,A4AL/
+M,^M4%2,07!L+,[\[&!P4520I:C(9.=54$[,2/M-)&RP?7M=(%1$J8<-,%2H@
+M4B,=51436^]2"!X<1A<44RD</>E+#%0>0S0/:4PJ9I,F-6DG420Y<"@09R,0
+M-V$R/R4M<:\H0!(H410Z:AT27&4Q9"L@;=1%(MA-$M5+#RL4+M8Z&AT<7[<:
+M(-QA&2,36R$++B(84!0:5ALO:K$A.]X?&!$84V@;/SX<6Q`;2$(B2QD21W4J
+M1=TW&@```````````````"P`````)0`J```(_@!]:(N'18\W%15T$1N'C)V?
+M0_HH,<$G9YBX!C6<3;+T@AZ-)K@\O*"!KP^$>"KVA`L3*8P3)^5ZA)@B:AH+
+M9];F7.$Q+!`!0=*<E3'5K(:EHS2N%"AP*Y(\&##H6(!A:!XU99B*H?%4IDF?
+M!8'<"-F%9I*TH8A83:*TXYD!J83D$0ICI-NE(:O8I6&FJ$64$M5$M%!3PU,F
+M2UJD"9I41E824WT2G?BV-!$(!`=,+<IF!P>.%",&P7J"9XB82L5,48F5K,:"
+M'94FU='6;!*R3T->E"%&95DR"`/6P,I0PDF)0SG8($$RJN0R`FI(H7$A2]VD
+M*^^L_6(T3U*V%XH"_AB:HDS8H$AO5@R:P,8.I%^.:*AC(>Z!'":6RC`1L@W-
+M%1Q/,%(.'5+1`<D^74R@P2#?T*'/$"%@\(L5Y?RAB!SO3#*,-6CL44\4]C1#
+MR0Q3C&&"!AH08@(#:Y2C@`&1---,.#)\T84=R##`0",H++8#)34,@X80R:"`
+M0A<]?'#.!";`TDH.8QBB0354A!,*)WI0\<D\YJRQ3PE[V",(.D#48$T9GO22
+MA0.BC,)'*]3TP,`^\_#QA0P@>`/"*]=<HX\3"C!BAQV%5",$+Z0,0X,UL3SB
+M#B[NN$'/,A&,$L,Y[-BASR(@<**("E^,0(<&;[QA0@^,3%",#2S8H,01_LX0
+M`(0:W%`@13#TN+'#&LK@0$T0VER##50*Q/%-%%&H$`0#K7"`!B^X/`),()F0
+M0PNT[K#BRBS1-!("`^=,$8`D="B`QRW?1**+-I?(X$@(L(R2AQ8+Y,*#-*YX
+MH(00'1Q!CSI,U'!%)^_%4(X&FUB@01$.@*!#$I?4D48I&1BA!2*HD%))(.+T
+MYTEOT3B#PB/U4(,$%QD0(<\QX^CRBC=)@%`!&+:<<TH&M*C1"RJX'-'.'`YX
+M<H0@<)#"0CX+I%`*-%:4L@XFS`#[11M?U-))"&RP84LWZL!A1A^YH.*)!)3<
+MHXX6L]P3"!I`H/!`*>90`PD.F'3SR@-AG)`&_A=3'"**#[J(P<<I@YCA2@32
+M!,*+Q9H`(XT2'O2RS"CGS.U9!K>0^C0&S/#1""(ZI)'&*6,,$842N%Q!@3NK
+M"R'%%4KP0D(Q?"`S!3)<I#!!".68$T(IMHP#>BVE(/$+)#-80<PTLBRP^@$>
+M<+,`-[QH$LP+0_P!1C>=S("!,N>8XP<8H6131!B;3`#&#)"DTH(L5#P0S#W+
+MQ)*`$K1HHD4^;E!2QP%:B``&4H$,/Y2C$Y*(1%0(00A)@```77B"*$0@#3>P
+MP&PU4`,^H!","P!!$')0P^H6((I5L"$'.;``';[Q!@-\PP"<B$<]EG"(#*C"
+M%-(@0":\L0U?D&`#_L50@33.(`4M4``=&4@'+-9!!P9JP`#9T$4H=*$+!#1B
+M'3A(`SYH`81'B.,(XJ@"":0(CDRPH@/<"$88V+"%$N#A&)MPX0N2H`L]C&,<
+MEW"$%6:0BCV@XPIH>$0?)M$`<92!%OG8Q3#@(`U2C*)%9-!`&`K`!!EP0@80
+M2,0M;I$.:"C#"D.@P#UJ``]GT"*,K%B&*0+!@TFH8VV*0$(:_/`)?7@#'.'0
+M@R[H8``\:&`,=NC"*"B@!2TTHP5]N((TEH&`<)B"!PU`0RQ(P8MNS``9K6@%
+M'W31AG%$(BZ2&((PA-&#'I"A&`F8!DD\\`H6-,.,X'B'%,+R#FX4`PS&_L!$
+M.4R0#7W<0@%O2,07$($#9@C3"%C8P!5H88\]J$,"-E!;(.X@C5T<`!65V,40
+M,'&(0C!"`1JP@"3TH`T9=&,5JRC$-]+1`U%TP@@[^,$>Z$&*0%1A%XFK`BFD
+MX0L6Y"(#A_A$#[JPC@%\@1@02`(SJ#&&.`A@'\&$!AALX(4Y="`/TA"",UA!
+M@%W<8!*\$`$@C%""+G1A"9AP!"<>9@ME*)$0F\C!$I8`B3\TP@%'@$(QH$`"
+M)8@#'(B0ACB`P`,@%&,'9"##)S`1!&)\`0)^&,,^+$`("QC"#D\X!":HX0!<
+ML(`&-O!%,&H@BS#F0AI'`!LO^"`,/OS!%KJ0_H0HEA`E27Q#%T%X0"%"@`1E
+M2,`!:F!%+Q#A!G)40A!HP`4OFK`#-13#`?I(QCW38(Q/9&``%0#!);01BE>$
+M@!TZNL81$G`!-]2!&&5@A1N&T0Q<,$$$%*!``BR1A5$PPPH<74$%]*`#$.RA
+M`(VP@#`X$(`7``(%T=@`.5Q`C@:0`P[)D$4'$H`."MB#"908Q=X@,01B9$(7
+MG'A%`#8!"QSL@PUAL,0==M"")CQCP4)0QQUDP806H&,!T]A!`EH@AC2P`P,^
+MT`,*NN%-&&T!&L@X!!Y^<(4.D(,%E>A`,T20C#IXL`6-:,`5F+"#!W"@'%OH
+MA`IJ$5(#;`(;AV/'FA103(EV+(,>GHB&&ZJ`!D'<X0[-N$(N@)$+4$C@`<(`
+M$(&/<8Q;7$,1UT"``+>P!57`X1F9D`4<W$`"4MP@$ZYX\B-"004Y2$`.HT@%
+M)@IAB#><0!]FB(<I.(&`(7P"%GPPQ3)F`0YB0"$0@8"")L!Q!RH`8A&AL,8L
+BR!$$,@@#&5OX!1V.\85XA.,.,A##!T2!AP@LXP#;"`@`.P``
+end
diff --git a/lib/CGI/eg/file_upload.cgi b/lib/CGI/eg/file_upload.cgi
new file mode 100644
index 0000000000..3037de7b14
--- /dev/null
+++ b/lib/CGI/eg/file_upload.cgi
@@ -0,0 +1,71 @@
+#!/usr/local/bin/perl -w
+
+use strict 'refs';
+use lib '..';
+use CGI qw(:standard);
+use CGI::Carp qw/fatalsToBrowser/;
+
+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 or greater, or IE 4.0 or greater."),
+ 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.';
+
+my @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 (my $file = param('filename')) {
+ my %stats;
+ my $tmpfile=tmpFileName($file);
+ my $mimetype = uploadInfo($file)->{'Content-Type'} || '';
+ print hr(),
+ h2($file),
+ h3($tmpfile),
+ h4("MIME Type:",em($mimetype));
+
+ 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 cite("URL parameters: "),url_param();
+
+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/lib/CGI/eg/frameset.cgi b/lib/CGI/eg/frameset.cgi
new file mode 100644
index 0000000000..fc86e92e9a
--- /dev/null
+++ b/lib/CGI/eg/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/lib/CGI/eg/index.html b/lib/CGI/eg/index.html
new file mode 100644
index 0000000000..133ecc4a16
--- /dev/null
+++ b/lib/CGI/eg/index.html
@@ -0,0 +1,119 @@
+<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> Server Push</H2>
+<ul>
+ <li><a href="nph-multipart.cgi">Try the script</a>
+ <li><a href="nph-multipart.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>
+<em>This script deliberately generates a compile-time error.</em>
+<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 Work with Netscape Navigator 2.0 and higher,
+or Internet Explorer 3.0 and higher</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 with a cookie</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: Wed Jun 23 15:31:47 EDT 1999
+<!-- hhmts end -->
+</BODY> </HTML>
diff --git a/lib/CGI/eg/internal_links.cgi b/lib/CGI/eg/internal_links.cgi
new file mode 100644
index 0000000000..4806966842
--- /dev/null
+++ b/lib/CGI/eg/internal_links.cgi
@@ -0,0 +1,33 @@
+#!/usr/local/bin/perl
+
+use CGI;
+$query = new CGI;
+
+# We generate a regular HTML file containing a very long list
+# and a popup menu that does nothing except to show that we
+# don't lose the state information.
+print $query->header;
+print $query->start_html("Internal Links Example");
+print "<H1>Internal Links Example</H1>\n";
+print "Click <cite>Submit Query</cite> to create a state. Then scroll down and",
+ " click on any of the <cite>Jump to top</cite> links. This is not very exciting.";
+
+print "<A NAME=\"start\"></A>\n"; # an anchor point at the top
+
+# pick a default starting value;
+$query->param('amenu','FOO1') unless $query->param('amenu');
+
+print $query->startform;
+print $query->popup_menu('amenu',[('FOO1'..'FOO9')]);
+print $query->submit,$query->endform;
+
+# We create a long boring list for the purposes of illustration.
+$myself = $query->self_url;
+print "<OL>\n";
+for (1..100) {
+ print qq{<LI>List item #$_ <A HREF="$myself#start">Jump to top</A>\n};
+}
+print "</OL>\n";
+
+print $query->end_html;
+
diff --git a/lib/CGI/eg/javascript.cgi b/lib/CGI/eg/javascript.cgi
new file mode 100644
index 0000000000..91c2b9e648
--- /dev/null
+++ b/lib/CGI/eg/javascript.cgi
@@ -0,0 +1,105 @@
+#!/usr/local/bin/perl
+
+# This script illustrates how to use JavaScript to validate fill-out
+# forms.
+use CGI qw(:standard);
+
+# Here's the javascript code that we include in the document.
+$JSCRIPT=<<EOF;
+ // validate that the user is the right age. Return
+ // false to prevent the form from being submitted.
+ function validateForm() {
+ var today = new Date();
+ var birthday = validateDate(document.form1.birthdate);
+ if (birthday == 0) {
+ document.form1.birthdate.focus()
+ document.form1.birthdate.select();
+ return false;
+ }
+ var milliseconds = today.getTime()-birthday;
+ var years = milliseconds/(1000 * 60 * 60 * 24 * 365.25);
+ if ((years > 20) || (years < 5)) {
+ alert("You must be between the ages of 5 and 20 to submit this form");
+ document.form1.birthdate.focus();
+ document.form1.birthdate.select();
+ return false;
+ }
+ // Since we've calculated the age in years already,
+ // we might as well send it up to our CGI script.
+ document.form1.age.value=Math.floor(years);
+ return true;
+ }
+
+ // make sure that the contents of the supplied
+ // field contain a valid date.
+ function validateDate(element) {
+ var date = Date.parse(element.value);
+ if (0 == date) {
+ alert("Please enter date in format MMM DD, YY");
+ element.focus();
+ element.select();
+ }
+ return date;
+ }
+
+ // Compliments, compliments
+ function doPraise(element) {
+ if (element.checked) {
+ self.status=element.value + " is an excellent choice!";
+ return true;
+ } else {
+ return false;
+ }
+ }
+
+ function checkColor(element) {
+ var color = element.options[element.selectedIndex].text;
+ if (color == "blonde") {
+ if (confirm("Is it true that blondes have more fun?"))
+ alert("Darn. That leaves me out.");
+ } else
+ alert(color + " is a fine choice!");
+ }
+EOF
+ ;
+
+# here's where the execution begins
+print header;
+print start_html(-title=>'Personal Profile',-script=>$JSCRIPT);
+
+print h1("Big Brother Wants to Know All About You"),
+ strong("Note: "),"This page uses JavaScript and requires ",
+ "Netscape 2.0 or higher to do anything special.";
+
+&print_prompt();
+print hr;
+&print_response() if param;
+print end_html;
+
+sub print_prompt {
+ print start_form(-name=>'form1',
+ -onSubmit=>"return validateForm()"),"\n";
+ print "Birthdate (e.g. Jan 3, 1972): ",
+ textfield(-name=>'birthdate',
+ -onBlur=>"validateDate(this)"),"<p>\n";
+ print "Sex: ",radio_group(-name=>'gender',
+ -value=>[qw/male female/],
+ -onClick=>"doPraise(this)"),"<p>\n";
+ print "Hair color: ",popup_menu(-name=>'color',
+ -value=>[qw/brunette blonde red gray/],
+ -default=>'red',
+ -onChange=>"checkColor(this)"),"<p>\n";
+ print hidden(-name=>'age',-value=>0);
+ print submit();
+ print end_form;
+}
+
+sub print_response {
+ import_names('Q');
+ print h2("Your profile"),
+ "You claim to be a ",b($Q::age)," year old ",b($Q::color,$Q::gender),".",
+ "You should be ashamed of yourself for lying so ",
+ "blatantly to big brother!",
+ hr;
+}
+
diff --git a/lib/CGI/eg/make_links.pl b/lib/CGI/eg/make_links.pl
new file mode 100755
index 0000000000..a0aa824556
--- /dev/null
+++ b/lib/CGI/eg/make_links.pl
@@ -0,0 +1,8 @@
+#!/usr/local/bin/perl
+
+# this is just a utility for creating symlinks from *.txt to *.cgi
+# for documentation purposes.
+foreach (<*.cgi>) {
+ ($target=$_)=~s/cgi$/txt/;
+ symlink $_,$target
+}
diff --git a/lib/CGI/eg/monty.cgi b/lib/CGI/eg/monty.cgi
new file mode 100644
index 0000000000..693c2586fc
--- /dev/null
+++ b/lib/CGI/eg/monty.cgi
@@ -0,0 +1,84 @@
+#!/usr/local/bin/perl
+
+use CGI;
+use CGI::Carp qw/fatalsToBrowser/;
+
+$query = new CGI;
+
+print $query->header;
+print $query->start_html("Example CGI.pm Form");
+print "<H1> Example CGI.pm Form</H1>\n";
+&print_prompt($query);
+&do_work($query);
+&print_tail;
+print $query->end_html;
+
+sub print_prompt {
+ my($query) = @_;
+
+ print $query->start_form;
+ print "<EM>What's your name?</EM><BR>";
+ print $query->textfield('name');
+ print $query->checkbox('Not my real name');
+
+ print "<P><EM>Where can you find English Sparrows?</EM><BR>";
+ print $query->checkbox_group(
+ -name=>'Sparrow locations',
+ -Values=>[England,France,Spain,Asia,Hoboken],
+ -linebreak=>'yes',
+ -defaults=>[England,Asia]);
+
+ print "<P><EM>How far can they fly?</EM><BR>",
+ $query->radio_group(
+ -name=>'how far',
+ -Values=>['10 ft','1 mile','10 miles','real far'],
+ -default=>'1 mile');
+
+ print "<P><EM>What's your favorite color?</EM> ";
+ print $query->popup_menu(-name=>'Color',
+ -Values=>['black','brown','red','yellow'],
+ -default=>'red');
+
+ print $query->hidden('Reference','Monty Python and the Holy Grail');
+
+ print "<P><EM>What have you got there?</EM><BR>";
+ print $query->scrolling_list(
+ -name=>'possessions',
+ -Values=>['A Coconut','A Grail','An Icon',
+ 'A Sword','A Ticket'],
+ -size=>5,
+ -multiple=>'true');
+
+ print "<P><EM>Any parting comments?</EM><BR>";
+ print $query->textarea(-name=>'Comments',
+ -rows=>10,
+ -columns=>50);
+
+ print "<P>",$query->reset;
+ print $query->submit('Action','Shout');
+ print $query->submit('Action','Scream');
+ print $query->endform;
+ print "<HR>\n";
+ }
+
+sub do_work {
+ my($query) = @_;
+ my(@values,$key);
+
+ print "<H2>Here are the current settings in this form</H2>";
+
+ foreach $key ($query->param) {
+ print "<STRONG>$key</STRONG> -> ";
+ @values = $query->param($key);
+ print join(", ",@values),"<BR>\n";
+ }
+}
+
+sub print_tail {
+ print <<END;
+<HR>
+<ADDRESS>Lincoln D. Stein</ADDRESS><BR>
+<A HREF="/">Home Page</A>
+END
+ ;
+}
diff --git a/lib/CGI/eg/multiple_forms.cgi b/lib/CGI/eg/multiple_forms.cgi
new file mode 100644
index 0000000000..b38bf93e96
--- /dev/null
+++ b/lib/CGI/eg/multiple_forms.cgi
@@ -0,0 +1,54 @@
+#!/usr/local/bin/perl
+
+use CGI;
+
+$query = new CGI;
+print $query->header;
+print $query->start_html('Multiple Forms');
+print "<H1>Multiple Forms</H1>\n";
+
+# Print the first form
+print $query->startform;
+$name = $query->remote_user || 'anonymous@' . $query->remote_host;
+
+print "What's your name? ",$query->textfield('name',$name,50);
+print "<P>What's the combination?<P>",
+ $query->checkbox_group('words',['eenie','meenie','minie','moe']);
+print "<P>What's your favorite color? ",
+ $query->popup_menu('color',['red','green','blue','chartreuse']),
+ "<P>";
+print $query->submit('form_1','Send Form 1');
+print $query->endform;
+
+# Print the second form
+print "<HR>\n";
+print $query->startform;
+print "Some radio buttons: ",$query->radio_group('radio buttons',
+ [qw{one two three four five}],'three'),"\n";
+print "<P>What's the password? ",$query->password_field('pass','secret');
+print $query->defaults,$query->submit('form_2','Send Form 2'),"\n";
+print $query->endform;
+
+print "<HR>\n";
+
+$query->import_names('Q');
+if ($Q::form_1) {
+ print "<H2>Form 1 Submitted</H2>\n";
+ print "Your name is <EM>$Q::name</EM>\n";
+ print "<P>The combination is: <EM>{",join(",",@Q::words),"}</EM>\n";
+ print "<P>Your favorite color is <EM>$Q::color</EM>\n";
+} elsif ($Q::form_2) {
+ print <<EOF;
+<H2>Form 2 Submitted</H2>
+<P>The value of the radio buttons is <EM>$Q::radio_buttons</EM>
+<P>The secret password is <EM>$Q::pass</EM>
+EOF
+ ;
+}
+print qq{<P><A HREF="./">Other examples</A>};
+print qq{<P><A HREF="../cgi_docs.html">Go to the documentation</A>};
+
+print $query->end_html;
+
+
+
diff --git a/lib/CGI/eg/nph-clock.cgi b/lib/CGI/eg/nph-clock.cgi
new file mode 100644
index 0000000000..55a2fbe545
--- /dev/null
+++ b/lib/CGI/eg/nph-clock.cgi
@@ -0,0 +1,18 @@
+#!/usr/local/bin/perl -w
+
+use CGI::Push qw(:standard :html3);
+
+do_push(-next_page=>\&draw_time,-delay=>1);
+
+sub draw_time {
+ my $time = `/bin/date`;
+ return start_html('Tick Tock'),
+ div({-align=>CENTER},
+ h1('Virtual Clock'),
+ h2($time)
+ ),
+ hr,
+ a({-href=>'index.html'},'More examples'),
+ end_html();
+}
+
diff --git a/lib/CGI/eg/nph-multipart.cgi b/lib/CGI/eg/nph-multipart.cgi
new file mode 100755
index 0000000000..f8cea59a87
--- /dev/null
+++ b/lib/CGI/eg/nph-multipart.cgi
@@ -0,0 +1,10 @@
+#!/usr/local/bin/perl
+use CGI qw/:push -nph/;
+$| = 1;
+print multipart_init(-boundary=>'----------------here we go!');
+while (1) {
+ print multipart_start(-type=>'text/plain'),
+ "The current time is ",scalar(localtime),"\n",
+ multipart_end;
+ sleep 1;
+}
diff --git a/lib/CGI/eg/popup.cgi b/lib/CGI/eg/popup.cgi
new file mode 100644
index 0000000000..88cea1da9c
--- /dev/null
+++ b/lib/CGI/eg/popup.cgi
@@ -0,0 +1,32 @@
+#!/usr/local/bin/perl
+
+use CGI;
+$query = new CGI;
+print $query->header;
+print $query->start_html('Popup Window');
+
+
+if (!$query->param) {
+ print "<H1>Ask your Question</H1>\n";
+ print $query->startform(-target=>'_new');
+ 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'],
+ -defaults=>['eenie','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;
+
+} else {
+ print "<H1>And the Answer is...</H1>\n";
+ 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";
+}
+print qq{<P><A HREF="cgi_docs.html">Go to the documentation</A>};
+print $query->end_html;
diff --git a/lib/CGI/eg/save_state.cgi b/lib/CGI/eg/save_state.cgi
new file mode 100644
index 0000000000..85bacaf59a
--- /dev/null
+++ b/lib/CGI/eg/save_state.cgi
@@ -0,0 +1,67 @@
+#!/usr/local/bin/perl
+
+use CGI;
+$query = new CGI;
+
+print $query->header;
+print $query->start_html("Save and Restore Example");
+print "<H1>Save and Restore Example</H1>\n";
+
+# Here's where we take action on the previous request
+&save_parameters($query) if $query->param('action') eq 'SAVE';
+$query = &restore_parameters($query) if $query->param('action') eq 'RESTORE';
+
+# Here's where we create the form
+print $query->start_multipart_form;
+print "Popup 1: ",$query->popup_menu('popup1',[qw{red green purple magenta orange chartreuse brown}]),"\n";
+print "Popup 2: ",$query->popup_menu('popup2',[qw{lion tiger bear zebra potto wildebeest frog emu gazelle}]),"\n";
+print "<P>";
+$default_name = $query->remote_addr . '.sav';
+print "Save/restore state from file: ",$query->textfield('savefile',$default_name),"\n";
+print "<P>";
+print $query->submit('action','SAVE'),$query->submit('action','RESTORE');
+print "<P>",$query->defaults;
+print $query->endform;
+
+# Here we print out a bit at the end
+print $query->end_html;
+
+sub save_parameters {
+ local($query) = @_;
+ local($filename) = &clean_name($query->param('savefile'));
+ if (open(FILE,">$filename")) {
+ $query->save(FILE);
+ close FILE;
+ print "<STRONG>State has been saved to file $filename</STRONG>\n";
+ print "<P>If you remember this name you can restore the state later.\n";
+ } else {
+ print "<STRONG>Error:</STRONG> couldn't write to file $filename: $!\n";
+ }
+}
+
+sub restore_parameters {
+ local($query) = @_;
+ local($filename) = &clean_name($query->param('savefile'));
+ if (open(FILE,$filename)) {
+ $query = new CGI(FILE); # Throw out the old query, replace it with a new one
+ close FILE;
+ print "<STRONG>State has been restored from file $filename</STRONG>\n";
+ } else {
+ print "<STRONG>Error:</STRONG> couldn't restore file $filename: $!\n";
+ }
+ return $query;
+}
+
+
+# Very important subroutine -- get rid of all the naughty
+# metacharacters from the file name. If there are, we
+# complain bitterly and die.
+sub clean_name {
+ local($name) = @_;
+ unless ($name=~/^[\w\._\-]+$/) {
+ print "<STRONG>$name has naughty characters. Only ";
+ print "alphanumerics are allowed. You can't use absolute names.</STRONG>";
+ die "Attempt to use naughty characters";
+ }
+ return "WORLD_WRITABLE/$name";
+}
diff --git a/lib/CGI/eg/tryit.cgi b/lib/CGI/eg/tryit.cgi
new file mode 100644
index 0000000000..83c620c3e4
--- /dev/null
+++ b/lib/CGI/eg/tryit.cgi
@@ -0,0 +1,37 @@
+#!/usr/local/bin/perl
+
+use CGI ':standard';
+
+print header;
+print start_html('A Simple Example'),
+ h1('A Simple Example'),
+ start_form,
+ "What's your name? ",textfield('name'),
+ p,
+ "What's the combination?",
+ p,
+ checkbox_group(-name=>'words',
+ -values=>['eenie','meenie','minie','moe'],
+ -defaults=>['eenie','minie']),
+ p,
+ "What's your favorite color? ",
+ popup_menu(-name=>'color',
+ -values=>['red','green','blue','chartreuse']),
+ p,
+ submit,
+ end_form,
+ hr;
+
+if (param()) {
+ print
+ "Your name is: ",em(param('name')),
+ p,
+ "The keywords are: ",em(join(", ",param('words'))),
+ p,
+ "Your favorite color is: ",em(param('color')),
+ hr;
+}
+print a({href=>'../cgi_docs.html'},'Go to the documentation');
+print end_html;
+
+
diff --git a/lib/CGI/eg/wilogo_gif.uu b/lib/CGI/eg/wilogo_gif.uu
new file mode 100644
index 0000000000..c5d10423b4
--- /dev/null
+++ b/lib/CGI/eg/wilogo_gif.uu
@@ -0,0 +1,13 @@
+begin 444 wilogo.gif
+M1TE&.#=A7@!$`(```'X2F?___RP`````7@!$```"_D2.J<#MKF)ZU,A3,[OO
+M(IUY']A%9"6AW$F)+#2]Y:BNLF6_\;WMH<?#I72^VP+D"@*)F&"O25KRDM&B
+M[%C-7;4_J)*6'4ZE&O`W8"1OQ5UGPWRBIKDPM!MW9J]-[;LUKL;$5W.'YQ3(
+M(O<&-^>F*(A55\BX%UEI^;<VB0BH1RFX2=<IELE4^*0'N?-I>OJ8N%(*Z^4G
+M.OJJ>8HZ.(>;JRMD><E[!KQHB^3;:APL6Z8\RKPK/)O:*-WLW&7]*\UYR]J)
+M?<P=1MR-_6VN76,WGAV^32W^3CZ_SCY3;W__C-R^CU^\%M#T!9PVL(ZZ&>X"
+M%A1XSM]!A?T8/C0T$1XMJG\B&G+,"-&C/(VS0(842;`)M'S>_OE8F#"=2S#*
+M8LHLAS'D1Y,42UGY9O,F-T:X@@JEE@D1RW>/D@8R.DZ-+*E0CQ:9JJ5JU!SQ
+MR&BU2D.;E*4'ER0TNY%G2A/Y.G[=VG%81+5K_UG$21<A6;=YP9'5B++O7:@7
+M\]J5]]?DX7:)%<]5%=B/55>-GQW55;$8L\RW6J8-9>QM7<^A/SMZK!ESY$,+
+(KPA.EJ```#L`
+end