From 38037f087366f4e850ac251efb50e58db8fe947e Mon Sep 17 00:00:00 2001 From: Andrew Johnson Date: Mon, 30 Sep 2013 17:44:45 -0500 Subject: [PATCH] Use Pod::Simple::XHTML if available. --- src/tools/dbdToHtml.pl | 118 ++++++++++++++++++++++++----------------- src/tools/style.css | 18 +++++-- 2 files changed, 81 insertions(+), 55 deletions(-) diff --git a/src/tools/dbdToHtml.pl b/src/tools/dbdToHtml.pl index 52772f525..d64a38ea2 100644 --- a/src/tools/dbdToHtml.pl +++ b/src/tools/dbdToHtml.pl @@ -18,7 +18,14 @@ use DBD::Parser; use EPICS::Getopts; use EPICS::macLib; use EPICS::Readfile; -use Pod::Simple::HTML; +use HTML::Entities; + +BEGIN { + $::XHTML = eval "require Pod::Simple::XHTML; 1"; + if (!$::XHTML) { + require Pod::Simple::HTML; + } +} my $tool = 'dbdToHtml'; @@ -35,7 +42,7 @@ $infile =~ m/\.dbd.pod$/ or &ParseDBD($dbd, &Readfile($infile, 0, \@opt_I)); if (!$opt_o) { - ($opt_o = $infile) =~ s/\.dbd.pod$/.html/; + ($opt_o = $infile) =~ s/\.dbd\.pod$/.html/; $opt_o =~ s/^.*\///; $opt_o =~ s/dbCommonRecord/dbCommon/; } @@ -48,66 +55,79 @@ if ($opt_D) { # Output dependencies only exit 0; } +(my $title = $opt_o) =~ s/\.html$//; + open my $out, '>', $opt_o or die "Can't create $opt_o: $!\n"; # Parse the Pod text from the root DBD object -my @pod = map { - # Handle a 'recordtype' Pod directive - if (m/^ =recordtype \s+ (.*)/x) { - my $rn = $1; - my $rtyp = $dbd->recordtype($rn); - die "Unknown recordtype '$rn' in $infile POD directive\n" - unless $rtyp; - rtypeToPod($rtyp, $dbd); - } - # Handle a 'menu' Pod directive - elsif (m/^ =menu \s+ (.*)/x) { - my $mn = $1; - my $menu = $dbd->menu($mn); - die "Unknown menu '$mn' in $infile POD directive\n" - unless $menu; - menuToPod($menu); - } - else { - $_; - } -} $dbd->pod; +my $pod = join "\n", '=for html
', '', + map { + # Handle a 'recordtype' Pod directive + if (m/^ =recordtype \s+ (.*)/x) { + my $rn = $1; + my $rtyp = $dbd->recordtype($rn); + die "Unknown recordtype '$rn' in $infile POD directive\n" + unless $rtyp; + rtypeToPod($rtyp, $dbd); + } + # Handle a 'menu' Pod directive + elsif (m/^ =menu \s+ (.*)/x) { + my $mn = $1; + my $menu = $dbd->menu($mn); + die "Unknown menu '$mn' in $infile POD directive\n" + unless $menu; + menuToPod($menu); + } + elsif (m/^ =title \s+ (.*)/x) { + $title = $1; + "=head1 $title"; + } + else { + $_; + } + } $dbd->pod, + '=for html
', ''; + +my $podHtml; + +if ($::XHTML) { + $podHtml = Pod::Simple::XHTML->new(); + $podHtml->html_doctype(<< '__END_DOCTYPE'); + + +__END_DOCTYPE +} else { # Fall back to HTML + $podHtml = Pod::Simple::HTML->new(); +} -my $podHtml = Pod::Simple::HTML->new(); $podHtml->html_css('style.css'); +$podHtml->force_title(encode_entities($title)); $podHtml->perldoc_url_prefix(''); $podHtml->perldoc_url_postfix('.html'); -$podHtml->set_source(\@pod); -# $podHtml->index(1); -$podHtml->output_string(\my $html); -$podHtml->run; -print $out $html; +$podHtml->output_fh($out); +$podHtml->parse_string_document($pod); close $out; sub menuToPod { my ($menu) = @_; my $index = 0; - return "=begin html\n", "\n", - "
\n", - "\n", - "\n", + return '=begin html', '', '
IndexIdentifierChoice String
', + '', map({choiceTableRow($_, $index++)} $menu->choices), - "
IndexIdentifierChoice String
\n", - "\n", "=end html\n"; + '', '', '=end html'; } sub choiceTableRow { my ($ch, $index) = @_; my ($id, $name) = @{$ch}; - return '', - $index, - '', - $id, - '', - $name, - "\n"; + return '', + "$index", + "$id", + "$name", + ''; } sub rtypeToPod { @@ -124,14 +144,12 @@ sub rtypeToPod { $field; } @names; # Generate Pod for the table - "=begin html\n", "\n", - "
\n", - "", - "", - "\n", + '=begin html', '', '
FieldSummaryTypeDCTDefaultReadWriteCA PP
', + '', + '', + '', map({fieldTableRow($_, $dbd)} @fields), - "
FieldSummaryTypeDCTDefaultReadWriteCA PP
\n", - "\n", "=end html\n"; + '', '', '=end html'; } # Handle a 'menu' Pod directive elsif (m/^ =menu \s+ (.*)/x) { @@ -174,7 +192,7 @@ sub fieldTableRow { $html .= ''; $html .= $fld->writable; $html .= ''; - $html .= $fld->attribute('pp') eq "TRUE" ? 'Yes' : 'No'; + $html .= $fld->attribute('pp') eq 'TRUE' ? 'Yes' : 'No'; $html .= "\n"; return $html; } diff --git a/src/tools/style.css b/src/tools/style.css index 905162a98..8253fb08f 100644 --- a/src/tools/style.css +++ b/src/tools/style.css @@ -80,7 +80,6 @@ DIV { DT { margin-top: 1em; - font-weight: bold; } .credits TD { @@ -189,6 +188,15 @@ TH A:link, TH A:visited { text-align: left; } +.DBD_Menu.index { + padding: 0.2ex 2ex; + text-align: right; +} + +.DBD_Menu.choice { + font: 1.0em monospace; +} + .label { background: #aaaaaa; color: black; @@ -307,7 +315,7 @@ table.dlsip { .pod H1 { background: transparent; color: #006699; - font-size: large; + font-size: 1.4em; } .pod H1 A { text-decoration: none; } @@ -318,20 +326,20 @@ table.dlsip { .pod H2 { background: transparent; color: #006699; - font-size: medium; + font-size: 1.2em; } .pod H3 { background: transparent; color: #006699; - font-size: medium; + font-size: 1em; font-style: italic; } .pod H4 { background: transparent; color: #006699; - font-size: medium; + font-size: 1em; font-weight: normal; }