Fix cross reference bug

The bug stopped POD files from being crossreferenced if they were more
than one directory below $Podpath

1 files changed, 68 insertions, 41 deletions

diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm
index 3e8db16fd2..f1cd250278 100644
--- a/ext/Pod-Html/lib/Pod/Html.pm
+++ b/ext/Pod-Html/lib/Pod/Html.pm
@@ -126,7 +126,8 @@ HTML converted forms can be linked to in cross references.
 
     --podroot=name
 
-Specify the base directory for finding library pods.
+Specify the base directory for finding library pods. This is prepended
+to each directory in podpath before searching for PODs.
 
 =item quiet
 
@@ -206,7 +207,7 @@ my $Backlink;
 my($Title, $Header);
 
 my %Pages = ();			# associative array used to find the location
-				#   of pages referenced by L<> links.
+                                #   of pages referenced by L<> links.
 
 my $Curdir = File::Spec->curdir;
 
@@ -214,19 +215,19 @@ init_globals();
 
 sub init_globals {
     $Htmlroot = "/";	    	# http-server base directory from which all
-				#   relative paths in $podpath stem.
+                                #   relative paths in $podpath stem.
     $Htmldir = "";	    	# The directory to which the html pages
-				# will (eventually) be written.
+                                # will (eventually) be written.
     $Htmlfile = "";		# write to stdout by default
     $Htmlfileurl = "";		# The url that other files would use to
-				# refer to this file.  This is only used
-				# to make relative urls that point to
-				# other files.
+                                # refer to this file.  This is only used
+                                # to make relative urls that point to
+                                # other files.
 
     $Podfile = "";		# read from stdin by default
     @Podpath = ();		# list of directories containing library pods.
     $Podroot = $Curdir;	        # filesystem base directory from which all
-				#   relative paths in $podpath stem.
+                                #   relative paths in $podpath stem.
     $Css = '';                  # Cascading style sheet
     $Recurse = 1;		# recurse on subdirectories in $podpath.
     $Quiet = 0;		        # not quiet by default
@@ -266,7 +267,8 @@ sub pod2html {
 
     # find all pod modules/pages in podpath, store in %Pages
     # - callback used to remove $Podroot from each file
-    Pod::Simple::Search->new->inc(0)->verbose($Verbose)
+    # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1)
+    Pod::Simple::Search->new->inc(0)->verbose($Verbose)->laborious(1)
 	->callback(\&_save_page)->survey(@Podpath);
 
     # set options for the parser
@@ -363,11 +365,10 @@ sub usage {
     die <<END_OF_USAGE;
 Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
            --podpath=<name>:...:<name> --podroot=<name>
-           --recurse --verbose --index
-           --norecurse --noindex
+           --recurse --verbose --index --norecurse --noindex
 
   --backlink     - turn =head1 directives into links pointing to the top of
-                   the page (off by default).
+                     the page (off by default).
   --css          - stylesheet URL
   --[no]header   - produce block header/footer (default is no headers).
   --help         - prints this message.
@@ -377,16 +378,16 @@ Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
   --[no]index    - generate an index at the top of the resulting html
                    (default behaviour).
   --infile       - filename for the pod to convert (input taken from stdin
-                   by default).
+		   by default).
   --outfile      - filename for the resulting html file (output sent to
                    stdout by default).
   --podpath      - colon-separated list of directories containing library
-                   pods (empty by default).
+                     pods (empty by default).
   --podroot      - filesystem base directory from which all relative paths
-                   in podpath stem (default is .).
+                     in podpath stem (default is .).
   --[no]quiet    - suppress some benign warning messages (default is off).
   --[no]recurse  - recurse on those subdirectories listed in podpath
-                   (default behaviour).
+                     (default behaviour).
   --title        - title that will appear in resulting html file.
   --[no]verbose  - self-explanatory (off by default).
 
@@ -402,22 +403,22 @@ sub parse_command_line {
 
     unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
     my $result = GetOptions(
-			    'backlink!'  => \$opt_backlink,
-			    'css=s'      => \$opt_css,
-			    'help'       => \$opt_help,
-			    'header!'    => \$opt_header,
-			    'htmldir=s'  => \$opt_htmldir,
-			    'htmlroot=s' => \$opt_htmlroot,
-			    'index!'     => \$opt_index,
-			    'infile=s'   => \$opt_infile,
-			    'outfile=s'  => \$opt_outfile,
-			    'podpath=s'  => \$opt_podpath,
-			    'podroot=s'  => \$opt_podroot,
-			    'quiet!'     => \$opt_quiet,
-			    'recurse!'   => \$opt_recurse,
-			    'title=s'    => \$opt_title,
-			    'verbose!'   => \$opt_verbose,
-			   );
+	                   'backlink!'  => \$opt_backlink,
+	                   'css=s'      => \$opt_css,
+	                   'help'       => \$opt_help,
+	                   'header!'    => \$opt_header,
+	                   'htmldir=s'  => \$opt_htmldir,
+	                   'htmlroot=s' => \$opt_htmlroot,
+	                   'index!'     => \$opt_index,
+	                   'infile=s'   => \$opt_infile,
+	                   'outfile=s'  => \$opt_outfile,
+	                   'podpath=s'  => \$opt_podpath,
+	                   'podroot=s'  => \$opt_podroot,
+	                   'quiet!'     => \$opt_quiet,
+	                   'recurse!'   => \$opt_recurse,
+	                   'title=s'    => \$opt_title,
+	                   'verbose!'   => \$opt_verbose,
+    );
     usage("-", "invalid parameters") if not $result;
 
     usage("-") if defined $opt_help;	# see if the user asked for help
@@ -488,8 +489,8 @@ sub _save_page {
     my ($modspec, $modname) = @_;
 
     # Remove $Podroot from path for cross referencing
-    my $rel_path = substr($modspec, length($Podroot) + 1);
-   
+    my $rel_path = substr($modspec, length($Podroot));
+    
     my ($file, $dir) = fileparse($rel_path, qr/\.[^.]*/); # strip .ext
     $Pages{$modname} = $dir . $file;
 }
@@ -523,20 +524,46 @@ sub resolve_pod_page_link {
         $section = '';
     }
 
-   unless (exists $self->pages->{$to}) {
-	warn "Cannot find $to in podpath: cannot resolve link.\n" 
-	    unless $self->quiet;
-	return '';
+    my $path; # path to $to according to %Pages
+    unless (exists $self->pages->{$to}) {
+	# try to find a POD that ends with $to and use that
+	# e.g., given L<XHTML>, if there is no $Podpath/XHTML in %Pages,
+	# look for $Podpath/*/XHTML in %Pages, with * being any path,
+	# as a substitute (e.g., $Podpath/Pod/Simple/XHTML)
+	my @matches;
+	foreach my $modname (keys %{$self->pages}) {
+	    push @matches, $modname if $modname =~ /$to\z/;
+	}
+
+	if ($#matches == -1) {
+	    warn "Cannot find $to in podpath: " . 
+		 "cannot find suitable replacement path, cannot resolve link\n"
+		 unless $self->quiet;
+	    return '';
+	} elsif ($#matches == 0) {
+	    warn "Cannot find $to in podpath: " .
+		 "using $matches[0] as replacement path to $to\n" 
+		 unless $self->quiet;
+	    $path = $self->pages->{$matches[0]};
+	} else {
+	    warn "Cannot find $to in podpath: " .
+		 "more than one possible replacement path to $to, " .
+		 "using $matches[-1]\n" unless $self->quiet;
+	    # Use last one found so that newer perl PODs are used
+	    $path = $self->pages->{$matches[-1]};
+	}
+    } else {
+	$path = $self->pages->{$to};
     }
 
-    my $url = File::Spec->catfile($self->htmlroot, $self->pages->{$to});
+    my $url = File::Spec->catfile($self->htmlroot, $path);
     if ($self->htmlfileurl ne '') {
 	# then $self->htmlroot eq '' (by definition of htmlfileurl) so
 	# $self->htmldir needs to be prepended to link to get the absolute path
 	# that will be relativized
 	$url = relativize_url($self->htmldir.$url, $self->htmlfileurl);
-    }	
-    
+    }
+
     return $url . ".html$section";
 }