This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Sync Pod::Usage with the CPAN version
[perl5.git] / lib / Pod / Html.pm
index d8807a3..8c999cc 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 require Exporter;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = 1.0502;
+$VERSION = 1.07;
 @ISA = qw(Exporter);
 @EXPORT = qw(pod2html htmlify);
 @EXPORT_OK = qw(anchorify);
@@ -32,9 +32,20 @@ Converts files from pod format (see L<perlpod>) to HTML format.  It
 can automatically generate indexes and cross-references, and it keeps
 a cache of things it knows how to cross-reference.
 
-=head1 ARGUMENTS
+=head1 FUNCTIONS
 
-Pod::Html takes the following arguments:
+=head2 pod2html
+
+    pod2html("pod2html",
+             "--podpath=lib:ext:pod:vms",
+             "--podroot=/usr/src/perl",
+             "--htmlroot=/perl/nmanual",
+             "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
+             "--recurse",
+             "--infile=foo.pod",
+             "--outfile=/perl/nmanual/foo.html");
+
+pod2html takes the following arguments:
 
 =over 4
 
@@ -187,16 +198,20 @@ Display progress messages.  By default, they won't be displayed.
 
 =back
 
-=head1 EXAMPLE
+=head2 htmlify
 
-    pod2html("pod2html",
-            "--podpath=lib:ext:pod:vms",
-            "--podroot=/usr/src/perl",
-            "--htmlroot=/perl/nmanual",
-            "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
-            "--recurse",
-            "--infile=foo.pod",
-            "--outfile=/perl/nmanual/foo.html");
+    htmlify($heading);
+
+Converts a pod section specification to a suitable section specification
+for HTML. Note that we keep spaces and special characters except 
+C<", ?> (Netscape problem) and the hyphen (writer's problem...).
+
+=head2 anchorify
+
+    anchorify(@heading);
+
+Similar to C<htmlify()>, but turns non-alphanumerics into underscores.  Note
+that C<anchorify()> is not exported by default.
 
 =head1 ENVIRONMENT
 
@@ -252,7 +267,6 @@ my %Items = ();                     # associative array used to find the location
 
 my %Local_Items;
 my $Is83;
-my $PTQuote;
 
 my $Curdir = File::Spec->curdir;
 
@@ -303,7 +317,6 @@ sub init_globals {
                                #   to prevent the first <hr /> directive.
     $Paragraph = '';           # which paragraph we're processing (used
                                #   for error messages)
-    $PTQuote = 0;               # status of double-quote conversion
     %Sections = ();            # sections within this page
 
     %Local_Items = ();
@@ -462,10 +475,12 @@ sub pod2html {
 END_OF_BLOCK
 
     print HTML <<END_OF_HEAD;
+<?xml version="1.0" ?>
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml">
 <head>
 <title>$Title</title>$csslink
+<meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:$Config{perladmin}" />
 </head>
 
@@ -496,8 +511,6 @@ END_OF_HEAD
     my $need_dd = 0;
     warn "Converting input file $Podfile\n" if $Verbose;
     foreach my $i (0..$#poddata){
-        $PTQuote = 0; # status of quote conversion
-
        $_ = $poddata[$i];
        $Paragraph = $i+1;
        if (/^(=.*)/s) {        # is it a pod directive?
@@ -524,7 +537,7 @@ END_OF_HEAD
                } elsif (/^=over\s*(.*)/) {             # =over N
                    process_over();
                } elsif (/^=back/) {            # =back
-                   process_back();
+                   process_back($need_dd);
                } elsif (/^=for\s+(\S+)\s*(.*)/si) {# =for
                    process_for($1,$2);
                } else {
@@ -571,11 +584,9 @@ END_OF_HEAD
                ## end of experimental
 
                if( $after_item ){
-                   print HTML "$text\n";
                    $After_Lpar = 1;
-               } else {
-                   print HTML "<p>$text</p>\n";
                }
+               print HTML "<p>$text</p>\n";
            }
            print HTML "</dd>\n" if $need_dd;
            $after_item = 0;
@@ -637,7 +648,7 @@ Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
                    pods (empty by default).
   --podroot      - filesystem base directory from which all relative paths
                    in podpath stem (default is .).
-  --[no]quiet    - supress some benign warning messages (default is off).
+  --[no]quiet    - suppress some benign warning messages (default is off).
   --[no]recurse  - recurse on those subdirectories listed in podpath
                    (default behaviour).
   --title        - title that will appear in resulting html file.
@@ -959,6 +970,19 @@ sub scan_dir {
            $Pages{$_}  = "" unless defined $Pages{$_};
            $Pages{$_} .= "$dir/$_.pm:";
            push(@pods, "$dir/$_.pm");
+       } elsif (-T "$dir/$_") {                            # script(?)
+           local *F;
+           if (open(F, "$dir/$_")) {
+               my $line;
+               while (defined($line = <F>)) {
+                   if ($line =~ /^=(?:pod|head1)/) {
+                       $Pages{$_}  = "" unless defined $Pages{$_};
+                       $Pages{$_} .= "$dir/$_.pod:";
+                       last;
+                   }
+               }
+               close(F);
+           }
        }
     }
     closedir(DIR);
@@ -1107,7 +1131,7 @@ sub emit_item_tag($$$){
         $name = anchorify($name);
        print HTML qq{<a name="$name">}, process_text( \$otext ), '</a>';
     }
-    print HTML "</strong><br />\n";
+    print HTML "</strong>\n";
     undef( $EmittedItem );
 }
 
@@ -1139,7 +1163,7 @@ sub process_item {
 
     # formatting: insert a paragraph if preceding item has >1 paragraph
     if( $After_Lpar ){
-       print HTML "<p></p>\n";
+       print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
        $After_Lpar = 0;
     }
 
@@ -1172,7 +1196,6 @@ sub process_item {
         }
         $need_dd = 1;
     }
-    print HTML "</$emitted>" if $emitted;
     print HTML "\n";
     return $need_dd;
 }
