2009-02-15: Getting close.

Rename dbExpand => dbdExpand,
Added proper parsing and generation of DBD file.

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;

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
  

src/dbHost/dbExpand.pl

@@ -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;
-}

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;

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;