From: Steve Hay Date: Sat, 10 Oct 2009 11:05:09 +0000 (+0100) Subject: Upgrade to CGI.pm-3.48 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=deafae52c0ee26d9b53e39e333d390c4443dd43c;p=p5sagit%2Fp5-mst-13.2.git Upgrade to CGI.pm-3.48 --- diff --git a/MANIFEST b/MANIFEST index 35e1072..679569f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -195,20 +195,28 @@ cpan/CGI/lib/CGI/Push.pm Support for server push cpan/CGI/lib/CGI/Switch.pm Simple interface for multiple server types cpan/CGI/lib/CGI/Util.pm Utility functions cpan/CGI/t/apache.t See if CGI::Apache still loads +cpan/CGI/t/autoescape.t See if CGI.pm works cpan/CGI/t/can.t See if CGI.pm works cpan/CGI/t/carp.t See if CGI::Carp works +cpan/CGI/t/checkbox_group.t See if CGI.pm works cpan/CGI/t/cookie.t See if CGI::Cookie works cpan/CGI/t/Dump.t See if CGI->Dump works +cpan/CGI/t/end_form.t See if CGI.pm works cpan/CGI/t/fast.t See if CGI::Fast works (if FCGI is installed) cpan/CGI/t/form.t See if CGI.pm works cpan/CGI/t/function.t See if CGI.pm works +cpan/CGI/t/hidden.t See if CGI.pm works cpan/CGI/t/html.t See if CGI.pm works +cpan/CGI/t/http.t See if CGI.pm works +cpan/CGI/t/init.t See if CGI.pm works +cpan/CGI/t/init_test.txt See if CGI.pm works cpan/CGI/t/no_tabindex.t See if CGI.pm works cpan/CGI/t/popup_menu.t See if CGI pop menus work cpan/CGI/t/pretty.t See if CGI.pm works cpan/CGI/t/push.t See if CGI::Push works cpan/CGI/t/query_string.t See if CGI->query_string() works cpan/CGI/t/request.t See if CGI.pm works +cpan/CGI/t/save_read_roundtrip.t See if CGI.pm works cpan/CGI/t/start_end_asterisk.t See if CGI.pm works cpan/CGI/t/start_end_end.t See if CGI.pm works cpan/CGI/t/start_end_start.t See if CGI.pm works @@ -218,6 +226,7 @@ cpan/CGI/t/uploadInfo.t See if CGI.pm works cpan/CGI/t/upload_post_text.txt Test data for CGI.pm cpan/CGI/t/upload.t See if CGI.pm works cpan/CGI/t/user_agent.t See if CGI->user_agent() works +cpan/CGI/t/utf8.t See if CGI.pm works cpan/CGI/t/util-58.t See if 5.8-dependent features work cpan/CGI/t/util.t See if CGI.pm works cpan/Class-ISA/ChangeLog Changes for Class::ISA diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index e4c3205..6707022 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -300,7 +300,7 @@ use File::Glob qw(:case); 'CGI' => { 'MAINTAINER' => 'lstein', - 'DISTRIBUTION' => 'LDS/CGI.pm-3.45.tar.gz', + 'DISTRIBUTION' => 'LDS/CGI.pm-3.48.tar.gz', 'FILES' => q[cpan/CGI], 'EXCLUDED' => [ qr{^t/lib/Test}, qw( cgi-lib_porting.html @@ -310,7 +310,7 @@ use File::Glob qw(:case); ) ], 'CPAN' => 1, - 'UPSTREAM' => undef, + 'UPSTREAM' => 'cpan', }, 'Class::ISA' => diff --git a/cpan/CGI/Changes b/cpan/CGI/Changes index a45e39b..e7acabd 100644 --- a/cpan/CGI/Changes +++ b/cpan/CGI/Changes @@ -1,16 +1,93 @@ +Version 3.48 + + [BUG FIXES] + 1. default values are now properly escaped. + Thanks to #raleigh.pm and Mark Stosberg. (RT#49606) + 2. The change to exception handling in CGI::Carp introduced in 3.47 has been + reverted for now. It caused regressions reported in RT#49630. + Thanks to mkanat for the report. + + [DOCUMENTATION] + 1. Documentation for upload() has been overhauled, thanks to Mark Stosberg. + 2. Documentation for tmpFileName has been added. Thanks to Mark Stosberg and Nathaniel K. Smith. + 3. URLS were updated, thanks to Leon Brocard and Yanick Champoux. (RT#49770) + + [INTERNALS] + 1. More tests were added for autoescape, thanks to Bob Kuo. (RT#25485) + +Version 3.47 + Released September 9th, 2009. + No code changes. + + [INTERNALS] + Re-release of 3.46, which did not contain a proper MANIFEST + +Version 3.46 + [BUG FIXES] + 1. In CGI::Pretty, we no longer add line breaks after tags we claim not to format. Thanks to rrt, Bob Kuo and + and Mark Stosberg. (RT#42114). + 2. unescapeHTML() no longer falsely recognizes certain text as entities. Thanks to Pete Gamanche, Mark Stosberg + and Bob Kuo. (RT#39122) + 3. checkbox_group() now correctly includes a space before the "checked" attribute. + Thanks to Andrew Speer and Bob Kuo. (RT#36583) + 4. Fix case-sensitivity in http() and https() according to docs. Make https() + return list of keys in list context. Thanks to riQyRoe and Rhesa Rozendaal. (RT#12909) + 5. XHTML is now automatically disabled for HTML 4, as well as HTML 2 and HTML 3. Thanks to + Dan Harkless and Yanick Champoux. (RT#27907) + 6. Pre-compiling 'end_form' with ':form' switch now works. Thanks to ryochin and Yanick Champoux. (RT#41530) + 7. Empty name/values pairs are now properly saved and restored from filehandles. Thanks to rlucas and + Rhesa Rozendaal (RT#13158) + 8. Some differences between startform() and start_form() have been fixed. Thanks to Slaven Rezic and + Shawn Corey. (RT#22046) + 9. url_param() has been updated to be more consistent with the documentation and param(). + Thanks to Britton Kerin and Yanick Campoux. (RT#43587) + 10.hidden() now correctly supports multiple default values. + Thanks to david@dierauer.net and Russell Jenkins. (RT#20436) + 11.Calling CGI->new() no longer clobbers the value of $_ in the current scope. + Thanks to Alexey Tourbin, Bob Kuo and Mark Stosberg. (RT#25131) + 12.UTF-8 params should not get double-decoded now. + Thanks to Yves, Bodo, Burak Gürsoy, and Michael Schout. (RT#19913) + 13.We now give objects passed to CGI::Carp::die a chance to be stringified. + Thanks to teek and Yanick Champoux (RT#41530) + 14.Turning off autoEscape() now only affects the behavior of built-in HTML + generation fuctions. Explicit calls to escapeHTML() always escape HTML regardless + of the setting. Thanks to vindex, Bob Kuo and Mark Stosberg (RT#40748) + 15.In CGI::Fast, preferences set via pragmas are now preserved. + Thanks to heinst and Mark Stosberg (RT#32119) + + [DOCUMENTATION] + 1. remote_addr() is now documented. Thanks to Yanick Champoux. (RT#38884) + 2. In CGI::Pretty in the list of tags left unformatted was updated to match the code. Thanks to Mark Stosberg. (RT#42114) + 3. In CGI::Pretty, performance concerns are now documented. Thanks to Jochen, Rhesa Rozendaal and Mark Stosberg (RT#13223) + 4. A number of outdated Netscape references have been removed. Thanks to Mark Stosberg. + 5. The documentation has been purged of examples of using indirect object notation. Thanks to Mark Stosberg. + 6. Some POD formatting was fixed. Thanks to Dave Mitchell (RT#48935). + 7. Docs and examples were updated to highlight start_form instead of startform. + Thanks to Slaven Rezic. + 8. Note that CGI::Carp::carpout() doesn't work with in-memory filehandles. + Thanks to rhubbell and Mark Stosberg. + 9. The documentation for the -newstyle_urls is now less confusing. + Thanks to Ryan Tate and Mark Stosberg (RT#49454) + + [INTERNALS] + 1. Quit bundling an ancient copy of Test::More and and using a custom 'lib' path for the tests. Instead, Test::More + is now a dependency. Thanks to Ansgar and Mark Stosberg (RT#48811) + 2. Automated tests for hidden() have been added, thanks to Russel Jenkins and Mark Stosberg (RT#20436) + 3. t/util.t has been updated to use Test::More instead of a home-grown test function. Thanks to Bob Kuo. + Version 3.45 [BUG FIXES] 1. Prevent warnings about "uninitialized values" for REQUEST_URI, HTTP_USER_AGENT and other environment variables. Patches by Callum Gibson, heiko and Mark Stosberg. (RT#24684, RT#29065) - 2. Avoid death in some cases when running under Taint mode on Windows. + 2. Avoid death in some cases when running under Taint mode on Windows. Patch by Peter Hancock (RT#43796) 3. Allow 0 to be used as a default value in popup_menu(). This was broken starting in 3.37. Thanks to Haze, who was the first to report this and supply a patch, and pfschill, who pinpointed when the bug was introduced. A regression test for this was also added. (RT#37908) - 4. Allow "+" as a valid character in file names, which fixes temp file creation on OS X Leopard. - Thanks to Andy Armstrong, and alech for patches. (RT#30504) + 4. Allow "+" as a valid character in file names, which fixes temp file creation on OS X Leopard. + Thanks to Andy Armstrong, and alech for patches. (RT#30504) 5. Set binmode() on the Netware platform, thanks to Guenter Knauf (RT#27455) - 6. Don't allow a CGI::Carp error handler to die recursively. Print a warning and exit instead. + 6. Don't allow a CGI::Carp error handler to die recursively. Print a warning and exit instead. Thanks to Marc Chantreux. (RT#45956) 7. The Dump() method now is fixed to escape HTML properly. Thanks to Mark Stosberg (RT#21341) 8. Support for with scrolling_list() now works the same way as it does for popup_menu(). @@ -27,20 +104,20 @@ Version 3.45 5. The docs for redirect() were updated to reflect that most headers are ignored during redirection. Thanks to Mark Stosberg (RT#44911) - [INTERNALS] + [INTERNALS] 1. New t/unescapeHTML.t test script has been added. It includes a TODO test for a pre-existing bug which could use a patch. Thanks to Pete Gamache and Mark Stosberg (RT#39122) 2. New test scripts have been added for user_agent(), popup_menu() and query_string(), scrolling_list() and Dump() Thanks to Mark Stosberg and Stuart Johnston. (RT#37908, RT#43006, RT#21341, RT#30097) - 3. CGI::Carp and CGI::Util have been updated to have non-developer version numbers. + 3. CGI::Carp and CGI::Util have been updated to have non-developer version numbers. Thanks to Slaven Rezic. (RT#48425) - 4. CGI::Switch and CGI::Apache now properly set their VERSION in their own name space. + 4. CGI::Switch and CGI::Apache now properly set their VERSION in their own name space. Thanks to Alexey Tourbin (RT#11941,RT#11942) Version 3.44 1. Patch from Kurt Jaeger to allow HTTP PUT even if the content length is unknown. 2. Patch from Pavel merdin to fix a problem for one of the FireFox addons. - 3. Fixed issue in mod_perl & fastCGI environment of cookies returned from + 3. Fixed issue in mod_perl & fastCGI environment of cookies returned from CGI->cookie() leaking from one session to another. Version 3.43 @@ -210,7 +287,7 @@ Version 3.45 Version 3.14 Tue Dec 6 17:12:03 EST 2005 1. Fixed broken scrolling_list() select attribute. - + Version 3.13 1. Removed extraneous empty "?" from end of self_url(). @@ -234,7 +311,7 @@ Version 3.45 Version 3.11 1. Killed warning in CGI::Cookie about MOD_PERL_API_VERSION 2. Fixed append() so that it works in function mode. - 3. Workaround for a bug that appears in Apache2 versions through 2.0.54 + 3. Workaround for a bug that appears in Apache2 versions through 2.0.54 in which SCRIPT_NAME and PATH_INFO are incorrect if the additional path_info contains a double slash. This workaround will handle the common case of http://mysite.com/cgi-bin/log.cgi/http://www.some.other.site/args, but will @@ -268,7 +345,7 @@ Version 3.45 5. Tests for *tag start/end generation from Shlomi Fish. 6. Support for can() method provided by Ron Savage. 7. Fix for lang='' when outputting XHTML. - 8. Added support for chunked transfer encoding, as suggested by + 8. Added support for chunked transfer encoding, as suggested by Hakan Ardo 9. Fixed clobbering of row and column headers in tableized radio and checkbox groups, as reported by Nicolas Thierry-Mieg. @@ -1109,7 +1186,7 @@ Version 3.45 4. HTML shortcuts now generate tags in ALL UPPERCASE. 5. start_html() now generates correct SGML header: - + 6. CGI::Carp no longer fails "use strict refs" pragma. Version 2.25 diff --git a/cpan/CGI/examples/clickable_image.cgi b/cpan/CGI/examples/clickable_image.cgi index 81daf09..0f6f672 100644 --- a/cpan/CGI/examples/clickable_image.cgi +++ b/cpan/CGI/examples/clickable_image.cgi @@ -10,7 +10,7 @@ print <startform; +print $query->start_form; print $query->image_button('picture',"./wilogo.gif"); print "Give me a: ",$query->popup_menu('letter',['A','B','C','D','E','W']),"\n"; # print "

