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 c4af19c..8c999cc 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 require Exporter;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = 1.0501;
+$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
 
@@ -78,6 +89,20 @@ section.  By default, no headers are generated.
 
 Displays the usage message.
 
+=item hiddendirs
+
+    --hiddendirs
+    --nohiddendirs
+
+Include hidden directories in the search for POD's in podpath if recurse
+is set.
+The default is not to traverse any directory whose name begins with C<.>.
+See L</"podpath"> and L</"recurse">.
+
+[This option is for backward compatibility only.
+It's hard to imagine that one would usefully create a module with a
+name component beginning with C<.>.]
+
 =item htmldir
 
     --htmldir=name
@@ -173,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
 
@@ -213,6 +242,7 @@ my $Css;
 
 my $Recurse;
 my $Quiet;
+my $HiddenDirs;
 my $Verbose;
 my $Doindex;
 
@@ -237,7 +267,6 @@ my %Items = ();                     # associative array used to find the location
 
 my %Local_Items;
 my $Is83;
-my $PTQuote;
 
 my $Curdir = File::Spec->curdir;
 
@@ -288,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 = ();
@@ -447,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>
 
@@ -481,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?
@@ -509,13 +537,13 @@ 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 {
                    /^=(\S*)\s*/;
                    warn "$0: $Podfile: unknown pod directive '$1' in "
-                      . "paragraph $Paragraph.  ignoring.\n";
+                      . "paragraph $Paragraph.  ignoring.\n" unless $Quiet;
                }
            }
            $Top = 0;
@@ -556,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;
@@ -604,6 +630,7 @@ Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
   --flush        - flushes the item and directory caches.
   --[no]header   - produce block header/footer (default is no headers).
   --help         - prints this message.
+  --hiddendirs   - search hidden directories in podpath
   --htmldir      - directory for resulting HTML files.
   --htmlroot     - http-server base directory from which all relative paths
                    in podpath stem (default is /).
@@ -621,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.
@@ -636,7 +663,7 @@ sub parse_command_line {
     my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,$opt_help,
        $opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,
        $opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_quiet,
-       $opt_recurse,$opt_title,$opt_verbose);
+       $opt_recurse,$opt_title,$opt_verbose,$opt_hiddendirs);
 
     unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
     my $result = GetOptions(
@@ -646,6 +673,7 @@ sub parse_command_line {
                            'flush'      => \$opt_flush,
                            'header!'    => \$opt_header,
                            'help'       => \$opt_help,
+                           'hiddendirs!'=> \$opt_hiddendirs,
                            'htmldir=s'  => \$opt_htmldir,
                            'htmlroot=s' => \$opt_htmlroot,
                            'index!'     => \$opt_index,
@@ -676,6 +704,7 @@ sub parse_command_line {
     $Htmlroot = $opt_htmlroot if defined $opt_htmlroot;
     $Doindex  = $opt_index    if defined $opt_index;
     $Podfile  = $opt_infile   if defined $opt_infile;
+    $HiddenDirs = $opt_hiddendirs if defined $opt_hiddendirs;
     $Htmlfile = $opt_outfile  if defined $opt_outfile;
     $Podroot  = $opt_podroot  if defined $opt_podroot;
     $Quiet    = $opt_quiet    if defined $opt_quiet;
@@ -871,7 +900,7 @@ sub scan_podpath {
 
            scan_items( \%Items, "$pod", @poddata);
        } else {
-           warn "$0: shouldn't be here (line ".__LINE__."\n";
+           warn "$0: shouldn't be here (line ".__LINE__."\n" unless $Quiet;
        }
     }
     @poddata = ();     # clean-up a bit
@@ -921,7 +950,9 @@ sub scan_dir {
     opendir(DIR, $dir) ||
        die "$0: error opening directory $dir: $!\n";
     while (defined($_ = readdir(DIR))) {
-       if (-d "$dir/$_" && $_ ne "." && $_ ne "..") {      # directory
+       if (-d "$dir/$_" && $_ ne "." && $_ ne ".."
+           && ($HiddenDirs || !/^\./)
+       ) {         # directory
            $Pages{$_}  = "" unless defined $Pages{$_};
            $Pages{$_} .= "$dir/$_:";
            push(@subdirs, $_);
@@ -939,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);
@@ -1045,7 +1089,7 @@ sub process_head {
     my $level = $1;
 
     if( $Listlevel ){
-       warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph.  ignoring.\n";
+       warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
         while( $Listlevel ){
             process_back();
         }
@@ -1087,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 );
 }
 
@@ -1113,13 +1157,13 @@ sub process_item {
     # bad!  but, the proper thing to do seems to be to just assume
     # they did do an =over.  so warn them once and then continue.
     if( $Listlevel == 0 ){
-       warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph.  ignoring.\n";
+       warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
        process_over();
     }
 
     # 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;
     }
 
@@ -1152,7 +1196,6 @@ sub process_item {
         }
         $need_dd = 1;
     }
-    print HTML "</$emitted>" if $emitted;
     print HTML "\n";
     return $need_dd;
 }
@@ -1171,8 +1214,9 @@ 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";
+       warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph.  ignoring.\n" unless $Quiet;
        return;
     }
 
@@ -1181,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 );
@@ -1360,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 );
 }
 
 #
@@ -1373,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 : "");
@@ -1453,6 +1490,7 @@ sub process_text {
     return if $Ignore;
     my( $tref ) = @_;
     my $res = process_text1( 0, $tref );
+    $res =~ s/\s+$//s;
     $$tref = $res;
 }
 
@@ -1601,7 +1639,7 @@ sub process_text1($$;$$){
 
             # warning; show some text.
             $linktext = $opar unless defined $linktext;
-            warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n";
+            warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n" unless $Quiet;
         }
 
         # now we have a URL or just plain code
@@ -1624,7 +1662,7 @@ sub process_text1($$;$$){
     } elsif( $func eq 'Z' ){
        # Z<> - empty
        warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n"
-           unless $$rstr =~ s/^>//;
+           unless $$rstr =~ s/^>// or $Quiet;
 
     } else {
         my $term = pattern $closing;
@@ -1642,7 +1680,7 @@ sub process_text1($$;$$){
        if( $lev == 1 ){
            $res .= pure_text( $$rstr );
        } else {
-           warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n";
+           warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet;
        }
     }
     return $res;
@@ -1666,7 +1704,7 @@ sub go_ahead($$$){
        }
        $res .= $2;
     }
-    warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n";
+    warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet;
     return $res;
 }
 
@@ -1788,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 = "";
@@ -1863,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;
 
@@ -1993,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);
       }
@@ -2012,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 );
@@ -2039,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*$|;
@@ -2049,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!