diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 1998-06-28 16:33:32 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 1998-06-28 16:33:32 +0000 |
commit | 424ec8fa43885c75adde62690957af43a6537c02 (patch) | |
tree | 685eac1f913fd302e7c746463a4a052196bc06f4 /eg | |
parent | eab60bb1f2e96e200fbded3694574d80930d568e (diff) | |
download | perl-424ec8fa43885c75adde62690957af43a6537c02.tar.gz |
add CGI-2.42, its and testsuite
p4raw-id: //depot/perl@1223
Diffstat (limited to 'eg')
-rwxr-xr-x | eg/cgi/RunMeFirst | 15 | ||||
-rw-r--r-- | eg/cgi/caution.xbm | 12 | ||||
-rw-r--r-- | eg/cgi/dna.small.gif.uu | 63 | ||||
-rw-r--r-- | eg/cgi/file_upload.cgi | 12 | ||||
-rw-r--r-- | eg/cgi/index.html | 13 | ||||
-rw-r--r-- | eg/cgi/monty.cgi | 11 | ||||
-rwxr-xr-x | eg/cgi/nph-multipart.cgi | 10 | ||||
-rw-r--r-- | eg/cgi/save_state.cgi | 2 | ||||
-rw-r--r-- | eg/cgi/wilogo.gif.uu | 3 |
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 |