1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
#----------------------------------------------------------------------
#
# Catalog.pm
# Perl module that extracts info from catalog headers into Perl
# data structures
#
# Portions Copyright (c) 1996-2016, PostgreSQL Global Development Group
# Portions Copyright (c) 1994, Regents of the University of California
#
# src/backend/catalog/Catalog.pm
#
#----------------------------------------------------------------------
package Catalog;
use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = ();
our @EXPORT_OK = qw(Catalogs RenameTempFile);
# Call this function with an array of names of header files to parse.
# Returns a nested data structure describing the data in the headers.
sub Catalogs
{
my (%catalogs, $catname, $declaring_attributes, $most_recent);
$catalogs{names} = [];
# There are a few types which are given one name in the C source, but a
# different name at the SQL level. These are enumerated here.
my %RENAME_ATTTYPE = (
'int16' => 'int2',
'int32' => 'int4',
'int64' => 'int8',
'Oid' => 'oid',
'NameData' => 'name',
'TransactionId' => 'xid');
foreach my $input_file (@_)
{
my %catalog;
$catalog{columns} = [];
$catalog{data} = [];
open(INPUT_FILE, '<', $input_file) || die "$input_file: $!";
# Scan the input file.
while (<INPUT_FILE>)
{
# Strip C-style comments.
s;/\*(.|\n)*\*/;;g;
if (m;/\*;)
{
# handle multi-line comments properly.
my $next_line = <INPUT_FILE>;
die "$input_file: ends within C-style comment\n"
if !defined $next_line;
$_ .= $next_line;
redo;
}
# Strip useless whitespace and trailing semicolons.
chomp;
s/^\s+//;
s/;\s*$//;
s/\s+/ /g;
# Push the data into the appropriate data structure.
if (/^DATA\(insert(\s+OID\s+=\s+(\d+))?\s+\(\s*(.*)\s*\)\s*\)$/)
{
push @{ $catalog{data} }, { oid => $2, bki_values => $3 };
}
elsif (/^DESCR\(\"(.*)\"\)$/)
{
$most_recent = $catalog{data}->[-1];
# this tests if most recent line is not a DATA() statement
if (ref $most_recent ne 'HASH')
{
die "DESCR() does not apply to any catalog ($input_file)";
}
if (!defined $most_recent->{oid})
{
die "DESCR() does not apply to any oid ($input_file)";
}
elsif ($1 ne '')
{
$most_recent->{descr} = $1;
}
}
elsif (/^SHDESCR\(\"(.*)\"\)$/)
{
$most_recent = $catalog{data}->[-1];
# this tests if most recent line is not a DATA() statement
if (ref $most_recent ne 'HASH')
{
die
"SHDESCR() does not apply to any catalog ($input_file)";
}
if (!defined $most_recent->{oid})
{
die "SHDESCR() does not apply to any oid ($input_file)";
}
elsif ($1 ne '')
{
$most_recent->{shdescr} = $1;
}
}
elsif (/^DECLARE_TOAST\(\s*(\w+),\s*(\d+),\s*(\d+)\)/)
{
$catname = 'toasting';
my ($toast_name, $toast_oid, $index_oid) = ($1, $2, $3);
push @{ $catalog{data} },
"declare toast $toast_oid $index_oid on $toast_name\n";
}
elsif (/^DECLARE_(UNIQUE_)?INDEX\(\s*(\w+),\s*(\d+),\s*(.+)\)/)
{
$catname = 'indexing';
my ($is_unique, $index_name, $index_oid, $using) =
($1, $2, $3, $4);
push @{ $catalog{data} },
sprintf(
"declare %sindex %s %s %s\n",
$is_unique ? 'unique ' : '',
$index_name, $index_oid, $using);
}
elsif (/^BUILD_INDICES/)
{
push @{ $catalog{data} }, "build indices\n";
}
elsif (/^CATALOG\(([^,]*),(\d+)\)/)
{
$catname = $1;
$catalog{relation_oid} = $2;
# Store pg_* catalog names in the same order we receive them
push @{ $catalogs{names} }, $catname;
$catalog{bootstrap} = /BKI_BOOTSTRAP/ ? ' bootstrap' : '';
$catalog{shared_relation} =
/BKI_SHARED_RELATION/ ? ' shared_relation' : '';
$catalog{without_oids} =
/BKI_WITHOUT_OIDS/ ? ' without_oids' : '';
$catalog{rowtype_oid} =
/BKI_ROWTYPE_OID\((\d+)\)/ ? " rowtype_oid $1" : '';
$catalog{schema_macro} = /BKI_SCHEMA_MACRO/ ? 'True' : '';
$declaring_attributes = 1;
}
elsif ($declaring_attributes)
{
next if (/^{|^$/);
next if (/^#/);
if (/^}/)
{
undef $declaring_attributes;
}
else
{
my %row;
my ($atttype, $attname, $attopt) = split /\s+/, $_;
die "parse error ($input_file)" unless $attname;
if (exists $RENAME_ATTTYPE{$atttype})
{
$atttype = $RENAME_ATTTYPE{$atttype};
}
if ($attname =~ /(.*)\[.*\]/) # array attribute
{
$attname = $1;
$atttype .= '[]'; # variable-length only
}
$row{'type'} = $atttype;
$row{'name'} = $attname;
if (defined $attopt)
{
if ($attopt eq 'BKI_FORCE_NULL')
{
$row{'forcenull'} = 1;
}
elsif ($attopt eq 'BKI_FORCE_NOT_NULL')
{
$row{'forcenotnull'} = 1;
}
else
{
die
"unknown column option $attopt on column $attname";
}
}
push @{ $catalog{columns} }, \%row;
}
}
}
$catalogs{$catname} = \%catalog;
close INPUT_FILE;
}
return \%catalogs;
}
# Rename temporary files to final names.
# Call this function with the final file name and the .tmp extension
# Note: recommended extension is ".tmp$$", so that parallel make steps
# can't use the same temp files
sub RenameTempFile
{
my $final_name = shift;
my $extension = shift;
my $temp_name = $final_name . $extension;
print "Writing $final_name\n";
rename($temp_name, $final_name) || die "rename: $temp_name: $!";
}
1;
|