Magnification: ",$query->radio_group('magnification',['1X','2X','4X','20X']),"\n"; diff --git a/cpan/CGI/examples/frameset.cgi b/cpan/CGI/examples/frameset.cgi index fc86e92..77a748b 100644 --- a/cpan/CGI/examples/frameset.cgi +++ b/cpan/CGI/examples/frameset.cgi @@ -54,7 +54,7 @@ sub print_end { sub print_query { $script_name = $query->script_name; print "

Frameset Query

\n"; - print $query->startform(-action=>"$script_name/response",-TARGET=>"response"); + print $query->start_form(-action=>"$script_name/response",-TARGET=>"response"); print "What's your name? ",$query->textfield('name'); print "

What's the combination?

", $query->checkbox_group(-name=>'words', diff --git a/cpan/CGI/examples/internal_links.cgi b/cpan/CGI/examples/internal_links.cgi index 4806966..c61722c 100644 --- a/cpan/CGI/examples/internal_links.cgi +++ b/cpan/CGI/examples/internal_links.cgi @@ -17,7 +17,7 @@ print "\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->start_form; print $query->popup_menu('amenu',[('FOO1'..'FOO9')]); print $query->submit,$query->endform; diff --git a/cpan/CGI/examples/multiple_forms.cgi b/cpan/CGI/examples/multiple_forms.cgi index b38bf93..a17a125 100644 --- a/cpan/CGI/examples/multiple_forms.cgi +++ b/cpan/CGI/examples/multiple_forms.cgi @@ -8,7 +8,7 @@ print $query->start_html('Multiple Forms'); print "

