diff --git a/configure/CONFIG_DATABASE_MODULE b/configure/CONFIG_DATABASE_MODULE index 14c219c2c..22f2bce6e 100644 --- a/configure/CONFIG_DATABASE_MODULE +++ b/configure/CONFIG_DATABASE_MODULE @@ -12,6 +12,7 @@ DBDTORECTYPEH_pl = $(EPICS_BASE_HOST_BIN)/dbdToRecordtypeH.pl DBDTORECTYPEH_dep = $(DBDTORECTYPEH_pl) $(call FIND_PM,DBD/Rec*.pm) DBDTOMENUH_pl = $(EPICS_BASE_HOST_BIN)/dbdToMenuH.pl DBDTOMENUH_dep = $(DBDTOMENUH_pl) $(call FIND_PM,DBD/Menu.pm) +DBDTOMD_pl = $(EPICS_BASE_HOST_BIN)/dbdToMD.pl DBDTOHTML_pl = $(EPICS_BASE_HOST_BIN)/dbdToHtml.pl DBDTOHTML_dep = $(DBDTOHTML_pl) $(call FIND_PM,EPICS/Pod*Html.pm) REGRECDEVDRV_pl = $(EPICS_BASE_HOST_BIN)/registerRecordDeviceDriver.pl @@ -21,6 +22,7 @@ REGRECDEVDRV_dep = $(REGRECDEVDRV_pl) DBEXPAND = $(PERL) $(DBDEXPAND_pl) DBTORECORDTYPEH = $(PERL) $(DBDTORECTYPEH_pl) DBTOMENUH = $(PERL) $(DBDTOMENUH_pl) +DBDTOMD = $(PERL) $(DBDTOMD_pl) DBDTOHTML = $(PERL) $(DBDTOHTML_pl) REGISTERRECORDDEVICEDRIVER = $(PERL) $(REGRECDEVDRV_pl) diff --git a/modules/database/src/tools/Makefile b/modules/database/src/tools/Makefile index 41bf086d3..84229dca8 100644 --- a/modules/database/src/tools/Makefile +++ b/modules/database/src/tools/Makefile @@ -34,6 +34,7 @@ PERL_SCRIPTS += dbdToRecordtypeH.pl PERL_SCRIPTS += dbdExpand.pl PERL_SCRIPTS += dbExpand.pl PERL_SCRIPTS += dbdToHtml.pl +PERL_SCRIPTS += dbdToMD.pl PERL_SCRIPTS += registerRecordDeviceDriver.pl HTMLS += dbdToHtml.html diff --git a/modules/database/src/tools/dbdToMD.pl b/modules/database/src/tools/dbdToMD.pl new file mode 100644 index 000000000..f1686a230 --- /dev/null +++ b/modules/database/src/tools/dbdToMD.pl @@ -0,0 +1,307 @@ +#!/usr/bin/env perl + +#************************************************************************* +# Copyright (c) 2012 UChicago Argonne LLC, as Operator of Argonne +# National Laboratory. +# SPDX-License-Identifier: EPICS +# 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/../../lib/perl"); + +use DBD; +use DBD::Parser; +use EPICS::Getopts; +use EPICS::macLib; +use EPICS::PodMD; +use EPICS::Readfile; + +use Pod::Usage; + +=head1 NAME + +dbdToMD.pl - Convert DBD file with POD to Markdown + +=head1 SYNOPSIS + +B [B<-h>] [B<-D>] [B<-I> dir] [B<-o> file] file.dbd.pod + +=head1 DESCRIPTION + +Generates MArkdown documentation from a B<.dbd.pod> file. + +=head1 OPTIONS + +B 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<-I> + +Path to look for include files. + +=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<.md>. + +=cut + +our ($opt_h, $opt_H, @opt_I, $opt_o); + +my $tool = 'dbdToMD.pl'; + +getopts('hHI@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$/.md/; + $opt_o =~ s/^.*\///; + $opt_o =~ s/dbCommonRecord/dbCommon/; +} + +(my $title = $opt_o) =~ s/\.md$//; + +open my $out, '>', $opt_o or + die "Can't create $opt_o: $!\n"; + +$SIG{__DIE__} = sub { + die @_ if $^S; # Ignore eval deaths + close $out; + unlink $opt_o; +}; + +sub make_fragment { + my $fragment = $_[1]; + $fragment =~ s/\W+/-/g; + $fragment = lc($fragment); + $_[1] = $fragment; +} + +my $podRst = EPICS::PodMD->new( + perldoc_url_prefix => '', + perldoc_fragment_format => make_fragment, + markdown_fragment_format => make_fragment, +); + +# Parse the Pod text from the root DBD object +my $pod = join "\n", + 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; + rtypeToMD($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; + menuToMD($menu); + } + elsif (m/^ =title \s+ (.*)/x) { + $title = $1; + "=head1 $title"; + } + else { + $_; + } + } $dbd->pod; + +$podRst->output_fh($out); +$podRst->parse_string_document($pod); +close $out; + +sub menuToMD { + my ($menu) = @_; + my $index = 0; + return "| Index | Identifier | Choice String |", + "| ----- | ---------- | ------------- |", + map({choiceTableRow($_, $index++)} $menu->choices); +} + +sub choiceTableRow { + my ($ch, $index) = @_; + my ($id, $name) = @{$ch}; + return "| $index | $id | $name |"; +} + +sub rtypeToMD { + 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 + "| Field | Summary | Type | DCT | Default | Read | Write | CA PP |", + "| ----- | ------- | ---- | --- | ------- | ---- | ----- | ----- |", + map({fieldTableRow($_, $dbd)} @fields); + } + # 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; + menuToMD($menu); + } + else { + # Raw text line + $_; + } + } $rtyp->pod; +} + +sub fieldTableRow { + my ($fld, $dbd) = @_; + my @md; + push @md, $fld->name, $fld->attribute('prompt'); + + my $type = $fld->public_type; + if ($type eq 'STRING') { + $type .= ' [' . $fld->attribute('size') . ']'; + } elsif ($type eq 'MENU') { + my $mn = $fld->attribute('menu'); + my $menu = $dbd->menu($mn); + my $mnl = lc($mn); + my $url = $menu ? "/menu-$mnl" : "${mn}.md"; + #just pass a L directive for the parser + $type .= " L<$mn|$url>"; + } + push @md, $type; + + push @md, $fld->attribute('promptgroup') ? 'Yes' : 'No'; + push @md, $fld->attribute('initial') || ' '; + push @md, $fld->readable; + push @md, $fld->writable; + push @md, $fld->attribute('pp') eq 'TRUE' ? 'Yes' : 'No'; + return '| ' . join(' | ', @md) . ' |'; +} + +# 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 Markdown. 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 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 Markdown +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. + +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 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