diff --git a/src/tools/DBD.pm b/src/tools/DBD.pm index 20b149b85..2d7180dcb 100644 --- a/src/tools/DBD.pm +++ b/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'}; } diff --git a/src/tools/DBD/Base.pm b/src/tools/DBD/Base.pm index 92b23a388..8c6b80cbb 100644 --- a/src/tools/DBD/Base.pm +++ b/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} diff --git a/src/tools/DBD/Menu.pm b/src/tools/DBD/Menu.pm index a7ca26ab9..357f8792c 100644 --- a/src/tools/DBD/Menu.pm +++ b/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) diff --git a/src/tools/DBD/Output.pm b/src/tools/DBD/Output.pm index b82ff98c9..99cb9e5ad 100644 --- a/src/tools/DBD/Output.pm +++ 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; diff --git a/src/tools/DBD/Parser.pm b/src/tools/DBD/Parser.pm index 8cace9c17..af7afeaaf 100644 --- a/src/tools/DBD/Parser.pm +++ b/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); diff --git a/src/tools/DBD/Recfield.pm b/src/tools/DBD/Recfield.pm index a370b2cc7..0feaded56 100644 --- a/src/tools/DBD/Recfield.pm +++ b/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 { diff --git a/src/tools/DBD/Recordtype.pm b/src/tools/DBD/Recordtype.pm index f730777a3..27b714124 100644 --- a/src/tools/DBD/Recordtype.pm +++ b/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;