Multiple Forms

\n"; # Print the first form -print $query->startform; +print $query->start_form; $name = $query->remote_user || 'anonymous@' . $query->remote_host; print "What's your name? ",$query->textfield('name',$name,50); @@ -22,7 +22,7 @@ print $query->endform; # Print the second form print "

\n"; -print $query->startform; +print $query->start_form; print "Some radio buttons: ",$query->radio_group('radio buttons', [qw{one two three four five}],'three'),"\n"; print "

What's the password? ",$query->password_field('pass','secret'); diff --git a/cpan/CGI/examples/popup.cgi b/cpan/CGI/examples/popup.cgi index 88cea1d..35cab57 100644 --- a/cpan/CGI/examples/popup.cgi +++ b/cpan/CGI/examples/popup.cgi @@ -8,7 +8,7 @@ print $query->start_html('Popup Window'); if (!$query->param) { print "

Ask your Question

\n"; - print $query->startform(-target=>'_new'); + print $query->start_form(-target=>'_new'); print "What's your name? ",$query->textfield('name'); print "

What's the combination?

", $query->checkbox_group(-name=>'words', diff --git a/cpan/CGI/lib/CGI.pm b/cpan/CGI/lib/CGI.pm index cacb03a..0cba881 100644 --- a/cpan/CGI/lib/CGI.pm +++ b/cpan/CGI/lib/CGI.pm @@ -19,7 +19,7 @@ use Carp 'croak'; # http://stein.cshl.org/WWW/software/CGI/ $CGI::revision = '$Id: CGI.pm,v 1.266 2009/07/30 16:32:34 lstein Exp $'; -$CGI::VERSION='3.45'; +$CGI::VERSION='3.48'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. @@ -128,7 +128,9 @@ sub initialize_globals { # ------------------ START OF THE LIBRARY ------------ -*end_form = \&endform; +#### Method: endform +# This method is DEPRECATED +*endform = \&end_form; # make mod_perlhappy initialize_globals(); @@ -455,12 +457,23 @@ sub param { if ($PARAM_UTF8) { eval "require Encode; 1;" unless Encode->can('decode'); # bring in these functions - @result = map {ref $_ ? $_ : Encode::decode(utf8=>$_) } @result; + @result = map {ref $_ ? $_ : $self->_decode_utf8($_) } @result; } return wantarray ? @result : $result[0]; } +sub _decode_utf8 { + my ($self, $val) = @_; + + if (Encode::is_utf8($val)) { + return $val; + } + else { + return Encode::decode(utf8 => $val); + } +} + sub self_or_default { return @_ if defined($_[0]) && (!ref($_[0])) &&($_[0] eq 'CGI'); unless (defined($_[0]) && @@ -613,10 +626,10 @@ sub init { } if (defined($fh) && ($fh ne '')) { - while (<$fh>) { - chomp; - last if /^=/; - push(@lines,$_); + while (my $line = <$fh>) { + chomp $line; + last if $line =~ /^=$/; + push(@lines,$line); } # massage back into standard format if ("@lines" =~ /=/) { @@ -1337,7 +1350,8 @@ sub url_param { push(@{$self->{'.url_param'}->{$param}},$value); } } else { - $self->{'.url_param'}->{'keywords'} = [$self->parse_keywordlist($ENV{QUERY_STRING})]; + my @keywords = $self->parse_keywordlist($ENV{QUERY_STRING}); + $self->{'.url_param'}{'keywords'} = \@keywords if @keywords; } } return keys %{$self->{'.url_param'}} unless defined($name); @@ -1359,11 +1373,11 @@ sub Dump { return '

