Upgrade to Archive::Tar 1.32.
[p5sagit/p5-mst-13.2.git] / lib / Pod / Html.pm
index 8dd0415..232bd2b 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 require Exporter;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = 1.07;
+$VERSION = 1.08;
 @ISA = qw(Exporter);
 @EXPORT = qw(pod2html htmlify);
 @EXPORT_OK = qw(anchorify);
@@ -1129,8 +1129,9 @@ my $EmittedItem;
 
 sub emit_item_tag($$$){
     my( $otext, $text, $compact ) = @_;
-    my $item = fragment_id( $text , -generate);
-
+    my $item = fragment_id( depod($text) , -generate);
+    Carp::confess("Undefined fragment '$text' (".depod($text).") from fragment_id() in emit_item_tag() in $Podfile")
+        if !defined $item;
     $EmittedItem = $item;
     ### print STDERR "emit_item_tag=$item ($text)\n";
 
@@ -1186,7 +1187,7 @@ sub process_item {
     # all the list variants:
     if( $text =~ /\A\*/ ){ # bullet
         $emitted = emit_li( 'ul' );
-        if ($text =~ /\A\*\s+(.+)\Z/s ) { # with additional text
+        if ($text =~ /\A\*\s+(\S.*)\Z/s ) { # with additional text
             my $tag = $1;
             $otext =~ s/\A\*\s+//;
             emit_item_tag( $otext, $tag, 1 );
@@ -1194,7 +1195,7 @@ sub process_item {
 
     } elsif( $text =~ /\A\d+/ ){ # numbered list
         $emitted = emit_li( 'ol' );
-        if ($text =~ /\A(?>\d+\.?)\s*(.+)\Z/s ) { # with additional text
+        if ($text =~ /\A(?>\d+\.?)\s*(\S.*)\Z/s ) { # with additional text
             my $tag = $1;
             $otext =~ s/\A\d+\.?\s*//;
             emit_item_tag( $otext, $tag, 1 );
@@ -1300,8 +1301,8 @@ sub process_begin {
 sub process_end {
     my($whom, $text) = @_;
     $whom = lc($whom);
-    if ($Begin_Stack[-1] ne $whom ) {
-       die "Unmatched begin/end at chunk $Paragraph\n"
+    if (!defined $Begin_Stack[-1] or $Begin_Stack[-1] ne $whom ) {
+       Carp::confess("Unmatched begin/end at chunk $Paragraph in pod $Podfile\n")
     }
     pop( @Begin_Stack );
 }
@@ -1447,20 +1448,36 @@ sub process_puretext {
     foreach my $word (@words) {
        # skip space runs
        next if $word =~ /^\s*$/;
-       # see if we can infer a link
-       if( $notinIS && $word =~ /^(\w+)\((.*)\)$/ ) {
+       # see if we can infer a link or a function call
+       #
+       # NOTE: This is a word based search, it won't automatically
+       # mark "substr($var, 1, 2)" because the 1st word would be "substr($var"
+       # User has to enclose those with proper C<>
+
+       if( $notinIS && $word =~
+           m/
+               ^([a-z_]{2,})                 # The function name
+               \(
+                   ([0-9][a-z]*              # Manual page(1) or page(1M)
+                   |[^)]*[\$\@\%][^)]+       # ($foo), (1, @foo), (%hash)
+                   |                         # ()
+                   )
+               \)
+               ([.,;]?)$                     # a possible punctuation follows
+           /xi
+       ) {
            # has parenthesis so should have been a C<> ref
             ## try for a pagename (perlXXX(1))?
-            my( $func, $args ) = ( $1, $2 );
+            my( $func, $args, $rest ) = ( $1, $2, $3 || '' );
             if( $args =~ /^\d+$/ ){
                 my $url = page_sect( $word, '' );
                 if( defined $url ){
-                    $word = "<a href=\"$url\">the $word manpage</a>";
+                    $word = qq(<a href="$url" class="man">the $word manpage</a>$rest);
                     next;
                 }
             }
             ## try function name for a link, append tt'ed argument list
-            $word = emit_C( $func, '', "($args)");
+            $word = emit_C( $func, '', "($args)") . $rest;
 
 #### disabled. either all (including $\W, $\w+{.*} etc.) or nothing.
 ##      } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) {
@@ -1494,8 +1511,8 @@ sub process_puretext {
 #
 
 sub process_text1($$;$$);
-sub pattern ($) { $_[0] ? '[^\S\n]+'.('>' x ($_[0] + 1)) : '>' }
-sub closing ($) { local($_) = shift; (defined && s/\s+$//) ? length : 0 }
+sub pattern ($) { $_[0] ? '\s+'.('>' x ($_[0] + 1)) : '>' }
+sub closing ($) { local($_) = shift; (defined && s/\s+\z//) ? length : 0 }
 
 sub process_text {
     return if $Ignore;
@@ -1508,17 +1525,15 @@ sub process_text {
 sub process_text_rfc_links {
     my $text = shift;
 
-    #  For every "RFCnnnn" or "RFC nnn" link it to the authoritative
-    #  source. Do not use (i) option here. Require RFC to be written in
+    # For every "RFCnnnn" or "RFC nnn", link it to the authoritative
+    # ource. Do not use the /i modifier here. Require "RFC" to be written in
     #  in capital letters.
 
     $text =~ s{
-         (?=^\S)            # positive lookahead, make sure this is "text" paragraph
-         (.*?)              # Grab leading text
-         (?<=[^<>])         # Make sure this is not an URL already
-           (RFC\s*(\d{1,5}))(?=\s) # max 5 digits
+       (?<=[^<>[:alpha:]])           # Make sure this is not an URL already
+       (RFC\s*([0-9]{1,5}))(?![0-9]) # max 5 digits
     }
-    {$1<a href="http://www.ietf.org/rfc/rfc$3.txt">$2</a>}gx;
+    {<a href="http://www.ietf.org/rfc/rfc$2.txt" class="rfc">$1</a>}gx;
 
     $text;
 }
@@ -1598,7 +1613,11 @@ sub process_text1($$;$$){
        # check for link patterns
        if( $par =~ m{^([^/]+?)/(?!")(.*?)$} ){     # name/ident
             # we've got a name/ident (no quotes)
-            ( $page, $ident ) = ( $1, $2 );
+            if (length $2) {
+                ( $page, $ident ) = ( $1, $2 );
+            } else {
+                ( $page, $section ) = ( $1, $2 );
+            }
             ### print STDERR "--> L<$par> to page $page, ident $ident\n";
 
        } elsif( $par =~ m{^(.*?)/"?(.*?)"?$} ){ # [name]/"section"
@@ -1686,11 +1705,11 @@ sub process_text1($$;$$){
 
     } elsif( $func eq 'X' ){
        # X<> - ignore
-       $$rstr =~ s/^[^>]*>//;
-
+       warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n"
+           unless $$rstr =~ s/^[^>]*>// or $Quiet;
     } elsif( $func eq 'Z' ){
        # Z<> - empty
-       warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n"
+       warn "$0: $Podfile: invalid Z<> in paragraph $Paragraph.\n"
            unless $$rstr =~ s/^>// or $Quiet;
 
     } else {
@@ -1708,8 +1727,10 @@ sub process_text1($$;$$){
        }
        if( $lev == 1 ){
            $res .= pure_text( $$rstr );
-       } else {
-           warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet;
+       } elsif( ! $Quiet ) {
+            my $snippet = substr($$rstr,0,60);
+            warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph: '$snippet'.\n" 
+                
        }
        $res = process_text_rfc_links($res);
     }
@@ -1724,7 +1745,7 @@ sub go_ahead($$$){
     my $res = '';
     my @closing = ($closing);
     while( $$rstr =~
-      s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|@{[pattern $closing[0]]})//s ){
+      s/\A(.*?)(([BCEFILSXZ])<(<+\s+)?|@{[pattern $closing[0]]})//s ){
        $res .= $1;
        unless( $3 ){
            shift @closing;
@@ -1734,7 +1755,10 @@ sub go_ahead($$$){
        }
        $res .= $2;
     }
-    warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet;
+    unless ($Quiet) {
+        my $snippet = substr($$rstr,0,60);
+        warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph (go_ahead): '$snippet'.\n" 
+    }          
     return $res;
 }
 
@@ -1930,10 +1954,13 @@ sub coderef($$){
     my( $url );
 
     my $fid = fragment_id( $item );
+    
     if( defined( $page ) && $page ne "" ){
        # we have been given a $page...
        $page =~ s{::}{/}g;
 
+        Carp::confess("Undefined fragment '$item' from fragment_id() in coderef() in $Podfile")
+            if !defined $fid;    
        # Do we take it? Item could be a section!
        my $base = $Items{$fid} || "";
        $base =~ s{[^/]*/}{};
@@ -2101,13 +2128,12 @@ sub fragment_id_readable {
 
     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:]]//;
+    # leave the words for the fragment identifier,
+    # change everything else to underbars.
+    $text =~ s/[^A-Za-z0-9_]+/_/g; # do not use \W to avoid locale dependency.
+    $text =~ s/_{2,}/_/g;
+    $text =~ s/\A_//;
+    $text =~ s/_\Z//;
 
     unless ($text)
     {
@@ -2131,11 +2157,11 @@ sub fragment_id_readable {
 }}
 
 my @HC;
-sub fragment_id_obfusticated {  # This was the old "_2d_2d__"
+sub fragment_id_obfuscated {  # 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? Normalize by obfuscating the fragment id to make it unique
     $text =~ s/\s+/_/sg;
 
     $text =~ s{(\W)}{
@@ -2176,9 +2202,9 @@ 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,/& ]+)?$};
 
-       fragment_id_readable($text, $generate);
+       return fragment_id_readable($text, $generate);
     } else {
-       return undef();
+       return;
     }
 }