aboutsummaryrefslogtreecommitdiff
path: root/src/backend/catalog/Catalog.pm
diff options
context:
space:
mode:
Diffstat (limited to 'src/backend/catalog/Catalog.pm')
-rw-r--r--src/backend/catalog/Catalog.pm306
1 files changed, 157 insertions, 149 deletions
diff --git a/src/backend/catalog/Catalog.pm b/src/backend/catalog/Catalog.pm
index cdb0bee1305..a66fce9e0dc 100644
--- a/src/backend/catalog/Catalog.pm
+++ b/src/backend/catalog/Catalog.pm
@@ -25,150 +25,158 @@ our @EXPORT_OK = qw(Catalogs RenameTempFile);
# 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 = (
- '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 ($atttype, $attname) = 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
- }
- push @{ $catalog{columns} }, {$attname => $atttype};
- }
- }
- }
- $catalogs{$catname} = \%catalog;
- close INPUT_FILE;
- }
- return \%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 = (
+ '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 ($atttype, $attname) = 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
+ }
+ push @{ $catalog{columns} }, { $attname => $atttype };
+ }
+ }
+ }
+ $catalogs{$catname} = \%catalog;
+ close INPUT_FILE;
+ }
+ return \%catalogs;
}
# Rename temporary files to final names.
@@ -177,11 +185,11 @@ sub Catalogs
# 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: $!";
+ 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;
generated by cgit v1.2.3 (git 2.25.1) at 2025-08-04 23:45:33 +0000