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",
- "| Index | Identifier | Choice String | \n",
- "
\n",
+ return '=begin html', '', '',
+ '| Index | Identifier | Choice String |
',
map({choiceTableRow($_, $index++)} $menu->choices),
- "
\n",
- "\n", "=end html\n";
+ '
', '', '=end html';
}
sub choiceTableRow {
my ($ch, $index) = @_;
my ($id, $name) = @{$ch};
- return '| ',
- $index,
- ' | ',
- $id,
- ' | ',
- $name,
- " |
\n";
+ return '',
+ "",
+ "",
+ "",
+ '
';
}
sub rtypeToPod {
@@ -124,14 +144,12 @@ sub rtypeToPod {
$field;
} @names;
# Generate Pod for the table
- "=begin html\n", "\n",
- "\n",
- "| Field | Summary | Type | DCT | ",
- "Default | Read | Write | CA PP | ",
- "
\n",
+ '=begin html', '', '',
+ '| Field | Summary | Type | DCT | ',
+ 'Default | Read | Write | CA PP | ',
+ '
',
map({fieldTableRow($_, $dbd)} @fields),
- "
\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;
}