#!/usr/bin/perl
#
# Licensed to the Apache Software Foundation (ASF) under one
# or more contributor license agreements.  See the NOTICE file
# distributed with this work for additional information
# regarding copyright ownership.  The ASF licenses this file
# to you under the Apache License, Version 2.0 (the
# "License"); you may not use this file except in compliance
# with the License.  You may obtain a copy of the License at
#
#   http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing,
# software distributed under the License is distributed on an
# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
# KIND, either express or implied.  See the License for the
# specific language governing permissions and limitations
# under the License.
#
# SLZY_HDR_END
use POSIX;
use Pod::Usage;
use Getopt::Long;
use Data::Dumper;
use strict;
use warnings;

# SLZY_POD_HDR_BEGIN
# WARNING: DO NOT MODIFY THE FOLLOWING POD DOCUMENT:
# Generated by sleazy.pl version 4 (release Fri Jul  8 15:26:54 2011)
# Make any changes under SLZY_TOP_BEGIN/SLZY_LONG_BEGIN

=head1 NAME

B<catullus.pl> - generate pg_proc and pg_type entries

=head1 VERSION

 This document describes version 8 of catullus.pl, released
 Mon Oct  3 12:58:12 2011.

=head1 SYNOPSIS

B<catullus.pl> 

Options:

    -help       brief help message
    -man        full documentation
    -procdef    sql definitions for pg_proc functions
    -prochdr    header file to modify (procedures)
    -typedef    sql definitions for pg_type functions
    -typehdr    header file to modify (types)

=head1 OPTIONS

=over 8

=item B<-help>

    Print a brief help message and exits.

=item B<-man>

    Prints the manual page and exits.

=item B<-procdef> <filename> (Required)

    sql definitions for pg_proc functions (normally pg_proc.sql)

=item B<-prochdr> <filename> (Required)

    header file to modify (normally pg_proc.h).  The original file is copied to a .backup copy.

=item B<-typedef> <filename> (Required)

    sql definitions for pg_type functions (normally pg_type.sql)

=item B<-typehdr> <filename> (Required)

    header file to modify (normally pg_type.h).  The original file is copied to a .backup copy.


=back

=head1 DESCRIPTION

catullus.pl converts annotated sql CREATE FUNCTION and CREATE TYPE
statements into pg_proc and pg_type entries and updates pg_proc.h and
pg_type.h.

The pg_type definitions are stored in pg_type.sql.  catullus reads
these definitions and outputs DATA statements for loading the pg_type
table.  In pg_type.h, it looks for a block of code delimited by the
tokens TIDYCAT_BEGIN_PG_TYPE_GEN and TIDYCAT_END_PG_TYPE_GEN and
substitutes the new generated code for the previous contents.

The pg_proc definitions are stored in pg_proc.sql.  catullus reads
these definitions and, using type information from pg_type.sql,
generates DATA statements for loading the pg_proc table.  In
pg_proc.h, it looks for a block of code delimited by the tokens
TIDYCAT_BEGIN_PG_PROC_GEN and TIDYCAT_END_PG_PROC_GEN and substitutes
the new generated code for the previous contents.

=head1 CAVEATS/FUTURE WORK

The aggregate transition functions are constructed from CREATE
FUNCTION statements.  But we should really use CREATE AGGREGATE
statements to generate the DATA statements for pg_aggregate and the
pg_proc entries.  A similar limitation exists for window functions in
pg_window.  And operators and operator classes?  Access methods? Casts?


=head1 AUTHORS

Apache HAWQ

Address bug reports and comments to: dev@hawq.apache.org

=cut
# SLZY_POD_HDR_END

my $glob_id = "";
my %glob_typeoidh; # hash type names to oid

# SLZY_GLOB_BEGIN
my $glob_glob;
# SLZY_GLOB_END

sub glob_validate
{
	# XXX XXX: special case these for now...

	$glob_typeoidh{"gp_persistent_relation_node"}	= 6990;
	$glob_typeoidh{"gp_persistent_database_node"}	= 6991;
	$glob_typeoidh{"gp_persistent_tablespace_node"} = 6992;
	$glob_typeoidh{"gp_persistent_filespace_node"}	= 6993;

	return 1;
}

# SLZY_CMDLINE_BEGIN
# WARNING: DO NOT MODIFY THE FOLLOWING SECTION:
# Generated by sleazy.pl version 4 (release Fri Jul  8 15:26:54 2011)
# Make any changes under SLZY_TOP_BEGIN/SLZY_LONG_BEGIN
# Any additional validation logic belongs in glob_validate()

BEGIN {
	    my $s_help      = 0;     # brief help message
	    my $s_man       = 0;     # full documentation
	    my $s_procdef;           # sql definitions for pg_proc functions
	    my $s_prochdr;           # header file to modify (procedures)
	    my $s_typedef;           # sql definitions for pg_type functions
	    my $s_typehdr;           # header file to modify (types)

    GetOptions(
		'help|?'                                                 =>     \$s_help,
		'man'                                                    =>     \$s_man,
		'procdef|prosource|procsource|prosrc|procsrc=s'          =>     \$s_procdef,
		'prochdr|proheader|procheader|prohdr=s'                  =>     \$s_prochdr,
		'typedef|typdef|typesource|typsource|typesrc|typsrc=s'   =>     \$s_typedef,
		'typehdr|typheader|typeheader|typhdr=s'                  =>     \$s_typehdr,
               )
        or pod2usage(2);

	pod2usage(-msg => $glob_id, -exitstatus => 1) if $s_help;
	pod2usage(-msg => $glob_id, -exitstatus => 0, -verbose => 2) if $s_man;
	
	
	$glob_glob = {};
	
	
	# version and properties from json definition
	$glob_glob->{_sleazy_properties} = {};
	$glob_glob->{_sleazy_properties}->{version} = '8';
	$glob_glob->{_sleazy_properties}->{slzy_date} = '1317671892';
	
	    die ("missing required argument for 'procdef'")
	    unless (defined($s_procdef));
	    die ("invalid argument for 'procdef': file $s_procdef does not exist")
	    unless (defined($s_procdef) && (-e $s_procdef));
	    die ("missing required argument for 'prochdr'")
	    unless (defined($s_prochdr));
	    die ("invalid argument for 'prochdr': file $s_prochdr does not exist")
	    unless (defined($s_prochdr) && (-e $s_prochdr));
	    die ("missing required argument for 'typedef'")
	    unless (defined($s_typedef));
	    die ("invalid argument for 'typedef': file $s_typedef does not exist")
	    unless (defined($s_typedef) && (-e $s_typedef));
	    die ("missing required argument for 'typehdr'")
	    unless (defined($s_typehdr));
	    die ("invalid argument for 'typehdr': file $s_typehdr does not exist")
	    unless (defined($s_typehdr) && (-e $s_typehdr));
	
	$glob_glob->{procdef}    =  $s_procdef  if (defined($s_procdef));
	$glob_glob->{prochdr}    =  $s_prochdr  if (defined($s_prochdr));
	$glob_glob->{typedef}    =  $s_typedef  if (defined($s_typedef));
	$glob_glob->{typehdr}    =  $s_typehdr  if (defined($s_typehdr));
	
	glob_validate();


}
# SLZY_CMDLINE_END

# DO NOT extend this list!  All new types must have a default array type.
my %array_type_exception_h = 
	(
	 pg_type => 1,
	 pg_attribute => 1,
	 pg_proc => 1,
	 pg_class => 1,
	 smgr => 1,
	 unknown => 1
	);

sub doformat
{
	my ($bigstr, $kv) = @_;

	my %blankprefix;

	# find format expressions with leading blanks
	if ($bigstr =~ m/\n/)
	{
		my @foo = split(/\n/, $bigstr);

		for my $lin (@foo)
		{
			next unless ($lin =~ m/^\s+\{.*\}/);

			# find the first format expression after the blank prefix
			my @baz = split(/\}/, $lin, 2);

			my $firstf = shift @baz;

			my @zzz = ($firstf =~ m/^(\s+)\{(.*)$/);

			next unless (defined($zzz[1]) &&
						 length($zzz[1]));

			my $k2 = quotemeta($zzz[1]);

			die "duplicate use of prefixed pattern $k2"
				if (exists($blankprefix{$k2}));

			# store the prefix
			$blankprefix{$k2} = $zzz[0];
		}

	}

#	print Data::Dumper->Dump([%blankprefix]);

	while (my ($kk, $vv) = each(%{$kv}))
	{
		my $subi = '{' . quotemeta($kk) . '}';
		my $v2 = $vv;

		if (exists($blankprefix{quotemeta($kk)}) && 
			($v2 =~ m/\n/))
		{
			my @foo = split(/\n/, $v2);

			# for a multiline substitution, prefix every line with the
			# offset of the original token
			$v2 = join("\n" . $blankprefix{quotemeta($kk)}, @foo);

			# fixup trailing newline if necessary
			if ($vv =~ m/\n$/)
			{
				$v2 .= "\n"
					unless ($v2 =~ m/\n$/);
			}

		}

		$bigstr =~ s/$subi/$v2/gm;
	}

	return $bigstr;
}

# get oid for type from local cache
sub get_typeoid
{
	my $tname = shift;

	# check the type/oid cache 
	return $glob_typeoidh{$tname} if (exists($glob_typeoidh{$tname}));

	die "cannot find type: $tname";

	return undef;
} # get_typeoid


sub get_fntype
{
	my $funcdef = shift;

	my @foo = split(/\s+/, $funcdef);

	my $tdef = "";
	
	# get [SETOF] typname 
	for my $ff (@foo)
	{
		if ($ff =~ m/^(setof)$/i)
		{
			$tdef .= $ff . " ";
			next;
		}
		if ($ff =~ m/^(\[.*\])$/i)
		{
			$tdef .= $ff;
			next;
		}
		$tdef .= $ff;
		last;
	}

	# get array bounds or ARRAY array bounds
	for my $ff (@foo)
	{
		if ($ff =~ m/^(ARRAY)$/i)
		{
			$tdef .= " " . $ff . " ";
			next;
		}
		if ($ff =~ m/^(\[.*\])$/i)
		{
			$tdef .= $ff;
			last;
		}
		last;
	}

	return $tdef;
} # end get_fntype

