src/backend/catalog/process_foreign_keys.pl

#! /usr/bin/perl -w
#-------------------------------------------------------------------------
#
# process_foreign_keys.pl
#
# Usage: cat <input headers> | perl process_foreign_keys.pl
#
# Reads catalog header files, and spits out a json file containing
# information about any foreign keys, as declared in FOREIGN_KEY lines
# in the headers.
#
#
# Portions Copyright (c) 2016-Present VMware, Inc. or its affiliates.
# Portions Copyright (c) 1996-2009, PostgreSQL Global Development Group
# Portions Copyright (c) 1994, Regents of the University of California
#
#
# IDENTIFICATION
#    src/backend/catalog/process_foreign_keys.pl
#
#-------------------------------------------------------------------------

use Text::ParseWords;

use strict;
use warnings;

my $catversion = 'unknown';

my $catalogname;

my %catalogs = ();

# Read all the header files from stdin (the caller is expected to cat
# and pipe them to us). For each FOREIGN_KEY declaration, add an entry
# in $catalogs hash table.
while (<>)
{
    if (m/^#define CATALOG_VERSION_NO\s+(\d+)/) {
	$catversion = $1;
    }

    if (m/^CATALOG\(([[:word:]]+)/) {
	# This is the beginning of a new catalog. Reset our variables.

	$catalogname = $1;
    }
    # E.g.
    # FOREIGN_KEY(oprnamespace REFERENCES pg_namespace(oid))
    if (m/^FOREIGN_KEY\(([[:word:]]+)\s+REFERENCES\s+([[:word:]]+)\s*\(([[:word:]]+)\)/) {
	# This is the beginning of a new catalog. Reset our variables.
	my %t = (fieldname => $1,
		 pktable => $2,
		 pkcol => $3 );

	push(@{$catalogs{$catalogname}}, \%t);
    }

}

# Spit out the Json file.

# common header
print "{\n";
print "   \"__comment\" : \"Generated by process_foreign_keys.pl\",\n";
print "   \"__info\" : { \"CATALOG_VERSION_NO\" : \"$catversion\" }";

# for each catalog table
for(sort keys %catalogs) {
    my $catalogname = $_;

    print ",\n";
    print "   \"$catalogname\" : {\n";
    print "      \"foreign_keys\" : [\n";

    # for each foreign key declaration in the catalog table
    my $firstfk = 1;
    for my $t (@{$catalogs{$catalogname}}) {
	my $fieldname = $t->{fieldname};
	my $pktable = $t->{pktable};
	my $pkcol = $t->{pkcol};

	if (!$firstfk)
	{
	    print ",\n";
	}

	$firstfk = 0;
	print "         [ [\"$fieldname\"], \"$pktable\", [\"$pkcol\"] ]";
    }
    print "\n";

    print "      ]\n";
    print "   }";
}

print "\n";
print "}\n";