r33084 - in /branches/upstream/libcgi-pm-perl/current: CGI.pm CGI/Util.pm Changes META.yml t/util-58.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun Apr 12 09:43:24 UTC 2009
Author: ansgar-guest
Date: Sun Apr 12 09:43:19 2009
New Revision: 33084
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=33084
Log:
[svn-upgrade] Integrating new upstream version, libcgi-pm-perl (3.43)
Modified:
branches/upstream/libcgi-pm-perl/current/CGI.pm
branches/upstream/libcgi-pm-perl/current/CGI/Util.pm
branches/upstream/libcgi-pm-perl/current/Changes
branches/upstream/libcgi-pm-perl/current/META.yml
branches/upstream/libcgi-pm-perl/current/t/util-58.t
Modified: branches/upstream/libcgi-pm-perl/current/CGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/CGI.pm?rev=33084&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/CGI.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/CGI.pm Sun Apr 12 09:43:19 2009
@@ -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.260 2008/09/08 14:13:23 lstein Exp $';
-$CGI::VERSION='3.42';
+$CGI::revision = '$Id: CGI.pm,v 1.263 2009/02/11 16:56:37 lstein Exp $';
+$CGI::VERSION='3.43';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -294,10 +294,10 @@
# To allow overriding, search through the packages
# Till we find one in which the correct subroutine is defined.
my @packages = ($self,@{"$self\:\:ISA"});
- foreach $sym (keys %EXPORT) {
+ for $sym (keys %EXPORT) {
my $pck;
my $def = ${"$self\:\:AutoloadClass"} || $DefaultClass;
- foreach $pck (@packages) {
+ for $pck (@packages) {
if (defined(&{"$pck\:\:$sym"})) {
$def = $pck;
last;
@@ -317,7 +317,7 @@
return ("start_$1","end_$1") if $tag=~/^(?:\*|start_|end_)(.+)/;
my(@r);
return ($tag) unless $EXPORT_TAGS{$tag};
- foreach (@{$EXPORT_TAGS{$tag}}) {
+ for (@{$EXPORT_TAGS{$tag}}) {
push(@r,&expand_tags($_));
}
return @r;
@@ -381,7 +381,7 @@
sub DESTROY {
my $self = shift;
if ($OS eq 'WINDOWS') {
- foreach my $href (values %{$self->{'.tmpfiles'}}) {
+ for my $href (values %{$self->{'.tmpfiles'}}) {
$href->{hndl}->DESTROY if defined $href->{hndl};
$href->{name}->DESTROY if defined $href->{name};
}
@@ -433,7 +433,7 @@
if (substr($p[0],0,1) eq '-') {
@values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : ();
} else {
- foreach ($value, at other) {
+ for ($value, at other) {
push(@values,$_) if defined($_);
}
}
@@ -488,7 +488,7 @@
# Initialize the query object from the environment.
# If a parameter list is found, this object will be set
-# to an associative array in which parameter names are keys
+# to a hash in which parameter names are keys
# and the values are stored as lists
# If a keyword list is found, this method creates a bogus
# parameter list with the single parameter 'keywords'.
@@ -603,7 +603,7 @@
last METHOD;
}
if (ref($initializer) && ref($initializer) eq 'HASH') {
- foreach (keys %$initializer) {
+ for (keys %$initializer) {
$self->param('-name'=>$_,'-value'=>$initializer->{$_});
}
last METHOD;
@@ -697,9 +697,9 @@
$self->delete_all();
}
- # Associative array containing our defined fieldnames
+ # hash containing our defined fieldnames
$self->{'.fieldnames'} = {};
- foreach ($self->param('.cgifields')) {
+ for ($self->param('.cgifields')) {
$self->{'.fieldnames'}->{$_}++;
}
@@ -752,7 +752,7 @@
# again, we initialize ourselves in exactly the same way. This allows
# us to have several of these objects.
@QUERY_PARAM = $self->param; # save list of parameters
- foreach (@QUERY_PARAM) {
+ for (@QUERY_PARAM) {
next unless defined $_;
$QUERY_PARAM{$_}=$self->{param}{$_};
}
@@ -765,7 +765,7 @@
my($self,$tosplit) = @_;
my(@pairs) = split(/[&;]/,$tosplit);
my($param,$value);
- foreach (@pairs) {
+ for (@pairs) {
($param,$value) = split('=',$_,2);
next unless defined $param;
next if $NO_UNDEF_PARAMS and not defined $value;
@@ -899,7 +899,7 @@
# to avoid reexporting unwanted variables
undef %EXPORT;
- foreach (@_) {
+ for (@_) {
$HEADERS_ONCE++, next if /^[:-]unique_headers$/;
$NPH++, next if /^[:-]nph$/;
$NOSTICKY++, next if /^[:-]nosticky$/;
@@ -928,7 +928,7 @@
next;
}
- foreach (&expand_tags($_)) {
+ for (&expand_tags($_)) {
tr/a-zA-Z0-9_//cd; # don't allow weird function names
$EXPORT{$_}++;
}
@@ -1006,7 +1006,7 @@
my(@names) = rearrange([NAME], at p);
my @to_delete = ref($names[0]) eq 'ARRAY' ? @$names[0] : @names;
my %to_delete;
- foreach my $name (@to_delete)
+ for my $name (@to_delete)
{
CORE::delete $self->{param}{$name};
CORE::delete $self->{'.fieldnames'}->{$name};
@@ -1028,7 +1028,7 @@
die "Can't import names into \"main\"\n" if \%{"${namespace}::"} == \%::;
if ($delete || $MOD_PERL || exists $ENV{'FCGI_ROLE'}) {
# can anyone find an easier way to do this?
- foreach (keys %{"${namespace}::"}) {
+ for (keys %{"${namespace}::"}) {
local *symbol = "${namespace}::${_}";
undef $symbol;
undef @symbol;
@@ -1036,7 +1036,7 @@
}
}
my($param, at value,$var);
- foreach $param ($self->param) {
+ for $param ($self->param) {
# protect against silly names
($var = $param)=~tr/a-zA-Z0-9_/_/c;
$var =~ s/^(?=\d)/_/;
@@ -1270,7 +1270,7 @@
if ($ENV{QUERY_STRING} =~ /=/) {
my(@pairs) = split(/[&;]/,$ENV{QUERY_STRING});
my($param,$value);
- foreach (@pairs) {
+ for (@pairs) {
($param,$value) = split('=',$_,2);
$param = unescape($param);
$value = unescape($value);
@@ -1298,11 +1298,11 @@
my($param,$value, at result);
return '<ul></ul>' unless $self->param;
push(@result,"<ul>");
- foreach $param ($self->param) {
+ for $param ($self->param) {
my($name)=$self->escapeHTML($param);
push(@result,"<li><strong>$param</strong></li>");
push(@result,"<ul>");
- foreach $value ($self->param($param)) {
+ for $value ($self->param($param)) {
$value = $self->escapeHTML($value);
$value =~ s/\n/<br \/>\n/g;
push(@result,"<li>$value</li>");
@@ -1335,14 +1335,14 @@
my($param);
local($,) = ''; # set print field separator back to a sane value
local($\) = ''; # set output line separator to a sane value
- foreach $param ($self->param) {
+ for $param ($self->param) {
my($escaped_param) = escape($param);
my($value);
- foreach $value ($self->param($param)) {
+ for $value ($self->param($param)) {
print $filehandle "$escaped_param=",escape("$value"),"\n";
}
}
- foreach (keys %{$self->{'.fieldnames'}}) {
+ for (keys %{$self->{'.fieldnames'}}) {
print $filehandle ".cgifields=",escape("$_"),"\n";
}
print $filehandle "=\n"; # end of record
@@ -1411,7 +1411,7 @@
# rearrange() was designed for the HTML portion, so we
# need to fix it up a little.
- foreach (@other) {
+ for (@other) {
# Don't use \s because of perl bug 21951
next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ': '.$self->unescapeHTML($value)/e;
@@ -1480,7 +1480,7 @@
# rearrange() was designed for the HTML portion, so we
# need to fix it up a little.
- foreach (@other) {
+ for (@other) {
# Don't use \s because of perl bug 21951
next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e;
@@ -1506,7 +1506,7 @@
# push all the cookies -- there may be several
if ($cookie) {
my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie;
- foreach (@cookie) {
+ for (@cookie) {
my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_;
push(@header,"Set-Cookie: $cs") if $cs ne '';
}
@@ -1559,7 +1559,7 @@
$status = '302 Found' unless defined $status;
$url ||= $self->self_url;
my(@o);
- foreach (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
+ for (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
unshift(@o,
'-Status' => $status,
'-Location'=> $url,
@@ -1662,7 +1662,7 @@
}
if ($meta && ref($meta) && (ref($meta) eq 'HASH')) {
- foreach (keys %$meta) { push(@result,$XHTML ? qq(<meta name="$_" content="$meta->{$_}" />)
+ for (keys %$meta) { push(@result,$XHTML ? qq(<meta name="$_" content="$meta->{$_}" />)
: qq(<meta name="$_" content="$meta->{$_}">)); }
}
@@ -1726,7 +1726,7 @@
if (ref($src) eq "ARRAY") # Check to see if the $src variable is an array reference
{ # If it is, push a LINK tag for each one
- foreach $src (@$src)
+ for $src (@$src)
{
push(@result,$XHTML ? qq(<link rel="$rel" type="$type" href="$src" $other/>)
: qq(<link rel="$rel" type="$type" href="$src"$other>)) if $src;
@@ -1740,10 +1740,10 @@
}
if ($verbatim) {
my @v = ref($verbatim) eq 'ARRAY' ? @$verbatim : $verbatim;
- push(@result, "<style type=\"text/css\">\n$_\n</style>") foreach @v;
+ push(@result, "<style type=\"text/css\">\n$_\n</style>") for @v;
}
my @c = ref($code) eq 'ARRAY' ? @$code : $code if $code;
- push(@result,style({'type'=>$type},"$cdata_start\n$_\n$cdata_end")) foreach @c;
+ push(@result,style({'type'=>$type},"$cdata_start\n$_\n$cdata_end")) for @c;
} else {
my $src = $s;
@@ -1761,7 +1761,7 @@
my (@result);
my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script);
- foreach $script (@scripts) {
+ for $script (@scripts) {
my($src,$code,$language);
if (ref($script)) { # script is a hash
($src,$code,$type) =
@@ -2269,7 +2269,7 @@
my($row,$column);
unshift(@colheaders,'') if @colheaders && @rowheaders;
$result .= "<tr>" if @colheaders;
- foreach (@colheaders) {
+ for (@colheaders) {
$result .= "<th>$_</th>";
}
for ($row=0;$row<$rows;$row++) {
@@ -2298,7 +2298,7 @@
# $linebreak -> (optional) Set to true to place linebreaks
# between the buttons.
# $labels -> (optional)
-# A pointer to an associative array of labels to print next to each checkbox
+# A pointer to a hash of labels to print next to each checkbox
# in the form $label{'value'}="Long explanatory label".
# Otherwise the provided values are used as the labels.
# Returns:
@@ -2326,7 +2326,7 @@
# $linebreak -> (optional) Set to true to place linebreaks
# between the buttons.
# $labels -> (optional)
-# A pointer to an associative array of labels to print next to each checkbox
+# A pointer to a hash of labels to print next to each checkbox
# in the form $label{'value'}="Long explanatory label".
# Otherwise the provided values are used as the labels.
# Returns:
@@ -2380,11 +2380,11 @@
# for disabling groups of radio/checkbox buttons
my %disabled;
- foreach (@{$disabled}) {
+ for (@{$disabled}) {
$disabled{$_}=1;
}
- foreach (@values) {
+ for (@values) {
my $disable="";
if ($disabled{$_}) {
$disable="disabled='1'";
@@ -2434,7 +2434,7 @@
# text of each menu item.
# $default -> (optional) Default item to display
# $labels -> (optional)
-# A pointer to an associative array of labels to print next to each checkbox
+# A pointer to a hash of labels to print next to each checkbox
# in the form $label{'value'}="Long explanatory label".
# Otherwise the provided values are used as the labels.
# Returns:
@@ -2463,7 +2463,7 @@
@values = $self->_set_values_and_labels($values,\$labels,$name);
$tabindex = $self->element_tab($tabindex);
$result = qq/<select name="$name" $tabindex$other>\n/;
- foreach (@values) {
+ for (@values) {
if (/<optgroup/) {
for my $v (split(/\n/)) {
my $selectit = $XHTML ? 'selected="selected"' : 'selected';
@@ -2497,7 +2497,7 @@
# $values -> A pointer to a regular array containing the
# values for each option line in the group.
# $labels -> (optional)
-# A pointer to an associative array of labels to print next to each item
+# A pointer to a hash of labels to print next to each item
# in the form $label{'value'}="Long explanatory label".
# Otherwise the provided values are used as the labels.
# $labeled -> (optional)
@@ -2524,9 +2524,9 @@
$name=$self->escapeHTML($name);
$result = qq/<optgroup label="$name"$other>\n/;
- foreach (@values) {
+ for (@values) {
if (/<optgroup/) {
- foreach (split(/\n/)) {
+ for (split(/\n/)) {
my $selectit = $XHTML ? 'selected="selected"' : 'selected';
s/(value="$selected")/$selectit $1/ if defined $selected;
$result .= "$_\n";
@@ -2564,7 +2564,7 @@
# $size -> (optional) Size of the list.
# $multiple -> (optional) If set, allow multiple selections.
# $labels -> (optional)
-# A pointer to an associative array of labels to print next to each checkbox
+# A pointer to a hash of labels to print next to each checkbox
# in the form $label{'value'}="Long explanatory label".
# Otherwise the provided values are used as the labels.
# Returns:
@@ -2591,7 +2591,7 @@
$name=$self->escapeHTML($name);
$tabindex = $self->element_tab($tabindex);
$result = qq/<select name="$name" $tabindex$has_size$is_multiple$other>\n/;
- foreach (@values) {
+ for (@values) {
my($selectit) = $self->_selected($selected{$_});
my($label) = $_;
$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
@@ -2631,7 +2631,7 @@
@value = ref($default) ? @{$default} : $default;
$do_override = $override;
} else {
- foreach ($default,$override, at other) {
+ for ($default,$override, at other) {
push(@value,$_) if defined($_);
}
}
@@ -2641,7 +2641,7 @@
@value = @prev if !$do_override && @prev;
$name=$self->escapeHTML($name);
- foreach (@value) {
+ for (@value) {
$_ = defined($_) ? $self->escapeHTML($_,1) : '';
push @result,$XHTML ? qq(<input type="hidden" name="$name" value="$_" @other />)
: qq(<input type="hidden" name="$name" value="$_" @other>);
@@ -2953,15 +2953,15 @@
sub query_string {
my($self) = self_or_default(@_);
my($param,$value, at pairs);
- foreach $param ($self->param) {
+ for $param ($self->param) {
my($eparam) = escape($param);
- foreach $value ($self->param($param)) {
+ for $value ($self->param($param)) {
$value = escape($value);
next unless defined $value;
push(@pairs,"$eparam=$value");
}
}
- foreach (keys %{$self->{'.fieldnames'}}) {
+ for (keys %{$self->{'.fieldnames'}}) {
push(@pairs,".cgifields=".escape("$_"));
}
return join($USE_PARAM_SEMICOLONS ? ';' : '&', at pairs);
@@ -2989,7 +2989,7 @@
? split(',',$self->http('accept'))
: ();
- foreach (@accept) {
+ for (@accept) {
($pref) = /q=(\d\.\d+|\d+)/;
($type) = m#(\S+/[^;]+)#;
next unless $type;
@@ -3008,7 +3008,7 @@
return $prefs{$search} if $prefs{$search};
# Didn't get it, so try pattern matching.
- foreach (keys %prefs) {
+ for (keys %prefs) {
next unless /\*/; # not a pattern match
($pat = $_) =~ s/([^\w*])/\\$1/g; # escape meta characters
$pat =~ s/\*/.*/g; # turn it into a pattern
@@ -3189,7 +3189,7 @@
$parameter =~ tr/-/_/;
return $ENV{"HTTP_\U$parameter\E"} if $parameter;
my(@p);
- foreach (keys %ENV) {
+ for (keys %ENV) {
push(@p,$_) if /^HTTP/;
}
return @p;
@@ -3208,7 +3208,7 @@
$parameter =~ tr/-/_/;
return $ENV{"HTTPS_\U$parameter\E"} if $parameter;
my(@p);
- foreach (keys %ENV) {
+ for (keys %ENV) {
push(@p,$_) if /^HTTPS/;
}
return @p;
@@ -3382,7 +3382,7 @@
$input = join(" ", at lines);
@words = &shellwords($input);
}
- foreach (@words) {
+ for (@words) {
s/\\=/%3D/g;
s/\\&/%26/g;
}
@@ -3488,7 +3488,7 @@
# together with the body for later parsing with an external
# MIME parser module
if ( $multipart ) {
- foreach ( keys %header ) {
+ for ( keys %header ) {
print $filehandle "$_: $header{$_}${CRLF}";
}
print $filehandle "${CRLF}";
@@ -3681,7 +3681,7 @@
my($element, $attributes) = @_;
return '' unless defined($attributes->{$element});
$attribs = ' ';
- foreach my $attrib (keys %{$attributes->{$element}}) {
+ for my $attrib (keys %{$attributes->{$element}}) {
(my $clean_attrib = $attrib) =~ s/^-//;
$attribs .= "@{[lc($clean_attrib)]}=\"$attributes->{$element}{$attrib}\" ";
}
@@ -3692,7 +3692,7 @@
'_compile_all' => <<'END_OF_FUNC',
sub _compile_all {
- foreach (@_) {
+ for (@_) {
next if defined(&$_);
$AUTOLOAD = "CGI::$_";
_compile();
@@ -4079,7 +4079,7 @@
# : Refer to getpwuid() only at run-time if we're fortunate and have UNIX.
# unshift(@TEMP,(eval {(getpwuid($>))[7]}).'/tmp') if $CGI::OS eq 'UNIX' and $> != 0;
- foreach (@TEMP) {
+ for (@TEMP) {
do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
}
}
@@ -4157,65 +4157,51 @@
=head1 NAME
-CGI - Simple Common Gateway Interface Class
+CGI - Handle Common Gateway Interface requests and responses
=head1 SYNOPSIS
- # CGI script that creates a fill-out form
- # and echoes back its values.
-
- use CGI qw/:standard/;
- print header,
- start_html('A Simple Example'),
- h1('A Simple Example'),
- start_form,
- "What's your name? ",textfield('name'),p,
- "What's the combination?", p,
- checkbox_group(-name=>'words',
- -values=>['eenie','meenie','minie','moe'],
- -defaults=>['eenie','minie']), p,
- "What's your favorite color? ",
- popup_menu(-name=>'color',
- -values=>['red','green','blue','chartreuse']),p,
- submit,
- end_form,
- hr;
-
- if (param()) {
- my $name = param('name');
- my $keywords = join ', ',param('words');
- my $color = param('color');
- print "Your name is",em(escapeHTML($name)),p,
- "The keywords are: ",em(escapeHTML($keywords)),p,
- "Your favorite color is ",em(escapeHTML($color)),
- hr;
- }
-
- print end_html;
-
-=head1 ABSTRACT
-
-This perl library uses perl5 objects to make it easy to create Web
-fill-out forms and parse their contents. This package defines CGI
-objects, entities that contain the values of the current query string
-and other state variables. Using a CGI object's methods, you can
-examine keywords and parameters passed to your script, and create
-forms whose initial values are taken from the current query (thereby
-preserving state information). The module provides shortcut functions
-that produce boilerplate HTML, reducing typing and coding errors. It
-also provides functionality for some of the more advanced features of
-CGI scripting, including support for file uploads, cookies, cascading
-style sheets, server push, and frames.
-
-CGI.pm also provides a simple function-oriented programming style for
-those who don't need its object-oriented features.
-
-The current version of CGI.pm is available at
-
- http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
- ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+ use CGI;
+
+ my $q = CGI->new;
+
+ # Process an HTTP request
+ @values = $q->param('form_field');
+
+ $fh = $q->upload('file_field');
+
+ $riddle = $query->cookie('riddle_name');
+ %answers = $query->cookie('answers');
+
+ # Prepare various HTTP responses
+ print $q->header();
+ print $q->header('application/json');
+
+ $cookie1 = $q->cookie(-name=>'riddle_name', -value=>"The Sphynx's Question");
+ $cookie2 = $q->cookie(-name=>'answers', -value=>\%answers);
+ print $q->header(
+ -type => 'image/gif',
+ -expires => '+3d',
+ -cookie => [$cookie1,$cookie2]
+ );
+
+ print $q->redirect('http://somewhere.else/in/movie/land');
=head1 DESCRIPTION
+
+CGI.pm is a stable, complete and mature solution for processing and preparing
+HTTP requests and responses. Major features including processing form
+submissions, file uploads, reading and writing cookies, query string generation
+and manipulation, and processing and preparing HTTP headers. Some HTML
+generation utilities are included as well.
+
+CGI.pm performs very well in in a vanilla CGI.pm environment and also comes
+with built-in support for mod_perl and mod_perl2 as well as FastCGI.
+
+It has the benefit of having developed and refined over 10 years with input
+from dozens of contributors and being deployed on thousands of websites.
+CGI.pm has been included in the Perl distribution since Perl 5.4, and has
+become a de-facto standard.
=head2 PROGRAMMING STYLE
@@ -4411,7 +4397,7 @@
restore_parameters(IN);
close IN;
-You can also initialize the query object from an associative array
+You can also initialize the query object from a hash
reference:
$query = new CGI( {'dinosaur'=>'barney',
@@ -4641,7 +4627,7 @@
open (OUT,">>test.out") || die;
$records = 5;
- foreach (0..$records) {
+ for (0..$records) {
my $q = new CGI;
$q->param(-name=>'counter',-value=>$_);
$q->save(\*OUT);
@@ -5226,7 +5212,7 @@
All relative links will be interpreted relative to this tag.
You add arbitrary meta information to the header with the B<-meta>
-argument. This argument expects a reference to an associative array
+argument. This argument expects a reference to a hash
containing name/value pairs of meta information. These will be turned
into a series of header <meta> tags that look something like this:
@@ -5565,8 +5551,8 @@
print h1("Chapter","1"); # <h1>Chapter 1</h1>"
-If the first argument is an associative array reference, then the keys
-and values of the associative array become the HTML tag's attributes:
+If the first argument is a hash reference, then the keys
+and values of the hash become the HTML tag's attributes:
print a({-href=>'fred.html',-target=>'_new'},
"Open a new frame");
@@ -6111,7 +6097,7 @@
usually includes the MIME content type. Future browsers may send
other information as well (such as modification date and size). To
retrieve this information, call uploadInfo(). It returns a reference to
-an associative array containing all the document headers.
+a hash containing all the document headers.
$filename = param('uploaded_file');
$type = uploadInfo($filename)->{'Content-Type'};
@@ -6233,7 +6219,7 @@
The optional fourth parameter (-labels) is provided for people who
want to use different values for the user-visible label inside the
popup menu and the value returned to your script. It's a pointer to an
-associative array relating menu values to user-visible labels. If you
+hash relating menu values to user-visible labels. If you
leave this parameter blank, the menu values will be displayed by
default. (You can also leave a label undefined if you want to).
@@ -6241,8 +6227,8 @@
The optional fifth parameter (-attributes) is provided to assign
any of the common HTML attributes to an individual menu item. It's
-a pointer to an associative array relating menu values to another
-associative array with the attribute's name as the key and the
+a pointer to a hash relating menu values to another
+hash with the attribute's name as the key and the
attribute's value as the value.
=back
@@ -6294,7 +6280,7 @@
=item 3.
The optional third parameter (B<-labels>) allows you to pass a reference
-to an associative array containing user-visible labels for one or more
+to a hash containing user-visible labels for one or more
of the menu items. You can use this when you want the user to see one
menu string, but have the browser return your program a different one.
If you don't specify this, the value string will be used instead
@@ -6321,8 +6307,8 @@
An optional sixth parameter (-attributes) is provided to assign
any of the common HTML attributes to an individual menu item. It's
-a pointer to an associative array relating menu values to another
-associative array with the attribute's name as the key and the
+a pointer to a hash relating menu values to another
+hash with the attribute's name as the key and the
attribute's value as the value.
=back
@@ -6382,7 +6368,7 @@
=item 5.
-The optional sixth argument is a pointer to an associative array
+The optional sixth argument is a pointer to a hash
containing long user-visible labels for the list items (-labels).
If not provided, the values will be displayed.
@@ -6390,8 +6376,8 @@
The optional sixth parameter (-attributes) is provided to assign
any of the common HTML attributes to an individual menu item. It's
-a pointer to an associative array relating menu values to another
-associative array with the attribute's name as the key and the
+a pointer to a hash relating menu values to another
+hash with the attribute's name as the key and the
attribute's value as the value.
When this form is processed, all selected list items will be returned as
@@ -6455,7 +6441,7 @@
=back
-The optional b<-labels> argument is a pointer to an associative array
+The optional b<-labels> argument is a pointer to a hash
relating the checkbox values to the user-visible labels that will be
printed next to them. If not provided, the values will be used as the
default.
@@ -6472,7 +6458,7 @@
The optional B<-attributes> argument is provided to assign any of the
common HTML attributes to an individual menu item. It's a pointer to
-an associative array relating menu values to another associative array
+a hash relating menu values to another hash
with the attribute's name as the key and the attribute's value as the
value.
@@ -6646,7 +6632,7 @@
The optional B<-attributes> argument is provided to assign any of the
common HTML attributes to an individual menu item. It's a pointer to
-an associative array relating menu values to another associative array
+a hash relating menu values to another hash
with the attribute's name as the key and the attribute's value as the
value.
@@ -6816,16 +6802,13 @@
button() produces a button that is compatible with Netscape 2.0's
JavaScript. When it's pressed the fragment of JavaScript code
-pointed to by the B<-onClick> parameter will be executed. On
-non-Netscape browsers this form element will probably not even
-display.
+pointed to by the B<-onClick> parameter will be executed.
=head1 HTTP COOKIES
-Netscape browsers versions 1.1 and higher, and all versions of
-Internet Explorer, support a so-called "cookie" designed to help
-maintain state within a browser session. CGI.pm has several methods
-that support cookies.
+Browsers support a so-called "cookie" designed to help maintain state
+within a browser session. CGI.pm has several methods that support
+cookies.
A cookie is a name=value pair much like the named parameters in a CGI
query string. CGI scripts create one or more cookies and send
@@ -6900,8 +6883,8 @@
=item B<-value>
The value of the cookie. This can be any scalar value,
-array reference, or even associative array reference. For example,
-you can store an entire associative array into a cookie this way:
+array reference, or even hash reference. For example,
+you can store an entire hash into a cookie this way:
$cookie=cookie(-name=>'family information',
-value=>\%childrens_ages);
@@ -7027,19 +7010,6 @@
side-by-side frames.
=head1 SUPPORT FOR JAVASCRIPT
-
-Netscape versions 2.0 and higher incorporate an interpreted language
-called JavaScript. Internet Explorer, 3.0 and higher, supports a
-closely-related dialect called JScript. JavaScript isn't the same as
-Java, and certainly isn't at all the same as Perl, which is a great
-pity. JavaScript allows you to programmatically change the contents of
-fill-out forms, create new windows, and pop up dialog box from within
-Netscape itself. From the point of view of CGI scripting, JavaScript
-is quite useful for validating fill-out forms prior to submitting
-them.
-
-You'll need to know JavaScript in order to use it. There are many good
-sources in bookstores and on the web.
The usual way to use JavaScript is to define a set of functions in a
<SCRIPT> block inside the HTML header and then to register event
@@ -7382,11 +7352,9 @@
=item B<raw_cookie()>
-Returns the HTTP_COOKIE variable, an HTTP extension implemented by
-Netscape browsers version 1.1 and higher, and all versions of Internet
-Explorer. Cookies have a special format, and this method call just
-returns the raw form (?cookie dough). See cookie() for ways of
-setting and retrieving cooked cookies.
+Returns the HTTP_COOKIE variable. Cookies have a special format, and
+this method call just returns the raw form (?cookie dough). See
+cookie() for ways of setting and retrieving cooked cookies.
Called with no parameters, raw_cookie() returns the packed cookie
structure. You can separate it into individual cookies by splitting
@@ -7400,7 +7368,7 @@
Returns the HTTP_USER_AGENT variable. If you give
this method a single argument, it will attempt to
pattern match on it, allowing you to do something
-like user_agent(netscape);
+like user_agent(Mozilla);
=item B<path_info()>
@@ -7583,7 +7551,7 @@
use CGI qw/:push -nph/;
$| = 1;
print multipart_init(-boundary=>'----here we go!');
- foreach (0 .. 4) {
+ for (0 .. 4) {
print multipart_start(-type=>'text/plain'),
"The current time is ",scalar(localtime),"\n";
if ($_ < 4) {
@@ -7639,9 +7607,6 @@
Users interested in server push applications should also have a look
at the CGI::Push module.
-Only Netscape Navigator supports server push. Internet Explorer
-browsers do not.
-
=head1 Avoiding Denial of Service Attacks
A potential problem with CGI.pm is that, by default, it attempts to
@@ -7893,7 +7858,7 @@
print "<h2>Here are the current settings in this form</h2>";
- foreach $key (param) {
+ for $key (param) {
print "<strong>$key</strong> -> ";
@values = param($key);
print join(", ", at values),"<br>\n";
Modified: branches/upstream/libcgi-pm-perl/current/CGI/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/CGI/Util.pm?rev=33084&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/CGI/Util.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/CGI/Util.pm Sun Apr 12 09:43:19 2009
@@ -210,7 +210,6 @@
my $todecode = shift;
return undef unless defined($todecode);
$todecode =~ tr/+/ /; # pluses become spaces
- $EBCDIC = "\t" ne "\011";
if ($EBCDIC) {
$todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
} else {
@@ -232,16 +231,24 @@
}
# URL-encode data
+#
+# We cannot use the %u escapes, they were rejected by W3C, so the official
+# way is %XX-escaped utf-8 encoding.
+# Naturally, Unicode strings have to be converted to their utf-8 byte
+# representation. (No action is required on 5.6.)
+# Byte strings were traditionally used directly as a sequence of octets.
+# This worked if they actually represented binary data (i.e. in CGI::Compress).
+# This also worked if these byte strings were actually utf-8 encoded; e.g.,
+# when the source file used utf-8 without the apropriate "use utf8;".
+# This fails if the byte string is actually a Latin 1 encoded string, but it
+# was always so and cannot be fixed without breaking the binary data case.
+# -- Stepan Kasal <skasal at redhat.com>
+#
sub escape {
shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
my $toencode = shift;
return undef unless defined($toencode);
- $toencode = eval { pack("C*", unpack("U0C*", $toencode))} || pack("C*", unpack("C*", $toencode));
-
- # force bytes while preserving backward compatibility -- dankogai
- # but commented out because it was breaking CGI::Compress -- lstein
- # $toencode = eval { pack("U*", unpack("U0C*", $toencode))} || pack("C*", unpack("C*", $toencode));
-
+ utf8::encode($toencode) if ($] > 5.007 && utf8::is_utf8($toencode));
if ($EBCDIC) {
$toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
} else {
Modified: branches/upstream/libcgi-pm-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/Changes?rev=33084&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/Changes (original)
+++ branches/upstream/libcgi-pm-perl/current/Changes Sun Apr 12 09:43:19 2009
@@ -1,3 +1,7 @@
+ Version 3.43
+ 1. Documentation patch from MARKSTOS at cpan.org to replace all occurrences of
+ "new CGI" with CGI->new()" to reflect best perl practices.
+ 2. Patch from Stepan Kasal to fix utf-8 related problems in perl 5.10
Version 3.42
1. Added patch from Renee Baecker that makes it possible to subclass
Modified: branches/upstream/libcgi-pm-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/META.yml?rev=33084&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/META.yml (original)
+++ branches/upstream/libcgi-pm-perl/current/META.yml Sun Apr 12 09:43:19 2009
@@ -1,10 +1,10 @@
--- #YAML:1.0
name: CGI.pm
-version: 3.42
+version: 3.43
abstract: ~
license: ~
author: ~
-generated_by: ExtUtils::MakeMaker version 6.44
+generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module
requires:
FCGI: 0.67
Modified: branches/upstream/libcgi-pm-perl/current/t/util-58.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/t/util-58.t?rev=33084&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/t/util-58.t (original)
+++ branches/upstream/libcgi-pm-perl/current/t/util-58.t Sun Apr 12 09:43:19 2009
@@ -1,16 +1,29 @@
+# test CGI::Util::escape
+use Test::More tests => 4;
+use_ok("CGI::Util");
+
+# Byte strings should be escaped byte by byte:
+# 1) not a valid utf-8 sequence:
+my $uri = "pe\x{f8}\x{ed}\x{e8}ko.ogg";
+is(CGI::Util::escape($uri), "pe%F8%ED%E8ko.ogg", "Escape a Latin-2 string");
+
+# 2) is a valid utf-8 sequence, but not an UTF-8-flagged string
+# This happens often: people write utf-8 strings to source, but forget
+# to tell perl about it by "use utf8;"--this is obviously wrong, but we
+# have to handle it gracefully, for compatibility with GCI.pm under
+# perl-5.8.x
#
-# This tests CGI::Util::escape() when fed with UTF-8-flagged string
-# -- dankogai
-BEGIN {
- if ($] < 5.008) {
- print "1..0 # \$] == $] < 5.008\n";
- exit(0);
- }
+$uri = "pe\x{c5}\x{99}\x{c3}\x{ad}\x{c4}\x{8d}ko.ogg";
+is(CGI::Util::escape($uri), "pe%C5%99%C3%AD%C4%8Dko.ogg",
+ "Escape an utf-8 byte string");
+
+SKIP:
+{
+ # This tests CGI::Util::escape() when fed with UTF-8-flagged string
+ # -- dankogai
+ skip("Unicode strings not available in $]", 1) if ($] < 5.008);
+ $uri = "\x{5c0f}\x{98fc} \x{5f3e}.txt"; # KOGAI, Dan, in Kanji
+ is(CGI::Util::escape($uri), "%E5%B0%8F%E9%A3%BC%20%E5%BC%BE.txt",
+ "Escape string with UTF-8 flag");
}
-
-use Test::More tests => 2;
-use_ok("CGI::Util");
-my $uri = "\x{5c0f}\x{98fc} \x{5f3e}.txt"; # KOGAI, Dan, in Kanji
-is(CGI::Util::escape($uri), "%E5%B0%8F%E9%A3%BC%20%E5%BC%BE.txt",
- "# Escape string with UTF-8 flag");
__END__
More information about the Pkg-perl-cvs-commits
mailing list