Update to current code:
* Added (c) header, expanded tabs * Set library path and use new library names * Added -D (dependency) output handling * Added -o (output file) support * Use <td> instead of <th> for normal cell data This is by no means complete, but it does seem to work.
This commit is contained in:
Andrew Johnson
@@ -24,6 +24,7 @@ PERL_MODULES += DBD/Variable.pm
|
||||
PERL_SCRIPTS += dbdToMenuH.pl
|
||||
PERL_SCRIPTS += dbdToRecordtypeH.pl
|
||||
PERL_SCRIPTS += dbdExpand.pl
|
||||
PERL_SCRIPTS += dbdToHtml.pl
|
||||
|
||||
include $(TOP)/configure/RULES
|
||||
|
||||
|
||||
@@ -1,15 +1,26 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
#*************************************************************************
|
||||
# Copyright (c) 2010 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.
|
||||
#*************************************************************************
|
||||
|
||||
# $Id$
|
||||
|
||||
use FindBin qw($Bin);
|
||||
use lib "$Bin/../../lib/perl";
|
||||
|
||||
use DBD;
|
||||
use DBD::Parser;
|
||||
use Getopts;
|
||||
use macLib;
|
||||
use EPICS::Getopts;
|
||||
use EPICS::macLib;
|
||||
use Readfile;
|
||||
|
||||
my $tool = 'dbdToHtml';
|
||||
getopts('DI@o:') or
|
||||
die "Usage: $tool [-D] [-I dir] [-o xRecord.h] xRecord.dbd [xRecord.h]\n";
|
||||
die "Usage: $tool [-D] [-I dir] [-o xRecord.html] xRecord.dbd\n";
|
||||
|
||||
my @path = map { split /[:;]/ } @opt_I;
|
||||
my $dbd = DBD->new();
|
||||
@@ -17,58 +28,66 @@ my $dbd = DBD->new();
|
||||
my $infile = shift @ARGV;
|
||||
$infile =~ m/\.dbd$/ or
|
||||
die "$tool: Input file '$infile' must have '.dbd' extension\n";
|
||||
my $outfile;
|
||||
if ($opt_o) {
|
||||
$outfile = $opt_o;
|
||||
} elsif (@ARGV) {
|
||||
$outfile = shift @ARGV;
|
||||
} else {
|
||||
($outfile = $infile) =~ s/\.dbd$/.h/;
|
||||
$outfile =~ s/^.*\///;
|
||||
$outfile =~ s/dbCommonRecord/dbCommon/;
|
||||
}
|
||||
|
||||
print "<H1>$infile </H1><BR>\n";
|
||||
|
||||
&ParseDBD($dbd, &Readfile($infile, 0, \@opt_I));
|
||||
|
||||
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 $out;
|
||||
if ($opt_o) {
|
||||
$out = $opt_o;
|
||||
} else {
|
||||
($out = $infile) =~ s/\.dbd$/.html/;
|
||||
$out =~ s/^.*\///;
|
||||
$out =~ s/dbCommonRecord/dbCommon/;
|
||||
}
|
||||
open $out, '>', $opt_o or die "Can't create $opt_o: $!\n";
|
||||
|
||||
print $out "<h1>$infile</h1>\n";
|
||||
|
||||
my $rtypes = $dbd->recordtypes;
|
||||
|
||||
my ($rn, $rtyp) = each %{$rtypes};
|
||||
print "<H2>Record Name $rn </H2>\n";
|
||||
print $out "<h2>Record Name $rn</h2>\n";
|
||||
|
||||
my @fields = $rtyp->fields;
|
||||
|
||||
#create a Hash to store the table of field information for each GUI type
|
||||
%dbdTables = (
|
||||
"GUI_COMMON" => "",
|
||||
"GUI_COMMON" => "",
|
||||
"GUI_ALARMS" => "",
|
||||
"GUI_BITS1" => "",
|
||||
"GUI_BITS2" => "",
|
||||
"GUI_CALC" => "",
|
||||
"GUI_CLOCK" => "",
|
||||
"GUI_COMPRESS" => "",
|
||||
"GUI_CONVERT" => "",
|
||||
"GUI_DISPLAY" => "",
|
||||
"GUI_HIST" => "",
|
||||
"GUI_INPUTS" => "",
|
||||
"GUI_LINKS" => "",
|
||||
"GUI_MBB" => "",
|
||||
"GUI_MOTOR" => "",
|
||||
"GUI_OUTPUT" => "",
|
||||
"GUI_PID" => "",
|
||||
"GUI_PULSE" => "",
|
||||
"GUI_SELECT" => "",
|
||||
"GUI_SEQ1" => "",
|
||||
"GUI_SEQ2" => "",
|
||||
"GUI_SEQ3" => "",
|
||||
"GUI_SUB" => "",
|
||||
"GUI_TIMER" => "",
|
||||
"GUI_WAVE" => "",
|
||||
"GUI_SCAN" => "",
|
||||
"GUI_NONE" => ""
|
||||
);
|
||||
"GUI_COMMON" => "",
|
||||
"GUI_COMMON" => "",
|
||||
"GUI_ALARMS" => "",
|
||||
"GUI_BITS1" => "",
|
||||
"GUI_BITS2" => "",
|
||||
"GUI_CALC" => "",
|
||||
"GUI_CLOCK" => "",
|
||||
"GUI_COMPRESS" => "",
|
||||
"GUI_CONVERT" => "",
|
||||
"GUI_DISPLAY" => "",
|
||||
"GUI_HIST" => "",
|
||||
"GUI_INPUTS" => "",
|
||||
"GUI_LINKS" => "",
|
||||
"GUI_MBB" => "",
|
||||
"GUI_MOTOR" => "",
|
||||
"GUI_OUTPUT" => "",
|
||||
"GUI_PID" => "",
|
||||
"GUI_PULSE" => "",
|
||||
"GUI_SELECT" => "",
|
||||
"GUI_SEQ1" => "",
|
||||
"GUI_SEQ2" => "",
|
||||
"GUI_SEQ3" => "",
|
||||
"GUI_SUB" => "",
|
||||
"GUI_TIMER" => "",
|
||||
"GUI_WAVE" => "",
|
||||
"GUI_SCAN" => "",
|
||||
"GUI_NONE" => ""
|
||||
);
|
||||
|
||||
|
||||
#Loop over all of the fields. Build a string that contains the table body
|
||||
@@ -76,9 +95,9 @@ my @fields = $rtyp->fields;
|
||||
foreach $fVal (@fields) {
|
||||
my $pg = $fVal->attribute('promptgroup');
|
||||
while ( ($typ1, $content) = each %dbdTables) {
|
||||
if ( $pg eq $typ1 or ($pg eq "" and $typ1 eq "GUI_NONE")) {
|
||||
buildTableRow($fVal, $dbdTables{$typ1} );
|
||||
}
|
||||
if ( $pg eq $typ1 or ($pg eq "" and $typ1 eq "GUI_NONE")) {
|
||||
buildTableRow($fVal, $dbdTables{$typ1} );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -92,12 +111,12 @@ while ( ($typ2, $content) = each %dbdTables) {
|
||||
#in as parameters
|
||||
sub buildTableRow {
|
||||
my ( $fld, $outStr) = @_;
|
||||
$longDesc = " ";
|
||||
$longDesc = " ";
|
||||
%htmlCellFmt = (
|
||||
rowStart => "<TR><TH rowspan = \"2\">",
|
||||
nextCell => "</TH><TH>",
|
||||
endRow => "</TH></TR>",
|
||||
nextRow => "<TR><TH colspan = \"7\" align=left>"
|
||||
rowStart => "<tr><td rowspan = \"2\">",
|
||||
nextCell => "</td><td>",
|
||||
endRow => "</td></tr>",
|
||||
nextRow => "<tr><td colspan = \"7\" align=left>"
|
||||
);
|
||||
my %cellFmt = %htmlCellFmt;
|
||||
my $rowStart = $cellFmt{rowStart};
|
||||
@@ -111,8 +130,8 @@ sub buildTableRow {
|
||||
$outStr = $outStr . $nextCell;
|
||||
my $recType = $fld->dbf_type;
|
||||
$typStr = $recType;
|
||||
if ($recType eq "DBF_STRING") {
|
||||
$typStr = $recType . " [" . $fld->attribute('size') . "]";
|
||||
if ($recType eq "DBF_STRING") {
|
||||
$typStr = $recType . " [" . $fld->attribute('size') . "]";
|
||||
}
|
||||
|
||||
$outStr = $outStr . $typStr;
|
||||
@@ -120,7 +139,7 @@ sub buildTableRow {
|
||||
$outStr = $outStr . design($fld);
|
||||
$outStr = $outStr . $nextCell;
|
||||
my $initial = $fld->attribute('initial');
|
||||
if ( $initial eq '' ) {$initial = " ";}
|
||||
if ( $initial eq '' ) {$initial = " ";}
|
||||
$outStr = $outStr . $initial;
|
||||
$outStr = $outStr . $nextCell;
|
||||
$outStr = $outStr . readable($fld);
|
||||
@@ -142,7 +161,7 @@ sub design {
|
||||
my $fld = $_[0];
|
||||
my $pg = $fld->attribute('promptgroup');
|
||||
if ( $pg eq '' ) {
|
||||
my $result = 'No';
|
||||
my $result = 'No';
|
||||
}
|
||||
else {
|
||||
my $result = 'Yes';
|
||||
@@ -153,15 +172,15 @@ sub design {
|
||||
sub readable {
|
||||
my $fld = $_[0];
|
||||
if ( $fld->attribute('special') eq "SPC_DBADDR") {
|
||||
$return = "Probably";
|
||||
$return = "Probably";
|
||||
}
|
||||
else{
|
||||
if ( $fld->dbf_type eq "DBF_NOACCESS" ) {
|
||||
$return = "No";
|
||||
}
|
||||
else {
|
||||
$return = "Yes"
|
||||
}
|
||||
if ( $fld->dbf_type eq "DBF_NOACCESS" ) {
|
||||
$return = "No";
|
||||
}
|
||||
else {
|
||||
$return = "Yes"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -170,20 +189,20 @@ sub writable {
|
||||
my $fld = $_[0];
|
||||
my $spec = $fld->attribute('special');
|
||||
if ( $spec eq "SPC_NOMOD" ) {
|
||||
$return = "No";
|
||||
$return = "No";
|
||||
}
|
||||
else {
|
||||
if ( $spec ne "SPC_DBADDR") {
|
||||
if ( $fld->dbf_type eq "DBF_NOACCESS" ) {
|
||||
$return = "No";
|
||||
}
|
||||
else {
|
||||
$return = "Yes";
|
||||
}
|
||||
}
|
||||
else {
|
||||
$return = "Maybe";
|
||||
}
|
||||
if ( $spec ne "SPC_DBADDR") {
|
||||
if ( $fld->dbf_type eq "DBF_NOACCESS" ) {
|
||||
$return = "No";
|
||||
}
|
||||
else {
|
||||
$return = "Yes";
|
||||
}
|
||||
}
|
||||
else {
|
||||
$return = "Maybe";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -193,31 +212,31 @@ sub processPassive {
|
||||
my $fld = $_[0];
|
||||
$pp = $fld->attribute('pp');
|
||||
if ( $pp eq "YES" or $pp eq "TRUE" ) {
|
||||
$result = "Yes";
|
||||
$result = "Yes";
|
||||
}
|
||||
elsif ( $PP eq "NO" or $pp eq "FALSE" or $pp eq "" ) {
|
||||
$result = "No";
|
||||
$result = "No";
|
||||
}
|
||||
}
|
||||
|
||||
#print the start row to define a table
|
||||
sub printTableStart {
|
||||
print "<TABLE border =\"1\" > \n";
|
||||
print "<CAPTION><EM>$_[0]</EM></CAPTION>";
|
||||
print "<th>Field</th>\n";
|
||||
print "<th>Summary</th>\n";
|
||||
print "<th>Type</th>\n";
|
||||
print "<th>DCT</th>\n";
|
||||
print "<th>Default</th>\n";
|
||||
print "<th>Read</th>\n";
|
||||
print "<th>Write</th>\n";
|
||||
print "<th>caPut=PP</th></tr>\n";
|
||||
print $out "<table border =\"1\"> \n";
|
||||
print $out "<caption><em>$_[0]</em></caption>";
|
||||
print $out "<th>Field</th>\n";
|
||||
print $out "<th>Summary</th>\n";
|
||||
print $out "<th>Type</th>\n";
|
||||
print $out "<th>DCT</th>\n";
|
||||
print $out "<th>Default</th>\n";
|
||||
print $out "<th>Read</th>\n";
|
||||
print $out "<th>Write</th>\n";
|
||||
print $out "<th>caPut=PP</th></tr>\n";
|
||||
|
||||
}
|
||||
|
||||
#print the tail end of the table
|
||||
sub printTableEnd {
|
||||
print "</TABLE>\n";
|
||||
print $out "</table>\n";
|
||||
}
|
||||
|
||||
# Print the table for a GUI type. The name of the GUI type and the Table body
|
||||
@@ -225,9 +244,9 @@ sub printTableEnd {
|
||||
sub printHtmlTable {
|
||||
my ($typ2, $content) = $_;
|
||||
if ( (length $_[1]) gt 0) {
|
||||
printTableStart($_[0]);
|
||||
print "$_[1]\n";
|
||||
printTableEnd();
|
||||
printTableStart($_[0]);
|
||||
print $out "$_[1]\n";
|
||||
printTableEnd();
|
||||
}
|
||||
|
||||
}
|
||||
Reference in New Issue
Block a user