Add ability to save & retrieve comments to DBD objects

src/tools/DBD.pm

@@ -21,7 +21,8 @@ sub new {
         'DBD::Menu'       => {},
         'DBD::Recordtype' => {},
         'DBD::Registrar'  => {},
-        'DBD::Variable'   => {}
+        'DBD::Variable'   => {},
+        'COMMENTS'        => []
     };
     bless $this, $class;
     return $this;
@@ -43,6 +44,15 @@ sub add {
     }
 }
 
+sub add_comment {
+    my ($this, $comment) = @_;
+    push @{$this->{COMMENTS}}, $comment;
+}
+
+sub comments {
+    return @{shift->{COMMENTS}};
+}
+
 sub breaktables {
     return shift->{'DBD::Breaktable'};
 }

src/tools/DBD/Base.pm

@@ -128,6 +128,11 @@ sub what {
     return shift->{WHAT};
 }
 
+sub add_comment {
+    my ($this, $comment) = @_;
+    # Ignore
+}
+
 sub equals {
     my ($a, $b) = @_;
     return $a->{NAME} eq $b->{NAME}

src/tools/DBD/Menu.pm

@@ -7,6 +7,7 @@ sub init {
     $this->SUPER::init($name, "menu");
     $this->{CHOICE_LIST} = [];
     $this->{CHOICE_INDEX} = {};
+    $this->{COMMENTS} = [];
     return $this;
 }
 
@@ -39,6 +40,15 @@ sub legal_choice {
     return exists $this->{CHOICE_INDEX}->{$value};
 }
 
+sub add_comment {
+    my ($this, $comment) = @_;
+    push @{$this->{COMMENTS}}, $comment;
+}
+
+sub comments {
+    return @{shift->{COMMENTS}};
+}
+
 sub equals {
     my ($a, $b) = @_;
     return $a->SUPER::equals($b)

src/tools/DBD/Output.pm

@@ -42,8 +42,6 @@ sub OutputRecordtypes {
     my ($out, $recordtypes) = @_;
     while (my ($name, $recordtype) = each %{$recordtypes}) {
         printf $out "recordtype(%s) {\n", $name;
-        print $out "    %$_\n"
-            foreach $recordtype->cdefs;
         foreach $field ($recordtype->fields) {
             printf $out "    field(%s, %s) {\n",
                 $field->name, $field->dbf_type;

src/tools/DBD/Parser.pm

@@ -19,10 +19,9 @@ use DBD::Variable;
 our $debug=0;
 
 sub ParseDBD {
-    my $dbd = shift;
-    $_ = shift;
+    (my $dbd, $_) = @_;
     while (1) {
-        parseCommon();
+        parseCommon($dbd);
         if (m/\G menu \s* \( \s* $RXstr \s* \) \s* \{/oxgc) {
             print "Menu: $1\n" if $debug;
             parse_menu($dbd, $1);
@@ -70,6 +69,7 @@ sub ParseDBD {
 }
 
 sub parseCommon {
+    my ($obj) = @_;
     while (1) {
         # Skip leading whitespace
         m/\G \s* /oxgc;
@@ -85,6 +85,7 @@ sub parseCommon {
             }
             else {
                 m/\G (.*) \n/oxgc;
+		$obj->add_comment($1);
                 print "Comment: $1\n" if $debug;
             }
         } else {
@@ -98,7 +99,7 @@ sub parse_menu {
     pushContext("menu($name)");
     my $menu = DBD::Menu->new($name);
     while(1) {
-        parseCommon();
+        parseCommon($menu);
         if (m/\G choice \s* \( \s* $RXstr \s* , \s* $RXstr \s* \)/oxgc) {
             print " Menu-Choice: $1, $2\n" if $debug;
             $menu->add_choice($1, $2);
@@ -120,7 +121,7 @@ sub parse_breaktable {
     pushContext("breaktable($name)");
     my $bt = DBD::Breaktable->new($name);
     while(1) {
-        parseCommon();
+        parseCommon($bt);
         if (m/\G point\s* \(\s* $RXstr \s* , \s* $RXstr \s* \)/oxgc) {
             print " Breaktable-Point: $1, $2\n" if $debug;
             $bt->add_point($1, $2);
@@ -146,7 +147,7 @@ sub parse_recordtype {
     pushContext("recordtype($name)");
     my $rtyp = DBD::Recordtype->new($name);
     while(1) {
-        parseCommon();
+        parseCommon($rtyp);
         if (m/\G field \s* \( \s* $RXstr \s* , \s* $RXstr \s* \) \s* \{/oxgc) {
             print " Recordtype-Field: $1, $2\n" if $debug;
             parse_field($rtyp, $1, $2);
@@ -172,7 +173,7 @@ sub parse_field {
     my $fld = DBD::Recfield->new($name, $field_type);
     pushContext("field($name, $field_type)");
     while(1) {
-        parseCommon();
+        parseCommon($fld);
         if (m/\G (\w+) \s* \( \s* $RXstr \s* \)/oxgc) {
             print "  Field-Attribute: $1, $2\n" if $debug;
             $fld->add_attribute($1, $2);

src/tools/DBD/Recfield.pm

@@ -56,6 +56,7 @@ sub init {
         sort keys %field_types) unless exists $field_types{$type};
     $this->{DBF_TYPE} = $type;
     $this->{ATTR_INDEX} = {};
+    $this->{COMMENTS} = [];
     return $this;
 }
 
@@ -109,6 +110,16 @@ sub check_valid {
         if (defined($default) and !$this->legal_value($default));
 }
 
+sub add_comment {
+    my ($this, $comment) = @_;
+    push @{$this->{COMMENTS}}, $comment;
+}
+
+sub comments {
+    return @{shift->{COMMENTS}};
+}
+
+
 # The C structure member name is usually the field name converted to
 # lower-case.  However if that is a reserved word, use the original.
 sub C_name {

src/tools/DBD/Recordtype.pm

@@ -12,6 +12,7 @@ sub init {
     $this->{DEVICE_LIST} = [];
     $this->{DEVICE_INDEX} = {};
     $this->{CDEFS} = [];
+    $this->{COMMENTS} = [];
     return $this;
 }
 
@@ -69,6 +70,15 @@ sub device {
     return $this->{DEVICE_INDEX}->{$choice};
 }
 
+sub add_comment {
+    my ($this, $comment) = @_;
+    push @{$this->{COMMENTS}}, $comment;
+}
+
+sub comments {
+    return @{shift->{COMMENTS}};
+}
+
 sub add_cdef {
     my ($this, $cdef) = @_;
     push @{$this->{CDEFS}}, $cdef;