Change 33801 by [EMAIL PROTECTED] on 2008/05/10 13:34:11
Integrate:
[ 33592]
Additional CGI.pm test files that got missed at some point.
[ 33643]
Pack lib/CGI/t/upload_post_text.txt with uupacktool.pl. (It contains a
GIF, which clearly isn't text)
Affected files ...
... //depot/maint-5.10/perl/MANIFEST#20 integrate
... //depot/maint-5.10/perl/lib/CGI/t/upload.t#1 branch
... //depot/maint-5.10/perl/lib/CGI/t/uploadInfo.t#1 branch
... //depot/maint-5.10/perl/lib/CGI/t/upload_post_text.txt.packed#1 branch
Differences ...
==== //depot/maint-5.10/perl/MANIFEST#20 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#19~33785~ 2008-05-04 05:46:52.000000000 -0700
+++ perl/MANIFEST 2008-05-10 06:34:11.000000000 -0700
@@ -1563,6 +1563,9 @@
lib/CGI/t/start_end_end.t See if CGI.pm works
lib/CGI/t/start_end_start.t See if CGI.pm works
lib/CGI/t/switch.t See if CGI::Switch still loads
+lib/CGI/t/uploadInfo.t See if CGI.pm works
+lib/CGI/t/upload.t See if CGI.pm works
+lib/CGI/t/upload_post_text.txt.packed Test data for CGI.pm
lib/CGI/t/util-58.t See if 5.8-dependent features work
lib/CGI/t/util.t See if CGI.pm works
lib/CGI/Util.pm Utility functions
==== //depot/maint-5.10/perl/lib/CGI/t/upload.t#1 (text) ====
Index: perl/lib/CGI/t/upload.t
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/CGI/t/upload.t 2008-05-10 06:34:11.000000000 -0700
@@ -0,0 +1,147 @@
+#!/usr/local/bin/perl -w
+
+#################################################################
+# Emanuele Zeppieri, Mark Stosberg #
+# Shamelessly stolen from Data::FormValidator and CGI::Upload #
+#################################################################
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+
+my $test_file;
+if($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = '../lib';
+ use File::Spec ();
+ $test_file = File::Spec->catfile(qw(.. lib CGI t), "upload_post_text.txt");
+} else {
+ use lib qw(. ./blib/lib ./blib/arch);
+ $test_file = "t/upload_post_text.txt";
+}
+
+use strict;
+
+use Test::More 'no_plan';
+
+use CGI;
+
+#-----------------------------------------------------------------------------
+# %ENV setup.
+#-----------------------------------------------------------------------------
+
+%ENV = (
+ %ENV,
+ 'SCRIPT_NAME' => '/test.cgi',
+ 'SERVER_NAME' => 'perl.org',
+ 'HTTP_CONNECTION' => 'TE, close',
+ 'REQUEST_METHOD' => 'POST',
+ 'SCRIPT_URI' => 'http://www.perl.org/test.cgi',
+ 'CONTENT_LENGTH' => 3285,
+ 'SCRIPT_FILENAME' => '/home/usr/test.cgi',
+ 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
+ 'HTTP_TE' => 'deflate,gzip;q=0.3',
+ 'QUERY_STRING' => '',
+ 'REMOTE_PORT' => '1855',
+ 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)',
+ 'SERVER_PORT' => '80',
+ 'REMOTE_ADDR' => '127.0.0.1',
+ 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
+ 'SERVER_PROTOCOL' => 'HTTP/1.1',
+ 'PATH' => '/usr/local/bin:/usr/bin:/bin',
+ 'REQUEST_URI' => '/test.cgi',
+ 'GATEWAY_INTERFACE' => 'CGI/1.1',
+ 'SCRIPT_URL' => '/test.cgi',
+ 'SERVER_ADDR' => '127.0.0.1',
+ 'DOCUMENT_ROOT' => '/home/develop',
+ 'HTTP_HOST' => 'www.perl.org'
+);
+
+#-----------------------------------------------------------------------------
+# Simulate the upload (really, multiple uploads contained in a single stream).
+#-----------------------------------------------------------------------------
+
+my $q;
+
+{
+ local *STDIN;
+ open STDIN, "< $test_file"
+ or die 'missing test file t/upload_post_text.txt';
+ binmode STDIN;
+ $q = CGI->new;
+}
+
+#-----------------------------------------------------------------------------
+# Check that the file names retrieved by CGI are correct.
+#-----------------------------------------------------------------------------
+
+is( $q->param('does_not_exist_gif'), 'does_not_exist.gif', 'filename_2' );
+is( $q->param('100;100_gif') , '100;100.gif' , 'filename_3' );
+is( $q->param('300x300_gif') , '300x300.gif' , 'filename_4' );
+
+{
+ my $test = "multiple file names are handled right with same-named upload
fields";
+ my @hello_names = $q->param('hello_world');
+ is_deeply([EMAIL PROTECTED], [ 'goodbye_world.txt','hello_world.txt' ],
$test);
+}
+
+#-----------------------------------------------------------------------------
+# Now check that the upload method works.
+#-----------------------------------------------------------------------------
+
+ok( defined $q->upload('does_not_exist_gif'), 'upload_basic_2' );
+ok( defined $q->upload('100;100_gif') , 'upload_basic_3' );
+ok( defined $q->upload('300x300_gif') , 'upload_basic_4' );
+
+{
+ my $test = "file handles have expected length for multi-valued field. ";
+ my ($goodbye_fh,$hello_fh) = $q->upload('hello_world');
+
+ # Go to end of file;
+ seek($goodbye_fh,0,2);
+ # How long is the file?
+ is(tell($goodbye_fh), 15, "$test..first file");
+
+ # Go to end of file;
+ seek($hello_fh,0,2);
+ # How long is the file?
+ is(tell($hello_fh), 13, "$test..second file");
+
+}
+
+
+
+{
+ my $test = "300x300_gif has expected length";
+ my $fh1 = $q->upload('300x300_gif');
+ is(tell($fh1), 0, "First object: filehandle starts with position set at
zero");
+
+ # Go to end of file;
+ seek($fh1,0,2);
+ # How long is the file?
+ is(tell($fh1), 1656, $test);
+}
+
+my $q2 = CGI->new;
+
+{
+ my $test = "Upload filehandles still work after calling CGI->new a second
time";
+ $q->param('new','zoo');
+
+ is($q2->param('new'),undef,
+ "Reality Check: params set in one object instance don't appear in
another instance");
+
+ my $fh2 = $q2->upload('300x300_gif');
+ is(tell($fh2), 0, "...so the state of a file handle shouldn't be
carried to a new object instance, either.");
+ # Go to end of file;
+ seek($fh2,0,2);
+ # How long is the file?
+ is(tell($fh2), 1656, $test);
+}
+
+{
+ my $test = "multi-valued uploads are reset properly";
+ my ($dont_care, $hello_fh2) = $q2->upload('hello_world');
+ is(tell($hello_fh2), 0, $test);
+}
+
+# vim: nospell
==== //depot/maint-5.10/perl/lib/CGI/t/uploadInfo.t#1 (text) ====
Index: perl/lib/CGI/t/uploadInfo.t
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/CGI/t/uploadInfo.t 2008-05-10 06:34:11.000000000 -0700
@@ -0,0 +1,86 @@
+#!/usr/local/bin/perl -w
+
+#################################################################
+# Emanuele Zeppieri, Mark Stosberg #
+# Shamelessly stolen from Data::FormValidator and CGI::Upload #
+#################################################################
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+
+my $test_file;
+if($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = '../lib';
+ use File::Spec ();
+ $test_file = File::Spec->catfile(qw(.. lib CGI t), "upload_post_text.txt");
+} else {
+ use lib qw(. ./blib/lib ./blib/arch);
+ $test_file = "t/upload_post_text.txt";
+}
+
+use strict;
+
+use Test::More 'no_plan';
+
+use CGI;
+
+#-----------------------------------------------------------------------------
+# %ENV setup.
+#-----------------------------------------------------------------------------
+
+%ENV = (
+ %ENV,
+ 'SCRIPT_NAME' => '/test.cgi',
+ 'SERVER_NAME' => 'perl.org',
+ 'HTTP_CONNECTION' => 'TE, close',
+ 'REQUEST_METHOD' => 'POST',
+ 'SCRIPT_URI' => 'http://www.perl.org/test.cgi',
+ 'CONTENT_LENGTH' => 3285,
+ 'SCRIPT_FILENAME' => '/home/usr/test.cgi',
+ 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
+ 'HTTP_TE' => 'deflate,gzip;q=0.3',
+ 'QUERY_STRING' => '',
+ 'REMOTE_PORT' => '1855',
+ 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)',
+ 'SERVER_PORT' => '80',
+ 'REMOTE_ADDR' => '127.0.0.1',
+ 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
+ 'SERVER_PROTOCOL' => 'HTTP/1.1',
+ 'PATH' => '/usr/local/bin:/usr/bin:/bin',
+ 'REQUEST_URI' => '/test.cgi',
+ 'GATEWAY_INTERFACE' => 'CGI/1.1',
+ 'SCRIPT_URL' => '/test.cgi',
+ 'SERVER_ADDR' => '127.0.0.1',
+ 'DOCUMENT_ROOT' => '/home/develop',
+ 'HTTP_HOST' => 'www.perl.org'
+);
+
+#-----------------------------------------------------------------------------
+# Simulate the upload (really, multiple uploads contained in a single stream).
+#-----------------------------------------------------------------------------
+
+my $q;
+
+{
+ local *STDIN;
+ open STDIN, "< $test_file"
+ or die 'missing test file t/upload_post_text.txt';
+ binmode STDIN;
+ $q = CGI->new;
+}
+
+{
+ my $test = "uploadInfo: basic test";
+ my $fh = $q->upload('300x300_gif');
+ is( $q->uploadInfo($fh)->{'Content-Type'}, "image/gif", $test);
+}
+
+my $q2 = CGI->new;
+
+{
+ my $test = "uploadInfo: works with second object instance";
+ my $fh = $q2->upload('300x300_gif');
+ is( $q2->uploadInfo($fh)->{'Content-Type'}, "image/gif", $test);
+}
+
==== //depot/maint-5.10/perl/lib/CGI/t/upload_post_text.txt.packed#1 (text) ====
Index: perl/lib/CGI/t/upload_post_text.txt.packed
--- /dev/null 2008-05-07 15:08:24.549929899 -0700
+++ perl/lib/CGI/t/upload_post_text.txt.packed 2008-05-10 06:34:11.000000000
-0700
@@ -0,0 +1,89 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u lib/CGI/t/upload_post_text.txt.packed
lib/CGI/t/upload_post_text.txt
+
+To recreate it use the following command:
+
+ uupacktool.pl -p lib/CGI/t/upload_post_text.txt
lib/CGI/t/upload_post_text.txt.packed
+
+Created at Thu Apr 3 17:55:51 2008
+#########################################################################
+__UU__
+M+2UX67I:60T*0V]N=&5N="U$:7-P;W-I=&EO;[EMAIL PROTECTED];2UD871A.R!N86UE
+M/2)H96QL;U]W;W)L9"([(&9I;&5N86UE/2)G;V]D8GEE7W=O<FQD+G1X="(-
+M"D-O;G1E;G0M3&5N9W1H.B`Q,PT*0V]N=&5N="U4>7!E.B!T97AT+W!L86EN
+M#0H-"D=O;V1B>[EMAIL PROTECTED];&0A"@T*+2UX67I:60T*0V]N=&5N="U$:7-P;W-I
+M=&EO;[EMAIL PROTECTED];2UD871A.R!N86UE/2)H96QL;U]W;W)L9"([(&9I;&5N86UE
+M/2)H96QL;U]W;W)L9"YT>'0B#0I#;VYT96YT+4QE;F=T:#H@,3,-"D-O;G1E
+M;G0M5'[EMAIL PROTECTED]&5X="]P;&%I;@T*#0I(96QL;R!7;W)L9"$*#0HM+7A9>EI9
+M#0I#;VYT96YT+41I<W!O<VET:6]N.B!F;W)M+61A=&$[(&YA;64](F1O97-?
+M;F]T7V5X:7-T7V=I9B([(&9I;&5N86UE/2)D;V5S7VYO=%]E>&ES="YG:68B
+M#0I#;VYT96YT+51Y<&4Z(&%P<&QI8V%T:6]N+V]C=&5T+7-T<F5A;0T*#0H-
+M"BTM>%EZ6ED-"D-O;G1E;G0M1&ES<&]S:71I;VXZ(&9O<FTM9&%T83L@;F%M
+M93TB,3`P.S$P,%]G:68B.R!F:6QE;F%M93TB,3`P.S$P,"YG:68B#0I#;VYT
+M96YT+4QE;F=T:[EMAIL PROTECTED];VYT96YT+51Y<&4Z(&[EMAIL PROTECTED]'
+M248X.6%D`&0`Q```@("`O[^_0$!`[^_O,#`PW]_?S\_/<'!P4%!0GY^?("`@
+MCX^/8&[EMAIL PROTECTED]
+M````````````````````````(?D$```````L`````&0`9```!?_@(XYD:9YH
+MJJYLJT)P+,]T;=]XKN^UR/_`H%#H&QJ/R%\QR6PRE\ZHE`>=6J^R*G8KU7*_
+M22]X3'R0ST<Q>GU3L]]9,WQN<]/[EMAIL PROTECTED]"@UB%AE:(B5URC'B.
+MCWN1DGZ4E8&7F(2:FX>[EMAIL PROTECTED]@4%-`$\`P9PBS4",0``-*\[!@>LHSP&[EMAIL
PROTECTED]
+ML0:K,;TP`<$TJC$#`:8W`<-AN3L)#[*^"@<$U1".`@<(M#,!M`,*`-DU`P0'
+M#`1-K32.`+?B,8X."<HU]!`&"@W(QX!-<Q=M1SQ9^[;%,,!``8(!I\`U0'`-
+M'0$&"PKJ>#?C((2$CAY"(/",&*T"#"#_#-!$;Q?!)@3:^4((SE&"F+<BQL!&
+M(($-`=T<0(06:@S'HDHT(DVC=.F0HTYS0(W:IBG5I%=%99TR=6L<.`)ZQ4*W
+M(,[EMAIL PROTECTED](`F#M"I`0``!9MNP,:"8$P*VBC#8SJQ!P$%.`SAC-(B)
+M($;AOD!:[EMAIL PROTECTED])[EMAIL PROTECTED]/"`)\+F`6-[):E0@<,#`F
+MI_9.`@@^MPTMK";0U#`07QO:&JL09[YJPK#]L=W*&([EMAIL PROTECTED]&`DP(ZA6
+MG,KK`N6`+Q^O4&6YW-!!US!P#WNVZC`6FPO&_K3<URJ7B2;&'T8^`T,!",-U
[EMAIL PROTECTED](CAA!LB$>&#'WH5XE8C0N=4
+MB?TAA2)J,22P``((!`!C@@`(@(`Q`^QU@'T-",[EMAIL PROTECTED])`)H-7!+
[EMAIL PROTECTED]>'P"++6-(M((`"[EMAIL PROTECTED]"UA%F#U8.YM:+RH`CE%_5+`#9
+M%2MZA&4U"<18UTX,-.!`->`UH"655VB#W*##N,B9,"X>H$T!`"P`9".,*+!`
+M`_!9PLA9`.!EU)@@<BJBIR2"FM6*49%ZHJA7F;J4JBJB2A6K1<$:BJR>T+J)
[EMAIL PROTECTED],`)N(L(80.XBQ@"#;A[)ZN.#LL]!&*ZT((0``.PT*+2UX
+M67I:60T*0V]N=&5N="U$:7-P;W-I=&EO;[EMAIL PROTECTED];2UD871A.R!N86UE/2(S
+M,#!X,S`P7V=I9B([(&9I;&5N86UE/2(S,#!X,S`P+F=I9B(-"D-O;G1E;G0M
+M3&5N9W1H.B`Q-C4V#0I#;VYT96YT+51Y<&4Z(&[EMAIL PROTECTED]'248X
+M.6$L`2P!Q```0$!`O[^_@("`[^_OS\_/,#`P<'!PGY^?4%!0("[EMAIL PROTECTED]/
+MKZ^O8&[EMAIL PROTECTED]
+M````````````````````(?D$```````L`````"P!+`$`!?_@(XYD:9YHJJYL
+MZ[YP+,]T;=_X`^U\[__`H'!(+!J/R*1RR6PZG]"G*$JM6J_8K';+-4Z[X+!X
+M3"Z/O^:T>[EMAIL PROTECTED]'NN'Q.G\/K^+Q^'[WS_X"!@'Z"A8:':82(BXR-5(J.D9*3
+M09"4EYB,EIF<G7R;GJ&B;J"CIJ=BI:BKK%:JK;"Q2J^RM;9`M+>ZMKF[OJV]
+MO\*FP</&G<7'RI3)R\Z-S<_2AM'3UG_5U]IXV=O><=W?XFKAX^9G.N?J@>7K
+M[ECM[_)]Z?/VI/7W^HGY^_ZI_?X)W!)OH$$>!0\:3*A0(,.&_AY"U"=QHKV*
+M%N5AS.AN(T=U'C^:"RE2',F2WD[_HM2F<J6UEBZEP8SI;"9-939O&LNI4QC/
+MGKY^`M4E="[EMAIL PROTECTED]::RE38$B?+HPJU2'5JA&O8J6H=>O%KEXU@@W;<2Q9
+MD&;/CDRKUB3;MBG?PF4I=^[+NG9EXLU;<R]?G'[EMAIL PROTECTED]"?APD$/(R:J>/%1
[EMAIL PROTECTED],JF5KCRE`QN]7\C3)G;)<_$PLM6I3GTGE.HZZC>K4=TJXSM8Z-CW9?
+MV\MFXR8'>W<DW;[+``^.CKAAX[^&(^^B?#G!WLX+-8\.#SKU0=:O?\JN7<_T
[EMAIL PROTECTED];J(_O!3Y]WO=-V\\O?#__XO]Q,E^`/PQ(
+M8`\&'KA#_X)Z**#`#P$<,0`!)3$X!P`\""#`#Q@:08`!%?HW"@$/[EMAIL PROTECTED]
+MR(.)[EMAIL PROTECTED]@\3\C!```\*$0"+8LUSP`,;GIB``07T"$$]`!B`0(<^!-#A``D(
+M$"[EMAIL PROTECTED],%?'51AB`JB1`/#APP(Q!:[EMAIL PROTECTED]"&.*.UHY3ST:0A#FD#P0
+MT$`""`P`(9(,(/`CE`4TL("([EMAIL PROTECTED];OEE/G1`4@&.+'2K0``0#(*4EB6K*
+M4T"5)Q:*9#T'7`KBG3P`6<`!00!0I`-VYJ@@,X"N6IVKDP@:H*S_T<J?K?GA
+M>I^N]/$:GZ]A`+!H%D(BP<"+:ZTC[!M++!N9.LX.8&H"I"Z(P/^GTIJ*9*>C
+M`F'``TB*^J*I!3"PPP$.%(#L9M":&("Y!VQ:(P0&;"[EMAIL PROTECTED],"\"/+`P*,*
+MY.MF`1-6"X&SD[6*2;0(%&#JECPL&V8`#FB[[H(9)[EMAIL PROTECTED]""?;[EMAIL
PROTECTED]"
+M@,C`ICTT0&J\.P2\`P&I^L#IHVZV3&H`1`[;F<*7.!M`D`Y#_'*3&O/0P+68
+M_N``ME)>RX.4#=`,`0((\,ON.3#SH`"%+.)X``'O(M`#V$([EMAIL PROTECTED]([8\SC
+M`%O'`D#K3)/;=9C--E!TEY>W>'N#UW=W?VL7^'6#4U?X&$AN=;@8<C.U>+`\
+M'+``U0%0'?.]"+PXP-$&&'QR`W=S-1#_FP!L7CH""^S``(@L[X`ZDST24/K)
+MH_.,"J&[EMAIL PROTECTED];'N`F@,@.VG/,XLR?8FOWN=;Z)*;X\+?#K5Z!DJWR8$
+M!R#P<[EMAIL PROTECTED],.!`CP$SP'[EMAIL PROTECTED]/\'@DLP,"^
+M%MVOQP`+$(#5%.*_X!30-P?<30)QLT#;-)`V#XQ-!%TSP=54$#47+$T&1;/!
+MSW20,[EMAIL PROTECTED],\+*E%`R)X1,"AVSPL6T$#$O+$P,!3/#O]20+S?,2P[MLL.Y
+M]!`N/VQ+$-4RQ+,4D2Q'#$L2O;)$Q1$/5E)X(A2;T$2L5+$J5Y1*%I^R1<=)
+M<8I+Z&)2Q&@4]3(.Q8QX^R(8DX#&GK11)V^\21SGIL8U'F&.,<&C2_2X$CZB
+MQ(\ALN,B`"D20G[$D!Q!9$84V;\Z"I((C)Q())7BR$<*89(-P20!*VE)7'"R
+MDS+[)"@1(LI1#JF4H]3D050Y/5."QI6OA.4>6$D^67H'E:"DI55L>4M>I@:7
+MG=3E/X29%5]R`YB6).8^E"DZ8]*!F?9#YB.A62EGOL>:K\'FH*0I2&JNB9MV
+M]*:JM"D?<*Y1G.]`9UG(61MVLD&=ZX#GL]R)'WK6TYYFD&?"\,D/?N;3G
+MI\C\"2""[EMAIL PROTECTED]<W+`T(8Z]*$0C:A$)TK1$H0``#L-"BTM>%EZ6EDM+0T*
+!"@``
End of Patch.