' unless $self->param; push(@result,"

$name

$value

\n/; } END_OF_FUNC #### Method: start_multipart_form -# synonym for startform 'start_multipart_form' => <<'END_OF_FUNC', sub start_multipart_form { my($self,@p) = self_or_default(@_); if (defined($p[0]) && substr($p[0],0,1) eq '-') { - return $self->startform(-enctype=>&MULTIPART,@p); + return $self->start_form(-enctype=>&MULTIPART,@p); } else { my($method,$action,@other) = rearrange([METHOD,ACTION],@p); - return $self->startform($method,$action,&MULTIPART,@other); + return $self->start_form($method,$action,&MULTIPART,@other); } } END_OF_FUNC -#### Method: endform + +#### Method: end_form # End a form -'endform' => <<'END_OF_FUNC', -sub endform { +'end_form' => <<'END_OF_FUNC', +sub end_form { my($self,@p) = self_or_default(@_); if ( $NOSTICKY ) { - return wantarray ? ("

",@fields,"

".(join '',@fields)."

",@fields,"

".(join '',@fields)."

/ - # . - $toencode =~ s{"}{"}gso; - } - else { - $toencode =~ s{"}{"}gso; - } - # Handle bug in some browsers with Latin charsets - if ($self->{'.charset'} && - (uc($self->{'.charset'}) eq 'ISO-8859-1' || - uc($self->{'.charset'}) eq 'WINDOWS-1252')) - { + # hack to work around earlier hacks + push @_,$_[0] if @_==1 && $_[0] eq 'CGI'; + my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_); + return undef unless defined($toencode); + $toencode =~ s{&}{&}gso; + $toencode =~ s{<}{<}gso; + $toencode =~ s{>}{>}gso; + if ($DTD_PUBLIC_IDENTIFIER =~ /[^X]HTML 3\.2/i) { + # $quot; was accidentally omitted from the HTML 3.2 DTD -- see + # / + # . + $toencode =~ s{"}{"}gso; + } + else { + $toencode =~ s{"}{"}gso; + } + + # Handle bug in some browsers with Latin charsets + if ($self->{'.charset'} + && (uc($self->{'.charset'}) eq 'ISO-8859-1' + || uc($self->{'.charset'}) eq 'WINDOWS-1252')) { $toencode =~ s{'}{'}gso; $toencode =~ s{\x8b}{‹}gso; $toencode =~ s{\x9b}{›}gso; - if (defined $newlinestoo && $newlinestoo) { - $toencode =~ s{\012}{ }gso; - $toencode =~ s{\015}{ }gso; - } - } - return $toencode; + if (defined $newlinestoo && $newlinestoo) { + $toencode =~ s{\012}{ }gso; + $toencode =~ s{\015}{ }gso; + } + } + return $toencode; } END_OF_FUNC @@ -2295,7 +2339,7 @@ sub unescapeHTML { my $latin = defined $self->{'.charset'} ? $self->{'.charset'} =~ /^(ISO-8859-1|WINDOWS-1252)$/i : 1; # thanks to Randal Schwartz for the correct solution to this one - $string=~ s[&(.*?);]{ + $string=~ s[&(\S*?);]{ local $_ = $1; /^amp$/i ? "&" : /^quot$/i ? '"' : @@ -2422,7 +2466,7 @@ sub _box_group { # If no check array is specified, check the first by default $checked{$values[0]}++ if $box_type eq 'radio' && !%checked; - $name=$self->escapeHTML($name); + $name=$self->_maybe_escapeHTML($name); my %tabs = (); if ($TABINDEX && $tabindex) { @@ -2463,19 +2507,19 @@ sub _box_group { unless (defined($nolabels) && $nolabels) { $label = $_; $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); - $label = $self->escapeHTML($label,1); + $label = $self->_maybe_escapeHTML($label,1); $label = "$label" if $disabled{$_}; } my $attribs = $self->_set_attributes($_, $attributes); my $tab = $tabs{$_}; - $_=$self->escapeHTML($_); + $_=$self->_maybe_escapeHTML($_); if ($XHTML) { push @elements, CGI::label($labelattributes, qq($label)).${break}; } else { - push(@elements,qq/${label}${break}/); + push(@elements,qq/${label}${break}/); } } $self->register_parameter($name); @@ -2516,7 +2560,7 @@ sub popup_menu { ? @$default : $default; } - $name=$self->escapeHTML($name); + $name=$self->_maybe_escapeHTML($name); my($other) = @other ? " @other" : ''; my(@values); @@ -2528,7 +2572,7 @@ sub popup_menu { for my $v (split(/\n/)) { my $selectit = $XHTML ? 'selected="selected"' : 'selected'; for my $selected (keys %selected) { - $v =~ s/(value="$selected")/$selectit $1/; + $v =~ s/(value="\Q$selected\E")/$selectit $1/; } $result .= "$v\n"; } @@ -2538,8 +2582,8 @@ sub popup_menu { my($selectit) = $self->_selected($selected{$_}); my($label) = $_; $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); - my($value) = $self->escapeHTML($_); - $label = $self->escapeHTML($label,1); + my($value) = $self->_maybe_escapeHTML($_); + $label = $self->_maybe_escapeHTML($label,1); $result .= "$label\n"; } } @@ -2582,7 +2626,7 @@ sub optgroup { @values = $self->_set_values_and_labels($values,\$labels,$name,$labeled,$novals); my($other) = @other ? " @other" : ''; - $name=$self->escapeHTML($name); + $name=$self->_maybe_escapeHTML($name); $result = qq/\n/; for (@values) { if (/_set_attributes($_, $attributes); my($label) = $_; $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); - $label=$self->escapeHTML($label); - my($value)=$self->escapeHTML($_,1); + $label=$self->_maybe_escapeHTML($label); + my($value)=$self->_maybe_escapeHTML($_,1); $result .= $labeled ? $novals ? "$label\n" : "$label\n" : $novals ? "$label\n" @@ -2648,7 +2692,7 @@ sub scrolling_list { my($has_size) = $size ? qq/ size="$size"/: ''; my($other) = @other ? " @other" : ''; - $name=$self->escapeHTML($name); + $name=$self->_maybe_escapeHTML($name); $tabindex = $self->element_tab($tabindex); $result = qq/) : qq(); } @@ -2740,7 +2785,7 @@ sub image_button { my($align) = $alignment ? " align=\L\"$alignment\"" : ''; my($other) = @other ? " @other" : ''; - $name=$self->escapeHTML($name); + $name=$self->_maybe_escapeHTML($name); return $XHTML ? qq() : qq//; } @@ -2872,7 +2917,7 @@ sub cookie { push(@param,'-secure'=>$secure) if $secure; push(@param,'-httponly'=>$httponly) if $httponly; - return new CGI::Cookie(@param); + return CGI::Cookie->new(@param); } END_OF_FUNC @@ -3258,36 +3303,34 @@ END_OF_FUNC sub http { my ($self,$parameter) = self_or_CGI(@_); if ( defined($parameter) ) { - if ( $parameter =~ /^HTTP/ ) { - return $ENV{$parameter}; - } - $parameter =~ tr/-/_/; - } - return $ENV{"HTTP_\U$parameter\E"} if $parameter; - my(@p); - for (keys %ENV) { - push(@p,$_) if /^HTTP/; + $parameter =~ tr/-a-z/_A-Z/; + if ( $parameter =~ /^HTTP(?:_|$)/ ) { + return $ENV{$parameter}; + } + return $ENV{"HTTP_$parameter"}; } - return @p; + return grep { /^HTTP(?:_|$)/ } keys %ENV; } END_OF_FUNC #### Method: https -# Return the value of HTTPS +# Return the value of HTTPS, or +# the value of an HTTPS variable, or +# the list of variables #### 'https' => <<'END_OF_FUNC', sub https { - local($^W)=0; my ($self,$parameter) = self_or_CGI(@_); - return $ENV{HTTPS} unless $parameter; - return $ENV{$parameter} if $parameter=~/^HTTPS/; - $parameter =~ tr/-/_/; - return $ENV{"HTTPS_\U$parameter\E"} if $parameter; - my(@p); - for (keys %ENV) { - push(@p,$_) if /^HTTPS/; + if ( defined($parameter) ) { + $parameter =~ tr/-a-z/_A-Z/; + if ( $parameter =~ /^HTTPS(?:_|$)/ ) { + return $ENV{$parameter}; + } + return $ENV{"HTTPS_$parameter"}; } - return @p; + return wantarray + ? grep { /^HTTPS(?:_|$)/ } keys %ENV + : $ENV{'HTTPS'}; } END_OF_FUNC @@ -3409,6 +3452,17 @@ sub default_dtd { END_OF_FUNC # -------------- really private subroutines ----------------- +'_maybe_escapeHTML' => <<'END_OF_FUNC', +sub _maybe_escapeHTML { + # hack to work around earlier hacks + push @_,$_[0] if @_==1 && $_[0] eq 'CGI'; + my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_); + return undef unless defined($toencode); + return $toencode if ref($self) && !$self->{'escape'}; + return $self->escapeHTML($toencode, $newlinestoo); +} +END_OF_FUNC + 'previous_or_default' => <<'END_OF_FUNC', sub previous_or_default { my($self,$name,$defaults,$override) = @_; @@ -3551,7 +3605,7 @@ sub read_multipart { # choose a relatively unpredictable tmpfile sequence number my $seqno = unpack("%16C*",join('',localtime,grep {defined $_} values %ENV)); for (my $cnt=10;$cnt>0;$cnt--) { - next unless $tmpfile = new CGITempFile($seqno); + next unless $tmpfile = CGITempFile->new($seqno); $tmp = $tmpfile->as_string; last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES)); $seqno += int rand(100); @@ -3663,7 +3717,7 @@ sub read_multipart_related { # choose a relatively unpredictable tmpfile sequence number my $seqno = unpack("%16C*",join('',localtime,grep {defined $_} values %ENV)); for (my $cnt=10;$cnt>0;$cnt--) { - next unless $tmpfile = new CGITempFile($seqno); + next unless $tmpfile = CGITempFile->new($seqno); $tmp = $tmpfile->as_string; last if defined($filehandle = Fh->new($param,$tmp,$PRIVATE_TEMPFILES)); $seqno += int rand(100); @@ -4301,7 +4355,7 @@ a simple "Hello World" HTML page: #!/usr/local/bin/perl -w use CGI; # load CGI routines - $q = new CGI; # create new CGI object + $q = CGI->new; # create new CGI object print $q->header, # create the HTTP header $q->start_html('hello world'), # start the HTML $q->h1('hello world'), # level 1 header @@ -4440,7 +4494,7 @@ HTML "standards". =head2 CREATING A NEW QUERY OBJECT (OBJECT-ORIENTED STYLE): - $query = new CGI; + $query = CGI->new; This will parse the input (from both POST and GET methods) and store it into a perl5 object called $query. @@ -4450,7 +4504,7 @@ the beginning of the file. =head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE - $query = new CGI(INPUTFILE); + $query = CGI->new(INPUTFILE); If you provide a file handle to the new() method, it will read parameters from the file (or STDIN, or whatever). The file can be in @@ -4463,7 +4517,7 @@ Perl purists will be pleased to know that this syntax accepts references to file handles, or even references to filehandle globs, which is the "official" way to pass a filehandle: - $query = new CGI(\*STDIN); + $query = CGI->new(\*STDIN); You can also initialize the CGI object with a FileHandle or IO::File object. @@ -4480,29 +4534,29 @@ default CGI object from the indicated file handle. You can also initialize the query object from a hash reference: - $query = new CGI( {'dinosaur'=>'barney', + $query = CGI->new( {'dinosaur'=>'barney', 'song'=>'I love you', 'friends'=>[qw/Jessica George Nancy/]} ); or from a properly formatted, URL-escaped query string: - $query = new CGI('dinosaur=barney&color=purple'); + $query = CGI->new('dinosaur=barney&color=purple'); or from a previously existing CGI object (currently this clones the parameter list, but none of the other object-specific fields, such as autoescaping): - $old_query = new CGI; - $new_query = new CGI($old_query); + $old_query = CGI->new; + $new_query = CGI->new($old_query); To create an empty query, initialize it from an empty string or hash: - $empty_query = new CGI(""); + $empty_query = CGI->new(""); -or- - $empty_query = new CGI({}); + $empty_query = CGI->new({}); =head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY: @@ -4708,7 +4762,7 @@ a short example of creating multiple session records: open (OUT,">>test.out") || die; $records = 5; for (0..$records) { - my $q = new CGI; + my $q = CGI->new; $q->param(-name=>'counter',-value=>$_); $q->save(\*OUT); } @@ -4717,7 +4771,7 @@ a short example of creating multiple session records: # reopen for reading open (IN,"test.out") || die; while (!eof(IN)) { - my $q = new CGI(\*IN); + my $q = CGI->new(\*IN); print $q->param('counter'),"\n"; } @@ -4806,12 +4860,11 @@ Import all methods that generate HTML 4 elements (such as =item B<:netscape> -Import all methods that generate Netscape-specific HTML extensions. +Import the , and tags. =item B<:html> -Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' + -'netscape')... +Import all HTML-generating shortcuts (i.e. 'html2', 'html3', 'html4' and 'netscape') =item B<:standard> @@ -4894,11 +4947,11 @@ The current list of pragmas is as follows: When you I, then any method that the query object doesn't recognize will be interpreted as a new HTML tag. This allows -you to support the next I Netscape or Microsoft HTML +you to support the next I HTML extension. This lets you go wild with new and unsupported tags: use CGI qw(-any); - $q=new CGI; + $q=CGI->new; print $q->gradient({speed=>'fast',start=>'red',end=>'blue'}); Since using any causes any mistyped method name @@ -4961,7 +5014,8 @@ By default, CGI.pm versions 2.69 and higher emit XHTML feature. Thanks to Michalis Kabrianis for this feature. -If start_html()'s -dtd parameter specifies an HTML 2.0 or 3.2 DTD, +If start_html()'s -dtd parameter specifies an HTML 2.0, +3.2, 4.0 or 4.01 DTD, XHTML will automatically be disabled without needing to use this pragma. @@ -4989,11 +5043,9 @@ semicolons rather than ampersands. For example: ?name=fred;age=24;favorite_color=3 -Semicolon-delimited query strings are always accepted, but will not be -emitted by self_url() and query_string() unless the -newstyle_urls -pragma is specified. - -This became the default in version 2.64. +Semicolon-delimited query strings are always accepted, and will be emitted by +self_url() and query_string(). newstyle_urls became the default in version +2.64. =item -oldstyle_urls @@ -5184,7 +5236,7 @@ indicated expiration date. The following forms are all valid for the The B<-cookie> parameter generates a header that tells the browser to provide a "magic cookie" during all subsequent transactions with your script. -Netscape cookies have a special format that includes interesting attributes +Some cookies have a special format that includes interesting attributes such as expiration time. Use the cookie() method to create and retrieve session cookies. @@ -5276,7 +5328,7 @@ This method returns a canned HTML header and the opening tag. All parameters are optional. In the named parameter form, recognized parameters are -title, -author, -base, -xbase, -dtd, -lang and -target (see below for the explanation). Any additional parameters you -provide, such as the Netscape unofficial BGCOLOR attribute, are added +provide, such as the unofficial BGCOLOR attribute, are added to the tag. Additional parameters must be proceeded by a hyphen. @@ -5289,9 +5341,7 @@ All relative links will be interpreted relative to this tag. The argument B<-target> allows you to provide a default target frame for all the links and fill-out forms on the page. B -See the Netscape documentation on frames for details of how to -manipulate this. +non-standard HTTP feature which only works with some browsers!> -target=>"answer_window" @@ -5357,7 +5407,7 @@ And here's how to create an HTTP-EQUIV tag: JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>, B<-onMouseOver>, B<-onMouseOut> and B<-onUnload> parameters are used -to add Netscape JavaScript calls to your pages. B<-script> should +to add JavaScript calls to your pages. B<-script> should point to a block of text containing JavaScript function definitions. This block will be placed within a