firebird/firebird-mirror
firebird/firebird-mirror
8
0
Fork 1
mirror of https://github.com/FirebirdSQL/firebird.git synced 2025-01-29 06:43:03 +01:00
Code Issues
1faaac2d34
firebird-mirror/src/gpre/gpre_meta.epp
brodsom 1faaac2d34 -BOOLEAN cleaning 
-Remove pfn_SQE_list_cb function casts
2003-09-10 19:48:53 +00:00

2213 lines
57 KiB
Plaintext
Raw Blame History

/*
* tab=4
*____________________________________________________________
*
* PROGRAM: C preprocessor
* MODULE: gpre_meta.epp
* DESCRIPTION: Meta data interface to system
*
* The contents of this file are subject to the Interbase Public
* License Version 1.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.Inprise.com/IPL.html
*
* Software distributed under the License is distributed on an
* "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express
* or implied. See the License for the specific language governing
* rights and limitations under the License.
*
* The Original Code was created by Inprise Corporation
* and its predecessors. Portions created by Inprise Corporation are
* Copyright (C) Inprise Corporation.
*
* All Rights Reserved.
* Contributor(s): ______________________________________.
*
*
*____________________________________________________________
*
* $Id: gpre_meta.epp,v 1.24 2003-09-10 19:48:53 brodsom Exp $
*/
#include "firebird.h"
#include <string.h>
#include "../jrd/gds.h"
#include "../gpre/gpre.h"
#include "../jrd/license.h"
#include "../gpre/parse.h"
#include "../jrd/intl.h"
#include "../gpre/gpre_proto.h"
#include "../gpre/hsh_proto.h"
#include "../gpre/jrdme_proto.h"
#include "../gpre/gpre_meta.h"
#include "../gpre/msc_proto.h"
#include "../gpre/par_proto.h"
#include "../jrd/constants.h"
#define MAX_USER_LENGTH 33
#define MAX_PASSWORD_LENGTH 33
DATABASE DB = FILENAME "yachts.lnk" RUNTIME database->dbb_filename;
extern enum lang_t sw_language;
extern bool sw_cstring;
extern DBB isc_databases;
static const UCHAR blr_bpb[] = { isc_bpb_version1,
isc_bpb_source_type, 1, BLOB_blr,
isc_bpb_target_type, 1, BLOB_blr
};
#ifdef SCROLLABLE_CURSORS
static SCHAR db_version_info[] = { gds__info_base_level };
#endif
static SLONG array_size(GPRE_FLD);
static void get_array(dbb*, TEXT *, GPRE_FLD);
static int get_intl_char_subtype(SSHORT *, UCHAR *, USHORT, dbb*);
static int resolve_charset_and_collation(SSHORT *, UCHAR *, UCHAR *);
static int symbol_length(TEXT *);
#ifdef NOT_USED_OR_REPLACED
static int upcase(TEXT *, TEXT *);
#endif
/*____________________________________________________________
*
* Lookup a field by name in a context.
* If found, return field block. If not, return NULL.
*/
GPRE_FLD MET_context_field( GPRE_CTX context, char *string)
{
SYM symbol;
GPRE_PRC procedure;
GPRE_FLD field;
SCHAR name[NAME_SIZE];
if (context->ctx_relation) {
return (MET_field(context->ctx_relation, string));
}
if (!context->ctx_procedure) {
return NULL;
}
strcpy(name, string);
procedure = context->ctx_procedure;
/* At this point the procedure should have been scanned, so all
* its fields are in the symbol table.
*/
field = NULL;
for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym) {
if (symbol->sym_type == SYM_field &&
(field = (GPRE_FLD) symbol->sym_object) &&
field->fld_procedure == procedure)
{
return field;
}
}
return field;
}
/*____________________________________________________________
*
* Initialize meta data access to database. If the
* database can't be opened, return FALSE.
*/
BOOLEAN MET_database(dbb* database, BOOLEAN print_version)
{
SCHAR dpb[MAX_PASSWORD_LENGTH + MAX_USER_LENGTH + 5], *d, *p;
static const UCHAR sql_version_info[] = { isc_info_base_level,
isc_info_ods_version,
isc_info_db_sql_dialect,
isc_info_end
};
/*
** Each info item requested will return
**
** 1 byte for the info item tag
** 2 bytes for the length of the information that follows
** 1 to 4 bytes of integer information
**
** isc_info_end will not have a 2-byte length - which gives us
** some padding in the buffer.
*/
UCHAR sql_buffer[sizeof(sql_version_info) * (1 + 2 + 4)];
UCHAR *ptr;
#ifndef REQUESTER
if (sw_language == lang_internal) {
JRDMET_init(database);
return TRUE;
}
#endif
DB = NULL;
if (!database->dbb_filename) {
CPR_error("No database specified");
return FALSE;
}
/* generate a dpb for the attach from the specified
* compiletime user name and password
*/
d = dpb;
if (database->dbb_c_user || database->dbb_c_password) {
*d++ = gds_dpb_version1;
if (p = database->dbb_c_user) {
*d++ = gds_dpb_user_name;
*d++ = strlen(p);
while (*p)
*d++ = *p++;
}
if (p = database->dbb_c_password) {
*d++ = gds_dpb_password;
*d++ = strlen(p);
while (*p)
*d++ = *p++;
}
}
if (gds__attach_database
(gds_status, 0, database->dbb_filename, &DB, d - &dpb[0], dpb)) {
/* We failed to attach, try in read only mode just in case
if (d == dpb)
*d++ = gds_dpb_version1;
*d++ = isc_dpb_set_db_readonly;
*d++ = 1;
*d++ = TRUE;
if (gds__attach_database
(gds_status, 0, database->dbb_filename, &DB, d - &dpb[0], dpb)) {
*/
gds__print_status(gds_status);
return FALSE;
//}
}
database->dbb_handle = DB;
if (sw_version && print_version) {
ib_printf(" Version(s) for database \"%s\"\n", database->dbb_filename);
gds__version(&DB, NULL, NULL);
}
sw_ods_version = 0;
sw_server_version = 0;
if (isc_database_info(isc_status, &DB, sizeof(sql_version_info),
(char*) sql_version_info, sizeof(sql_buffer), (char*) sql_buffer)) {
gds__print_status(isc_status);
return FALSE;
}
ptr = sql_buffer;
while (*ptr != isc_info_end) {
UCHAR item;
USHORT length;
item = (UCHAR) * ptr++;
length = isc_vax_integer((char*)ptr, sizeof(USHORT));
ptr += sizeof(USHORT);
switch (item) {
case isc_info_base_level:
sw_server_version = (USHORT) ptr[1];
break;
case isc_info_ods_version:
sw_ods_version = isc_vax_integer((char*)ptr, length);
break;
case isc_info_db_sql_dialect:
compiletime_db_dialect = isc_vax_integer((char*)ptr, length);
break;
case isc_info_error:
/* Error indicates that one of the option
was not understood by thr server. Make sure it was
isc_info_db_sql_dialect and assume
that the database dialect is SQL_DIALECT_V5
*/
if ((sw_server_version != 0) && (sw_ods_version != 0))
compiletime_db_dialect = SQL_DIALECT_V5;
else
ib_printf("Internal error: Unexpected isc_info_value %d\n",
item);
break;
default:
ib_printf("Internal error: Unexpected isc_info_value %d\n", item);
break;
}
ptr += length;
}
if (!dialect_specified)
sw_sql_dialect = compiletime_db_dialect;
if (sw_ods_version < 10) {
if (sw_sql_dialect != compiletime_db_dialect) {
char warn_mesg[100];
sprintf(warn_mesg,
"Pre 6.0 database. Cannot use dialect %d, Resetting to %d\n",
sw_sql_dialect, compiletime_db_dialect);
CPR_warn(warn_mesg);
}
sw_sql_dialect = compiletime_db_dialect;
}
else if (sw_sql_dialect != compiletime_db_dialect) {
char warn_mesg[100];
sprintf(warn_mesg,
"Client dialect set to %d. Compiletime database dialect is %d\n",
sw_sql_dialect, compiletime_db_dialect);
CPR_warn(warn_mesg);
}
#ifdef DEBUG
if (sw_version && print_version)
ib_printf("Gpre Start up values. \
\n\tServer Ver : %d\
\n\tCompile time db Ver : %d\
\n\tCompile time db Sql Dialect : %d\
\n\tClient Sql dialect set to : %d\n\n", sw_server_version, sw_ods_version, compiletime_db_dialect, sw_sql_dialect);
#endif
#ifdef SCROLLABLE_CURSORS
SCHAR buffer[16];
/* get the base level of the engine */
if (gds__database_info(gds_status, &DB, sizeof(db_version_info),
db_version_info, sizeof(buffer), buffer)) {
gds__print_status(gds_status);
return FALSE;
}
/* this seems like a lot of rigamarole to read one info item,
* but it provides for easy extensibility in case we need
* more info items later
*/
SCHAR* data = buffer;
while ((p = *data++) != gds__info_end) {
l = isc_vax_integer(data, 2);
data += 2;
switch ((int) p) {
/* This flag indicates the version level of the engine
itself, so we can tell what capabilities the engine
code itself (as opposed to the on-disk structure).
Apparently the base level up to now indicated the major
version number, but for 4.1 the base level is being
incremented, so the base level indicates an engine version
as follows:
1 == v1.x
2 == v2.x
3 == v3.x
4 == v4.0 only
5 == v4.1
Note: this info item is so old it apparently uses an
archaic format, not a standard vax integer format.
*/
case gds__info_base_level:
database->dbb_base_level = (USHORT) data[1];
break;
default:
;
}
data += l;
}
#endif
return TRUE;
}
/*____________________________________________________________
*
* Lookup a domain by name.
* Initialize the size of the field.
*/
USHORT MET_domain_lookup(GPRE_REQ request, GPRE_FLD field, char *string)
{
SYM symbol;
dbb* database;
SCHAR name[NAME_SIZE];
GPRE_FLD d_field;
SSHORT found = FALSE;
strcpy(name, string);
/* Lookup domain. If we find it in the hash table, and it is not the
* field we a currently looking at, use it. Else look it up from the
* database.
*/
for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
if ((symbol->sym_type == SYM_field) &&
((d_field = (GPRE_FLD) symbol->sym_object) && (d_field != field))) {
field->fld_length = d_field->fld_length;
field->fld_scale = d_field->fld_scale;
field->fld_sub_type = d_field->fld_sub_type;
field->fld_dtype = d_field->fld_dtype;
field->fld_ttype = d_field->fld_ttype;
field->fld_charset_id = d_field->fld_charset_id;
field->fld_collate_id = d_field->fld_collate_id;
field->fld_char_length = d_field->fld_char_length;
return TRUE;
}
if (!request)
return FALSE;
database = request->req_database;
if (database->dbb_flags & DBB_sqlca)
return FALSE;
DB = database->dbb_handle;
gds_trans = database->dbb_transaction;
if (!(database->dbb_flags & DBB_v3)) {
FOR(REQUEST_HANDLE database->dbb_domain_request)
F IN RDB$FIELDS WITH F.RDB$FIELD_NAME EQ name found = TRUE;
field->fld_length = F.RDB$FIELD_LENGTH;
field->fld_scale = F.RDB$FIELD_SCALE;
field->fld_sub_type = F.RDB$FIELD_SUB_TYPE;
field->fld_dtype =
MET_get_dtype(F.RDB$FIELD_TYPE, F.RDB$FIELD_SUB_TYPE,
&field->fld_length);
switch (field->fld_dtype) {
case dtype_text:
case dtype_cstring:
field->fld_flags |= FLD_text;
break;
case dtype_blob:
field->fld_flags |= FLD_blob;
field->fld_seg_length = F.RDB$SEGMENT_LENGTH;
break;
}
if (field->fld_dtype <= dtype_any_text) {
if (!F.RDB$CHARACTER_LENGTH.NULL)
field->fld_char_length = F.RDB$CHARACTER_LENGTH;
if (!F.RDB$CHARACTER_SET_ID.NULL)
field->fld_charset_id = F.RDB$CHARACTER_SET_ID;
if (!F.RDB$COLLATION_ID.NULL)
field->fld_collate_id = F.RDB$COLLATION_ID;
}
field->fld_ttype =
INTL_CS_COLL_TO_TTYPE(field->fld_charset_id,
field->fld_collate_id);
END_FOR;
}
else {
FOR(REQUEST_HANDLE database->dbb_domain_request)
F IN RDB$FIELDS WITH F.RDB$FIELD_NAME EQ name found = TRUE;
field->fld_length = F.RDB$FIELD_LENGTH;
field->fld_scale = F.RDB$FIELD_SCALE;
field->fld_sub_type = F.RDB$FIELD_SUB_TYPE;
field->fld_dtype =
MET_get_dtype(F.RDB$FIELD_TYPE, F.RDB$FIELD_SUB_TYPE,
&field->fld_length);
switch (field->fld_dtype) {
case dtype_text:
case dtype_cstring:
field->fld_flags |= FLD_text;
break;
case dtype_blob:
field->fld_flags |= FLD_blob;
field->fld_seg_length = F.RDB$SEGMENT_LENGTH;
break;
}
field->fld_ttype =
INTL_CS_COLL_TO_TTYPE(field->fld_charset_id,
field->fld_collate_id);
END_FOR;
}
return found;
}
/*____________________________________________________________
*
* Gets the default value for a domain of an existing table
*/
BOOLEAN MET_get_domain_default(dbb* database,
TEXT * domain_name,
TEXT * buffer, USHORT buff_length)
{
FRBRD *DB, *gds_trans;
SCHAR name[NAME_SIZE];
SSHORT length;
bool has_default = false;
ISC_STATUS_ARRAY status_vect;
isc_blob_handle blob_handle = NULL;
ISC_QUAD *blob_id;
TEXT *ptr_in_buffer;
ISC_STATUS stat;
strcpy(name, domain_name);
if (database == NULL)
return FALSE;
if ((database->dbb_handle == NULL) && !MET_database(database, FALSE))
CPR_exit(FINI_ERROR);
assert(database->dbb_transaction == NULL);
gds_trans = NULL;
DB = database->dbb_handle;
START_TRANSACTION;
FOR(REQUEST_HANDLE database->dbb_domain_request)
GPRE_FLD IN RDB$FIELDS WITH
GPRE_FLD.RDB$FIELD_NAME EQ name if (!GPRE_FLD.RDB$DEFAULT_VALUE.NULL) {
blob_id = &GPRE_FLD.RDB$DEFAULT_VALUE;
/* open the blob */
stat = isc_open_blob2(status_vect, &DB, &gds_trans, &blob_handle,
blob_id, sizeof(blr_bpb), const_cast<unsigned char*>(blr_bpb));
if (stat) {
gds__print_status(status_vect);
CPR_exit(FINI_ERROR);
}
/* fetch segments. Assume buffer is big enough. */
ptr_in_buffer = buffer;
while (true) {
stat = isc_get_segment(status_vect, &blob_handle, (USHORT*) &length,
buff_length, ptr_in_buffer);
ptr_in_buffer = ptr_in_buffer + length;
buff_length = buff_length - length;
if (!stat)
continue;
else if (stat == gds_segstr_eof) {
/* null terminate the buffer */
*ptr_in_buffer = 0;
break;
}
else
CPR_exit(FINI_ERROR);
}
isc_close_blob(status_vect, &blob_handle);
/* the default string must be of the form:
blr_version4 blr_literal ..... blr_eoc OR
blr_version4 blr_null blr_eoc OR
blr_version4 blr_user_name blr_eoc */
assert(buffer[0] == blr_version4 || buffer[0] == blr_version5);
assert(buffer[1] == blr_literal ||
buffer[1] == blr_null || buffer[1] == blr_user_name);
has_default = true;
}
else { /* default not found */
if (sw_sql_dialect > SQL_DIALECT_V5)
buffer[0] = blr_version5;
else
buffer[0] = blr_version4;
buffer[1] = blr_eoc;
}
END_FOR COMMIT;
return (has_default? TRUE : FALSE);
}
/*____________________________________________________________
*
* Gets the default value for a column of an existing table.
* Will check the default for the column of the table, if that is
* not present, will check for the default of the relevant domain
*
* The default blr is returned in buffer. The blr is of the form
* blr_version4 blr_literal ..... blr_eoc
*
* Reads the system tables RDB$FIELDS and RDB$RELATION_FIELDS.
*/
BOOLEAN MET_get_column_default(GPRE_REL relation,
TEXT * column_name,
TEXT * buffer, USHORT buff_length)
{
dbb* database;
FRBRD *DB, *gds_trans;
SCHAR name[NAME_SIZE];
SSHORT length;
bool has_default = false;
ISC_STATUS_ARRAY status_vect;
isc_blob_handle blob_handle = NULL;
ISC_QUAD *blob_id;
TEXT *ptr_in_buffer;
ISC_STATUS stat;
strcpy(name, column_name);
if ((database = relation->rel_database) == NULL)
return FALSE;
if ((database->dbb_handle == NULL) && !MET_database(database, FALSE))
CPR_exit(FINI_ERROR);
assert(database->dbb_transaction == NULL);
gds_trans = NULL;
DB = database->dbb_handle;
START_TRANSACTION;
FOR(REQUEST_HANDLE database->dbb_field_request)
RFR IN RDB$RELATION_FIELDS CROSS F IN RDB$FIELDS WITH
RFR.RDB$FIELD_SOURCE EQ F.RDB$FIELD_NAME AND
RFR.RDB$FIELD_NAME EQ name AND
RFR.RDB$RELATION_NAME EQ relation->rel_symbol->sym_string
if (!RFR.RDB$DEFAULT_VALUE.NULL) {
blob_id = &RFR.RDB$DEFAULT_VALUE;
has_default = true;
}
else if (!F.RDB$DEFAULT_VALUE.NULL) {
blob_id = &F.RDB$DEFAULT_VALUE;
has_default = true;
}
if (has_default) {
/* open the blob */
stat = isc_open_blob2(status_vect, &DB, &gds_trans,
&blob_handle, blob_id, sizeof(blr_bpb),
const_cast<unsigned char*>(blr_bpb));
if (stat) {
gds__print_status(status_vect);
CPR_exit(FINI_ERROR);
}
/* fetch segments. Assuming here that the buffer is big enough. */
ptr_in_buffer = buffer;
while (true) {
stat = isc_get_segment(status_vect, &blob_handle,
(USHORT*)&length, buff_length, ptr_in_buffer);
ptr_in_buffer = ptr_in_buffer + length;
buff_length = buff_length - length;
if (!stat)
continue;
else if (stat == gds_segstr_eof) {
/* null terminate the buffer */
*ptr_in_buffer = 0;
break;
}
else
CPR_exit(FINI_ERROR);
}
isc_close_blob(status_vect, &blob_handle);
/* the default string must be of the form:
blr_version4 blr_literal ..... blr_eoc OR
blr_version4 blr_null blr_eoc OR
blr_version4 blr_user_name blr_eoc */
assert(buffer[0] == blr_version4 || buffer[0] == blr_version5);
assert(buffer[1] == blr_literal ||
buffer[1] == blr_null || buffer[1] == blr_user_name);
}
else {
if (sw_sql_dialect > SQL_DIALECT_V5)
buffer[0] = blr_version5;
else
buffer[0] = blr_version4;
buffer[1] = blr_eoc;
}
END_FOR;
COMMIT;
return (has_default? TRUE : FALSE);
}
/*____________________________________________________________
*
* Lookup the fields for the primary key
* index on a relation, returning a list
* of the fields.
*/
LLS MET_get_primary_key(dbb* database, TEXT * relation_name)
{
LLS fields = NULL, *ptr_fields;
FRBRD *DB, *gds_trans;
SCHAR name[NAME_SIZE];
STR field_name;
TEXT *tmp;
strcpy(name, relation_name);
if (database == NULL)
return NULL;
if ((database->dbb_handle == NULL) && !MET_database(database, FALSE))
CPR_exit(FINI_ERROR);
assert(database->dbb_transaction == NULL);
gds_trans = NULL;
DB = database->dbb_handle;
START_TRANSACTION;
ptr_fields = &fields;
FOR(REQUEST_HANDLE database->dbb_primary_key_request)
X IN RDB$INDICES CROSS
Y IN RDB$INDEX_SEGMENTS
OVER RDB$INDEX_NAME CROSS
Z IN RDB$RELATION_CONSTRAINTS
OVER RDB$INDEX_NAME
WITH Z.RDB$RELATION_NAME EQ name
AND Z.RDB$CONSTRAINT_TYPE EQ "PRIMARY KEY"
SORTED BY Y.RDB$FIELD_POSITION
field_name = (str*) MAKE_STRING(Y.RDB$FIELD_NAME);
/* Strip off any trailing spaces from field name */
tmp = (TEXT*) field_name;
while (*tmp && *tmp != ' ')
*tmp++;
*tmp = '\0';
PUSH((GPRE_NOD) field_name, ptr_fields);
ptr_fields = &(*ptr_fields)->lls_next;
END_FOR COMMIT;
return fields;
}
/*____________________________________________________________
*
* Lookup a field by name in a relation.
* If found, return field block. If not, return NULL.
*/
GPRE_FLD MET_field(GPRE_REL relation, char *string)
{
SYM symbol;
GPRE_FLD field;
dbb* database;
SCHAR name[NAME_SIZE];
SSHORT length;
strcpy(name, string);
length = strlen(name);
/* Lookup field. If we find it, nifty. If not, look it up in the
* database.
*/
for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
if (symbol->sym_type == SYM_keyword &&
symbol->sym_keyword == (int) KW_DBKEY) return relation->rel_dbkey;
else if (symbol->sym_type == SYM_field &&
(field = (GPRE_FLD) symbol->sym_object) &&
field->fld_relation == relation) return field;
if (sw_language == lang_internal)
return NULL;
database = relation->rel_database;
if (database->dbb_flags & DBB_sqlca)
return NULL;
DB = database->dbb_handle;
gds_trans = database->dbb_transaction;
field = NULL;
if (!(database->dbb_flags & DBB_v3)) {
FOR(REQUEST_HANDLE database->dbb_field_request)
RFR IN RDB$RELATION_FIELDS CROSS F IN RDB$FIELDS WITH
RFR.RDB$FIELD_SOURCE EQ F.RDB$FIELD_NAME AND
RFR.RDB$FIELD_NAME EQ name AND
RFR.RDB$RELATION_NAME EQ relation->rel_symbol->sym_string
field = (GPRE_FLD) ALLOC(FLD_LEN);
field->fld_relation = relation;
field->fld_next = relation->rel_fields;
relation->rel_fields = field;
field->fld_id = RFR.RDB$FIELD_ID;
field->fld_length = F.RDB$FIELD_LENGTH;
field->fld_scale = F.RDB$FIELD_SCALE;
field->fld_position = RFR.RDB$FIELD_POSITION;
field->fld_sub_type = F.RDB$FIELD_SUB_TYPE;
field->fld_dtype =
MET_get_dtype(F.RDB$FIELD_TYPE, F.RDB$FIELD_SUB_TYPE,
&field->fld_length);
switch (field->fld_dtype) {
case dtype_text:
case dtype_cstring:
field->fld_flags |= FLD_text;
break;
case dtype_blob:
field->fld_flags |= FLD_blob;
field->fld_seg_length = F.RDB$SEGMENT_LENGTH;
break;
}
if (F.RDB$DIMENSIONS && !(database->dbb_flags & DBB_no_arrays))
get_array(database, F.RDB$FIELD_NAME, field);
if ((field->fld_dtype <= dtype_any_text)
|| (field->fld_dtype == dtype_blob)) {
if (!F.RDB$CHARACTER_LENGTH.NULL)
field->fld_char_length = F.RDB$CHARACTER_LENGTH;
if (!F.RDB$CHARACTER_SET_ID.NULL)
field->fld_charset_id = F.RDB$CHARACTER_SET_ID;
if (!RFR.RDB$COLLATION_ID.NULL)
field->fld_collate_id = RFR.RDB$COLLATION_ID;
else if (!F.RDB$COLLATION_ID.NULL)
field->fld_collate_id = F.RDB$COLLATION_ID;
}
field->fld_ttype =
INTL_CS_COLL_TO_TTYPE(field->fld_charset_id,
field->fld_collate_id);
field->fld_symbol = symbol =
MSC_symbol(SYM_field, name, length, (GPRE_CTX) field);
HSH_insert(symbol);
field->fld_global = symbol =
MSC_symbol(SYM_field, RFR.RDB$FIELD_SOURCE,
symbol_length(RFR.RDB$FIELD_SOURCE), (GPRE_CTX) field);
END_FOR;
}
else {
FOR(REQUEST_HANDLE database->dbb_field_request)
RFR IN RDB$RELATION_FIELDS CROSS F IN RDB$FIELDS WITH
RFR.RDB$FIELD_SOURCE EQ F.RDB$FIELD_NAME AND
RFR.RDB$FIELD_NAME EQ name AND
RFR.RDB$RELATION_NAME EQ relation->rel_symbol->sym_string
field = (GPRE_FLD) ALLOC(FLD_LEN);
field->fld_relation = relation;
field->fld_next = relation->rel_fields;
relation->rel_fields = field;
field->fld_id = RFR.RDB$FIELD_ID;
field->fld_length = F.RDB$FIELD_LENGTH;
field->fld_scale = F.RDB$FIELD_SCALE;
field->fld_position = RFR.RDB$FIELD_POSITION;
field->fld_sub_type = F.RDB$FIELD_SUB_TYPE;
field->fld_dtype =
MET_get_dtype(F.RDB$FIELD_TYPE, F.RDB$FIELD_SUB_TYPE,
&field->fld_length);
switch (field->fld_dtype) {
case dtype_text:
case dtype_cstring:
field->fld_flags |= FLD_text;
break;
case dtype_blob:
field->fld_flags |= FLD_blob;
field->fld_seg_length = F.RDB$SEGMENT_LENGTH;
break;
}
if (!(database->dbb_flags & DBB_no_arrays))
get_array(database, F.RDB$FIELD_NAME, field);
field->fld_ttype =
INTL_CS_COLL_TO_TTYPE(field->fld_charset_id,
field->fld_collate_id);
field->fld_symbol = symbol =
MSC_symbol(SYM_field, name, length, (GPRE_CTX) field);
HSH_insert(symbol);
field->fld_global = symbol =
MSC_symbol(SYM_field, RFR.RDB$FIELD_SOURCE,
symbol_length(RFR.RDB$FIELD_SOURCE), (GPRE_CTX) field);
END_FOR;
}
return field;
}
/*____________________________________________________________
*
* Return a list of the fields in a relation
*/
GPRE_NOD MET_fields(GPRE_CTX context)
{
dbb* database;
GPRE_FLD field;
LLS stack;
GPRE_NOD node, field_node;
REF reference;
GPRE_PRC procedure;
GPRE_REL relation;
TEXT *p;
int count;
if (procedure = context->ctx_procedure) {
node = MAKE_NODE(nod_list, procedure->prc_out_count);
count = 0;
for (field = procedure->prc_outputs; field; field = field->fld_next) {
reference = (REF) ALLOC(REF_LEN);
reference->ref_field = field;
reference->ref_context = context;
field_node = MSC_unary(nod_field, (GPRE_NOD) reference);
node->nod_arg[field->fld_position] = field_node;
count++;
}
return node;
}
relation = context->ctx_relation;
if (relation->rel_meta) {
for (count = 0, field = relation->rel_fields; field;
field = field->fld_next) count++;
node = MAKE_NODE(nod_list, count);
count = 0;
for (field = relation->rel_fields; field; field = field->fld_next) {
reference = (REF) ALLOC(REF_LEN);
reference->ref_field = field;
reference->ref_context = context;
field_node = MSC_unary(nod_field, (GPRE_NOD) reference);
node->nod_arg[field->fld_position] = field_node;
count++;
}
return node;
}
if (sw_language == lang_internal)
return NULL;
database = relation->rel_database;
DB = database->dbb_handle;
gds_trans = database->dbb_transaction;
count = 0;
stack = NULL;
FOR(REQUEST_HANDLE database->dbb_flds_request)
RFR IN RDB$RELATION_FIELDS CROSS GPRE_FLD IN RDB$FIELDS WITH
RFR.RDB$FIELD_SOURCE EQ GPRE_FLD.RDB$FIELD_NAME AND
RFR.RDB$RELATION_NAME EQ relation->rel_symbol->sym_string
SORTED BY RFR.RDB$FIELD_POSITION
for (p = RFR.RDB$FIELD_NAME; *p && *p != ' '; p++);
*p = 0;
PUSH((GPRE_NOD) MET_field(relation, RFR.RDB$FIELD_NAME), &stack);
count++;
END_FOR;
node = MAKE_NODE(nod_list, count);
while (stack) {
field = (GPRE_FLD) POP(&stack);
reference = (REF) ALLOC(REF_LEN);
reference->ref_field = field;
reference->ref_context = context;
field_node = MSC_unary(nod_field, (GPRE_NOD) reference);
node->nod_arg[--count] = field_node;
}
return node;
}
/*____________________________________________________________
*
* Shutdown all attached databases.
*/
void MET_fini(dbb* end)
{
dbb* database;
for (database = isc_databases;
database && database != end;
database = database->dbb_next)
{
if (DB = database->dbb_handle) {
if (gds_trans = database->dbb_transaction)
COMMIT;
FINISH;
database->dbb_handle = NULL;
database->dbb_transaction = NULL;
database->dbb_field_request = NULL;
database->dbb_flds_request = NULL;
database->dbb_relation_request = NULL;
database->dbb_procedure_request = NULL;
database->dbb_udf_request = NULL;
database->dbb_trigger_request = NULL;
database->dbb_proc_prms_request = NULL;
database->dbb_proc_prm_fld_request = NULL;
database->dbb_index_request = NULL;
database->dbb_type_request = NULL;
database->dbb_array_request = NULL;
database->dbb_dimension_request = NULL;
database->dbb_domain_request = NULL;
database->dbb_generator_request = NULL;
database->dbb_view_request = NULL;
database->dbb_primary_key_request = NULL;
}
}
}
/*____________________________________________________________
*
* Lookup a generator by name.
* If found, return string. If not, return NULL.
*/
SCHAR *MET_generator(TEXT * string, dbb* database)
{
SYM symbol;
SCHAR name[NAME_SIZE];
strcpy(name, string);
for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
if ((symbol->sym_type == SYM_generator) &&
(database == (dbb*) (symbol->sym_object))) return symbol->sym_string;
return NULL;
}
/*____________________________________________________________
*
* Compute internal datatype and length based on system relation field values.
*/
USHORT MET_get_dtype(USHORT blr_dtype, USHORT sub_type, USHORT * length)
{
USHORT l, dtype;
l = *length;
switch (blr_dtype) {
case blr_varying:
case blr_text:
dtype = dtype_text;
if (sw_cstring && !SUBTYPE_ALLOWS_NULLS(sub_type)) {
++l;
dtype = dtype_cstring;
}
break;
case blr_cstring:
dtype = dtype_cstring;
++l;
break;
case blr_short:
dtype = dtype_short;
l = sizeof(SSHORT);
break;
case blr_long:
dtype = dtype_long;
l = sizeof(SLONG);
break;
case blr_quad:
dtype = dtype_quad;
l = sizeof(GDS__QUAD);
break;
case blr_float:
dtype = dtype_real;
l = sizeof(float);
break;
case blr_double:
dtype = dtype_double;
l = sizeof(double);
break;
case blr_blob:
dtype = dtype_blob;
l = sizeof(GDS__QUAD);
break;
/** Begin sql date/time/timestamp **/
case blr_sql_date:
dtype = dtype_sql_date;
l = sizeof(ISC_DATE);
break;
case blr_sql_time:
dtype = dtype_sql_time;
l = sizeof(ISC_TIME);
break;
case blr_timestamp:
dtype = dtype_timestamp;
l = sizeof(ISC_TIMESTAMP);
break;
/** Begin sql date/time/timestamp **/
case blr_int64:
dtype = dtype_int64;
l = sizeof(ISC_INT64);
break;
default:
CPR_error("datatype not supported");
}
*length = l;
return dtype;
}
/*____________________________________________________________
*
* Lookup a procedure (represented by a token) in a database.
* Return a procedure block (if name is found) or NULL.
*
* This function has been cloned into MET_get_udf
*/
GPRE_PRC MET_get_procedure(dbb* database, TEXT * string, TEXT * owner_name)
{
SYM symbol;
GPRE_FLD *fld_list, field;
GPRE_PRC procedure;
USHORT type, count;
SCHAR name[NAME_SIZE], owner[NAME_SIZE];
strcpy(name, string);
strcpy(owner, owner_name);
procedure = NULL;
for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
if (symbol->sym_type == SYM_procedure &&
(procedure = (GPRE_PRC) symbol->sym_object) &&
procedure->prc_database == database &&
(!owner[0] ||
(procedure->prc_owner
&& !strcmp(owner, procedure->prc_owner->sym_string)))) break;
if (!procedure)
return NULL;
if (procedure->prc_flags & PRC_scanned)
return procedure;
FOR(REQUEST_HANDLE database->dbb_procedure_request)
X IN RDB$PROCEDURES WITH X.RDB$PROCEDURE_ID = procedure->prc_id;
for (type = 0; type < 2; type++) {
count = 0;
if (type)
fld_list = &procedure->prc_outputs;
else
fld_list = &procedure->prc_inputs;
FOR(REQUEST_HANDLE database->dbb_proc_prms_request)
Y IN RDB$PROCEDURE_PARAMETERS WITH
Y.RDB$PROCEDURE_NAME EQ name AND
Y.RDB$PARAMETER_TYPE EQ type
SORTED BY DESCENDING Y.RDB$PARAMETER_NUMBER count++;
FOR(REQUEST_HANDLE database->dbb_proc_prm_fld_request)
F IN RDB$FIELDS WITH
Y.RDB$FIELD_SOURCE EQ F.RDB$FIELD_NAME
field = (GPRE_FLD) ALLOC(FLD_LEN);
field->fld_procedure = procedure;
field->fld_next = *fld_list;
*fld_list = field;
field->fld_position = Y.RDB$PARAMETER_NUMBER;
field->fld_length = F.RDB$FIELD_LENGTH;
field->fld_scale = F.RDB$FIELD_SCALE;
field->fld_sub_type = F.RDB$FIELD_SUB_TYPE;
field->fld_dtype = MET_get_dtype(F.RDB$FIELD_TYPE,
F.RDB$FIELD_SUB_TYPE,
&field->fld_length);
switch (field->fld_dtype) {
case dtype_text:
case dtype_cstring:
field->fld_flags |= FLD_text;
if (!F.RDB$CHARACTER_LENGTH.NULL)
field->fld_char_length = F.RDB$CHARACTER_LENGTH;
if (!F.RDB$CHARACTER_SET_ID.NULL)
field->fld_charset_id = F.RDB$CHARACTER_SET_ID;
if (!F.RDB$COLLATION_ID.NULL)
field->fld_collate_id = F.RDB$COLLATION_ID;
field->fld_ttype =
INTL_CS_COLL_TO_TTYPE(field->fld_charset_id,
field->fld_collate_id);
break;
case dtype_blob:
field->fld_flags |= FLD_blob;
field->fld_seg_length = F.RDB$SEGMENT_LENGTH;
if (!F.RDB$CHARACTER_SET_ID.NULL)
field->fld_charset_id = F.RDB$CHARACTER_SET_ID;
break;
}
field->fld_symbol = MSC_symbol(SYM_field,
Y.RDB$PARAMETER_NAME,
symbol_length(Y.RDB$PARAMETER_NAME),
(GPRE_CTX) field);
/* If output parameter, insert in symbol table as a
field. */
if (type)
HSH_insert(field->fld_symbol);
END_FOR;
END_FOR;
if (type)
procedure->prc_out_count = count;
else
procedure->prc_in_count = count;
}
END_FOR;
procedure->prc_flags |= PRC_scanned;
/* Generate a dummy relation to point to the procedure to use when procedure
* is used as a view.
*/
return procedure;
}
/*____________________________________________________________
*
* Lookup a relation (represented by a token) in a database.
* Return a relation block (if name is found) or NULL.
*/
GPRE_REL MET_get_relation(dbb* database, TEXT * string, TEXT * owner_name)
{
SYM symbol;
GPRE_REL relation;
SCHAR name[NAME_SIZE], owner[NAME_SIZE];
strcpy(name, string);
strcpy(owner, owner_name);
for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
if (symbol->sym_type == SYM_relation &&
(relation = (GPRE_REL) symbol->sym_object) &&
relation->rel_database == database &&
(!owner[0] ||
(relation->rel_owner
&& !strcmp(owner,
relation->rel_owner->sym_string)))) return relation;
return NULL;
}
/*____________________________________________________________
*
*/
INTLSYM MET_get_text_subtype(SSHORT ttype)
{
INTLSYM p;
for (p = text_subtypes; p; p = p->intlsym_next)
if (p->intlsym_ttype == ttype)
return p;
return NULL;
}
/*____________________________________________________________
*
* Lookup a udf (represented by a token) in a database.
* Return a udf block (if name is found) or NULL.
*
* This function was cloned from MET_get_procedure
*/
UDF MET_get_udf(dbb* database, TEXT * string)
{
SYM symbol;
GPRE_FLD field;
udf* the_udf;
SCHAR name[NAME_SIZE];
strcpy(name, string);
the_udf = NULL;
for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
if (symbol->sym_type == SYM_udf &&
(the_udf = (udf*) symbol->sym_object) && the_udf->udf_database == database)
break;
if (!the_udf)
return NULL;
if (the_udf->udf_flags & UDF_scanned)
return the_udf;
if (database->dbb_flags & DBB_v3) {
/* Version of V4 request without new V4 metadata */
FOR(REQUEST_HANDLE database->dbb_udf_request)
UDF_DEF IN RDB$FUNCTIONS CROSS
UDF_ARG IN RDB$FUNCTION_ARGUMENTS
WITH UDF_DEF.RDB$FUNCTION_NAME EQ name AND
UDF_DEF.RDB$FUNCTION_NAME EQ UDF_ARG.RDB$FUNCTION_NAME AND
UDF_DEF.RDB$RETURN_ARGUMENT != UDF_ARG.RDB$ARGUMENT_POSITION
SORTED BY DESCENDING UDF_ARG.RDB$ARGUMENT_POSITION;
field = (GPRE_FLD) ALLOC(FLD_LEN);
field->fld_next = the_udf->udf_inputs;
the_udf->udf_inputs = field;
the_udf->udf_args++;
field->fld_position = UDF_ARG.RDB$ARGUMENT_POSITION;
field->fld_length = UDF_ARG.RDB$FIELD_LENGTH;
field->fld_scale = UDF_ARG.RDB$FIELD_SCALE;
field->fld_sub_type = UDF_ARG.RDB$FIELD_SUB_TYPE;
field->fld_dtype = MET_get_dtype(UDF_ARG.RDB$FIELD_TYPE,
UDF_ARG.RDB$FIELD_SUB_TYPE,
&field->fld_length);
switch (field->fld_dtype) {
case dtype_text:
case dtype_cstring:
field->fld_flags |= FLD_text;
break;
case dtype_blob:
field->fld_flags |= FLD_blob;
break;
}
END_FOR;
}
else {
/* Same request as above, but with V4 metadata also fetched */
FOR(REQUEST_HANDLE database->dbb_udf_request)
UDF_DEF IN RDB$FUNCTIONS CROSS
UDF_ARG IN RDB$FUNCTION_ARGUMENTS
WITH UDF_DEF.RDB$FUNCTION_NAME EQ name AND
UDF_DEF.RDB$FUNCTION_NAME EQ UDF_ARG.RDB$FUNCTION_NAME AND
UDF_DEF.RDB$RETURN_ARGUMENT != UDF_ARG.RDB$ARGUMENT_POSITION
SORTED BY DESCENDING UDF_ARG.RDB$ARGUMENT_POSITION;
field = (GPRE_FLD) ALLOC(FLD_LEN);
field->fld_next = the_udf->udf_inputs;
the_udf->udf_inputs = field;
the_udf->udf_args++;
field->fld_position = UDF_ARG.RDB$ARGUMENT_POSITION;
field->fld_length = UDF_ARG.RDB$FIELD_LENGTH;
field->fld_scale = UDF_ARG.RDB$FIELD_SCALE;
field->fld_sub_type = UDF_ARG.RDB$FIELD_SUB_TYPE;
field->fld_dtype = MET_get_dtype(UDF_ARG.RDB$FIELD_TYPE,
UDF_ARG.RDB$FIELD_SUB_TYPE,
&field->fld_length);
switch (field->fld_dtype) {
case dtype_text:
case dtype_cstring:
field->fld_flags |= FLD_text;
if (!UDF_ARG.RDB$CHARACTER_SET_ID.NULL)
field->fld_charset_id = UDF_ARG.RDB$CHARACTER_SET_ID;
field->fld_ttype =
INTL_CS_COLL_TO_TTYPE(field->fld_charset_id,
field->fld_collate_id);
break;
case dtype_blob:
field->fld_flags |= FLD_blob;
if (!UDF_ARG.RDB$CHARACTER_SET_ID.NULL)
field->fld_charset_id = UDF_ARG.RDB$CHARACTER_SET_ID;
break;
}
END_FOR;
}
the_udf->udf_flags |= UDF_scanned;
return the_udf;
}
/*____________________________________________________________
*
* Return TRUE if the passed view_name represents a
* view with the passed relation as a base table
* (the relation could be an alias).
*/
GPRE_REL MET_get_view_relation(GPRE_REQ request,
char *view_name,
char *relation_or_alias, USHORT level)
{
dbb* database;
TEXT *p;
GPRE_REL relation;
database = request->req_database;
DB = database->dbb_handle;
gds_trans = database->dbb_transaction;
relation = NULL;
FOR(REQUEST_HANDLE database->dbb_view_request, LEVEL level)
X IN RDB$VIEW_RELATIONS WITH
X.RDB$VIEW_NAME EQ view_name
for (p = X.RDB$CONTEXT_NAME; *p && *p != ' '; p++);
*p = 0;
for (p = X.RDB$RELATION_NAME; *p && *p != ' '; p++);
*p = 0;
if (!strcmp(X.RDB$RELATION_NAME, relation_or_alias) ||
!strcmp(X.RDB$CONTEXT_NAME, relation_or_alias))
return MET_get_relation(database, X.RDB$RELATION_NAME, "");
if (relation =
MET_get_view_relation(request, X.RDB$RELATION_NAME, relation_or_alias,
level + 1))
return relation;
END_FOR;
return NULL;
}
/*____________________________________________________________
*
* Lookup an index for a database.
* Return an index block (if name is found) or NULL.
*/
IND MET_index(dbb* database, TEXT * string)
{
SYM symbol;
IND index;
SCHAR name[NAME_SIZE];
SSHORT length;
strcpy(name, string);
length = strlen(name);
for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
if (symbol->sym_type == SYM_index &&
(index = (IND) symbol->sym_object) &&
index->ind_relation->rel_database == database)
return index;
if (sw_language == lang_internal)
return NULL;
if (database->dbb_flags & DBB_sqlca)
return NULL;
DB = database->dbb_handle;
gds_trans = database->dbb_transaction;
index = NULL;
FOR(REQUEST_HANDLE database->dbb_index_request)
X IN RDB$INDICES WITH X.RDB$INDEX_NAME EQ name
index = (IND) ALLOC(IND_LEN);
index->ind_symbol = symbol = MSC_symbol(SYM_index, name, length, (GPRE_CTX) index);
index->ind_relation = MET_get_relation(database, X.RDB$RELATION_NAME, "");
HSH_insert(symbol);
END_FOR;
return index;
}
/*____________________________________________________________
*
* Load all of the relation names
* and user defined function names
* into the symbol (hash) table.
*/
void MET_load_hash_table(dbb* database)
{
GPRE_REL relation;
GPRE_PRC procedure;
SYM symbol;
GPRE_FLD dbkey;
udf* an_udf;
TEXT *p;
FRBRD *handle, *handle2;
USHORT post_v3_flag;
SLONG length;
INTLSYM iname;
/* If this is an internal ISC access method invocation, don't do any of this
* stuff
*/
if (sw_language == lang_internal)
return;
if (!database->dbb_handle)
if (!MET_database(database, FALSE))
CPR_exit(FINI_ERROR);
if (database->dbb_transaction)
/* we must have already loaded this one */
return;
gds_trans = NULL;
DB = database->dbb_handle;
START_TRANSACTION;
database->dbb_transaction = gds_trans;
handle = handle2 = NULL;
/* Determine if the database is V3. */
post_v3_flag = FALSE;
handle = NULL;
FOR(REQUEST_HANDLE handle)
X IN RDB$RELATIONS WITH
X.RDB$RELATION_NAME = 'RDB$PROCEDURES' AND
X.RDB$SYSTEM_FLAG = 1 post_v3_flag = TRUE;
END_FOR;
gds__release_request(gds_status, &handle);
if (!post_v3_flag)
database->dbb_flags |= DBB_v3;
/* Pick up all relations (necessary to parse parts of the GDML grammar) */
if (database->dbb_flags & DBB_v3) {
FOR(REQUEST_HANDLE handle)
X IN RDB$RELATIONS relation = (GPRE_REL) ALLOC(REL_LEN);
relation->rel_database = database;
relation->rel_next = database->dbb_relations;
database->dbb_relations = relation;
relation->rel_id = X.RDB$RELATION_ID;
relation->rel_symbol = symbol =
MSC_symbol(SYM_relation, X.RDB$RELATION_NAME,
symbol_length(X.RDB$RELATION_NAME), (GPRE_CTX) relation);
HSH_insert(symbol);
relation->rel_dbkey = dbkey = MET_make_field("rdb$db_key", dtype_text,
(X.RDB$DBKEY_LENGTH) ? X.
RDB$DBKEY_LENGTH : 8,
FALSE);
dbkey->fld_flags |= FLD_dbkey | FLD_text | FLD_charset;
dbkey->fld_ttype = ttype_binary;
END_FOR;
}
else {
FOR(REQUEST_HANDLE handle)
X IN RDB$RELATIONS relation = (GPRE_REL) ALLOC(REL_LEN);
relation->rel_database = database;
relation->rel_next = database->dbb_relations;
database->dbb_relations = relation;
relation->rel_id = X.RDB$RELATION_ID;
relation->rel_symbol = symbol =
MSC_symbol(SYM_relation, X.RDB$RELATION_NAME,
symbol_length(X.RDB$RELATION_NAME), (GPRE_CTX) relation);
HSH_insert(symbol);
relation->rel_dbkey = dbkey = MET_make_field("rdb$db_key", dtype_text,
(X.RDB$DBKEY_LENGTH) ? X.
RDB$DBKEY_LENGTH : 8,
FALSE);
dbkey->fld_flags |= FLD_dbkey | FLD_text | FLD_charset;
dbkey->fld_ttype = ttype_binary;
if (!X.RDB$OWNER_NAME.NULL
&& (length =
symbol_length(X.RDB$OWNER_NAME))) relation->rel_owner =
MSC_symbol(SYM_username, X.RDB$OWNER_NAME, length, NULL);
END_FOR;
}
gds__release_request(gds_status, &handle);
/* Pick up all procedures (necessary to parse parts of the GDML grammar) */
FOR(REQUEST_HANDLE handle)
X IN RDB$PROCEDURES procedure = (GPRE_PRC) ALLOC(REL_LEN);
procedure->prc_database = database;
procedure->prc_next = (GPRE_PRC) database->dbb_procedures;
database->dbb_procedures = (GPRE_REL) procedure;
procedure->prc_id = X.RDB$PROCEDURE_ID;
procedure->prc_symbol = symbol =
MSC_symbol(SYM_procedure, X.RDB$PROCEDURE_NAME,
symbol_length(X.RDB$PROCEDURE_NAME), (GPRE_CTX) procedure);
HSH_insert(symbol);
if (!X.RDB$OWNER_NAME.NULL && (length = symbol_length(X.RDB$OWNER_NAME)))
procedure->prc_owner =
MSC_symbol(SYM_username, X.RDB$OWNER_NAME, length, NULL);
END_FOR ON_ERROR
/* assume pre V4 database, no procedures */
END_ERROR;
if (handle)
gds__release_request(gds_status, &handle);
/* Pickup any user defined functions. If the database does not support UDF's,
* this may fail
*/
FOR(REQUEST_HANDLE handle)
FUN IN RDB$FUNCTIONS CROSS ARG IN RDB$FUNCTION_ARGUMENTS WITH
FUN.RDB$FUNCTION_NAME EQ ARG.RDB$FUNCTION_NAME AND
FUN.RDB$RETURN_ARGUMENT EQ ARG.RDB$ARGUMENT_POSITION
p = FUN.RDB$FUNCTION_NAME;
length = symbol_length(p);
p[length] = 0;
an_udf = (udf*) ALLOC(UDF_LEN + length);
strcpy(an_udf->udf_function, p);
an_udf->udf_database = database;
an_udf->udf_type = FUN.RDB$FUNCTION_TYPE;
if (length = symbol_length(FUN.RDB$QUERY_NAME)) {
p = FUN.RDB$QUERY_NAME;
p[length] = 0;
}
an_udf->udf_symbol = symbol = MSC_symbol(SYM_udf, p, strlen(p), (GPRE_CTX) an_udf);
HSH_insert(symbol);
an_udf->udf_length = ARG.RDB$FIELD_LENGTH;
an_udf->udf_scale = ARG.RDB$FIELD_SCALE;
an_udf->udf_sub_type = ARG.RDB$FIELD_SUB_TYPE;
an_udf->udf_dtype =
MET_get_dtype(ARG.RDB$FIELD_TYPE, ARG.RDB$FIELD_SUB_TYPE,
&an_udf->udf_length);
if (post_v3_flag) {
FOR(REQUEST_HANDLE handle2)
V4ARG IN RDB$FUNCTION_ARGUMENTS
CROSS CS IN RDB$CHARACTER_SETS
CROSS COLL IN RDB$COLLATIONS WITH
V4ARG.RDB$CHARACTER_SET_ID EQ CS.RDB$CHARACTER_SET_ID AND
COLL.RDB$COLLATION_NAME EQ CS.RDB$DEFAULT_COLLATE_NAME AND
V4ARG.RDB$CHARACTER_SET_ID NOT MISSING AND
V4ARG.RDB$FUNCTION_NAME EQ ARG.RDB$FUNCTION_NAME AND
V4ARG.RDB$ARGUMENT_POSITION EQ ARG.RDB$ARGUMENT_POSITION;
an_udf->udf_charset_id = V4ARG.RDB$CHARACTER_SET_ID;
an_udf->udf_ttype =
INTL_CS_COLL_TO_TTYPE(an_udf->udf_charset_id, COLL.RDB$COLLATION_ID);
END_FOR;
}
END_FOR ON_ERROR END_ERROR;
gds__release_request(gds_status, &handle);
if (handle2)
gds__release_request(gds_status, &handle2);
/* Pick up all Collation names, might have several collations
* for a given character set.
* There can also be several alias names for a character set.
*/
FOR(REQUEST_HANDLE handle)
CHARSET IN RDB$CHARACTER_SETS CROSS COLL IN RDB$COLLATIONS OVER
RDB$CHARACTER_SET_ID;
p = COLL.RDB$COLLATION_NAME;
length = symbol_length(p);
p[length] = 0;
iname = (INTLSYM) ALLOC(INTLSYM_LEN + length);
strcpy(iname->intlsym_name, p);
iname->intlsym_database = database;
iname->intlsym_symbol = symbol =
MSC_symbol(SYM_collate, p, strlen(p), (GPRE_CTX) iname);
HSH_insert(symbol);
iname->intlsym_type = INTLSYM_collation;
iname->intlsym_flags = 0;
iname->intlsym_charset_id = COLL.RDB$CHARACTER_SET_ID;
iname->intlsym_collate_id = COLL.RDB$COLLATION_ID;
iname->intlsym_ttype =
INTL_CS_COLL_TO_TTYPE(iname->intlsym_charset_id,
iname->intlsym_collate_id);
iname->intlsym_bytes_per_char =
(CHARSET.RDB$BYTES_PER_CHARACTER.NULL) ? 1 : (CHARSET.
RDB$BYTES_PER_CHARACTER);
iname->intlsym_next = text_subtypes;
text_subtypes = iname;
FOR(REQUEST_HANDLE handle2)
TYPE IN RDB$TYPES
WITH TYPE.RDB$FIELD_NAME = "RDB$COLLATION_NAME"
AND TYPE.RDB$TYPE = COLL.RDB$COLLATION_ID
AND TYPE.RDB$TYPE_NAME != COLL.RDB$COLLATION_NAME;
p = TYPE.RDB$TYPE_NAME;
length = symbol_length(p);
p[length] = 0;
symbol = MSC_symbol(SYM_collate, p, length, (GPRE_CTX) iname);
HSH_insert(symbol);
END_FOR ON_ERROR END_ERROR;
END_FOR ON_ERROR
/* assume pre V4 database, no collations */
END_ERROR;
gds__release_request(gds_status, &handle);
if (handle2)
gds__release_request(gds_status, &handle2);
/* Now pick up all character set names - with the subtype set to
* the type of the default collation for the character set.
*/
FOR(REQUEST_HANDLE handle)
CHARSET IN RDB$CHARACTER_SETS CROSS COLL IN RDB$COLLATIONS
WITH CHARSET.RDB$DEFAULT_COLLATE_NAME EQ COLL.RDB$COLLATION_NAME;
p = CHARSET.RDB$CHARACTER_SET_NAME;
length = symbol_length(p);
p[length] = 0;
iname = (INTLSYM) ALLOC(INTLSYM_LEN + length);
strcpy(iname->intlsym_name, p);
iname->intlsym_database = database;
iname->intlsym_symbol = symbol =
MSC_symbol(SYM_charset, p, strlen(p), (GPRE_CTX) iname);
HSH_insert(symbol);
iname->intlsym_type = INTLSYM_collation;
iname->intlsym_flags = 0;
iname->intlsym_charset_id = COLL.RDB$CHARACTER_SET_ID;
iname->intlsym_collate_id = COLL.RDB$COLLATION_ID;
iname->intlsym_ttype =
INTL_CS_COLL_TO_TTYPE(iname->intlsym_charset_id,
iname->intlsym_collate_id);
iname->intlsym_bytes_per_char =
(CHARSET.RDB$BYTES_PER_CHARACTER.NULL) ? 1 : (CHARSET.
RDB$BYTES_PER_CHARACTER);
FOR(REQUEST_HANDLE handle2)
TYPE IN RDB$TYPES
WITH TYPE.RDB$FIELD_NAME = "RDB$CHARACTER_SET_NAME"
AND TYPE.RDB$TYPE = CHARSET.RDB$CHARACTER_SET_ID
AND TYPE.RDB$TYPE_NAME != CHARSET.RDB$CHARACTER_SET_NAME;
p = TYPE.RDB$TYPE_NAME;
length = symbol_length(p);
p[length] = 0;
symbol = MSC_symbol(SYM_charset, p, length, (GPRE_CTX) iname);
HSH_insert(symbol);
END_FOR ON_ERROR END_ERROR;
END_FOR ON_ERROR
/* assume pre V4 database, no character sets */
END_ERROR;
gds__release_request(gds_status, &handle);
if (handle2)
gds__release_request(gds_status, &handle2);
/* Pick up name of database default character set for SQL */
FOR(REQUEST_HANDLE handle)
FIRST 1 DBB IN RDB$DATABASE
WITH DBB.RDB$CHARACTER_SET_NAME NOT MISSING
p = DBB.RDB$CHARACTER_SET_NAME;
length = symbol_length(p);
p[length] = 0;
database->dbb_def_charset = (TEXT *) ALLOC(length + 1);
strcpy(database->dbb_def_charset, p);
if (!MSC_find_symbol(HSH_lookup(database->dbb_def_charset), SYM_charset))
CPR_warn("Default character set for database is not known");
END_FOR ON_ERROR
/* Assume V3 Db, no default charset */
END_ERROR;
gds__release_request(gds_status, &handle);
/* Pick up all generators for the database */
FOR(REQUEST_HANDLE handle)
X IN RDB$GENERATORS
symbol = MSC_symbol(SYM_generator, X.RDB$GENERATOR_NAME,
symbol_length(X.RDB$GENERATOR_NAME), (GPRE_CTX) database);
HSH_insert(symbol);
END_FOR ON_ERROR END_ERROR;
gds__release_request(gds_status, &handle);
/* now that we have attached to the database, resolve the character set
* request (if any) (and if we can)
*/
if (database->dbb_c_lc_ctype) {
if (get_intl_char_subtype
(&database->dbb_char_subtype, (UCHAR*) database->dbb_c_lc_ctype,
strlen(database->dbb_c_lc_ctype), database))
database->dbb_know_subtype = 1;
else {
TEXT buffer[200];
sprintf(buffer, "Cannot recognize character set '%s'",
database->dbb_c_lc_ctype);
PAR_error(buffer);
}
sw_know_interp = database->dbb_know_subtype;
sw_interp = database->dbb_char_subtype;
}
}
/*____________________________________________________________
*
* Make a field symbol.
*/
GPRE_FLD MET_make_field(SCHAR * name,
SSHORT dtype,
SSHORT length,
BOOLEAN insert_flag)
{
GPRE_FLD field;
SYM symbol;
field = (GPRE_FLD) ALLOC(FLD_LEN);
field->fld_length = length;
field->fld_dtype = dtype;
field->fld_symbol = symbol =
MSC_symbol(SYM_field, name, strlen(name), (GPRE_CTX) field);
if (insert_flag)
HSH_insert(symbol);
return field;
}
/*____________________________________________________________
*
* Make an index symbol.
*/
IND MET_make_index(SCHAR * name)
{
IND index;
index = (IND) ALLOC(IND_LEN);
index->ind_symbol = MSC_symbol(SYM_index, name, strlen(name), (GPRE_CTX) index);
return index;
}
/*____________________________________________________________
*
* Make an relation symbol.
*/
GPRE_REL MET_make_relation(SCHAR * name)
{
GPRE_REL relation;
relation = (GPRE_REL) ALLOC(REL_LEN);
relation->rel_symbol =
MSC_symbol(SYM_relation, name, strlen(name), (GPRE_CTX) relation);
return relation;
}
/*____________________________________________________________
*
* Lookup a type name for a field.
*/
BOOLEAN MET_type(GPRE_FLD field, TEXT * string, SSHORT * ptr)
{
GPRE_REL relation;
dbb* database;
SYM symbol;
TYP type;
UCHAR buffer[32]; /* BASED ON RDB$TYPES.RDB$TYPE_NAME */
UCHAR *p;
for (symbol = HSH_lookup(string); symbol; symbol = symbol->sym_homonym)
if (symbol->sym_type == SYM_type &&
(type = (TYP) symbol->sym_object) &&
(!type->typ_field || type->typ_field == field)) {
*ptr = type->typ_value;
return TRUE;
}
relation = field->fld_relation;
database = relation->rel_database;
DB = database->dbb_handle;
gds_trans = database->dbb_transaction;
/* Force the name to uppercase, using C locale rules for uppercasing */
for (p = buffer; *string && p < &buffer[sizeof(buffer) - 1];
p++, string++) *p = UPPER7(*string);
*p = '\0';
FOR(REQUEST_HANDLE database->dbb_type_request)
X IN RDB$TYPES WITH X.RDB$FIELD_NAME EQ field->fld_global->sym_string AND
X.RDB$TYPE_NAME EQ buffer {
type = (TYP) ALLOC(TYP_LEN);
type->typ_field = field;
*ptr = type->typ_value = X.RDB$TYPE;
type->typ_symbol = symbol =
MSC_symbol(SYM_type, string, strlen(string), (GPRE_CTX) type);
HSH_insert(symbol);
return TRUE;
} END_FOR ON_ERROR END_ERROR;
return FALSE;
}
/*____________________________________________________________
*
* Lookup an index for a database.
*
* Return: TRUE if the trigger exists
* FALSE otherwise
*/
BOOLEAN MET_trigger_exists(dbb* database, TEXT* trigger_name)
{
char name[NAME_SIZE];
strcpy(name, trigger_name);
DB = database->dbb_handle;
gds_trans = database->dbb_transaction;
FOR(REQUEST_HANDLE database->dbb_trigger_request)
TRIG IN RDB$TRIGGERS WITH TRIG.RDB$TRIGGER_NAME EQ name return TRUE;
END_FOR;
return FALSE;
}
/*____________________________________________________________
*
* Compute and return the size of the array.
*/
static SLONG array_size( GPRE_FLD field)
{
ARY array_block;
DIM dimension;
SLONG count;
array_block = field->fld_array_info;
count = field->fld_array->fld_length;
for (dimension = array_block->ary_dimension; dimension;
dimension = dimension->dim_next) count =
count * (dimension->dim_upper - dimension->dim_lower + 1);
return count;
}
/*____________________________________________________________
*
* See if field is array.
*/
static void get_array(dbb* database, TEXT * field_name, GPRE_FLD field)
{
GPRE_FLD sub_field;
ARY array_block;
DIM dimension_block, last_dimension_block;
array_block = NULL;
FOR(REQUEST_HANDLE database->dbb_array_request)
F IN RDB$FIELDS WITH F.RDB$FIELD_NAME EQ field_name if (F.RDB$DIMENSIONS) {
sub_field = (GPRE_FLD) ALLOC(FLD_LEN);
*sub_field = *field;
field->fld_array = sub_field;
field->fld_dtype = dtype_blob;
field->fld_flags |= FLD_blob;
field->fld_length = 8;
field->fld_array_info = array_block =
(ARY) ALLOC(ARY_LEN(F.RDB$DIMENSIONS));
array_block->ary_dtype = sub_field->fld_dtype;
} END_FOR ON_ERROR {
database->dbb_flags |= DBB_no_arrays;
return;
}
END_ERROR;
if (!array_block)
return;
FOR(REQUEST_HANDLE database->dbb_dimension_request)
D IN RDB$FIELD_DIMENSIONS WITH D.RDB$FIELD_NAME EQ field_name
SORTED BY ASCENDING D.RDB$DIMENSION
array_block->ary_rpt[D.RDB$DIMENSION].ary_lower = D.RDB$LOWER_BOUND;
array_block->ary_rpt[D.RDB$DIMENSION].ary_upper = D.RDB$UPPER_BOUND;
dimension_block = (DIM) ALLOC(DIM_LEN);
dimension_block->dim_number = D.RDB$DIMENSION;
dimension_block->dim_lower = D.RDB$LOWER_BOUND;
dimension_block->dim_upper = D.RDB$UPPER_BOUND;
if (D.RDB$DIMENSION != 0) {
last_dimension_block->dim_next = dimension_block;
dimension_block->dim_previous = last_dimension_block;
}
else
array_block->ary_dimension = dimension_block;
last_dimension_block = dimension_block;
END_FOR;
array_block->ary_dimension_count = last_dimension_block->dim_number + 1;
array_block->ary_size = array_size(field);
}
/*____________________________________________________________
*
* Character types can be specified as either:
* b) A POSIX style locale name "<collation>.<characterset>"
* or
* c) A simple <characterset> name (using default collation)
* d) A simple <collation> name (use charset for collation)
*
* Given an ASCII7 string which could be any of the above, try to
* resolve the name in the order b, c, d.
* b) is only tried iff the name contains a period.
* (in which case c) and d) are not tried).
*
* Return:
* 1 if no errors (and *id is set).
* 0 if the name could not be resolved.
*/
static int get_intl_char_subtype(
SSHORT * id,
UCHAR * name, USHORT length, dbb* database)
{
UCHAR buffer[32]; /* BASED ON RDB$COLLATION_NAME */
UCHAR *p;
UCHAR *period = NULL;
UCHAR *end_name;
assert(id != NULL);
assert(name != NULL);
assert(database != NULL);
DB = database->dbb_handle;
if (!DB)
return (0);
gds_trans = database->dbb_transaction;
end_name = name + length;
/* Force key to uppercase, following C locale rules for uppercasing
* At the same time, search for the first period in the string (if any)
*/
for (p = (UCHAR *) buffer;
name < end_name && p < (UCHAR *) (buffer + sizeof(buffer) - 1);
p++, name++) {
*p = UPPER7(*name);
if ((*p == '.') && !period)
period = p;
};
*p = 0;
/* Is there a period, separating collation name from character set? */
if (period) {
*period = 0;
return (resolve_charset_and_collation(id, period + 1, buffer));
}
else {
int res;
/* Is it a character set name (implying charset default collation sequence) */
res = resolve_charset_and_collation(id, buffer, NULL);
if (!res) {
/* Is it a collation name (implying implementation-default character set) */
res = resolve_charset_and_collation(id, NULL, buffer);
}
return (res);
}
}
/*____________________________________________________________
*
* Given ASCII7 name of charset & collation
* resolve the specification to a ttype (id) that implements
* it.
*
* Inputs:
* (charset)
* ASCII7z name of characterset.
* NULL (implying unspecified) means use the character set
* for defined for (collation).
*
* (collation)
* ASCII7z name of collation.
* NULL means use the default collation for (charset).
*
* Outputs:
* (*id)
* Set to subtype specified by this name.
*
* Return:
* 1 if no errors (and *id is set).
* 0 if either name not found.
* or if names found, but the collation isn't for the specified
* character set.
*/
static int resolve_charset_and_collation(
SSHORT * id,
UCHAR * charset, UCHAR * collation)
{
int found = 0;
FRBRD *request = NULL;
assert(id != NULL);
if (!DB)
return (0);
if (collation == NULL) {
if (charset == NULL) {
FOR(REQUEST_HANDLE request)
FIRST 1 DBB IN RDB$DATABASE
WITH DBB.RDB$CHARACTER_SET_NAME NOT MISSING
AND DBB.RDB$CHARACTER_SET_NAME != " ";
charset = (UCHAR *) DBB.RDB$CHARACTER_SET_NAME;
END_FOR ON_ERROR
/* Assume V3 DB, without default character set */
END_ERROR;
gds__release_request(gds_status, &request);
if (charset == NULL)
charset = (UCHAR *) DEFAULT_CHARACTER_SET_NAME;
}
FOR(REQUEST_HANDLE request)
FIRST 1 CS IN RDB$CHARACTER_SETS
CROSS COLL IN RDB$COLLATIONS
CROSS TYPE IN RDB$TYPES
WITH TYPE.RDB$TYPE_NAME EQ charset
AND TYPE.RDB$FIELD_NAME EQ "RDB$CHARACTER_SET_NAME"
AND TYPE.RDB$TYPE EQ CS.RDB$CHARACTER_SET_ID
AND CS.RDB$DEFAULT_COLLATE_NAME EQ COLL.RDB$COLLATION_NAME;
found++;
*id = MAP_CHARSET_TO_TTYPE(CS.RDB$CHARACTER_SET_ID);
END_FOR ON_ERROR END_ERROR;
gds__release_request(gds_status, &request);
return (found);
}
else if (charset == NULL) {
FOR(REQUEST_HANDLE request)
FIRST 1 CS IN RDB$CHARACTER_SETS
CROSS COLL IN RDB$COLLATIONS
OVER RDB$CHARACTER_SET_ID
WITH COLL.RDB$COLLATION_NAME EQ collation;
found++;
*id = MAP_CHARSET_TO_TTYPE(CS.RDB$CHARACTER_SET_ID);
END_FOR ON_ERROR END_ERROR;
gds__release_request(gds_status, &request);
return (found);
}
FOR(REQUEST_HANDLE request)
FIRST 1 CS IN RDB$CHARACTER_SETS
CROSS COL IN RDB$COLLATIONS OVER RDB$CHARACTER_SET_ID
CROSS NAME2 IN RDB$TYPES
WITH COL.RDB$COLLATION_NAME EQ collation
AND NAME2.RDB$TYPE_NAME EQ charset
AND NAME2.RDB$FIELD_NAME EQ "RDB$CHARACTER_SET_NAME"
AND NAME2.RDB$TYPE EQ CS.RDB$CHARACTER_SET_ID;
found++;
*id = MAP_CHARSET_TO_TTYPE(CS.RDB$CHARACTER_SET_ID);
END_FOR ON_ERROR END_ERROR;
gds__release_request(gds_status, &request);
return (found);
}
/*____________________________________________________________
*
* Compute significant length of symbol.
*/
static int symbol_length( TEXT * string)
{
TEXT *p;
int len;
len = strlen(string);
p = string + (len - 1);
for (; p >= string && *p == ' '; p--);
if (p < string)
return 0;
++p;
return p - string;
}
#ifdef NOT_USED_OR_REPLACED
/*____________________________________________________________
*
* Upcase a string into another string. Return
* length of string.
*/
static int upcase( TEXT * from, TEXT * to)
{
TEXT *p, *end, c;
p = to;
end = to + NAME_SIZE;
while (p < end && (c = *from++)) {
*p++ = UPPER(c);
}
*p = 0;
return p - to;
}
#endif
View Git Blame Copy Permalink