Skip to content

Commit

Permalink
Merge e7e9b97 into 08e4a1e
Browse files Browse the repository at this point in the history
  • Loading branch information
@scottchiefbaker
scottchiefbaker committed May 28, 2021
2 parents 08e4a1e + e7e9b97 commit b490d4c
Showing 1 changed file with 100 additions and 43 deletions.
143 changes: 100 additions & 43 deletions ext/Pod-Html/lib/Pod/Html.pm
View file
Expand Up @@ -96,7 +96,7 @@ Displays the usage message.
Sets the directory to which all cross references in the resulting
html file will be relative. Not passing this causes all links to be
absolute since this is the value that tells Pod::Html the root of the
absolute since this is the value that tells Pod::Html the root of the
documentation tree.
Do not use this and --htmlroot in the same call to pod2html; they are
Expand Down Expand Up @@ -141,7 +141,7 @@ is specified.
--poderrors
--nopoderrors
Include a "POD ERRORS" section in the outfile if there were any POD
Include a "POD ERRORS" section in the outfile if there were any POD
errors in the infile. This section is included by default.
=item podpath
Expand Down Expand Up @@ -210,7 +210,7 @@ Uses C<$Config{pod2html}> to setup default options.
=head1 AUTHOR
Marc Green, E<lt>marcgreen@cpan.orgE<gt>.
Marc Green, E<lt>marcgreen@cpan.orgE<gt>.
Original version by Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
Expand All @@ -229,15 +229,15 @@ This program is distributed under the Artistic License.
sub feed_tree_to_parser {
my($parser, $tree) = @_;
if(ref($tree) eq "") {
$parser->_handle_text($tree);
$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]);
$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 $Cachedir;
my $Dircache;
my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl);
my($Podfile, @Podpath, $Podroot);
Expand All @@ -246,6 +246,7 @@ my $Css;

my $Recurse;
my $Quiet;
my $OutputMode;
my $Verbose;
my $Doindex;

Expand Down Expand Up @@ -287,6 +288,7 @@ sub init_globals {
$Backlink = 0; # no backlinks added by default
$Header = 0; # produce block header/footer
$Title = undef; # title to give the pod(s)
$OutputMode = "html" # OutputMode is either HTML or XHTML
}

sub pod2html {
Expand Down Expand Up @@ -319,7 +321,7 @@ sub pod2html {
unless (get_cache($Dircache, \@Podpath, $Podroot, $Recurse)) {
# generate %Pages
my $pwd = getcwd();
chdir($Podroot) ||
chdir($Podroot) ||
die "$0: error changing to directory $Podroot: $!\n";

# find all pod modules/pages in podpath, store in %Pages
Expand Down Expand Up @@ -377,18 +379,18 @@ sub pod2html {
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]}]);
}
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 //= "";
Expand Down Expand Up @@ -434,26 +436,11 @@ sub pod2html {
END_OF_BLOCK
# create own header/footer because of --header
$parser->html_header(<<"HTMLHEAD");
<?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>
<body$bodyid>
$block
HTMLHEAD
my $head = get_header($OutputMode, $Title, $csslink, $bodyid, $block);
$parser->html_header($head);
$parser->html_footer(<<"HTMLFOOT");
$block
</body>
</html>
HTMLFOOT
my $foot = get_footer($OutputMode, $Title, $csslink, $bodyid, $block);
$parser->html_footer($foot);
feed_tree_to_parser($parser, $podtree);
Expand Down Expand Up @@ -503,7 +490,7 @@ Usage: $0 --help --htmldir=<name> --htmlroot=<URL>
by default).
--outfile - filename for the resulting html file (output sent to
stdout by default).
--[no]poderrors - include a POD ERRORS section in the output if there were
--[no]poderrors - include a POD ERRORS section in the output if there were
any POD errors in the input (default behavior).
--podpath - colon-separated list of directories containing library
pods (empty by default).
Expand All @@ -523,7 +510,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_outfile,$opt_poderrors,$opt_podpath,$opt_podroot,
$opt_quiet,$opt_recurse,$opt_title,$opt_verbose);
$opt_quiet,$opt_recurse,$opt_title,$opt_verbose,$opt_xhtml);

unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
my $result = GetOptions(
Expand All @@ -545,6 +532,7 @@ sub parse_command_line {
'recurse!' => \$opt_recurse,
'title=s' => \$opt_title,
'verbose!' => \$opt_verbose,
'xhtml' => \$opt_xhtml,
);
usage("-", "invalid parameters") if not $result;

Expand All @@ -569,6 +557,10 @@ sub parse_command_line {
$Title = $opt_title if defined $opt_title;
$Verbose = $opt_verbose if defined $opt_verbose;

if ($opt_xhtml) {
$OutputMode = "xhtml";
}

warn "Flushing directory caches\n"
if $opt_verbose && defined $opt_flush;
$Dircache = "$Cachedir/pod2htmd.tmp";
Expand Down Expand Up @@ -771,7 +763,7 @@ sub resolve_pod_page_link {
my $modloc = File::Spec->catfile(split(/::/, $to));

if ($#matches == -1) {
warn "Cannot find file \"$modloc.*\" directly under podpath, " .
warn "Cannot find file \"$modloc.*\" directly under podpath, " .
"cannot find suitable replacement: link remains unresolved.\n"
if $self->verbose;
return '';
Expand Down Expand Up @@ -863,4 +855,69 @@ sub trim_leading_whitespace {
return;
}

sub get_header {
my ($mode, $title, $csslink, $bodyid, $block) = @_;

my $ret = "";

if ($mode eq "xhtml") {
$ret = qq(<!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" />
</head>
<body$bodyid>
$block);
} elsif ($mode eq 'html') {
$ret = qq(<!doctype html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">
<style>
body {
font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", "Roboto", "Oxygen", "Ubuntu", "Cantarell", "Fira Sans", "Droid Sans", "Helvetica Neue", sans-serif;
font-size: 11pt;
}
a:link { color: #0062cc; }
a:visited { color: #1398ae; }
pre, p > code {
font-family : Menlo, Monaco, Consolas, "Ubuntu Mono", "Courier New", monospace;
border : 1px solid #cccccc;;
background : #f5f5f5;
padding : 5px;
display : inline-block;
}
</style>
<title>$title</title>$csslink
</head>
<body$bodyid>
$block);
}

return $ret;
}

sub get_footer {
my $mode = shift() // "html";
my ($title, $csslink, $bodyid, $block) = @_;

my $ret = "";

# Modes are the same (for now) for footer stuff
if ($mode eq "xhtml" || $mode eq 'html') {
$ret = "$block\n</body>\n\n</html>";
}

return $ret;
}

1;

# vim: tabstop=4 shiftwidth=4 expandtab autoindent softtabstop=4

0 comments on commit b490d4c

Please sign in to comment.