projects / p5sagit/p5-mst-13.2.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw (parent: 7558ebc)
Upgrade to CGI.pm 2.74, from Lincoln Stein.
Jarkko Hietaniemi [Tue, 10 Oct 2000 12:01:32 +0000 (12:01 +0000)]
p4raw-id: //depot/perl@7184

lib/CGI.pm patch | blob | blame | history
t/lib/cgi-form.t patch | blob | blame | history
t/lib/cgi-html.t patch | blob | blame | history

diff --git a/lib/CGI.pm b/lib/CGI.pm
index a847c9d..fd06f64 100644 (file)
--- 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(<!DOCTYPE HTML\n\tPUBLIC "$dtd->[0]"\n\t"$dtd->[1]">));
+        push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\t"$dtd->[1]">));
     } else {
-        push(@result,qq(<!DOCTYPE HTML\n\tPUBLIC "$dtd">));
+        push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd">));
     }
     push(@result,$XHTML ? qq(<html xmlns="http://www.w3.org/1999/xhtml" lang="$lang"><head><title>$title</title>)
                         : qq(<html lang="$lang"><head><title>$title</title>));
        if (defined $author) {
     push(@result,$XHTML ? "<link rev=\"made\" href=\"mailto:$author\" />"
-                                                               : "<link rev=made href=\"mailto:$author\">");
+                                                               : "<link rev=\"made\" href=\"mailto:$author\">");
        }
 
     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/<form method="$method" $action enctype="$enctype"$other>\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 ? "<br />" : "<br>";
@@ -2049,7 +2052,7 @@ sub popup_menu {
 
     $result = qq/<select name="$name"$other>\n/;
     foreach (@values) {
-       my($selectit) = defined($selected) ? ($selected eq $_ ? qq/selected="yes"/ : '' ) : '';
+       my($selectit) = defined($selected) ? ($selected eq $_ ? qq/selected/ : '' ) : '';
        my($label) = $_;
        $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
        my($value) = $self->escapeHTML($_);
@@ -2096,14 +2099,14 @@ sub scrolling_list {
     $size = $size || scalar(@values);
 
     my(%selected) = $self->previous_or_default($name,$defaults,$override);
-    my($is_multiple) = $multiple ? qq/ multiple="yes"/ : '';
+    my($is_multiple) = $multiple ? qq/ multiple/ : '';
     my($has_size) = $size ? qq/ size="$size"/: '';
     my($other) = @other ? " @other" : '';
 
     $name=$self->escapeHTML($name);
     $result = qq/<select name="$name"$has_size$is_multiple$other>\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(<input type="hidden" name="$name" value="$_" />)
-                            : qq/<input type="hidden" name="$name" value="$_">/);
+       push @result,$XHTMl ? qq(<input type="hidden" name="$name" value="$_" />)
+                            : qq(<input type="hidden" name="$name" value="$_">);
     }
     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<url()> 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<server_port ()>
+
+Return the port that the server is listening on.
+
 =item B<server_software ()>
 
 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 (executable)
--- 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(<form method="GET" action="foobar" enctype="application/x-www-form-urlencoded">\n),
+test(2,start_form(-action=>'foobar',-method=>'get') eq 
+     qq(<form method="get" action="foobar" enctype="application/x-www-form-urlencoded">\n),
      "start_form()");
 
 test(3,submit() eq qq(<input type="submit" name=".submit" />),"submit()");
@@ -51,32 +51,31 @@ test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq
      qq(<input type="checkbox" name="weather" value="nice" />forecast),
      "checkbox()");
 test(11,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast',-checked=>1,-override=>1) eq 
-     qq(<input type="checkbox" name="weather" value="nice" checked="yes" />forecast),
+     qq(<input type="checkbox" name="weather" value="nice" checked />forecast),
      "checkbox()");
 test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq 
-     qq(<input type="checkbox" name="weather" value="dull" checked="yes" />forecast),
+     qq(<input type="checkbox" name="weather" value="dull" checked />forecast),
      "checkbox()");
 
 test(13,radio_group(-name=>'game') eq 
-     qq(<input type="radio" name="game" value="chess" checked="yes" />chess <input type="radio" name="game" value="checkers" />checkers),
+     qq(<input type="radio" name="game" value="chess" checked />chess <input type="radio" name="game" value="checkers" />checkers),
      'radio_group()');
 test(14,radio_group(-name=>'game',-labels=>{'chess'=>'ping pong'}) eq 
-     qq(<input type="radio" name="game" value="chess" checked="yes" />ping pong <input type="radio" name="game" value="checkers" />checkers),
+     qq(<input type="radio" name="game" value="chess" checked />ping pong <input type="radio" name="game" value="checkers" />checkers),
      'radio_group()');
 
 test(15, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/]) eq 
-     qq(<input type="checkbox" name="game" value="checkers" checked="yes" />checkers <input type="checkbox" name="game" value="chess" checked="yes" />chess <input type="checkbox" name="game" value="cribbage" />cribbage),
+     qq(<input type="checkbox" name="game" value="checkers" checked />checkers <input type="checkbox" name="game" value="chess" checked />chess <input type="checkbox" name="game" value="cribbage" />cribbage),
      'checkbox_group()');
 
 test(16, checkbox_group(-name=>'game',-values=>[qw/checkers chess cribbage/],-defaults=>['cribbage'],-override=>1) eq 
-     qq(<input type="checkbox" name="game" value="checkers" />checkers <input type="checkbox" name="game" value="chess" />chess <input type="checkbox" name="game" value="cribbage" checked="yes" />cribbage),
+     qq(<input type="checkbox" name="game" value="checkers" />checkers <input type="checkbox" name="game" value="chess" />chess <input type="checkbox" name="game" value="cribbage" checked />cribbage),
      'checkbox_group()');
-
 test(17, popup_menu(-name=>'game',-values=>[qw/checkers chess cribbage/],-default=>'cribbage',-override=>1) eq <<END,'checkbox_group()');
 <select name="game">
 <option  value="checkers">checkers</option>
 <option  value="chess">chess</option>
-<option selected="yes" value="cribbage">cribbage</option>
+<option selected value="cribbage">cribbage</option>
 </select>
 END
 
diff --git a/t/lib/cgi-html.t b/t/lib/cgi-html.t
index 2d71ff6..21bbcfb 100755 (executable)
--- 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 <<END,"start_html()");
-<!DOCTYPE HTML
+<!DOCTYPE html
        PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
        "DTD/xhtml1-transitional.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
@@ -58,14 +67,14 @@ test(13,start_html() ."\n" eq <<END,"start_html()");
 END
     ;
 test(14,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR") ."\n" eq <<END,"start_html()");
-<!DOCTYPE HTML
+<!DOCTYPE html
        PUBLIC "-//IETF//DTD HTML 3.2//FR">
 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
 </head><body>
 END
     ;
 test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
-<!DOCTYPE HTML
+<!DOCTYPE html
        PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
        "DTD/xhtml1-transitional.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>The world of foo</title>
@@ -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 '<h3>');
 test(19,end_h3 eq '</h3>');
Unnamed repository; edit this file to name it for gitweb.