Change 30873 by [EMAIL PROTECTED] on 2007/04/08 11:25:47
Integrate:
[ 30400]
Module::Pluggable::Object::search_paths portability update prompted by
VMS test failures. Patch also submitted to CPAN RT queue at
<http://rt.cpan.org/Public/Bug/Display.html?id=13607>.
[ 30404]
Add a version number to Module::Pluggable::Object and
bump the version number of Module::Pluggable
[ 30869]
Upgrade to Module-Pluggable 3.6
Affected files ...
... //depot/maint-5.8/perl/lib/Module/Pluggable.pm#2 integrate
... //depot/maint-5.8/perl/lib/Module/Pluggable/Object.pm#2 integrate
... //depot/maint-5.8/perl/lib/Module/Pluggable/t/20dodgy_files.t#2 integrate
Differences ...
==== //depot/maint-5.8/perl/lib/Module/Pluggable.pm#2 (text) ====
Index: perl/lib/Module/Pluggable.pm
--- perl/lib/Module/Pluggable.pm#1~30559~ 2007-03-13 03:30:36.000000000
-0700
+++ perl/lib/Module/Pluggable.pm 2007-04-08 04:25:47.000000000 -0700
@@ -9,7 +9,7 @@
# Peter Gibbons: I wouldn't say I've been missing it, Bob!
-$VERSION = '3.5';
+$VERSION = '3.6';
sub import {
my $class = shift;
==== //depot/maint-5.8/perl/lib/Module/Pluggable/Object.pm#2 (text) ====
Index: perl/lib/Module/Pluggable/Object.pm
--- perl/lib/Module/Pluggable/Object.pm#1~30559~ 2007-03-13
03:30:36.000000000 -0700
+++ perl/lib/Module/Pluggable/Object.pm 2007-04-08 04:25:47.000000000 -0700
@@ -3,10 +3,14 @@
use strict;
use File::Find ();
use File::Basename;
-use File::Spec::Functions qw(splitdir catdir abs2rel);
+use File::Spec::Functions qw(splitdir catdir curdir catfile abs2rel);
use Carp qw(croak carp);
use Devel::InnerPackage;
use Data::Dumper;
+use vars qw($VERSION);
+
+$VERSION = '3.6';
+
sub new {
my $class = shift;
@@ -145,17 +149,48 @@
# untaint the file; accept .pm only
next unless ($file) = ($file =~ /(.*$file_regex)$/);
# parse the file to get the name
- my ($name, $directory) = fileparse($file, $file_regex);
+ my ($name, $directory, $suffix) = fileparse($file, $file_regex);
$directory = abs2rel($directory, $sp);
+
+ # If we have a mixed-case package name, assume case has been
preserved
+ # correctly. Otherwise, root through the file to locate the
case-preserved
+ # version of the package name.
+ my @pkg_dirs = ();
+ if ( $name eq lc($name) || $name eq uc($name) ) {
+ my $pkg_file = catfile($sp, $directory, "$name$suffix");
+ open PKGFILE, "<$pkg_file" or die "search_paths: Can't open
$pkg_file: $!";
+ my $in_pod = 0;
+ while ( my $line = <PKGFILE> ) {
+ $in_pod = 1 if $line =~ m/^=\w/;
+ $in_pod = 0 if $line =~ /^=cut/;
+ next if ($in_pod || $line =~ /^=cut/); # skip pod text
+ next if $line =~ /^\s*#/; # and comments
+ if ( $line =~ m/^\s*package\s+(.*::)?($name)\s*;/i ) {
+ @pkg_dirs = split /::/, $1;
+ $name = $2;
+ last;
+ }
+ }
+ close PKGFILE;
+ }
+
# then create the class name in a cross platform way
$directory =~ s/^[a-z]://i if($^O =~ /MSWin32|dos/); #
remove volume
+ my @dirs = ();
if ($directory) {
($directory) = ($directory =~ /(.*)/);
+ @dirs = grep(length($_), splitdir($directory))
+ unless $directory eq curdir();
+ for my $d (reverse @dirs) {
+ my $pkg_dir = pop @pkg_dirs;
+ last unless defined $pkg_dir;
+ $d =~ s/\Q$pkg_dir\E/$pkg_dir/i; # Correct case
+ }
} else {
$directory = "";
}
- my $plugin = join "::", splitdir catdir($searchpath, $directory,
$name);
+ my $plugin = join '::', $searchpath, @dirs, $name;
next unless $plugin =~ m!(?:[a-z\d]+)[a-z\d]!i;
==== //depot/maint-5.8/perl/lib/Module/Pluggable/t/20dodgy_files.t#2 (text) ====
Index: perl/lib/Module/Pluggable/t/20dodgy_files.t
--- perl/lib/Module/Pluggable/t/20dodgy_files.t#1~30559~ 2007-03-13
03:30:36.000000000 -0700
+++ perl/lib/Module/Pluggable/t/20dodgy_files.t 2007-04-08 04:25:47.000000000
-0700
@@ -1,5 +1,12 @@
#!perl -w
+BEGIN {
+ if ($^O eq 'VMS') {
+ print "1..0 # Skip: can't handle misspelled plugin names\n";
+ exit;
+ }
+}
+
use strict;
use FindBin;
use lib "$FindBin::Bin/lib";
End of Patch.