sub get_fnoptlist
{
	my $funcdef = shift;
	my @optlist;

	my $rex = 'called\s+on\s+null\s+input|'.
		'returns\s+null\s+on\s+null\s+input|strict|immutable|stable|volatile|'.
		'external\s+security\s+definer|external\s+security\s+invoker|' .
		'security\s+definer|security\s+invoker|' .
		'no\s+sql|contains\s+sql|reads\s+sql\s+data|modifies\s+sql\s+data|' .
		'language\s+\S+|' .
		'as\s+\\\'\S+\\\'(?:\s*,\s*\\\'\S+\\\')*';

#	print "$rex\n";

#	my @foo = ($funcdef =~ m/((?:\s*$rex\s*))*/i);

	my @foo = ($funcdef =~ m/($rex)/i);

	while (scalar(@foo))
	{
		my $opt = $foo[0];
		push @optlist, $opt;
		my $o2 = quotemeta($opt);
		$funcdef =~ s/$o2//;
		@foo = ($funcdef =~ m/($rex)/i);
	}

	return \@optlist;

} # end get_fnoptlist

sub make_opt
{
	my $fndef = shift;

	# values from pg_language
	my $plh = {
		internal => 12, 
		c		 => 13,
		sql		 => 14,
		plpgsql	 => 10886
	};

	my $proname		= $fndef->{name};
	my $prolang;
	my $provolatile;
	my $proisstrict = 0;
	my $prosecdef	= 0;
	my $prodataaccess;
	my $prosrc;
	my $func_as;

	my $tdef;

	# remove double quotes
	$proname =~ s/^\"//;
	$proname =~ s/\"$//;

	if (exists($fndef->{optlist}))
	{
		for my $opt (@{$fndef->{optlist}})
		{
			if ($opt =~ m/^(immutable|stable|volatile)/i)
			{
				die ("conflicting or redundant options: $opt") 
					if (defined($provolatile));
				
				# provolatile is first char of option ([i]mmmutble, [s]table,
				# [v]olatile).
				$provolatile = lc(substr($opt, 0, 1));
			}


			if ($opt =~ m/^language\s+(internal|c|sql|plpgsql)$/i)
			{
				die ("conflicting or redundant options: $opt") 
					if (defined($prolang));
				
				my $l1 = lc($opt);
				$l1 =~ s/^language\s+//;

				$prolang = $plh->{$l1};
			}

			if ($opt =~ m/^(no\s+sql|contains\s+sql|reads\s+sql\s+data|modifies\s+sql\s+data)/i)
			{
				die ("conflicting or redundant options: $opt")
					if (defined($prodataaccess));

				# prodataaccess is first char of option ([n]o sql, [c]ontains sql,
				# [r]eads sql data, [m]odifies sql data).
				$prodataaccess = lc(substr($opt, 0, 1));
			}

			if ($opt =~ m/^AS\s+\'.*\'$/)
			{
				die ("conflicting or redundant options: $opt") 
					if (defined($func_as));

				# NOTE: we preprocessed dollar-quoted ($$) AS options
				# to single-quoted strings.  Will fix the string value
				# later.
				my @foo = ($opt =~ m/^AS\s+\'(.*)\'$/);
				die "bad func AS: $opt" unless (scalar(@foo));

				$func_as = shift @foo;
			}

			$proisstrict = 1
				if ($opt =~ m/^(strict|returns\s+null\s+on\s+null\s+input)$/i);
			$proisstrict = 0
				if ($opt =~ m/^(called\s+on\s+null\s+input)$/i);

			$prosecdef = 1
				if ($opt =~ m/security definer/i);
			$prosecdef = 0
				if ($opt =~ m/security invoker/i);
		} # end for

		$tdef = {

			proname		 => $proname,
#			pronamespace => 11, # pg_catalog
#			proowner	 => 10, # admin
			pronamespace => "PGNSP", # pg_catalog
			proowner	 => "PGUID", # admin
			prolang		 => $prolang,
			proisagg	 => 0,
			prosecdef	 => $prosecdef,
			proisstrict	 => $proisstrict,
#			proretset
			provolatile	 => $provolatile,
#			pronargs
#			prorettype
			proiswin	 => 0,
#			proargtypes
#			proallargtypes
#			proargmodes
#			proargnames
			prodataaccess	=> $prodataaccess
		};

		if (defined($func_as) && defined($prolang))
		{
			if (12 == $prolang) # internal
			{
				$tdef->{prosrc} = $func_as;
			}
			elsif (13 == $prolang) # C
			{
				die ("bad C function def $func_as") unless ($func_as =~ m/\,/);

				$func_as =~ s/\'//g;
				
				my @foo = split(/\s*\,\s*/, $func_as);

				$tdef->{prosrc} = $foo[1];
				$tdef->{probin} = $foo[0];

			}
			elsif (14 == $prolang) # sql
			{
				$func_as =~ s/^\s*\'//;
				$func_as =~ s/\'\s*$//;

				# NOTE: here is the fixup for the AS option --
				# retrieve the quoted string.
				#  [ unquurl ]
				$func_as =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
				$tdef->{prosrc} = $func_as;
			}
			else
			{
				die ("bad lang: $prolang");
			}
		} 

		if (!defined($prodataaccess))
		{ 
			if (14 == $prolang) # SQL
			{
				$prodataaccess = 'c';
			}
			else
			{
				$prodataaccess = 'n';
			}

			$tdef->{prodataaccess} = $prodataaccess;
		}

		# check for conflicting prodataaccess options
		if (14 == $prolang && ('n' eq $prodataaccess))
		{
			die ("conflicting options: A SQL function cannot specify NO SQL");
		}

		if (defined($provolatile) && ('i' eq $provolatile))
		{
			if ('r' eq $prodataaccess)
			{
				die ("conflicting options: IMMUTABLE conflicts with READS SQL DATA");
			}
			if ('m' eq $prodataaccess)
			{
				die ("conflicting options: IMMUTABLE conflicts with MODIFIES SQL DATA");
			}
		}

	} # end if exists

	
	$fndef->{tuple} = $tdef if (defined($tdef));


} # end make_opt

sub make_rettype
{
	my $fndef = shift;

	if (exists($fndef->{returntype}))
	{
		my $rt = $fndef->{returntype};

		# check if SETOF returntype
		$fndef->{tuple}->{proretset} = ($rt =~ m/^setof/i);

		# remove SETOF
		$rt =~ s/^setof\s*//i;

		# remove "pg_catalog." prefix
		$rt =~ s/^pg\_catalog\.//i;

		# quotes
		$rt =~ s/\"//g;

		my $rtoid = get_typeoid($rt);

		$fndef->{tuple}->{prorettype} = $rtoid 
			if (defined($rtoid));
	}
	
} # end make_rettype

sub make_allargs
{
	my $fndef = shift;
	my $fnname = $fndef->{name};

	return undef
		unless (exists($fndef->{rawargs}) && 
				length($fndef->{rawargs}));
	
	my $argstr = $fndef->{rawargs};
	
	return undef
		unless (length($argstr) && ($argstr !~ m/^\s*$/));
	
	my @foo;
	
	# A function takes multiple "func_args" (parameters),
	# separated by commas.  Each func_arg must have a type,
	# and it optionally has a name (for languages that
	# support named parameters) and/or an "arg_class" (which
	# is IN, OUT, INOUT or "IN OUT").  The func_arg tokens are
	# separated by spaces, and the ordering and combinations
	# are a bit too flexible for comfort.  So we only support
	# declarations in the order arg_class, param_name, func_type.
	
	if ($argstr =~ m/\,/)
	{
		@foo = split(/\s*\,\s*/, $argstr);
	}
	else
	{
		push @foo, $argstr;
	}

	# oids, type, class, name
	my @argoids;
	my @argtype;
	my @argclass;
	my @argname;
	
	my $nargs = 0;
	for my $func_arg (@foo)
	{
		# no spaces, so arg_type only
		if ($func_arg !~ /\S+\s+\S+/)
		{
			my $arg1 = $func_arg;
			$arg1 =~ s/\"//g;
			$arg1 =~ s/^\s+//;
			$arg1 =~ s/\s+$//g;
			push @argtype, $arg1;
		}
		else # split func_arg
		{
			if ($func_arg =~ m/^in\s+out\s+/i)
			{
				# NOTE: we want to split by spaces, 
				# so convert "in out" to "inout"
				$func_arg =~ s/^in\s+out\s+/inout /i;
			}

			my @baz = split(/\s+/, $func_arg);
			
			if (3 == scalar(@baz))
			{	
				die "$fnname: arg str badly formed: $argstr"
					unless ($baz[0] =~ m/^(in|out|inout|in\s+out)$/i);
				
				my $aclass = shift @baz;
				
				if ($aclass =~ m/^(in|out)$/i)
				{
					# use first char as argclass
					$argclass[$nargs] = lc(substr($aclass, 0, 1));
				}
				else
				{
					$argclass[$nargs] = "b"; # [b]oth
				}
				
				# drop thru to handle two remaining args
				# (and don't allow multiple IN/OUT for same func_arg)
				die "$fnname: arg str badly formed: $argstr"
					if ($baz[0] =~ m/^(in|out|inout|in\s+out)$/i);
			}
			
			die "$fnname: arg str badly formed: $argstr"
				unless (2 == scalar(@baz));
			
			# last token is always a type
			my $arg1 = pop(@baz);
			$arg1 =~ s/\"//g;
			$arg1 =~ s/^\s+//;
			$arg1 =~ s/\s+$//g;
			push @argtype, $arg1;
			
			# remaining token is an arg_class or name
			if ($baz[0] =~ m/^(in|out|inout|in\s+out)$/i)
			{
				my $aclass = shift @baz;
				
				if ($aclass =~ m/^(in|out)$/i)
				{
					$argclass[$nargs] = lc(substr($aclass, 0, 1));
				}
				else # both
				{
					$argclass[$nargs] = "b";
				}
			}
			else # not a class, so it's a name
			{
				my $arg2 = pop(@baz);
				$arg2 =~ s/\"//g;
				$arg2 =~ s/^\s+//;
				$arg2 =~ s/\s+$//g;
				$argname[$nargs] = $arg2;
			}
			
		} # end split func_arg

		$nargs++;
	} # end for my func_arg
	
	for my $ftyp (@argtype)
	{
		push @argoids, get_typeoid($ftyp);				
	}
	
	# check list of names
	if (scalar(@argname))
	{
		# fill in blank names if necessary
		for my $ii (0..($nargs-1))
		{
			$argname[$ii] = ""
				unless (defined($argname[$ii]) &&
						length($argname[$ii]));
		}
		
		$fndef->{tuple}->{proargnames} = "{" .
			join(",", @argname) . "}";
	}
	
	my @iargs; # count the input args
	# check list of arg class
	if (scalar(@argclass))
	{
		# if no class specified, use "IN"
		for my $ii (0..($nargs-1))
		{
			$argclass[$ii] = "i"
				unless (defined($argclass[$ii]) &&
						length($argclass[$ii]));
			
			# distinguish input args from output
			push @iargs, $argoids[$ii]
				if ($argclass[$ii] !~ m/o/i);
		}
		
		$fndef->{tuple}->{proargmodes} = "{" .
			join(",", @argclass) . "}";
	}
	
	# sigh. stupid difference between representation for oidvector and
	# oid array.  This is an oid array for proallargtypes.  
	# Oidvector uses spaces, not commas.
	my $oidstr =  "{" . join(",", @argoids) . "}";
	
	# number of args is input args if have arg_class, else just count
	$fndef->{tuple}->{pronargs} = 
		scalar(@argclass) ? scalar(@iargs) : $nargs;
	if (scalar(@argclass))
	{
		# distinguish input args from all args
		$fndef->{tuple}->{proallargtypes} = $oidstr;
		$fndef->{tuple}->{proargtypes} = 
			join(" ", @iargs);

		# handle case of no input args (pg_get_keywords)
		$fndef->{tuple}->{proargtypes} = ""
			unless (defined($fndef->{tuple}->{proargtypes}) &&
					length($fndef->{tuple}->{proargtypes}));


	}
	else # no input args (or all input args...)
	{
		$fndef->{tuple}->{proargtypes} = 
			join(" ", @argoids);
	}
	return $oidstr;
	
} # end make_allargs


# parse the WITH clause
sub get_fnwithhash
{
	my $funcdef = shift;
	my %withh;
	use Text::ParseWords;


	if ($funcdef =~ m/with\s*\(.*\)/i)
	{
		my @baz = ($funcdef =~ m/(with\s*\(.*\))/is);
		
		die "bad WITH: $funcdef"  unless (scalar(@baz));

		my $withclause = shift @baz;

		$withclause =~ s/^\s*with\s*\(\s*//is;
		$withclause =~ s/\s*\)\s*$//s;

		# split by comma, but use Text::ParseWords::parse_line to
		# preserve quoted descriptions
		@baz = parse_line(",", 1, $withclause);

		for my $withdef (@baz)
		{
			my @bzz = split("=", $withdef, 2);

			die "bad WITH def: $withdef" unless (2 == scalar(@bzz));

			my $kk = shift @bzz;
			my $vv = shift @bzz;

			$kk =~ s/^\s+//;
			$kk =~ s/\s+$//;
			$kk = lc($kk);

			$vv =~ s/^\s+//;
			$vv =~ s/\s+$//;

			if ($kk =~ m/proisagg|proiswin/)
			{
				# unquote the string
				$vv =~ s/\"//g;
			}
			if ($kk =~ m/prosrc/)
			{
				# double the single quotes
				$vv =~ s/\'/\'\'/g;
			}

			$withh{$kk} = $vv;
		}

	}

	return \%withh;
} # end get_fnwithhash

# old_order: preserve the original pg_proc order of definitions 
sub old_order
{
	my $fh = shift;

	my @ord1 =
		(1242, 1243, 1244, 31, 1245, 33, 34, 35, 38, 39, 40, 41, 42, 43, 44,
		 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 60, 61, 62, 63,
		 64, 65, 66, 67, 68, 69, 70, 1246, 72, 73, 74, 77, 78, 79, 1252, 1254,
		 1256, 1257, 1258, 84, 89, 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, 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, 200, 201, 202,
		 203, 204, 205, 206, 207, 208, 6024, 3106, 3107, 209, 211, 212, 213,
		 214, 215, 216, 217, 218, 219, 220, 221, 222, 6025, 3108, 3109, 223,
		 224, 225, 226, 227, 228, 229, 2308, 2320, 2309, 2310, 230, 231, 232,
		 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246,
		 247, 248, 249, 250, 251, 252, 253, 254, 255, 256, 257, 258, 259, 260,
		 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
		 275, 277, 278, 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289,
		 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303,
		 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317,
		 318, 319, 330, 636, 331, 333, 334, 335, 336, 337, 338, 332, 972, 1268,
		 2785, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 350, 351, 842,
		 354, 355, 356, 404, 357, 358, 359, 360, 377, 380, 381, 382, 2905, 361,
		 362, 363, 364, 365, 366, 367, 368, 369, 370, 371, 372, 373, 401, 406,
		 407, 408, 409, 440, 637, 441, 443, 444, 445, 446, 447, 448, 442, 425,
		 438, 2786, 449, 450, 949, 451, 452, 453, 454, 455, 400, 456, 457, 329,
		 398, 399, 422, 6432, 458, 459, 460, 461, 462, 463, 464, 465, 466, 467,
		 468, 469, 470, 471, 472, 474, 475, 476, 477, 478, 479, 480, 481, 482,
		 483, 652, 653, 714, 754, 1285, 1286, 655, 656, 657, 658, 659, 668,
		 669, 676, 619, 677, 678, 679, 680, 681, 710, 716, 717, 720, 721, 722,
		 723, 724, 725, 726, 727, 728, 729, 740, 741, 742, 743, 745, 746, 744,
		 390, 391, 392, 393, 396, 747, 750, 751, 2091, 2092, 378, 379, 383,
		 384, 394, 395, 515, 516, 6012, 2908, 2909, 2910, 3534, 3535, 3536,
		 3537, 3538, 760, 761, 762, 763, 764, 765, 766, 768, 769, 770, 771,
		 774, 638, 775, 777, 778, 779, 780, 781, 782, 776, 2561, 772, 2787,
		 784, 785, 786, 787, 788, 789, 817, 818, 819, 838, 839, 840, 841, 846,
		 847, 848, 849, 850, 851, 852, 853, 854, 855, 856, 857, 858, 859, 860,
		 861, 820, 862, 863, 864, 865, 866, 867, 886, 887, 888, 889, 890, 891,
		 892, 893, 894, 895, 896, 897, 898, 899, 919, 935, 940, 941, 942, 943,
		 945, 947, 944, 946, 950, 951, 952, 953, 954, 955, 956, 957, 715, 958,
		 828, 959, 960, 961, 962, 963, 964, 973, 975, 976, 977, 978, 979, 980,
		 981, 982, 983, 984, 985, 986, 987, 988, 989, 990, 991, 992, 993, 994,
		 995, 996, 997, 998, 999, 748, 749, 837, 948, 938, 939, 1026, 1029,
		 1030, 1031, 1032, 1035, 1036, 1037, 1062, 1365, 1044, 1045, 1046,
		 1047, 1048, 1049, 1050, 1051, 1052, 1053, 1063, 1064, 1078, 1080,
		 1081, 1084, 1085, 1086, 1087, 1088, 1089, 1090, 1091, 1092, 1102,
		 1103, 1104, 1105, 1106, 1107, 1138, 1139, 1140, 1141, 1142, 1143,
		 1144, 1145, 1146, 1147, 1148, 1149, 1150, 1151, 1152, 1153, 1154,
		 1155, 1156, 1157, 1158, 1159, 1160, 1161, 1162, 1163, 1164, 1165,
		 1166, 1167, 1168, 1169, 1170, 1171, 1172, 1173, 1174, 2711, 1175,
		 1295, 1176, 1177, 1178, 1179, 1180, 1181, 1188, 1189, 1190, 1191,
		 1192, 1193, 1194, 1195, 1196, 1197, 1198, 1199, 1200, 1215, 1216,
		 1993, 1217, 1218, 1219, 2857, 2804, 1230, 1236, 1237, 1238, 1239,
		 1240, 1241, 1251, 1253, 1263, 1271, 1272, 1273, 1274, 1275, 1276,
		 1277, 1278, 1279, 1280, 1281, 1287, 1288, 1289, 1290, 1291, 1292,
		 1293, 1294, 1265, 2790, 2791, 2792, 2793, 2794, 2795, 2796, 1296,
		 1297, 1298, 1299, 2647, 2648, 2649, 1300, 1301, 1302, 1303, 1304,
		 1305, 1306, 1307, 1308, 1309, 1310, 1311, 1312, 1313, 1314, 1315,
		 1316, 1317, 1318, 1319, 1326, 1339, 1340, 1341, 1342, 1343, 1344,
		 1345, 1346, 1368, 1347, 1348, 1349, 1350, 1351, 1352, 1353, 1354,
		 1355, 1356, 1357, 1358, 1359, 1364, 1367, 1369, 1370, 1372, 1373,
		 1374, 1375, 1377, 1378, 1379, 1380, 1381, 1382, 1383, 1384, 1385,
		 1386, 1388, 1389, 1390, 1376, 1394, 1395, 1396, 1397, 1398, 1400,
		 1401, 1402, 1403, 1404, 1405, 1406, 1407, 1408, 1409, 1410, 1411,
		 1412, 1413, 1414, 1415, 1416, 1417, 1418, 1419, 1421, 1422, 1423,
		 1424, 1425, 1426, 1428, 1429, 1430, 1431, 1432, 1433, 1434, 1435,
		 1436, 1437, 1438, 1439, 1440, 1441, 1442, 1443, 1444, 1445, 1446,
		 1447, 1448, 1449, 1450, 1451, 1452, 1453, 1454, 1455, 1456, 1457,
		 1458, 1459, 1460, 1461, 1462, 1463, 1464, 1465, 1466, 1467, 1468,
		 1469, 1470, 1471, 1472, 1473, 1474, 1475, 1476, 1477, 1478, 1479,
		 1480, 1481, 1482, 1483, 1484, 1485, 1486, 1487, 1488, 1489, 1490,
		 1491, 1492, 1493, 1494, 1495, 1496, 1497, 1498, 1499, 1530, 1531,
		 1532, 1533, 1534, 1540, 1541, 1542, 1543, 1544, 1545, 1556, 1564,
		 1565, 1569, 1570, 1571, 1572, 1574, 1575, 1576, 1765, 1579, 1580,
		 1581, 1582, 1592, 1593, 1594, 1595, 1596, 1598, 1599, 1600, 1601,
		 1602, 1603, 1604, 1605, 1606, 1607, 1608, 1609, 1610, 1618, 1620,
		 1621, 1622, 1623, 1624, 1631, 1632, 1633, 1634, 1635, 1636, 1637,
		 1656, 1657, 1658, 1659, 1660, 1661, 1689, 868, 870, 871, 872, 873,
		 874, 875, 876, 877, 878, 879, 880, 881, 882, 883, 884, 885, 936, 937,
		 2087, 2284, 2285, 5018, 5019, 5020, 5021, 5022, 5023, 2088, 2089,
		 2090, 1039, 810, 1717, 1813, 1619, 1264, 1597, 1638, 1639, 1573, 1640,
		 1641, 1642, 1643, 1662, 1387, 1716, 1665, 5024, 5025, 5034, 5027,
		 5028, 5037, 821, 822, 1644, 1645, 1646, 1647, 1648, 1649, 1650, 1651,
		 1652, 1653, 1654, 1655, 1666, 1667, 1668, 1669, 1670, 1671, 1672,
		 1673, 1674, 1675, 1676, 1677, 1678, 1679, 1680, 1681, 1682, 1683,
		 1684, 1685, 1687, 1698, 1699, 436, 437, 752, 753, 767, 830, 831, 832,
		 833, 834, 835, 836, 910, 911, 1267, 1427, 920, 921, 922, 923, 924,
		 925, 926, 927, 928, 929, 930, 598, 599, 605, 635, 711, 683, 696, 697,
		 698, 699, 730, 1362, 1713, 1714, 1715, 2196, 2197, 2198, 2199, 2627,
		 2628, 2629, 2630, 2631, 2632, 2633, 1686, 1688, 1690, 1691, 1692,
		 1693, 1696, 1697, 1701, 1702, 1703, 1704, 1705, 1706, 1707, 1708,
		 1709, 1710, 1711, 2167, 1712, 1718, 1719, 1720, 1721, 1722, 1723,
		 1724, 1725, 1726, 1727, 1728, 1729, 1730, 1731, 1732, 1733, 1734,
		 1735, 1736, 1737, 1738, 2169, 1739, 1740, 1741, 1742, 1743, 1744,
		 1745, 1746, 2170, 1747, 1748, 1749, 1750, 1764, 1004, 1766, 1767,
		 1769, 1771, 1779, 1781, 1782, 1783, 1770, 1772, 1773, 1774, 1775,
		 1776, 1777, 1778, 1780, 1768, 1282, 1283, 1798, 1799, 1810, 1811,
		 1812, 1814, 1815, 1816, 1817, 1818, 1819, 1820, 1821, 1822, 1823,
		 1824, 1825, 1826, 1827, 1828, 1829, 1830, 2512, 1831, 2513, 1832,
		 1833, 3102, 7309, 3103, 1834, 1835, 1836, 7306, 7307, 7308, 1837,
		 2514, 1838, 2596, 1839, 1840, 1841, 1842, 7008, 7009, 7010, 1843,
		 6038, 1844, 1962, 1963, 3100, 6019, 6020, 3101, 1964, 2805, 2806,
		 2807, 2808, 2809, 2810, 2811, 2812, 2813, 2814, 2815, 2816, 2817,
		 1845, 1846, 1847, 1848, 1850, 1851, 1852, 1853, 1854, 1855, 1856,
		 1857, 1858, 1859, 1860, 1861, 1892, 1893, 1894, 1895, 1896, 1897,
		 1898, 1899, 1900, 1901, 1902, 1903, 1904, 1905, 1906, 1907, 1908,
		 1909, 1910, 1911, 1912, 1913, 1914, 1915, 1922, 1923, 1924, 1925,
		 1926, 1927, 1928, 1929, 1930, 1931, 1932, 1933, 1934, 1935, 2781,
		 2782, 2783, 2784, 1936, 2026, 2274, 1937, 1938, 1939, 1940, 2853,
		 2094, 1391, 1392, 1393, 1941, 1942, 1943, 1944, 1945, 6031, 6032,
		 6033, 6034, 6039, 6042, 6071, 1946, 1947, 1948, 1949, 1950, 1951,
		 1952, 1953, 1954, 1961, 1965, 1966, 1967, 1968, 1969, 2005, 2006,
		 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2085, 2086, 2014, 2015,
		 2019, 2020, 2021, 2022, 2023, 2024, 2025, 2027, 2028, 2029, 2030,
		 2031, 2032, 2033, 2034, 2035, 2036, 2037, 2038, 2041, 2042, 2043,
		 2044, 2045, 2046, 2047, 2048, 2049, 2052, 2053, 2054, 2055, 2056,
		 2057, 2058, 2059, 2069, 2070, 2071, 2072, 2073, 2074, 2075, 2076,
		 2077, 2078, 2084, 1371, 1065, 2079, 2080, 2081, 2082, 2083, 2093,
		 2854, 2855, 2171, 2878, 2172, 2173, 2848, 2849, 2852, 2850, 2851,
		 2621, 2622, 2623, 2624, 2625, 2626, 6030, 6069, 6045, 6046, 6047,
		 6048, 6049, 6050, 6051, 2971, 2100, 2101, 2102, 2103, 2104, 2105,
		 2106, 2107, 2108, 2109, 2110, 2111, 2112, 2113, 2114, 2115, 2116,
		 2117, 2118, 2119, 2120, 2121, 2122, 2123, 2124, 2125, 2126, 2127,
		 2128, 2129, 2130, 2050, 2244, 2797, 3332, 2131, 2132, 2133, 2134,
		 2135, 2136, 2137, 2138, 2139, 2140, 2141, 2142, 2143, 2144, 2145,
		 2146, 2051, 2245, 2798, 3333, 2147, 2803, 2718, 2719, 2720, 2721,
		 2722, 2723, 2641, 2642, 2643, 2644, 2645, 2646, 2148, 2149, 2150,
		 2151, 2152, 2153, 2724, 2725, 2726, 2727, 2728, 2729, 2712, 2713,
		 2714, 2715, 2716, 2717, 2154, 2155, 2156, 2157, 2158, 2159, 6013,
		 2818, 2819, 2820, 2821, 2822, 2823, 2824, 2825, 2826, 2827, 2828,
		 2829, 2160, 2161, 2162, 2163, 2164, 2165, 2166, 7000, 7001, 7002,
		 7003, 7004, 7005, 7006, 7007, 7017, 7018, 7019, 7020, 7021, 7022,
		 7023, 7024, 7025, 7026, 7027, 7028, 7029, 7030, 7031, 7032, 7033,
		 7034, 7035, 7036, 7037, 7038, 7039, 7040, 7041, 7042, 7043, 7044,
		 7045, 7046, 7047, 7232, 7256, 7272, 7288, 7012, 7013, 7014, 7015,
		 7016, 7063, 7072, 7073, 7048, 7049, 7050, 7051, 7052, 7053, 7054,
		 7055, 7056, 7057, 7058, 7059, 7060, 7061, 7062, 7064, 7065, 7066,
		 7067, 7068, 7069, 7070, 7071, 7238, 7258, 7274, 7290, 7675, 7491,
		 7493, 7495, 7497, 7499, 7501, 7503, 7505, 7507, 7509, 7511, 7513,
		 7515, 7517, 7519, 7521, 7523, 7525, 7527, 7529, 7531, 7533, 7535,
		 7537, 7539, 7541, 7543, 7545, 7547, 7549, 7551, 7553, 7555, 7557,
		 7559, 7561, 7563, 7565, 7567, 7569, 7571, 7573, 7575, 7577, 7579,
		 7581, 7583, 7585, 7587, 7589, 7591, 7593, 7595, 7597, 7599, 7601,
		 7603, 7605, 7607, 7609, 7611, 7613, 7615, 7617, 7619, 7621, 7623,
		 7625, 7627, 7629, 7631, 7633, 7635, 7637, 7639, 7641, 7643, 7645,
		 7647, 7649, 7651, 7653, 7655, 7657, 7659, 7661, 7663, 7665, 7667,
		 7669, 7671, 7673, 7211, 7212, 7213, 7226, 7228, 7230, 7250, 7252,
		 7254, 7266, 7268, 7270, 7011, 7074, 7075, 7310, 7312, 7314, 7316,
		 7318, 7320, 7322, 7324, 7326, 7328, 7330, 7332, 7334, 7336, 7338,
		 7340, 7342, 7344, 7346, 7348, 7350, 7352, 7354, 7356, 7358, 7360,
		 7362, 7364, 7366, 7368, 7370, 7372, 7374, 7376, 7378, 7380, 7382,
		 7384, 7386, 7388, 7390, 7392, 7394, 7396, 7398, 7400, 7402, 7404,
		 7406, 7408, 7410, 7412, 7414, 7416, 7418, 7420, 7422, 7424, 7426,
		 7428, 7430, 7432, 7434, 7436, 7438, 7440, 7442, 7444, 7446, 7448,
		 7450, 7452, 7454, 7456, 7458, 7460, 7462, 7464, 7466, 7468, 7470,
		 7472, 7474, 7476, 7478, 7480, 7482, 7484, 7486, 7488, 7214, 7215,
		 7216, 7220, 7222, 7224, 7244, 7246, 7248, 7260, 7262, 7264, 2174,
		 2175, 2176, 2177, 2178, 2179, 2180, 2181, 2182, 2183, 2184, 2185,
		 2186, 2187, 2188, 2189, 2190, 2191, 2192, 2193, 2194, 2195, 2896,
		 2212, 2213, 2214, 2215, 2216, 2217, 2218, 2219, 2220, 2221, 1079,
		 2246, 2247, 2248, 2250, 2251, 2252, 2253, 2254, 2255, 2256, 2257,
		 2258, 2259, 2260, 2261, 2262, 2263, 2264, 2265, 2266, 2267, 2268,
		 2269, 2270, 2271, 2272, 2273, 2390, 2391, 2392, 2393, 2394, 2395,
		 3112, 3113, 3114, 3115, 3116, 3117, 3118, 3119, 3120, 3121, 3122,
		 3123, 2705, 2706, 2707, 2708, 2709, 2710, 1269, 2322, 2323, 2324,
		 2168, 2325, 2289, 2286, 2287, 2288, 2897, 2290, 2291, 2292, 2293,
		 2294, 2295, 2296, 2297, 2298, 2299, 2300, 2301, 2302, 2303, 2304,
		 2305, 2306, 2307, 2312, 2313, 2398, 2399, 2597, 2598, 2311, 2321,
		 2338, 2339, 2340, 2341, 2342, 2343, 2344, 2351, 2352, 2353, 2354,
		 2355, 2356, 2357, 2364, 2365, 2366, 2367, 2368, 2369, 2370, 2377,
		 2378, 2379, 2380, 2381, 2382, 2383, 2520, 2521, 2522, 2523, 2524,
		 2525, 2526, 2527, 2528, 2529, 2530, 2531, 2532, 2533, 2400, 2401,
		 2402, 2403, 2404, 2405, 2406, 2407, 2408, 2409, 2410, 2411, 2412,
		 2413, 2414, 2415, 2416, 2417, 2418, 2419, 2420, 2421, 2422, 2423,
		 2424, 2425, 2426, 2427, 2428, 2429, 2430, 2431, 2432, 2433, 2434,
		 2435, 2436, 2437, 2438, 2439, 2440, 2441, 2442, 2443, 2444, 2445,
		 2446, 2447, 2448, 2449, 2450, 2451, 2452, 2453, 2454, 2455, 2456,
		 2457, 2458, 2459, 2460, 2461, 2462, 2463, 2464, 2465, 2466, 2467,
		 2468, 2469, 2470, 2471, 2472, 2473, 2474, 2475, 2476, 2477, 2478,
		 2479, 2480, 2481, 2482, 2483, 2484, 2485, 2486, 2487, 2488, 2489,
		 2490, 2491, 2492, 2493, 2494, 2495, 2496, 2497, 2498, 2499, 2500,
		 2501, 2502, 2503, 2504, 2505, 2506, 2507, 2508, 2509, 2510, 2511,
		 2599, 2856, 1066, 1067, 1068, 1069, 2515, 2516, 2517, 2518, 2519,
		 2236, 2237, 2238, 2239, 2240, 2241, 2242, 2243, 2546, 2547, 2548,
		 2549, 2550, 2556, 2557, 2558, 2559, 2560, 2562, 2563, 2564, 2565,
		 2566, 2567, 2568, 2569, 2587, 2588, 2578, 2579, 2580, 2581, 2582,
		 2583, 2584, 2585, 2586, 2591, 2592, 2730, 2731, 2732, 2733, 2734,
		 2735, 2736, 2737, 2738, 2739, 2740, 2741, 2788, 3200, 3201, 3202,
		 3203, 3204, 3205, 3206, 3208, 3209, 3210, 3211, 3212, 3213, 3214,
		 3215, 3216, 3217, 3218, 3219, 3225, 3226, 3227, 3228, 3229, 3230,
		 3240, 3252, 3253, 3254, 3255, 3267, 3268, 3256, 3257, 3258, 3259,
		 3260, 3261, 3262, 3263, 3264, 3265, 3266, 3302, 3303, 3304, 3305,
		 3312, 3313, 3314, 3315, 3318, 3319, 3331, 3320, 3321, 3322, 3323,
		 3324, 6003, 6004, 6005, 6006, 6007, 6008, 3104, 6009, 6010, 3111,
		 6011, 6015, 3105, 6016, 6017, 3110, 6018, 6014, 6021, 6022, 6023,
		 6035, 6036, 6037, 6043, 6044, 6435, 6068, 7100, 7101, 7102, 7490,
		 7492, 7494, 7496, 7498, 7500, 7502, 7504, 7506, 7508, 7510, 7512,
		 7514, 7516, 7518, 7520, 7522, 7524, 7526, 7528, 7530, 7532, 7534,
		 7536, 7538, 7540, 7542, 7544, 7546, 7548, 7550, 7552, 7554, 7556,
		 7558, 7560, 7562, 7564, 7566, 7568, 7570, 7572, 7574, 7576, 7578,
		 7580, 7582, 7584, 7586, 7588, 7590, 7592, 7594, 7596, 7598, 7600,
		 7602, 7604, 7606, 7608, 7610, 7612, 7614, 7616, 7618, 7620, 7622,
		 7624, 7626, 7628, 7630, 7632, 7634, 7636, 7638, 7640, 7642, 7644,
		 7646, 7648, 7650, 7652, 7654, 7656, 7658, 7660, 7662, 7664, 7666,
		 7668, 7670, 7672, 7674, 7208, 7209, 7210, 7227, 7229, 7231, 7251,
		 7253, 7255, 7267, 7269, 7271, 7106, 7104, 7105, 7311, 7313, 7315,
		 7317, 7319, 7321, 7323, 7325, 7327, 7329, 7331, 7333, 7335, 7337,
		 7339, 7341, 7343, 7345, 7347, 7349, 7351, 7353, 7355, 7357, 7359,
		 7361, 7363, 7365, 7367, 7369, 7371, 7373, 7375, 7377, 7379, 7381,
		 7383, 7385, 7387, 7389, 7391, 7393, 7395, 7397, 7399, 7401, 7403,
		 7405, 7407, 7409, 7411, 7413, 7415, 7417, 7419, 7421, 7423, 7425,
		 7427, 7429, 7431, 7433, 7435, 7437, 7439, 7441, 7443, 7445, 7447,
		 7449, 7451, 7453, 7455, 7457, 7459, 7461, 7463, 7465, 7467, 7469,
		 7471, 7473, 7475, 7477, 7479, 7481, 7483, 7485, 7487, 7489, 7217,
		 7218, 7219, 7221, 7223, 7225, 7245, 7247, 7249, 7261, 7263, 7265,
		 7111, 7112, 7113, 7114, 7115, 7116, 7117, 7118, 7119, 7120, 7121,
		 7122, 7123, 7124, 7125, 7126, 7127, 7128, 7129, 7130, 7131, 7132,
		 7133, 7134, 7135, 7136, 7137, 7138, 7139, 7140, 7141, 7233, 7257,
		 7273, 7289, 7103, 7107, 7108, 7109, 7110, 7165, 7166, 7167, 7168,
		 7142, 7143, 7144, 7145, 7146, 7147, 7148, 7149, 7150, 7151, 7152,
		 7153, 7154, 7155, 7157, 7158, 7159, 7160, 7161, 7162, 7163, 7164,
		 7239, 7259, 7275, 7291, 7204, 7205, 7206, 7207, 7303, 7304, 7305,
		 7169, 7170, 7171, 7172, 7173, 7174, 7178, 7179, 7180, 7181, 7182,
		 2743, 2744, 2747, 2748, 2749, 2880, 2881, 2882, 2883, 2884, 2885,
		 2886, 2887, 2888, 2889, 2890, 2891, 2892, 3050, 3051, 3001, 3002,
		 3003, 3004, 3005, 3006, 3007, 3008, 3009, 3010, 3011, 9900, 9997,
		 9998, 9999, 5032, 5040, 5041, 5042, 5044, 5045, 5046, 5047, 5048,
		 5049, 5050, 5051, 5052, 5053, 5054, 5055, 5056, 5057, 5058, 5059,
		 5060, 5061, 5062, 5063, 5064, 5065, 5066, 5067, 5068, 5069, 5070,
		 5071, 5072, 5073, 5074);

	my $ocomm =
	{ 1242 => "1 - 99", 101 => "100 - 199", 200 => "200 - 299",
	  300 => "300 - 399", 401 => "400 - 499", 701 => "700 - 799",
	  817 => "800 - 899", 940 => "900 - 999", 1026 => "1000 - 1999",
	  1102 => "1100 - 1199", 1200 => "1200 - 1299", 1300 => "1300 - 1399",
	  1400 => "1400 - 1499", 1530 => "1500 - 1599", 1600 => "1600 - 1699"};

	for my $oid (@ord1)
	{
		if (exists($fh->{$oid}))
		{
#			print "\n/* OIDS 500 - 599 */\n\n/* OIDS 600 - 699 */\n\n"
#				if (652 == $oid);

			if (0 && exists($ocomm->{$oid}))
			{
				print "\n/* OIDS " . $ocomm->{$oid} . " */\n\n";
			}

			if (0)
			{
				my $rawtxt = $fh->{$oid}->{rawtxt};

				my @ggg = ($rawtxt =~ m/AS\s+\'\"(.*)\"\'/i);

				if (scalar(@ggg))
				{
					my $m1 = shift @ggg;
					my $m2 = $m1;
					$m2 =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
					$m2 =~ s/\'\'/\'/g;
					$m2 = '$$'.$m2.'$$';
#					$m2 = quotemeta($m2);
					$rawtxt =~ s/AS\s+\'\"(.*)\"\'/AS $m2/i;
				}

				print $rawtxt, ";\n";
			}
			else
			{
				printfndef($fh->{$oid});
			}
		}
		else
		{
			print "/* MISSING: $oid */\n";
		}

	}
	
} # end old_order

sub printfndef
{
	my $fndef = shift;
	my $bigstr = "";

	my $addcomment = 1;

	die "bad fn" unless (exists($fndef->{with}->{oid}));
	my $tup = $fndef->{tuple};
	my $nam = $fndef->{name};
	
	$nam =~ s/\"//g;

	if (exists($fndef->{prefix}) &&
		length($fndef->{prefix}))
	{
		$bigstr .= $fndef->{prefix};
	}
	
#		print Data::Dumper->Dump([$tup]);		
#		print $fndef->{name} . "\n\n";

	$bigstr .= "/* " .
		$fndef->{name} . "(" . 
		($fndef->{rawargs} ? $fndef->{rawargs} : "" ) . ") => " .
		(exists($fndef->{returntype}) ? $fndef->{returntype} : "()") . " */ \n"
		if ($addcomment);


	$bigstr .= "DATA(insert OID = " . $fndef->{with}->{oid} . " ( " .
		$nam . "  " . $tup->{pronamespace} . " " .
		$tup->{proowner} . " " .
		$tup->{prolang} . " " .
		(exists($fndef->{with}->{proisagg}) ? $fndef->{with}->{proisagg} :
		 ($tup->{proisagg} ? "t" : "f") ) . " " .
		($tup->{prosecdef} ? "t" : "f") . " " .
		($tup->{proisstrict} ? "t" : "f") . " " .
		($tup->{proretset} ? "t" : "f") . " " .
		($tup->{provolatile} ? $tup->{provolatile} : "_null_" ) . " " .
		($tup->{pronargs} ? $tup->{pronargs} : 0) . " " .
		($tup->{prorettype} ? $tup->{prorettype} : '""') . " " .
		(exists($fndef->{with}->{proiswin}) ? $fndef->{with}->{proiswin} :
		 ($tup->{proiswin} ? "t" : "f")) . " " .
		($tup->{proargtypes} ? '"'. $tup->{proargtypes} . '"' : '""') . " " .
		($tup->{proallargtypes} ? '"' . $tup->{proallargtypes} . '"'  : "_null_")  . " " .
		($tup->{proargmodes} ? '"' . $tup->{proargmodes} . '"' : "_null_") . " " .
		($tup->{proargnames} ? '"' . $tup->{proargnames} . '"' : "_null_") . " " .
		(exists($fndef->{with}->{prosrc}) ? $fndef->{with}->{prosrc} :
		 ($tup->{prosrc} ? $tup->{prosrc} : "_null_" )) . " " .
		($tup->{probin} ? $tup->{probin} : "-") . " " .
		($tup->{proacl} ? $tup->{proacl} : "_null_") . " " . 
		$tup->{prodataaccess} . " " .
		"));\n";
	$bigstr .= "DESCR(" . $fndef->{with}->{description} . ");\n"
		if (exists($fndef->{with}->{description}));
	$bigstr .= "\n"
		if ($addcomment);

	return $bigstr;
} # end printfndef

# MAIN routine for pg_proc generation
sub doprocs()
{
	
	my $whole_file;
	
	{
        # $$$ $$$ undefine input record separator (\n)
        # and slurp entire file into variable
		
        local $/;
        undef $/;
		
		my $fh;

		open $fh, "< $glob_glob->{procdef}" 
			or die "cannot open $glob_glob->{procdef}: $!";

		$whole_file = <$fh>;
		
		close $fh;
	}
	
	my @allfndef;
	my $fndefh;
	
	# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX 
	# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX 
	# NOTE: preprocess dollar quoted strings for SQL functions:
	if ($whole_file =~  m/\$\$/)
	{
		my @ddd = split(/(\$\$)/m, $whole_file);

		my @eee;

		my $gotone = -1;
		
		for my $d1 (@ddd)
		{
			$gotone *= -1
				if ($d1 =~ m/\$\$/);

			if (($gotone > 0) &&
				($d1 !~ m/\$\$/))
			{
				$d1 =~ s/\'/\'\'/gm; # double quote the single quotes

				# quurl - convert to a single quoted string without spaces
				$d1 =~ s/([^a-zA-Z0-9])/uc(sprintf("%%%02lx",  ord $1))/eg;

				# and make it a quoted, double quoted string (eg '"string"')
				$d1 = "'\"" . $d1 . "\"'";
			}
			# strip the $$ tokens
			push @eee, $d1
				if ($d1 !~ m/\$\$/);
		}
		$whole_file = join("", @eee);
	}
	# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX 
	# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX 

	
	my @allfuncs = split(/\;\s*$/m, $whole_file);
	
#	print Data::Dumper->Dump(\@allfuncs);
	
	for my $funcdef (@allfuncs)
	{
		my $funcprefix;

		undef $funcprefix;

		# find "prefix", ie comments or #DEF's, preceding function definition.
		if ($funcdef =~ m/\s*\-\-.*create func/ims)
		{
			my @ppp = ($funcdef =~ m/(^\s*\-\-.*\n)\s*create func/ims);

#			print "ppp: ",Data::Dumper->Dump(\@ppp);

			if (scalar(@ppp))
			{
				my @qqq = split(/\n/, $ppp[0]);

				$funcprefix = "";

				for my $l1 (@qqq)
				{
					# uncomment #DEF's 
					if ($l1 =~ m/^\s*\-\- \#define/)
					{
						$l1 =~ s|\-\-\s*||;
					}
					# convert to c-style comments
					if ($l1 =~ m/^\s*\-\-/)
					{
						$l1 =~ s|\-\-|\/\*|;
						$l1 .= " */";
					}
					$funcprefix .= $l1 . "\n";
				}

				my $rex2 = quotemeta($ppp[0]);

				# remove the prefix
				$funcdef =~ s/$rex2//;

#				print $funcprefix;
			}

		}

		next
			unless ($funcdef =~ 
					m/create func(?:tion)*\s+((\w+\.)*(\")*(\w+)(\")*)/i);
		my $orig = $funcdef;
		
		# strip "create function"
		$funcdef =~ s/^\s*create func(?:tion)*\s*//i;
		
		# find function name (precedes leading paren)
		my @foo = split(/\(\s*/, $funcdef, 2);
		
		die "bad funcdef: $orig" unless (2 == scalar(@foo));
		
		my $funcname = shift @foo;
		my $fnrex = quotemeta($funcname);
		
		# strip func name
		$funcdef =~ s/\s*$fnrex\s*//;
		
		@foo = split(/\s*\)/, $funcdef, 2);		
		
		die "bad funcdef: $orig" unless (2 == scalar(@foo));
		
		my $fnargs = shift @foo;
		# remove leading paren
		$fnargs =~ s/\s*\(//;
		
		$funcdef = shift @foo;
		
		die "bad funcdef - no RETURNS: $orig" 
			unless ($funcdef =~ m/\s*RETURN/i);
		
		$funcdef =~ s/\s+RETURNS\s+//i;

		my $fntdef = get_fntype($funcdef);

		# remove the function arg list tokens
		@foo = split(/\s+/, $fntdef);
		for my $ff (@foo)
		{
			$ff = quotemeta($ff);
			$funcdef =~ s/^$ff//;
		}

#		print "name: $funcname\nargs: $fnargs\nreturns: $fntdef\nrest: $funcdef\n";

#		print Data::Dumper->Dump(get_fnoptlist($funcdef));
		my $t1 = get_fnoptlist($funcdef);
		my $w1 = get_fnwithhash($funcdef);
#		print "name: $funcname\nargs: $fnargs\nreturns: $fntdef\nrest: $funcdef\n";
#		print Data::Dumper->Dump($t1);

		$fndefh = { name=> $funcname, rawtxt => $orig, 
					returntype => $fntdef,
					rawargs => $fnargs, optlist => $t1, with => $w1 };

		$fndefh->{prefix} = $funcprefix
			if (defined($funcprefix));

		push @allfndef, $fndefh;
	}


#	print Data::Dumper->Dump(\@allfndef);

	for my $fndef (@allfndef)
	{
		make_opt($fndef);
		make_rettype($fndef);
		make_allargs($fndef);
	}

#	print Data::Dumper->Dump(\@allfndef);

    my $verzion = "unknown";
	$verzion = $glob_glob->{_sleazy_properties}->{version}
	if (exists($glob_glob->{_sleazy_properties}) &&
		exists($glob_glob->{_sleazy_properties}->{version}));

	$verzion = $0 . " version " . $verzion;
	my $nnow = localtime;
	my $gen_hdr_str = "";
#	$gen_hdr_str = "/* TIDYCAT_BEGIN_PG_PROC_GEN \n\n";
	$gen_hdr_str = "\n";
	$gen_hdr_str .= "   WARNING: DO NOT MODIFY THE FOLLOWING SECTION: \n" .
		"   Generated by " . $verzion . "\n" . 
		"   on " . $nnow . "\n\n" . 
		"   Please make your changes in " . $glob_glob->{procdef} . "\n*/\n\n";

	my $bigstr = "";

	$bigstr .= $gen_hdr_str;

	if (0)
	{
		# build definitions in "old" order
		my %fh;
		for my $fndef (@allfndef)
		{
			$fh{$fndef->{with}->{oid}} = $fndef;
		}
		old_order(\%fh);
	}
	else
	{
		# build definitions in same order as input file
		for my $fndef (@allfndef)
		{
			$bigstr .= printfndef($fndef);
		}
	}

	$bigstr .= "\n";
#	$bigstr .= "\n\n/* TIDYCAT_END_PG_PROC_GEN */\n";

	if (0)
	{
		print $bigstr;
	}
	else
	{
        # $$$ $$$ undefine input record separator (\n)
        # and slurp entire file into variable
		
        local $/;
        undef $/;
		
		my $tfh;

		open $tfh, "< $glob_glob->{prochdr}" 
			or die "cannot open $glob_glob->{prochdr}: $!";

		my $target_file = <$tfh>;
		
		close $tfh;

		my $prefx = quotemeta('TIDYCAT_BEGIN_PG_PROC_GEN');
		my $suffx = quotemeta('TIDYCAT_END_PG_PROC_GEN');

		my @zzz = ($target_file =~ 
				   m/^\s*\/\*\s*$prefx\s*\s*$(.*)^\s*\/\*\s*$suffx\s*\*\/\s*$/ms);

		die "bad target: $glob_glob->{prochdr}"
			unless (scalar(@zzz));

		my $rex = $zzz[0];

		# replace carriage returns first, then quotemeta, then fix CR again...
		$rex =~ s/\n/SLASHNNN/gm;
		$rex = quotemeta($rex);
		$rex =~ s/SLASHNNN/\\n/gm;

		# substitute the new generated proc definitions for the prior
		# generated defitions in the target file
		$target_file =~ s/$rex/$bigstr/ms;

		# save a backup file
		system "cp $glob_glob->{prochdr} $glob_glob->{prochdr}.backup";

		my $outi;

		open $outi, "> $glob_glob->{prochdr}" 
			or die "cannot open $glob_glob->{prochdr} for write: $!";
		
		# rewrite the target file
		print $outi $target_file;

		close $outi;
		
	}


}

# populate a type definition
sub make_type
{
	my %h1 = @_;

	die ("no oid")
		unless (exists($h1{with}) &&
				exists($h1{with}->{oid}));

	die ("no tuple")
		unless (exists($h1{tuple}));

	my @deflist;

	# treat bootstrap tables special
	if ($h1{tuple}->{typname} =~ 
		m/^pg\_(type|attribute|proc|class)$/)
	{
		my %boottabdef = (
			typnamespace => "PGNSP", # pg_catalog
			typowner	 => "PGUID", # admin
			typlen         => -1,
			typbyval       => "f",
			typtype        => 'c', # composite
			typisdefined   => "t",
			typdelim       => ',', # except for box which uses ";"
#			typrelid       => 0,
			typelem        => 0,
			typinput       => "record_in",
			typoutput      => "record_out",
			typreceive     => "record_recv",
			typsend        => "record_send",
			typanalyze     => undef,
			typalign       => "d",
			typstorage     => "x",
			typnotnull     => 'f', # not a domain
			typbasetype    => 0,   # not a domain
			typtypmod      => -1,  # not a domain
			typndims       => 0,
			typdefaultbin  => undef,
			typdefault     => undef
			);

		while (my ($kk, $vv) = each(%boottabdef))
		{
			$h1{tuple}->{$kk} = $vv;
		}
		die "no relid"
			unless (exists($h1{with}->{relid}));
		$h1{tuple}->{typrelid} = $h1{with}->{relid};

		goto L_enddef;
	}

	# parse the rest of the definition
	if (exists($h1{at}))
	{
		my @foo = split(/\n/, $h1{at});

		for my $f1 (@foo)
		{
			# XXX XXX: complain about missing/extra commas here?

			# remove spaces and trailing comma
			$f1 =~ s/^\s+//;
			$f1 =~ s/\s+$//;
			$f1 =~ s/\,$//;

			next unless (length($f1));
			push @deflist, $f1;
		}
	}

	# byvalue is false, unless passedbyvalue is set
	$h1{tuple}->{typbyval} = "f";

	for my $def (@deflist)
	{
		if ($def =~ m/passedbyvalue/i)
		{
			$h1{tuple}->{typbyval} = "t";
			next;
		}

		# key = value pairs
		my @baz = split(/\s*=\s*/, $def, 2);
		die "bad def: $def"
			unless (2 == scalar(@baz));

		my $kk = shift @baz;
		my $vv = shift @baz;

		$kk =~ s/^\s+//;
		$kk =~ s/\s+$//;
		$vv =~ s/^\s+//;
		$vv =~ s/\s+$//;

		# get names of regproc functions
		if ($kk =~ m/^(input|output|receive|send|analyze)$/i)
		{
			my $rproc = "typ" . lc($kk); # regproc name

			# XXX XXX: fixup dummy_cast_functions
			$vv =~ s/dummy\_cast\_functions\.//;

			$h1{tuple}->{$rproc} = $vv;
		}

		if ($kk =~ m/^storage$/i)
		{
			die ("bad storage: $vv - must be PLAIN, EXTERNAL, EXTENDED, or MAIN")
				unless ($vv =~ m/^(plain|external|extended|main)$/i);

			# just use first character for storage type...
			my $st1 = lc(substr($vv, 0, 1));

			# ...except for eXtended
			$st1 = "x" if ($vv =~ m/extended/i);
			$h1{tuple}->{typstorage} = $st1;
		}

		if ($kk =~ m/^internallength$/i)
		{
			my $ilen;

			$ilen = $vv;

			$ilen = -1 if ($vv =~ m/^variable$/i);

			# must be a number
			die ("bad length: $vv")
				unless ($ilen =~ m/^(\-)?\d+$/);

			$h1{tuple}->{typlen} = $ilen;
		}

		if ($kk =~ m/^element$/i)
		{
			die ("bad element: $vv")
				unless (exists($h1{typeoidh}) &&
						exists($h1{typeoidh}->{lc($vv)}));

			$h1{tuple}->{typelem} = $h1{typeoidh}->{lc($vv)};
		}

		if ($kk =~ m/^alignment$/i)
		{
			die ("bad aligment: $vv")
				unless ($vv =~ m/^(char|short|int|int2|int4|double)$/);

			# just use first character for alignment...
			$h1{tuple}->{typalign} = lc(substr($vv, 0, 1));

			# ...except for int2 (short)
			$h1{tuple}->{typalign} = "s" if ($vv =~ m/^int2/i);
		}

		if ($kk =~ m/^delimiter$/i)
		{
			my $delim = $vv;

			# remove trailing comma, quotes
			$delim =~ s/\s*\,\s*$//;

			$delim =~ s/\"\s*$//;
			$delim =~ s/^\s*\"//;
			$delim =~ s/\'\s*$//;
			$delim =~ s/^\s*\'//; 

			die ("bad delimiter: $vv")
				unless (1 == length($delim));

			$h1{tuple}->{typdelim} = $delim;
		}

	}

L_enddef:

	return (\%h1);
}# end make_type

# build DATA statements for array types
sub print_arr_type
{
	my $tdef = shift;

	return ""
		unless (exists($tdef->{with}) &&
				exists($tdef->{with}->{arrayoid}));

	my $bigstr = 
		"DATA(insert OID = {arrayoid} (\t_{typname}\t   " .
		"{typnamespace} {typowner} " .
		"-1 f b t " .
		"{typdelim} 0\t" . 
		"{oid} array_in array_out array_recv array_send " .
		"- {typalign} x f 0 -1 0 _null_ _null_ ));";

	my $t2def = {oid => $tdef->{with}->{oid}};
	$t2def->{arrayoid} = $tdef->{with}->{arrayoid};

#	print Data::Dumper->Dump([$tdef]);

	while (my ($kk, $vv) = each(%{$tdef->{tuple}}))
	{
		$t2def->{$kk} = $vv;

		if ($kk =~ m/typdelim/)
		{
			$t2def->{$kk} = sprintf("\\0%o", ord($vv)); 
		}
		if ($kk =~ m/typalign/)
		{
			# typecmds.c:DefineType() "alignment must be 'i' or 'd' for arrays"
			# XXX XXX: alignment is always "int" unless base type is "double"
			$t2def->{$kk} = "i"
				unless ($vv eq "d");
		}
	}
	
	my $fmt = doformat($bigstr, $t2def);

	return $fmt;

} # end print_arr_type

sub print_type
{
	my $tdef = shift;

	my $bigstr = 
		"DATA(insert OID = {oid} (\t{typname}\t   {typnamespace} {typowner} " .
		"{typlen} {typbyval} {typtype} {typisdefined} " .
		"{typdelim} {typrelid}\t" .
		"{typelem} {typinput} {typoutput} {typreceive} {typsend} " .
		"{typanalyze} {typalign} {typstorage} {typnotnull} {typbasetype} " .
		"{typtypmod} {typndims} {typdefaultbin} {typdefault} ));";

	my $t2def = {oid => $tdef->{with}->{oid}};

#	print Data::Dumper->Dump([$tdef]);

	while (my ($kk, $vv) = each(%{$tdef->{tuple}}))
	{
		$t2def->{$kk} = $vv;

		unless (defined($vv))
		{
			$t2def->{$kk} = '_null_';

			# a null regproc is a dash...
			if ($kk =~ m/^typ(input|output|receive|send|analyze)$/)
			{
				$t2def->{$kk} = "-";
			}
		}

		if ($kk =~ m/typdelim/)
		{
			$t2def->{$kk} = sprintf("\\0%o", ord($vv)); 
		}
	}
	
	# XXX XXX: fixup for name
	if ($t2def->{typname} eq "name")
	{
		# 64
		$t2def->{typlen} = "NAMEDATALEN";
	}

	my $fmt = doformat($bigstr, $t2def);

	if (exists($tdef->{with}->{description}))
	{
		$fmt .= "\nDESCR(" . $tdef->{with}->{description} . ");";
	}

	return $fmt;
	
} # end print_type

# MAIN routine for pg_type generation
sub dotypes
{
	
	my $whole_file;
	
	{
        # $$$ $$$ undefine input record separator (\n)
        # and slurp entire file into variable
		
        local $/;
        undef $/;
		
		my $fh;

		open $fh, "< $glob_glob->{typedef}" 
			or die "cannot open $glob_glob->{typedef}: $!";

		$whole_file = <$fh>;
		
		close $fh;
	}
	
	my $wf2 = $whole_file;

	# substitute for all "(.*)" pairs an empty "()" :
	#   for the case where "(" ends a line and ")" begins a line, 
	#   and ".*" does not contain parens
	#

	# This expression converts a CREATE TYPE statement to a single
	# line
	$wf2 =~ s/\((?:\s*)$([^\(\)]*)^\s*\)/()/gsm;

	# strip off the remainder of the CREATE TYPE statement after the type name
	$wf2 =~ s/(^\s*CREATE TYPE\s+(?:\")?\w+(?:\")?)\(\).*/$1/gm;

	# remove DROP TYPE
	$wf2 =~ s/^\s*DROP TYPE.*//gmi;

	# uncomment #defines
	$wf2 =~ s/(^\s*\-\-\s*\#define)/\#define/gmi;

	# uncomment ARRAY TYPE -- will substitute later
	$wf2 =~ s/(^\s*\-\-\s*ARRAY TYPE)/ARRAY TYPE/gmi;

#	$wf2 =~ s|^\s*(\-\-)(\s*$)|$2|gm;

#	$wf2 =~ s|^\s*(\-\-)(.*)(\s*$)|/* $2 */$3|gm;
	$wf2 =~ s|(\-\-)(.*)(\s*$)|/* $2 */$3|gm;

#	$wf2 =~ s|/\*\s+\*/||gm;

#	print $wf2;

	my @lines = split(/\n/, $wf2);

	my %raytypes;

	# convert comments on adjacent lines to block comments
	my $prevline = "";
	my $wf3 = "";
	for my $lin (@lines)
	{
		if ($lin =~ m|^\s*/\*.*\*/|)
		{
			if ($prevline =~ m|\*/\s*$|)
			{
				$prevline =~ s|\*/\s*$||;
				$lin =~ s|(^\s*)/\*|$1\*\*|;
			}
		}
		else
		{
			if ($prevline =~ m|^\s*\*\*.*\*/|)
			{
				$prevline =~ s|\*/\s*$|\n\*/|;
			}
		}

		if ($lin =~ m/^\s*ARRAY TYPE/)
		{
			my @foo = ($lin =~ m/^\s*ARRAY TYPE\s+(.*)/);

			die "bad array type name: $lin"
				unless (scalar(@foo));

			my $atyp = shift @foo;

			# remove quotes
			$atyp =~ s/\"//g; 
			
			die "duplicate array type reference: $atyp"
				if (exists($raytypes{$atyp}));

			$raytypes{$atyp} = -1;
		}

		$wf3 .= $prevline . "\n";
		$prevline = $lin;
	}
	$wf3 .= $prevline . "\n";

#	print $wf3;

	my @alltypes = split(/\;\s*$/m, $whole_file);

	my @alltypedef;

	for my $atyp (@alltypes)
	{
		# filter comments
		$atyp =~ s/^\s*\-\-.*//gm;

		# filter empties
		$atyp =~ s/^\s+$//gm;

		# filter DROP TYPE
		$atyp =~ s/^\s*DROP TYPE.*//i;

		next unless (length($atyp));

		my $raw = $atyp;

		my @baz = ($atyp =~ m/^\s*CREATE TYPE (?:\")?(\w+)(?:\")?/im);

		die "bad type $atyp"
			unless (scalar(@baz));

		my $typname = shift @baz;

		$atyp =~ s/^\s*CREATE TYPE\s+[^\(]*\($//im;
		my $w1 = get_fnwithhash($atyp);

		# match up array oids - 
		# if no match, assume array definition "trails" (immediately
		# follows) the scalar
		my $trailing_array = !(exists($raytypes{$typname}));

		if ($trailing_array)
		{
			# if there isn't a "substitute location" for the array
			# type of this type, then complain if we don't have an
			# ARRAYOID, unless this is a pseudo type, or one of the
			# bootstrap tables.

			unless (exists($w1->{arrayoid}) ||
					(exists($w1->{typtype}) &&
					 ($w1->{typtype} eq "PSEUDO")))
			{
				die "missing ARRAYOID for array type for $typname"
					unless (exists($array_type_exception_h{$typname}))
			}
		}
		else
		{
			die "missing ARRAYOID for array type for $typname"
				unless (exists($w1->{arrayoid}));

			$raytypes{$typname} = $w1->{arrayoid};
		}

		# save the oid for each typename for CREATE TYPE...ELEMENT lookup
		$glob_typeoidh{lc($typname)} = $w1->{oid}
			if (exists($w1->{oid}));
		$glob_typeoidh{"_" . lc($typname)} = $w1->{arrayoid}
			if (exists($w1->{arrayoid}));

		# remove WITH
		$atyp =~ s/^\s*\) WITH .*//i;
		
		my $tdef = {
			typname        => $typname,
			typnamespace => "PGNSP", # pg_catalog
			typowner	 => "PGUID", # admin
#			typlen         => 0,
#			typbyval       => 0,
			typtype        => 'b', # "base" by default
			typisdefined   => 't', # 
			typdelim       => ',', # except for box which uses ";"
			typrelid       => 0,
			typelem        => 0,   # 
			typinput       => undef,
			typoutput      => undef,
			typreceive     => undef,
			typsend        => undef,
			typanalyze     => undef,
#			typalign       => 0,
#			typstorage     => 0,
			typnotnull     => 'f', # not a domain
			typbasetype    => 0,   # not a domain
			typtypmod      => -1,  # not a domain
			typndims       => 0,
			typdefaultbin  => undef,
			typdefault     => undef

		};
		
		# reset typtype from "base" to "pseudo" (or whatever)
		if (exists($w1->{typtype}) && length($w1->{typtype}))
		{
			my $ttt = substr(lc($w1->{typtype}), 0, 1);

			die "invalid type: $w1->{typtype} - valid types are BASE, COMPOSITE, DOMAIN, and PSEUDO"
				unless ($ttt =~ m/^(b|c|d|p)$/);

			$tdef->{typtype} = $ttt;
		}
		if ($tdef->{typtype} eq 'b')
		{
			unless (exists($w1->{arrayoid}))
			{
				die "missing ARRAYOID for array type for $typname"
					unless (exists($array_type_exception_h{$typname}));
			}
		}
			
		my $t1def = {
			tuple => $tdef, raw => $raw, with => $w1, 
			trailing_array => $trailing_array, at=>$atyp};

		push @alltypedef, $t1def;
	} # end for my $atyp

	my @wf4 = split(/\n/, $wf3);

	# finish processing type definitions in second pass 
	#
	# sort the definitions by typename length so global replacement works, 
	# eg replace "timestamptz" before "timestamp"
	for my $t1def 
		(sort {length($b->{tuple}->{typname}) <=> 
				   length($a->{tuple}->{typname})}(@alltypedef))
	{
		my $t2def		 = make_type(%{$t1def}, typeoidh=>\%glob_typeoidh);
		my $ttname		 = $t1def->{tuple}->{typname};
		my $datstatement = print_type($t2def);
		my $arrstatement = print_arr_type($t2def);

		# rather than global replace the ARRAY and CREATE TYPE
		# definitions with a regex, walk the file line by line to
		# place trailing array defs after #defines...
		for my $linnum (0..(scalar(@wf4)-1))
		{
			my $lin = $wf4[$linnum];

			chomp($lin);
			$wf4[$linnum] = $lin;
			next
				unless ($lin =~ m/^\s*(ARRAY|CREATE) TYPE (\")?$ttname(\")?/);

			if ($lin =~ m/^\s*CREATE TYPE/)
			{
				$lin =~ s/^\s*CREATE TYPE $ttname\s*$/$datstatement/;
				$lin =~ s/^\s*CREATE TYPE \"$ttname\"\s*$/$datstatement/;

				if ($t1def->{trailing_array})
				{
					my $nextlin = $linnum + 1;
					
					# the "trailing array" definition immediately
					# follows the scalar definition, unless the scalar
					# is followed by a #define
					if (($nextlin <= (scalar(@wf4)-1)) &&
						($wf4[$nextlin] =~ m/^\s*\#define/))
					{
						$wf4[$nextlin] .= "\n" . $arrstatement;
					}
					else
					{
						$lin .= "\n" . $arrstatement;
					}
				}
			}
			else
			{
				$lin =~ s/^\s*ARRAY TYPE $ttname\s*$/$arrstatement/;
				$lin =~ s/^\s*ARRAY TYPE \"$ttname\"\s*$/$arrstatement/;
			}
			$wf4[$linnum] = $lin;
		} # end for my linnum
	} # end for my t1def

#	print Data::Dumper->Dump([\%raytypes]);
#	print join("\n", @wf4);

    my $verzion = "unknown";
	$verzion = $glob_glob->{_sleazy_properties}->{version}
	if (exists($glob_glob->{_sleazy_properties}) &&
		exists($glob_glob->{_sleazy_properties}->{version}));

	$verzion = $0 . " version " . $verzion;
	my $nnow = localtime;
	my $gen_hdr_str = "";
#	$gen_hdr_str = "/* TIDYCAT_BEGIN_PG_TYPE_GEN \n\n";
	$gen_hdr_str = "\n";
	$gen_hdr_str .= "   WARNING: DO NOT MODIFY THE FOLLOWING SECTION: \n" .
		"   Generated by " . $verzion . "\n" . 
		"   on " . $nnow . "\n\n" . 
		"   Please make your changes in " . $glob_glob->{typedef} . "\n*/\n\n";

	my $bigstr = "";

	$bigstr .= $gen_hdr_str;

	# append generated DATA definitions
	$bigstr .= join("\n", @wf4);

	$bigstr .= "\n\n";

	if (0)
	{
		print $bigstr;
	}
	else
	{
        # $$$ $$$ undefine input record separator (\n)
        # and slurp entire file into variable
		
        local $/;
        undef $/;
		
		my $tfh;

		open $tfh, "< $glob_glob->{typehdr}" 
			or die "cannot open $glob_glob->{typehdr}: $!";

		my $target_file = <$tfh>;
		
		close $tfh;

		my $prefx = quotemeta('TIDYCAT_BEGIN_PG_TYPE_GEN');
		my $suffx = quotemeta('TIDYCAT_END_PG_TYPE_GEN');

		my @zzz = ($target_file =~ 
				   m/^\s*\/\*\s*$prefx\s*\s*$(.*)^\s*\/\*\s*$suffx\s*\*\/\s*$/ms);

		die "bad target: $glob_glob->{typehdr}"
			unless (scalar(@zzz));

		my $rex = $zzz[0];

		# replace carriage returns first, then quotemeta, then fix CR again...
		$rex =~ s/\n/SLASHNNN/gm;
		$rex = quotemeta($rex);
		$rex =~ s/SLASHNNN/\\n/gm;

		# substitute the new generated type definitions for the prior
		# generated defitions in the target file
		$target_file =~ s/$rex/$bigstr/ms;

		# save a backup file
		system "cp $glob_glob->{typehdr} $glob_glob->{typehdr}.backup";

		my $outi;

		open $outi, "> $glob_glob->{typehdr}" 
			or die "cannot open $glob_glob->{typehdr} for write: $!";
		
		# rewrite the target file
		print $outi $target_file;

		close $outi;
		
	}

} # end sub dotypes

if (1)
{
	dotypes();
	doprocs();
}


# SLZY_TOP_BEGIN
if (0)
{
    my $bigstr = <<'EOF_bigstr';
{
   "args" : [
      {
         "alias" : "?",
         "long" : "Print a brief help message and exits.",
         "name" : "help",
         "required" : "0",
         "short" : "brief help message",
         "type" : "untyped"
      },
      {
         "long" : "Prints the manual page and exits.",
         "name" : "man",
         "required" : "0",
         "short" : "full documentation",
         "type" : "untyped"
      },
      {
         "alias" : "prosource|procsource|prosrc|procsrc",
         "long" : "sql definitions for pg_proc functions (normally pg_proc.sql)",
         "name" : "procdef",
         "required" : "1",
         "short" : "sql definitions for pg_proc functions",
         "type" : "file"
      },
      {
         "alias" : "proheader|procheader|prohdr",
         "long" : "header file to modify (normally pg_proc.h).  The original file is copied to a .backup copy.",
         "name" : "prochdr",
         "required" : "1",
         "short" : "header file to modify (procedures)",
         "type" : "file"
      },
      {
         "alias" : "typdef|typesource|typsource|typesrc|typsrc",
         "long" : "sql definitions for pg_type functions (normally pg_type.sql)",
         "name" : "typedef",
         "required" : "1",
         "short" : "sql definitions for pg_type functions",
         "type" : "file"
      },
      {
         "alias" : "typheader|typeheader|typhdr",
         "long" : "header file to modify (normally pg_type.h).  The original file is copied to a .backup copy.",
         "name" : "typehdr",
         "required" : "1",
         "short" : "header file to modify (types)",
         "type" : "file"
      }
   ],
   "long" : "$toplong",
   "properties" : {
      "slzy_date" : 1317671892
   },
   "short" : "generate pg_proc and pg_type entries",
   "version" : "8"
}

EOF_bigstr
}
# SLZY_TOP_END


# SLZY_LONG_BEGIN
if (0)
{
	my $toplong = <<'EOF_toplong';
catullus.pl converts annotated sql CREATE FUNCTION and CREATE TYPE
statements into pg_proc and pg_type entries and updates pg_proc.h and
pg_type.h.

The pg_type definitions are stored in pg_type.sql.  catullus reads
these definitions and outputs DATA statements for loading the pg_type
table.  In pg_type.h, it looks for a block of code delimited by the
tokens TIDYCAT_BEGIN_PG_TYPE_GEN and TIDYCAT_END_PG_TYPE_GEN and
substitutes the new generated code for the previous contents.

The pg_proc definitions are stored in pg_proc.sql.  catullus reads
these definitions and, using type information from pg_type.sql,
generates DATA statements for loading the pg_proc table.  In
pg_proc.h, it looks for a block of code delimited by the tokens
TIDYCAT_BEGIN_PG_PROC_GEN and TIDYCAT_END_PG_PROC_GEN and substitutes
the new generated code for the previous contents.

{HEAD1} CAVEATS/FUTURE WORK

The aggregate transition functions are constructed from CREATE
FUNCTION statements.  But we should really use CREATE AGGREGATE
statements to generate the DATA statements for pg_aggregate and the
pg_proc entries.  A similar limitation exists for window functions in
pg_window.  And operators and operator classes?  Access methods? Casts?

EOF_toplong


}
# SLZY_LONG_END