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.