Change 34287 by [EMAIL PROTECTED] on 2008/09/05 22:36:23
Integrate:
[ 34257]
Integrate:
[ 34164]
Subject: [PATCH] update Exporter to version 5.63
From: "Adriano Ferreira" <[EMAIL PROTECTED]>
Date: Tue, 29 Jul 2008 17:37:12 -0300
Message-ID: <[EMAIL PROTECTED]>
[ 34170]
Subject: [PATCH] Tiny SelfLoader patch for better warnings
From: Steffen Mueller <[EMAIL PROTECTED]>
Message-ID: <[EMAIL PROTECTED]>
Date: Sat, 02 Aug 2008 17:38:39 +0200
[ 34193]
Upgrade to ExtUtils-Manifest-1.54
[ 34194]
Upgrade to CGI.pm-3.40
Affected files ...
... //depot/maint-5.8/perl/lib/CGI.pm#24 integrate
... //depot/maint-5.8/perl/lib/CGI/Fast.pm#8 integrate
... //depot/maint-5.8/perl/lib/CGI/t/request.t#4 integrate
... //depot/maint-5.8/perl/lib/Exporter.pm#8 integrate
... //depot/maint-5.8/perl/lib/Exporter.t#6 integrate
... //depot/maint-5.8/perl/lib/Exporter/Heavy.pm#7 integrate
... //depot/maint-5.8/perl/lib/ExtUtils/MANIFEST.SKIP#10 integrate
... //depot/maint-5.8/perl/lib/ExtUtils/Manifest.pm#14 integrate
... //depot/maint-5.8/perl/lib/ExtUtils/t/Manifest.t#16 integrate
... //depot/maint-5.8/perl/lib/SelfLoader.pm#6 integrate
Differences ...
==== //depot/maint-5.8/perl/lib/CGI.pm#24 (text) ====
Index: perl/lib/CGI.pm
--- perl/lib/CGI.pm#23~33819~ 2008-05-11 03:19:04.000000000 -0700
+++ perl/lib/CGI.pm 2008-09-05 15:36:23.000000000 -0700
@@ -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.257 2008/08/06 14:01:06 lstein Exp $';
+$CGI::VERSION='3.40';
# 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->[EMAIL PROTECTED];
+ $self->[EMAIL PROTECTED];
}
} else {
$name = $p[0];
}
- return unless defined($name) && $self->{$name};
+ return unless defined($name) && $self->{param}{$name};
- my @result = @{$self->{$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)[EMAIL PROTECTED];
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,@values) = self_or_default(@_);
# If values is provided, then we set it.
- $self->{'keywords'[EMAIL PROTECTED] if @values;
- my(@result) = defined($self->{'keywords'}) ? @{$self->{'keywords'}} : ();
+ $self->{param}{'keywords'[EMAIL PROTECTED] if @values;
+ my(@result) = defined($self->{param}{'keywords'}) ?
@{$self->{param}{'keywords'}} : ();
@result;
}
END_OF_FUNC
@@ -1176,7 +1176,7 @@
'EXISTS' => <<'END_OF_FUNC',
sub EXISTS {
- exists $_[0]->{$_[1]};
+ exists $_[0]->{param}{$_[1]};
}
END_OF_FUNC
@@ -1203,7 +1203,7 @@
my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
if (@values) {
$self->add_parameter($name);
- push(@{$self->{$name}},@values);
+ push(@{$self->{param}{$name}},@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 [EMAIL
PROTECTED];
+ }
+ 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,@other) =
rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,
ATTRIBUTES,[OVERRIDE,FORCE],TABINDEX],@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,@p) = self_or_default(@_);
my($name) = rearrange([NAME],@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
@@ -2835,30 +2849,58 @@
}
END_OF_FUNC
-# WE USE THIS TO COMPENSATE FOR A BUG IN APACHE 2 PRESENT AT LEAST UP THROUGH
2.0.54
+# This function returns a potentially modified version of SCRIPT_NAME
+# and PATH_INFO. Some HTTP servers do sanitise the paths in those
+# variables. It is the case of at least Apache 2. If for instance the
+# user requests: /path/./to/script.cgi/x//y/z/../x?y, Apache will set:
+# REQUEST_URI=/path/./to/script.cgi/x//y/z/../x?y
+# SCRIPT_NAME=/path/to/env.cgi
+# PATH_INFO=/x/y/x
+#
+# This is all fine except that some bogus CGI scripts expect
+# PATH_INFO=/http://foo when the user requests
+# http://xxx/script.cgi/http://foo
+#
+# Old versions of this module used to accomodate with those scripts, so
+# this is why we do this here to keep those scripts backward compatible.
+# Basically, we accomodate with those scripts but within limits, that is
+# we only try to preserve the number of / that were provided by the user
+# if $REQUEST_URI and "$SCRIPT_NAME$PATH_INFO" only differ by the number
+# of consecutive /.
+#
+# So for instance, in: http://foo/x//y/script.cgi/a//b, we'll return a
+# script_name of /x//y/script.cgi and a path_info of /a//b, but in:
+# http://foo/./x//z/script.cgi/a/../b//c, we'll return the versions
+# possibly sanitised by the HTTP server, so in the case of Apache 2:
+# script_name == /foo/x/z/script.cgi and path_info == /b/c.
+#
+# Future versions of this module may no longer do that, so one should
+# avoid relying on the browser, proxy, server, and CGI.pm preserving the
+# number of consecutive slashes as no guarantee can be made there.
'_name_and_path_from_env' => <<'END_OF_FUNC',
sub _name_and_path_from_env {
- my $self = shift;
- my $raw_script_name = $ENV{SCRIPT_NAME} || '';
- my $raw_path_info = $ENV{PATH_INFO} || '';
- my $uri = unescape($self->request_uri) || '';
-
- my $protected = quotemeta($raw_path_info);
- $raw_script_name =~ s/$protected$//;
-
- my @uri_double_slashes = $uri =~ m^(/{2,}?)^g;
- my @path_double_slashes = "$raw_script_name $raw_path_info" =~ m^(/{2,}?)^g;
-
- my $apache_bug = @uri_double_slashes != @path_double_slashes;
- return ($raw_script_name,$raw_path_info) unless $apache_bug;
-
- my $path_info_search = quotemeta($raw_path_info);
- $path_info_search =~ s!/!/+!g;
- if ($uri =~ m/^(.+)($path_info_search)/) {
- return ($1,$2);
- } else {
- return ($raw_script_name,$raw_path_info);
- }
+ my $self = shift;
+ my $script_name = $ENV{SCRIPT_NAME} || '';
+ my $path_info = $ENV{PATH_INFO} || '';
+ my $uri = $self->request_uri || '';
+
+ $uri =~ s/\?.*//s;
+ $uri = unescape($uri);
+
+ if ($uri ne "$script_name$path_info") {
+ my $script_name_pattern = quotemeta($script_name);
+ my $path_info_pattern = quotemeta($path_info);
+ $script_name_pattern =~ s{(?:\\/)+}{/+}g;
+ $path_info_pattern =~ s{(?:\\/)+}{/+}g;
+
+ if ($uri =~ /^($script_name_pattern)($path_info_pattern)$/s) {
+ # REQUEST_URI and SCRIPT_NAME . PATH_INFO only differ by the
+ # numer of consecutive slashes, so we can extract the info from
+ # REQUEST_URI:
+ ($script_name, $path_info) = ($1, $2);
+ }
+ }
+ return ($script_name,$path_info);
}
END_OF_FUNC
@@ -2942,7 +2984,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 +3423,8 @@
return;
}
+ $header{'Content-Disposition'} ||= ''; # quench uninit variable warning
+
my($param)= $header{'Content-Disposition'}=~/ name="([^"]*)"/;
$param .= $TAINTED;
@@ -3387,6 +3433,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 +3450,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 +3526,7 @@
name => $tmpfile,
info => {%header},
};
- push(@{$self->{$param}},$filehandle);
+ push(@{$self->{param}{$param}},$filehandle);
}
}
}
@@ -3579,7 +3628,7 @@
name => $tmpfile,
info => {%header},
};
- push(@{$self->{$param}},$filehandle);
+ push(@{$self->{param}{$param}},$filehandle);
}
}
return $returnvalue;
@@ -4409,8 +4458,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 +6181,7 @@
print popup_menu(-name=>'menu_name',
-values=>['eenie','meenie','minie'],
- -default=>'meenie',
+ -default=>['meenie','minie'],
-labels=>\%labels,
-attributes=>\%attributes);
@@ -6156,7 +6204,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.
==== //depot/maint-5.8/perl/lib/CGI/Fast.pm#8 (text) ====
Index: perl/lib/CGI/Fast.pm
--- perl/lib/CGI/Fast.pm#7~33819~ 2008-05-11 03:19:04.000000000 -0700
+++ perl/lib/CGI/Fast.pm 2008-09-05 15:36:23.000000000 -0700
@@ -82,18 +82,17 @@
=head1 DESCRIPTION
-CGI::Fast is a subclass of the CGI object created by
-CGI.pm. It is specialized to work well with the Open Market
-FastCGI standard, which greatly speeds up CGI scripts by
-turning them into persistently running server processes. Scripts
-that perform time-consuming initialization processes, such as
-loading large modules or opening persistent database connections,
-will see large performance improvements.
+CGI::Fast is a subclass of the CGI object created by CGI.pm. It is
+specialized to work well FCGI module, which greatly speeds up CGI
+scripts by turning them into persistently running server processes.
+Scripts that perform time-consuming initialization processes, such as
+loading large modules or opening persistent database connections, will
+see large performance improvements.
=head1 OTHER PIECES OF THE PUZZLE
-In order to use CGI::Fast you'll need a FastCGI-enabled Web
-server. See http://www.fastcgi.com/ for details.
+In order to use CGI::Fast you'll need the FCGI module. See
+http://www.cpan.org/ for details.
=head1 WRITING FASTCGI PERL SCRIPTS
@@ -106,7 +105,7 @@
A typical FastCGI script will look like this:
- #!/usr/local/bin/perl # must be a FastCGI version of perl!
+ #!/usr/bin/perl
use CGI::Fast;
&do_some_initialization();
while ($q = new CGI::Fast) {
==== //depot/maint-5.8/perl/lib/CGI/t/request.t#4 (xtext) ====
Index: perl/lib/CGI/t/request.t
--- perl/lib/CGI/t/request.t#3~21929~ 2003-12-19 11:06:10.000000000 -0800
+++ perl/lib/CGI/t/request.t 2008-09-05 15:36:23.000000000 -0700
@@ -4,7 +4,7 @@
######################### We start with some black magic to print on failure.
use lib '.','../blib/lib','../blib/arch';
-BEGIN {$| = 1; print "1..33\n"; }
+BEGIN {$| = 1; print "1..34\n"; }
END {print "not ok 1\n" unless $loaded;}
use CGI ();
use Config;
@@ -74,6 +74,7 @@
test(29,$p->{bar} eq 'froz',"tied interface fetch");
$p->{bar} = join("\0",qw(foo bar baz));
test(30,join(' ',$q->param('bar')) eq 'foo bar baz','tied interface store');
+test(31,exists $p->{bar});
# test posting
$q->_reset_globals;
@@ -88,11 +89,11 @@
exit 0;
}
# at this point, we're in a new (child) process
- test(31,$q=new CGI,"CGI::new() from POST");
- test(32,$q->param('weather') eq 'nice',"CGI::param() from POST");
- test(33,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+ test(32,$q=new CGI,"CGI::new() from POST");
+ test(33,$q->param('weather') eq 'nice',"CGI::param() from POST");
+ test(34,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
} else {
- print "ok 31 # Skip\n";
print "ok 32 # Skip\n";
print "ok 33 # Skip\n";
+ print "ok 34 # Skip\n";
}
==== //depot/maint-5.8/perl/lib/Exporter.pm#8 (text) ====
Index: perl/lib/Exporter.pm
--- perl/lib/Exporter.pm#7~33186~ 2008-02-02 07:21:00.000000000 -0800
+++ perl/lib/Exporter.pm 2008-09-05 15:36:23.000000000 -0700
@@ -9,10 +9,11 @@
our $Debug = 0;
our $ExportLevel = 0;
our $Verbose ||= 0;
-our $VERSION = '5.62';
+our $VERSION = '5.63';
our (%Cache);
-# Carp does this now for us, so we can finally live w/o Carp
-#$Carp::Internal{Exporter} = 1;
+
+# Carp 1.05+ does this now for us, but we may be running with an old Carp
+$Carp::Internal{Exporter}++;
sub as_heavy {
require Exporter::Heavy;
@@ -102,7 +103,7 @@
=head1 SYNOPSIS
-In module YourModule.pm:
+In module F<YourModule.pm>:
package YourModule;
require Exporter;
@@ -115,9 +116,9 @@
use Exporter 'import'; # gives you Exporter's import() method directly
@EXPORT_OK = qw(munge frobnicate); # symbols to export on request
-In other files which wish to use YourModule:
+In other files which wish to use C<YourModule>:
- use ModuleName qw(frobnicate); # import listed symbols
+ use YourModule qw(frobnicate); # import listed symbols
frobnicate ($left, $right) # calls YourModule::frobnicate
Take a look at L</Good Practices> for some variants
@@ -159,11 +160,11 @@
Do B<not> export anything else by default without a good reason!
Exports pollute the namespace of the module user. If you must export
-try to use @EXPORT_OK in preference to @EXPORT and avoid short or
+try to use C<@EXPORT_OK> in preference to C<@EXPORT> and avoid short or
common symbol names to reduce the risk of name clashes.
Generally anything not exported is still accessible from outside the
-module using the ModuleName::item_name (or $blessed_ref-E<gt>method)
+module using the C<YourModule::item_name> (or C<< $blessed_ref->method >>)
syntax. By convention you can use a leading underscore on names to
informally indicate that they are 'internal' and not for public use.
@@ -178,7 +179,7 @@
As a general rule, if the module is trying to be object oriented
then export nothing. If it's just a collection of functions then
[EMAIL PROTECTED] anything but use @EXPORT with caution. For function and
+C<@EXPORT_OK> anything but use C<@EXPORT> with caution. For function and
method names use barewords in preference to names prefixed with
ampersands for the export lists.
@@ -191,19 +192,19 @@
=over 4
-=item C<use ModuleName;>
+=item C<use YourModule;>
-This imports all the symbols from ModuleName's @EXPORT into the namespace
+This imports all the symbols from YourModule's C<@EXPORT> into the namespace
of the C<use> statement.
-=item C<use ModuleName ();>
+=item C<use YourModule ();>
This causes perl to load your module but does not import any symbols.
-=item C<use ModuleName qw(...);>
+=item C<use YourModule qw(...);>
This imports only the symbols listed by the caller into their namespace.
-All listed symbols must be in your @EXPORT or @EXPORT_OK, else an error
+All listed symbols must be in your C<@EXPORT> or C<@EXPORT_OK>, else an error
occurs. The advanced export features of Exporter are accessed like this,
but with list entries that are syntactically distinct from symbol names.
@@ -232,7 +233,7 @@
extra names in addition to the default set you will still need to
include :DEFAULT explicitly.
-e.g., Module.pm defines:
+e.g., F<Module.pm> defines:
@EXPORT = qw(A1 A2 A3 A4 A5);
@EXPORT_OK = qw(B1 B2 B3 B4 B5);
@@ -265,9 +266,9 @@
MyPackage->export_to_level($where_to_export, $package, @what_to_export);
-where $where_to_export is an integer telling how far up the calling stack
-to export your symbols, and @what_to_export is an array telling what
-symbols *to* export (usually this is @_). The $package argument is
+where C<$where_to_export> is an integer telling how far up the calling stack
+to export your symbols, and C<@what_to_export> is an array telling what
+symbols *to* export (usually this is C<@_>). The C<$package> argument is
currently unused.
For example, suppose that you have a module, A, which already has an
@@ -283,7 +284,7 @@
$A::b = 1; # not a very useful import method
}
-and you want to Export symbol $A::b back to the module that called
+and you want to Export symbol C<$A::b> back to the module that called
package A. Since Exporter relies on the import method to work, via
inheritance, as it stands Exporter::import() will never get called.
Instead, say the following:
@@ -306,7 +307,7 @@
=head2 Exporting without inheriting from Exporter
-By including Exporter in your @ISA you inherit an Exporter's import() method
+By including Exporter in your C<@ISA> you inherit an Exporter's import() method
but you also inherit several other helper methods which you probably don't
want. To avoid this you can do
@@ -315,7 +316,7 @@
which will export Exporter's own import() method into YourModule.
Everything will work as before but you won't need to include Exporter in
[EMAIL PROTECTED]::ISA.
+C<@YourModule::ISA>.
Note: This feature was introduced in version 5.57
of Exporter, released with perl 5.8.3.
@@ -323,14 +324,14 @@
=head2 Module Version Checking
The Exporter module will convert an attempt to import a number from a
-module into a call to $module_name-E<gt>require_version($value). This can
+module into a call to C<< $module_name->require_version($value) >>. This can
be used to validate that the version of the module being used is
greater than or equal to the required version.
-The Exporter module supplies a default require_version method which
-checks the value of $VERSION in the exporting module.
+The Exporter module supplies a default C<require_version> method which
+checks the value of C<$VERSION> in the exporting module.
-Since the default require_version method treats the $VERSION number as
+Since the default C<require_version> method treats the C<$VERSION> number as
a simple numeric value it will regard version 1.10 as lower than
1.9. For this reason it is strongly recommended that you use numbers
with at least two decimal places, e.g., 1.09.
@@ -351,37 +352,37 @@
@failed_symbols = $module_name->export_fail(@failed_symbols);
-If the export_fail method returns an empty list then no error is
+If the C<export_fail> method returns an empty list then no error is
recorded and all the requested symbols are exported. If the returned
list is not empty then an error is generated for each symbol and the
-export fails. The Exporter provides a default export_fail method which
+export fails. The Exporter provides a default C<export_fail> method which
simply returns the list unchanged.
-Uses for the export_fail method include giving better error messages
+Uses for the C<export_fail> method include giving better error messages
for some symbols and performing lazy architectural checks (put more
-symbols into @EXPORT_FAIL by default and then take them out if someone
+symbols into C<@EXPORT_FAIL> by default and then take them out if someone
actually tries to use them and an expensive check shows that they are
usable on that platform).
=head2 Tag Handling Utility Functions
-Since the symbols listed within %EXPORT_TAGS must also appear in either
[EMAIL PROTECTED] or @EXPORT_OK, two utility functions are provided which allow
-you to easily add tagged sets of symbols to @EXPORT or @EXPORT_OK:
+Since the symbols listed within C<%EXPORT_TAGS> must also appear in either
+C<@EXPORT> or C<@EXPORT_OK>, two utility functions are provided which allow
+you to easily add tagged sets of symbols to C<@EXPORT> or C<@EXPORT_OK>:
%EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
Exporter::export_tags('foo'); # add aa, bb and cc to @EXPORT
Exporter::export_ok_tags('bar'); # add aa, cc and dd to @EXPORT_OK
-Any names which are not tags are added to @EXPORT or @EXPORT_OK
+Any names which are not tags are added to C<@EXPORT> or C<@EXPORT_OK>
unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags
-names being silently added to @EXPORT or @EXPORT_OK. Future versions
+names being silently added to C<@EXPORT> or C<@EXPORT_OK>. Future versions
may make this a fatal error.
=head2 Generating combined tags
-If several symbol categories exist in %EXPORT_TAGS, it's usually
+If several symbol categories exist in C<%EXPORT_TAGS>, it's usually
useful to create the utility ":all" to simplify "use" statements.
The simplest way to do this is:
@@ -397,7 +398,7 @@
grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS;
}
-CGI.pm creates an ":all" tag which contains some (but not really
+F<CGI.pm> creates an ":all" tag which contains some (but not really
all) of its categories. That could be done with one small
change:
@@ -411,7 +412,7 @@
foreach qw/html2 html3 netscape form cgi internal/;
}
-Note that the tag names in %EXPORT_TAGS don't have the leading ':'.
+Note that the tag names in C<%EXPORT_TAGS> don't have the leading ':'.
=head2 C<AUTOLOAD>ed Constants
@@ -581,3 +582,6 @@
and/or modify it under the same terms as Perl itself.
=cut
+
+
+
==== //depot/maint-5.8/perl/lib/Exporter.t#6 (text) ====
Index: perl/lib/Exporter.t
--- perl/lib/Exporter.t#5~30536~ 2007-03-10 08:42:04.000000000 -0800
+++ perl/lib/Exporter.t 2008-09-05 15:36:23.000000000 -0700
@@ -25,7 +25,7 @@
BEGIN {
$test = 1;
- print "1..28\n";
+ print "1..30\n";
require Exporter;
ok( 1, 'Exporter compiled' );
}
@@ -218,3 +218,8 @@
my $val = eval { wibble() };
::ok($val eq "wobble", "exported importer worked");
+# Check that Carp recognizes Exporter as internal to Perl
+require Carp;
+::ok($Carp::Internal{Exporter}, "Carp recognizes Exporter");
+::ok($Carp::Internal{'Exporter::Heavy'}, "Carp recognizes Exporter::Heavy");
+
==== //depot/maint-5.8/perl/lib/Exporter/Heavy.pm#7 (text) ====
Index: perl/lib/Exporter/Heavy.pm
--- perl/lib/Exporter/Heavy.pm#6~30536~ 2007-03-10 08:42:04.000000000 -0800
+++ perl/lib/Exporter/Heavy.pm 2008-09-05 15:36:23.000000000 -0700
@@ -5,8 +5,9 @@
# On one line so MakeMaker will see it.
require Exporter; our $VERSION = $Exporter::VERSION;
-# Carp does this now for us, so we can finally live w/o Carp
-#$Carp::Internal{"Exporter::Heavy"} = 1;
+
+# Carp 1.05+ does this now for us, but we may be running with an old Carp
+$Carp::Internal{'Exporter::Heavy'}++;
=head1 NAME
==== //depot/maint-5.8/perl/lib/ExtUtils/MANIFEST.SKIP#10 (text) ====
Index: perl/lib/ExtUtils/MANIFEST.SKIP
--- perl/lib/ExtUtils/MANIFEST.SKIP#9~33006~ 2008-01-18 12:15:11.000000000
-0800
+++ perl/lib/ExtUtils/MANIFEST.SKIP 2008-09-05 15:36:23.000000000 -0700
@@ -4,6 +4,7 @@
\bSCCS\b
,v$
\B\.svn\b
+\B\.git\b
\b_darcs\b
# Avoid Makemaker generated and utility files.
==== //depot/maint-5.8/perl/lib/ExtUtils/Manifest.pm#14 (text) ====
Index: perl/lib/ExtUtils/Manifest.pm
--- perl/lib/ExtUtils/Manifest.pm#13~32328~ 2007-11-15 04:11:24.000000000
-0800
+++ perl/lib/ExtUtils/Manifest.pm 2008-09-05 15:36:23.000000000 -0700
@@ -13,11 +13,12 @@
$Is_MacOS $Is_VMS
$Debug $Verbose $Quiet $MANIFEST $DEFAULT_MSKIP);
-$VERSION = '1.51_01';
+$VERSION = '1.54';
@ISA=('Exporter');
@EXPORT_OK = qw(mkmanifest
manicheck filecheck fullcheck skipcheck
manifind maniread manicopy maniadd
+ maniskip
);
$Is_MacOS = $^O eq 'MacOS';
@@ -71,16 +72,14 @@
mkmanifest();
Writes all files in and below the current directory to your F<MANIFEST>.
-It works similar to
+It works similar to the result of the Unix command
find . > MANIFEST
All files that match any regular expression in a file F<MANIFEST.SKIP>
(if it exists) are ignored.
-Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>. Lines
-from the old F<MANIFEST> file is preserved, including any comments
-that are found in the existing F<MANIFEST> file in the new one.
+Any existing F<MANIFEST> file will be saved as F<MANIFEST.bak>.
=cut
@@ -96,8 +95,8 @@
my $bakbase = $MANIFEST;
$bakbase =~ s/\./_/g if $Is_VMS; # avoid double dots
rename $MANIFEST, "$bakbase.bak" unless $manimiss;
- open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
- my $skip = _maniskip();
+ open M, "> $MANIFEST" or die "Could not open $MANIFEST: $!";
+ my $skip = maniskip();
my $found = manifind();
my($key,$val,$file,%all);
%all = (%$found, %$read);
@@ -118,6 +117,10 @@
my $tabs = (5 - (length($file)+1)/8);
$tabs = 1 if $tabs < 1;
$tabs = 0 unless $text;
+ if ($file =~ /\s/) {
+ $file =~ s/([\\'])/\\$1/g;
+ $file = "'$file'";
+ }
print M $file, "\t" x $tabs, $text, "\n";
}
close M;
@@ -231,7 +234,7 @@
sub skipcheck {
my($p) = @_;
my $found = manifind();
- my $matches = _maniskip();
+ my $matches = maniskip();
my @skipped = ();
foreach my $file (_sort keys %$found){
@@ -274,7 +277,7 @@
my($p) = @_;
my $read = maniread() || {};
my $found = manifind($p);
- my $skip = _maniskip();
+ my $skip = maniskip();
my @missentry = ();
foreach my $file (_sort keys %$found){
@@ -308,7 +311,7 @@
$mfile ||= $MANIFEST;
my $read = {};
local *M;
- unless (open M, $mfile){
+ unless (open M, "< $mfile"){
warn "Problem opening $mfile: $!";
return $read;
}
@@ -317,7 +320,16 @@
chomp;
next if /^\s*#/;
- my($file, $comment) = /^(\S+)\s*(.*)/;
+ my($file, $comment);
+
+ # filename may contain spaces if enclosed in ''
+ # (in which case, \\ and \' are escapes)
+ if (($file, $comment) = /^'(\\[\\']|.+)+'\s*(.*)/) {
+ $file =~ s/\\([\\'])/$1/g;
+ }
+ else {
+ ($file, $comment) = /^(\S+)\s*(.*)/;
+ }
next unless $file;
if ($Is_MacOS) {
@@ -343,18 +355,33 @@
$read;
}
+=item maniskip
+
+ my $skipchk = maniskip();
+ my $skipchk = maniskip($manifest_skip_file);
+
+ if ($skipchk->($file)) { .. }
+
+reads a named C<MANIFEST.SKIP> file (defaults to C<MANIFEST.SKIP> in
+the current directory) and returns a CODE reference that tests whether
+a given filename should be skipped.
+
+=cut
+
# returns an anonymous sub that decides if an argument matches
-sub _maniskip {
+sub maniskip {
my @skip ;
- my $mfile = "$MANIFEST.SKIP";
+ my $mfile = shift || "$MANIFEST.SKIP";
_check_mskip_directives($mfile) if -f $mfile;
local(*M, $_);
- open M, $mfile or open M, $DEFAULT_MSKIP or return sub {0};
+ open M, "< $mfile" or open M, "< $DEFAULT_MSKIP" or return sub {0};
while (<M>){
chomp;
s/\r//;
next if /^#/;
next if /^\s*$/;
+ s/^'//;
+ s/'$//;
push @skip, _macify($_);
}
close M;
@@ -380,7 +407,7 @@
local (*M, $_);
my @lines = ();
my $flag = 0;
- unless (open M, $mfile) {
+ unless (open M, "< $mfile") {
warn "Problem opening $mfile: $!";
return;
}
@@ -410,7 +437,7 @@
$bakbase =~ s/\./_/g if $Is_VMS; # avoid double dots
rename $mfile, "$bakbase.bak";
warn "Debug: Saving original $mfile as $bakbase.bak\n" if $Debug;
- unless (open M, ">$mfile") {
+ unless (open M, "> $mfile") {
warn "Problem opening $mfile: $!";
return;
}
@@ -428,7 +455,7 @@
return;
}
local (*M, $_);
- unless (open M, $mskip) {
+ unless (open M, "< $mskip") {
warn "Problem opening $mskip: $!";
return;
}
@@ -492,7 +519,10 @@
sub cp_if_diff {
my($from, $to, $how)[EMAIL PROTECTED];
- -f $from or carp "$0: $from not found";
+ if (! -f $from) {
+ carp "$from not found";
+ return;
+ }
my($diff) = 0;
local(*F,*T);
open(F,"< $from\0") or die "Can't read $from: $!\n";
@@ -626,6 +656,10 @@
foreach my $file (_sort @needed) {
my $comment = $additions->{$file} || '';
+ if ($file =~ /\s/) {
+ $file =~ s/([\\'])/\\$1/g;
+ $file = "'$file'";
+ }
printf MANIFEST "%-40s %s\n", $file, $comment;
}
close MANIFEST or die "Error closing $MANIFEST: $!";
@@ -669,11 +703,14 @@
Anything between white space and an end of line within a C<MANIFEST>
file is considered to be a comment. Any line beginning with # is also
-a comment.
+a comment. Beginning with ExtUtils::Manifest 1.52, a filename may
+contain whitespace characters if it is enclosed in single quotes; single
+quotes or backslashes in that filename must be backslash-escaped.
# this a comment
some/file
some/other/file comment about some/file
+ 'some/third file' comment
=head2 MANIFEST.SKIP
==== //depot/maint-5.8/perl/lib/ExtUtils/t/Manifest.t#16 (text) ====
Index: perl/lib/ExtUtils/t/Manifest.t
--- perl/lib/ExtUtils/t/Manifest.t#15~32328~ 2007-11-15 04:11:24.000000000
-0800
+++ perl/lib/ExtUtils/t/Manifest.t 2008-09-05 15:36:23.000000000 -0700
@@ -13,7 +13,7 @@
use strict;
-use Test::More tests => 66;
+use Test::More tests => 94;
use Cwd;
use File::Spec;
@@ -33,7 +33,7 @@
my ($file, $data) = @_;
$data ||= 'foo';
1 while unlink $file; # or else we'll get multiple versions on VMS
- open( T, '>'.$file) or return;
+ open( T, '> '.$file) or return;
print T $data;
++$Files{$file};
close T;
@@ -60,7 +60,7 @@
BEGIN {
use_ok( 'ExtUtils::Manifest',
qw( mkmanifest manicheck filecheck fullcheck
- maniread manicopy skipcheck maniadd) );
+ maniread manicopy skipcheck maniadd maniskip) );
}
my $cwd = Cwd::getcwd();
@@ -173,12 +173,12 @@
eval { (undef, $warn) = catch_warning( sub {
manicopy( $files, 'copy', 'cp' ) })
};
-like( $@, qr/^Can't read none: /, 'croaked about none' );
# a newline comes through, so get rid of it
chomp($warn);
-
-# the copy should have given one warning and one error
+# the copy should have given a warning
+like($warn, qr/^none not found/, 'carped about none' );
+($res, $warn) = catch_warning( \&skipcheck );
like($warn, qr/^Skipping MANIFEST.SKIP/i, 'warned about MANIFEST.SKIP' );
# tell ExtUtils::Manifest to use a different file
@@ -218,13 +218,67 @@
is( $files->{yarrow}, 'hock',' with comment' );
is( $files->{foobar}, '', ' preserved old entries' );
+my %funky_files;
+# test including a filename with a space
+SKIP: {
+ add_file( 'foo bar' => "space" )
+ or skip "couldn't create spaced test file", 2;
+ local $ExtUtils::Manifest::MANIFEST = "albatross";
+ maniadd({ 'foo bar' => "contains space"});
+ is( maniread()->{'foo bar'}, "contains space",
+ 'spaced manifest filename' );
+ add_file( 'albatross.bak', '' );
+ ($res, $warn) = catch_warning( \&mkmanifest );
+ like( $warn, qr/\A(Added to.*\n)+\z/m,
+ 'no warnings about funky filename' );
+ $funky_files{'space'} = 'foo bar';
+}
+
+# test including a filename with a space and a quote
+SKIP: {
+ add_file( 'foo\' baz\'quux' => "quote" )
+ or skip "couldn't create quoted test file", 1;
+ local $ExtUtils::Manifest::MANIFEST = "albatross";
+ maniadd({ 'foo\' baz\'quux' => "contains quote"});
+ is( maniread()->{'foo\' baz\'quux'}, "contains quote",
+ 'quoted manifest filename' );
+ $funky_files{'space_quote'} = 'foo\' baz\'quux';
+}
+
+# test including a filename with a space and a backslash
+SKIP: {
+ add_file( 'foo bar\\baz' => "backslash" )
+ or skip "couldn't create backslash test file", 1;
+ local $ExtUtils::Manifest::MANIFEST = "albatross";
+ maniadd({ 'foo bar\\baz' => "contains backslash"});
+ is( maniread()->{'foo bar\\baz'}, "contains backslash",
+ 'backslashed manifest filename' );
+ $funky_files{'space_backslash'} = 'foo bar\\baz';
+}
+
+# test including a filename with a space, quote, and a backslash
+SKIP: {
+ add_file( 'foo bar\\baz\'quux' => "backslash/quote" )
+ or skip "couldn't create backslash/quote test file", 1;
+ local $ExtUtils::Manifest::MANIFEST = "albatross";
+ maniadd({ 'foo bar\\baz\'quux' => "backslash and quote"});
+ is( maniread()->{'foo bar\\baz\'quux'}, "backslash and quote",
+ 'backslashed and quoted manifest filename' );
+ $funky_files{'space_quote_backslash'} = 'foo bar\\baz\'quux';
+}
+
+my @funky_keys = qw(space space_quote space_backslash space_quote_backslash);
# test including an external manifest.skip file in MANIFEST.SKIP
{
maniadd({ foo => undef , albatross => undef,
'mymanifest.skip' => undef, 'mydefault.skip' => undef});
+ for (@funky_keys) {
+ maniadd( {$funky_files{$_} => $_} ) if defined $funky_files{$_};
+ }
+
add_file('mymanifest.skip' => "^foo\n");
add_file('mydefault.skip' => "^my\n");
- $ExtUtils::Manifest::DEFAULT_MSKIP =
+ local $ExtUtils::Manifest::DEFAULT_MSKIP =
File::Spec->catfile($cwd, qw(mantest mydefault.skip));
my $skip = File::Spec->catfile($cwd, qw(mantest mymanifest.skip));
add_file('MANIFEST.SKIP' =>
@@ -234,11 +288,27 @@
like( $warn, qr/Skipping \b$_\b/,
"Skipping $_" );
}
+ for my $funky_key (@funky_keys) {
+ SKIP: {
+ my $funky_file = $funky_files{$funky_key};
+ skip "'$funky_key' not created", 1 unless $funky_file;
+ like( $warn, qr/Skipping \b\Q$funky_file\E\b/,
+ "Skipping $funky_file");
+ }
+ }
($res, $warn) = catch_warning( \&mkmanifest );
for (qw(albatross foo foobar mymanifest.skip mydefault.skip)) {
like( $warn, qr/Removed from MANIFEST: \b$_\b/,
"Removed $_ from MANIFEST" );
}
+ for my $funky_key (@funky_keys) {
+ SKIP: {
+ my $funky_file = $funky_files{$funky_key};
+ skip "'$funky_key' not created", 1 unless $funky_file;
+ like( $warn, qr/Removed from MANIFEST: \b\Q$funky_file\E\b/,
+ "Removed $funky_file from MANIFEST");
+ }
+ }
my $files = maniread;
ok( ! exists $files->{albatross}, 'albatross excluded via MANIFEST.SKIP' );
ok( exists $files->{yarrow}, 'yarrow included in MANIFEST' );
@@ -249,6 +319,44 @@
'mymanifest.skip excluded via mydefault.skip' );
ok( ! exists $files->{'mydefault.skip'},
'mydefault.skip excluded via mydefault.skip' );
+
+ # test exclusion of funky files
+ for my $funky_key (@funky_keys) {
+ SKIP: {
+ my $funky_file = $funky_files{$funky_key};
+ skip "'$funky_key' not created", 1 unless $funky_file;
+ ok( ! exists $files->{$funky_file},
+ "'$funky_file' excluded via mymanifest.skip" );
+ }
+ }
+
+ # tests for maniskip
+ my $skipchk = maniskip();
+ is ( $skipchk->('albatross'), 1,
+ 'albatross excluded via MANIFEST.SKIP' );
+ is( $skipchk->('yarrow'), '',
+ 'yarrow included in MANIFEST' );
+ is( $skipchk->('bar'), '',
+ 'bar included in MANIFEST' );
+ $skipchk = maniskip('mymanifest.skip');
+ is( $skipchk->('foobar'), 1,
+ 'foobar excluded via mymanifest.skip' );
+ is( $skipchk->('foo'), 1,
+ 'foo excluded via mymanifest.skip' );
+ is( $skipchk->('mymanifest.skip'), '',
+ 'mymanifest.skip included via mydefault.skip' );
+ is( $skipchk->('mydefault.skip'), '',
+ 'mydefault.skip included via mydefault.skip' );
+ $skipchk = maniskip('mydefault.skip');
+ is( $skipchk->('foobar'), '',
+ 'foobar included via mydefault.skip' );
+ is( $skipchk->('foo'), '',
+ 'foo included via mydefault.skip' );
+ is( $skipchk->('mymanifest.skip'), 1,
+ 'mymanifest.skip excluded via mydefault.skip' );
+ is( $skipchk->('mydefault.skip'), 1,
+ 'mydefault.skip excluded via mydefault.skip' );
+
my $extsep = $Is_VMS ? '_' : '.';
$Files{"$_.bak"}++ for ('MANIFEST', "MANIFEST${extsep}SKIP");
}
==== //depot/maint-5.8/perl/lib/SelfLoader.pm#6 (text) ====
Index: perl/lib/SelfLoader.pm
--- perl/lib/SelfLoader.pm#5~33173~ 2008-02-01 11:33:57.000000000 -0800
+++ perl/lib/SelfLoader.pm 2008-09-05 15:36:23.000000000 -0700
@@ -1,7 +1,7 @@
package SelfLoader;
use 5.008;
use strict;
-our $VERSION = "1.15";
+our $VERSION = "1.16";
# The following bit of eval-magic is necessary to make this work on
# perls < 5.009005.
@@ -163,7 +163,8 @@
return () unless $fullname;
carp("Redefining sub $fullname")
if exists $Cache{$fullname};
- $Cache{$fullname} = join('', "package $pack; ",@$lines);
+ $Cache{$fullname} = join('', "\n\#line 1 \"sub $fullname\"\npackage $pack;
", @$lines);
+ #$Cache{$fullname} = join('', "package $pack; ",@$lines);
print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if DEBUG;
# return stub to be eval'd
defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;"
End of Patch.
