From: Jari Aalto <jari.aalto@poboxes.com>
Date: Wed, 7 Mar 2007 10:04:15 +0000 (+0200)
Subject: Re: [perl #41687] [PATCH] v5.8.8 pod2html -- Add --[no]fragmentuniq to support more... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bc75160cf09f3e1464ff9548cf947e811c342c67;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #41687] [PATCH] v5.8.8 pod2html -- Add --[no]fragmentuniq to support more readable <a name=..> refs
Message-ID: <87y7m9scn4.fsf@w2kpicasso.cante.net>

with test adjustments

p4raw-id: //depot/perl@30584
---

diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm
index 03ac8f0..32b71e1 100644
--- a/lib/Pod/Html.pm
+++ b/lib/Pod/Html.pm
@@ -231,7 +231,6 @@ This program is distributed under the Artistic License.
 
 =cut
 
-
 my($Cachedir);
 my($Dircache, $Itemcache);
 my @Begin_Stack;
@@ -1130,7 +1129,7 @@ my $EmittedItem;
 
 sub emit_item_tag($$$){
     my( $otext, $text, $compact ) = @_;
-    my $item = fragment_id( $text );
+    my $item = fragment_id( $text , -generate);
 
     $EmittedItem = $item;
     ### print STDERR "emit_item_tag=$item ($text)\n";
@@ -1139,9 +1138,9 @@ sub emit_item_tag($$$){
     if ($Items_Named{$item}++) {
 	print HTML process_text( \$otext );
     } else {
-        my $name = 'item_' . $item;
+        my $name = $item;
         $name = anchorify($name);
-	print HTML qq{<a name="$name">}, process_text( \$otext ), '</a>';
+	print HTML qq{<a name="$name" class="item">}, process_text( \$otext ), '</a>';
     }
     print HTML "</strong>\n";
     undef( $EmittedItem );
@@ -1997,7 +1996,8 @@ sub htmlify {
     $heading =~ s/\s+\Z//;
     $heading =~ s/\A\s+//;
     # The hyphen is a disgrace to the English language.
-    $heading =~ s/[-"?]//g;
+    # $heading =~ s/[-"?]//g;
+    $heading =~ s/["?]//g;
     $heading = lc( $heading );
     return $heading;
 }
@@ -2073,14 +2073,70 @@ sub depod1($;$$){
   return $res;
 }
 
+{
+    my %seen;   # static fragment record hash
+
+sub fragment_id_readable {
+    my $text     = shift;
+    my $generate = shift;   # optional flag
+
+    my $orig = $text;
+
+    # just clean the punctuation and leave the words for the
+    # fragment identifier.
+    $text =~ s/([[:punct:]\s])+/$1/g;
+    $text =~ s/[[:punct:]\s]+\Z//g;
+
+    #   "=item --version", remove leading punctuation.
+    $text =~ s/^[-[:punct:]]//;
+
+    unless ($text)
+    {
+        # Nothing left after removing punctuation, so leave it as is
+        # E.g. if option is named: "=item -#"
+
+        $text = $orig;
+    }
+
+    if ($generate) {
+        if ( exists $seen{$text} ) {
+            # This already exists, make it unique
+            $seen{$text}++;
+            $text = $text . $seen{$text};
+        } else {
+            $seen{$text} = 1;  # first time seen this fragment
+        }
+    }
+
+    $text;
+}}
+
+my @HC;
+sub fragment_id_obfusticated {  # This was the old "_2d_2d__"
+    my $text     = shift;
+    my $generate = shift;   # optional flag
+
+    # text? Normalize by obfusticating the fragment id to make it unique
+    $text =~ s/\s+/_/sg;
+
+    $text =~ s{(\W)}{
+        defined( $HC[ord($1)] ) ? $HC[ord($1)]
+        : ( $HC[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe;
+    $text = substr( $text, 0, 50 );
+
+    $text;
+}
+
 #
 # fragment_id - construct a fragment identifier from:
 #   a) =item text
 #   b) contents of C<...>
 #
-my @HC;
+
 sub fragment_id {
-    my $text = shift();
+    my $text     = shift;
+    my $generate = shift;   # optional flag
+
     $text =~ s/\s+\Z//s;
     if( $text ){
 	# a method or function?
@@ -2101,12 +2157,7 @@ sub fragment_id {
 	return $1 if $text =~ m{^([a-z\d_]+)(\s+[A-Z,/& ][A-Z\d,/& ]*)?$};
 	return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$};
 
-	# text? normalize!
-	$text =~ s/\s+/_/sg;
-	$text =~ s{(\W)}{
-         defined( $HC[ord($1)] ) ? $HC[ord($1)]
-                 : ( $HC[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe;
-        $text = substr( $text, 0, 50 );
+	fragment_id_readable($text, $generate);
     } else {
 	return undef();
     }
diff --git a/lib/Pod/t/htmllink.t b/lib/Pod/t/htmllink.t
index 7d03e07..25147bb 100644
--- a/lib/Pod/t/htmllink.t
+++ b/lib/Pod/t/htmllink.t
@@ -108,19 +108,19 @@ __DATA__
 <h2><a name="section_three">section three</a></h2>
 <p>This is section three.</p>
 <dl>
-<dt><strong><a name="item_item1">item1</a></strong>
+<dt><strong><a name="item1" class="item">item1</a></strong>
 
 <dd>
 <p>This is item one.</p>
 </dd>
 </li>
-<dt><strong><a name="item_item_2">item 2</a></strong>
+<dt><strong><a name="item_2" class="item">item 2</a></strong>
 
 <dd>
 <p>This is item two.</p>
 </dd>
 </li>
-<dt><strong><a name="item_item_three">item three</a></strong>
+<dt><strong><a name="item_three" class="item">item three</a></strong>
 
 <dd>
 <p>This is item three.</p>
diff --git a/lib/Pod/t/htmlview.t b/lib/Pod/t/htmlview.t
index 9b9bb90..03a1f1a 100644
--- a/lib/Pod/t/htmlview.t
+++ b/lib/Pod/t/htmlview.t
@@ -86,13 +86,13 @@ other <strong>cool </strong></em>&gt; stuff &gt;&gt;</p>
 <h2><a name="new__"><code>new()</code></a></h2>
 <p>Constructor method.  Accepts the following config options:</p>
 <dl>
-<dt><strong><a name="item_foo">foo</a></strong>
+<dt><strong><a name="foo" class="item">foo</a></strong>
 
 <dd>
 <p>The foo item.</p>
 </dd>
 </li>
-<dt><strong><a name="item_bar">bar</a></strong>
+<dt><strong><a name="bar" class="item">bar</a></strong>
 
 <dd>
 <p>The bar item.</p>
@@ -106,7 +106,7 @@ other <strong>cool </strong></em>&gt; stuff &gt;&gt;</p>
 <p>The waz item.</p>
 </li>
 </ul>
-<dt><strong><a name="item_baz">baz</a></strong>
+<dt><strong><a name="baz" class="item">baz</a></strong>
 
 <dd>
 <p>The baz item.</p>
@@ -115,20 +115,20 @@ other <strong>cool </strong></em>&gt; stuff &gt;&gt;</p>
 </dl>
 <p>Title on the same line as the =item + * bullets</p>
 <ul>
-<li><strong><a name="item_black_cat"><code>Black</code> Cat</a></strong>
+<li><strong><a name="black_cat" class="item"><code>Black</code> Cat</a></strong>
 
-<li><strong><a name="item_sat_on_the">Sat <em>on</em>&nbsp;the</a></strong>
+<li><strong><a name="sat_on_the" class="item">Sat <em>on</em>&nbsp;the</a></strong>
 
-<li><strong><a name="item_mat_3c_21_3e">Mat&lt;!&gt;</a></strong>
+<li><strong><a name="mat" class="item">Mat&lt;!&gt;</a></strong>
 
 </ul>
 <p>Title on the same line as the =item + numerical bullets</p>
 <ol>
-<li><strong><a name="item_cat">Cat</a></strong>
+<li><strong><a name="cat" class="item">Cat</a></strong>
 
-<li><strong><a name="item_sat">Sat</a></strong>
+<li><strong><a name="sat" class="item">Sat</a></strong>
 
-<li><strong><a name="item_mat">Mat</a></strong>
+<li><strong><a name="mat2" class="item">Mat</a></strong>
 
 </ol>
 <p>No bullets, no title</p>