Bug #13607 for Module-Pluggable: Module fails tests on VMS

The attached patch against blead gets Module::Pluggable to pass all tests on VMS (except one, which is skipped). It had been failing 26 tests, which I think is pretty much all of them. I also tested after applying the patch on Mac OS X, where everything still passes. I have not tested on Win32 as I have no build environment available. The significant changes are all to Module::Pluggable::Object::search_paths. One minor nit was that package names were being passed to File::Spec->catdir(). Package names have colons in them. Colons in path specifications are significant on VMS (and Win32 for that matter). Here's an example of the kind of nonsense that gets generated: $ perl -"MFile::Spec" -e "print File::Spec->catdir('Foo::Bar', 'Baz');" Foo:[Bar.Baz] It interpreted Foo as the volume name. So I split and recombine things a bit differently to avoid sending something that's not a directory to catdir. (It's possible we no longer need the line that lops the volume name off on Win32.) The really big issue, though, was the assumption that you can scan the filesystem for .pm files and construct case-preserved package names from them (or I guess in this case plugin names). Even though perlfaq3 more or less tells you to do it that way (though it makes no commitment about case preservation) and even though all the cool kids are doing it these days (Module::Install comes to mind and there are probably others), that's not a very good assumption. On VMS, case preservation in the C run-time is off by default even when using a volume format that supports it, so filenames are all reported in lower case from readdir() via File::Find. On any OS using any file system that is not case sensitive (including NTFS and HFS +), module name case is not significant when using a module, so why should it be significant when going the other direction? But the horse seems to be out of the barn, at least as far as Module::Pluggable is concerned, and the only thing I could think of to do was read inside the file for the package declaration and correct case based on what I find there. It's ugly, but it seems to work. There is one test that explicitly makes sure it can find a plugin where the filename has been misspelled. I don't know why you'd want to support that, but if I can't get the plugin name from the filename and I can't get it from the package declaration, there's really nowhere else to go, so I skip that test. I thought I'd see if there was any feedback or alternate suggestions for how to handle this before applying it to blead.

--- lib/Module/Pluggable/Object.pm;-0 Tue Nov 28 07:51:00 2006 +++ lib/Module/Pluggable/Object.pm Sat Jan 27 12:49:22 2007 @@ -3,7 +3,7 @@ package Module::Pluggable::Object; 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; @@ -145,17 +145,48 @@ sub search_paths { # 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; --- lib/Module/Pluggable/t/20dodgy_files.t;-0 Tue Nov 28 07:51:00 2006 +++ lib/Module/Pluggable/t/20dodgy_files.t Sat Jan 27 12:49:23 2007 @@ -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";