Adjust test for the recent change (#19136) to Pod::Html

[p5sagit/p5-mst-13.2.git] / lib / Pod / ParseUtils.pm

diff --git a/lib/Pod/ParseUtils.pm b/lib/Pod/ParseUtils.pm
index 7d994c7..18e9626 100644 (file)
--- a/lib/Pod/ParseUtils.pm
+++ b/lib/Pod/ParseUtils.pm
@@ -10,7 +10,7 @@
 package Pod::ParseUtils;
 
 use vars qw($VERSION);
-$VERSION = 0.22;   ## Current version of this package
+$VERSION = 0.30;   ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 =head1 NAME
@@ -274,7 +274,7 @@ sub initialize {
 This method can be used to (re)parse a (new) hyperlink, i.e. the contents
 of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object.
 Warnings are stored in the B<warnings> property.
-E.g. sections like C<LE<lt>open(2)E<gt>> are deprected, as they do not point
+E.g. sections like C<LE<lt>open(2)E<gt>> are deprecated, as they do not point
 to Perl documents. C<LE<lt>DBI::foo(3p)E<gt>> is wrong as well, the manpage
 section can simply be dropped.
 
@@ -284,7 +284,7 @@ sub parse {
     my $self = shift;
     local($_) = $_[0];
     # syntax check the link and extract destination
-    my ($alttext,$page,$node,$type) = (undef,'','','');
+    my ($alttext,$page,$node,$type,$quoted) = (undef,'','','',0);
 
     $self->{_warnings} = [];
 
@@ -311,7 +311,7 @@ sub parse {
     # problem: a lot of people use (), or (1) or the like to indicate
     # man page sections. But this collides with L<func()> that is supposed
     # to point to an internal funtion...
-    my $page_rx = '[\w.]+(?:::[\w.]+)*(?:[(](?:\d\w*|)[)]|)';
+    my $page_rx = '[\w.-]+(?:::[\w.-]+)*(?:[(](?:\d\w*|)[)]|)';
     # page name only
     if(m!^($page_rx)$!o) {
         $page = $1;
@@ -321,6 +321,7 @@ sub parse {
     elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$!o) {
         ($alttext, $page, $node) = ($1, $2, $3);
         $type = 'section';
+        $quoted = 1; #... therefore | and / are allowed
     }
     # alttext and page
     elsif(m!^(.*?)\s*[|]\s*($page_rx)$!o) {
@@ -331,11 +332,13 @@ sub parse {
     elsif(m!^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$!) {
         ($alttext, $node) = ($1,$2);
         $type = 'section';
+        $quoted = 1;
     }
     # page and "section"
     elsif(m!^($page_rx)\s*/\s*"(.+)"$!o) {
         ($page, $node) = ($1, $2);
         $type = 'section';
+        $quoted = 1;
     }
     # page and item
     elsif(m!^($page_rx)\s*/\s*(.+)$!o) {
@@ -346,6 +349,7 @@ sub parse {
     elsif(m!^/?"(.+)"$!) {
         $node = $1;
         $type = 'section';
+        $quoted = 1;
     }
     # only item
     elsif(m!^\s*/(.+)$!) {
@@ -392,7 +396,7 @@ sub parse {
     if($page =~ /[(]\w*[)]$/) {
         $self->warning("(section) in '$page' deprecated");
     }
-    if($node =~ m:[|/]:) {
+    if(!$quoted && $node =~ m:[|/]:) {
         $self->warning("node '$node' contains non-escaped | or /");
     }
     if($alttext =~ m:[|/]:) {
@@ -422,11 +426,9 @@ sub _construct_text {
         $self->{_text} = $section;
     }
     else {
-        $self->{_text} = (!$section ? '' : 
-            $type eq 'item' ? "the $section entry" :
-                "the section on $section" ) .
-            ($page ? ($section ? ' in ':'') . "the $page$page_ext manpage" :
-                ' elsewhere in this document');
+        $self->{_text} = ($section || '') .
+            (($page && $section) ? ' in ' : '') .
+            "$page$page_ext";
     }
     # for being marked up later
     # use the non-standard markers P<> and Q<>, so that the resulting
@@ -439,11 +441,8 @@ sub _construct_text {
         $self->{_markup} = "Q<$section>";
     }
     else {
-        $self->{_markup} = (!$section ? '' : 
-            $type eq 'item' ? "the Q<$section> entry" :
-                "the section on Q<$section>" ) .
-            ($page ? ($section ? ' in ':'') . "the P<$page>$page_ext manpage" :
-                ' elsewhere in this document');
+        $self->{_markup} = (!$section ? '' : "Q<$section>") .
+            ($page ? ($section ? ' in ':'') . "P<$page>$page_ext" : '');
     }
 }
 
@@ -469,10 +468,10 @@ but without markers (read only). Depending on the link type this is one of
 the following alternatives (the + and * denote the portions of the text
 that are marked up):
 
-  the +perl+ manpage
-  the *$|* entry in the +perlvar+ manpage
-  the section on *OPTIONS* in the +perldoc+ manpage
-  the section on *DESCRIPTION* elsewhere in this document
+  +perl+                    L<perl>
+  *$|* in +perlvar+         L<perlvar/$|>
+  *OPTIONS* in +perldoc+    L<perldoc/"OPTIONS">
+  *DESCRIPTION*             L<"DESCRIPTION">
 
 =cut