396 lines
12 KiB
Perl
396 lines
12 KiB
Perl
#!/usr/bin/env perl
|
|
|
|
#*************************************************************************
|
|
# Copyright (c) 2012 UChicago Argonne LLC, as Operator of Argonne
|
|
# National Laboratory.
|
|
# EPICS BASE is distributed subject to a Software License Agreement found
|
|
# in file LICENSE that is included with this distribution.
|
|
#*************************************************************************
|
|
|
|
use strict;
|
|
|
|
use FindBin qw($Bin);
|
|
use lib ($Bin, "$Bin/../../lib/perl");
|
|
use databaseModuleDirs;
|
|
no lib $Bin;
|
|
|
|
use DBD;
|
|
use DBD::Parser;
|
|
use EPICS::Getopts;
|
|
use EPICS::macLib;
|
|
use EPICS::Readfile;
|
|
|
|
BEGIN {
|
|
$::XHTML = eval "require Pod::Simple::XHTML; 1";
|
|
$::ENTITIES = eval "require HTML::Entities; 1";
|
|
if (!$::XHTML) {
|
|
require Pod::Simple::HTML;
|
|
}
|
|
if (!$::ENTITIES) {
|
|
my %entities = (
|
|
q{>} => 'gt',
|
|
q{<} => 'lt',
|
|
q{'} => '#39',
|
|
q{"} => 'quot',
|
|
q{&} => 'amp',
|
|
);
|
|
|
|
sub encode_entities {
|
|
my $str = shift;
|
|
my $ents = join '', keys %entities;
|
|
$str =~ s/([ $ents ])/'&' . ($entities{$1} || sprintf '#x%X', ord $1) . ';'/xge;
|
|
return $str;
|
|
}
|
|
}
|
|
}
|
|
|
|
use Pod::Usage;
|
|
|
|
=head1 NAME
|
|
|
|
dbdToHtml.pl - Convert DBD file with POD to HTML
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
B<dbdToHtml.pl> [B<-h>] [B<-D>] [B<-I> dir] [B<-o> file] file.dbd.pod
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Generates HTML documentation from a B<.dbd.pod> file.
|
|
|
|
=head1 OPTIONS
|
|
|
|
B<dbdToHtml.pl> understands the following options:
|
|
|
|
=over 4
|
|
|
|
=item B<-h>
|
|
|
|
Help, display usage information.
|
|
|
|
=item B<-H>
|
|
|
|
Conversion help, display information about converting reference documentation
|
|
from the EPICS Wiki into a B<.dbd.pod> file for use with this tool.
|
|
|
|
=item B<-D>
|
|
|
|
Instead of creating the output file as described, read the input file(s) and
|
|
print a B<Makefile> dependency rule for the output file(s) to stdout.
|
|
|
|
=item B<-o> file
|
|
|
|
Name of the output file to be created.
|
|
|
|
=back
|
|
|
|
If no output filename is set, the file created will be named after the input
|
|
file, removing any directory components in the path and replacing any
|
|
B<.dbd.pod> file extension with B<.html>.
|
|
|
|
=cut
|
|
|
|
our ($opt_h, $opt_H, $opt_D, @opt_I, $opt_o);
|
|
|
|
my $tool = 'dbdToHtml.pl';
|
|
|
|
getopts('hHDI@o:') or
|
|
pod2usage(2);
|
|
pod2usage(-verbose => 2) if $opt_H;
|
|
pod2usage(1) if $opt_h;
|
|
pod2usage("$tool: No input file given.\n") if @ARGV != 1;
|
|
|
|
my $dbd = DBD->new();
|
|
|
|
my $infile = shift @ARGV;
|
|
$infile =~ m/\.dbd.pod$/ or
|
|
pod2usage("$tool: Input file '$infile' must have '.dbd.pod' extension.\n");
|
|
|
|
ParseDBD($dbd, Readfile($infile, 0, \@opt_I));
|
|
|
|
if (!$opt_o) {
|
|
($opt_o = $infile) =~ s/\.dbd\.pod$/.html/;
|
|
$opt_o =~ s/^.*\///;
|
|
$opt_o =~ s/dbCommonRecord/dbCommon/;
|
|
}
|
|
|
|
if ($opt_D) { # Output dependencies only
|
|
my %filecount;
|
|
my @uniqfiles = grep { not $filecount{$_}++ } @inputfiles;
|
|
print "$opt_o: ", join(" \\\n ", @uniqfiles), "\n\n";
|
|
print map { "$_:\n" } @uniqfiles;
|
|
exit 0;
|
|
}
|
|
|
|
(my $title = $opt_o) =~ s/\.html$//;
|
|
|
|
open my $out, '>', $opt_o or
|
|
die "Can't create $opt_o: $!\n";
|
|
|
|
my $podHtml;
|
|
my $idify;
|
|
|
|
if ($::XHTML) {
|
|
$podHtml = Pod::Simple::XHTML->new();
|
|
$podHtml->html_doctype(<< '__END_DOCTYPE');
|
|
<?xml version='1.0' encoding='iso-8859-1'?>
|
|
<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Transitional//EN'
|
|
'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd'>
|
|
__END_DOCTYPE
|
|
$podHtml->html_header_tags($podHtml->html_header_tags .
|
|
"\n<link rel='stylesheet' href='style.css' type='text/css'>");
|
|
|
|
$idify = sub {
|
|
my $title = shift;
|
|
return $podHtml->idify($title, 1);
|
|
}
|
|
} else { # Fall back to HTML
|
|
$podHtml = Pod::Simple::HTML->new();
|
|
$podHtml->html_css('style.css');
|
|
|
|
$idify = sub {
|
|
my $title = shift;
|
|
return Pod::Simple::HTML::esc($podHtml->section_escape($title));
|
|
}
|
|
}
|
|
|
|
# Parse the Pod text from the root DBD object
|
|
my $pod = join "\n", '=for html <div class="pod">', '',
|
|
map {
|
|
# Handle a 'recordtype' Pod directive
|
|
if (m/^ =recordtype \s+ (\w+) /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+ (\w+) /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 </div>', '';
|
|
|
|
$podHtml->force_title(encode_entities($title));
|
|
$podHtml->perldoc_url_prefix('');
|
|
$podHtml->perldoc_url_postfix('.html');
|
|
$podHtml->output_fh($out);
|
|
$podHtml->parse_string_document($pod);
|
|
close $out;
|
|
|
|
|
|
sub menuToPod {
|
|
my ($menu) = @_;
|
|
my $index = 0;
|
|
return '=begin html', '', '<blockquote><table border="1"><tr>',
|
|
'<th>Index</th><th>Identifier</th><th>Choice String</th></tr>',
|
|
map({choiceTableRow($_, $index++)} $menu->choices),
|
|
'</table></blockquote>', '', '=end html';
|
|
}
|
|
|
|
sub choiceTableRow {
|
|
my ($ch, $index) = @_;
|
|
my ($id, $name) = @{$ch};
|
|
return '<tr>',
|
|
"<td class='cell DBD_Menu index'>$index</td>",
|
|
"<td class='cell DBD_Menu identifier'>$id</td>",
|
|
"<td class='cell DBD_Menu choice'>$name</td>",
|
|
'</tr>';
|
|
}
|
|
|
|
sub rtypeToPod {
|
|
my ($rtyp, $dbd) = @_;
|
|
return map {
|
|
# Handle a 'fields' Pod directive
|
|
if (m/^ =fields \s+ (\w+ (?:\s* , \s* \w+ )* )/x) {
|
|
my @names = split /\s*,\s*/, $1;
|
|
# Look up the named fields
|
|
my @fields = map {
|
|
my $field = $rtyp->field($_);
|
|
die "Unknown field name '$_' in $infile POD\n"
|
|
unless $field;
|
|
$field;
|
|
} @names;
|
|
# Generate Pod for the table
|
|
'=begin html', '', '<blockquote><table border="1"><tr>',
|
|
'<th>Field</th><th>Summary</th><th>Type</th><th>DCT</th>',
|
|
'<th>Default</th><th>Read</th><th>Write</th><th>CA PP</th>',
|
|
'</tr>',
|
|
map({fieldTableRow($_, $dbd)} @fields),
|
|
'</table></blockquote>', '', '=end html';
|
|
}
|
|
# Handle a 'menu' Pod directive
|
|
elsif (m/^ =menu \s+ (\w+) /x) {
|
|
my $mn = $1;
|
|
my $menu = $dbd->menu($mn);
|
|
die "Unknown menu '$mn' in $infile POD directive\n"
|
|
unless $menu;
|
|
menuToPod($menu);
|
|
}
|
|
else {
|
|
# Raw text line
|
|
$_;
|
|
}
|
|
} $rtyp->pod;
|
|
}
|
|
|
|
sub fieldTableRow {
|
|
my ($fld, $dbd) = @_;
|
|
my $html = '<tr><td class="cell">';
|
|
$html .= $fld->name;
|
|
$html .= '</td><td class="cell">';
|
|
$html .= $fld->attribute('prompt');
|
|
$html .= '</td><td class="cell">';
|
|
my $type = $fld->public_type;
|
|
$html .= $type;
|
|
$html .= ' [' . $fld->attribute('size') . ']'
|
|
if $type eq 'STRING';
|
|
if ($type eq 'MENU') {
|
|
my $mn = $fld->attribute('menu');
|
|
my $menu = $dbd->menu($mn);
|
|
my $url = $menu ? '#' . &$idify("Menu $mn") : "${mn}.html";
|
|
$html .= " (<a href='$url'>$mn</a>)";
|
|
}
|
|
$html .= '</td><td class="cell">';
|
|
$html .= $fld->attribute('promptgroup') ? 'Yes' : 'No';
|
|
$html .= '</td><td class="cell">';
|
|
$html .= $fld->attribute('initial') || ' ';
|
|
$html .= '</td><td class="cell">';
|
|
$html .= $fld->readable;
|
|
$html .= '</td><td class="cell">';
|
|
$html .= $fld->writable;
|
|
$html .= '</td><td class="cell">';
|
|
$html .= $fld->attribute('pp') eq 'TRUE' ? 'Yes' : 'No';
|
|
$html .= "</td></tr>\n";
|
|
return $html;
|
|
}
|
|
|
|
# Native type presented to dbAccess users
|
|
sub DBD::Recfield::public_type {
|
|
my $fld = shift;
|
|
m/^ =type \s+ (.+) /x && return $1 for $fld->comments;
|
|
my $type = $fld->dbf_type;
|
|
$type =~ s/^DBF_//;
|
|
return $type;
|
|
}
|
|
|
|
# Check if this field is readable
|
|
sub DBD::Recfield::readable {
|
|
my $fld = shift;
|
|
m/^ =read \s+ (?i) (Yes|No) /x && return $1 for $fld->comments;
|
|
return 'Probably'
|
|
if $fld->attribute('special') eq "SPC_DBADDR";
|
|
return $fld->dbf_type eq 'DBF_NOACCESS' ? 'No' : 'Yes';
|
|
}
|
|
|
|
# Check if this field is writable
|
|
sub DBD::Recfield::writable {
|
|
my $fld = shift;
|
|
m/^ =write \s+ (?i) (Yes|No) /x && return $1 for $fld->comments;
|
|
my $special = $fld->attribute('special');
|
|
return 'No'
|
|
if $special eq "SPC_NOMOD";
|
|
return 'Maybe'
|
|
if $special eq "SPC_DBADDR";
|
|
return $fld->dbf_type eq "DBF_NOACCESS" ? 'No' : 'Yes';
|
|
}
|
|
|
|
=pod
|
|
|
|
=head1 Converting Wiki Record Reference to POD
|
|
|
|
If you open the src/std/rec/aiRecord.dbd.pod file in your favourite plain text
|
|
editor you'll see what input was required to generate the aiRecord.html file.
|
|
The text markup language we're using is a standard called POD (Plain Old
|
|
Documentation) which is used by Perl developers, but you don't need to know Perl
|
|
at all to be able to use it.
|
|
|
|
When we add POD markup to a record type, we rename its *Record.dbd file to
|
|
.dbd.pod in the src/std/rec directory; no other changes are needed for the build
|
|
system to find it by its new name. The POD content is effectively just a new
|
|
kind of comment that appears in .dbd.pod files, which the formatter knows how to
|
|
convert into HTML. The build also generates a plain *Record.dbd file from this
|
|
same input file by stripping out all of the POD markup.
|
|
|
|
Documentation for Perl's POD markup standard can be found online at
|
|
L<https://perldoc.perl.org/perlpod.html> or you may be able to type 'perldoc
|
|
perlpod' into a Linux command-line to see the same text. We added a few POD
|
|
keywords of our own to handle the table generation, and I'll cover those briefly
|
|
below.
|
|
|
|
POD text can appear almost anywhere in a dbd.pod file. It always starts with a
|
|
line "=[keyword] [additional text...]" where [keyword] is "title", "head1"
|
|
through "head4" etc.. The POD text ends with a line "=cut". There must be a
|
|
blank line above every POD line, and in many cases below it as well.
|
|
|
|
The POD keywords we have added are "title", "recordtype", "menu", "fields",
|
|
"type", "read" and "write". The last 3 are less common but are used in some of
|
|
the other record types such as the waveform and aSub records.
|
|
|
|
The most interesting of our new keywords is "fields", which takes a list of
|
|
record field names on the same line after the keyword and generates an HTML
|
|
Table describing those fields based on the field description found in the DBD
|
|
parts. In the ai documentation the first such table covers the DTYP and INP
|
|
fields, so the line
|
|
|
|
=fields DTYP, INP
|
|
|
|
generates all this in the output:
|
|
|
|
<blockquote><table border="1">
|
|
<tr>
|
|
<th>Field</th><th>Summary</th><th>Type</th><th>DCT</th>
|
|
<th>Default</th><th>Read</th><th>Write</th><th>CA PP</th>
|
|
</tr>
|
|
<tr>
|
|
<td class="cell">DTYP</td><td class="cell">Device Type</td>
|
|
<td class="cell">DEVICE</td>
|
|
<td class="cell">Yes</td>
|
|
<td class="cell"> </td>
|
|
<td class="cell">Yes</td>
|
|
<td class="cell">Yes</td>
|
|
<td class="cell">No</td>
|
|
</tr>
|
|
<tr>
|
|
<td class="cell">INP</td>
|
|
<td class="cell">Input Specification</td>
|
|
<td class="cell">INLINK</td>
|
|
<td class="cell">Yes</td>
|
|
<td class="cell"> </td>
|
|
<td class="cell">Yes</td>
|
|
<td class="cell">Yes</td>
|
|
<td class="cell">No</td>
|
|
</tr>
|
|
</table></blockquote>
|
|
|
|
Note that the "=fields" line must appear inside the DBD's declaration of the
|
|
record type, i.e. after the line
|
|
|
|
recordtype(ai) {
|
|
|
|
The "type", "read" and "write" POD keywords are used inside an individual record
|
|
field declaration and provide information for the "Type", "Read" and "Write"
|
|
columns of the field's table output for fields where this information is
|
|
normally supplied by the record support code. Usage examples for these keywords
|
|
can be found in the aai and aSub record types.
|
|
|
|
If you look at the L<aoRecord.dbd.pod> file you'll see that the POD there starts
|
|
by documenting a record-specific menu definition. The "menu" keyword generates a
|
|
table that lists all the choices found in the named menu. Any MENU fields in the
|
|
field tables that refer to a locally-defined menu will generate a link to a
|
|
document section which must be titled "Menu [menuName]".
|
|
|
|
=cut
|