src/backend/catalog/Catalog.pm | 216 ++++++++-------- src/include/catalog/convert_header2dat.pl | 370 ++++++++++++++++++++++++++++ src/include/catalog/pg_aggregate.h | 38 +-- src/include/catalog/pg_amop.h | 31 ++- src/include/catalog/pg_amproc.h | 19 +- src/include/catalog/pg_authid.h | 43 +++- src/include/catalog/pg_class.h | 138 ++++++++--- src/include/catalog/pg_opclass.h | 17 +- src/include/catalog/pg_operator.h | 56 +++-- src/include/catalog/pg_opfamily.h | 8 +- src/include/catalog/pg_proc.h | 116 ++++++--- src/include/catalog/pg_type.h | 47 ++-- src/include/catalog/rewrite_dat.pl | 392 ++++++++++++++++++++++++++++++ 13 files changed, 1232 insertions(+), 259 deletions(-) diff --git a/src/backend/catalog/Catalog.pm b/src/backend/catalog/Catalog.pm new file mode 100644 index 246aa36..adb0c86 *** a/src/backend/catalog/Catalog.pm --- b/src/backend/catalog/Catalog.pm *************** *** 1,7 **** #---------------------------------------------------------------------- # # Catalog.pm ! # Perl module that extracts info from catalog headers into Perl # data structures # # Portions Copyright (c) 1996-2017, PostgreSQL Global Development Group --- 1,7 ---- #---------------------------------------------------------------------- # # Catalog.pm ! # Perl module that extracts info from catalog files into Perl # data structures # # Portions Copyright (c) 1996-2017, PostgreSQL Global Development Group *************** package Catalog; *** 16,32 **** use strict; use warnings; - require Exporter; - our @ISA = qw(Exporter); - our @EXPORT = (); - our @EXPORT_OK = qw(Catalogs SplitDataLine RenameTempFile FindDefinedSymbol); - # 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. --- 16,29 ---- use strict; use warnings; # Call this function with an array of names of header files to parse. ! # Returns a data structure describing the schemas of the system catalogs. ! sub ParseHeader { ! my (%catalogs, $catname, $declaring_attributes); $catalogs{names} = []; + $catalogs{toasting} = []; + $catalogs{indexing} = []; # 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. *************** sub Catalogs *** 43,55 **** { my %catalog; $catalog{columns} = []; - $catalog{data} = []; my $is_varlen = 0; open(my $ifh, '<', $input_file) || die "$input_file: $!"; my ($filename) = ($input_file =~ m/(\w+)\.h$/); - my $natts_pat = "Natts_$filename"; # Scan the input file. while (<$ifh>) --- 40,50 ---- *************** sub Catalogs *** 78,145 **** s/\s+/ /g; # Push the data into the appropriate data structure. ! if (/$natts_pat\s+(\d+)/) ! { ! $catalog{natts} = $1; ! } ! elsif ( ! /^DATA\(insert(\s+OID\s+=\s+(\d+))?\s+\(\s*(.*)\s*\)\s*\)$/) ! { ! check_natts($filename, $catalog{natts}, $3, $input_file, ! $input_line_number); ! ! 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 ' : '', --- 73,93 ---- s/\s+/ /g; # Push the data into the appropriate data structure. ! if (/^DECLARE_TOAST\(\s*(\w+),\s*(\d+),\s*(\d+)\)/) { ! # Clear last catname so we don't overwrite that ! # catalog's schema with a blank one. ! undef $catname; my ($toast_name, $toast_oid, $index_oid) = ($1, $2, $3); ! push @{ $catalogs{toasting} }, "declare toast $toast_oid $index_oid on $toast_name\n"; } elsif (/^DECLARE_(UNIQUE_)?INDEX\(\s*(\w+),\s*(\d+),\s*(.+)\)/) { my ($is_unique, $index_name, $index_oid, $using) = ($1, $2, $3, $4); ! push @{ $catalogs{indexing} }, sprintf( "declare %sindex %s %s %s\n", $is_unique ? 'unique ' : '', *************** sub Catalogs *** 147,153 **** } elsif (/^BUILD_INDICES/) { ! push @{ $catalog{data} }, "build indices\n"; } elsif (/^CATALOG\(([^,]*),(\d+)\)/) { --- 95,101 ---- } elsif (/^BUILD_INDICES/) { ! push @{ $catalogs{indexing} }, "build indices\n"; } elsif (/^CATALOG\(([^,]*),(\d+)\)/) { *************** sub Catalogs *** 189,196 **** { $column{is_varlen} = 1; } ! my ($atttype, $attname, $attopt) = split /\s+/, $_; ! die "parse error ($input_file)" unless $attname; if (exists $RENAME_ATTTYPE{$atttype}) { $atttype = $RENAME_ATTTYPE{$atttype}; --- 137,148 ---- { $column{is_varlen} = 1; } ! my @attribute = split /\s+/, $_; ! my $atttype = shift @attribute; ! my $attname = shift @attribute; ! die "parse error ($input_file)" ! unless ($attname and $atttype); ! if (exists $RENAME_ATTTYPE{$atttype}) { $atttype = $RENAME_ATTTYPE{$atttype}; *************** sub Catalogs *** 204,210 **** $column{type} = $atttype; $column{name} = $attname; ! if (defined $attopt) { if ($attopt eq 'BKI_FORCE_NULL') { --- 156,162 ---- $column{type} = $atttype; $column{name} = $attname; ! foreach my $attopt (@attribute) { if ($attopt eq 'BKI_FORCE_NULL') { *************** sub Catalogs *** 218,259 **** { $column{default} = $1; } else { die "unknown column option $attopt on column $attname"; } } push @{ $catalog{columns} }, \%column; } } } ! $catalogs{$catname} = \%catalog; close $ifh; } return \%catalogs; } ! # Split a DATA line into fields. ! # Call this on the bki_values element of a DATA item returned by Catalogs(); ! # it returns a list of field values. We don't strip quoting from the fields. ! # Note: it should be safe to assign the result to a list of length equal to ! # the nominal number of catalog fields, because check_natts already checked ! # the number of fields. ! sub SplitDataLine { ! my $bki_values = shift; ! # This handling of quoted strings might look too simplistic, but it ! # matches what bootscanner.l does: that has no provision for quote marks ! # inside quoted strings, either. If we don't have a quoted string, just ! # snarf everything till next whitespace. That will accept some things ! # that bootscanner.l will see as erroneous tokens; but it seems wiser ! # to do that and let bootscanner.l complain than to silently drop ! # non-whitespace characters. ! my @result = $bki_values =~ /"[^"]*"|\S+/g; ! return @result; } # Fill in default values of a record using the given schema. It's the --- 170,246 ---- { $column{default} = $1; } + elsif ($attopt =~ /BKI_ABBREV\((\S+)\)/) + { + $column{abbrev} = $1; + } else { die "unknown column option $attopt on column $attname"; } + if ($column{forcenull} and $column{forcenotnull}) + { + die "$attname is forced both null and not null"; + } } push @{ $catalog{columns} }, \%column; } } } ! # Prevent toasting and indexing blank %catalog vars from ! # over-writing the last real catalog. ! if (defined $catname) ! { ! $catalogs{$catname} = \%catalog; ! } close $ifh; } return \%catalogs; } ! # Takes an array of names of data files containing Perl data structure ! # literals. This function simply calls eval on the whole string. ! # XXX This is much slower than parsing DATA() statements was. ! # Is there a better way? ! sub ParseData { ! my %catalog_data; ! foreach my $input_file (@_) ! { ! my ($filename) = ($input_file =~ m/(\w+)\.dat$/); ! my $raw_data = do ! { ! local $/ = undef; ! open my $ifh, "<", $input_file || die "$input_file: $!"; ! <$ifh>; ! }; ! my $parsed_data; ! eval '$parsed_data = ' . $raw_data; ! # XXX: Is this enough error reporting? ! print "Error : $@\n" if $@; ! $catalog_data{$filename} = $parsed_data; ! } ! return \%catalog_data; ! } ! ! # Copy values from abbreviated keys to full keys. ! sub ResolveColumnAbbrevs ! { ! my $row = shift; ! my $schema = shift; ! ! foreach my $column (@$schema) ! { ! my $abbrev = $column->{abbrev}; ! my $attname = $column->{name}; ! if (defined $abbrev and defined $row->{$abbrev}) ! { ! $row->{$attname} = $row->{$abbrev}; ! } ! } } # Fill in default values of a record using the given schema. It's the *************** sub AddDefaultValues *** 280,290 **** } else { ! die "Unspecified value in $catname.$attname\n"; } } } # 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 --- 267,309 ---- } else { ! printf "Unspecified value in $catname.$attname\n"; ! ! # Give user a clue where the problem was. ! print "Showing other values for context:\n"; ! my $msg; ! foreach (keys %{$row}) ! { ! $msg .= "$_ => $row->{$_}, "; ! } ! die "$msg\n"; } } } + # Some pg_proc fields are computed as part of forming a full tuple. + sub ComputePgProcFields + { + my $row = shift; + + # pronargs is computed by counting proargtypes. + if ($row->{proargtypes}) + { + my @argtypes = split /\s+/, $row->{proargtypes}; + $row->{pronargs} = scalar(@argtypes); + } + else + { + $row->{pronargs} = '0'; + } + + # If prosrc doesn't exist, it must be a copy of proname. + if (!exists $row->{prosrc}) + { + $row->{prosrc} = $row->{proname} + } + } + # 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 *************** sub RenameTempFile *** 298,304 **** rename($temp_name, $final_name) || die "rename: $temp_name: $!"; } - # Find a symbol defined in a particular header file and extract the value. # # The include path has to be passed as a reference to an array. --- 317,322 ---- *************** sub FindDefinedSymbol *** 330,351 **** die "$catalog_header: not found in any include directory\n"; } - - # verify the number of fields in the passed-in DATA line - sub check_natts - { - my ($catname, $natts, $bki_val, $file, $line) = @_; - - die - "Could not find definition for Natts_${catname} before start of DATA() in $file\n" - unless defined $natts; - - my $nfields = scalar(SplitDataLine($bki_val)); - - die sprintf - "Wrong number of attributes in DATA() entry at %s:%d (expected %d but got %d)\n", - $file, $line, $natts, $nfields - unless $natts == $nfields; - } - 1; --- 348,351 ---- diff --git a/src/include/catalog/convert_header2dat.pl b/src/include/catalog/convert_header2dat.pl new file mode 100644 index ...d61cdc8 *** a/src/include/catalog/convert_header2dat.pl --- b/src/include/catalog/convert_header2dat.pl *************** *** 0 **** --- 1,370 ---- + #!/usr/bin/perl -w + #---------------------------------------------------------------------- + # + # convert_header2dat.pl + # Perl script that reads BKI data from the catalog header files + # and writes them out as native perl data structures. Commments and + # white space are preserved. Some functions are loosely copied from + # src/backend/catalog/Catalog.pm, whose equivalents will be removed. + # + # Portions Copyright (c) 1996-2017, PostgreSQL Global Development Group + # Portions Copyright (c) 1994, Regents of the University of California + # + # /src/include/catalog/convert_header2dat.pl + # + #---------------------------------------------------------------------- + + use strict; + use warnings; + + use Data::Dumper; + # No $VARs - we add our own later. + $Data::Dumper::Terse = 1; + + my @input_files; + my $output_path = ''; + my $major_version; + + # Process command line switches. + while (@ARGV) + { + my $arg = shift @ARGV; + if ($arg !~ /^-/) + { + push @input_files, $arg; + } + elsif ($arg =~ /^-o/) + { + $output_path = length($arg) > 2 ? substr($arg, 2) : shift @ARGV; + } + else + { + usage(); + } + } + + # Sanity check arguments. + die "No input files.\n" if !@input_files; + foreach my $input_file (@input_files) + { + if ($input_file !~ /\.h$/) + { + die "Input files need to be header files.\n"; + } + } + + # Make sure output_path ends in a slash. + if ($output_path ne '' && substr($output_path, -1) ne '/') + { + $output_path .= '/'; + } + + # Read all the input header files into internal data structures + # XXX This script is not robust against non-catalog headers. It's best + # to pass it the same list found in backend/catalog/Makefile. + my $catalogs = catalogs(@input_files); + + # produce output, one catalog at a time + foreach my $catname (@{ $catalogs->{names} }) + { + my $catalog = $catalogs->{$catname}; + my $schema = $catalog->{columns}; + + # First, see if the header has any data. This is necessary + # not only because of catalogs with no data, but also because some + # values coming down the pike are comments or newlines. + my $found_one = 0; + foreach my $data (@{ $catalog->{data} }) + { + if (ref $data eq 'HASH') + { + $found_one = 1; + } + } + next if !$found_one; + + my @attnames; + foreach my $column (@$schema) + { + my $attname = $column->{name}; + my $atttype = $column->{type}; + push @attnames, $attname; + } + + my $datfile = "$output_path$catname.dat"; + open my $dat, '>', $datfile + or die "can't open $datfile: $!"; + + # Write out data file. + print $dat "# $catname.dat\n"; + + # Note: Put extra newlines after brackets because otherwise + # some catalogs have newlines and some don't, because of whitespace + # around DATA() comments. + print $dat "[\n\n"; + + foreach my $data (@{ $catalog->{data} }) + { + + # Either a newline or comment - just write it out. + if (! ref $data) + { + print $dat "$data\n"; + } + # Hash ref representing a data entry. + elsif (ref $data eq 'HASH') + { + # Split line into tokens without interpreting their meaning. + my %bki_values; + @bki_values{@attnames} = split_data_line($data->{bki_values}); + + # Flatten data hierarchy. + delete $data->{bki_values}; + my %flat_data = (%$data, %bki_values); + + # Strip double quotes for readability. Most will be put + # back in when writing postgres.bki + foreach (values %flat_data) + { + s/"//g; + } + + print $dat Dumper(\%flat_data); + print $dat ",\n"; + } + } + print $dat "\n]\n"; + } + + + # This function is a heavily modified version of its former namesake + # in Catalog.pm. There's probably some dead code here. It's not worth removing. + 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', + 'XLogRecPtr' => 'pg_lsn'); + + foreach my $input_file (@_) + { + my %catalog; + $catalog{columns} = []; + $catalog{data} = []; + my $is_varlen = 0; + my $saving_comments = 0; + + open(my $ifh, '<', $input_file) || die "$input_file: $!"; + + # Scan the input file. + while (<$ifh>) + { + # Determine that we're in the DATA section and should + # Start saving DATA comments. + if (/(\/|\s)\*\s+initial contents of pg_/) + { + $saving_comments = 1; + } + + if ($saving_comments) + { + if ( m;^(/|\s+)\*\s+(.+); ) + { + my $comment = $2; + + # Ugly way to strip */ off the end + if ($comment =~ m;\*/$;) + { + $comment =~ s/.{2}$//; + } + + # Turn C-style comment into Perl-style. + + # Filter out comments we know we don't want. + if ($comment !~ /^-+$/ + and $comment !~ /initial contents of pg/ + and $comment !~ /PG_\w+_H/) + { + # Trim whitespace. + $comment =~ s/^\s+//; + $comment =~ s/\s+$//; + push @{ $catalog{data} }, "# $comment"; + } + } + elsif (/^$/) + { + # Preserve blank lines + # Newline gets added by caller. + push @{ $catalog{data} }, ''; + } + } + else + { + # Strip C-style comments. + s;/\*(.|\n)*\*/;;g; + if (m;/\*;) + { + # handle multi-line comments properly. + my $next_line = <$ifh>; + die "$input_file: ends within C-style comment\n" + if !defined $next_line; + $_ .= $next_line; + redo; + } + } + # Remember input line number for later. + my $input_line_number = $.; + + # 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*\)$/) + { + if ($2) + { + push @{ $catalog{data} }, { oid => $2, bki_values => $3 }; + } + else + { + push @{ $catalog{data} }, { 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 (/^CATALOG\(([^,]*),(\d+)\)/) + { + $catname = $1; + $catalog{relation_oid} = $2; + + # Store pg_* catalog names in the same order we receive them + push @{ $catalogs{names} }, $catname; + + $declaring_attributes = 1; + } + elsif ($declaring_attributes) + { + next if (/^{|^$/); + next if (/^#/); + if (/^}/) + { + undef $declaring_attributes; + } + else + { + my %column; + if ($is_varlen) + { + $column{is_varlen} = 1; + } + 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 .= '[]'; + } + + $column{type} = $atttype; + $column{name} = $attname; + + push @{ $catalog{columns} }, \%column; + } + } + } + if (defined $catname) + { + $catalogs{$catname} = \%catalog; + } + close $ifh; + } + return \%catalogs; + } + + # Split a DATA line into fields. + # Call this on the bki_values element of a DATA item returned by catalogs(); + # it returns a list of field values. We don't strip quoting from the fields. + # Note: it should be safe to assign the result to a list of length equal to + # the nominal number of catalog fields, because the number of fields were + # checked in the original Catalog module. + sub split_data_line + { + my $bki_values = shift; + + # This handling of quoted strings might look too simplistic, but it + # matches what bootscanner.l does: that has no provision for quote marks + # inside quoted strings, either. If we don't have a quoted string, just + # snarf everything till next whitespace. That will accept some things + # that bootscanner.l will see as erroneous tokens; but it seems wiser + # to do that and let bootscanner.l complain than to silently drop + # non-whitespace characters. + my @result = $bki_values =~ /"[^"]*"|\S+/g; + + return @result; + } + + sub usage + { + die <= this. ! * this is really a MultiXactId */ #ifdef CATALOG_VARLEN /* variable-length fields start here */ /* NOTE: These fields are not present in a relcache entry's rd_rel field. */ ! aclitem relacl[1]; /* access permissions */ ! text reloptions[1]; /* access-method-specific options */ ! pg_node_tree relpartbound; /* partition bound node tree */ #endif } FormData_pg_class; --- 31,147 ---- CATALOG(pg_class,1259) BKI_BOOTSTRAP BKI_ROWTYPE_OID(83) BKI_SCHEMA_MACRO { ! /* class name */ ! NameData relname; ! ! /* OID of namespace containing this class */ ! Oid relnamespace BKI_DEFAULT(PGNSP); ! ! /* OID of entry in pg_type for table's implicit row type */ ! Oid reltype; ! ! /* OID of entry in pg_type for underlying composite type */ ! Oid reloftype BKI_DEFAULT(0); ! ! /* class owner */ ! Oid relowner BKI_DEFAULT(PGUID); ! ! /* index access method; 0 if not an index */ ! Oid relam BKI_DEFAULT(0); ! ! /* identifier of physical storage file */ ! Oid relfilenode BKI_DEFAULT(0); /* relfilenode == 0 means it is a "mapped" relation, see relmapper.c */ ! ! /* identifier of table space for relation */ ! Oid reltablespace BKI_DEFAULT(0); ! ! /* # of blocks (not always up-to-date) */ ! int32 relpages BKI_DEFAULT(0); ! ! /* # of tuples (not always up-to-date) */ ! float4 reltuples BKI_DEFAULT(0); ! ! /* # of all-visible blocks (not always up-to-date) */ ! int32 relallvisible BKI_DEFAULT(0); ! ! /* OID of toast table; 0 if none */ ! Oid reltoastrelid BKI_DEFAULT(0); ! ! /* T if has (or has had) any indexes */ ! bool relhasindex BKI_DEFAULT(f); ! ! /* T if shared across databases */ ! bool relisshared BKI_DEFAULT(f); ! ! /* see RELPERSISTENCE_xxx constants below */ ! char relpersistence BKI_DEFAULT(p); ! ! /* see RELKIND_xxx constants below */ ! char relkind BKI_DEFAULT(r); ! ! /* number of user attributes */ ! int16 relnatts; /* * Class pg_attribute must contain exactly "relnatts" user attributes * (with attnums ranging from 1 to relnatts) for this class. It may also * contain entries with negative attnums for system attributes. */ ! ! /* # of CHECK constraints for class */ ! int16 relchecks BKI_DEFAULT(0); ! ! /* T if we generate OIDs for rows of rel */ ! bool relhasoids; ! ! /* has (or has had) PRIMARY KEY index */ ! bool relhaspkey BKI_DEFAULT(f); ! ! /* has (or has had) any rules */ ! bool relhasrules BKI_DEFAULT(f); ! ! /* has (or has had) any TRIGGERs */ ! bool relhastriggers BKI_DEFAULT(f); ! ! /* has (or has had) derived classes */ ! bool relhassubclass BKI_DEFAULT(f); ! ! /* row security is enabled or not */ ! bool relrowsecurity BKI_DEFAULT(f); ! ! /* row security forced for owners or not */ ! bool relforcerowsecurity BKI_DEFAULT(f); ! ! /* matview currently holds query results */ ! bool relispopulated BKI_DEFAULT(t); ! ! /* see REPLICA_IDENTITY_xxx constants */ ! char relreplident BKI_DEFAULT(n); ! ! /* is relation a partition? */ ! bool relispartition BKI_DEFAULT(f); ! ! /* all Xids < this are frozen in this rel */ ! /* Note: "3" stands for FirstNormalTransactionId */ ! TransactionId relfrozenxid BKI_DEFAULT(3); ! ! /* all multixacts in this rel are >= this. This is really a MultiXactId */ ! /* Note: "1" stands for FirstMultiXactId */ ! TransactionId relminmxid BKI_DEFAULT(1); #ifdef CATALOG_VARLEN /* variable-length fields start here */ /* NOTE: These fields are not present in a relcache entry's rd_rel field. */ ! ! /* access permissions */ ! aclitem relacl[1] BKI_DEFAULT(_null_); ! ! /* access-method-specific options */ ! text reloptions[1] BKI_DEFAULT(_null_); ! ! /* partition bound node tree */ ! pg_node_tree relpartbound BKI_DEFAULT(_null_); #endif } FormData_pg_class; diff --git a/src/include/catalog/pg_opclass.h b/src/include/catalog/pg_opclass.h new file mode 100644 index 28dbc74..7c31622 *** a/src/include/catalog/pg_opclass.h --- b/src/include/catalog/pg_opclass.h *************** CATALOG(pg_opclass,2616) *** 52,63 **** { Oid opcmethod; /* index access method opclass is for */ NameData opcname; /* name of this opclass */ ! Oid opcnamespace; /* namespace of this opclass */ ! Oid opcowner; /* opclass owner */ Oid opcfamily; /* containing operator family */ Oid opcintype; /* type of data indexed by opclass */ ! bool opcdefault; /* T if opclass is default for opcintype */ ! Oid opckeytype; /* type of data in index, or InvalidOid */ } FormData_pg_opclass; /* ---------------- --- 52,72 ---- { Oid opcmethod; /* index access method opclass is for */ NameData opcname; /* name of this opclass */ ! ! /* namespace of this opclass */ ! Oid opcnamespace BKI_DEFAULT(PGNSP); ! ! /* opclass owner */ ! Oid opcowner BKI_DEFAULT(PGUID); ! Oid opcfamily; /* containing operator family */ Oid opcintype; /* type of data indexed by opclass */ ! ! /* T if opclass is default for opcintype */ ! bool opcdefault BKI_DEFAULT(t); ! ! /* type of data in index, or InvalidOid */ ! Oid opckeytype BKI_DEFAULT(0); } FormData_pg_opclass; /* ---------------- diff --git a/src/include/catalog/pg_operator.h b/src/include/catalog/pg_operator.h new file mode 100644 index ff9b470..c94186a *** a/src/include/catalog/pg_operator.h --- b/src/include/catalog/pg_operator.h *************** *** 33,52 **** CATALOG(pg_operator,2617) { ! NameData oprname; /* name of operator */ ! Oid oprnamespace; /* OID of namespace containing this oper */ ! Oid oprowner; /* operator owner */ ! char oprkind; /* 'l', 'r', or 'b' */ ! bool oprcanmerge; /* can be used in merge join? */ ! bool oprcanhash; /* can be used in hash join? */ ! Oid oprleft; /* left arg type, or 0 if 'l' oprkind */ ! Oid oprright; /* right arg type, or 0 if 'r' oprkind */ ! Oid oprresult; /* result datatype */ ! Oid oprcom; /* OID of commutator oper, or 0 if none */ ! Oid oprnegate; /* OID of negator oper, or 0 if none */ ! regproc oprcode; /* OID of underlying function */ ! regproc oprrest; /* OID of restriction estimator, or 0 */ ! regproc oprjoin; /* OID of join estimator, or 0 */ } FormData_pg_operator; /* ---------------- --- 33,80 ---- CATALOG(pg_operator,2617) { ! ! /* name of operator */ ! NameData oprname; ! ! /* OID of namespace containing this oper */ ! Oid oprnamespace BKI_DEFAULT(PGNSP); ! ! /* operator owner */ ! Oid oprowner BKI_DEFAULT(PGUID); ! ! /* 'l', 'r', or 'b' */ ! char oprkind BKI_DEFAULT(b); ! ! /* can be used in merge join? */ ! bool oprcanmerge BKI_DEFAULT(f); ! ! /* can be used in hash join? */ ! bool oprcanhash BKI_DEFAULT(f); ! ! /* left arg type, or 0 if 'l' oprkind */ ! Oid oprleft; ! ! /* right arg type, or 0 if 'r' oprkind */ ! Oid oprright; ! ! /* result datatype */ ! Oid oprresult; ! ! /* OID of commutator oper, or 0 if none */ ! Oid oprcom BKI_DEFAULT(0); ! ! /* OID of negator oper, or 0 if none */ ! Oid oprnegate BKI_DEFAULT(0); ! ! /* OID of underlying function */ ! regproc oprcode; ! ! /* OID of restriction estimator, or 0 */ ! regproc oprrest BKI_DEFAULT(-); ! ! /* OID of join estimator, or 0 */ ! regproc oprjoin BKI_DEFAULT(-); } FormData_pg_operator; /* ---------------- diff --git a/src/include/catalog/pg_opfamily.h b/src/include/catalog/pg_opfamily.h new file mode 100644 index 0d0ba7c..39bb8cd *** a/src/include/catalog/pg_opfamily.h --- b/src/include/catalog/pg_opfamily.h *************** CATALOG(pg_opfamily,2753) *** 32,39 **** { Oid opfmethod; /* index access method opfamily is for */ NameData opfname; /* name of this opfamily */ ! Oid opfnamespace; /* namespace of this opfamily */ ! Oid opfowner; /* opfamily owner */ } FormData_pg_opfamily; /* ---------------- --- 32,43 ---- { Oid opfmethod; /* index access method opfamily is for */ NameData opfname; /* name of this opfamily */ ! ! /* namespace of this opfamily */ ! Oid opfnamespace BKI_DEFAULT(PGNSP); ! ! /* opfamily owner */ ! Oid opfowner BKI_DEFAULT(PGUID); } FormData_pg_opfamily; /* ---------------- diff --git a/src/include/catalog/pg_proc.h b/src/include/catalog/pg_proc.h new file mode 100644 index c969375..4b2cf32 *** a/src/include/catalog/pg_proc.h --- b/src/include/catalog/pg_proc.h *************** *** 35,77 **** CATALOG(pg_proc,1255) BKI_BOOTSTRAP BKI_ROWTYPE_OID(81) BKI_SCHEMA_MACRO { ! NameData proname; /* procedure name */ ! Oid pronamespace; /* OID of namespace containing this proc */ ! Oid proowner; /* procedure owner */ ! Oid prolang; /* OID of pg_language entry */ ! float4 procost; /* estimated execution cost */ ! float4 prorows; /* estimated # of rows out (if proretset) */ ! Oid provariadic; /* element type of variadic array, or 0 */ ! regproc protransform; /* transforms calls to it during planning */ ! bool proisagg; /* is it an aggregate? */ ! bool proiswindow; /* is it a window function? */ ! bool prosecdef; /* security definer */ ! bool proleakproof; /* is it a leak-proof function? */ ! bool proisstrict; /* strict with respect to NULLs? */ ! bool proretset; /* returns a set? */ ! char provolatile; /* see PROVOLATILE_ categories below */ ! char proparallel; /* see PROPARALLEL_ categories below */ ! int16 pronargs; /* number of arguments */ ! int16 pronargdefaults; /* number of arguments with defaults */ ! Oid prorettype; /* OID of result type */ /* * variable-length fields start here, but we allow direct access to * proargtypes */ ! oidvector proargtypes; /* parameter types (excludes OUT params) */ #ifdef CATALOG_VARLEN ! Oid proallargtypes[1]; /* all param types (NULL if IN only) */ ! char proargmodes[1]; /* parameter modes (NULL if IN only) */ ! text proargnames[1]; /* parameter names (NULL if no names) */ ! pg_node_tree proargdefaults; /* list of expression trees for argument ! * defaults (NULL if none) */ ! Oid protrftypes[1]; /* types for which to apply transforms */ ! text prosrc BKI_FORCE_NOT_NULL; /* procedure source text */ ! text probin; /* secondary procedure info (can be NULL) */ ! text proconfig[1]; /* procedure-local GUC settings */ ! aclitem proacl[1]; /* access permissions */ #endif } FormData_pg_proc; --- 35,133 ---- CATALOG(pg_proc,1255) BKI_BOOTSTRAP BKI_ROWTYPE_OID(81) BKI_SCHEMA_MACRO { ! /* procedure name */ ! NameData proname BKI_ABBREV(n); ! ! /* OID of namespace containing this proc */ ! Oid pronamespace BKI_DEFAULT(PGNSP); ! ! /* procedure owner */ ! Oid proowner BKI_DEFAULT(PGUID); ! ! /* OID of pg_language entry */ ! Oid prolang BKI_DEFAULT(12); ! ! /* estimated execution cost */ ! float4 procost BKI_DEFAULT(1); ! ! /* estimated # of rows out (if proretset) */ ! float4 prorows BKI_DEFAULT(0); ! ! /* element type of variadic array, or 0 */ ! Oid provariadic BKI_DEFAULT(0); ! ! /* transforms calls to it during planning */ ! regproc protransform BKI_DEFAULT(0); ! ! /* is it an aggregate? */ ! bool proisagg BKI_DEFAULT(f); ! ! /* is it a window function? */ ! bool proiswindow BKI_DEFAULT(f); ! ! /* security definer */ ! bool prosecdef BKI_DEFAULT(f); ! ! /* is it a leak-proof function? */ ! bool proleakproof BKI_ABBREV(lp) BKI_DEFAULT(f); ! ! /* strict with respect to NULLs? */ ! bool proisstrict BKI_DEFAULT(t); ! ! /* returns a set? */ ! bool proretset BKI_DEFAULT(f); ! ! /* see PROVOLATILE_ categories below */ ! char provolatile BKI_ABBREV(v) BKI_DEFAULT(i); ! ! /* see PROPARALLEL_ categories below */ ! char proparallel BKI_ABBREV(p) BKI_DEFAULT(u); ! ! /* number of arguments */ ! int16 pronargs; ! ! /* number of arguments with defaults */ ! int16 pronargdefaults BKI_DEFAULT(0); ! ! /* OID of result type */ ! Oid prorettype BKI_ABBREV(rt); /* * variable-length fields start here, but we allow direct access to * proargtypes */ ! ! /* parameter types (excludes OUT params) */ ! oidvector proargtypes BKI_ABBREV(at); #ifdef CATALOG_VARLEN ! ! /* all param types (NULL if IN only) */ ! Oid proallargtypes[1] BKI_DEFAULT(_null_); ! ! /* parameter modes (NULL if IN only) */ ! char proargmodes[1] BKI_DEFAULT(_null_); ! ! /* parameter names (NULL if no names) */ ! text proargnames[1] BKI_DEFAULT(_null_); ! ! /* list of expression trees for argument defaults (NULL if none) */ ! pg_node_tree proargdefaults BKI_DEFAULT(_null_); ! ! /* types for which to apply transforms */ ! Oid protrftypes[1] BKI_DEFAULT(_null_); ! ! /* procedure source text */ ! text prosrc BKI_ABBREV(s) BKI_FORCE_NOT_NULL; ! ! /* secondary procedure info (can be NULL) */ ! text probin BKI_DEFAULT(_null_); ! ! /* procedure-local GUC settings */ ! text proconfig[1] BKI_DEFAULT(_null_); ! ! /* access permissions */ ! aclitem proacl[1] BKI_DEFAULT(_null_); #endif } FormData_pg_proc; diff --git a/src/include/catalog/pg_type.h b/src/include/catalog/pg_type.h new file mode 100644 index e355144..1039c1b *** a/src/include/catalog/pg_type.h --- b/src/include/catalog/pg_type.h *************** *** 37,44 **** CATALOG(pg_type,1247) BKI_BOOTSTRAP BKI_ROWTYPE_OID(71) BKI_SCHEMA_MACRO { NameData typname; /* type name */ ! Oid typnamespace; /* OID of namespace containing this type */ ! Oid typowner; /* type owner */ /* * For a fixed-size type, typlen is the number of bytes we use to --- 37,48 ---- CATALOG(pg_type,1247) BKI_BOOTSTRAP BKI_ROWTYPE_OID(71) BKI_SCHEMA_MACRO { NameData typname; /* type name */ ! ! /* OID of namespace containing this type */ ! Oid typnamespace BKI_DEFAULT(PGNSP); ! ! /* type owner */ ! Oid typowner BKI_DEFAULT(PGUID); /* * For a fixed-size type, typlen is the number of bytes we use to *************** CATALOG(pg_type,1247) BKI_BOOTSTRAP BKI_ *** 66,72 **** * * If typtype is 'c', typrelid is the OID of the class' entry in pg_class. */ ! char typtype; /* * typcategory and typispreferred help the parser distinguish preferred --- 70,76 ---- * * If typtype is 'c', typrelid is the OID of the class' entry in pg_class. */ ! char typtype BKI_DEFAULT(b); /* * typcategory and typispreferred help the parser distinguish preferred *************** CATALOG(pg_type,1247) BKI_BOOTSTRAP BKI_ *** 76,92 **** */ char typcategory; /* arbitrary type classification */ ! bool typispreferred; /* is type "preferred" within its category? */ /* * If typisdefined is false, the entry is only a placeholder (forward * reference). We know the type name, but not yet anything else about it. */ ! bool typisdefined; ! char typdelim; /* delimiter for arrays of this type */ ! Oid typrelid; /* 0 if not a composite type */ /* * If typelem is not 0 then it identifies another row in pg_type. The --- 80,99 ---- */ char typcategory; /* arbitrary type classification */ ! /* is type "preferred" within its category? */ ! bool typispreferred BKI_DEFAULT(f); /* * If typisdefined is false, the entry is only a placeholder (forward * reference). We know the type name, but not yet anything else about it. */ ! bool typisdefined BKI_DEFAULT(t); ! /* delimiter for arrays of this type */ ! char typdelim BKI_DEFAULT(\054); ! /* 0 if not a composite type */ ! Oid typrelid BKI_DEFAULT(0); /* * If typelem is not 0 then it identifies another row in pg_type. The *************** CATALOG(pg_type,1247) BKI_BOOTSTRAP BKI_ *** 99,105 **** * * typelem != 0 and typlen == -1. */ ! Oid typelem; /* * If there is a "true" array type having this type as element type, --- 106,112 ---- * * typelem != 0 and typlen == -1. */ ! Oid typelem BKI_DEFAULT(0); /* * If there is a "true" array type having this type as element type, *************** CATALOG(pg_type,1247) BKI_BOOTSTRAP BKI_ *** 118,130 **** /* * I/O functions for optional type modifiers. */ ! regproc typmodin; ! regproc typmodout; /* * Custom ANALYZE procedure for the datatype (0 selects the default). */ ! regproc typanalyze; /* ---------------- * typalign is the alignment required when storing a value of this --- 125,137 ---- /* * I/O functions for optional type modifiers. */ ! regproc typmodin BKI_DEFAULT(-); ! regproc typmodout BKI_DEFAULT(-); /* * Custom ANALYZE procedure for the datatype (0 selects the default). */ ! regproc typanalyze BKI_DEFAULT(-); /* ---------------- * typalign is the alignment required when storing a value of this *************** CATALOG(pg_type,1247) BKI_BOOTSTRAP BKI_ *** 162,168 **** * 'm' MAIN like 'x' but try to keep in main tuple * ---------------- */ ! char typstorage; /* * This flag represents a "NOT NULL" constraint against this datatype. --- 169,175 ---- * 'm' MAIN like 'x' but try to keep in main tuple * ---------------- */ ! char typstorage BKI_DEFAULT(p); /* * This flag represents a "NOT NULL" constraint against this datatype. *************** CATALOG(pg_type,1247) BKI_BOOTSTRAP BKI_ *** 172,203 **** * * Used primarily for domain types. */ ! bool typnotnull; /* * Domains use typbasetype to show the base (or domain) type that the * domain is based on. Zero if the type is not a domain. */ ! Oid typbasetype; /* * Domains use typtypmod to record the typmod to be applied to their base * type (-1 if base type does not use a typmod). -1 if this type is not a * domain. */ ! int32 typtypmod; /* * typndims is the declared number of dimensions for an array domain type * (i.e., typbasetype is an array type). Otherwise zero. */ ! int32 typndims; /* * Collation: 0 if type cannot use collations, DEFAULT_COLLATION_OID for * collatable base types, possibly other OID for domains */ ! Oid typcollation; #ifdef CATALOG_VARLEN /* variable-length fields start here */ --- 179,210 ---- * * Used primarily for domain types. */ ! bool typnotnull BKI_DEFAULT(f); /* * Domains use typbasetype to show the base (or domain) type that the * domain is based on. Zero if the type is not a domain. */ ! Oid typbasetype BKI_DEFAULT(0); /* * Domains use typtypmod to record the typmod to be applied to their base * type (-1 if base type does not use a typmod). -1 if this type is not a * domain. */ ! int32 typtypmod BKI_DEFAULT(-1); /* * typndims is the declared number of dimensions for an array domain type * (i.e., typbasetype is an array type). Otherwise zero. */ ! int32 typndims BKI_DEFAULT(0); /* * Collation: 0 if type cannot use collations, DEFAULT_COLLATION_OID for * collatable base types, possibly other OID for domains */ ! Oid typcollation BKI_DEFAULT(0); #ifdef CATALOG_VARLEN /* variable-length fields start here */ *************** CATALOG(pg_type,1247) BKI_BOOTSTRAP BKI_ *** 206,212 **** * a default expression for the type. Currently this is only used for * domains. */ ! pg_node_tree typdefaultbin; /* * typdefault is NULL if the type has no associated default value. If --- 213,219 ---- * a default expression for the type. Currently this is only used for * domains. */ ! pg_node_tree typdefaultbin BKI_DEFAULT(_null_); /* * typdefault is NULL if the type has no associated default value. If *************** CATALOG(pg_type,1247) BKI_BOOTSTRAP BKI_ *** 216,227 **** * external representation of the type's default value, which may be fed * to the type's input converter to produce a constant. */ ! text typdefault; /* * Access permissions */ ! aclitem typacl[1]; #endif } FormData_pg_type; --- 223,234 ---- * external representation of the type's default value, which may be fed * to the type's input converter to produce a constant. */ ! text typdefault BKI_DEFAULT(_null_); /* * Access permissions */ ! aclitem typacl[1] BKI_DEFAULT(_null_); #endif } FormData_pg_type; diff --git a/src/include/catalog/rewrite_dat.pl b/src/include/catalog/rewrite_dat.pl new file mode 100644 index ...7b5deb4 *** a/src/include/catalog/rewrite_dat.pl --- b/src/include/catalog/rewrite_dat.pl *************** *** 0 **** --- 1,392 ---- + #!/usr/bin/perl -w + #---------------------------------------------------------------------- + # + # rewrite_dat.pl + # Perl script that reads in a catalog data file and writes out + # a functionally equivalent file in a standard format. + # + # -Metadata fields are on their own line + # -Fields are in the same order they would be in the catalog table + # -Default values and computed values for the catalog are left out. + # -Column abbreviations are used where indicated. + # + # Portions Copyright (c) 1996-2017, PostgreSQL Global Development Group + # Portions Copyright (c) 1994, Regents of the University of California + # + # /src/include/catalog/rewrite_dat.pl + # + #---------------------------------------------------------------------- + + use Catalog; + + use strict; + use warnings; + + my @input_files; + my $output_path = ''; + my $expand_tuples = 0; + + # Process command line switches. + while (@ARGV) + { + my $arg = shift @ARGV; + if ($arg !~ /^-/) + { + push @input_files, $arg; + } + elsif ($arg =~ /^-o/) + { + $output_path = length($arg) > 2 ? substr($arg, 2) : shift @ARGV; + } + elsif ($arg eq '--revert') + { + revert(); + } + elsif ($arg eq '--expand') + { + $expand_tuples = 1; + } + else + { + usage(); + } + } + + # Sanity check arguments. + die "No input files.\n" if !@input_files; + foreach my $input_file (@input_files) + { + if ($input_file !~ /\.dat$/) + { + die "Input files need to be data (.dat) files.\n"; + } + } + + # Make sure output_path ends in a slash. + if ($output_path ne '' && substr($output_path, -1) ne '/') + { + $output_path .= '/'; + } + + # We pass data file names as arguments and then look for matching + # headers to parse the schema from. + my @header_files; + foreach my $datfile (@input_files) + { + $datfile =~ /(.+)\.dat$/; + my $header = "$1.h"; + if (-e $header) + { + push @header_files, $header; + } + else + { + die "There in no header file corresponding to $datfile"; + } + } + + # Metadata of a catalog entry + my @metafields = ('oid', 'descr', 'shdescr'); + + # Read all the input files into internal data structures + my $catalogs = Catalog::ParseHeader(@header_files); + my $catalog_data = parse_data_preserve_comments(@input_files); + + # produce output, one catalog at a time + foreach my $catname (@{ $catalogs->{names} }) + { + # @attnames here can also be column abbreviations. + my @attnames; + my $catalog = $catalogs->{$catname}; + my $schema = $catalog->{columns}; + + foreach my $column (@$schema) + { + my $attname; + + # Use abbreviations where available, unless we're writing + # full tuples. + if (exists $column->{abbrev} and !$expand_tuples) + { + $attname = $column->{abbrev}; + } + else + { + $attname = $column->{name}; + } + push @attnames, $attname; + } + + if (defined $catalog_data->{$catname}) + { + + # Back up old data file rather than overwrite it. + # We don't assume the input path and output path are the same, + # but they can be. + my $newdatfile = "$output_path$catname.dat"; + if (-e $newdatfile) + { + rename($newdatfile, $newdatfile . '.bak') + or die "rename: $newdatfile: $!"; + } + open my $dat, '>', $newdatfile + or die "can't open $newdatfile: $!"; + + foreach my $data (@{ $catalog_data->{$catname} }) + { + # Either a newline or comment - just write it out. + if (! ref $data) + { + print $dat "$data\n"; + } + # Hash ref representing a data entry. + elsif (ref $data eq 'HASH') + { + my %values = %$data; + print $dat "{ "; + + # Write out full tuples fully expanded. This is useful + # for debugging, and as a prerequisite for changing + # default values or column abbreviations. + if ($expand_tuples) + { + # We must do the following operations in the order given. + Catalog::ResolveColumnAbbrevs(\%values, $schema); + if ($catname eq 'pg_proc') + { + Catalog::ComputePgProcFields(\%values); + } + Catalog::AddDefaultValues(\%values, $schema, $catname); + } + else + # Write out tuples in a compact representation. + { + # We must do the following operations in the order given. + strip_default_values(\%values, $schema, $catname); + if ($catname eq 'pg_proc') + { + delete $values{pronargs} + if exists $values{pronargs}; + # Assumes pg_proc.dat is in expanded form. + delete $values{prosrc} + if $values{prosrc} eq $values{proname}; + } + add_column_abbrevs(\%values, $schema); + } + + # Separate out metadata fields for readability. + my $metadata_line = format_line(\%values, @metafields); + if ($metadata_line) + { + print $dat $metadata_line; + print $dat ",\n"; + } + my $data_line = format_line(\%values, @attnames); + + # Line up with metadata line, if there is one. + if ($metadata_line) + { + print $dat ' '; + } + print $dat $data_line; + print $dat " },\n"; + } + else + { + die "Unexpected data type"; + } + } + } + } + + # When the build scripts consume the data, they just slurp the whole + # file and ignore non-data. That won't work if we want to transform + # the data into a standard format, because we want to preserve comments + # and blank lines. We have to separate data from comments, and + # parse data entries retail. + sub parse_data_preserve_comments + { + my %catalog_data; + foreach my $input_file (@_) + { + open(my $ifh, '<', $input_file) || die "$input_file: $!"; + my ($filename) = ($input_file =~ m/(\w+)\.dat$/); + my $data = []; + my $prev_blank = 0; + + # Scan the input file. + while (<$ifh>) + { + if (/^$/) + { + # Preserve non-consecutive blank lines. + # Newline gets added by caller. + if (!$prev_blank) + { + push @$data, ''; + $prev_blank = 1; + } + } + else + { + $prev_blank = 0; + if (/{/) + { + # Capture the hash ref + # NB: Assumes that the next hash ref can't start on the + # same line where the present one ended. + # Not foolproof, but we shouldn't need a full lexer, + # since we expect relatively well-behaved input. + + # Quick hack to detect when we have a full hash ref to + # parse. We can't just use a regex because of values in + # pg_aggregate and pg_proc like '{0,0}'. + my $lcnt = tr/{//; + my $rcnt = tr/}//; + + if ($lcnt == $rcnt) + { + my $entry; + eval '$entry = ' . $_; + if (!ref $entry) + { + die "Error parsing $_\n"; + } + push @$data, $entry; + } + else + { + my $next_line = <$ifh>; + die "$input_file: ends within perl hash\n" + if !defined $next_line; + $_ .= $next_line; + redo; + } + } + # Capture comments that are on their own line. + elsif (/^\s*#\s*(.+)\s*/) + { + my $comment = $1; + push @$data, "# $comment"; + } + # Assume bracket is the only token in the line. + elsif (/^\s*(\[|\])\s*$/) + { + push @$data, $1; + } + } + } + $catalog_data{$filename} = $data; + } + return \%catalog_data; + } + + sub strip_default_values + { + my $row = shift; + my $schema = shift; + my $catname = shift; + + foreach my $column (@$schema) + { + my $attname = $column->{name}; + + # Delete values that match defaults. + if (defined $row->{$attname}) + { + if (defined $column->{default} + and ($row->{$attname} eq $column->{default})) + { + delete $row->{$attname}; + } + } + else + { + if (!exists $column->{default} + and !exists $column->{abbrev} + and $attname ne 'pronargs' + and $attname ne 'prosrc') + { + die "Missing value in $catname.$attname\n"; + } + } + } + } + + sub add_column_abbrevs + { + my $row = shift; + my $schema = shift; + + foreach my $column (@$schema) + { + my $abbrev = $column->{abbrev}; + my $attname = $column->{name}; + if (defined $abbrev and exists $row->{$attname}) + { + $row->{$abbrev} = $row->{$attname}; + } + } + } + + sub format_line + { + my $data = shift; + my @atts = @_; + + my $first = 1; + my $value; + my $line = ''; + + foreach my $field (@atts) + { + next if !defined $data->{$field}; + $value = $data->{$field}; + + # Re-escape single quotes. + $value =~ s/'/\\'/g; + + if (!$first) + { + $line .= ', '; + } + $first = 0; + + $line .= "$field => '$value'"; + } + return $line; + } + + # Rename .bak files back to .dat + # This requires passing the .dat files as arguments to the script as normal. + sub revert + { + foreach my $datfile (@input_files) + { + my $bakfile = "$datfile.bak"; + if (-e $bakfile) + { + rename($bakfile, $datfile) or die "rename: $bakfile: $!"; + } + } + exit 0; + } + + sub usage + { + die <