automatic titling in Pod::Html

Automatic extraction of a title from the content was lost with the
switch to using Pod::Simple::XHTML for rendering.  It would be tricky
to add in Pod::Simple::XHTML, or anything else integrated into that
parser, because the stream-oriented approach plays poorly with any kind
of lookahead.  Instead go to a two-stage conversion, parsing the input
to tree form using Pod::Simple::SimpleTree and later feeding the tree
to the stream-oriented Pod::Simple::XHTML for output.  Between the two
stages, extract a default title from the tree, in time to use it when
setting options for Pod::Simple::XHTML.  Fixes [perl #110520].

12 files changed, 71 insertions, 36 deletions

diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm
index 1972a8c2d3..8f7999b835 100644
--- a/ext/Pod-Html/lib/Pod/Html.pm
+++ b/ext/Pod-Html/lib/Pod/Html.pm
@@ -2,7 +2,7 @@ package Pod::Html;
 use strict;
 require Exporter;
 
-our $VERSION = 1.2203;
+our $VERSION = 1.23;
 our @ISA = qw(Exporter);
 our @EXPORT = qw(pod2html htmlify);
 our @EXPORT_OK = qw(anchorify);
@@ -15,6 +15,7 @@ use File::Spec;
 use File::Spec::Unix;
 use Getopt::Long;
 use Pod::Simple::Search;
+use Pod::Simple::SimpleTree ();
 use locale; # make \w work right in non-ASCII lands
 
 =head1 NAME
@@ -222,6 +223,19 @@ This program is distributed under the Artistic License.
 
 =cut
 
+# This sub duplicates the guts of Pod::Simple::FromTree.  We could have
+# used that module, except that it would have been a non-core dependency.
+sub feed_tree_to_parser {
+    my($parser, $tree) = @_;
+    if(ref($tree) eq "") {
+	$parser->_handle_text($tree);
+    } elsif(!($tree->[0] eq "X" && $parser->nix_X_codes)) {
+	$parser->_handle_element_start($tree->[0], $tree->[1]);
+	feed_tree_to_parser($parser, $_) foreach @{$tree}[2..$#$tree];
+	$parser->_handle_element_end($tree->[0]);
+    }
+}
+
 my $Cachedir; 
 my $Dircache;
 my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl);
@@ -273,7 +287,7 @@ sub init_globals {
     $Doindex = 1;               # non-zero if we should generate an index
     $Backlink = 0;              # no backlinks added by default
     $Header = 0;                # produce block header/footer
-    $Title = '';                # title to give the pod(s)
+    $Title = undef;             # title to give the pod(s)
 }
 
 sub pod2html {
@@ -339,25 +353,60 @@ sub pod2html {
         close $cache or die "error closing $Dircache: $!";
     }
 
-    # set options for the parser
-    my $parser = Pod::Simple::XHTML::LocalPodLinks->new();
+    my $input;
+    unless (@ARGV && $ARGV[0]) {
+        if ($Podfile and $Podfile ne '-') {
+            $input = $Podfile;
+        } else {
+            $input = '-'; # XXX: make a test case for this
+        }
+    } else {
+        $Podfile = $ARGV[0];
+        $input = *ARGV;
+    }
+
+    # set options for input parser
+    my $parser = Pod::Simple::SimpleTree->new;
+    $parser->codes_in_verbatim(0);
+    $parser->accept_targets(qw(html HTML));
+    $parser->no_errata_section(!$Poderrors); # note the inverse
+
+    warn "Converting input file $Podfile\n" if $Verbose;
+    my $podtree = $parser->parse_file($input)->root;
+
+    unless(defined $Title) {
+	if($podtree->[0] eq "Document" && ref($podtree->[2]) eq "ARRAY" &&
+		$podtree->[2]->[0] eq "head1" && @{$podtree->[2]} == 3 &&
+		ref($podtree->[2]->[2]) eq "" && $podtree->[2]->[2] eq "NAME" &&
+		ref($podtree->[3]) eq "ARRAY" && $podtree->[3]->[0] eq "Para" &&
+		@{$podtree->[3]} >= 3 &&
+		!(grep { ref($_) ne "" }
+		    @{$podtree->[3]}[2..$#{$podtree->[3]}]) &&
+		(@$podtree == 4 ||
+		    (ref($podtree->[4]) eq "ARRAY" &&
+			$podtree->[4]->[0] eq "head1"))) {
+	    $Title = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]);
+	}
+    }
+
+    $Title //= "";
+    $Title = html_escape($Title);
+
+    # set options for the HTML generator
+    $parser = Pod::Simple::XHTML::LocalPodLinks->new();
     $parser->codes_in_verbatim(0);
     $parser->anchor_items(1); # the old Pod::Html always did
     $parser->backlink($Backlink); # linkify =head1 directives
+    $parser->force_title($Title);
     $parser->htmldir($Htmldir);
     $parser->htmlfileurl($Htmlfileurl);
     $parser->htmlroot($Htmlroot);
     $parser->index($Doindex);
-    $parser->no_errata_section(!$Poderrors); # note the inverse
     $parser->output_string(\my $output); # written to file later
     $parser->pages(\%Pages);
     $parser->quiet($Quiet);
     $parser->verbose($Verbose);
 
-    # XXX: implement default title generator in pod::simple::xhtml
-    # copy the way the old Pod::Html did it
-    $Title = html_escape($Title);
-
     # We need to add this ourselves because we use our own header, not
     # ::XHTML's header. We need to set $parser->backlink to linkify
     # the =head1 directives
@@ -404,20 +453,7 @@ $block
 </html>
 HTMLFOOT
 
-    my $input;
-    unless (@ARGV && $ARGV[0]) {
-        if ($Podfile and $Podfile ne '-') {
-            $input = $Podfile;
-        } else {
-            $input = '-'; # XXX: make a test case for this
-        }
-    } else {
-        $Podfile = $ARGV[0];
-        $input = *ARGV;
-    }
-
-    warn "Converting input file $Podfile\n" if $Verbose;
-    $parser->parse_file($input);
+    feed_tree_to_parser($parser, $podtree);
 
     # Write output to file
     $Htmlfile = "-" unless $Htmlfile; # stdout
@@ -619,8 +655,7 @@ sub html_escape {
     $rest   =~ s/</&lt;/g;
     $rest   =~ s/>/&gt;/g;
     $rest   =~ s/"/&quot;/g;
-    # &apos; is only in XHTML, not HTML4.  Be conservative
-    #$rest   =~ s/'/&apos;/g;
+    $rest =~ s/([^ -~])/sprintf("&#x%x;", ord($1))/eg;
     return $rest;
 }
 
diff --git a/ext/Pod-Html/t/crossref.t b/ext/Pod-Html/t/crossref.t
index 49309d9f7d..74e04e042f 100644
--- a/ext/Pod-Html/t/crossref.t
+++ b/ext/Pod-Html/t/crossref.t
@@ -35,7 +35,7 @@ __DATA__
 <!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>htmlcrossref - Test HTML cross reference links</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>
diff --git a/ext/Pod-Html/t/crossref2.t b/ext/Pod-Html/t/crossref2.t
index 06dfcc2880..4e1b923333 100644
--- a/ext/Pod-Html/t/crossref2.t
+++ b/ext/Pod-Html/t/crossref2.t
@@ -31,7 +31,7 @@ __DATA__
 <!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>htmlcrossref - Test HTML cross reference links</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>
diff --git a/ext/Pod-Html/t/crossref3.t b/ext/Pod-Html/t/crossref3.t
index eb6c834858..5edab486d0 100644
--- a/ext/Pod-Html/t/crossref3.t
+++ b/ext/Pod-Html/t/crossref3.t
@@ -31,7 +31,7 @@ __DATA__
 <!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>htmlcrossref - Test HTML cross reference links</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>
diff --git a/ext/Pod-Html/t/htmldir1.t b/ext/Pod-Html/t/htmldir1.t
index 88d02a5087..22632a18ba 100644
--- a/ext/Pod-Html/t/htmldir1.t
+++ b/ext/Pod-Html/t/htmldir1.t
@@ -52,7 +52,7 @@ __DATA__
 <!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>htmldir - Test --htmldir feature</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>
diff --git a/ext/Pod-Html/t/htmldir2.t b/ext/Pod-Html/t/htmldir2.t
index bf2d02c715..36efdb7ad8 100644
--- a/ext/Pod-Html/t/htmldir2.t
+++ b/ext/Pod-Html/t/htmldir2.t
@@ -39,7 +39,7 @@ __DATA__
 <!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>htmldir - Test --htmldir feature</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>
diff --git a/ext/Pod-Html/t/htmldir3.t b/ext/Pod-Html/t/htmldir3.t
index 843620be6c..3bcf4d09c9 100644
--- a/ext/Pod-Html/t/htmldir3.t
+++ b/ext/Pod-Html/t/htmldir3.t
@@ -48,7 +48,7 @@ __DATA__
 <!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>htmldir - Test --htmldir feature</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>
diff --git a/ext/Pod-Html/t/htmldir4.t b/ext/Pod-Html/t/htmldir4.t
index 01b4f57408..14435fa8d2 100644
--- a/ext/Pod-Html/t/htmldir4.t
+++ b/ext/Pod-Html/t/htmldir4.t
@@ -34,7 +34,7 @@ __DATA__
 <!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>htmldir - Test --htmldir feature</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>
diff --git a/ext/Pod-Html/t/htmldir5.t b/ext/Pod-Html/t/htmldir5.t
index bf03e5e377..3f53d3ffba 100644
--- a/ext/Pod-Html/t/htmldir5.t
+++ b/ext/Pod-Html/t/htmldir5.t
@@ -37,7 +37,7 @@ __DATA__
 <!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>htmldir - Test --htmldir feature</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>
diff --git a/ext/Pod-Html/t/htmlescp.t b/ext/Pod-Html/t/htmlescp.t
index 655b521909..fd5207ab22 100644
--- a/ext/Pod-Html/t/htmlescp.t
+++ b/ext/Pod-Html/t/htmlescp.t
@@ -14,7 +14,7 @@ __DATA__
 <!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>Escape Sequences Test</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>
diff --git a/ext/Pod-Html/t/htmllink.t b/ext/Pod-Html/t/htmllink.t
index e9aade506e..033c93f16f 100644
--- a/ext/Pod-Html/t/htmllink.t
+++ b/ext/Pod-Html/t/htmllink.t
@@ -14,7 +14,7 @@ __DATA__
 <!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>htmllink - Test HTML links</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>
diff --git a/ext/Pod-Html/t/htmlview.t b/ext/Pod-Html/t/htmlview.t
index a95a0abf77..1e3a304b36 100644
--- a/ext/Pod-Html/t/htmlview.t
+++ b/ext/Pod-Html/t/htmlview.t
@@ -14,7 +14,7 @@ __DATA__
 <!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>Test HTML Rendering</title>
 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
 <link rev="made" href="mailto:[PERLADMIN]" />
 </head>