blob: 91f59de3a0eef868ff74d031c0ea66c403e0b112 [file] [log] [blame]
#!/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.
#
# $Header: //gpsql/feature/hd2.0/private-lili/src/include/catalog/calico.pl#2 $
#
# SLZY_HDR_END
use POSIX;
use Pod::Usage;
use Getopt::Long;
use Data::Dumper;
#use JSON;
use strict;
use warnings;
# SLZY_POD_HDR_BEGIN
# WARNING: DO NOT MODIFY THE FOLLOWING POD DOCUMENT:
# Generated by sleazy.pl version 9 (release Mon Feb 4 13:03:01 2013)
# Make any changes under SLZY_TOP_BEGIN/SLZY_LONG_BEGIN
=head1 NAME
B<calico.pl> - CaQL catalog query code generation
=head1 VERSION
This document describes version 55 of calico.pl, released
Mon Feb 4 13:07:23 2013.
=head1 SYNOPSIS
B<calico.pl>
Options:
-help brief help message
-man full documentation
-interactive Run calico.pl as an interactive shell
-metadata json document describing the catalog
-gperf Construct an input file for gperf
-dump dump the data structures
-logquery turn on logging (elog) for all basic functions
-logquery_hash turn on filter logging
-lockcheck check locking
-readlock check locks for read
-holdtablelock hold table locks until transaction commit
-lockblacklist tables excluded from locking
-lockwhitelist tables covered by locking
-filemap build a json file mapping files to catalog tables
-basedef build a json file of basic caql definitions
-uniqdef build a json file of uniq caql definitions
-inputfiles list of cql input files
=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<-interactive>
Runs calico.pl as an interactive shell
=item B<-metadata> <filename> (Required)
the metadata file is a json document describing the catalog generated by tidycat
=item B<-gperf> <filename>
Construct an input file for gperf
=item B<-dump>
dump the data structures
=item B<-logquery>
Turn on logging (elog) for all basic functions. Use caqltrack.sql to
process these statements from the logs to calculate code coverage.
=item B<-logquery_hash>
turn on filter logging for all basic functions (filter duplicate callers)
=item B<-lockcheck>
acquire locks to prevent write skew
=item B<-readlock>
acquire primary key locks in basic fn prior to read
=item B<-holdtablelock>
Normally, table locks are released at heap_close at caql_endscan.
When this flag is set, the table lock is retained until transaction
commit/abort.
=item B<-lockblacklist>
tables excluded from locking
=item B<-lockwhitelist>
tables covered by locking
=item B<-filemap> <filename>
build a json file mapping source files to catalog tables referenced in cql statements (for pablopcatso)
=item B<-basedef> <filename>
build a json file of basic caql definitions
=item B<-uniqdef> <filename>
build a json file of uniq caql definitions
=item B<-inputfiles> <filename>
file containing list of cql input files (1 per line). If defined, ignores the filenames from the argument list and only processes files listed in the input file.
=back
=head1 DESCRIPTION
calico.pl discovers cql() functions with CaQL statements and generates
the corresponding C functions in catquery.c. It acts as a compiler,
parsing CaQL, a small, SQL-like query language, and it generates the
corresponding low-level heap/index lookup functions, or CaQL "basic
queries". At runtime, the cql functions use a hash of the CaQL
statement to dispatch to the associated "basic query" function.
The CaQL parsing and code generation is driven by the tidycat json
metadata file, which describes the catalog tables, their indexes and
dependencies.
=head2 INSERT/UPDATE Syntax
CaQL has been extended to handle INSERT and UPDATE.
=head2 Locking
The readlock/lockcheck options use the tidycat dependency information
(JSON) to generate the insert/update/delete ("iud") locking functions.
Without locking, concurrent transactions can cause catalog corruption,
e.g the case where one transaction does CREATE TABLE in a schema and a
concurrent transaction DROPs the schema. The caql_lockwell() function
locks the "primary key" index(es) and any associated foreign key
indexes, ensuring that referential integrity is maintained.
=head1 CAVEATS/FUTURE WORK
=head2 External Catalog
After the entire catalog is converted to CaQL, we should be able to
restructure the system to support a single, external catalog. At this
stage we may switch from calico code generation to a direct
implementation of catquery as an external catalog API.
=head2 Catalog Bloat
Need to restructure the catalog to eliminate bloat.
=head1 AUTHORS
Apache HAWQ
Address bug reports and comments to: dev@hawq.apache.org
=cut
# SLZY_POD_HDR_END
# SLZY_GLOB_BEGIN
my $glob_id = "";
my $glob_glob;
# SLZY_GLOB_END
sub glob_validate
{
# map files to catalog tables
$glob_glob->{fil2tab} = {};
# look for JSON on normal path, but if it isn't there, add the
# directory containing this script and look for it there...
unless (eval "require JSON")
{
use FindBin qw($Bin);
use lib "$Bin";
unless (eval "require JSON")
{
die("Fatal Error: The required package JSON is not installed -- please download it from www.cpan.org\n");
exit(1);
}
}
# readlock implies general lockcheck
$glob_glob->{lockcheck} = 1
if (exists($glob_glob->{readlock})
&& ($glob_glob->{readlock}));
# DO NOT extend this list! These tables are *exempt* from the
# autogenerated primary locking mechanism for historical reasons.
#
my @pklock_exception_tables =
qw(
pg_class
pg_authid
pg_largeobject
pg_statistic
pg_stat_last_operation
pg_stat_last_shoperation
gp_distribution_policy
pg_depend
pg_shdepend
pg_description
pg_shdescription
);
# build locking whitelist and blacklist
my $blacklist = {};
for my $tname (@pklock_exception_tables)
{
$blacklist->{$tname} = 1;
}
if (exists($glob_glob->{lockblacklist})
&& defined($glob_glob->{lockblacklist}))
{
my @foo = split(/,/, $glob_glob->{lockblacklist});
for my $tname (@foo)
{
$blacklist->{$tname} = 1;
}
}
$glob_glob->{lock_exceptions} = {blacklist => $blacklist};
if (exists($glob_glob->{lockwhitelist})
&& defined($glob_glob->{lockwhitelist}))
{
my @foo = split(/,/, $glob_glob->{lockwhitelist});
my $whitelist = {};
for my $tname (@foo)
{
die "table $tname cannot be on both " .
"lockwhitelist and lockblacklist"
if (exists($blacklist->{$tname}));
$whitelist->{$tname} = 1;
}
$glob_glob->{lock_exceptions}->{whitelist} = $whitelist
if (scalar(@foo));
}
# print Data::Dumper->Dump([\$glob_glob]);
}
# SLZY_CMDLINE_BEGIN
# WARNING: DO NOT MODIFY THE FOLLOWING SECTION:
# Generated by sleazy.pl version 9 (release Mon Feb 4 13:03:01 2013)
# 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_interactive = 0; # Run calico.pl as an interactive shell
my $s_metadata; # json document describing the catalog
my $s_gperf; # Construct an input file for gperf
my $s_dump = 0; # dump the data structures
my $s_logquery = 0; # turn on logging (elog) for all basic functions
my $s_logquery_hash = 0; # turn on filter logging
my $s_lockcheck = 0; # check locking
my $s_readlock = 0; # check locks for read
my $s_holdtablelock = 0; # hold table locks until transaction commit
my $s_lockblacklist; # tables excluded from locking
my $s_lockwhitelist; # tables covered by locking
my $s_filemap; # build a json file mapping files to catalog tables
my $s_basedef; # build a json file of basic caql definitions
my $s_uniqdef; # build a json file of uniq caql definitions
my $s_inputfiles; # list of cql input files
my $slzy_argv_str;
$slzy_argv_str = quotemeta(join(" ", @ARGV))
if (scalar(@ARGV));
GetOptions(
'help|?' => \$s_help,
'man' => \$s_man,
'interactive' => \$s_interactive,
'metadata|json=s' => \$s_metadata,
'gperf|perf:s' => \$s_gperf,
'dump' => \$s_dump,
'logquery|elog' => \$s_logquery,
'logquery_hash' => \$s_logquery_hash,
'lockcheck' => \$s_lockcheck,
'readlock' => \$s_readlock,
'holdtablelock|holdlock' => \$s_holdtablelock,
'lockblacklist|lbl:s' => \$s_lockblacklist,
'lockwhitelist|lwl:s' => \$s_lockwhitelist,
'filemap:s' => \$s_filemap,
'basedef:s' => \$s_basedef,
'uniqdef:s' => \$s_uniqdef,
'inputfiles|infiles:s' => \$s_inputfiles,
)
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} = '55';
$glob_glob->{_sleazy_properties}->{AUTHORNAME} = 'Jeffrey I Cohen';
$glob_glob->{_sleazy_properties}->{BUGEMAIL} = 'Address bug reports and comments to: jcohen@greenplum.com';
$glob_glob->{_sleazy_properties}->{COPYDATES} = '2011, 2012, 2013';
$glob_glob->{_sleazy_properties}->{COPYHOLDER} = 'Greenplum';
$glob_glob->{_sleazy_properties}->{slzy_date} = '1360012043';
$glob_glob->{_sleazy_properties}->{slzy_argv_str} = $slzy_argv_str;
die ("missing required argument for 'metadata'")
unless (defined($s_metadata));
if (defined($s_metadata))
{
die ("invalid argument for 'metadata': file $s_metadata does not exist")
unless (-e $s_metadata);
}
if (defined($s_inputfiles))
{
die ("invalid argument for 'inputfiles': file $s_inputfiles does not exist")
unless (-e $s_inputfiles);
}
$glob_glob->{interactive} = $s_interactive if (defined($s_interactive));
$glob_glob->{metadata} = $s_metadata if (defined($s_metadata));
$glob_glob->{gperf} = $s_gperf if (defined($s_gperf));
$glob_glob->{dump} = $s_dump if (defined($s_dump));
$glob_glob->{logquery} = $s_logquery if (defined($s_logquery));
$glob_glob->{logquery_hash} = $s_logquery_hash if (defined($s_logquery_hash));
$glob_glob->{lockcheck} = $s_lockcheck if (defined($s_lockcheck));
$glob_glob->{readlock} = $s_readlock if (defined($s_readlock));
$glob_glob->{holdtablelock} = $s_holdtablelock if (defined($s_holdtablelock));
$glob_glob->{lockblacklist} = $s_lockblacklist if (defined($s_lockblacklist));
$glob_glob->{lockwhitelist} = $s_lockwhitelist if (defined($s_lockwhitelist));
$glob_glob->{filemap} = $s_filemap if (defined($s_filemap));
$glob_glob->{basedef} = $s_basedef if (defined($s_basedef));
$glob_glob->{uniqdef} = $s_uniqdef if (defined($s_uniqdef));
$glob_glob->{inputfiles} = $s_inputfiles if (defined($s_inputfiles));
glob_validate();
}
# SLZY_CMDLINE_END
# 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"
},
{
"long" : "Runs calico.pl as an interactive shell",
"name" : "interactive",
"required" : "0",
"short" : "Run calico.pl as an interactive shell",
"type" : "untyped"
},
{
"alias" : "json",
"long" : "the metadata file is a json document describing the catalog generated by tidycat",
"name" : "metadata",
"required" : "1",
"short" : "json document describing the catalog",
"type" : "file"
},
{
"alias" : "perf",
"long" : "Construct an input file for gperf",
"name" : "gperf",
"required" : "0",
"short" : "Construct an input file for gperf",
"type" : "outfile"
},
{
"long" : "dump the data structures",
"name" : "dump",
"required" : "0",
"short" : "dump the data structures",
"type" : "untyped"
},
{
"alias" : "elog",
"long" : "$loglong",
"name" : "logquery",
"required" : "0",
"short" : "turn on logging (elog) for all basic functions",
"type" : "untyped"
},
{
"long" : "turn on filter logging for all basic functions (filter duplicate callers)",
"name" : "logquery_hash",
"required" : "0",
"short" : "turn on filter logging",
"type" : "untyped"
},
{
"long" : "acquire locks to prevent write skew",
"name" : "lockcheck",
"required" : "0",
"short" : "check locking",
"type" : "untyped"
},
{
"long" : "acquire primary key locks in basic fn prior to read",
"name" : "readlock",
"required" : "0",
"short" : "check locks for read",
"type" : "untyped"
},
{
"alias" : "holdlock",
"long" : "$holdlocklong",
"name" : "holdtablelock",
"required" : "0",
"short" : "hold table locks until transaction commit",
"type" : "untyped"
},
{
"alias" : "lbl",
"name" : "lockblacklist",
"required" : "0",
"short" : "tables excluded from locking",
"type" : "string"
},
{
"alias" : "lwl",
"name" : "lockwhitelist",
"required" : "0",
"short" : "tables covered by locking",
"type" : "string"
},
{
"long" : "build a json file mapping source files to catalog tables referenced in cql statements (for pablopcatso)",
"name" : "filemap",
"required" : "0",
"short" : "build a json file mapping files to catalog tables",
"type" : "outfile"
},
{
"name" : "basedef",
"required" : "0",
"short" : "build a json file of basic caql definitions",
"type" : "outfile"
},
{
"name" : "uniqdef",
"required" : "0",
"short" : "build a json file of uniq caql definitions",
"type" : "outfile"
},
{
"alias" : "infiles",
"long" : "file containing list of cql input files (1 per line). If defined, ignores the filenames from the argument list and only processes files listed in the input file.",
"name" : "inputfiles",
"required" : "0",
"short" : "list of cql input files",
"type" : "file"
}
],
"long" : "$toplong",
"properties" : {
"AUTHORNAME" : "Jeffrey I Cohen",
"BUGEMAIL" : "Address bug reports and comments to: jcohen@greenplum.com",
"COPYDATES" : "2011, 2012, 2013",
"COPYHOLDER" : "Greenplum",
"slzy_date" : 1360012043
},
"short" : "CaQL catalog query code generation",
"version" : "55"
}
EOF_bigstr
}
# SLZY_TOP_END
# SLZY_LONG_BEGIN
if (0)
{
my $toplong = <<'EOF_toplong';
calico.pl discovers cql() functions with CaQL statements and generates
the corresponding C functions in catquery.c. It acts as a compiler,
parsing CaQL, a small, SQL-like query language, and it generates the
corresponding low-level heap/index lookup functions, or CaQL "basic
queries". At runtime, the cql functions use a hash of the CaQL
statement to dispatch to the associated "basic query" function.
The CaQL parsing and code generation is driven by the tidycat json
metadata file, which describes the catalog tables, their indexes and
dependencies.
{HEAD2} INSERT/UPDATE Syntax
CaQL has been extended to handle INSERT and UPDATE.
{HEAD2} Locking
The readlock/lockcheck options use the tidycat dependency information
(JSON) to generate the insert/update/delete ("iud") locking functions.
Without locking, concurrent transactions can cause catalog corruption,
e.g the case where one transaction does CREATE TABLE in a schema and a
concurrent transaction DROPs the schema. The caql_lockwell() function
locks the "primary key" index(es) and any associated foreign key
indexes, ensuring that referential integrity is maintained.
{HEAD1} CAVEATS/FUTURE WORK
{HEAD2} External Catalog
After the entire catalog is converted to CaQL, we should be able to
restructure the system to support a single, external catalog. At this
stage we may switch from calico code generation to a direct
implementation of catquery as an external catalog API.
{HEAD2} Catalog Bloat
Need to restructure the catalog to eliminate bloat.
EOF_toplong
my $loglong = <<'EOF_loglong';
Turn on logging (elog) for all basic functions. Use caqltrack.sql to
process these statements from the logs to calculate code coverage.
EOF_loglong
my $holdlocklong = <<'EOF_holdlocklong';
Normally, table locks are released at heap_close at caql_endscan.
When this flag is set, the table lock is retained until transaction
commit/abort.
EOF_holdlocklong
}
# SLZY_LONG_END
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]);
if (exists($blankprefix{$k2}))
{
# print STDERR Data::Dumper->Dump(\@foo);
# print STDERR Data::Dumper->Dump([\%blankprefix]);
die "duplicate use of prefixed pattern $k2 for\n$bigstr"
unless ($blankprefix{$k2} eq $zzz[0]);
}
# 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;
}
# only allow alphanums, and quote all other chars as hex string
sub sql_func_quurl
{
my $str = shift;
$str =~ s/([^a-zA-Z0-9])/uc(sprintf("%%%02lx", ord $1))/eg;
return $str;
}
# more "relaxed" version of quurl function -- allow basic punctuation
# with the exception of "%" and quote characters
sub sql_func_quurl2
{
my $str = shift;
my $pat1 = '[^a-zA-Z0-9' .
quotemeta(' ~!@#$^&*()-_=+{}|[]:;<>,.?/') . ']';
$str =~ s/($pat1)/uc(sprintf("%%%02lx", ord $1))/eg;
return $str;
}
# unconvert quoted strings
sub sql_func_unquurl
{
my $str = shift;
$str =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
return $str;
}
sub scanhdr
{
my $bigstr = <<'EOF_bigstr';
SysScanDesc {SCAN};
{RELATIONDEF}
{HEAPTUPLEDEF}
EOF_bigstr
return $bigstr;
} # end scanhdr
sub scankeyinit
{
my $bigstr = <<'EOF_bigstr';
ScanKeyInit(&{KEY}[{KEYOFFSET}],
{ANUMKEYCOL},
BTEqualStrategyNumber, {FMGREQOID},
{KVTRANSFORM}({KEYVAL}));
EOF_bigstr
return $bigstr;
} # end scankeyinit
sub readpkeyhashinit
{
my $bigstr = <<'EOF_bigstr';
newhash = caql_pkhash(pCtx, newhash, ({KEYVAL}),
false /* isnull */, {MHTYPOID});
EOF_bigstr
return $bigstr;
} # end readkpeyhashinit
sub idxokfunc
{
my $bigstr = <<'EOF_bigstr';
/* always use the index (if possible) unless the caller states otherwise */
if (!pCtx->cq_setidxOK)
pCtx->cq_useidxOK = true;
EOF_bigstr
return $bigstr;
}
sub nosyscacheid
{
my $bigstr = <<'EOF_bigstr';
Assert (!pCtx->cq_usesyscache);
pCtx->cq_usesyscache = false; /* complain in debug, work in production */
EOF_bigstr
return $bigstr;
}
sub syscacheid
{
my $bigstr = <<'EOF_bigstr';
/* always use the syscache unless the caller states otherwise */
if (!pCtx->cq_setsyscache)
{
pCtx->cq_usesyscache = true;
/* Normally, must match all columns of the index to use syscache,
* except for case of SearchSysCacheList
*/
if (!pCtx->cq_bCacheList && (pCtx->cq_NumKeys != {NUMSYSCACHEIDXCOLS}))
pCtx->cq_usesyscache = false;
/* ARD-28, MPP-16119: can only use SnapshowNow with syscache */
if (pCtx->cq_snapshot != SnapshotNow)
{
/* Complain in debug, but behave in production */
Assert(!pCtx->cq_usesyscache);
pCtx->cq_setsyscache = true;
pCtx->cq_usesyscache = false;
}
}
if (pCtx->cq_usesyscache)
{
pCtx->cq_cacheId = {SYSCACHEIDENTIFIER};
/* number of keys must match (unless a SearchSysCacheList ) */
Assert(pCtx->cq_bCacheList || (pCtx->cq_NumKeys == {NUMSYSCACHEIDXCOLS}));
}
/* else perform heap/index scan */
EOF_bigstr
return $bigstr;
} # end syscacheid
sub syscachetupdesc
{
my $bigstr = <<'EOF_bigstr';
/* XXX XXX : NOTE: disable heap_open/lock for syscache
only if : no external lock mode or external relation
*/
if ((!pCtx->cq_setlockmode) &&
pCtx->cq_usesyscache &&
(AccessShareLock == pCtx->cq_lockmode))
{
pCtx->cq_externrel = true; /* pretend we have external relation */
pCtx->cq_heap_rel = InvalidRelation;
/*
pCtx->cq_tupdesc = SysCache[pCtx->cq_cacheId]->cc_tupdesc;
*/
return NULL; /* XXX XXX: return early - don't open heap */
}
else
EOF_bigstr
return $bigstr;
} # end syscachetupdesc
## ARD-27: check lock strength for query/update in caql basic functions
sub rel_lock_test
{
my $bigstr = <<'EOF_bigstr';
/* test lock strength */
if ((!pCtx->cq_setlockmode) &&
RelationIsValid(pCtx->cq_heap_rel))
{
LOCKMODE mode = pCtx->cq_lockmode;
LOCKMASK gm =
LockRelationOid_GetGrantMask(
RelationGetRelid(pCtx->cq_heap_rel),
"{FUNCNAME}");
for (; mode < MAX_LOCKMODES; mode++)
{
if (gm & LOCKBIT_ON(mode))
break;
}
Assert(gm & LOCKBIT_ON(mode));
}
EOF_bigstr
return $bigstr;
} # end rel_lock_test
sub beginscan
{
my $bigstr = <<'EOF_bigstr';
systable_beginscan({REL},
{INDEX},
{INDEXOK},
{SNAPSHOT}, {KEYNUM}, {KEY});
EOF_bigstr
return $bigstr;
} # end beginscan
sub nextscan
{
my $bigstr = "systable_getnext({SCAN})";
return $bigstr;
} # end nextscan
sub endscan
{
my $bigstr = "systable_endscan({SCAN})";
return $bigstr;
} # end endscan
sub scanfuncbody
{
my $bigstr = <<'EOF_bigstr';
void
{FUNCNAME}({FUNCARGS})
{
{SCANHDR}
{OPENREL}
{SCANKEYINIT}
{SCAN} = {BEGINSCAN}
{TUPLELOOPGUTS}
/* Clean up after the scan */
{ENDSCAN}
{CLOSEREL}
}
EOF_bigstr
return $bigstr;
} # end scanfuncbody
# XXX XXX:
# NOTE: logging function requires cql filename, lineno for debug
#
sub selectfrom_elog_hash
{
my $bigstr = <<'EOF_bigstr';
SUPPRESS_ERRCONTEXT_DECLARE;
SUPPRESS_ERRCONTEXT_PUSH();
if (gp_enable_caql_logging)
{
CaQLLogTag caqllogtag;
CaQLLogEntry *entry;
int hashcode;
int len;
bool found = false;
/* memset caqllogtag is needed, as memcmp is done during hash_search_with_hash_value */
MemSet(&caqllogtag, 0, sizeof(caqllogtag));
len = (strlen(pcql->filename) > MAXPGPATH ? MAXPGPATH : strlen(pcql->filename));
memcpy(caqllogtag.filename, pcql->filename, len);
caqllogtag.lineno = pcql->lineno;
/* compute the hash */
hashcode = caqlLogHashCode(&caqllogtag);
/* look up the hash table to see if this line has been logged before */
entry = (CaQLLogEntry *) hash_search_with_hash_value(CaQLLogHash,
(void *)&caqllogtag,
hashcode,
HASH_ENTER, &found);
if (!found)
elog(LOG, "catquery: %s caller: %s %d %d %d ",
"{FUNCNAME}", pcql->filename, pcql->lineno, pCtx->cq_uniqquery_code,
DatumGetObjectId(pcql->cqlKeys[0])
);
}
SUPPRESS_ERRCONTEXT_POP();
EOF_bigstr
return $bigstr;
}
# NOTE WELL: always pass the first argument (pcql->cqlKeys[0] as an OID,
# even if it isn't one (or doesn't exist!). We will sort it out
# later during log processing
sub selectfrom_elog
{
my $bigstr = <<'EOF_bigstr';
caql_logquery("{FUNCNAME}", pcql->filename, pcql->lineno, pCtx->cq_uniqquery_code,
DatumGetObjectId(pcql->cqlKeys[0]));
EOF_bigstr
return $bigstr;
}
# lock entire table if cannot use primary keys
# (used for both read and insert case)
sub readinsert_entiretable_exclusive
{
my $bigstr = <<'EOF_bigstr';
/* cannot get primary key lock -- {READPK_FAILREASON} */
if (pCtx->cq_setpklock)
{
LOCKMODE pklockmode = AccessExclusiveLock;
bool dontWait = false;
if (!pCtx->cq_pklock_excl)
pklockmode = AccessShareLock;
caql_lock_entiretable(pCtx, {RELATIONID},
pklockmode, dontWait);
}
EOF_bigstr
return $bigstr;
}
# share lock entire table (if necessary) if *can* use primary keys
# (used for both read and insert case)
sub readinsert_entiretable_share
{
my $bigstr = <<'EOF_bigstr';
/*
if any caql statement on {RELATIONID} cannot use a
primary key, then need to obtain a share lock
(to block the table exclusive lock)
*/
if (bLockEntireTable)
caql_lock_entiretable(pCtx, {RELATIONID},
AccessShareLock, false);
EOF_bigstr
return $bigstr;
}
sub get_readpk
{
my $bigstr = <<'EOF_bigstr';
/* can get primary key lock for read: {LW_TNAME}({COLSTR}) */
if (pCtx->cq_setpklock)
{
LOCKMODE pklockmode = AccessExclusiveLock;
bool dontWait = false;
Oid newhash = 0;
if (!pCtx->cq_pklock_excl)
pklockmode = AccessShareLock;
{READPK_ENTIRETABLE}
{READPK_INIT}
caql_lockwell(pCtx, {RELATIONID},
pklockmode, NULL,
"{LW_TNAME}",
"{COLSTR}",
{INDEX},
newhash,
dontWait,
true /* ignore invalid tuple */
);
/* XXX XXX: disable syscache because it might need to be invalidated!! */
// pCtx->cq_setsyscache = true;
// pCtx->cq_usesyscache = false;
AcceptInvalidationMessages(); /* syscache could be out of date after lock wait */
}
EOF_bigstr
return $bigstr;
}
sub selectfrom
{
my $selguts = <<'EOF_bigstr';
static
SysScanDesc
{FUNCNAME}({FUNCARGS})
{
{SCANHDR}
Relation rel;
{SELECTFROM_ELOG}
{GET_READPK}
{SYSCACHECHECK}
pCtx->cq_relationId = {RELATIONID};
if (!pCtx->cq_externrel)
{
{SYSCACHETUPDESC}
{
pCtx->cq_heap_rel = heap_open(pCtx->cq_relationId,
pCtx->cq_lockmode);
pCtx->cq_tupdesc = RelationGetDescr(pCtx->cq_heap_rel);
}
}
else
{
/* make sure the supplied relation matches the caql */
if (RelationIsValid(pCtx->cq_heap_rel))
{
Assert({RELATIONID} ==
RelationGetRelid(pCtx->cq_heap_rel));
pCtx->cq_tupdesc = RelationGetDescr(pCtx->cq_heap_rel);
}
{RELLOCKTEST}
}
rel = pCtx->cq_heap_rel;
if (pCtx->cq_usesyscache) return NULL; /* XXX XXX: don't init scan */
{SCANKEYINIT}
{SCAN} = {BEGINSCAN}
return ({SCAN});
}
EOF_bigstr
return $selguts;
} # end selectfrom
sub deletefrom
{
my $loopguts = <<'EOF_bigstr';
/* Delete all the matching tuples */
while (HeapTupleIsValid({TUPLE} = {NEXTSCAN}))
{
if (HeapTupleIsValid({TUPLE}))
simple_heap_delete({REL}, &{TUPLE}->t_self);
}
EOF_bigstr
return doformat(scanfuncbody(),
{
TUPLELOOPGUTS => $loopguts
});
} # end deletefrom
sub duplicate_obj
{
my $loopguts = <<'EOF_bigstr';
{TUPLE} = {NEXTSCAN};
if (HeapTupleIsValid({TUPLE}))
ereport(ERROR,
(errcode(ERRCODE_DUPLICATE_OBJECT),
errmsg({DUPOBJEXISTSMSG})
errOmitLocation(true)));
EOF_bigstr
return doformat(scanfuncbody(),
{
TUPLELOOPGUTS => $loopguts
});
} # end duplicate_obj
sub undef_obj
{
my $loopguts = <<'EOF_bigstr';
{TUPLE} = {NEXTSCAN};
if (!HeapTupleIsValid({TUPLE}))
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_OBJECT),
errmsg({UNDEFOBJNOTEXISTMSG})
errOmitLocation(true)));
EOF_bigstr
return doformat(scanfuncbody(),
{
TUPLELOOPGUTS => $loopguts
});
} # end undef_obj
# construct a basic function for an INSERT
#
# 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 XXX XXX
#
# Note that if locking is enabled (as a calico option), and
# bLockEntireTable is set, then always lock the table Share (really
# Intent Exclusive) if the table has a primary key, or Exclusive if
# the table does *not* have a primary key. Unlike basic functions
# which fetch tuples (SELECT/DELETE), the INSERT *always* gets a lock
# with the IUD functions, so the basic function for INSERT does *not*
# use cq_setpklock to control lock acquistion.
#
# 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 XXX XXX
sub insertinto
{
my $insertguts = <<'EOF_bigstr';
static
SysScanDesc
{FUNCNAME}({FUNCARGS})
{
Relation rel;
{SELECTFROM_ELOG}
pCtx->cq_relationId = {RELATIONID};
{INSERTPK_ENTIRETABLE}
if (!pCtx->cq_externrel)
{
{SYSCACHETUPDESC}
{
pCtx->cq_heap_rel = heap_open(pCtx->cq_relationId,
pCtx->cq_lockmode);
pCtx->cq_tupdesc = RelationGetDescr(pCtx->cq_heap_rel);
}
}
else
{
/* make sure the supplied relation matches the caql */
if (RelationIsValid(pCtx->cq_heap_rel))
{
Assert({RELATIONID} ==
RelationGetRelid(pCtx->cq_heap_rel));
pCtx->cq_tupdesc = RelationGetDescr(pCtx->cq_heap_rel);
}
{RELLOCKTEST}
}
rel = pCtx->cq_heap_rel;
return NULL; /* XXX XXX: don't init scan */
}
EOF_bigstr
return $insertguts;
} # end insertinto
sub unique_index_by_cols
{
my ($bigh, $tname, $colstr) = @_;
return undef
unless (exists($bigh->{$tname}->{indexes}));
my @ikeylist;
my $idxl = $colstr;
$idxl =~ s/^\s+//;
$idxl =~ s/\s+$//;
if ($idxl =~ m/\,/)
{
@ikeylist = split(/\s*\,\s*/, $idxl)
}
else
{
# single key
push @ikeylist, $idxl;
}
# print "$tname, $colstr\n";
my $cola;
for my $idx (@{$bigh->{$tname}->{indexes}})
{
# print Data::Dumper->Dump(\@ikeylist);
# print Data::Dumper->Dump([$idx]);
next
unless (exists($idx->{unique}) &&
$idx->{unique});
next unless (scalar(@{$idx->{cols}}) == scalar(@ikeylist));
# print Data::Dumper->Dump([$idx]);
my $bMatch;
$cola = [];
$bMatch = 1;
# match keys
for my $ii (0..(scalar(@ikeylist)-1))
{
# list of [colname, col_ops]
#
# so match colname in position 0
my $col = $idx->{cols}->[$ii];
unless ($col->[0] eq $ikeylist[$ii])
{
$bMatch = 0;
last;
}
push @{$cola}, { name => $col->[0], ops => $col->[1] };
}
return [$idx->{CamelCaseIndexId}, $cola]
if ($bMatch);
}
return undef;
}
# choose an index which can satisfy the predicate.
# If bexact=true, then index cols must match predicate col order
# (for ORDER BY)
sub choose_index
{
my ($bigh, $tname, $wpred, $bexact) = @_;
return undef
unless (exists($bigh->{$tname}->{indexes}));
my $numkeys = scalar(@{$wpred});
my %pkeyh; # hash of key col names
for my $pred (@{$wpred})
{
$pkeyh{$pred->{key}} = 1;
}
# for all indexes with matching key columns, build a hash of lists
# of matching indexes (hash by total keys in index). We want the
# "best fit", ie the index has the same number of key columns as
# the predicate.
my %indbynumkey;
for my $inds (@{$bigh->{$tname}->{indexes}})
{
my $matchcol;
my $icolnum;
$matchcol = 0;
$icolnum = scalar(@{$inds->{cols}});
# don't check indexes with insufficient key columns
next
if ($icolnum < $numkeys);
# for my $icol (@{$inds->{cols}})
for my $jj (0..(scalar(@{$inds->{cols}})-1))
{
my $icol = $inds->{cols}->[$jj];
# index prefix must match keys. If it does, increment the
# match count. If all keys are matched then this index is
# a candidate, even if it has extra trailing columns.
if ($bexact)
{
# for an *exact* match, key col order must match predicate
last unless ($icol->[0] eq $wpred->[$jj]->{key});
}
last unless (exists($pkeyh{$icol->[0]}));
$matchcol++;
}
# skip unless found all columns in index
next
unless ($matchcol == $numkeys);
$indbynumkey{$icolnum} = []
unless (exists($indbynumkey{$icolnum}));
my $iih =
{CamelCaseIndexId => $inds->{CamelCaseIndexId}};
$iih->{unique} = 1
if (exists($inds->{unique}) && $inds->{unique});
# if this table is a "dependent class" of the parent table,
# then we can lock the primary key of the parent if we aren't
# using all the columns of our index.
$iih->{primarykey_prefix} = $inds->{primarykey_prefix}
if (exists($inds->{primarykey_prefix}));
# predicate matches all columns of index
# (necessary for syscache or pkey locking)
$iih->{allcols} = 1
if ($icolnum == $numkeys);
$iih->{numcols} = $icolnum;
# can use the syscache iff match all cols of index
if (exists($inds->{with}->{syscacheid}) &&
($icolnum == $numkeys))
{
$iih->{SysCacheIdentifier} = $inds->{with}->{syscacheid};
}
push @{$indbynumkey{$icolnum}}, $iih;
}
return undef
unless (scalar(keys(%indbynumkey)));
# walk the set of matching indexes. Best case is exact prefix
# match, ie the index columns are the same as the predicate key
# cols. But we will accept any case with key prefix. First match
# wins. Assume max 10 keys in index.
for my $ii ($numkeys..10)
{
next unless (exists($indbynumkey{$ii}));
# first one is good enough
return $indbynumkey{$ii}->[0];
}
return undef;
} # end choose_index
sub check_oby_index
{
my ($bigh, $tname, $iname, $wpred) = @_;
die "bad oby index: $iname - no indexes on $tname"
unless (exists($bigh->{$tname}->{indexes}));
my $numkeys = scalar(@{$wpred});
my $iih;
for my $inds (@{$bigh->{$tname}->{indexes}})
{
next unless ($iname eq $inds->{CamelCaseIndexId});
my $icolnum = scalar(@{$inds->{cols}});
# NOTE: same logic as choose_index()
$iih =
{CamelCaseIndexId => $inds->{CamelCaseIndexId}};
$iih->{unique} = 1
if (exists($inds->{unique}) && $inds->{unique});
# if this table is a "dependent class" of the parent table,
# then we can lock the primary key of the parent if we aren't
# using all the columns of our index.
$iih->{primarykey_prefix} = $inds->{primarykey_prefix}
if (exists($inds->{primarykey_prefix}));
# predicate matches all columns of index
# (necessary for syscache or pkey locking)
$iih->{allcols} = 1
if ($icolnum == $numkeys);
$iih->{numcols} = $icolnum;
# XXX XXX: for ORDER BY case, we might use the syscache even
# if all the index columns *don't* match, for
# SearchSysCacheList -- use check of "allcols" to determine
# validity
$iih->{SysCacheIdentifier} = $inds->{with}->{syscacheid}
if (exists($inds->{with}->{syscacheid}));
last;
}
die "bad oby index: $iname"
unless (defined($iih));
return $iih;
} # end check_oby_index
# build hash of fixed fields for all tables/structs
sub getfixedfields
{
my $bigh = shift;
# known list of basic variable length types (a bit of overkill,
# since only need to worry about bootstrap)
my @variable =
qw(
anyarray
anytable
bit
bpchar
bytea
cidr
inet
int2vector
numeric
oidvector
path
polygon
record
refcursor
text
varbit
varchar
xml
);
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# NOTE: Add timestamp with timezone because they make me
# nervous -- treat them as variable length to prevent GETSTRUCT
# issues...
# push @variable, "time";
push @variable, "timestamp_with_timezone";
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
my $varitype = join("|", @variable);
my $ffh = {};
while (my ($kk, $vv) = each(%{$bigh}))
{
my $tname = $kk;
next # ignore comments
if ($tname =~ m/^\_\_/);
my $cols = [];
my $ii;
$ii = 0;
my $lastfixed = 0;
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# MPP-17159: hack pg_extprotocol to deal with NULLs in fixed part
if ($tname eq "pg_extprotocol")
{
$lastfixed = 1;
}
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
for my $coldef (@{$vv->{cols}})
{
my $isvari = (($coldef->{sqltype} =~ m/^($varitype)$/) ||
# no arrays
($coldef->{sqltype} =~ m/\[\]$/));
unless ($lastfixed)
{
if ($isvari)
{
$lastfixed = $ii + 1;
}
}
$ii++;
push @{$cols}, {
colname => $coldef->{colname},
attnum => $ii,
ctype => $coldef->{ctype},
sqltype => $coldef->{sqltype},
fixed =>
($isvari || ($lastfixed && ($lastfixed <= $ii))) ? 0 : 1
};
}
$ffh->{$tname} = {
tname => $tname,
relid => $vv->{CamelCaseRelationId},
maxfixedattnum => $lastfixed,
cols => $cols
};
} # end while kk,vv
return $ffh;
} # end getfixedfields
sub colops2typoid
{
my $colops = shift;
$colops =~ s/\_ops//;
$colops = uc($colops);
$colops .= "OID";
$colops = "INT8OID"
if ($colops =~ m/BIGINTOID/);
return $colops;
}
# convert a column name to an "Anum_" column id
sub anum_key
{
my ($tname, $wkey) = @_;
my $atname = $tname;
# 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: stupid last_operation/shoperation fixup
if ($tname =~ m/pg\_stat\_last_(sh)?operation/)
{
$atname =~ s/eration$//;
$atname =~ s/stat\_last\_/statlast/;
}
if ($tname =~ m/gp_distribution_policy/)
{
$atname =~ s/distribution\_//;
}
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
return "Anum_" . $atname . "_" . $wkey;
}
sub struct_form_tname
{
my $tname = shift;
my $atname = $tname;
# 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: stupid last_operation/shoperation fixup
if ($tname =~ m/pg\_stat\_last_(sh)?operation/)
{
$atname =~ s/eration$//;
$atname =~ s/stat\_last\_/statlast/;
}
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
return "Form_" . $atname;
}
# returns true if table is a locking exception (no locks required),
# else false. If the blacklist exists, it takes precedence over the
# whitelist. All blacklisted tables are excluded from locking. If
# there *isn't* a whitelist, all tables that are *not* on the
# blacklist are implicitly on the whitelist. If there *is* a
# whitelist, all tables that are *not* on the whitelist are implicitly
# on the blacklist.
sub check_locking_exception
{
my $tname = shift;
return 0
unless (exists($glob_glob->{lock_exceptions}));
if (exists($glob_glob->{lock_exceptions}->{blacklist}))
{
return 1
if ($glob_glob->{lock_exceptions}->{blacklist}->{$tname});
}
# if a white list exists, and the table is *not* on it, treat it
# as an exception.
if (exists($glob_glob->{lock_exceptions}->{whitelist}))
{
return 1
unless ($glob_glob->{lock_exceptions}->{whitelist}->{$tname});
}
# if we get here:
# the table wasn't blacklisted.
# if we had a whitelist, the table must be on it (because if
# the table wasn't on it function should have returned TRUE
# already)
return 0;
} # end check_locking_exception
# build C function for caql query expressions
sub dothing
{
my ($bigh, $qry, $funcname, $bqh) = @_;
my $filerr = "";
my $filenames = "";
# build list of filenames for this basic query
if (defined($bqh) && exists($bqh->{files}))
{
$filenames = join("\n\t",
(keys(%{$bqh->{files}})));
}
$filerr = "\nfiles: $filenames"
if (defined($filenames) && length($filenames));
# error msg: basic query + all files that reference it
my $qerr = $qry . $filerr;
$funcname = "foo"
unless (defined($funcname));
my $tname;
my $domethod;
my $where1;
my ($wkey, $wval, $wcmp);
my $bAllEq = 1; # set false if find a non-equal comparison
if ($qry =~ m/^\s*(delete|undef|dup|select)/i)
{
my @foo =
($qry =~
m/(delete|undef|dup|select\s+\*)\s+from\s+(\w*)(?:\s+where)?/);
die "bad tname for $qerr" unless (2 == scalar(@foo));
$domethod = shift @foo;
$domethod = "select"
if ($domethod =~ m/^select/);
$tname = shift @foo;
}
elsif ($qry =~ m/^\s*insert\s+into/i)
{
my @foo =
($qry =~
m/^\s*insert\s+into\s+(\w*)/i);
die "bad tname for $qerr" unless (1 == scalar(@foo));
$domethod = "insert";
$tname = shift @foo;
}
else
{
die "bad cql: $qerr";
}
# map the files back to the catalog tables (for pablopcatso)
if (defined($bqh) && exists($bqh->{files}))
{
use File::Basename;
for my $k1 (keys(%{$bqh->{files}}))
{
my $fnam = basename($k1);
# XXX XXX: fix analyze
if ($fnam eq "analyze.c")
{
if ($k1 =~ m|commands/analyze|)
{
$fnam = "commands/analyze";
}
elsif ($k1 =~ m|parser/analyze|)
{
$fnam = "parser/analyze";
}
else
{
die "$k1 - yet another analyze.c!";
}
}
$glob_glob->{fil2tab}->{$fnam} = {}
unless (exists($glob_glob->{fil2tab}->{$fnam}));
$glob_glob->{fil2tab}->{$fnam}->{$tname} = 1;
}
}
my $obyidx;
# Extract index for ORDER BY if specified
if ($qry =~ m/ORDER\_BY.*$/)
{
my @foo = ($qry =~ m/ORDER\_BY(.*)$/);
$obyidx = shift @foo;
# Trim to leave SELECT ... WHERE ...
$qry =~ s/ORDER\_BY.*$//;
$obyidx =~ s/^\s+//;
$obyidx =~ s/\s+$//;
}
if ($qry =~ m/where.*$/i)
{
my @foo = ($qry =~ m/where\s+(.*)\s*(?:\;)?/);
die "bad WHERE clause for $qerr" unless (scalar(@foo));
# print Data::Dumper->Dump(\@foo);
$where1 = shift @foo;
}
my (@wpred, @wpred2);
if (defined($where1))
{
my $kvrex =
# NOTE: allow more types of comparison than equality
#
# key = (or other comparison) :bindnum
'\s*(\w+)\s*(\=|\<\=|\>\=|\>|\<)\s*\:(\d+)\s*';
die "bad WHERE clause for: $qerr"
unless ($where1 =~ m/$kvrex/);
my @baz;
push @baz, $where1;
# build list of predicates if have "k1=v1 AND k2=v2..."
if ($where1 =~ m/\s+AND\s+/i)
{
@baz = split(/\s+AND\s+/i, $where1);
}
for my $pred (@baz)
{
# allow key = val, key <= val, key > val, etc
my @foo = ($pred =~ m/$kvrex/);
die "bad WHERE clause: $where1"
unless (3 == scalar(@foo));
$wkey = shift @foo;
$wcmp = shift @foo;
$wval = "arg" . shift @foo;
unless ($wcmp =~ m/^\=/)
{
$bAllEq = 0; # not an equality comparison
}
push @wpred, {key => $wkey, val => $wval, cmp => $wcmp};
}
}
die "no such tname $tname: $qerr" unless (exists($bigh->{$tname}));
my $realindex = "";
my $uniqueidx = 0; # index is unique
my $allcolidx = 0; # predicate uses all columns of index
my $numidxcols = 0; # number of columns in index
my $prefixidx; # primary key prefix index (if it exists)
my $syscacheid = "";
my $indexname = "InvalidOid"; # set to realindex if find it
my $fmgreqoid = "";
my $kvtransfm = "";
my $anumkeycol = "";
my $relationid = "";
my $wktyp;
if (exists($bigh->{$tname}->{CamelCaseRelationId}) &&
length($bigh->{$tname}->{CamelCaseRelationId}))
{
$relationid = $bigh->{$tname}->{CamelCaseRelationId};
}
else
{
die "no relationid $tname: $qerr";
}
$bqh->{tablename} = $tname; # for do_iud
if (exists($bigh->{$tname}->{fk_list}))
{
$bqh->{foreign_key_tables} = {}
unless (exists($bqh->{foreign_key_tables}));
for my $fk (@{$bigh->{$tname}->{fk_list}})
{
my $pktname = $fk->{pktable};
my $fkentry = "(" . join(", ", @{$fk->{pkcols}}) . ") <- (" .
join(", ", @{$fk->{fkcols}}) . ")";
$fkentry .= " [vector]"
if ($fk->{type} =~ m/vector/i);
# set of local fk cols for tname
$bqh->{foreign_key_tables}->{$pktname} = {}
unless (exists($bqh->{foreign_key_tables}->{$pktname}));
$bqh->{foreign_key_tables}->{$pktname}->{$fkentry} = 1;
}
}
if (scalar(@wpred))
{
for my $pred (@wpred)
{
$wkey = $pred->{key};
die "no type for $wkey! : $qerr"
unless (exists($bigh->{$tname}->{colh}->{$wkey}));
$anumkeycol = anum_key($tname, $wkey);
# oid column is system column (usually)
if (($wkey eq 'oid') &&
(exists($bigh->{$tname}->{with}->{oid})) &&
($bigh->{$tname}->{with}->{oid}))
{
$anumkeycol = 'ObjectIdAttributeNumber';
}
$wktyp = $bigh->{$tname}->{colh}->{$wkey};
# NOTE: convert regproc to oid, namedata to name
if ($wktyp =~ m/regproc/)
{
$wktyp = "oid";
}
# XXX XXX: CHECK THIS -- from gp_fastsequence
if ($wktyp =~ m/bigint/)
{
$wktyp = "int8";
}
$fmgreqoid = "F_" . uc($wktyp) . "EQ";
$fmgreqoid =~ s/NAMEDATA/NAME/;
if ($wktyp =~ m/oid/i)
{
$kvtransfm = "ObjectIdGetDatum";
}
if ($wktyp =~ m/name/i)
{
$kvtransfm = "NameGetDatum";
}
if ($wktyp =~ m/int2/i)
{
$kvtransfm = "Int16GetDatum";
}
$pred->{anumkeycol} = $anumkeycol;
$pred->{fmgreqoid} = $fmgreqoid;
$pred->{wktyp} = $wktyp;
$pred->{kvtransfm} = $kvtransfm;
} # end for my pred
my $iih = choose_index($bigh, $tname, \@wpred);
# if we had an ORDER BY, use that matching index instead
if (defined($obyidx))
{
$iih = check_oby_index($bigh, $tname, $obyidx, \@wpred);
}
if (defined($iih))
{
$realindex = $iih->{CamelCaseIndexId}
if (exists($iih->{CamelCaseIndexId}));
$syscacheid = $iih->{SysCacheIdentifier}
if (exists($iih->{SysCacheIdentifier}));
$uniqueidx = 1
if (exists($iih->{unique}));
$allcolidx = 1
if (exists($iih->{allcols}));
die "bad index -- no numcols"
unless (exists($iih->{numcols}));
$numidxcols = $iih->{numcols};
}
else
{
$realindex = undef;
$syscacheid = undef;
}
if (defined($realindex))
{
$bqh->{func_index} = $realindex;
}
else
{
$realindex = "";
}
# rebuild the WHERE predicate list. If we have an index,
# re-order it, else just use the original
if (!length($realindex))
{
push @wpred2, @wpred;
}
else
{
my $numkeys = scalar(@wpred);
my %pkeyh; # hash of key col names
for my $pred (@wpred)
{
$pkeyh{$pred->{key}} = $pred;
}
for my $inds (@{$bigh->{$tname}->{indexes}})
{
next
unless ($realindex eq $inds->{CamelCaseIndexId});
# NOTE: rebuild the WHERE clause predicate column list in
# index key column order
for my $jj (0..($numkeys-1))
{
my $icol = $inds->{cols}->[$jj];
$wpred2[$jj] = $pkeyh{$icol->[0]};
}
last;
}
}
# if this table is a "dependent class" of the parent table,
# then we can lock the primary key of the parent if we aren't
# using all the columns of our index.
# NOTE: first column must have equality comparison, but strict
# equality for all columns is not necessary
if (defined($iih) &&
($wpred2[0]->{cmp} =~ m/^\=/) &&
length($realindex) &&
!($uniqueidx && $allcolidx) &&
(exists($iih->{primarykey_prefix})))
{
$prefixidx = $iih->{primarykey_prefix};
$bqh->{func_note} .=
"index " . $prefixidx->{pktname} . "(" .
$prefixidx->{pkcolname} . ") <" .
$prefixidx->{pkidx} . "> is a prefix of \n\t" .
"index " . $tname . "(" .
$prefixidx->{fkcolname} . ", ...) <" .
$realindex . ">\n";
}
} # end if scalar wpred
my $funcargs = "cqContext *pCtx, cq_list *pcql, bool bLockEntireTable";
my $indexok = "pCtx->cq_useidxOK";
if (scalar(@wpred2))
{
if (length($realindex))
{
$indexname = $realindex;
}
else
{
$indexok = "false";
}
}
else
{
$indexok = "false";
}
# for optional arguments, strip out these lines from the final string
my $stripout = '/* **stripout** */';
# my $stripout = '';
my $striprex = quotemeta($stripout);
my $basicargs =
{
FUNCNAME => $funcname,
FUNCARGS => $funcargs,
INDEX => $indexname,
INDEXOK => $indexok,
UNIQUEIDX => $uniqueidx,
KEY => "pCtx->cq_scanKeys",
KEYNUM => scalar(@wpred2),
REL => "rel",
SCAN => "scan",
TUPLE => "tuple",
# SNAPSHOT => "SnapshotNow",
SNAPSHOT => "pCtx->cq_snapshot",
RELATIONID => $relationid,
RELATIONDEF => $stripout,
HEAPTUPLEDEF => $stripout,
OPENREL => $stripout,
CLOSEREL => $stripout,
KEYVAL => $wval
};
# turn on lock checking if lockcheck is on
$basicargs->{RELLOCKTEST} = (exists($glob_glob->{lockcheck}) &&
$glob_glob->{lockcheck}) ?
rel_lock_test() : $stripout;
my $scankeyinit = "";
my $readpk_init = ""; # readpk and lw_colstr for primary key readlock
my $lw_colstr = "";
if ($domethod !~ m/sel/i)
{
$basicargs->{HEAPTUPLEDEF} = "HeapTuple tuple;";
}
for my $ii (0..(scalar(@wpred2)-1))
{
my $pred2 = $wpred2[$ii];
my $currscankey;
$wkey = $pred2->{key};
$wval = $pred2->{val};
$wcmp = $pred2->{cmp};
$basicargs->{KEYOFFSET} = $ii;
$basicargs->{ANUMKEYCOL} = $pred2->{anumkeycol};
$basicargs->{FMGREQOID} = $pred2->{fmgreqoid};
$basicargs->{KVTRANSFORM} = $pred2->{kvtransfm};
# build type oid for caql_pkhash()
$basicargs->{MHTYPOID} = uc($pred2->{wktyp}) . "OID";
$basicargs->{MHTYPOID} =~ s/NAMEDATA/NAME/; # NAMEOID
if ($domethod =~ m/sel/i)
{
$basicargs->{KVTRANSFORM} = "";
$basicargs->{KEYVAL} = "pCtx->cq_datumKeys[$ii]";
}
# build a ScanKeyInit(...) statement
$currscankey =
doformat(scankeyinit(),
$basicargs
);
# fix comparison for inequality
unless ($wcmp =~ m/^\=/)
{
if ($wcmp =~ m/^\<\=/)
{
$currscankey =~
s/BTEqualStrategyNumber/BTLessEqualStrategyNumber/;
$currscankey =~ s/EQ\,/LE,/;
}
elsif ($wcmp =~ m/^\>\=/)
{
$currscankey =~
s/BTEqualStrategyNumber/BTGreaterEqualStrategyNumber/;
$currscankey =~ s/EQ\,/GE,/;
}
elsif ($wcmp =~ m/^\</)
{
$currscankey =~
s/BTEqualStrategyNumber/BTLessStrategyNumber/;
$currscankey =~ s/EQ\,/LT,/;
}
elsif ($wcmp =~ m/^\>/)
{
$currscankey =~
s/BTEqualStrategyNumber/BTGreaterStrategyNumber/;
$currscankey =~ s/EQ\,/GT,/;
}
}
# NOTE: special case for "primarykey_prefix"/"dependent class"
# -- build the caql_pkhash(...) statement for a single column
if (defined($prefixidx) &&
!length($lw_colstr))
{
# NOTE: only one column for this case, and we store the
# results in prefixidx (instead of readpk_init).
$prefixidx->{READPK_INIT} =
doformat(readpkeyhashinit(),
$basicargs
);
}
# build a "column string" for caql_lockwell()
$lw_colstr .= ", " if (length($lw_colstr));
$lw_colstr .= $wkey;
# initialize the hash for the primary key lock
# -- build the caql_pkhash(...) statement
$readpk_init .=
doformat(readpkeyhashinit(),
$basicargs
);
$scankeyinit .= $currscankey;
# XXX XXX: do something about stupid KEYVAL swizzling...
$basicargs->{KEYVAL} = $wval;
$scankeyinit .= "\n";
} # end for my ii
$scankeyinit .= "\n";
# store the ScanKeyInit(...) and caql_pkhash(...) initializations
$basicargs->{SCANKEYINIT} = $scankeyinit;
$basicargs->{READPK_INIT} = $readpk_init;
# special case if can use SysCache to satisfy query
$basicargs->{SYSCACHEIDENTIFIER} = $syscacheid;
$basicargs->{NUMSYSCACHEIDXCOLS} = $numidxcols;
if (!$bAllEq)
{
$bqh->{func_note} .= "WHERE clause is not strict equality\n";
if (defined($syscacheid) && length($syscacheid))
{
$bqh->{func_note} .= "Could not use syscache due to inequality\n";
}
}
else
{
# NOTE: even if WHERE clause is strict equality, syscache is
# only valid if predicate matches *all* columns of index,
# *or* if basic function is invoked by SearchSysCacheList()
if (defined($syscacheid) && length($syscacheid) && !$allcolidx)
{
$bqh->{func_note} .=
"Predicate does not match all index columns " .
"( " . scalar(@wpred2) . " != " . $numidxcols . " ),\n" .
"can only use syscache for SearchSysCacheList case\n";
}
}
# logging code
if ($glob_glob->{logquery} || $glob_glob->{logquery_hash})
{
$basicargs->{SELECTFROM_ELOG} =
doformat(selectfrom_elog(),
$basicargs,
);
}
else
{
$basicargs->{SELECTFROM_ELOG} = $stripout;
}
# set up read locks if possible
if (!(exists($glob_glob->{readlock}) && $glob_glob->{readlock}))
{
$basicargs->{GET_READPK} = $stripout;
$basicargs->{READPK_ENTIRETABLE} = $stripout;
$basicargs->{INSERTPK_ENTIRETABLE} = $stripout;
}
else # build read locks
{
my $bException = 0;
# XXX XXX NOTE: locking exceptions
# 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: stupid last_operation/shoperation fixup, etc
$bException = check_locking_exception($tname);
# build caql_lock_entiretable(...) statement for insert.
#
# if the table has any primary key, just need a share lock on
# the entire table, else need an exclusive lock first
#
if (!$bException &&
($domethod =~ m/insert/i))
{
if (exists($bigh->{$tname}->{calico}) &&
exists($bigh->{$tname}->{calico}->{pkeys}) &&
(scalar(@{$bigh->{$tname}->{calico}->{pkeys}}) > 0))
{
# get share lock on entire table (if necessary)
$basicargs->{INSERTPK_ENTIRETABLE} =
doformat(readinsert_entiretable_share(),
$basicargs,
);
}
else
{
$basicargs->{READPK_FAILREASON} =
"no primary keys for $tname";
$basicargs->{INSERTPK_ENTIRETABLE} =
doformat(readinsert_entiretable_exclusive(),
$basicargs,
);
$bqh->{func_note} .=
"WARNING: insert operation not protected with pk lock!!\n";
$bigh->{$tname}->{calico}->{lock_entire_table} = 1;
}
}
if ($bException)
{
$basicargs->{READPK_FAILREASON} = "exception for $tname";
$basicargs->{GET_READPK} =
"/* no table lock - exception for $tname */\n";
$basicargs->{READPK_ENTIRETABLE} =
"/* no table lock - exception for $tname */\n";
$basicargs->{INSERTPK_ENTIRETABLE} =
"/* no table lock - exception for $tname */\n";
}
elsif (!defined($prefixidx) &&
(!$bAllEq || !length($readpk_init) ||
(!$uniqueidx) || (!$allcolidx)
))
{
if (!length($readpk_init) || !length($realindex))
{
$basicargs->{READPK_FAILREASON} = "no primary key index";
}
elsif (!$uniqueidx)
{
$basicargs->{READPK_FAILREASON} = "index not unique";
}
elsif (!$allcolidx)
{
$basicargs->{READPK_FAILREASON} = "partial match of index cols";
}
elsif (!$bAllEq)
{
$basicargs->{READPK_FAILREASON} = "inequality in index lookup";
}
$basicargs->{GET_READPK} =
doformat(readinsert_entiretable_exclusive(),
$basicargs,
);
# NOTE: don't consider "tablename" exceptions for locking
# case -- they are protected by other locks
if (($bqh->{num_upd_ops} || $bqh->{num_del_ops}) &&
!$bException &&
(!$bAllEq || !length($readpk_init) ||
(!$uniqueidx) || (!$allcolidx)
))
{
$bqh->{func_note} .=
"WARNING: update/delete operation not protected with pk lock!!\n";
$bigh->{$tname}->{calico}->{lock_entire_table} = 1;
}
}
else
{
my $real_iname = $basicargs->{INDEX};
my $real_relid = $basicargs->{RELATIONID};
# build caql_lock_entiretable(...) statement
$basicargs->{READPK_ENTIRETABLE} =
doformat(readinsert_entiretable_share(),
$basicargs,
);
if (!defined($prefixidx))
{
$basicargs->{LW_TNAME} = $tname;
$basicargs->{COLSTR} = $lw_colstr;
}
else
{
$basicargs->{INDEX} = $prefixidx->{pkidx};
$basicargs->{RELATIONID} = $prefixidx->{pkrelid};
$basicargs->{LW_TNAME} = $prefixidx->{pktname};
$basicargs->{COLSTR} = $prefixidx->{pkcolname};
$basicargs->{READPK_INIT} = $prefixidx->{READPK_INIT};
$bqh->{func_note} .= "Primary key Locking using index " .
$prefixidx->{pkidx} . " on " .
$prefixidx->{pktname} . "\n\tinstead of " .
$real_iname . "\n";
}
$basicargs->{GET_READPK} =
doformat(get_readpk(),
$basicargs,
);
# restore the index name and relation id
$basicargs->{INDEX} = $real_iname;
$basicargs->{RELATIONID} = $real_relid;
}
}
# can only use syscache for equality primary key lookup
if (defined($syscacheid) && length($syscacheid) && $bAllEq)
{
$bqh->{syscacheid} = $syscacheid;
$basicargs->{SYSCACHECHECK} =
doformat(syscacheid(),
$basicargs,
);
# and special tuple descriptors
$basicargs->{SYSCACHETUPDESC} =
doformat(syscachetupdesc(),
$basicargs,
);
}
else # must not use SysCache
{
$basicargs->{SYSCACHECHECK} =
doformat(nosyscacheid(),
$basicargs,
);
$basicargs->{SYSCACHETUPDESC} = "";
}
# add the indexOK check for non-heapscan case
if ($indexok !~ m/false/)
{
$basicargs->{SYSCACHECHECK} .=
doformat(idxokfunc(),
$basicargs,
);
}
$basicargs->{SCANHDR} =
doformat(scanhdr(),
$basicargs,
);
# cleanup whitespace in scanheader
$basicargs->{SCANHDR} =~ s/^\s*$striprex\s*$//gm;
$basicargs->{SCANHDR} =~ s/^(\s*)$striprex(.*)$/$1$2/gm;
$basicargs->{SCANHDR} =~ s/^(\s*)$//gm;
$basicargs->{BEGINSCAN} =
doformat(beginscan(),
$basicargs,
);
$basicargs->{NEXTSCAN} =
doformat(nextscan(),
$basicargs,
);
$basicargs->{ENDSCAN} =
doformat(endscan(),
$basicargs,
);
my $bigstr;
if ($domethod =~ m/sel/i)
{
$bigstr =
doformat(selectfrom(),
$basicargs
);
}
if ($domethod =~ m/del/i)
{
$bigstr =
doformat(deletefrom(),
$basicargs
);
}
elsif ($domethod =~ m/dup/i)
{
$bigstr =
doformat(duplicate_obj(),
$basicargs
);
}
elsif ($domethod =~ m/undef/i)
{
$bigstr =
doformat(undef_obj(),
$basicargs
);
}
elsif ($domethod =~ m/insert/i)
{
$bigstr =
doformat(insertinto(),
$basicargs
);
}
$bigstr =~ s/^\s*$striprex\s*$//gm;
$bigstr =~ s/^(\s*)$striprex(.*)$/$1$2/gm;
return $bigstr;
} # end dothing
# build insert/update/delete validation functions
sub do_iud
{
my ($bigh, $qry, $funcname, $bqh) = @_;
my @fktablist;
my @pktablist;
my @uniqidxlist; # uniq index list "indexname: col1, col2..."
my %uniqidxh; # hash by idx name
my $tname = $bqh->{tablename};
my $trelid = $bigh->{$tname}->{CamelCaseRelationId};
my $shlockwell_str = "/* No Share Locks Acquired */";
if (exists($bqh->{foreign_key_tables}))
{
for my $fktab (sort(keys(%{$bqh->{foreign_key_tables}})))
{
# XXX XXX NOTE: IUD Exceptions - fix these!!
# 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: gp_relation_node
if ($fktab =~ m/(gp_relation_node)/)
{
next;
}
for my $fkentry (sort(keys(%{$bqh->{foreign_key_tables}->{$fktab}})))
{
push @fktablist,
$fktab . " " . $fkentry;
}
}
}
my $idxstr = "/* ZERO indexes */";
my $xlockwell_str = "/* Cannot obtain exclusive lock on tuple !! */";
if (exists($bigh->{$tname}))
{
# NOTE: built in bigh_fk_fixup()
if (exists($bigh->{$tname}->{pk_dependent}))
{
for my $pktab (sort(keys(%{$bigh->{$tname}->{pk_dependent}})))
{
# XXX XXX NOTE: IUD Exceptions - fix these!!
# 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: gp_relation_node
if ($pktab =~ m/(gp_relation_node)/)
{
next;
}
# potentially multiple fk references to tname in
# dependent table
for my $pkl (sort(keys(%{$bigh->{$tname}->{pk_dependent}->{$pktab}})))
{
push @pktablist,
$pktab . " " . $pkl;
}
}
}
if (exists($bigh->{$tname}->{indexes}))
{
for my $idx (@{$bigh->{$tname}->{indexes}})
{
if (exists($idx->{unique})
&& length($idx->{unique})
&& ($idx->{unique}))
{
my $colstr;
my $cola = [];
$colstr = "";
for my $col (@{$idx->{cols}})
{
$colstr .= ", "
if (length($colstr));
$colstr .= $col->[0];
push @{$cola}, { name => $col->[0], ops => $col->[1] };
}
$colstr = $idx->{CamelCaseIndexId} . ": " . $colstr;
push @uniqidxlist, $colstr;
$uniqidxh{$idx->{CamelCaseIndexId}} = $cola;
}
}
if (scalar(@uniqidxlist))
{
$idxstr = "/*\n" .
scalar(@uniqidxlist) . " unique index";
# plural
$idxstr .=
((scalar(@uniqidxlist) > 1) ? "es:\n" : ":\n");
$idxstr .= join("\n", @uniqidxlist) . "\n*/";
$xlockwell_str = "";
for my $idxl (@uniqidxlist)
{
my $lockwellidxid;
#
# indexid:<space> key1[, key2...]
#
my @zzz = split(/\:\s*/, $idxl, 2);
die "bad index list: $idxl"
unless (2 == scalar(@zzz));
$lockwellidxid = $zzz[0];
$idxl = $zzz[1];
die "bad index: $lockwellidxid"
unless (exists($uniqidxh{$lockwellidxid}));
my $lw_makehash = "";
my $colinfo = $uniqidxh{$lockwellidxid};
for my $cola (@{$colinfo})
{
$lw_makehash .=
doformat(caql_makehash(),
{
MHTYPOID =>
colops2typoid($cola->{ops}),
MHATTNUM =>
(("oid" eq $cola->{name}) ?
'ObjectIdAttributeNumber' :
anum_key($tname, $cola->{name}))
}
);
}
my $lockwellh = {
# TABLERELID => "RelationGetRelid(pCtx->cq_heap_rel)",
TABLERELID => $bigh->{$tname}->{CamelCaseRelationId},
# LOCKMODE => "AccessExclusiveLock",
LOCKMODE => "pklockmode",
LW_TNAME => $tname,
COLSTR => $idxl,
LOCKWELL_IDX => $lockwellidxid,
LOCKWELL_MAKEHASH => $lw_makehash,
};
# build a string, but don't specify tuple
my $basic_lockwell_str .=
doformat(caql_iud_lockwell(),
$lockwellh);
# build two strings -- one for newtup, other for oldtup
$lockwellh->{TUPLE} = "newtup";
$lockwellh->{HASHVAR} = "newhash";
$lockwellh->{LOCKWELL_HASHKEY} = "newhash";
$lockwellh->{LOCKWELL_HASHKEY2} = "newhash";
my $l1 =
doformat($basic_lockwell_str,
$lockwellh);
$lockwellh->{TUPLE} = "oldtup";
$lockwellh->{HASHVAR} = "oldhash";
$lockwellh->{LOCKWELL_HASHKEY} = "oldhash";
$lockwellh->{LOCKWELL_HASHKEY2} = "oldhash";
my $l2 =
doformat($basic_lockwell_str,
$lockwellh);
$xlockwell_str .= $l1 . $l2;
} # end for my idxl
}
else
{
$idxstr = "/*\nZERO unique indexes\n*/";
}
}
}
my $rex1 = '(gp\_distribution\_policy)|(pg\_authid)';
# XXX XXX NOTE: IUD Exceptions
# 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: stupid last_operation/shoperation fixup
if ($tname =~ m/pg\_stat\_last\_(sh)?operation/)
{
@fktablist = ();
@pktablist = ();
$xlockwell_str = "/* $tname: do not get exclusive lock */";
}
if ($tname =~ m/$rex1/)
{
$xlockwell_str = "/* $tname: do not get exclusive lock */";
}
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
if (scalar(@fktablist) &&
($tname !~ m/$rex1/))
{
$shlockwell_str = "";
for my $fktab1 (@fktablist)
{
my $fktab = $fktab1 . ""; # copy the string so we can modify it
# XXX XXX: special case for oidvector or oid array
my $isvector = ($fktab =~ m/\[vector\]/);
$fktab =~ s/\s*\[vector\]\s*//; # remove it
#
# tablename<space>(pk1[, pk2...]) <- (fk1[, fk2...])
#
my @foo = split(/\s+/, $fktab, 2); # first part is tablename
die "bad fktab: $fktab"
unless (2 == scalar(@foo));
# tricky nomenclature -- tname is our table, fktname is the
# foreign key table, but we need the primary key of that table.
my $fktname = $foo[0];
my $fkrelid = $bigh->{$fktname}->{CamelCaseRelationId};
#
# (pk1[, pk2...]) <- (fk1[, fk2...])
#
# get key list (pk/fk)
my @baz = split(/\s+\<\-\s+/, $foo[1], 2);
die "bad fktab2: $fktab"
unless (2 == scalar(@baz));
my $pk_colstr = $baz[0];
# remove lead/trailing parentheses
$pk_colstr =~ s/^\s*\(\s*//;
$pk_colstr =~ s/\s*\)\s*$//;
my @lockwell_keys;
my @ikeylist;
my $idxl = $baz[1];
# remove lead/trailing parentheses
$idxl =~ s/^\s*\(\s*//;
$idxl =~ s/\s*\)\s*$//;
if ($idxl =~ m/\,/)
{
@ikeylist = split(/\s*\,\s*/, $idxl)
}
else
{
# single key
push @ikeylist, $idxl;
}
# need the type of vector (oidvector or oid array) in
# order to distinguish the DatumGet<blah>() method in
# caql_iud_lockwell_oidvector()
my $isvector_type;
if ($isvector)
{
die "invalid vector has > 1 col"
unless (1 == scalar(@ikeylist));
# get the type by colname (only one for this case)
$isvector_type = $bigh->{$tname}->{colh}->{$ikeylist[0]};
}
# NOTE: 5 keys max
for my $ii (0..4)
{
if (defined($ikeylist[$ii]))
{
my $kk = $ikeylist[$ii];
$kk =~ s/^\s+//;
$kk =~ s/\s+$//;
if ($kk =~ m/^oid$/)
{
# Oid column
$kk = "ObjectIdAttributeNumber";
}
else
{
# attribute column
$kk = anum_key($tname, $kk);
}
push @lockwell_keys, $kk;
}
else
{
push @lockwell_keys, "InvalidAttrNumber";
}
}
# find the indexid for the unique index with those columns
my $lockwellidxid;
my $lockwellidxid_a =
unique_index_by_cols($bigh,
$fktname,
$pk_colstr
);
my $lw_makehash = "{ d = 0; isnull = 0; }";
if (defined($lockwellidxid_a))
{
my $colinfo = $lockwellidxid_a->[1];
$lockwellidxid = $lockwellidxid_a->[0];
$lw_makehash = "";
if (!$isvector)
{
for my $cola (@{$colinfo})
{
my $attnum = shift @lockwell_keys;
$lw_makehash .=
doformat(caql_makehash(),
{
MHTYPOID =>
colops2typoid($cola->{ops}),
MHATTNUM => $attnum
}
);
}
}
else
{
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# NOTE: the vector case is slightly funky --
# we build the LOCKWELL_MAKEHASH def for
# caql_iud_lockwell_oidvector(), but it's slightly
# different from the caql_makehash() definition
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
my $attnum = shift @lockwell_keys;
$lw_makehash .=
doformat(
"d = caql_getattr_internal(pCtx, {TUPLE}, \n" .
" {MHATTNUM},\n" .
" &isnull);\n" ,
{
MHATTNUM => $attnum
}
);
}
}
else
{
# no index found
$lockwellidxid = "InvalidOid";
}
my $lockwellh = {
TABLERELID => $fkrelid,
LOCKMODE => "AccessShareLock",
LW_TNAME => $fktname,
COLSTR => $pk_colstr,
LOCKWELL_IDX => $lockwellidxid,
LOCKWELL_MAKEHASH => $lw_makehash,
LW_GETDATUM => "DatumGetPointer", # for oidvector case
LW_VEC_OR_ARRAY => "vector", # for oidvector case.
};
# NOTE: oidvector is fixed length,
# but oid array *could* be toasted...
if ($isvector)
{
# if not oidvector, must be array (eg "Oid[1]")
if ($isvector_type !~ /vector/i)
{
$lockwellh->{LW_GETDATUM} = "DatumGetArrayTypeP";
$lockwellh->{LW_VEC_OR_ARRAY} = " array";
}
}
# build a string, but don't specify tuple
my $basic_lockwell_str .=
doformat(($isvector ?
caql_iud_lockwell_oidvector() :
caql_iud_lockwell()),
$lockwellh);
# build two strings -- one for newtup, other for oldtup
$lockwellh->{TUPLE} = "newtup";
$lockwellh->{HASHVAR} = "newhash";
$lockwellh->{LOCKWELL_HASHKEY} = "newhash";
$lockwellh->{LOCKWELL_HASHKEY2} = "newhash";
my $l1 =
doformat($basic_lockwell_str,
$lockwellh);
$lockwellh->{TUPLE} = "oldtup";
$lockwellh->{HASHVAR} = "oldhash";
$lockwellh->{LOCKWELL_HASHKEY} = "oldhash";
$lockwellh->{LOCKWELL_HASHKEY2} = "oldhash";
my $l2 =
doformat($basic_lockwell_str,
$lockwellh);
$shlockwell_str .= $l1 . $l2;
} # end for my fktab
}
my $bh_str = doformat(
caql_iud_buildhash(),
{
IUD_BH_TUP => "oldtup",
IUD_BH_VAL => "oldhash"
});
$bh_str .= doformat(
caql_iud_buildhash(),
{
IUD_BH_TUP => "newtup",
IUD_BH_VAL => "newhash"
});
my $iud_args = {
IUD_FUNC_NAME => $funcname,
IUD_TNAME => $tname,
IUD_BUILDHASH => $bh_str,
IUD_FKTABS => join("\n", @fktablist),
IUD_PKTABS => join("\n", @pktablist),
IUD_IDX => $idxstr,
IUD_IDX_XLOCKWELL => $xlockwell_str, # exclusive locks
IUD_SHLOCKWELL => $shlockwell_str, # share locks
};
$iud_args->{IUD_DELETE} = "";
# for INSERT only, don't construct a delete case
## if ($qry !~ m/\s*insert/i)
if (1) # XXX XXX XXX XXX XXX
{
if (scalar(@pktablist))
{
# have some foreign keys
$iud_args->{IUD_DELETE} =
doformat(caql_iud_delete(),
$iud_args);
$iud_args->{IUD_DELETE} .= "\n";
for my $pktab (@pktablist)
{
# XXX XXX:
next if ($pktab =~ m/\[vector\]/);
my $pkrelid = $bigh->{$pktab}->{CamelCaseRelationId};
# $iud_args->{IUD_DELETE} .= "gm = LockRelationOid_GetGrantMask($pkrelid, \"$funcname\");\n";
}
}
else
{
# none
}
}
$iud_args->{IUD_INSERTUPDATE} = "";
if (scalar(@fktablist))
{
$iud_args->{IUD_INSERTUPDATE} =
doformat(caql_iud_insertupdate(),
$iud_args);
$iud_args->{IUD_INSERTUPDATE} .= "\n";
$iud_args->{IUD_DELETE} =
"/* DELETE: no tables have fk reference to $tname */"
unless (scalar(@fktablist));
}
else
{
# none
if (scalar(@pktablist))
{
$iud_args->{IUD_INSERTUPDATE} =
"/* INSERT/UPDATE: $tname does not have fk reference to any table */"
}
else
{
$iud_args->{IUD_INSERTUPDATE} =
"/* INSERT/UPDATE/DELETE: no references\n $tname is unrelated to any other table */"
}
}
my $bigstr =
doformat(caql_iud_function(),
$iud_args);
return $bigstr;
} # end do_iud
sub do_interactive
{
my $bigh = shift;
while (<>)
{
my $ini = $_;
next unless (length($ini));
next if ($ini =~ m/^\s*$/);
print dothing($bigh, $ini);
}
}
sub check_bind_variables
{
my ($qry, $arglst) = @_;
use Text::ParseWords;
# find bind variables (:1 ... :N ), where max N = 5, if they
# exist
my @zzz = split(/(\:\d+)/, $qry);
my @bindlst;
for my $tok (@zzz)
{
next unless ($tok =~ m/^\:\d+$/);
$tok =~ s/\://;
if (($tok < 1) || ($tok > 5))
{
warn("bind variable $tok out of range (1-5)");
return 0;
}
if (defined($bindlst[$tok-1]))
{
warn("Duplicate bind variable $tok");
return 0;
}
$bindlst[$tok-1] = "CHECK_DUMMY";
}
for my $ii (1..(scalar(@bindlst)))
{
my $bb = $bindlst[$ii-1];
if (!defined($bb) ||
($bb !~ m/CHECK\_DUMMY/))
{
warn("missing bind variable $ii");
return 0;
}
}
my @args;
if (defined($arglst) && length($arglst) && ($arglst =~ m/\,/))
{
# split by comma, but use Text::ParseWords::parse_line to
# preserve quoted descriptions
@args = parse_line(",", 1, $arglst);
# Note: first comma is delimiter for *start* of arglst, so
# first arg should be NULL/blank
my $a1 = shift @args;
if (defined($a1) && ($a1 =~ m/\w/))
{
warn("weird first argument $a1");
return 0;
}
}
if (scalar(@args))
{
if ($args[0] =~ m/^\s*\".*\"/)
{
my $a2 = $args[0];
$a2 =~ s/^\s*//;
warn("Possible comma problem -- should first arg $a2 be part of query?");
return 0;
}
if (!scalar(@bindlst))
{
my $a2 = $args[0];
$a2 =~ s/^\s*//;
# XXX XXX: allow NULL as placeholder for non-existent bind
# vars to deal with compilation issues with cql->cql1 (ie,
# have a trailing comma preceding the non-existent
# varargs).
unless ($a2 =~ m/^NULL/)
{
warn("Found arg $a2 but no bind variables");
return 0;
}
}
}
# XXX XXX: Cannot do validation until return entire arglist
# (versus stopping at first end paren...)
if (scalar(@args) != scalar(@bindlst))
{
my $argnum = scalar(@args);
my $bindnum = scalar(@bindlst);
# print Data::Dumper->Dump(\@bindlst);
# print Data::Dumper->Dump(\@args);
# warn ("arg mismatch: $bindnum bind variables and $argnum arguments");
# return 0;
}
return 1;
} # end check_bind_variables
# extract caql from c source file
sub get_caql
{
my ($caqlh, $filnam, $bigh) = @_;
die "bad file $filnam" unless (-e $filnam);
my $whole_file;
{
# $$$ $$$ undefine input record separator (\n)
# and slurp entire file into variable
local $/;
undef $/;
my $fh;
open $fh, "< $filnam" or die "cannot open $filnam: $!";
$whole_file = <$fh>;
close $fh;
}
# find "cql(.*)", where ".*" is really "[not a close paren]*"
# NOTE: "count(*)" in the select list messes up this pattern, so
# replace it with a dummy expression, then extract the cql, then
# replace the dummy with "count(*)"
# my @foo = ($whole_file =~ m/(cql0\((?:[^\)])*\))/g);
# XXX XXX: Ugh! need to do this in a way to handle mixed case. Or
# complain or something
$whole_file =~ s/count\s*\(\s*\*\s*\)/CALICO_DUMMY_COUNTSTARR/g;
$whole_file =~ s/COUNT\s*\(\s*\*\s*\)/CALICO_DUMMY_COUNTSTAR2/g;
my @foo = ($whole_file =~ m/(cql(?:0)?\((?:[^\)])*\))/g);
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# NOTE: DOES NOT FIND full cql(.*) expression -- it may
# terminate at the closing paren for the first argument,
# eg: ObjectIdGetDatum(roleid)
# TODO: beef up the regex match to process the whole arg list.
# It's not as simple as looking for a trailing semicolon, since
# cql statements can be located in conditional expressions.
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# print Data::Dumper->Dump(\@foo);
my @baz;
for my $lin (@foo)
{
# $lin =~ s/\"\s*$^\s*"//gm;
# remove newlines and append contiguous quoted strings into a
# single string
$lin =~ s/\n//gm;
$lin =~ s/\"\s*\"//g;
# replace the dummy with "count(*)"
$lin =~ s/CALICO_DUMMY_COUNTSTARR/count\(\*\)/g;
$lin =~ s/CALICO_DUMMY_COUNTSTAR2/COUNT\(\*\)/g;
push @baz, $lin;
}
# print Data::Dumper->Dump(\@baz);
die "duplicate filename $filnam"
if (exists($caqlh->{files}->{$filnam}));
$caqlh->{files}->{$filnam}->{rawtxt} = \@foo;
$caqlh->{files}->{$filnam}->{cookedtxt} = \@baz;
# line should look like cql("<caql>"[, arg1 [,argN...]]
# NOTE: no trailing close paren ")"
for my $lin (@baz)
{
# my @zzz = ($lin =~ m/\s*cql0\(\"(.*)/);
my @zzz = ($lin =~ m/\s*cql(?:0)?\(\"(.*)\"/);
die "bad caql in $filnam: $lin"
unless (scalar(@zzz));
my $qry = shift @zzz;
# check if have sufficient/excess args, because C varargs is
# too dumb
@zzz = split(/\"/, $lin, 3);
# zzz[0] is 'cql("'
# zzz[1] is qry
my $arglst = $zzz[2];
die "bad caql in $filnam: $lin"
unless (check_bind_variables($qry, $arglst));
$caqlh->{queries}->{$qry} = { files => {}, cql => "cql0" }
unless (exists($caqlh->{queries}->{$qry}));
# detect case of pure cql0 queries
if ($caqlh->{queries}->{$qry}->{cql} eq "cql0")
{
$caqlh->{queries}->{$qry}->{cql} = "cql"
if ($lin =~ m/cql\(/);
}
if (exists($caqlh->{queries}->{$qry}->{files}->{$filnam}))
{
$caqlh->{queries}->{$qry}->{files}->{$filnam} += 1;
}
else
{
$caqlh->{queries}->{$qry}->{files}->{$filnam} = 1;
}
# extrapolate the "basic query" contained within the specified query
my $basic_qry = lc($qry);
$basic_qry =~ s/\s+/ /g;
# trim leading and trailing spaces
$basic_qry =~ s/^\s*//;
$basic_qry =~ s/\s*$//;
# tag the query as delete, count(*), for update
$caqlh->{queries}->{$qry}->{bDelete} =
($basic_qry =~ m/^delete/) ? 1 : 0;
$caqlh->{queries}->{$qry}->{bCount} =
($caqlh->{queries}->{$qry}->{bDelete}) ? 1 :
(($basic_qry =~ m/count\(\*\)/) ? 1 : 0);
$caqlh->{queries}->{$qry}->{bUpdate} =
($basic_qry =~ m/for update/) ? 1 : 0;
$caqlh->{queries}->{$qry}->{bInsert} =
($basic_qry =~ m/^insert/) ? 1 : 0;
die "bad query in $filnam: $qry -- cannot DELETE ... FOR UPDATE"
if ($caqlh->{queries}->{$qry}->{bDelete} &&
$caqlh->{queries}->{$qry}->{bUpdate});
die "bad query in $filnam: $qry -- cannot INSERT ... FOR UPDATE"
if ($caqlh->{queries}->{$qry}->{bInsert} &&
$caqlh->{queries}->{$qry}->{bUpdate});
# strip out delete, count(*), for update attributes
$basic_qry =~ s/^select\s+count\(\*\)/select */;
$basic_qry =~ s/^delete/select */;
# temporarily treat INSERT as SELECT * (but reverse later)
$basic_qry =~ s/^insert\s+into/select * from/;
# SELECT ... ORDER BY ... FOR UPDATE
$basic_qry =~ s/\s*for update\s*$//;
if ($basic_qry =~ m/order\s+by/)
{
my @oby = ($basic_qry =~ m/order\s+by\s+(.*)/);
die "bad query in $filnam: $qry -- invalid ORDER BY"
unless (scalar(@oby));
$caqlh->{queries}->{$qry}->{oby} = { rawtxt => $oby[0] };
$basic_qry =~ s/\s*order\s+by\s*.*$//;
}
# check for a column name in SELECT list
# NOTE: only support a single column currently
$caqlh->{queries}->{$qry}->{colnum} = "InvalidAttrNumber";
if ($basic_qry =~ m/^select\s+(.*)\s+from/i)
{
my $tname;
if ($basic_qry =~ m/^select\s+\*\s+from/i)
{
my @ccc =
($basic_qry =~ m/^select\s+\*\s+from\s+(\w*)\s*/i);
$tname = shift @ccc;
$caqlh->{queries}->{$qry}->{tablename} = $tname;
}
else
{
my @ccc =
($basic_qry =~ m/^select\s+(\w*)\s+from\s+(\w*)\s+/i);
my $colname = shift @ccc;
$tname = shift @ccc;
$caqlh->{queries}->{$qry}->{colname} = $colname;
$caqlh->{queries}->{$qry}->{tablename} = $tname;
die "no type for $colname! : $filnam: $qry"
unless (exists($bigh->{$tname}->{colh}->{$colname}));
$caqlh->{queries}->{$qry}->{colnum} =
anum_key($tname, $colname);
# oid column is system column (usually)
if (($colname eq 'oid') &&
(exists($bigh->{$tname}->{with}->{oid})) &&
($bigh->{$tname}->{with}->{oid}))
{
$caqlh->{queries}->{$qry}->{colnum} =
'ObjectIdAttributeNumber';
}
# remove the column name
$basic_qry =~ s/^select\s+.*\s+from/select \* from/;
}
# process ORDER BY cols (if any)
if (exists($caqlh->{queries}->{$qry}->{oby}))
{
my $rawoby = $caqlh->{queries}->{$qry}->{oby}->{rawtxt};
$rawoby =~ s/^\s+//;
$rawoby =~ s/\s+$//;
my @obylist;
if ($rawoby !~ m/\,/)
{
push @obylist, $rawoby;
}
else
{
@obylist = split(/\s*\,\s*/, $rawoby);
}
die "bad query in $filnam: $qry -- invalid ORDER BY"
unless (scalar(@obylist));
# get ORDER BY column names and attribute numbers
my $obnams = []; # list of names
my $obnums = []; # list of attribute numbers
my $obpred = []; # predicate list for choose_index()
for my $obyitem (@obylist)
{
$obyitem =~ s/^\s+//;
$obyitem =~ s/\s+$//;
die "no type for ORDER BY $obyitem! : $filnam: $qry"
unless (exists($bigh->{$tname}->{colh}->{$obyitem}));
push @{$obnams}, $obyitem;
push @{$obpred}, {key =>$ obyitem};
push @{$obnums}, anum_key($tname, $obyitem);
}
$caqlh->{queries}->{$qry}->{oby}->{colnames} = $obnams;
$caqlh->{queries}->{$qry}->{oby}->{attnums} = $obnums;
# choose an _exact_ match index (columns match ORDER BY)
my $obyidx = choose_index($bigh, $tname, $obpred, 1);
die "no index for ORDER BY! : $filnam: $qry"
unless (defined($obyidx));
$caqlh->{queries}->{$qry}->{oby}->{index} = $obyidx;
# NOTE: Add ORDER BY to distinguish basic query with
# required order from same basic query with optional
# order.
$basic_qry .= " ORDER_BY " . $obyidx->{CamelCaseIndexId};
}
} # end if select
die "bad query in $filnam: $qry"
unless ($basic_qry =~ m/^select\s+\*\s+from/i);
# fix the basic query to show INSERT
$basic_qry =~ s/^select\s+\*\s+from/insert into/i
if ($caqlh->{queries}->{$qry}->{bInsert});
$caqlh->{queries}->{$qry}->{basic} = $basic_qry;
$caqlh->{basic}->{$basic_qry} = { files => {} ,
cql => "cql0",
indexes => {},
num_ins_ops => 0,
num_upd_ops => 0,
num_del_ops => 0 }
unless (exists($caqlh->{basic}->{$basic_qry}));
# track insert/update/delete operations
$caqlh->{basic}->{$basic_qry}->{num_ins_ops} += 1
if ($caqlh->{queries}->{$qry}->{bInsert});
$caqlh->{basic}->{$basic_qry}->{num_upd_ops} += 1
if ($caqlh->{queries}->{$qry}->{bUpdate});
$caqlh->{basic}->{$basic_qry}->{num_del_ops} += 1
if ($caqlh->{queries}->{$qry}->{bDelete});
# detect case of pure cql0 queries
if ($caqlh->{basic}->{$basic_qry}->{cql} eq "cql0")
{
$caqlh->{basic}->{$basic_qry}->{cql} = "cql"
if ($caqlh->{queries}->{$qry}->{cql} eq "cql")
}
# track file references for this query
if (exists($caqlh->{basic}->{$basic_qry}->{files}->{$filnam}))
{
$caqlh->{basic}->{$basic_qry}->{files}->{$filnam} += 1;
}
else
{
$caqlh->{basic}->{$basic_qry}->{files}->{$filnam} = 1;
}
} # end for my lin
} # end get_caql
sub gperf_header
{
my $bigstr = <<'EOF_bigstr';
%{
{GENERAL_HDR}
%}
struct caql_hash_cookie
{
const char *name; /* caql string */
int uniqquery_code; /* corresponding unique query */
int basequery_code; /* corresponding base query */
int bDelete; /* query performs DELETE */
int bCount; /* SELECT COUNT(*) (or DELETE) */
int bUpdate; /* SELECT ... FOR UPDATE */
int bInsert; /* INSERT INTO */
AttrNumber attnum; /* column number (or 0 if no column specified) */
};
%%
EOF_bigstr
return $bigstr;
}
sub more_header
{
my $bigstr = <<'EOF_bigstr';
/*-------------------------------------------------------------------------
*
* catquery.c
* general catalog table access methods (internal api)
*
* 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.
*
*-------------------------------------------------------------------------
*/
#include "postgres.h"
#include <math.h>
#include <fcntl.h>
#include <locale.h>
#include <string.h>
#include <unistd.h>
#include "access/genam.h"
#include "access/heapam.h"
#include "access/relscan.h"
#include "access/transam.h"
#include "catalog/caqlparse.h"
#include "catalog/catalog.h"
#include "catalog/catquery.h"
#include "catalog/indexing.h"
#include "catalog/pg_aggregate.h"
#include "catalog/pg_amop.h"
#include "catalog/pg_amproc.h"
#include "catalog/pg_appendonly_alter_column.h"
#include "catalog/pg_attrdef.h"
#include "catalog/pg_auth_members.h"
#include "catalog/pg_authid.h"
#include "catalog/pg_autovacuum.h"
#include "catalog/pg_cast.h"
#include "catalog/pg_class.h"
#include "catalog/pg_constraint.h"
#include "catalog/pg_conversion.h"
#include "catalog/pg_database.h"
#include "catalog/pg_depend.h"
#include "catalog/pg_description.h"
#include "catalog/pg_extprotocol.h"
#include "catalog/pg_exttable.h"
#include "catalog/pg_filespace.h"
#include "catalog/pg_filespace_entry.h"
#include "catalog/pg_inherits.h"
#include "catalog/pg_language.h"
#include "catalog/pg_largeobject.h"
#include "catalog/pg_listener.h"
#include "catalog/pg_namespace.h"
#include "catalog/pg_opclass.h"
#include "catalog/pg_operator.h"
#include "catalog/pg_partition.h"
#include "catalog/pg_partition_rule.h"
#include "catalog/pg_pltemplate.h"
#include "catalog/pg_proc.h"
#include "catalog/pg_resqueue.h"
#include "catalog/pg_rewrite.h"
#include "catalog/pg_shdepend.h"
#include "catalog/pg_shdescription.h"
#include "catalog/pg_statistic.h"
#include "catalog/pg_tablespace.h"
#include "catalog/pg_trigger.h"
#include "catalog/pg_user_mapping.h"
#include "catalog/pg_window.h"
#include "catalog/pg_tidycat.h"
#include "catalog/gp_configuration.h"
#include "catalog/gp_configuration.h"
#include "catalog/gp_segment_config.h"
#include "catalog/gp_san_config.h"
#include "catalog/gp_master_mirroring.h"
#include "catalog/gp_persistent.h"
#include "catalog/gp_global_sequence.h"
#include "catalog/gp_version.h"
#include "catalog/toasting.h"
#include "catalog/gp_policy.h"
#include "miscadmin.h"
#include "storage/fd.h"
#include "utils/fmgroids.h"
#include "utils/relcache.h"
#include "utils/lsyscache.h"
#include "utils/syscache.h"
#include "utils/acl.h"
#include "utils/builtins.h"
#include "utils/inval.h"
#include "cdb/cdbpersistenttablespace.h"
#include "cdb/cdbvars.h"
{STATIC_CAQL_LOCKWELL}
{CAQL_LOG_HASH}
/* ----------------------------------------------------------------
* cq_lookup()
* cq_lookup() defines a hash cookie for every cql() declaration. The
* cookie associates the caql string with a "base query" function
* [caql_basic_fn_#()] that constructs the scan for the query.
* caql_switch() dispatches on the cookie to the base query function.
* ----------------------------------------------------------------
*/
EOF_bigstr
return $bigstr;
} # end more_header
sub caql_switch
{
my $bigstr = <<'EOF_bigstr';
/* ----------------------------------------------------------------
* caql_switch()
* Given a cookie, dispatch to the appropriate "base query" function to
* construct the scan, and return a cqContext
* NOTE: the caql_switch frees the cql after it sets up the pCtx
* ----------------------------------------------------------------
*/
static
cqContext *caql_switch(struct caql_hash_cookie *pchn,
cqContext *pCtx,
cq_list *pcql)
{
Assert(pCtx); /* must have a valid context */
/* set the snapshot and lockmodes */
if (!pCtx->cq_setsnapshot)
pCtx->cq_snapshot = SnapshotNow;
if (!pCtx->cq_setlockmode)
{
if (pchn->bDelete || pchn->bUpdate || pchn->bInsert)
pCtx->cq_lockmode = RowExclusiveLock;
else
pCtx->cq_lockmode = AccessShareLock;
}
/* XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX */
if (1) /* implicit locking everywhere */
{
pCtx->cq_setpklock = 1;
pCtx->cq_pklock_excl =
(pchn->bDelete || pchn->bUpdate || pchn->bInsert);
}
/* XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX */
/* pcql must be valid */
Assert(pcql && pcql->bGood);
/* get everything we need from cql */
for (int ii = 0; ii < pcql->maxkeys; ii++)
{
pCtx->cq_datumKeys[ii] = pcql->cqlKeys[ii];
}
pCtx->cq_NumKeys = pcql->maxkeys;
pCtx->cq_cacheKeys = &pCtx->cq_datumKeys[0];
pCtx->cq_uniqquery_code = pchn->uniqquery_code;
pCtx->cq_basequery_code = pchn->basequery_code;
/* NOTE: pass the cql to basic functions -- optionally
* used for debugging
*/
switch(pchn->basequery_code)
{
{ALLCASES}
default:
break;
/* bad */
}
/* NOTE: free up the cql before we return */
pcql->bGood = false;
pfree(pcql);
return (pCtx);
} /* end caql_switch */
EOF_bigstr
return $bigstr;
}
sub caql_switch_case
{
my $bigstr = <<'EOF_bigstr';
case {CASEVAL}: /* {CASECOMM} */
pCtx->cq_sysScan = {FUNCNAME}(pCtx, pcql, {IS_LOCKENTIRETABLE});
break;
EOF_bigstr
return $bigstr;
}
sub caql_iud_switch
{
my $bigstr = <<'EOF_bigstr';
/* ----------------------------------------------------------------
* caql_iud_switch()
* dispatch to the appropriate "insert/update/delete" function
* for concurrent update validation
* ----------------------------------------------------------------
*/
static
void caql_iud_switch(cqContext *pCtx, int is_iud,
HeapTuple oldtup, HeapTuple newtup, bool dontWait)
{
LOCKMODE pklockmode = AccessExclusiveLock;
Assert(pCtx); /* must have a valid context */
if (pCtx->cq_setpklock)
{
/* WAIT if caql_PKLOCK() is set */
dontWait = false;
if (!pCtx->cq_pklock_excl)
pklockmode = AccessShareLock;
}
switch(pCtx->cq_basequery_code)
{
{ALL_IUD_CASES}
default:
break;
/* bad */
}
} /* end caql_iud_switch */
EOF_bigstr
return $bigstr;
} # end caql_iud_switch
sub caql_iud_switch_case
{
my $bigstr = <<'EOF_bigstr';
case {CASEVAL}: /* {CASECOMM} */
{IUD_FUNC_NAME}(pCtx, is_iud, oldtup, newtup, dontWait, pklockmode);
break;
EOF_bigstr
return $bigstr;
}
sub caql_iud_delete
{
my $bigstr = <<'EOF_bigstr';
/*
if deleting, {IUD_TNAME} primary key may be referenced in:
{IUD_PKTABS}
*/
EOF_bigstr
return $bigstr;
}
sub caql_iud_insertupdate
{
my $bigstr = <<'EOF_bigstr';
/*
if insert/update, check foreign keys against:
{IUD_FKTABS}
*/
EOF_bigstr
return $bigstr;
}
sub caql_makehash
{
my $bigstr = <<'EOF_bigstr';
d = caql_getattr_internal(pCtx, {TUPLE}, {MHATTNUM}, &isnull);
{HASHVAR} = caql_pkhash(pCtx, {HASHVAR}, d, isnull, {MHTYPOID});
EOF_bigstr
return $bigstr;
} # end caql_makehash
sub static_caql_log_hash_create
{
my $bigstr = <<'EOF_bigstr';
if (gp_enable_caql_logging && CaQLLogHash == NULL)
{
HASHCTL hash_ctl;
hash_ctl.keysize = sizeof(CaQLLogTag);
hash_ctl.entrysize = sizeof(CaQLLogTag);
hash_ctl.hash = tag_hash;
CaQLLogHash = hash_create("caql log hash",
1000,
&hash_ctl,
HASH_ELEM | HASH_FUNCTION);
}
EOF_bigstr
return $bigstr;
}
sub static_caql_log_hash
{
my $bigstr = <<'EOF_bigstr';
static HTAB *CaQLLogHash = NULL;
typedef struct CaQLLogTag
{
char filename[MAXPGPATH];
int lineno;
} CaQLLogTag;
typedef struct CaQLLogEntry
{
CaQLLogTag key;
} CaQLLogEntry;
static uint32 caqlLogHashCode(CaQLLogTag *tagPtr)
{
return get_hash_value(CaQLLogHash, (void *)tagPtr);
}
EOF_bigstr
return $bigstr;
} # end static_caql_log_hash
sub static_caql_lockwell
{
my $bigstr = <<'EOF_bigstr';
static void caql_lockwell(cqContext *pCtx,
Oid relid,
LOCKMODE lockmode,
HeapTuple tup,
char *tablenbame,
char *colstr,
Oid indexid,
Oid hashoid,
bool dontWait,
bool ignoreInvalidTuple
);
static Oid caql_pkhash(cqContext *pCtx,
Oid hashoid,
Datum d,
bool isNull,
Oid typoid
);
static void caql_lock_entiretable(cqContext *pCtx,
Oid relid,
LOCKMODE lockmode,
bool dontWait
);
EOF_bigstr
return $bigstr;
} # end static_caql_lockwell
sub caql_heapclose_releaselock
{
my $bigstr = <<'EOF_bigstr';
heap_close((pCtx)->cq_heap_rel, (pCtx)->cq_lockmode); \
EOF_bigstr
} # end caql_heapclose_releaselock
# if not in a transaction, release the table lock, else hold it
# (until the txn commits/aborts)
sub caql_heapclose_holdlock
{
my $bigstr = <<'EOF_bigstr';
{ if (!IsTransactionState()) \
heap_close((pCtx)->cq_heap_rel, (pCtx)->cq_lockmode); \
else heap_close((pCtx)->cq_heap_rel, NoLock); } \
EOF_bigstr
} # end caql_heapclose_holdlock
# build the C code for the caql fetch functions (getcount(), getfirst(), etc)
sub caql_lockwell_func_body
{
my $bigstr = <<'EOF_bigstr';
/* ----------------------------------------------------------------
* caql_lockwell()
*
* acquire a primary key lock on the index
* ----------------------------------------------------------------
*/
static void caql_lockwell(cqContext *pCtx,
Oid relid,
LOCKMODE lockmode,
HeapTuple tup,
char *tablenbame,
char *colstr,
Oid indexid,
Oid hashoid,
bool dontWait,
bool ignoreInvalidTuple
)
{
// Relation rel;
LOCKTAG tag;
LockAcquireResult res;
Oid dbid;
// Assert(RelationIsValid(pCtx->cq_heap_rel));
// rel = pCtx->cq_heap_rel;
// Assert (!pCtx->cq_usesyscache); /* ok to have syscache as long as real rel? */
/* 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
* XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
* Disable locking on segments...
* 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
*/
if (Gp_role != GP_ROLE_DISPATCH)
return;
if (!criticalRelcachesBuilt || !IsTransactionState())
return;
if (IsSharedRelation(relid))
dbid = InvalidOid;
else
dbid = MyDatabaseId;
if (!ignoreInvalidTuple && !HeapTupleIsValid(tup))
return;
// SET_LOCKTAG_RELATION(tag, dbid, relid);
/* use gp_san_configuration for now */
Oid keyoid = hashoid;
/* XXX XXX: need a check to prevent lock of invalid oid for
foreign keys (but should be legal for case of bool false=0 mapped
into oid )
*/
if (!OidIsValid(keyoid))
return;
tag.locktag_field3 = keyoid; /* 32 bit for Oid */
tag.locktag_field4 = indexid; /* 16 bit for indexid (less than 64k) */
/* get a lock (and don't wait) */
res = LockAcquire(&tag, lockmode, false, dontWait);
if (LOCKACQUIRE_NOT_AVAIL == res)
{
ereport(ERROR,
(errcode(ERRCODE_LOCK_NOT_AVAILABLE),
errmsg("concurrent operation on resource: %s(%s)",
tablenbame, colstr)));
}
}
/* ----------------------------------------------------------------
* caql_pkhash()
*
* hash a datum by type to a 32 bit value suitable for a
* primary key lock
* ----------------------------------------------------------------
*/
/*
hash built out of a multiplier (called iteratively over the bytes
of the key) and a final shift to fix up low order bits
*/
#define pkhashmult(h, k) ( ((h)*33) + (k) )
#define pkhashshift(h) ( (h) + ((h) >> 5) )
static Oid caql_pkhashloop(Oid hashoid,
char *p,
int len
)
{
for (int ii = 0; ii < len; ii++)
{
hashoid = pkhashmult(hashoid, *p);
p++;
}
hashoid = pkhashshift(hashoid);
return hashoid;
}
static Oid caql_pkhash(cqContext *pCtx,
Oid hashoid,
Datum d,
bool isNull,
Oid typoid
)
{
if (isNull)
return hashoid;
if ((0 == hashoid) && (OIDOID == typoid))
return (DatumGetObjectId(d));
switch(typoid)
{
case OIDOID:
hashoid = pkhashmult(hashoid, DatumGetObjectId(d));
hashoid = pkhashshift(hashoid);
break;
case CHAROID:
if (0 == hashoid)
{
hashoid = DatumGetChar(d);
}
else
{
hashoid = pkhashmult(hashoid, DatumGetChar(d));
hashoid = pkhashshift(hashoid);
}
break;
case BOOLOID:
if (0 == hashoid)
{
hashoid = DatumGetBool(d);
}
else
{
hashoid = pkhashmult(hashoid, DatumGetBool(d));
hashoid = pkhashshift(hashoid);
}
break;
case INT2OID:
if (0 == hashoid)
{
hashoid = DatumGetInt16(d);
}
else
{
hashoid = pkhashmult(hashoid, DatumGetInt16(d));
hashoid = pkhashshift(hashoid);
}
break;
case INT4OID:
if (0 == hashoid)
{
hashoid = DatumGetInt32(d);
}
else
{
hashoid = pkhashmult(hashoid, DatumGetInt32(d));
hashoid = pkhashshift(hashoid);
}
break;
case INT8OID:
{
int64 result = DatumGetInt64(d);
hashoid = caql_pkhashloop(hashoid, (char *)&result, 8);
break;
}
case NAMEOID:
{
char *result = NameStr(*(DatumGetName(d)));
hashoid = caql_pkhashloop(hashoid, result, strlen(result));
break;
}
case OIDVECTOROID:
{
/* Note: see cdbhash.c */
oidvector *oidvec_buf = (oidvector *) DatumGetPointer(d);
hashoid = caql_pkhashloop(hashoid,
(char *)(oidvec_buf->values),
(oidvec_buf->dim1 * sizeof(Oid)));
break;
}
default:
break; /* bad */
}
return hashoid;
}
/* ----------------------------------------------------------------
* caql_lock_entiretable()
*
* lock the whole catalog table if no primary key
* (using the pg_class(oid) primary key lock)
* ----------------------------------------------------------------
*/
static void caql_lock_entiretable(cqContext *pCtx,
Oid relid,
LOCKMODE lockmode,
bool dontWait
)
{
Oid newhash = 0;
newhash = caql_pkhash(pCtx, newhash, ObjectIdGetDatum(relid),
false /* isnull */, OIDOID);
caql_lockwell(pCtx, RelationRelationId,
lockmode, NULL,
"pg_class",
"oid",
ClassOidIndexId,
newhash,
dontWait,
true /* ignore invalid tuple */
);
AcceptInvalidationMessages(); /* syscache could be out of date after lock wait */
}
EOF_bigstr
return $bigstr;
} # end caql_lockwell
sub caql_iud_lockwell
{
my $bigstr = <<'EOF_bigstr';
if (HeapTupleIsValid({TUPLE}))
{
Datum d;
bool isnull;
{LOCKWELL_HASHKEY2} = 0;
{LOCKWELL_MAKEHASH}
caql_lockwell(pCtx, {TABLERELID},
{LOCKMODE}, {TUPLE},
"{LW_TNAME}",
"{COLSTR}",
{LOCKWELL_IDX},
{LOCKWELL_HASHKEY},
dontWait,
false /* don't ignore invalid tuple */
);
}
EOF_bigstr
return $bigstr;
}
sub caql_iud_lockwell_oidvector
{
my $bigstr = <<'EOF_bigstr';
if (HeapTupleIsValid({TUPLE}))
{
Datum d;
bool isnull;
/* NOTE: special case of oid{LW_VEC_OR_ARRAY} */
{LOCKWELL_MAKEHASH}
ArrayType *oidarr = isnull ? NULL :
(ArrayType *) {LW_GETDATUM}(d);
/* must be a 1 dimensional array of oid
(either oidvector or oid array)
*/
if (!isnull && oidarr)
{
Assert((ARR_NDIM(oidarr) == 1) &&
(ARR_ELEMTYPE(oidarr) == OIDOID));
Oid *ovp = (Oid *)ARR_DATA_PTR(oidarr);
/* lock every oid in the array */
for (int ii=0; ii < ARR_DIMS(oidarr)[0]; ii++)
{
{LOCKWELL_HASHKEY2} = ovp[ii];
caql_lockwell(pCtx, {TABLERELID},
{LOCKMODE}, {TUPLE},
"{LW_TNAME}",
"{COLSTR}",
{LOCKWELL_IDX},
{LOCKWELL_HASHKEY},
dontWait,
false /* don't ignore invalid tuple */
);
}
}
}
EOF_bigstr
return $bigstr;
}
sub caql_iud_buildhash
{
my $bigstr = <<'EOF_bigstr';
if (HeapTupleIsValid({IUD_BH_TUP}))
{
if (!pCtx->cq_setpklock)
Assert(RelationIsValid(pCtx->cq_heap_rel));
{IUD_BH_VAL} = 0;
}
EOF_bigstr
return $bigstr;
}
sub caql_iud_function
{
my $bigstr = <<'EOF_bigstr';
static
void {IUD_FUNC_NAME}(cqContext *pCtx, int is_iud,
HeapTuple oldtup, HeapTuple newtup, bool dontWait,
LOCKMODE pklockmode)
{
Oid oldhash = 0;
Oid newhash = 0;
{IUD_BUILDHASH}
{IUD_IDX}
{IUD_IDX_XLOCKWELL}
/* NOTE: don't get fk locks if only needed share locks on pk */
if (pklockmode != AccessExclusiveLock)
return;
if (!is_iud)
{
{IUD_DELETE}
}
else
{
dontWait = true; /* never wait for share locks on foreign keys */
{IUD_INSERTUPDATE}
{IUD_SHLOCKWELL}
}
} /* end {IUD_FUNC_NAME} */
EOF_bigstr
return $bigstr;
}
# build the C code for the caql fetch functions (getcount(), getfirst(), etc)
sub caql_fetch_funcs
{
my $bigstr = <<'EOF_bigstr';
{CAQL_LOCKWELL}
{BUILTIN_OBJECT_CHECK}
{DISABLE_CATALOG_CHECK}
{DISABLE_ATTRIBUTE_CHECK}
EOF_bigstr
return $bigstr;
} # end caql_fetch_funcs
# Project NameData Column Case Statement
sub projnamcolcase
{
my $bFixed = shift;
my $bigstr;
if ($bFixed)
{
$bigstr = <<'EOF_bigstr';
case {PROJCOLATTNUM}: /* {PROJCOLUMNNAME} */
result = pstrdup(
NameStr((({PROJTABLEFORM})
GETSTRUCT(tuple))->{PROJCOLUMNNAME}));
if (pbIsNull) *pbIsNull = false;
break;
EOF_bigstr
}
else
{
$bigstr = <<'EOF_bigstr2';
case {PROJCOLATTNUM}: /* {PROJCOLUMNNAME} */
{
bool isnull;
Datum d =
caql_getattr_internal(pCtx, tuple, {PROJCOLATTNUM}, &isnull);
if (!isnull)
result = pstrdup(
NameStr(*(DatumGetName(d))));
if (pbIsNull) *pbIsNull = isnull;
}
break;
EOF_bigstr2
}
return $bigstr;
}
# Project Oid Column Case Statement
sub projoidcolcase
{
my $bFixed = shift;
my $bigstr;
if ($bFixed)
{
$bigstr = <<'EOF_bigstr';
case {PROJCOLATTNUM}: /* {PROJCOLUMNNAME} */
result = (Oid)
(({PROJTABLEFORM})
GETSTRUCT(tuple))->{PROJCOLUMNNAME};
if (pbIsNull) *pbIsNull = false;
break;
EOF_bigstr
}
else
{
$bigstr = <<'EOF_bigstr2';
case {PROJCOLATTNUM}: /* {PROJCOLUMNNAME} */
{
bool isnull;
Datum d =
caql_getattr_internal(pCtx, tuple, {PROJCOLATTNUM}, &isnull);
if (!isnull)
result = DatumGetObjectId(d);
if (pbIsNull) *pbIsNull = isnull;
}
break;
EOF_bigstr2
}
return $bigstr;
}
# Project Text Column Case Statement
sub projtxtcolcase
{
# NOTE: treat all text columns as variable (Nullable)
my $bigstr = <<'EOF_bigstr';
case {PROJCOLATTNUM}: /* {PROJCOLUMNNAME} */
{
bool isnull;
Datum d =
caql_getattr_internal(pCtx, tuple, {PROJCOLATTNUM}, &isnull);
if (!isnull)
result = DatumGetCString(
DirectFunctionCall1(textout, d));
if (pbIsNull) *pbIsNull = isnull;
}
break;
EOF_bigstr
return $bigstr;
}
sub projcase_switch
{
my $bigstr = <<'EOF_bigstr';
case {CASERELID}: /* {PROJTABLENAME} */
{
switch({PROJATTNUM})
{
{PROJCOLCASE}
default:
elog(ERROR, "column not {PROJTYPMSG}: %s\nfile: %s, line %d",
caql_str, filenam, lineno);
}
} /* end {PROJTABLENAME} */
break;
EOF_bigstr
return $bigstr;
}
sub cstring_table_switch
{
my $bigstr = <<'EOF_bigstr';
switch({TABLERELID})
{
{PROJCASE}
default:
elog(ERROR, "could not get column for relation: %s\nfile: %s, line %d",
caql_str, filenam, lineno);
}
EOF_bigstr
return $bigstr;
}
# build the C code for the caql fetch functions (getcstring() )
sub caql_fetch_cols
{
my $bigstr = <<'EOF_bigstr';
/* XXX XXX: temp fix for gp_distro reference in getoid_plus */
typedef FormData_gp_policy *Form_gp_distribution_policy;
/* ----------------------------------------------------------------
* caql_getoid_plus()
* Return an oid column from the first tuple and end the scan.
* Note: this works for regproc columns as well, but you should cast
* the output as RegProcedure.
* ----------------------------------------------------------------
*/
Oid caql_getoid_plus(cqContext *pCtx0, int *pFetchcount,
bool *pbIsNull, cq_list *pcql)
{
const char* caql_str = pcql->caqlStr;
const char* filenam = pcql->filename;
int lineno = pcql->lineno;
struct caql_hash_cookie *pchn = {LOOKUP}(caql_str, strlen(caql_str), pcql);
cqContext *pCtx;
cqContext cqc;
HeapTuple tuple;
Relation rel;
Oid result = InvalidOid;
if (NULL == pchn)
elog(ERROR, "invalid caql string: %s\nfile: %s, line %d",
caql_str, filenam, lineno);
Assert(!pchn->bInsert); /* INSERT not allowed */
/* use the provided context, or provide a clean local ctx */
if (pCtx0)
pCtx = pCtx0;
else
pCtx = cqclr(&cqc);
pCtx = caql_switch(pchn, pCtx, pcql);
/* NOTE: caql_switch frees the pcql */
rel = pCtx->cq_heap_rel;
if (pFetchcount) *pFetchcount = 0;
if (pbIsNull) *pbIsNull = true;
/* use the SysCache */
if (pCtx->cq_usesyscache)
{
tuple = SearchSysCacheKeyArray(pCtx->cq_cacheId,
pCtx->cq_NumKeys,
pCtx->cq_cacheKeys);
}
else
{
tuple = systable_getnext(pCtx->cq_sysScan);
}
disable_catalog_check(pCtx, tuple);
if (HeapTupleIsValid(tuple))
{
if (pFetchcount) *pFetchcount = 1;
/* if attnum not set, (InvalidAttrNumber == 0)
* use tuple oid, else extract oid from column
* (includes ObjectIdAttributeNumber == -2)
*/
if (pchn->attnum <= InvalidAttrNumber)
{
if (pbIsNull) *pbIsNull = false;
result = HeapTupleGetOid(tuple);
}
else /* find oid column */
{
{GETOIDTABLESWITCH}
}
} /* end HeapTupleIsValid */
if (pCtx->cq_usesyscache)
{
if (HeapTupleIsValid(tuple))
ReleaseSysCache(tuple);
}
else
{
if (pFetchcount && HeapTupleIsValid(tuple))
{
if (HeapTupleIsValid(systable_getnext(pCtx->cq_sysScan)))
{
*pFetchcount = 2;
}
}
systable_endscan(pCtx->cq_sysScan);
}
caql_heapclose(pCtx);
return (result);
} /* end caql_getoid_plus */
/* ----------------------------------------------------------------
* caql_getoid_only()
* Return the oid of the first tuple and end the scan
* If pbOnly is not NULL, return TRUE if a second tuple is not found,
* else return FALSE
* ----------------------------------------------------------------
*/
Oid caql_getoid_only(cqContext *pCtx0, bool *pbOnly, cq_list *pcql)
{
const char* caql_str = pcql->caqlStr;
const char* filenam = pcql->filename;
int lineno = pcql->lineno;
struct caql_hash_cookie *pchn = {LOOKUP}(caql_str, strlen(caql_str), pcql);
cqContext *pCtx;
cqContext cqc;
HeapTuple tuple;
Relation rel;
Oid result = InvalidOid;
if (NULL == pchn)
elog(ERROR, "invalid caql string: %s\nfile: %s, line %d",
caql_str, filenam, lineno);
Assert(!pchn->bInsert); /* INSERT not allowed */
/* use the provided context, or provide a clean local ctx */
if (pCtx0)
pCtx = pCtx0;
else
pCtx = cqclr(&cqc);
pCtx = caql_switch(pchn, pCtx, pcql);
/* NOTE: caql_switch frees the pcql */
rel = pCtx->cq_heap_rel;
if (pbOnly) *pbOnly = true;
/* use the SysCache */
if (pCtx->cq_usesyscache)
{
tuple = SearchSysCacheKeyArray(pCtx->cq_cacheId,
pCtx->cq_NumKeys,
pCtx->cq_cacheKeys);
disable_catalog_check(pCtx, tuple);
if (HeapTupleIsValid(tuple))
{
result = HeapTupleGetOid(tuple);
ReleaseSysCache(tuple);
/* only one */
}
caql_heapclose(pCtx);
return (result);
}
if (HeapTupleIsValid(tuple = systable_getnext(pCtx->cq_sysScan)))
{
disable_catalog_check(pCtx, tuple);
result = HeapTupleGetOid(tuple);
if (pbOnly)
{
*pbOnly =
!(HeapTupleIsValid(tuple =
systable_getnext(pCtx->cq_sysScan)));
}
}
systable_endscan(pCtx->cq_sysScan);
caql_heapclose(pCtx);
return (result);
}
/* ----------------------------------------------------------------
* caql_getcstring_plus()
* Return a cstring column from the first tuple and end the scan.
* ----------------------------------------------------------------
*/
char *caql_getcstring_plus(cqContext *pCtx0, int *pFetchcount,
bool *pbIsNull, cq_list *pcql)
{
const char* caql_str = pcql->caqlStr;
const char* filenam = pcql->filename;
int lineno = pcql->lineno;
struct caql_hash_cookie *pchn = {LOOKUP}(caql_str, strlen(caql_str), pcql);
cqContext *pCtx;
cqContext cqc;
HeapTuple tuple;
Relation rel;
char *result = NULL;
if (NULL == pchn)
elog(ERROR, "invalid caql string: %s\nfile: %s, line %d",
caql_str, filenam, lineno);
Assert(!pchn->bInsert); /* INSERT not allowed */
/* use the provided context, or provide a clean local ctx */
if (pCtx0)
pCtx = pCtx0;
else
pCtx = cqclr(&cqc);
pCtx = caql_switch(pchn, pCtx, pcql);
/* NOTE: caql_switch frees the pcql */
rel = pCtx->cq_heap_rel;
if (pFetchcount) *pFetchcount = 0;
if (pbIsNull) *pbIsNull = true;
/* use the SysCache */
if (pCtx->cq_usesyscache)
{
tuple = SearchSysCacheKeyArray(pCtx->cq_cacheId,
pCtx->cq_NumKeys,
pCtx->cq_cacheKeys);
}
else
{
tuple = systable_getnext(pCtx->cq_sysScan);
}
disable_catalog_check(pCtx, tuple);
if (HeapTupleIsValid(tuple))
{
if (pFetchcount) *pFetchcount = 1;
{GETCSTRINGTABLESWITCH}
} /* end HeapTupleIsValid */
if (pCtx->cq_usesyscache)
{
if (HeapTupleIsValid(tuple))
ReleaseSysCache(tuple);
}
else
{
if (pFetchcount && HeapTupleIsValid(tuple))
{
if (HeapTupleIsValid(systable_getnext(pCtx->cq_sysScan)))
{
*pFetchcount = 2;
}
}
systable_endscan(pCtx->cq_sysScan);
}
caql_heapclose(pCtx);
return (result);
} /* end caql_getcstring_plus */
EOF_bigstr
return $bigstr;
} # end caql_fetch_cols
# build the gperf input file
sub do_gperf
{
my ($caqlh, $gpf, $bigh) = @_;
my $gpo;
open $gpo, "> $gpf"
or die "cannot open $gpf: $!";
my $verzion = "unknown";
$verzion = $glob_glob->{_sleazy_properties}->{version}
if (exists($glob_glob->{_sleazy_properties}) &&
exists($glob_glob->{_sleazy_properties}->{version}));
my $slzy_argv_str = "";
$slzy_argv_str =
"\nARGV: " . $glob_glob->{_sleazy_properties}->{slzy_argv_str} . "\n"
if (exists($glob_glob->{_sleazy_properties}->{slzy_argv_str}) &&
length($glob_glob->{_sleazy_properties}->{slzy_argv_str}));
$verzion = $0 . " version " . $verzion;
my $nnow = localtime;
my $gen_hdr_str = "/* \n";
$gen_hdr_str .= " WARNING: DO NOT MODIFY THIS FILE: \n" .
" Generated by " . $verzion . "\n" .
" on " . $nnow . "\n" . $slzy_argv_str .
"\n*/\n\n";
my $static_caql_lockwell_str = (exists($glob_glob->{lockcheck}) &&
$glob_glob->{lockcheck}) ?
static_caql_lockwell() : "";
my $caql_heapclose_str = (exists($glob_glob->{holdtablelock}) &&
$glob_glob->{holdtablelock}) ?
caql_heapclose_holdlock() :
caql_heapclose_releaselock();
my $static_caql_log_hash_str = (exists($glob_glob->{logquery_hash}) &&
$glob_glob->{logquery_hash}) ?
static_caql_log_hash() : "";
$gen_hdr_str .=
doformat(more_header(),
{
STATIC_CAQL_LOCKWELL => $static_caql_lockwell_str,
CAQL_HEAPCLOSE => $caql_heapclose_str,
CAQL_LOG_HASH => $static_caql_log_hash_str
}
);
$gen_hdr_str .= "#ifdef NOT_USED\n";
print $gpo doformat(gperf_header(),
{
GENERAL_HDR => $gen_hdr_str
}
);
# Omit unused code. If this giant code is needed in future,
# we can come back and re-evaluate it.
if(0)
{
# caql hash cookie initialization
my $uniq_code = 1; # label unique queries for caqltrack
for my $qry (sort(keys(%{$caqlh->{queries}})))
{
print $gpo '"' . $qry . '"' . ", " ;
my $basic = $caqlh->{queries}->{$qry}->{basic};
print $gpo $uniq_code . ", ";
print $gpo $caqlh->{basic}->{$basic}->{func_number} . ", ";
print $gpo $caqlh->{queries}->{$qry}->{bDelete} . ", ";
print $gpo $caqlh->{queries}->{$qry}->{bCount} . ", ";
print $gpo $caqlh->{queries}->{$qry}->{bUpdate} . ", ";
print $gpo $caqlh->{queries}->{$qry}->{bInsert} . ", ";
print $gpo $caqlh->{queries}->{$qry}->{colnum} . "\n";
$caqlh->{queries}->{$qry}->{uniqquery_code} = $uniq_code;
$caqlh->{queries}->{$qry}->{basequery_code} =
$caqlh->{basic}->{$basic}->{func_number};
$uniq_code++;
}
print $gpo '%%' . "\n\n";
# print the base query functions
print $gpo caql_stats($caqlh, $bigh);
for my $bq (sort(keys(%{$caqlh->{basic}})))
{
print $gpo "/* base query: $bq */\n";
if (exists($caqlh->{basic}->{$bq}->{func_index}))
{
my $bqi = $caqlh->{basic}->{$bq}->{func_index};
print $gpo "/* index: $bqi */\n";
}
else
{
print $gpo "/* index: *None* */\n";
}
if (exists($caqlh->{basic}->{$bq}->{syscacheid}))
{
my $bqsc = $caqlh->{basic}->{$bq}->{syscacheid};
print $gpo "/* syscacheid: $bqsc */\n";
}
print $gpo "/* clients: ";
{
# print total client count
my $totclient = 0;
for my $filc (sort(keys(%{$caqlh->{basic}->{$bq}->{files}})))
{
$totclient += $caqlh->{basic}->{$bq}->{files}->{$filc};
}
print $gpo $totclient;
print $gpo "\t\t";
# insert/update/delete
print $gpo "i/u/d: ";
print $gpo $caqlh->{basic}->{$bq}->{num_ins_ops} . "/";
print $gpo $caqlh->{basic}->{$bq}->{num_upd_ops} . "/";
print $gpo $caqlh->{basic}->{$bq}->{num_del_ops} ;
}
print $gpo " \n";
# breakdown references per file
for my $filc (sort(keys(%{$caqlh->{basic}->{$bq}->{files}})))
{
my $fn2 = $filc;
$fn2 =~ s|^.*/src/|/src/|;
$fn2 =~ s|^(\.\./)*||; # remove leading "../"
print $gpo " * $fn2: ";
print $gpo $caqlh->{basic}->{$bq}->{files}->{$filc} . "\n";
}
print $gpo " */\n";
print $gpo "/* foreign key tables: ";
if (!exists($caqlh->{basic}->{$bq}->{foreign_key_tables}))
{
print $gpo "*None*\n";
}
else
{
print $gpo "\n";
for my $fktab (sort(keys(%{$caqlh->{basic}->{$bq}->{foreign_key_tables}})))
{
print $gpo " * $fktab\n";
}
}
print $gpo " */\n";
# additional notes
# note the case of a basic function where all queries are cql0
if ($caqlh->{basic}->{$bq}->{cql} eq "cql0")
{
$caqlh->{basic}->{$bq}->{func_note} .=
"cql0 definition only - function never called\n";
}
if (exists($caqlh->{basic}->{$bq}->{func_note}) &&
length($caqlh->{basic}->{$bq}->{func_note}))
{
my $fnn = $caqlh->{basic}->{$bq}->{func_note};
$fnn =~ s/^/ * /gm; # prefix newlines
print $gpo "/* Notes: \n";
print $gpo $fnn;
print $gpo " */\n";
}
print $gpo $caqlh->{basic}->{$bq}->{func}, "\n";
}
if (exists($glob_glob->{lockcheck}) &&
$glob_glob->{lockcheck})
{
# iud functions
print $gpo "/* start iud functions */\n";
print $gpo
doformat(
"/* Note: {NUMIUD} iud functions for {NUMBQ} basic queries */\n\n",
{
NUMIUD => scalar(keys(%{$glob_glob->{iud2bq}})),
NUMBQ => scalar(keys(%{$caqlh->{basic}}))
});
for my $bq (sort(keys(%{$caqlh->{basic}})))
{
# only print function body if it exists (duplicates were
# eliminated), so the list has "holes" in the numbering
if (defined($caqlh->{basic}->{$bq}->{iud_func}))
{
# NOTE: we deduplicated iud functions, so print the
# list of all basic queries associated with this
# function
my $bql =
join("\n\t",
@{$glob_glob->{iud2bq}->{
$caqlh->{basic}->{$bq}->{iud_func_name}}});
# reformat the WHERE clause a bit
$bql =~ s/\s+where/\n\t\twhere/gm;
print $gpo "/* base query: \n\t$bql\n\t*/\n";
print $gpo $caqlh->{basic}->{$bq}->{iud_func}, "\n";
}
}
print $gpo "/* end iud functions */\n";
}
# build dispatch table
my $allcase = "";
my $all_iudcase = "";
for my $bq (sort(keys(%{$caqlh->{basic}})))
{
my $lock_entire_table = "false";
my $bq_tname = $caqlh->{basic}->{$bq}->{tablename};
if (exists($bigh->{$bq_tname}->{calico}) &&
exists($bigh->{$bq_tname}->{calico}->{lock_entire_table}) &&
($bigh->{$bq_tname}->{calico}->{lock_entire_table}))
{
# NOTE WELL: if this table had any basic functions that
# could *not* use a pkey index, then all functions that
# use this table must get a share or exclusive lock for
# the entire table.
$lock_entire_table = "true";
}
$allcase .= doformat(caql_switch_case(),
{
FUNCNAME =>
$caqlh->{basic}->{$bq}->{func_name},
CASECOMM => $bq,
CASEVAL =>
$caqlh->{basic}->{$bq}->{func_number},
IS_LOCKENTIRETABLE => $lock_entire_table,
}
);
$all_iudcase .= doformat(caql_iud_switch_case(),
{
IUD_FUNC_NAME =>
$caqlh->{basic}->{$bq}->{iud_func_name},
CASECOMM => $bq,
CASEVAL =>
$caqlh->{basic}->{$bq}->{func_number}
}
);
}
my $caqlsw = doformat(caql_switch(),
{
ALLCASES => $allcase
}
);
my $caql_iudsw = doformat(caql_iud_switch(),
{
ALL_IUD_CASES => $all_iudcase
}
);
print $gpo $caqlsw;
} # if(0)
else
{
# We need something. Output dummy.
print $gpo '"SELECT 1", 1, 1, 0, 0, 0, 0, foo' . $/;
print $gpo '%%' . $/;
}
my $caql_iudsw = "";
print $gpo "#endif /* NOT_USED */\n";
if (exists($glob_glob->{lockcheck}) &&
$glob_glob->{lockcheck})
{
print $gpo $caql_iudsw;
}
else
{
print $gpo "\n\n/* NOTE: caql_iud_switch locking removed */\n";
print $gpo "#define caql_iud_switch(pctx, isiud, oldtup, newtup, dontWait) \n";
}
print $gpo "\n";
# add caql_lockwell function if locking
my $lockwell_str = (exists($glob_glob->{lockcheck}) &&
$glob_glob->{lockcheck}) ?
caql_lockwell_func_body() : "";
my $builtin_object_check_case_str = get_builtin_object_check_case_str();
my $builtin_object_check_str = doformat(get_builtin_object_check_str(),
{
BUILTIN_OBJECT_CHECK_CASE => $builtin_object_check_case_str
}
);
my $disable_catalog_check_str = get_disable_catalog_check_str();
my $disable_attribute_check_str = get_disable_attribute_check_str();
print $gpo doformat(caql_fetch_funcs(),
{
CAQL_LOCKWELL => $lockwell_str,
LOOKUP => "cq_lookup",
BUILTIN_OBJECT_CHECK => $builtin_object_check_str,
DISABLE_CATALOG_CHECK => $disable_catalog_check_str,
DISABLE_ATTRIBUTE_CHECK => $disable_attribute_check_str
}
);
my $proj_cstr_case = "";
my $proj_oid_case = "";
if (1)
{
# fixed fields
my $ffh = getfixedfields($bigh);
my %alltabh;
while (my ($kk, $vv) = each(%{$glob_glob->{fil2tab}}))
{
for my $jj (keys(%{$vv}))
{
$alltabh{$jj} = 1;
}
}
# build column PROJECTION switch statements
for my $projtname (sort(keys(%{$bigh})))
{
next # ignore comments
if ($projtname =~ m/^\_\_/);
next
unless (exists($alltabh{$projtname}));
my $proj_cstr_colcase = "";
my $proj_oid_colcase = "";
# for all tables, build switch statement to
# extract (project) tuple columns.
# "fixed" columns are not nullable.
if (exists($ffh->{$projtname}))
{
for my $ffcdef (@{$ffh->{$projtname}->{cols}})
{
my $projcolname = $ffcdef->{colname};
next
unless ($ffcdef->{ctype} =~
m/NameData|text|Oid|regproc/);
if ($ffcdef->{ctype} =~ m/NameData/)
{
$proj_cstr_colcase .= doformat(
projnamcolcase($ffcdef->{fixed}),
{
PROJCOLUMNNAME => $projcolname,
PROJTABLEFORM =>
struct_form_tname($projtname),
PROJCOLATTNUM => $ffcdef->{attnum}
}
);
}
elsif ($ffcdef->{ctype} =~ m/text/)
{
$proj_cstr_colcase .= doformat(projtxtcolcase(),
{
PROJCOLUMNNAME => $projcolname,
PROJTABLEFORM =>
struct_form_tname($projtname),
PROJCOLATTNUM => $ffcdef->{attnum}
}
);
}
# no array of Oid, regproc is equivalent to Oid
elsif ($ffcdef->{ctype} =~ m/regproc|Oid$/)
{
$proj_oid_colcase .= doformat(
projoidcolcase($ffcdef->{fixed}),
{
PROJCOLUMNNAME => $projcolname,
PROJTABLEFORM =>
struct_form_tname($projtname),
PROJCOLATTNUM => $ffcdef->{attnum}
}
);
}
}
}
$proj_cstr_case .= doformat(projcase_switch(),
{
PROJTABLENAME => $projtname,
PROJATTNUM => "pchn->attnum",
PROJCOLCASE => $proj_cstr_colcase,
PROJTYPMSG => "a cstring",
CASERELID =>
$bigh->{$projtname}->{CamelCaseRelationId}
}
)
if (length($proj_cstr_colcase));
$proj_oid_case .= doformat(projcase_switch(),
{
PROJTABLENAME => $projtname,
PROJATTNUM => "pchn->attnum",
PROJCOLCASE => $proj_oid_colcase,
PROJTYPMSG => "an oid",
CASERELID =>
$bigh->{$projtname}->{CamelCaseRelationId}
}
)
if (length($proj_oid_colcase));
}
# print $gpo "\n/*\n";
# print $gpo Data::Dumper->Dump([$ffh]);
# print $gpo "\n*/\n";
}
my $projsw = doformat(cstring_table_switch(),
{
TABLERELID => "pCtx->cq_relationId",
PROJCASE => $proj_cstr_case
}
);
my $projoidsw = doformat(cstring_table_switch(),
{
TABLERELID => "pCtx->cq_relationId",
PROJCASE => $proj_oid_case
}
);
print $gpo doformat(caql_fetch_cols(),
{
LOOKUP => "cq_lookup",
GETCSTRINGTABLESWITCH => $projsw,
GETOIDTABLESWITCH => $projoidsw
}
);
print $gpo doformat(caql_logquery(),
{}
);
close $gpo;
} # end do_gperf
sub get_builtin_object_check_case_str()
{
my $str = "";
my @clist = ("GpPolicyRelationId, FormData_gp_policy *, localoid",
"AggregateRelationId, Form_pg_aggregate, aggfnoid",
"AccessMethodOperatorRelationId, Form_pg_amop, amopclaid",
"AccessMethodProcedureRelationId, Form_pg_amproc, amopclaid",
"AppendOnlyRelationId, Form_pg_appendonly, relid",
"AttrDefaultRelationId, Form_pg_attrdef, adrelid",
"AttributeRelationId, Form_pg_attribute, attrelid",
"AttributeEncodingRelationId, Form_pg_attribute_encoding, attrelid",
"AuthMemRelationId, Form_pg_auth_members, roleid",
"AuthTimeConstraintRelationId, Form_pg_auth_time_constraint, authid",
"DependRelationId, Form_pg_depend, objid",
"DescriptionRelationId, Form_pg_description, objoid",
"ExtTableRelationId, Form_pg_exttable, reloid",
"FileSpaceEntryRelationId, Form_pg_filespace_entry, fsefsoid",
"IndexRelationId, Form_pg_index, indexrelid",
"InheritsRelationId, Form_pg_inherits, inhrelid",
"PartitionEncodingRelationId, Form_pg_partition_encoding, parencoid",
"PLTemplateRelationId, Form_pg_pltemplate, tmplname",
"TriggerRelationId, Form_pg_trigger, tgrelid",
"RewriteRelationId, Form_pg_rewrite, ev_class",
"ProcCallbackRelationId, Form_pg_proc_callback, profnoid",
"SharedDependRelationId, Form_pg_shdepend, objid",
"SharedDescriptionRelationId, Form_pg_shdescription, objoid",
"StatLastOpRelationId, Form_pg_statlastop, objid",
"StatLastShOpRelationId, Form_pg_statlastshop, objid",
"StatisticRelationId, Form_pg_statistic, starelid",
"TypeEncodingRelationId, Form_pg_type_encoding, typid",
"WindowRelationId, Form_pg_window, winfnoid"
);
for my $lin (@clist)
{
my @foo = split(/, /, $lin);
if ($foo[0] =~ /PLTemplateRelationId/)
{
$str .= <<'EOF_str';
case PLTemplateRelationId:
{
char *name_str = pstrdup(NameStr(((Form_pg_pltemplate) GETSTRUCT(tuple))->tmplname));
if ((strcmp(name_str, "plpgsql") != 0) ||
(strcmp(name_str, "c") != 0) ||
(strcmp(name_str, "sql") != 0) ||
(strcmp(name_str, "internal") != 0))
result = InvalidOid;
break;
}
EOF_str
}
else
{
$str .= <<EOF_str;
case $foo[0]:
result = (Oid) (($foo[1]) GETSTRUCT(tuple))->$foo[2];
break;
EOF_str
}
}
return $str;
}
sub get_disable_catalog_check_str()
{
my $bigstr = <<'EOF_bigstr';
EOF_bigstr
return $bigstr;
}
sub get_disable_attribute_check_str()
{
my $bigstr = <<'EOF_bigstr';
EOF_bigstr
return $bigstr;
}
sub get_builtin_object_check_str()
{
my $bigstr = <<'EOF_bigstr';
bool
is_builtin_object(cqContext *pCtx, HeapTuple tuple)
{
Oid result = InvalidOid;
if (!HeapTupleIsValid(tuple))
return true;
if (tuple->t_data->t_infomask & HEAP_HASOID)
result = HeapTupleGetOid(tuple);
else
{
switch(pCtx->cq_relationId)
{
{BUILTIN_OBJECT_CHECK_CASE}
default:
return false;
}
}
if (result > FirstNormalObjectId)
return false;
return true;
}
EOF_bigstr
return $bigstr;
}
sub get_syscacheid_map
{
my ($idxcacheidmap, $whole_sysc) = @_;
my $prevlin;
my @lines = split(/\n/, $whole_sysc);
for my $lin (@lines)
{
if ($lin !~ m/^\s*\w+IndexId\,\s*$/)
{
$prevlin = $lin;
next;
}
my $idx = $lin;
$idx =~ s/\,\s*$//;
$idx =~ s/^\s*//;
die "bad syscache file: $prevlin\n$lin"
unless ($prevlin =~ m|\/\*\s*\w+\s*\*\/|);
# comment in previous line is " /* cacheid */ "
my @foo = ($prevlin =~ m|\/\*\s*(\w+)\s*\*\/|);
$idxcacheidmap->{$idx} = $foo[0];
$prevlin = $lin;
}
# print Data::Dumper->Dump([$idxcacheidmap]);
} # end get_syscacheid_map
sub caql_stats
{
my ($caqlh, $bigh) = @_;
my $bigstr = <<'EOF_bigstr';
/* ----------------------------------------------------------------
* catquery statistics
*
* total files: {nfiles}
* total caql queries (including inserts): {nqueries}
* total unique queries: {nuniq}
* total basic queries: {nbasic}
* total insert statements: {ninsert}
*
* locking - table locks required for
* {numlocktab} tables, {numlockfun} functions:
{tablelocks}
* space and case-sensitive query duplicates:
{hashdups}
* ----------------------------------------------------------------
*/
EOF_bigstr
my $totquerycnt = 0;
my $totinsertcnt = 0;
my %dupcheck;
# for all distinct queries
while (my ($kk, $vv) = each(%{$caqlh->{queries}}))
{
# check for statements that differ only by spacing or case
my $k2 = lc($kk);
$k2 =~ s/\s+/ /g;
$k2 =~ s/^\s+//;
$k2 =~ s/\s+$//;
$dupcheck{$k2} = []
unless (exists($dupcheck{$k2}));
push @{$dupcheck{$k2}}, '"' . $kk . '"';
# for every file that contains that query, sum the count
while (my ($jj, $ww) = each(%{$vv->{files}}))
{
$totquerycnt += $ww;
}
}
while (my ($kk, $vv) = each(%{$caqlh->{basic}}))
{
$totinsertcnt += 1
if ($kk =~ m/^insert/i);
}
my $tablelocks = "";
my $hashdups = "";
# if the "deduplicated" query list has duplicates, print them
while (my ($kk, $vv) = each(%dupcheck))
{
next unless (scalar(@{$vv}) > 1);
# more than 1 query for "deduped" list
$hashdups .= join("\n", @{$vv}) . "\n";
}
my @tlockl;
my %tabh;
my $numLockTab = 0;
my $numLockFunc = 0;
# find functions where had to lock entire table
for my $bq (sort(keys(%{$caqlh->{basic}})))
{
my $bq_tname = $caqlh->{basic}->{$bq}->{tablename};
if (exists($bigh->{$bq_tname}->{calico}) &&
exists($bigh->{$bq_tname}->{calico}->{lock_entire_table}) &&
($bigh->{$bq_tname}->{calico}->{lock_entire_table}))
{
# build list of indented function names
$tabh{$bq_tname} = ""
unless (exists($tabh{$bq_tname}));
$tabh{$bq_tname} .= "\n"
if (length($tabh{$bq_tname}));
$tabh{$bq_tname} .= "\t\t" . $caqlh->{basic}->{$bq}->{func_name};
$numLockFunc++;
}
}
for my $ttname (sort(keys(%tabh)))
{
$numLockTab++;
push @tlockl, $ttname . "\n" . $tabh{$ttname} . "\n";
}
# if any tables require tablelocks, list them
if (scalar(@tlockl))
{
# list of all tablenames and affected functions
$tablelocks = join("\n", @tlockl) . "\n";
}
$tablelocks = "<None>"
unless (length($tablelocks));
$hashdups = "<None>"
unless (length($hashdups));
$bigstr = doformat($bigstr,
{
nfiles => scalar(keys(%{$caqlh->{files}})) ,
nqueries => $totquerycnt,
nuniq => scalar(keys(%{$caqlh->{queries}})),
nbasic => scalar(keys(%{$caqlh->{basic}})),
ninsert => $totinsertcnt,
hashdups => $hashdups,
tablelocks => $tablelocks,
numlocktab => $numLockTab,
numlockfun => $numLockFunc,
}
);
return $bigstr;
} # end caql_stats
# enhance bigh with reversed primary key dependency (for caql delete)
sub bigh_fk_fixup
{
my $bigh = shift;
while (my ($kk, $vv) = each(%{$bigh}))
{
my $tname = $kk;
next # ignore comments
if ($tname =~ m/^\_\_/);
$bigh->{$tname}->{calico} = {}; # special calico attributes
# XXX XXX NOTE: IUD Exceptions
# 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: stupid last_operation/shoperation fixup
if ($tname =~ m/pg\_stat\_last\_(sh)?operation/)
{
$bigh->{$tname}->{calico}->{iud_exception} = 1;
next;
}
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# track the primary keys for each table
if (exists($bigh->{$tname}->{indexes}))
{
$bigh->{$tname}->{calico}->{pkeys} = [];
for my $idx (@{$bigh->{$tname}->{indexes}})
{
if (exists($idx->{unique}) &&
$idx->{unique})
{
push @{$bigh->{$tname}->{calico}->{pkeys}},
$idx->{CamelCaseIndexId};
}
}
}
next
unless (exists($bigh->{$tname}->{fk_list}));
# find all unique indexes whose prefixes are oid columns. If
# those columns are foreign keys, then this relation is a
# "dependent class" of the parent relation. For the
# purposes of locking, we can lock the parent relation primary
# key exclusively, which will lock the dependent class.
#
# Why this works: if we can lock the primary key of the
# dependent class, it needs to get a share lock on foreign
# keys, and one of those foreign keys is a primary key of the
# parent.
my $oidcol2idx = {};
if (exists($bigh->{$tname}->{indexes}))
{
for my $ii (0..(scalar(@{$bigh->{$tname}->{indexes}}) - 1))
{
my $idx = $bigh->{$tname}->{indexes}->[$ii];
# first column (cols[0]) is [name, "type_ops"] pair
# -- it must be an oid for this to work.
next
unless ($idx->{cols}->[0]->[1] eq "oid_ops");
my $colname = $idx->{cols}->[0]->[0];
$oidcol2idx->{$colname} = []
unless (exists($oidcol2idx->{$colname}));
my $idxdesc = {idxname => $idx->{CamelCaseIndexId},
firstcol => $colname, idxoffset => $ii };
# NOTE: if index is not unique, then table is not
# necessarily a "dependent table", but the parent
# index still works for locking if it is a primary key
push @{$oidcol2idx->{$colname}}, $idxdesc;
}
} # end for indexes
for my $fk (@{$bigh->{$tname}->{fk_list}})
{
my $pktname = $fk->{pktable};
# track "parent key" dependencies for delete, ie if
# deleting from this table, then find tables that depend
# on its primary key
$bigh->{$pktname}->{pk_dependent} = {}
unless (exists($bigh->{$pktname}->{pk_dependent}));
$bigh->{$pktname}->{pk_dependent}->{$tname} = {}
unless (exists($bigh->{$pktname}->{pk_dependent}->{$tname}));
my $isvec = "";
$isvec = " [vector]"
if ($fk->{type} =~ m/vector/i);
my $fkentry = "(" . join(", ", @{$fk->{fkcols}}) .
") <- (" . join(", ", @{$fk->{pkcols}}) . ")" .
$isvec;
# set of primary key cols for tname in pktname
# listed as "(keycols) <- (fk key cols)"
$bigh->{$pktname}->{pk_dependent}->{$tname}->{$fkentry} = 1;
next # does the primary key have a single column?
unless (1 == scalar(@{$fk->{pkcols}}));
# get column names of first (and only) column of pk/fk
my $firstcol = $fk->{fkcols}->[0];
my $pk1stcol = $fk->{pkcols}->[0]; # should just be oid?
next
unless (exists($oidcol2idx->{$firstcol}));
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# Great! the first column of the foreign key is the first
# column of a unique index on this table. And if it is
# the first (and only) column of a primary key index on
# the pktable then note that information.
# It indicates that this table is a "dependent class" of
# the parent relation (the "primary key" table), so
# locking the primary key of the parent table will lock a
# portion of the primary key on this table. Which is
# really what you want to do if you want to lock all the
# records in this relation that depend on the primary key
# of the parent table.
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
# XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX XXX
for my $idxdesc (@{$oidcol2idx->{$firstcol}})
{
next
unless (exists($bigh->{$pktname}->{indexes}));
for my $pkidx (@{$bigh->{$pktname}->{indexes}})
{
# must be unique, single col oid index
next
unless (exists($pkidx->{unique}) &&
$pkidx->{unique} &&
(1 == scalar(@{$pkidx->{cols}})));
# first col description: [colname, "type_ops"]
my $pk1c = $pkidx->{cols}->[0];
next # type must be oid
unless ($pk1c->[1] eq "oid_ops");
next # must match name
unless ($pk1c->[0] eq $pk1stcol);
# finally!! This unique index on the "primary
# key" table is the prefix of our primary key
my $depidx =
$bigh->{$tname}->{indexes}->[$idxdesc->{idxoffset}];
# add "primarykey_prefix" attribute to the
# dependent table index
$depidx->{primarykey_prefix} = {
pktname => $pktname,
pkrelid => $bigh->{$pktname}->{CamelCaseRelationId},
pkidx => $pkidx->{CamelCaseIndexId},
pkcolname => $pk1stcol,
fkcolname => $firstcol,
};
} # end for my pkidx
} # end for my idxdesc
} # end for my fk
} # end while kk vv
} # end bigh_fk_fixup
if (1)
{
my $whole_file;
{
my $injson;
open $injson, "< $glob_glob->{metadata}"
or die "cannot open $glob_glob->{metadata}: $!";
# $$$ $$$ undefine input record separator (\n)
# and slurp entire file into variable
local $/;
undef $/;
$whole_file = <$injson>;
close $injson;
}
my $bigh = JSON::from_json($whole_file);
if (exists($glob_glob->{interactive}) && $glob_glob->{interactive} )
{
do_interactive($bigh);
exit(0);
}
# enhance bigh with reversed primary key dependency (for caql delete)
bigh_fk_fixup($bigh);
## print JSON::to_json($bigh, {pretty => 1, indent => 2, canonical => 1});
my $caqlh = {queries => {}, files => {}, basic => {} };
# if infiles is specified, use this file list, else read from command line
if (exists($glob_glob->{inputfiles}) && $glob_glob->{inputfiles} )
{
my $infil;
open $infil, "< $glob_glob->{inputfiles}"
or die "cannot open $glob_glob->{inputfiles}: $!";
my $filnam;
while ( $filnam = <$infil> )
{
chomp($filnam);
get_caql($caqlh, $filnam, $bigh);
} # end for my $filnam
close $infil;
}
else
{
for my $filnam (@ARGV)
{
get_caql($caqlh, $filnam, $bigh);
} # end for my $filnam
}
# print Data::Dumper->Dump([$caqlh]);
# deduplicate the iud functions, and build a map (by
# iud_func_name) to the lists of basic queries sharing the
# function
my $iud_dedup = {};
$glob_glob->{iud2bq} = {};
my $ii = 1;
for my $bq (sort(keys(%{$caqlh->{basic}})))
{
my $funcname = "caql_basic_fn_$ii";
$caqlh->{basic}->{$bq}->{func_note} = "";
$caqlh->{basic}->{$bq}->{func} =
dothing($bigh, $bq, $funcname,
$caqlh->{basic}->{$bq});
$caqlh->{basic}->{$bq}->{func_number} = $ii;
$caqlh->{basic}->{$bq}->{func_name} = $funcname;
# now do the iud functions
$caqlh->{basic}->{$bq}->{iud_func_name} =
"caql_iud_fn_$ii";
my $iud_func = do_iud($bigh, $bq,
# $caqlh->{basic}->{$bq}->{iud_func_name},
# NOTE: don't specify the function name yet
"{IUD_FUNC_NAME}",
$caqlh->{basic}->{$bq});
# check if already have this function (but make into single
# alpha string)
my $ifq = sql_func_quurl($iud_func);
if (exists($iud_dedup->{$ifq}))
{
# found a duplicate
$iud_dedup->{$ifq}->{count} += 1;
$caqlh->{basic}->{$bq}->{iud_func_name} =
$iud_dedup->{$ifq}->{name};
$caqlh->{basic}->{$bq}->{iud_func} = undef;
# track all basic queries sharing an iud function
push
@{$glob_glob->{iud2bq}->{$iud_dedup->{$ifq}->{name}}},
$bq;
}
else
{
# new iud function - add it to the list
$iud_dedup->{$ifq} =
{ count => 1,
name =>
$caqlh->{basic}->{$bq}->{iud_func_name}};
# XXX XXX: replace the function name now! we couldn't do
# it before because it breaks duplicate checking.
$iud_func =
doformat($iud_func,
{
IUD_FUNC_NAME =>
$caqlh->{basic}->{$bq}->{iud_func_name}
});
$caqlh->{basic}->{$bq}->{iud_func} = $iud_func;
# track all basic queries sharing an iud function
$glob_glob->{iud2bq}->{$iud_dedup->{$ifq}->{name}} = [ $bq ];
}
$ii++;
}
if (exists($glob_glob->{gperf}) && $glob_glob->{gperf} )
{
# build the gperf input file
do_gperf($caqlh, $glob_glob->{gperf}, $bigh);
# run gperf
my $gperfstr =
"gperf -S 1 --hash-fn-name=cq_hash --lookup-fn-name=cq_lookup" .
" --duplicates " .
# XXX XXX: add some more keys to fix dups
" --key=11,18,20,27,29,39,43,61,92" .
" -t $glob_glob->{gperf} ";
# NOTE: this string is very large -- it's all of catquery.c
my $gperfout = `$gperfstr`;
# from perlfunc - get system status
if ($? != 0)
{
my $errstr;
if ($? == -1) {
$errstr = "failed to execute: $!\n";
}
elsif ($? & 127) {
$errstr = sprintf "child died with signal %d, %s coredump\n",
($? & 127), ($? & 128) ? 'with' : 'without';
}
else {
$errstr = sprintf "child exited with value %d\n", $? >> 8;
}
die ("gperf call failed: $errstr");
}
# remove inline directives, and change declaration of
# cq_lookup to static
$gperfout =~ s/^\_\_inline//gm;
$gperfout =~ s/^inline//gm;
# fix newer gperf
$gperfout =~ s/^\_\_attribute\_\_ \(\(\_\_gnu\_inline\_\_\)\)//gm;
$gperfout =~
s/^struct caql_hash_cookie \*/static struct caql_hash_cookie */gm;
# print generated file
print $gperfout;
}
# dump routine
if (exists($glob_glob->{dump}) && $glob_glob->{dump} )
{
if (0)
{
for my $bq (sort(keys(%{$caqlh->{basic}})))
{
print "$bq :\n\n";
print Data::Dumper->Dump([$caqlh->{basic}->{$bq}]);
}
}
else
{
my %hx;
# build a json doc keyed by func name, and strip out
# "extraneous" attributes like the function name, the
# function body, etc.
for my $bq (sort(keys(%{$caqlh->{basic}})))
{
# print "$bq :\n\n";
# print Data::Dumper->Dump([$caqlh->{basic}->{$bq}]);
my $th = {};
$th->{basic_query} = $bq;
for my $bqk (keys(%{$caqlh->{basic}->{$bq}}))
{
next if (($bqk =~ m/^func/) && ($bqk !~ /index/));
$th->{$bqk} = $caqlh->{basic}->{$bq}->{$bqk};
}
$hx{$caqlh->{basic}->{$bq}->{func_name}} = $th;
}
print JSON::to_json(\%hx,
{pretty => 1, indent => 2,
canonical => 1});
}
}
# caql definitions
if (exists($glob_glob->{uniqdef}) && length($glob_glob->{uniqdef}))
{
my $f2mfh;
open $f2mfh, "> $glob_glob->{uniqdef}" or
die "cannot open $glob_glob->{uniqdef}: $!";
print $f2mfh JSON::to_json($caqlh->{queries},
{pretty => 1, indent => 2,
canonical => 1});
close $f2mfh;
}
# caql definitions
if (exists($glob_glob->{basedef}) && length($glob_glob->{basedef}))
{
my $f2mfh;
open $f2mfh, "> $glob_glob->{basedef}" or
die "cannot open $glob_glob->{basedef}: $!";
print $f2mfh JSON::to_json($caqlh->{basic},
{pretty => 1, indent => 2,
canonical => 1});
close $f2mfh;
}
# build filemap for pablopcatso
if (exists($glob_glob->{fil2tab}) &&
exists($glob_glob->{filemap}) && length($glob_glob->{filemap}))
{
my %hx;
for my $kk (keys(%{$glob_glob->{fil2tab}}))
{
$hx{$kk} = [];
push @{$hx{$kk}}, (sort(keys(%{$glob_glob->{fil2tab}->{$kk}})));
}
my $f2mfh;
open $f2mfh, "> $glob_glob->{filemap}" or
die "cannot open $glob_glob->{filemap}: $!";
print $f2mfh JSON::to_json(\%hx,
{pretty => 1, indent => 2,
canonical => 1});
close $f2mfh;
}
}
sub caql_logquery
{
my $bigstr = <<'EOF_bigstr';
void
caql_logquery(const char *funcname, const char *filename, int lineno,
int uniqquery_code, Oid arg1)
{
EOF_bigstr
if ($glob_glob->{logquery})
{
$bigstr .= <<'EOF_bigstr';
SUPPRESS_ERRCONTEXT_DECLARE;
SUPPRESS_ERRCONTEXT_PUSH();
elog(LOG, "catquery: %s caller: %s %d %d %d ",
funcname, filename, lineno, uniqquery_code, arg1);
SUPPRESS_ERRCONTEXT_POP();
EOF_bigstr
}
elsif ($glob_glob->{logquery_hash})
{
$bigstr .= <<'EOF_bigstr';
CaQLLogTag tag;
CaQLLogEntry *entry;
int hashcode;
int len;
bool found = false;
SUPPRESS_ERRCONTEXT_DECLARE;
if (!gp_enable_caql_logging)
return;
if (CaQLLogHash == NULL)
{
HASHCTL hash_ctl;
hash_ctl.keysize = sizeof(CaQLLogTag);
hash_ctl.entrysize = sizeof(CaQLLogTag);
hash_ctl.hash = tag_hash;
CaQLLogHash = hash_create("caql log hash",
1000,
&hash_ctl,
HASH_ELEM | HASH_FUNCTION);
}
/* memset is required, as we use memcmp on this */
MemSet(&tag, 0, sizeof(CaQLLogTag));
len = strlen(filename);
if (len > MAXPGPATH - 1)
len = MAXPGPATH - 1;
memcpy(tag.filename, filename, len);
tag.lineno = lineno;
/* compute the hash */
hashcode = caqlLogHashCode(&tag);
/* look up the hash table to see if this line has been logged before */
entry = (CaQLLogEntry *) hash_search_with_hash_value(CaQLLogHash,
(void *) &tag,
hashcode,
HASH_ENTER, &found);
SUPPRESS_ERRCONTEXT_PUSH();
if (!found)
elog(LOG, "catquery: %s caller: %s %d %d %d ",
funcname, filename, lineno, uniqquery_code, arg1);
SUPPRESS_ERRCONTEXT_POP();
EOF_bigstr
}
$bigstr .= <<'EOF_bigstr';
}
EOF_bigstr
return $bigstr;
}