$title

From: Jarkko Hietaniemi Date: Tue, 10 Oct 2000 12:01:32 +0000 (+0000) Subject: Upgrade to CGI.pm 2.74, from Lincoln Stein. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=03b9648da61dbacb9e86f830b7b3b0aa18eb26c9;p=p5sagit%2Fp5-mst-13.2.git Upgrade to CGI.pm 2.74, from Lincoln Stein. p4raw-id: //depot/perl@7184 --- diff --git a/lib/CGI.pm b/lib/CGI.pm index a847c9d..fd06f64 100644 --- a/lib/CGI.pm +++ b/lib/CGI.pm @@ -17,8 +17,8 @@ require 5.004; # The most recent version and complete docs are available at: # http://stein.cshl.org/WWW/software/CGI/ -$CGI::revision = '$Id: CGI.pm,v 1.42 2000/08/13 16:04:43 lstein Exp $'; -$CGI::VERSION='2.72'; +$CGI::revision = '$Id: CGI.pm,v 1.45 2000/09/13 02:55:41 lstein Exp $'; +$CGI::VERSION='2.74'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. @@ -1294,15 +1294,15 @@ sub start_html { $dtd = $XHTML ? XHTML_DTD : $DEFAULT_DTD; } if (ref($dtd) && ref($dtd) eq 'ARRAY') { - push(@result,qq([0]"\n\t"$dtd->[1]">)); + push(@result,qq([0]"\n\t"$dtd->[1]">)); } else { - push(@result,qq()); + push(@result,qq()); } push(@result,$XHTML ? qq($title) : qq($title)); if (defined $author) { push(@result,$XHTML ? "" - : ""); + : ""); } if ($base || $xbase || $target) { @@ -1461,10 +1461,13 @@ sub startform { my($method,$action,$enctype,@other) = rearrange([METHOD,ACTION,ENCTYPE],@p); - $method = uc($method) || 'POST'; + $method = lc($method) || 'post'; $enctype = $enctype || &URL_ENCODED; - $action = $action ? qq(action="$action") : qq 'action="' . - $self->url(-absolute=>1,-path=>1,-query=>1) . '"'; + unless (defined $action) { + $action = $self->url(-absolute=>1,-path=>1); + $action .= "?$ENV{QUERY_STRING}" if $ENV{QUERY_STRING}; + } + $action = qq(action="$action"); my($other) = @other ? " @other" : ''; $self->{'.parametersToAdd'}={}; return qq/

