@@ -33,185 +33,186 @@ sub ParseHeader
3333' TransactionId' => ' xid' ,
3434' XLogRecPtr' => ' pg_lsn' );
3535
36- my %catalog ;
37- my $declaring_attributes = 0;
38- my $is_varlen = 0;
39- my $is_client_code = 0;
36+ my %catalog ;
37+ my $declaring_attributes = 0;
38+ my $is_varlen = 0;
39+ my $is_client_code = 0;
4040
41- $catalog {columns } = [];
42- $catalog {toasting } = [];
43- $catalog {indexing } = [];
44- $catalog {client_code } = [];
41+ $catalog {columns } = [];
42+ $catalog {toasting } = [];
43+ $catalog {indexing } = [];
44+ $catalog {client_code } = [];
4545
46- open (my $ifh ,' <' ,$input_file ) ||die " $input_file :$! " ;
46+ open (my $ifh ,' <' ,$input_file ) ||die " $input_file :$! " ;
4747
48- # Scan the input file.
49- while (<$ifh >)
50- {
48+ # Scan the input file.
49+ while (<$ifh >)
50+ {
5151
52- # Set appropriate flag when we're in certain code sections.
53- if (/ ^#/ )
52+ # Set appropriate flag when we're in certain code sections.
53+ if (/ ^#/ )
54+ {
55+ $is_varlen = 1if / ^#ifdef\s +CATALOG_VARLEN/ ;
56+ if (/ ^#ifdef\s +EXPOSE_TO_CLIENT_CODE/ )
5457{
55- $is_varlen = 1if / ^#ifdef\s +CATALOG_VARLEN/ ;
56- if (/ ^#ifdef\s +EXPOSE_TO_CLIENT_CODE/ )
57- {
58- $is_client_code = 1;
59- next ;
60- }
61- next if !$is_client_code ;
58+ $is_client_code = 1;
59+ next ;
6260}
61+ next if !$is_client_code ;
62+ }
6363
64- if (!$is_client_code )
64+ if (!$is_client_code )
65+ {
66+ # Strip C-style comments.
67+ s ;/\*(.|\n)*\*/;;g;
68+ if (m ; /\* ; )
6569{
66- # Strip C-style comments.
67- s ;/\*(.|\n)*\*/;;g;
68- if (m ; /\* ; )
69- {
70-
71- # handle multi-line comments properly.
72- my $next_line = <$ifh >;
73- die " $input_file : ends within C-style comment\n "
74- if !defined $next_line ;
75- $_ .=$next_line ;
76- redo ;
77- }
7870
79- # Strip useless whitespace and trailing semicolons.
80- chomp ;
81- s / ^\s +// ;
82- s / ;\s *$// ;
83- s /\s +/ / g ;
71+ # handle multi-line comments properly.
72+ my $next_line = <$ifh >;
73+ die " $input_file : ends within C-style comment\n "
74+ if !defined $next_line ;
75+ $_ .=$next_line ;
76+ redo ;
8477}
8578
86- # Push the data into the appropriate data structure.
87- if (/ ^DECLARE_TOAST\(\s *(\w +),\s *(\d +),\s *(\d +)\) / )
79+ # Strip useless whitespace and trailing semicolons.
80+ chomp ;
81+ s / ^\s +// ;
82+ s / ;\s *$// ;
83+ s /\s +/ / g ;
84+ }
85+
86+ # Push the data into the appropriate data structure.
87+ if (/ ^DECLARE_TOAST\(\s *(\w +),\s *(\d +),\s *(\d +)\) / )
88+ {
89+ my ($toast_name ,$toast_oid ,$index_oid ) = ($1 ,$2 ,$3 );
90+ push @{$catalog {toasting } },
91+ " declare toast$toast_oid $index_oid on$toast_name \n " ;
92+ }
93+ elsif (/ ^DECLARE_(UNIQUE_)?INDEX\(\s *(\w +),\s *(\d +),\s *(.+)\) / )
94+ {
95+ my ($is_unique ,$index_name ,$index_oid ,$using ) =
96+ ($1 ,$2 ,$3 ,$4 );
97+ push @{$catalog {indexing } },
98+ sprintf (
99+ " declare%sindex %s %s %s \n " ,
100+ $is_unique ?' unique' :' ' ,
101+ $index_name ,$index_oid ,$using );
102+ }
103+ elsif (/ ^BUILD_INDICES/ )
104+ {
105+ push @{$catalog {indexing } }," build indices\n " ;
106+ }
107+ elsif (/ ^CATALOG\( (\w +),(\d +),(\w +)\) / )
108+ {
109+ $catalog {catname } =$1 ;
110+ $catalog {relation_oid } =$2 ;
111+ $catalog {relation_oid_macro } =$3 ;
112+
113+ $catalog {bootstrap } = /BKI_BOOTSTRAP/ ?' bootstrap' :' ' ;
114+ $catalog {shared_relation } =
115+ / BKI_SHARED_RELATION/ ?' shared_relation' :' ' ;
116+ $catalog {without_oids } =
117+ / BKI_WITHOUT_OIDS/ ?' without_oids' :' ' ;
118+ if (/ BKI_ROWTYPE_OID\( (\d +),(\w +)\) / )
88119{
89- my ( $toast_name , $toast_oid , $index_oid ) = ( $1 , $2 , $3 ) ;
90- push @{ $catalog {toasting } },
91- " declare toast $toast_oid $index_oid on $toast_name \n " ;
120+ $catalog { rowtype_oid } = $1 ;
121+ $catalog {rowtype_oid_clause } = " rowtype_oid $1 " ;
122+ $catalog { rowtype_oid_macro } = $2 ;
92123}
93- elsif ( / ^DECLARE_(UNIQUE_)?INDEX \(\s *( \w +), \s *( \d +), \s *(.+) \) / )
124+ else
94125{
95- my ($is_unique ,$index_name ,$index_oid ,$using ) =
96- ($1 ,$2 ,$3 ,$4 );
97- push @{$catalog {indexing } },
98- sprintf (
99- " declare%sindex %s %s %s \n " ,
100- $is_unique ?' unique' :' ' ,
101- $index_name ,$index_oid ,$using );
126+ $catalog {rowtype_oid } =' ' ;
127+ $catalog {rowtype_oid_clause } =' ' ;
128+ $catalog {rowtype_oid_macro } =' ' ;
102129}
103- elsif (/ ^BUILD_INDICES/ )
130+ $catalog {schema_macro } = /BKI_SCHEMA_MACRO/ ? 1 : 0;
131+ $declaring_attributes = 1;
132+ }
133+ elsif ($is_client_code )
134+ {
135+ if (/ ^#endif/ )
104136{
105- push @{ $catalog { indexing } }, " build indices \n " ;
137+ $is_client_code = 0 ;
106138}
107- elsif ( / ^CATALOG \( ( \w +),( \d +),( \w +) \) / )
139+ else
108140{
109- $catalog {catname } =$1 ;
110- $catalog {relation_oid } =$2 ;
111- $catalog {relation_oid_macro } =$3 ;
112-
113- $catalog {bootstrap } = /BKI_BOOTSTRAP/ ?' bootstrap' :' ' ;
114- $catalog {shared_relation } =
115- / BKI_SHARED_RELATION/ ?' shared_relation' :' ' ;
116- $catalog {without_oids } =
117- / BKI_WITHOUT_OIDS/ ?' without_oids' :' ' ;
118- if (/ BKI_ROWTYPE_OID\( (\d +),(\w +)\) / )
119- {
120- $catalog {rowtype_oid } =$1 ;
121- $catalog {rowtype_oid_clause } =" rowtype_oid$1 " ;
122- $catalog {rowtype_oid_macro } =$2 ;
123- }
124- else
125- {
126- $catalog {rowtype_oid } =' ' ;
127- $catalog {rowtype_oid_clause } =' ' ;
128- $catalog {rowtype_oid_macro } =' ' ;
129- }
130- $catalog {schema_macro } = /BKI_SCHEMA_MACRO/ ? 1 : 0;
131- $declaring_attributes = 1;
141+ push @{$catalog {client_code } },$_ ;
132142}
133- elsif ($is_client_code )
143+ }
144+ elsif ($declaring_attributes )
145+ {
146+ next if (/ ^{|^$ / );
147+ if (/ ^}/ )
134148{
135- if (/ ^#endif/ )
136- {
137- $is_client_code = 0;
138- }
139- else
140- {
141- push @{$catalog {client_code } },$_ ;
142- }
149+ $declaring_attributes = 0;
143150}
144- elsif ( $declaring_attributes )
151+ else
145152{
146- next if (/ ^{|^$ / );
147- if (/ ^}/ )
153+ my %column ;
154+ my @attopts =split /\s +/,$_ ;
155+ my $atttype =shift @attopts ;
156+ my $attname =shift @attopts ;
157+ die " parse error ($input_file )"
158+ unless ($attname and $atttype );
159+
160+ if (exists $RENAME_ATTTYPE {$atttype })
148161{
149- $declaring_attributes =0 ;
162+ $atttype =$RENAME_ATTTYPE { $atttype } ;
150163}
151- else
164+
165+ # If the C name ends with '[]' or '[digits]', we have
166+ # an array type, so we discard that from the name and
167+ # prepend '_' to the type.
168+ if ($attname =~/ (\w +)\[\d *\] / )
152169{
153- my %column ;
154- my @attopts =split /\s +/,$_ ;
155- my $atttype =shift @attopts ;
156- my $attname =shift @attopts ;
157- die " parse error ($input_file )"
158- unless ($attname and $atttype );
159-
160- if (exists $RENAME_ATTTYPE {$atttype })
170+ $attname =$1 ;
171+ $atttype =' _' .$atttype ;
172+ }
173+
174+ $column {type } =$atttype ;
175+ $column {name } =$attname ;
176+ $column {is_varlen } = 1if $is_varlen ;
177+
178+ foreach my $attopt (@attopts )
179+ {
180+ if ($attopt eq ' BKI_FORCE_NULL' )
161181{
162- $atttype =$RENAME_ATTTYPE { $atttype } ;
182+ $column { forcenull } =1 ;
163183}
164-
165- # If the C name ends with '[]' or '[digits]', we have
166- # an array type, so we discard that from the name and
167- # prepend '_' to the type.
168- if ($attname =~/ (\w +)\[\d *\] / )
184+ elsif ($attopt eq ' BKI_FORCE_NOT_NULL' )
169185{
170- $attname =$1 ;
171- $atttype =' _' .$atttype ;
186+ $column {forcenotnull } = 1;
172187}
173188
174- $column {type } =$atttype ;
175- $column {name } =$attname ;
176- $column {is_varlen } = 1if $is_varlen ;
189+ # We use quotes for values like \0 and \054, to
190+ # make sure all compilers and syntax highlighters
191+ # can recognize them properly.
192+ elsif ($attopt =~/ BKI_DEFAULT\( ['"]?([^'"]+)['"]?\) / )
193+ {
194+ $column {default } =$1 ;
195+ }
196+ elsif ($attopt =~/ BKI_LOOKUP\( (\w +)\) / )
197+ {
198+ $column {lookup } =$1 ;
199+ }
200+ else
201+ {
202+ die
203+ " unknown column option$attopt on column$attname " ;
204+ }
177205
178- foreach my $attopt ( @attopts )
206+ if ( $column { forcenull } and $column { forcenotnull } )
179207{
180- if ($attopt eq ' BKI_FORCE_NULL' )
181- {
182- $column {forcenull } = 1;
183- }
184- elsif ($attopt eq ' BKI_FORCE_NOT_NULL' )
185- {
186- $column {forcenotnull } = 1;
187- }
188- # We use quotes for values like \0 and \054, to
189- # make sure all compilers and syntax highlighters
190- # can recognize them properly.
191- elsif ($attopt =~/ BKI_DEFAULT\( ['"]?([^'"]+)['"]?\) / )
192- {
193- $column {default } =$1 ;
194- }
195- elsif ($attopt =~/ BKI_LOOKUP\( (\w +)\) / )
196- {
197- $column {lookup } =$1 ;
198- }
199- else
200- {
201- die
202- " unknown column option$attopt on column$attname " ;
203- }
204-
205- if ($column {forcenull }and $column {forcenotnull })
206- {
207- die " $attname is forced both null and not null" ;
208- }
208+ die " $attname is forced both null and not null" ;
209209}
210- push @{$catalog {columns } }, \%column ;
211210}
211+ push @{$catalog {columns } }, \%column ;
212212}
213213}
214- close $ifh ;
214+ }
215+ close $ifh ;
215216return \%catalog ;
216217}
217218
@@ -228,7 +229,7 @@ sub ParseData
228229$input_file =~/ (\w +)\. dat$ /
229230or die " Input file$input_file needs to be a .dat file.\n " ;
230231my $catname =$1 ;
231- my $data = [];
232+ my $data = [];
232233
233234# Scan the input file.
234235while (<$ifd >)
@@ -311,8 +312,9 @@ sub AddDefaultValues
311312{
312313$row -> {$attname } =$column -> {default };
313314}
314- elsif ($catname eq ' pg_proc' &&$attname eq ' pronargs' &&
315- defined ($row -> {proargtypes }))
315+ elsif ($catname eq ' pg_proc'
316+ &&$attname eq ' pronargs'
317+ &&defined ($row -> {proargtypes }))
316318{
317319# pg_proc.pronargs can be derived from proargtypes.
318320my @proargtypes =split /\s +/,$row -> {proargtypes };
@@ -328,7 +330,7 @@ sub AddDefaultValues
328330if (@missing_fields )
329331{
330332die sprintf " missing values for field(s)%s in%s .dat line%s \n " ,
331- join (' ,' ,@missing_fields ),$catname ,$row -> {line_number };
333+ join (' ,' ,@missing_fields ),$catname ,$row -> {line_number };
332334}
333335}
334336
@@ -379,7 +381,7 @@ sub FindDefinedSymbol
379381sub FindDefinedSymbolFromData
380382{
381383my ($data ,$symbol ) =@_ ;
382- foreach my $row (@{$data })
384+ foreach my $row (@{$data })
383385{
384386if ($row -> {oid_symbol }eq $symbol )
385387{