#!/usr/bin/perl -w
#----------------------------------------------------------------------
#
# rewrite_dat_oid2name.pl
#    Perl script that replaces some numeric OIDs with human readable
#    macros.
#
# Portions Copyright (c) 1996-2018, PostgreSQL Global Development Group
# Portions Copyright (c) 1994, Regents of the University of California
#
# /src/include/catalog/rewrite_dat_oid2name.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;
	}
	else
	{
		usage();
	}
}

# Sanity check arguments.
die "No input files.\n"
  if !@input_files;

# Make sure output_path ends in a slash.
if ($output_path ne '' && substr($output_path, -1) ne '/')
{
	$output_path .= '/';
}

# Metadata of a catalog entry
my @METADATA = ('oid', 'oid_symbol', 'descr', 'shdescr');

# Read all the input files into internal data structures.
# We pass data file names as arguments and then look for matching
# headers to parse the schema from.
my %catalogs;
my %catalog_data;
my @catnames;
foreach my $datfile (@input_files)
{
	$datfile =~ /(.+)\.dat$/
	  or die "Input files need to be data (.dat) files.\n";

	my $header = "$1.h";
	die "There in no header file corresponding to $datfile"
	  if ! -e $header;

	my $catalog = Catalog::ParseHeader($header);
	my $catname = $catalog->{catname};
	my $schema  = $catalog->{columns};

	push @catnames, $catname;
	$catalogs{$catname} = $catalog;

	$catalog_data{$catname} = Catalog::ParseData($datfile, $schema, 1);
}

# Build lookup tables.
# Note: the "next if !ref $row" checks below are a hack to filter out
# non-hash objects. This is because we build the lookup tables from data
# that we read using the "preserve_formatting" switch.

# Index access method lookup.
my %amnames;
foreach my $row (@{ $catalog_data{pg_am} })
{
	next if !ref $row;
	$amnames{$row->{oid}} = $row->{amname};
}

# Type oid lookup.
my %typenames;
$typenames{'0'} = '0';  # Easier than adding a check at every type lookup
foreach my $row (@{ $catalog_data{pg_type} })
{
	next if !ref $row;
	$typenames{$row->{oid}} = $row->{typname};
}

# Opfamily oid lookup.
my %opfnames;
foreach my $row (@{ $catalog_data{pg_opfamily} })
{
	next if !ref $row;
	$opfnames{$row->{oid}} = $amnames{$row->{opfmethod}} . '/' . $row->{opfname};
}

# Opclass oid lookup.
my %opcnames;
foreach my $row (@{ $catalog_data{pg_opclass} })
{
	next if !ref $row;
	$opcnames{$row->{oid}} = $amnames{$row->{opcmethod}} . '/' . $row->{opcname}
	  if exists $row->{oid};
}

# Operator oid lookup.
my %opernames;
foreach my $row (@{ $catalog_data{pg_operator} })
{
	next if !ref $row;
	$opernames{$row->{oid}} = sprintf "%s(%s,%s)",
	  $row->{oprname}, $typenames{$row->{oprleft}}, $typenames{$row->{oprright}};
}

# Proc oid lookup.
my %procoids;
foreach my $row (@{ $catalog_data{pg_proc} })
{
	next if !ref $row;
	if (defined($procoids{ $row->{proname} }))
	{
		$procoids{ $row->{proname} } = 'MULTIPLE';
	}
	else
	{
		$procoids{ $row->{oid} } = $row->{proname};
	}
}