\n/; @@ -1776,9 +1779,9 @@ sub checkbox { if (!$override && ($self->{'.fieldnames'}->{$name} || defined $self->param($name))) { - $checked = grep($_ eq $value,$self->param($name)) ? ' checked="yes"' : ''; + $checked = grep($_ eq $value,$self->param($name)) ? ' checked' : ''; } else { - $checked = $checked ? qq/ checked="yes"/ : ''; + $checked = $checked ? qq/ checked/ : ''; } my($the_label) = defined $label ? $label : $name; $name = $self->escapeHTML($name); @@ -1843,7 +1846,7 @@ sub checkbox_group { my($other) = @other ? " @other" : ''; foreach (@values) { - $checked = $checked{$_} ? qq/ checked="yes"/ : ''; + $checked = $checked{$_} ? qq/ checked/ : ''; $label = ''; unless (defined($nolabels) && $nolabels) { $label = $_; @@ -1988,7 +1991,7 @@ sub radio_group { my($other) = @other ? " @other" : ''; foreach (@values) { - my($checkit) = $checked eq $_ ? qq/ checked="yes"/ : ''; + my($checkit) = $checked eq $_ ? qq/ checked/ : ''; my($break); if ($linebreak) { $break = $XHTML ? "
" : "
"; @@ -2049,7 +2052,7 @@ sub popup_menu { $result = qq/\n/; foreach (@values) { - my($selectit) = $selected{$_} ? qq/selected="yes"/ : ''; + my($selectit) = $selected{$_} ? qq/selected/ : ''; my($label) = $_; $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); $label=$self->escapeHTML($label); @@ -2153,8 +2156,8 @@ sub hidden { $name=$self->escapeHTML($name); foreach (@value) { $_ = defined($_) ? $self->escapeHTML($_,1) : ''; - push(@result,$XHTMl ? qq() - : qq//); + push @result,$XHTMl ? qq() + : qq(); } return wantarray ? @result : join('',@result); } @@ -2215,10 +2218,10 @@ END_OF_FUNC 'url' => <<'END_OF_FUNC', sub url { my($self,@p) = self_or_default(@_); - my ($relative,$absolute,$full,$path_info,$query) = - rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING']],@p); + my ($relative,$absolute,$full,$path_info,$query,$base) = + rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING'],'BASE'],@p); my $url; - $full++ if !($relative || $absolute); + $full++ if $base || !($relative || $absolute); my $path = $self->path_info; my $script_name = $self->script_name; @@ -2251,12 +2254,14 @@ sub url { unless (lc($protocol) eq 'http' && $port == 80) || (lc($protocol) eq 'https' && $port == 443); } + return $url if $base; $url .= $script_name; } elsif ($relative) { ($url) = $script_name =~ m!([^/]+)$!; } elsif ($absolute) { $url = $script_name; } + $url .= $path if $path_info and defined $path; $url .= "?" . $self->query_string if $query and $self->query_string; $url = '' unless defined $url; @@ -3173,8 +3178,7 @@ sub read { die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0); # If the boundary begins the data, then skip past it - # and return undef. The +2 here is a fiendish plot to - # remove the CR/LF pair at the end of the boundary. + # and return undef. if ($start == 0) { # clear us out completely if we've hit the last boundary. @@ -3185,7 +3189,8 @@ sub read { } # just remove the boundary. - substr($self->{BUFFER},0,length($self->{BOUNDARY})+2)=''; + substr($self->{BUFFER},0,length($self->{BOUNDARY}))=''; + $self->{BUFFER} =~ s/^\012\015?//; return undef; } @@ -4519,6 +4524,7 @@ You can also retrieve the unprocessed query string with query_string(): $absolute_url = $query->url(-absolute=>1); $url_with_path = $query->url(-path_info=>1); $url_with_path_and_query = $query->url(-path_info=>1,-query=>1); + $netloc = $query->url(-base => 1); B returns the script's URL in a variety of formats. Called without any arguments, it returns the full form of the URL, including @@ -4560,6 +4566,10 @@ Append the query string to the URL. This can be combined with B<-full>, B<-absolute> or B<-relative>. B<-query_string> is provided as a synonym. +=item B<-base> + +Generate just the protocol and net location, as in http://www.foo.com:8000 + =back =head2 MIXING POST AND URL PARAMETERS @@ -5807,13 +5817,17 @@ To create multiple cookies, give header() an array reference: -value=>\%answers); print $query->header(-cookie=>[$cookie1,$cookie2]); -To retrieve a cookie, request it by name by calling cookie() -method without the B<-value> parameter: +To retrieve a cookie, request it by name by calling cookie() method +without the B<-value> parameter: use CGI; $query = new CGI; - %answers = $query->cookie(-name=>'answers'); - # $query->cookie('answers') will work too! + $riddle = $query->cookie('riddle_name'); + %answers = $query->cookie('answers'); + +Cookies created with a single scalar value, such as the "riddle_name" +cookie, will be returned in that form. Cookies with array and hash +values can also be retrieved. The cookie and CGI namespaces are separate. If you have a parameter named 'answers' and a cookie named 'answers', the values retrieved by @@ -6112,6 +6126,10 @@ name. When using virtual hosts, returns the name of the host that the browser attempted to contact +=item B + +Return the port that the server is listening on. + =item B Returns the server software and version number. diff --git a/t/lib/cgi-form.t b/t/lib/cgi-form.t index 7d02181..6bdd7de 100755 --- a/t/lib/cgi-form.t +++ b/t/lib/cgi-form.t @@ -34,8 +34,8 @@ $ENV{SERVER_PROTOCOL} = 'HTTP/1.0'; $ENV{SERVER_PORT} = 8080; $ENV{SERVER_NAME} = 'the.good.ship.lollypop.com'; -test(2,start_form(-action=>'foobar',-method=>GET) eq - qq(\n), +test(2,start_form(-action=>'foobar',-method=>'get') eq + qq(\n), "start_form()"); test(3,submit() eq qq(),"submit()"); @@ -51,32 +51,31 @@ test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq qq(forecast), "checkbox()"); test(11,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast',-checked=>1,-override=>1) eq - qq(forecast), + qq(forecast), "checkbox()"); test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq - qq(forecast), + qq(forecast), "checkbox()"); test(13,radio_group(-name=>'game') eq - qq(chess checkers), + qq(chess checkers), 'radio_group()'); test(14,radio_group(-name=>'game',-labels=>{'chess'=>'ping pong'}) eq - qq(ping pong checkers), + qq(ping pong checkers), 'radio_group()'); test(15, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/]) eq - qq(checkers chess cribbage), + qq(checkers chess cribbage), 'checkbox_group()'); test(16, checkbox_group(-name=>'game',-values=>[qw/checkers chess cribbage/],-defaults=>['cribbage'],-override=>1) eq - qq(checkers chess cribbage), + qq(checkers chess cribbage), 'checkbox_group()'); - test(17, popup_menu(-name=>'game',-values=>[qw/checkers chess cribbage/],-default=>'cribbage',-override=>1) eq < - + END diff --git a/t/lib/cgi-html.t b/t/lib/cgi-html.t index 2d71ff6..21bbcfb 100755 --- a/t/lib/cgi-html.t +++ b/t/lib/cgi-html.t @@ -17,6 +17,15 @@ print "ok 1\n"; ######################### End of black magic. +my $CRLF = "\015\012"; +if ($^O eq 'VMS') { + $CRLF = "\n"; # via web server carriage is inserted automatically +} +if (ord("\t") != 9) { # EBCDIC? + $CRLF = "\r\n"; +} + + # util sub test { local($^W) = 0; @@ -50,7 +59,7 @@ test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${CRLF}${CRLF}","h test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}","header()"); test(12,header(-nph=>1) eq "HTTP/1.0 200 OK${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","header()"); test(13,start_html() ."\n" eq < Untitled Document @@ -58,14 +67,14 @@ test(13,start_html() ."\n" eq <"-//IETF//DTD HTML 3.2//FR") ."\n" eq < Untitled Document END ; test(15,start_html(-Title=>'The world of foo') ."\n" eq < The world of foo @@ -74,7 +83,7 @@ END ; test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()"); my $h = header(-Cookie=>$cookie); -test(17,$h =~ m!^Set-Cookie: fred=chocolate&chip\; path=/\015\012Date:.*\015\012Content-Type: text/html; charset=ISO-8859-1\015\012\015\012!s, +test(17,$h =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s, "header(-cookie)"); test(18,start_h3 eq '

'); test(19,end_h3 eq '

');