From adbf7a73889b848aac79cfa505ca69d58b23e9a8 Mon Sep 17 00:00:00 2001 From: Andrew Johnson Date: Mon, 10 May 2010 15:59:39 -0500 Subject: [PATCH] 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 instead of for normal cell data This is by no means complete, but it does seem to work. --- src/dbHost/Makefile | 1 + src/dbHost/{dbdToHtml => dbdToHtml.pl} | 201 ++++++++++++++----------- 2 files changed, 111 insertions(+), 91 deletions(-) rename src/dbHost/{dbdToHtml => dbdToHtml.pl} (51%) diff --git a/src/dbHost/Makefile b/src/dbHost/Makefile index 927d8f53c..465c910ac 100644 --- a/src/dbHost/Makefile +++ b/src/dbHost/Makefile @@ -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 diff --git a/src/dbHost/dbdToHtml b/src/dbHost/dbdToHtml.pl similarity index 51% rename from src/dbHost/dbdToHtml rename to src/dbHost/dbdToHtml.pl index 23e063e27..a6fb69dfc 100644 --- a/src/dbHost/dbdToHtml +++ b/src/dbHost/dbdToHtml.pl @@ -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 "

$infile


\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 "

$infile

\n"; + my $rtypes = $dbd->recordtypes; my ($rn, $rtyp) = each %{$rtypes}; -print "

Record Name $rn

\n"; +print $out "

Record Name $rn

\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 => "", - nextCell => "", - endRow => "", - nextRow => "" + rowStart => "", + nextCell => "", + endRow => "", + nextRow => "" ); 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 " \n"; - print ""; - print "\n"; - print "\n"; - print "\n"; - print "\n"; - print "\n"; - print "\n"; - print "\n"; - print "\n"; + print $out "
$_[0]
FieldSummaryTypeDCTDefaultReadWritecaPut=PP
\n"; + print $out ""; + print $out "\n"; + print $out "\n"; + print $out "\n"; + print $out "\n"; + print $out "\n"; + print $out "\n"; + print $out "\n"; + print $out "\n"; } #print the tail end of the table sub printTableEnd { - print "
$_[0]
FieldSummaryTypeDCTDefaultReadWritecaPut=PP
\n"; + print $out "\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(); } }