summaryrefslogtreecommitdiff
path: root/eg
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1998-06-28 16:33:32 +0000
committerGurusamy Sarathy <gsar@cpan.org>1998-06-28 16:33:32 +0000
commit424ec8fa43885c75adde62690957af43a6537c02 (patch)
tree685eac1f913fd302e7c746463a4a052196bc06f4 /eg
parenteab60bb1f2e96e200fbded3694574d80930d568e (diff)
downloadperl-424ec8fa43885c75adde62690957af43a6537c02.tar.gz
add CGI-2.42, its and testsuite
p4raw-id: //depot/perl@1223
Diffstat (limited to 'eg')
-rwxr-xr-xeg/cgi/RunMeFirst15
-rw-r--r--eg/cgi/caution.xbm12
-rw-r--r--eg/cgi/dna.small.gif.uu63
-rw-r--r--eg/cgi/file_upload.cgi12
-rw-r--r--eg/cgi/index.html13
-rw-r--r--eg/cgi/monty.cgi11
-rwxr-xr-xeg/cgi/nph-multipart.cgi10
-rw-r--r--eg/cgi/save_state.cgi2
-rw-r--r--eg/cgi/wilogo.gif.uu3
9 files changed, 123 insertions, 18 deletions
diff --git a/eg/cgi/RunMeFirst b/eg/cgi/RunMeFirst
index c96d79eb62..018b11b718 100755
--- a/eg/cgi/RunMeFirst
+++ b/eg/cgi/RunMeFirst
@@ -9,10 +9,17 @@ unless (-w $ww) {
}
# Decode the sample image.
-for $bin (qw(wilogo.gif)) {
- unless (open UU, "$bin.uu") { warn "Can't open $bin.uu: $!\n"; next }
+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 }
- $_ = <UU>;
+ binmode BIN;
while (<UU>) {
chomp;
last if /^end/;
@@ -24,6 +31,6 @@ for $bin (qw(wilogo.gif)) {
# Create symlinks from *.txt to *.cgi for documentation purposes.
foreach (<*.cgi>) {
- ($target = $_) =~ s/cgi$/txt/;
+ ($target = $_) =~ s/cgi$/txt/i;
symlink $_, $target unless -e $target;
}
diff --git a/eg/cgi/caution.xbm b/eg/cgi/caution.xbm
new file mode 100644
index 0000000000..87fcdbef8a
--- /dev/null
+++ b/eg/cgi/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/eg/cgi/dna.small.gif.uu b/eg/cgi/dna.small.gif.uu
new file mode 100644
index 0000000000..d3ce24c18d
--- /dev/null
+++ b/eg/cgi/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/eg/cgi/file_upload.cgi b/eg/cgi/file_upload.cgi
index 1f9eaec332..f6bbbe0b74 100644
--- a/eg/cgi/file_upload.cgi
+++ b/eg/cgi/file_upload.cgi
@@ -1,7 +1,8 @@
-#!/usr/local/bin/perl
+#!/usr/local/bin/perl -w
+use lib '..';
use CGI qw(:standard);
-use CGI::Carp;
+use CGI::Carp qw/fatalsToBrowser/;
print header();
print start_html("File Upload Example");
@@ -32,9 +33,12 @@ print start_multipart_form(),
# Process the form if there is a file name entered
if ($file = param('filename')) {
$tmpfile=tmpFileName($file);
+ $mimetype = uploadInfo($file)->{'Content-Type'} || '';
print hr(),
h2($file),
- h3($tmpfile);
+ h3($tmpfile),
+ h4("MIME Type:",em($mimetype));
+
my($lines,$words,$characters,@words) = (0,0,0,0);
while (<$file>) {
$lines++;
@@ -52,6 +56,8 @@ if ($file = param('filename')) {
}
}
+# print cite("URL parameters: "),url_param();
+
print hr(),
a({href=>"../cgi_docs.html"},"CGI documentation"),
hr,
diff --git a/eg/cgi/index.html b/eg/cgi/index.html
index 9eafd5f108..75e2d30139 100644
--- a/eg/cgi/index.html
+++ b/eg/cgi/index.html
@@ -23,6 +23,12 @@
<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>
@@ -42,6 +48,7 @@
</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>
@@ -73,7 +80,7 @@
<li><a href="cookie.txt">Look at its source code</a>
</ul>
-<h2>Permanently customize the appearance of a page</h2>
+<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>
@@ -100,12 +107,12 @@
<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>
+ <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
+Last modified: Tue May 19 22:16:43 EDT 1998
<!-- hhmts end -->
</BODY> </HTML>
diff --git a/eg/cgi/monty.cgi b/eg/cgi/monty.cgi
index b7c0f6a8f6..693c2586fc 100644
--- a/eg/cgi/monty.cgi
+++ b/eg/cgi/monty.cgi
@@ -1,6 +1,7 @@
#!/usr/local/bin/perl
use CGI;
+use CGI::Carp qw/fatalsToBrowser/;
$query = new CGI;
@@ -15,7 +16,7 @@ print $query->end_html;
sub print_prompt {
my($query) = @_;
- print $query->start_multipart_form;
+ print $query->start_form;
print "<EM>What's your name?</EM><BR>";
print $query->textfield('name');
print $query->checkbox('Not my real name');
@@ -23,19 +24,19 @@ sub print_prompt {
print "<P><EM>Where can you find English Sparrows?</EM><BR>";
print $query->checkbox_group(
-name=>'Sparrow locations',
- -values=>[England,France,Spain,Asia,Hoboken],
+ -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'],
+ -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'],
+ -Values=>['black','brown','red','yellow'],
-default=>'red');
print $query->hidden('Reference','Monty Python and the Holy Grail');
@@ -43,7 +44,7 @@ sub print_prompt {
print "<P><EM>What have you got there?</EM><BR>";
print $query->scrolling_list(
-name=>'possessions',
- -values=>['A Coconut','A Grail','An Icon',
+ -Values=>['A Coconut','A Grail','An Icon',
'A Sword','A Ticket'],
-size=>5,
-multiple=>'true');
diff --git a/eg/cgi/nph-multipart.cgi b/eg/cgi/nph-multipart.cgi
new file mode 100755
index 0000000000..f8cea59a87
--- /dev/null
+++ b/eg/cgi/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/eg/cgi/save_state.cgi b/eg/cgi/save_state.cgi
index be79051bd6..85bacaf59a 100644
--- a/eg/cgi/save_state.cgi
+++ b/eg/cgi/save_state.cgi
@@ -12,7 +12,7 @@ print "<H1>Save and Restore Example</H1>\n";
$query = &restore_parameters($query) if $query->param('action') eq 'RESTORE';
# Here's where we create the form
-print $query->startform;
+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>";
diff --git a/eg/cgi/wilogo.gif.uu b/eg/cgi/wilogo.gif.uu
index a183bc02d5..c5d10423b4 100644
--- a/eg/cgi/wilogo.gif.uu
+++ b/eg/cgi/wilogo.gif.uu
@@ -1,4 +1,4 @@
-begin 644 wilogo.gif
+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(
@@ -10,5 +10,4 @@ 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