r22177 - in /branches/upstream/libcgi-pm-perl/current: CGI.pm Changes META.yml debian/ t/start_end_asterisk.t t/start_end_end.t t/start_end_start.t
yvesago-guest at users.alioth.debian.org
yvesago-guest at users.alioth.debian.org
Thu Jun 26 08:06:28 UTC 2008
Author: yvesago-guest
Date: Thu Jun 26 08:06:27 2008
New Revision: 22177
URL: http://svn.debian.org/wsvn/?sc=1&rev=22177
Log:
[svn-upgrade] Integrating new upstream version, libcgi-pm-perl (3.38)
Removed:
branches/upstream/libcgi-pm-perl/current/debian/
branches/upstream/libcgi-pm-perl/current/t/start_end_asterisk.t
branches/upstream/libcgi-pm-perl/current/t/start_end_end.t
branches/upstream/libcgi-pm-perl/current/t/start_end_start.t
Modified:
branches/upstream/libcgi-pm-perl/current/CGI.pm
branches/upstream/libcgi-pm-perl/current/Changes
branches/upstream/libcgi-pm-perl/current/META.yml
Modified: branches/upstream/libcgi-pm-perl/current/CGI.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libcgi-pm-perl/current/CGI.pm?rev=22177&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/CGI.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/CGI.pm Thu Jun 26 08:06:27 2008
@@ -18,8 +18,8 @@
# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.251 2008/04/23 13:08:23 lstein Exp $';
-$CGI::VERSION='3.37';
+$CGI::revision = '$Id: CGI.pm,v 1.254 2008/06/25 14:52:19 lstein Exp $';
+$CGI::VERSION='3.38';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -227,7 +227,7 @@
tt u i b blockquote pre img a address cite samp dfn html head
base body Link nextid title meta kbd start_html end_html
input Select option comment charset escapeHTML/],
- ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param
+ ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param nobr
embed basefont style span layer ilayer font frameset frame script small big Area Map/],
':html4'=>[qw/abbr acronym bdo col colgroup del fieldset iframe
ins label legend noframes noscript object optgroup Q
@@ -440,15 +440,15 @@
# If values is provided, then we set it.
if (@values or defined $value) {
$self->add_parameter($name);
- $self->{$name}=[@values];
+ $self->{param}{$name}=[@values];
}
} else {
$name = $p[0];
}
- return unless defined($name) && $self->{$name};
-
- my @result = @{$self->{$name}};
+ return unless defined($name) && $self->{param}{$name};
+
+ my @result = @{$self->{param}{$name}};
if ($PARAM_UTF8) {
eval "require Encode; 1;" unless Encode->can('decode'); # bring in these functions
@@ -576,14 +576,14 @@
$self->add_parameter($param);
$self->read_from_client(\$value,$content_length,0)
if $content_length > 0;
- push (@{$self->{$param}},$value);
+ push (@{$self->{param}{$param}},$value);
$is_xforms = 1;
} elsif ($ENV{'CONTENT_TYPE'} =~ /multipart\/related.+boundary=\"?([^\";,]+)\"?.+start=\"?\<?([^\"\>]+)\>?\"?/) {
my($boundary,$start) = ($1,$2);
my($param) = 'XForms:Model';
$self->add_parameter($param);
my($value) = $self->read_multipart_related($start,$boundary,$content_length,0);
- push (@{$self->{$param}},$value);
+ push (@{$self->{param}{$param}},$value);
if ($MOD_PERL) {
$query_string = $self->r->args;
} else {
@@ -675,7 +675,7 @@
&& $ENV{'CONTENT_TYPE'} !~ m|^multipart/form-data| ) {
my($param) = $meth . 'DATA' ;
$self->add_parameter($param) ;
- push (@{$self->{$param}},$query_string);
+ push (@{$self->{param}{$param}},$query_string);
undef $query_string ;
}
# YL: End Change for XML handler 10/19/2001
@@ -687,7 +687,7 @@
$self->parse_params($query_string);
} else {
$self->add_parameter('keywords');
- $self->{'keywords'} = [$self->parse_keywordlist($query_string)];
+ $self->{param}{'keywords'} = [$self->parse_keywordlist($query_string)];
}
}
@@ -754,7 +754,7 @@
@QUERY_PARAM = $self->param; # save list of parameters
foreach (@QUERY_PARAM) {
next unless defined $_;
- $QUERY_PARAM{$_}=$self->{$_};
+ $QUERY_PARAM{$_}=$self->{param}{$_};
}
$QUERY_CHARSET = $self->charset;
%QUERY_FIELDNAMES = %{$self->{'.fieldnames'}};
@@ -773,7 +773,7 @@
$param = unescape($param);
$value = unescape($value);
$self->add_parameter($param);
- push (@{$self->{$param}},$value);
+ push (@{$self->{param}{$param}},$value);
}
}
@@ -781,7 +781,7 @@
my($self,$param)=@_;
return unless defined $param;
push (@{$self->{'.parameters'}},$param)
- unless defined($self->{$param});
+ unless defined($self->{param}{$param});
}
sub all_parameters {
@@ -1008,7 +1008,7 @@
my %to_delete;
foreach my $name (@to_delete)
{
- CORE::delete $self->{$name};
+ CORE::delete $self->{param}{$name};
CORE::delete $self->{'.fieldnames'}->{$name};
$to_delete{$name}++;
}
@@ -1057,8 +1057,8 @@
sub keywords {
my($self, at values) = self_or_default(@_);
# If values is provided, then we set it.
- $self->{'keywords'}=[@values] if @values;
- my(@result) = defined($self->{'keywords'}) ? @{$self->{'keywords'}} : ();
+ $self->{param}{'keywords'}=[@values] if @values;
+ my(@result) = defined($self->{param}{'keywords'}) ? @{$self->{param}{'keywords'}} : ();
@result;
}
END_OF_FUNC
@@ -1203,7 +1203,7 @@
my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
if (@values) {
$self->add_parameter($name);
- push(@{$self->{$name}}, at values);
+ push(@{$self->{param}{$name}}, at values);
}
return $self->param($name);
}
@@ -1666,12 +1666,22 @@
: qq(<meta name="$_" content="$meta->{$_}">)); }
}
- push(@result,ref($head) ? @$head : $head) if $head;
+ my $meta_bits_set = 0;
+ if( $head ) {
+ if( ref $head ) {
+ push @result, @$head;
+ $meta_bits_set = 1 if grep { /http-equiv=["']Content-Type/i }@$head;
+ }
+ else {
+ push @result, $head;
+ $meta_bits_set = 1 if $head =~ /http-equiv=["']Content-Type/i;
+ }
+ }
# handle the infrequently-used -style and -script parameters
push(@result,$self->_style($style)) if defined $style;
push(@result,$self->_script($script)) if defined $script;
- push(@result,$meta_bits) if defined $meta_bits;
+ push(@result,$meta_bits) if defined $meta_bits and !$meta_bits_set;
# handle -noscript parameter
push(@result,<<END) if $noscript;
@@ -2437,12 +2447,14 @@
my($name,$values,$default,$labels,$attributes,$override,$tabindex, at other) =
rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,
ATTRIBUTES,[OVERRIDE,FORCE],TABINDEX], at p);
- my($result,$selected);
+ my($result,%selected);
if (!$override && defined($self->param($name))) {
- $selected = $self->param($name);
- } else {
- $selected = $default;
+ $selected{$self->param($name)}++;
+ } elsif ($default) {
+ %selected = map {$_=>1} ref($default) eq 'ARRAY'
+ ? @$default
+ : $default;
}
$name=$self->escapeHTML($name);
my($other) = @other ? " @other" : '';
@@ -2453,20 +2465,22 @@
$result = qq/<select name="$name" $tabindex$other>\n/;
foreach (@values) {
if (/<optgroup/) {
- foreach (split(/\n/)) {
+ for my $v (split(/\n/)) {
my $selectit = $XHTML ? 'selected="selected"' : 'selected';
- s/(value="$selected")/$selectit $1/ if defined $selected;
- $result .= "$_\n";
+ for my $selected (keys %selected) {
+ $v =~ s/(value="$selected")/$selectit $1/;
+ }
+ $result .= "$v\n";
}
}
else {
- my $attribs = $self->_set_attributes($_, $attributes);
- my($selectit) = defined($selected) ? $self->_selected($selected eq $_) : '';
- my($label) = $_;
- $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
- my($value) = $self->escapeHTML($_);
- $label=$self->escapeHTML($label,1);
- $result .= "<option${attribs} ${selectit}value=\"$value\">$label</option>\n";
+ my $attribs = $self->_set_attributes($_, $attributes);
+ my($selectit) = $self->_selected($selected{$_});
+ my($label) = $_;
+ $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
+ my($value) = $self->escapeHTML($_);
+ $label = $self->escapeHTML($label,1);
+ $result .= "<option${attribs} ${selectit}value=\"$value\">$label</option>\n";
}
}
@@ -2804,12 +2818,12 @@
sub param_fetch {
my($self, at p) = self_or_default(@_);
my($name) = rearrange([NAME], at p);
- unless (exists($self->{$name})) {
+ unless (exists($self->{param}{$name})) {
$self->add_parameter($name);
- $self->{$name} = [];
+ $self->{param}{$name} = [];
}
- return $self->{$name};
+ return $self->{param}{$name};
}
END_OF_FUNC
@@ -2942,7 +2956,9 @@
my($self,$search) = self_or_CGI(@_);
my(%prefs,$type,$pref,$pat);
- my(@accept) = split(',',$self->http('accept'));
+ my(@accept) = defined $self->http('accept')
+ ? split(',',$self->http('accept'))
+ : ();
foreach (@accept) {
($pref) = /q=(\d\.\d+|\d+)/;
@@ -3379,6 +3395,8 @@
return;
}
+ $header{'Content-Disposition'} ||= ''; # quench uninit variable warning
+
my($param)= $header{'Content-Disposition'}=~/ name="([^"]*)"/;
$param .= $TAINTED;
@@ -3387,6 +3405,9 @@
# content-disposition parsing fail.
my ($filename) = $header{'Content-Disposition'}
=~/ filename=(("[^"]*")|([a-z\d!\#'\*\+,\.^_\`\{\}\|\~]*))/i;
+
+ $filename ||= ''; # quench uninit variable warning
+
$filename =~ s/^"([^"]*)"$/$1/;
# Test for Opera's multiple upload feature
my($multipart) = ( defined( $header{'Content-Type'} ) &&
@@ -3401,7 +3422,7 @@
if ( ( !defined($filename) || $filename eq '' ) && !$multipart ) {
my($value) = $buffer->readBody;
$value .= $TAINTED;
- push(@{$self->{$param}},$value);
+ push(@{$self->{param}{$param}},$value);
next;
}
@@ -3477,7 +3498,7 @@
name => $tmpfile,
info => {%header},
};
- push(@{$self->{$param}},$filehandle);
+ push(@{$self->{param}{$param}},$filehandle);
}
}
}
@@ -3579,7 +3600,7 @@
name => $tmpfile,
info => {%header},
};
- push(@{$self->{$param}},$filehandle);
+ push(@{$self->{param}{$param}},$filehandle);
}
}
return $returnvalue;
@@ -4409,8 +4430,7 @@
the method will return a single value.
If a value is not given in the query string, as in the queries
-"name1=&name2=" or "name1&name2", it will be returned as an empty
-string. This feature is new in 2.63.
+"name1=&name2=", it will be returned as an empty string.
If the parameter does not exist at all, then param() will return undef
@@ -6133,7 +6153,7 @@
print popup_menu(-name=>'menu_name',
-values=>['eenie','meenie','minie'],
- -default=>'meenie',
+ -default=>['meenie','minie'],
-labels=>\%labels,
-attributes=>\%attributes);
@@ -6156,7 +6176,8 @@
The optional third parameter (-default) is the name of the default
menu choice. If not specified, the first item will be the default.
-The values of the previous choice will be maintained across queries.
+The values of the previous choice will be maintained across
+queries. Pass an array reference to select multiple defaults.
=item 4.
Modified: branches/upstream/libcgi-pm-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libcgi-pm-perl/current/Changes?rev=22177&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/Changes (original)
+++ branches/upstream/libcgi-pm-perl/current/Changes Thu Jun 26 08:06:27 2008
@@ -1,3 +1,14 @@
+ Version 3.38
+ 1. Fix annoying warning in http://rt.cpan.org/Ticket/Display.html?id=34551
+ 2. Added nobr() function http://rt.cpan.org/Ticket/Display.html?id=35377
+ 3. popup_menu() allows multiple items to be selected by default, satisfying
+ http://rt.cpan.org/Ticket/Display.html?id=35376
+ 4. Patch from Renee Backer to avoid doubled <http-equiv> headers.
+ 5. Fixed documentation bug that describes what happens when a
+ parameter is empty (e.g. "?test1=").
+ 6. Fixed minor warning described at http://rt.cpan.org/Public/Bug/Display.html?id=36435
+ 7. Fixed overlap of attribute and parameter space described in http://rt.perl.org/rt3//Ticket/Display.html?id=24294
+
Version 3.37
1. Fix pragmas so that they persist over modperl invocations (e.g. RT 34761)
2. Fixed handling of chunked multipart uploads; thanks to Michael Bernhardt
Modified: branches/upstream/libcgi-pm-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libcgi-pm-perl/current/META.yml?rev=22177&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/META.yml (original)
+++ branches/upstream/libcgi-pm-perl/current/META.yml Thu Jun 26 08:06:27 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CGI.pm
-version: 3.37
+version: 3.38
abstract: ~
license: ~
author: ~
More information about the Pkg-perl-cvs-commits
mailing list