On Dec 27, 2005, at 18:59, Craig A. Berry wrote:
The current implementation of Pod::Simple::Search assumes that
case-preserved package and pod names can be constructed from
filenames,
which is not always true, at least not on VMS, where the patch knocks
out about a dozen test failures in blead.
The basic approach is to root around in the file for C<=head1 NAME>
and
use the first word after it to correct the case of the pod name
constructed from the filename. This is only done for names that are
not
already in mixed case. The approach fails (does no additional harm but
also no good) when the internal name does not match the filename, but
that seems to me an error that shouldn't really be catered to. The
test
pod squaa::Wowo had such an error and the patch includes a fix for it.
This patch has a few problems that show up as a large number of
"uninitialized value" warnings during 'make test'. The first problem
is that it assumes there will always be a captured value, even from
an optional atom:
+ if( m/(\w+::)?(\w+)/) {
+ # substitute case-preserved version of name
+ my $podname = $2;
+ my $prefix = $1;
I fixed this one by just changing that last line to:
my $prefix = $1 || '';
The second problem is that it assumes that all names are supposed to
be in mixed case. This line of code determines whether the special
name extraction code is run:
+ if ($name eq lc($name) || $name eq uc($name)) {
But t/search_50survey_inc.t runs Pod::Simple::Search against all of
@INC. This includes modules like "threads::shared" and
"warnings::register". For these, $name equals lc($name), but that
really is the correct name for the module, so the extraction code
runs even when it shouldn't. I added an "$^O eq 'VMS'" condition to
the 'if', to limit where the extraction code runs unnecessarily, but
if you can come up with a more restrictive general condition it would
be handy.
The third problem is that when the extraction code runs, it clobbers
$_ here:
+ while (<PODFILE>) {
And this causes problems elsewhere in the module. (Particularly on
line 202, which is where one set of the "uninitialized value"
warnings was coming from.) A 'local $_' fixes the problem, but since
I consider the root of the problem to be excessive use of $_
throughout the module (a candidate for a later refactor), I switched
the patch to using 'my $line' instead of $_.
I don't have access to VMS, so I'd appreciate it if you'd check and
make sure the patch still solves your problem after my changes. You
can find the pre-release version here:
http://svn.lohutok.net/nam/trunk/perl5/modules/Pod/Simple/lib/Pod/
Simple/Search.pm
If all is well, I can release 3.04 tomorrow.
The patch also has a couple of minor VMS-specific adjustments.
Those are fine.
Thanks,
Allison
--- lib/Pod/Simple/Search.pm;-0 Wed Dec 7 06:09:21 2005
+++ lib/Pod/Simple/Search.pm Mon Dec 26 22:23:56 2005
@@ -67,14 +67,7 @@ sub survey {
$try = File::Spec->catfile( $cwd ,$try);
}
# simplify path
- # on VMS canonpath will vmsify:[the.path], but File::Find::find
- # wants /unixy/paths
- # (Is that irrelevent now htat we don't use File::Find? --
SMB)
- if( $^O eq 'VMS' ) {
- $try = VMS::Filespec::unixify($try);
- } else {
- $try = File::Spec->canonpath($try);
- }
+ $try = File::Spec->canonpath($try);
my $start_in;
my $modname_prefix;
@@ -243,9 +236,11 @@ sub _path2modname {
# * remove e.g. "i586-linux" (from 'archname')
# * remove e.g. 5.00503
# * remove pod/ if followed by perl*.pod (e.g. in pod/perlfunc.pod)
+ # * dig into the file for case-preserved name if not already
mixed case
my @m = @$modname_bits;
my $x;
+ my $verbose = $self->verbose;
# Shaving off leading naughty-bits
while(@m
@@ -258,6 +253,36 @@ sub _path2modname {
my $name = join '::', @m, $shortname;
$self->_simplify_base($name);
+
+ if ($name eq lc($name) || $name eq uc($name)) {
+ open PODFILE, "<$file" or die "_path2modname: Can't open
$file: $!";
+ my $in_pod = 0;
+ my $in_name = 0;
+ while (<PODFILE>) {
+ chomp;
+ $in_pod = 1 if m/^=\w/;
+ $in_pod = 0 if m/^=cut/;
+ next unless $in_pod; # skip non-pod text
+ next if m/^\s*\z/; # and blank lines
+ next if ($in_pod && m/^X</); # and commands
+ if ($in_name) {
+ if( m/(\w+::)?(\w+)/) {
+ # substitute case-preserved version of name
+ my $podname = $2;
+ my $prefix = $1;
+ $verbose and print "Attempting case restore of '$name'
from '$prefix$podname'\n";
+ unless ($name =~ s/$prefix$podname/$prefix$podname/i) {
+ $verbose and print "Attempting case restore of
'$name' from '$podname'\n";
+ $name =~ s/$podname/$podname/i;
+ }
+ last;
+ }
+ }
+ $in_name = 1 if m/^=head1 NAME/;
+ }
+ close PODFILE;
+ }
+
return $name;
}
@@ -308,6 +333,7 @@ sub _recurse_dir {
$callback->( $i_full, $i, 0, $modname_bits );
} elsif(-d _) {
+ $i =~ s/\.DIR\z//i if $^O eq 'VMS';
$_ = $i;
my $rv = $callback->( $i_full, $i, 1, $modname_bits ) || '';
--- lib/Pod/Simple/t/other_test_lib/squaa/Wowo.pod;-0 Tue Dec 13
13:37:05 2005
+++ lib/Pod/Simple/t/other_test_lib/squaa/Wowo.pod Mon Dec 26
22:40:47 2005
@@ -1,7 +1,7 @@
=head1 NAME
-squaa::Glunk -- blorpoesu
+squaa::Wowo -- blorpoesu
=head1 DESCRIPTION
