diff --git a/src/dbHost/DBD/Output.pm b/src/dbHost/DBD/Output.pm new file mode 100644 index 000000000..eaff9c45c --- /dev/null +++ b/src/dbHost/DBD/Output.pm @@ -0,0 +1,98 @@ +package DBD::Output; + +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(&OutputDBD); + +use DBD; +use DBD::Base; +use DBD::Breaktable; +use DBD::Device; +use DBD::Driver; +use DBD::Menu; +use DBD::Recordtype; +use DBD::Recfield; +use DBD::Registrar; +use DBD::Function; +use DBD::Variable; + +sub OutputDBD { + my ($out, $dbd) = @_; + &OutputMenus($out, $dbd->menus); + &OutputRecordtypes($out, $dbd->recordtypes); + &OutputDrivers($out, $dbd->drivers); + &OutputRegistrars($out, $dbd->registrars); + &OutputFunctions($out, $dbd->functions); + &OutputVariables($out, $dbd->variables); + &OutputBreaktables($out, $dbd->breaktables); +} + +sub OutputMenus { + my ($out, $menus) = @_; + while (my ($name, $menu) = each %{$menus}) { + printf $out "menu(%s) {\n", $name; + printf $out " choice(%s, \"%s\")\n", @{$_} + foreach $menu->choices; + print $out "}\n"; + } +} + +sub OutputRecordtypes { + my ($out, $recordtypes) = @_; + while (my ($name, $recordtype) = each %{$recordtypes}) { + printf $out "recordtype(%s) {\n", $name; + foreach $field ($recordtype->fields) { + printf $out " field(%s, %s) {\n", + $field->name, $field->dbf_type; + while (my ($attr, $val) = each %{$field->attributes}) { + $val = "\"$val\"" if $val =~ m/\s/; + printf $out " %s(%s)\n", $attr, $val; + } + print $out " }\n"; + } + print $out "% $_\n" + foreach $recordtype->cdefs; + printf $out "}\n"; + printf $out "device(%s, %s, %s, \"%s\")\n", + $name, $_->link_type, $_->name, $_->choice + foreach $recordtype->devices; + } +} + +sub OutputDrivers { + my ($out, $drivers) = @_; + printf $out "driver(%s)\n", $_ + foreach keys %{$drivers}; +} + +sub OutputRegistrars { + my ($out, $registrars) = @_; + printf $out "registrar(%s)\n", $_ + foreach keys %{$registrars}; +} + +sub OutputFunctions { + my ($out, $functions) = @_; + printf $out "function(%s)\n", $_ + foreach keys %{$functions}; +} + +sub OutputVariables { + my ($out, $variables) = @_; + while (my ($name, $variable) = each %{$variables}) { + printf $out "variable(%s, %s)\n", $name, $variable->var_type; + } +} + +sub OutputBreaktables { + my ($out, $breaktables) = @_; + while (my ($name, $breaktable) = each %{$breaktables}) { + printf $out "breaktable(\"%s\") {\n", $name; + printf $out " point(%s, %s)\n", @{$_} + foreach $breaktable->points; + print $out "}\n"; + } +} + +1; diff --git a/src/dbHost/Makefile b/src/dbHost/Makefile index 03f17cc85..0158ca2a5 100644 --- a/src/dbHost/Makefile +++ b/src/dbHost/Makefile @@ -16,6 +16,7 @@ PERL_MODULES += DBD/Device.pm PERL_MODULES += DBD/Driver.pm PERL_MODULES += DBD/Function.pm PERL_MODULES += DBD/Menu.pm +PERL_MODULES += DBD/Output.pm PERL_MODULES += DBD/Parser.pm PERL_MODULES += DBD/Recfield.pm PERL_MODULES += DBD/Recordtype.pm @@ -24,7 +25,7 @@ PERL_MODULES += DBD/Variable.pm PERL_SCRIPTS += dbdToMenuH.pl PERL_SCRIPTS += dbdToRecordtypeH.pl -PERL_SCRIPTS += dbExpand.pl +PERL_SCRIPTS += dbdExpand.pl include $(TOP)/configure/RULES diff --git a/src/dbHost/dbExpand.pl b/src/dbHost/dbExpand.pl deleted file mode 100755 index 5ff79e58b..000000000 --- a/src/dbHost/dbExpand.pl +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/perl - -# This version of dbExpand does not syntax check its input files or remove -# duplicate definitions, unlike the dbStaticLib version. It does do the -# include file expansion and macro substitution though. - -use FindBin qw($Bin); -use lib "$Bin/../../lib/perl"; - -use EPICS::Getopts; -use Readfile; -use macLib; - -getopts('DI@S@o:') or - die "Usage: dbExpand [-D] [-I dir] [-S macro=val] [-o out.dbd] in.dbd ..."; - -my @path = map { split /[:;]/ } @opt_I; -my @output; - -my $macros = macLib->new(@opt_S); - -while (@ARGV) { - my @file = &Readfile(shift @ARGV, $macros, \@opt_I); - # Strip the stuff that Readfile() added: - push @output, grep !/^\#\#!/, @file -} - -if ($opt_D) { # Output dependencies, not the expanded data - my %filecount; - my @uniqfiles = grep { not $filecount{$_}++ } @inputfiles; - print "$opt_o: ", join(" \\\n ", @uniqfiles), "\n\n"; - print map { "$_:\n" } @uniqfiles; -} elsif ($opt_o) { - open OUTFILE, ">$opt_o" or die "Can't create $opt_o: $!\n"; - print OUTFILE @output; - close OUTFILE; -} else { - print @output; -} diff --git a/src/dbHost/dbdExpand.pl b/src/dbHost/dbdExpand.pl new file mode 100755 index 000000000..5919ddbe4 --- /dev/null +++ b/src/dbHost/dbdExpand.pl @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +use FindBin qw($Bin); +use lib "$Bin/../../lib/perl"; + +use DBD; +use DBD::Parser; +use DBD::Output; +use EPICS::Getopts; +use Readfile; +use macLib; + +getopts('DI@S@o:') or + die "Usage: dbdExpand [-D] [-I dir] [-S macro=val] [-o out.dbd] in.dbd ..."; + +my @path = map { split /[:;]/ } @opt_I; +my $macros = macLib->new(@opt_S); +my $dbd = DBD->new(); + +while (@ARGV) { + &ParseDBD($dbd, &Readfile(shift @ARGV, $macros, \@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) { + open $out, '>', $opt_o or die "Can't create $opt_o: $!\n"; +} else { + $out = STDOUT; +} + +&OutputDBD($out, $dbd); + +if ($opt_o) { + close $out or die "Closing $opt_o failed: $!\n"; +} +exit 0; diff --git a/src/dbHost/dbdReport b/src/dbHost/dbdReport index 7b0060c98..a9d198614 100755 --- a/src/dbHost/dbdReport +++ b/src/dbHost/dbdReport @@ -1,8 +1,11 @@ #!/usr/bin/perl +use FindBin qw($Bin); +use lib "$Bin/../../lib/perl"; + use DBD; use DBD::Parser; -use Getopts; +use EPICS::Getopts; use macLib; use Readfile; use Text::Wrap;