# Write the data.
foreach my $catname (@catnames)
{
	my $catalog = $catalogs{$catname};
	my @attnames;
	my $schema = $catalog->{columns};

	foreach my $column (@$schema)
	{
		my $attname = $column->{name};
		push @attnames, $attname;
	}

	# Overwrite .dat files in place.
	my $datfile = "$output_path$catname.dat";
	open my $dat, '>', $datfile
	  or die "can't open $datfile: $!";

	# Write the data.
	foreach my $data (@{ $catalog_data{$catname} })
	{
		# Either a newline, comment, or bracket - 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 "{ ";

			# We strip default values first because it makes the checks
			# below a little less verbose.
			strip_default_values(\%values, $schema, $catname);

			# Replace OIDs with names
			if ($catname eq 'pg_proc')
			{

				# Oid -> Name
				$values{prorettype} = $typenames{$values{prorettype}};
				if ($values{proargtypes})
				{
					my @argtypeoids = split /\s+/, $values{proargtypes};
					my @argtypenames;
					foreach my $argtypeoid (@argtypeoids)
					{
						push @argtypenames, $typenames{$argtypeoid};
					}
					$values{proargtypes} = join(' ', @argtypenames);
				}
				if ($values{proallargtypes})
				{
					$values{proallargtypes} =~ s/[{}]//g;
					my @argtypeoids = split /,/, $values{proallargtypes};
					my @argtypenames;
					foreach my $argtypeoid (@argtypeoids)
					{
						push @argtypenames, $typenames{$argtypeoid};
					}
					$values{proallargtypes} = '{' . join(',', @argtypenames) . '}';
				}
			}
			if ($catname eq 'pg_aggregate')
			{
				$values{aggsortop}     = $opernames{$values{aggsortop}}
				  if exists $values{aggsortop};
				$values{aggtranstype}  = $typenames{$values{aggtranstype}};
				$values{aggmtranstype} = $typenames{$values{aggmtranstype}}
				  if exists $values{aggmtranstype};
			}
			if ($catname eq 'pg_amop')
			{
				$values{amoplefttype}   = $typenames{$values{amoplefttype}};
				$values{amoprighttype}  = $typenames{$values{amoprighttype}};
				$values{amopmethod}     = $amnames{$values{amopmethod}};
				$values{amopfamily}     = $opfnames{$values{amopfamily}};
				$values{amopopr}        = $opernames{$values{amopopr}};
				$values{amopsortfamily} = $opfnames{$values{amopsortfamily}}
				  if exists $values{amopsortfamily};
			}
			if ($catname eq 'pg_amproc')
			{
				$values{amprocfamily}    = $opfnames{$values{amprocfamily}};
				$values{amproclefttype}  = $typenames{$values{amproclefttype}};
				$values{amprocrighttype} = $typenames{$values{amprocrighttype}};
			}
			if ($catname eq 'pg_opfamily')
			{
				$values{opfmethod}  = $amnames{$values{opfmethod}};
			}
			if ($catname eq 'pg_opclass')
			{
				$values{opcmethod}  = $amnames{$values{opcmethod}};
				$values{opcfamily}  = $opfnames{$values{opcfamily}};
				$values{opcintype}  = $typenames{$values{opcintype}};
				$values{opckeytype} = $typenames{$values{opckeytype}}
				  if exists $values{opckeytype};
			}
			if ($catname eq 'pg_operator')
			{
				$values{oprleft}   = $typenames{$values{oprleft}};
				$values{oprright}  = $typenames{$values{oprright}};
				$values{oprresult} = $typenames{$values{oprresult}};
				$values{oprcom}    = $opernames{$values{oprcom}}
				  if exists $values{oprcom};
				$values{oprnegate} = $opernames{$values{oprnegate}}
				  if exists $values{oprnegate};
			}
			if ($catname eq 'pg_range')
			{
				$values{rngtypid}   = $typenames{$values{rngtypid}};
				$values{rngsubtype} = $typenames{$values{rngsubtype}};
				$values{rngsubopc}  = $opcnames{$values{rngsubopc}};
			}
			if ($catname eq 'pg_cast')
			{
				$values{castsource} = $typenames{$values{castsource}};
				$values{casttarget} = $typenames{$values{casttarget}};
			}

			# Separate out metadata fields for readability.
			my $metadata_line = format_line(\%values, @METADATA);
			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";
		}
	}
}

# Leave values out if there is a matching default.
sub strip_default_values
{
	my ($row, $schema, $catname) = @_;

	foreach my $column (@$schema)
	{
		my $attname = $column->{name};
		die "strip_default_values: $catname.$attname undefined\n"
		  if ! defined $row->{$attname};

		# Delete values that match defaults.
		if (defined $column->{default}
			and ($row->{$attname} eq $column->{default}))
		{
			delete $row->{$attname};
		}
	}
}

# Format the individual elements of a Perl hash into a valid string
# representation. We do this ourselves, rather than use native Perl
# facilities, so we can keep control over the exact formatting of the
# data files.
sub format_line
{
	my $data = shift;
	my @attnames = @_;

	my $first = 1;
	my $value;
	my $line = '';

	foreach my $attname (@attnames)
	{
		next if !defined $data->{$attname};
		$value = $data->{$attname};

		# Re-escape single quotes.
		$value =~ s/'/\\'/g;

		if (!$first)
		{
			$line .= ', ';
		}
		$first = 0;

		$line .= "$attname => '$value'";
	}
	return $line;
}

sub usage
{
	die <<EOM;
Usage: rewrite_dat_oid2name.pl [options] datafile...

Options:
    -o               output path

Expects a list of .dat files as arguments.

Make sure location of Catalog.pm is passed to the perl interpreter:
perl -I /path/to/Catalog.pm/ ...

EOM
}