Permalink
Browse files

Version 2.70

  • Loading branch information...
1 parent f0b284b commit 18516e510e745b7f2035e4b257bd5984c1b16f79 lstein committed Aug 13, 2000
Showing with 40 additions and 20 deletions.
  1. +13 −13 CGI.pm
  2. +1 −1 CGI/Cookie.pm
  3. +11 −2 cgi_docs.html
  4. +12 −2 t/function.t
  5. +3 −2 t/html.t
View
26 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.39 2000-07-28 03:00:03 lstein Exp $';
-$CGI::VERSION='2.69';
+$CGI::revision = '$Id: CGI.pm,v 1.40 2000-08-13 15:07:04 lstein Exp $';
+$CGI::VERSION='2.70';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -1162,7 +1162,7 @@ sub header {
# need to fix it up a little.
foreach (@other) {
next unless my($header,$value) = /([^\s=]+)=\"?(.+?)\"?$/;
- ($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ': '.unescapeHTML($value)/e;
+ ($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ': '.$self->unescapeHTML($value)/e;
}
$type ||= 'text/html' unless defined($type);
@@ -1228,7 +1228,7 @@ END_OF_FUNC
sub redirect {
my($self,@p) = self_or_default(@_);
my($url,$target,$cookie,$nph,@other) = rearrange([[LOCATION,URI,URL],TARGET,COOKIE,NPH],@p);
- $url = $url || $self->self_url;
+ $url ||= $self->self_url;
my(@o);
foreach (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
unshift(@o,
@@ -1275,7 +1275,7 @@ sub start_html {
$lang ||= 'en-US';
my(@result);
if ($dtd) {
- if (ref $dtd && $ref eq 'ARRAY') {
+ if (defined(ref($dtd)) and (ref($dtd) eq 'ARRAY')) {
$dtd = $DEFAULT_DTD unless $dtd->[0] =~ m|^-//|;
} else {
$dtd = $DEFAULT_DTD unless $dtd =~ m|^-//|;
@@ -1448,7 +1448,8 @@ sub startform {
$method = uc($method) || 'POST';
$enctype = $enctype || &URL_ENCODED;
- $action = $action ? qq(action="$action") : qq 'action="' . $self->script_name . '"';
+ $action = $action ? qq(action="$action") : qq 'action="' .
+ $self->url(-absolute=>1,-path=>1,-query=>1) . '"';
my($other) = @other ? " @other" : '';
$self->{'.parametersToAdd'}={};
return qq/<form method="$method" $action enctype="$enctype"$other>\n/;
@@ -1869,8 +1870,7 @@ END_OF_FUNC
sub unescapeHTML {
my ($self,$string) = CGI::self_or_default(@_);
return undef unless defined($string);
- my $latin = uc $self->{'.charset'} eq 'ISO-8859-1' or
- uc $self->{'.charset'} eq 'WINDOWS-1252';
+ my $latin = $self->{'.charset'} =~ /^(ISO-8859-1|WINDOWS-1252)$/i;
# thanks to Randal Schwartz for the correct solution to this one
$string=~ s[&(.*?);]{
local $_ = $1;
@@ -2075,8 +2075,8 @@ sub scrolling_list {
$size = $size || scalar(@values);
my(%selected) = $self->previous_or_default($name,$defaults,$override);
- my($is_multiple) = $multiple ? qq/multiple="yes"/ : '';
- my($has_size) = $size ? " size=$size" : '';
+ my($is_multiple) = $multiple ? qq/ multiple="yes"/ : '';
+ my($has_size) = $size ? qq/ size="$size"/: '';
my($other) = @other ? " @other" : '';
$name=$self->escapeHTML($name);
@@ -2811,7 +2811,7 @@ sub read_multipart {
my($param)= $header{'Content-Disposition'}=~/ name="?([^\";]*)"?/;
# Bug: Netscape doesn't escape quotation marks in file names!!!
- my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\";]*)"?/;
+ my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\"]*)"?/;
# add this parameter to our list
$self->add_parameter($param);
@@ -3727,13 +3727,13 @@ the keys are the names of the CGI parameters, and the values are the
parameters' values. The Vars() method does this. Called in a scalar
context, it returns the parameter list as a tied hash reference.
Changing a key changes the value of the parameter in the underlying
-CGI parameter list. Called in an array context, it returns the
+CGI parameter list. Called in a list context, it returns the
parameter list as an ordinary hash. This allows you to read the
contents of the parameter list, but not to change it.
When using this, the thing you must watch out for are multivalued CGI
parameters. Because a hash cannot distinguish between scalar and
-array context, multivalued parameters will be returned as a packed
+list context, multivalued parameters will be returned as a packed
string, separated by the "\0" (null) character. You must split this
packed string in order to get at the individual values. This is the
convention introduced long ago by Steve Brenner in his cgi-lib.pl
View
@@ -384,7 +384,7 @@ Get or set the cookie's value. Example:
$value = $c->value;
@new_value = $c->value(['a','b','c','d']);
-B<value()> is context sensitive. In an array context it will return
+B<value()> is context sensitive. In a list context it will return
the current value of the cookie as an array. In a scalar context it
will return the B<first> value of a multivalued cookie.
View
@@ -6,7 +6,7 @@
<BODY bgcolor="#FFFFFF">
<H1><IMG SRC="examples/dna.small.gif" ALT="[logo]">
CGI.pm - a Perl5 CGI Library</H1>
-Version 2.69, 7/27/2000, L. Stein
+Version 2.70, 8/4/2000, L. Stein
<p>
<H2>Abstract</H2> This perl 5 library uses objects to create Web
@@ -4644,6 +4644,15 @@
<H2><A NAME="new">Revision History</A></H2>
+
+<h3>Version 2.70</h3>
+<p>
+August 4, 2000
+<ol>
+ <li>Fixed bug in scrolling_list() which omitted a space in front of the "multiple" attribute.
+ <li>Squashed the "useless use of string in void context" message from redirects.
+</ol>
+
<h3>Version 2.69</h3>
<ol>
<li>startform() now creates default ACTION for POSTs as well as GETs.
@@ -5481,6 +5490,6 @@
<a href="http://www.cshl.org/">Cold Spring Harbor Laboratory</a></ADDRESS>
<P>
<!-- hhmts start -->
-Last modified: Thu Jul 27 22:59:03 EDT 2000
+Last modified: Fri Aug 4 15:36:23 EDT 2000
<!-- hhmts end -->
</BODY> </HTML>
View
@@ -22,6 +22,15 @@ sub test {
my $CRLF = "\015\012";
+# A peculiarity of sending "\n" through MBX|Socket|web-server on VMS
+# is that a CR character gets inserted automatically in the web server
+# case but not internal to perl's double quoted strings "\n". This
+# test would need to be modified to use the "\015\012" on VMS if it
+# were actually run through a web server.
+# Thanks to Peter Prymmer for this
+
+if ($^O eq 'VMS') { $CRLF = "\n"; }
+
# Set up a CGI environment
$ENV{REQUEST_METHOD}='GET';
$ENV{QUERY_STRING} ='game=chess&game=checkers&weather=dull';
@@ -76,11 +85,12 @@ if ($Config{d_fork}) {
}
# at this point, we're in a new (child) process
test(23,param('weather') eq 'nice',"CGI::param() from POST");
- test(24,url_param('big_balls') eq 'basketball',"CGI::url_param()");
+ test(24,(url_param('big_balls') eq 'basketball'),"CGI::url_param()");
} else {
print "ok 23 # Skip\n";
print "ok 24 # Skip\n";
}
test(25,redirect('http://somewhere.else') eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
-test(26,redirect(-Location=>'http://somewhere.else',-Type=>'text/html') eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+my $h = redirect(-Location=>'http://somewhere.else',-Type=>'text/html');
+test(26,$h eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Moved${CRLF}location: http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
View
@@ -60,8 +60,9 @@ test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
END
;
test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()");
-test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; path=/\015\012Date:.*\015\012Content-Type: text/html\015\012\015\012!s,
- "header(-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,
+ "header(-cookie)");
test(18,start_h3 eq '<h3>');
test(19,end_h3 eq '</h3>');
test(20,start_table({-border=>undef}) eq '<table border>');

0 comments on commit 18516e5

Please sign in to comment.