@@ -1191,6 +1214,7 @@ sub process_over {
 # process_back - process a pod back tag and convert it to HTML format.
 #
 sub process_back {
+    my $need_dd = shift;
     if( $Listlevel == 0 ){
        warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
        return;
@@ -1201,7 +1225,7 @@ sub process_back {
     # $Listend[$Listlevel] may have never been initialized.
     $Listlevel--;
     if( defined $Listend[$Listlevel] ){
-       print HTML '<p></p>' if $After_Lpar;
+       print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
        print HTML $Listend[$Listlevel];
         print HTML "\n";
         pop( @Listend );
@@ -1380,12 +1404,12 @@ sub process_pre {
 #
 sub pure_text($){
     my $text = shift();
-    process_puretext( $text, \$PTQuote, 1 );
+    process_puretext( $text, 1 );
 }
 
 sub inIS_text($){
     my $text = shift();
-    process_puretext( $text, \$PTQuote, 0 );
+    process_puretext( $text, 0 );
 }
 
 #
@@ -1393,21 +1417,14 @@ sub inIS_text($){
 #  double-quotes and handling implicit C<> links.
 #
 sub process_puretext {
-    my($text, $quote, $notinIS) = @_;
+    my($text, $notinIS) = @_;
 
-    ## Guessing at func() or [$@%&]*var references in plain text is destined
+    ## Guessing at func() or [\$\@%&]*var references in plain text is destined
     ## to produce some strange looking ref's. uncomment to disable:
     ## $notinIS = 0;
 
     my(@words, $lead, $trail);
 
-    # convert double-quotes to single-quotes
-    if( $$quote && $text =~ s/"/''/s ){
-        $$quote = 0;
-    }
-    while ($text =~ s/"([^"]*)"/``$1''/sg) {};
-    $$quote = 1 if $text =~ s/"/``/s;
-
     # keep track of leading and trailing white-space
     $lead  = ($text =~ s/\A(\s+)//s ? $1 : "");
     $trail = ($text =~ s/(\s+)\Z//s ? $1 : "");
@@ -1473,6 +1490,7 @@ sub process_text {
     return if $Ignore;
     my( $tref ) = @_;
     my $res = process_text1( 0, $tref );
+    $res =~ s/\s+$//s;
     $$tref = $res;
 }
 
@@ -1808,10 +1826,9 @@ sub page_sect($$) {
            $section = "#$section" if $section;
             ### print STDERR "...section=$section\n";
 
-           # check if there is a .pod with the page name
-           if ($Pages{$page} =~ /([^:]*)\.pod:/) {
-               $link = "$Htmlroot/$1.html$section";
-           } elsif ($Pages{$page} =~ /([^:]*)\.pm:/) {
+           # check if there is a .pod with the page name.
+           # for L<Foo>, Foo.(pod|pm) is preferred to A/Foo.(pod|pm)
+           if ($Pages{$page} =~ /([^:]*)\.(?:pod|pm):/) {
                $link = "$Htmlroot/$1.html$section";
            } else {
                $link = "";
@@ -1883,7 +1900,7 @@ sub coderef($$){
     my( $url );
 
     my $fid = fragment_id( $item );
-    if( defined( $page ) ){
+    if( defined( $page ) && $page ne "" ){
        # we have been given a $page...
        $page =~ s{::}{/}g;
 
@@ -2013,7 +2030,7 @@ sub depod1($;$$){
   return $res unless defined $$rstr;
   if( ! defined( $func ) ){
       # skip to next begin of an interior sequence
-      while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?// ){
+      while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?//s ){
          # recurse into its text
          $res .= $1 . depod1( $rstr, $2, closing $3);
       }
@@ -2032,7 +2049,7 @@ sub depod1($;$$){
       # all others: either recurse into new function or
       # terminate at closing angle bracket
       my $term = pattern $closing;
-      while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)// ){
+      while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){
          $res .= $1;
          last unless $3;
           $res .= depod1( $rstr, $3, closing $4 );
@@ -2059,7 +2076,7 @@ sub fragment_id {
        return $1 if $text =~ /->\s*(\w+)\s*\(?/;
 
        # a variable name?
-       return $1 if $text =~ /^([$@%*]\S+)/;
+       return $1 if $text =~ /^([\$\@%*]\S+)/;
 
        # some pattern matching operator?
        return $1 if $text =~ m|^(\w+/).*/\w*$|;
@@ -2069,7 +2086,7 @@ sub fragment_id {
 
        # honour the perlfunc manpage: func [PAR[,[ ]PAR]...]
        # and some funnies with ... Module ...
-       return $1 if $text =~ m{^([a-z\d_]+)(\s+[A-Z\d,/& ]+)?$};
+       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!