/*
Generated by VAX SQL V4.0A-0 at  3-DEC-1991 18:53:30.43
Source file is USER1:[LEDERMAN.RDB.RTF]CROSS_REFERENCE.SC;32
*/
#module CROSS_REFERENCE "V2.19"

/*
  Get Rdb database table and domain information out of the metadata.

  B. Z. Lederman	13-Mar-1990
			19-Sep-1990	Updates, running
			20-Sep-1990	Add order of retrieval
			 3-Jun-1991	FAO output, Rdb 4.0, two relations
			20-Nov-1991	Change format to suit the
					RDB_TO_RTF command procedure
			21-Nov-1991	Also generate lists of domains
					and tables for processing, and
					table list RTF. Put as much file
					generation here as possible.
			25-Nov-1991	don't change tabs for cross
					reference until after new page.
					Database name in header, page
					numbers in footer.
			 3-Dec-1991	Drop back to original format for now.
*/

#include STDIO
#include DESCRIP
#include ERRNO
#include "DTYPE.H"

globalvalue RMS$_NMF;		/* for LIB$FIND_FILE results		*/

#define SQL_SUCCESS 0

/* #define DEBUG TRUE		/* get printouts while program runs	*/

int field_type, field_length;
char relation_name[64], field_name[64], field_source[64];
short int flags;

/* Include the SQLCA							*/

/*
    EXEC SQL INCLUDE SQLCA;
*/
struct
    {
	char SQLCAID[8];
	int SQLCABC;
	int SQLCODE;
	struct { 
	    short SQLERRML;
	    char SQLERRMC[70];
	       } SQLERRM;
	int SQLERRD[6];
	struct { 
	    char SQLWARN0[1];
	    char SQLWARN1[1];
	    char SQLWARN2[1];
	    char SQLWARN3[1];
	    char SQLWARN4[1];
	    char SQLWARN5[1];
	    char SQLWARN6[1];
	    char SQLWARN7[1];
	       } SQLWARN;
	char SQLEXT[8];
    } SQLCA = { 	"SQLCA   ",
	    		128, 0,
	 		{0, ""},
			{0,0,0,0,0,0},
			{"", "", "", "", "", "", "", ""},
			"" };
extern struct {
    int RDB$LU_NUM_ARGUMENTS;
    int RDB$LU_STATUS;
    int RDB$LU_ARGUMENTS[18]; } RDB$MESSAGE_VECTOR;

/* Declare the database schema						*/

/*
    EXEC SQL DECLARE SCHEMA FILENAME 'SQL$DATABASE';
*/

/*
    EXEC SQL DECLARE TRANSACTION READ ONLY
	RESERVING RDB$RELATION_FIELDS FOR SHARED READ,
		  RDB$RELATIONS FOR SHARED READ,
		  RDB$FIELDS FOR SHARED READ;
*/

/*
    EXEC SQL DECLARE R_C CURSOR FOR
	SELECT R.RDB$RELATION_NAME, R.RDB$FIELD_NAME, R.RDB$FIELD_SOURCE,
		F.RDB$FIELD_TYPE, F.RDB$FIELD_LENGTH
	FROM RDB$RELATION_FIELDS R, RDB$FIELDS F
	WHERE F.RDB$FIELD_NAME = R.RDB$FIELD_SOURCE AND
		F.RDB$SYSTEM_FLAG = 0
        ORDER BY RDB$FIELD_SOURCE, RDB$RELATION_NAME, RDB$FIELD_NAME;
*/

/*
    EXEC SQL DECLARE TABLE_C CURSOR FOR
	SELECT T.RDB$RELATION_NAME, T.RDB$FLAGS
	FROM RDB$RELATIONS T
	WHERE T.RDB$SYSTEM_FLAG = 0
        ORDER BY RDB$FLAGS, RDB$RELATION_NAME;
*/

/*
    EXEC SQL DECLARE DOMAIN_C CURSOR FOR
	SELECT D.RDB$FIELD_NAME
	FROM RDB$FIELDS D
	WHERE D.RDB$SYSTEM_FLAG = 0
        ORDER BY RDB$FIELD_NAME;
*/

/*
    EXEC SQL WHENEVER SQLERROR GOTO ERROR_HANDLER;
*/

cross_reference ()
MAIN_PROGRAM
{
    int i, o, secondary_status, out_file_ptr, rtf_file_ptr;
    char out_buf[256], length_text[32];
    short int length;
    char cross_file[] = "RDB_CROSS_TEMP.RTF";
    char table_file[] = "RDB_TABLES_TEMP.RTF";
    char relation_file[] = "RDB_FETCH_TABLES_TEMP.SQL";
    char domain_file[] = "RDB_FETCH_DOMAINS_TEMP.SQL";
    char report_file[] = "RDB_DATABASE.RTF";
    int status = 1, num_tab = 0, context = 0;

    struct dsc$descriptor_s found_desc =
	{0, DSC$K_DTYPE_T, DSC$K_CLASS_D, 0};

    struct dsc$descriptor_s out_desc =
	{ 0, DSC$K_DTYPE_T, DSC$K_CLASS_D, 0};

    $DESCRIPTOR (faoctl1, "{\\b Database !AS\\par !11<!%D!>}\\par");

    $DESCRIPTOR (search_desc, "SQL$DATABASE");

/* Change the logical name SQL$DATABASE into a file specification	*/

    status = LIB$FIND_FILE (&search_desc, &found_desc, &context, 
				0, 0, &secondary_status, 0);

    if (status == RMS$_NMF) exit (status);	/* if no more files, quit */

    if ((status & 1) != 1) LIB$SIGNAL (status, secondary_status);

    status = LIB$FIND_FILE_END (&context);  /* finish up the connection	*/
/*
   Create a report file, and write the header information into it.
   Done here because this way we get a normal 'CR' file instead of
   DCL's weird VFC file.  It should also be faster, and perhaps someday
   all the processing will be in this program anyway.
*/
    out_file_ptr = creat (report_file, 0, "rfm=var", "rat=cr", "mrs=255");

    if (out_file_ptr < 0) 
    {
	printf (" error %d opening %s \n", errno, report_file);
	exit (errno);
    };

    strcpy (out_buf, "{\\rtf1\\mac\\deff2 {\\fonttbl{\\f0\\fswiss Chicago;}{\\f2\\froman New York;}");
    write (out_file_ptr, &out_buf, strlen (out_buf));
    strcpy (out_buf, "{\\f3\\fswiss Geneva;}{\\f4\\fmodern Monaco;}{\\f16\\fnil Palatino;}");
    write (out_file_ptr, &out_buf, strlen (out_buf));
    strcpy (out_buf, "{\\f20\\froman Times;}{\\f21\\fswiss Helvetica;}{\\f22\\fmodern Courier;}");
    write (out_file_ptr, &out_buf, strlen (out_buf));
    strcpy (out_buf, "{\\f23\\ftech Symbol;}}{\\colortbl\\red0\\green0\\blue0;\\red0\\green0\\blue255;");
    write (out_file_ptr, &out_buf, strlen (out_buf));
    strcpy (out_buf, "\\red0\\green255\\blue255;\\red0\\green255\\blue0;\\red255\\green0\\blue255;");
    write (out_file_ptr, &out_buf, strlen (out_buf));
    strcpy (out_buf, "\\red255\\green0\\blue0;\\red255\\green255\\blue0;\\red255\\green255\\blue255;}");
    write (out_file_ptr, &out_buf, strlen (out_buf));
    strcpy (out_buf, "{\\stylesheet {\\sbasedon222\\snext0 Normal;}}");
    write (out_file_ptr, &out_buf, strlen (out_buf));
    strcpy (out_buf, "\\margl1440\\margr1440\\widowctrl\\ftnbj\\sectd\\linemod0\\linex0\\cols1\\endnhere");
    write (out_file_ptr, &out_buf, strlen (out_buf));
    strcpy (out_buf, "\\ftnbj\\pard\\plain\\fs20");
    write (out_file_ptr, &out_buf, strlen (out_buf));
    strcpy (out_buf, "{\\header\\pard\\plain\\fs24");
    write (out_file_ptr, &out_buf, strlen (out_buf));

/* Create the header which contains the database name and date/time	*/

    status = LIB$SYS_FAO (&faoctl1, 0, &out_desc, &found_desc, 0);

    if ((status & 1) != 1) LIB$SIGNAL (status);

    write (out_file_ptr, out_desc.dsc$a_pointer, out_desc.dsc$w_length);

    strcpy (out_buf, "\\par{\\b\\ul Domains}}\\par");
    write (out_file_ptr, &out_buf, strlen (out_buf));

    strcpy (out_buf, "{\\footer\\plain\\tx6120\\tab\\chftn\\par}");
    write (out_file_ptr, &out_buf, strlen (out_buf));

    strcpy (out_buf, "\\pard\\plain\\tx2800\\tx4600\\fs20");
    write (out_file_ptr, &out_buf, strlen (out_buf));

    close (out_file_ptr);

/* Get the list of relations to be processed				*/

    out_file_ptr = creat (relation_file, 0, "rfm=var", "rat=cr", "mrs=255");

    if (out_file_ptr < 0) 
    {
	printf (" error %d opening %s \n", errno, relation_file);
	exit (errno);
    };

    rtf_file_ptr = creat (table_file, 0, "rfm=var", "rat=cr", "mrs=255");

    if (rtf_file_ptr < 0) 
    {
	printf (" error %d opening %s \n", errno, table_file);
	exit (errno);
    };

    strcpy (out_buf, "SET OUTPUT rdb_tables.temp2");
    write (out_file_ptr, &out_buf, strlen (out_buf));

    strcpy (out_buf, "\\page");
    write (rtf_file_ptr, &out_buf, strlen (out_buf));
    strcpy (out_buf, "\\pard\\plain\\fs20\\s244\\tqc\\tx4320\\tqr\\tx8640");
    write (rtf_file_ptr, &out_buf, strlen (out_buf));

    strcpy (out_buf, "\\sectd{\\header\\pard\\plain\\fs24");
    write (rtf_file_ptr, &out_buf, strlen (out_buf));

    write (rtf_file_ptr, out_desc.dsc$a_pointer, out_desc.dsc$w_length);
    strcpy (out_buf, "\\par{\\b\\ul Tables}}\\par");
    write (rtf_file_ptr, &out_buf, strlen (out_buf));

    strcpy (out_buf, "\\trowd \\trgaph80\\trleft-80 \\cellx4600\\cellx9280\\pard \\intbl\\tx2500 ");
    write (rtf_file_ptr, &out_buf, strlen (out_buf));

/*
    EXEC SQL OPEN TABLE_C;
*/
			{
			SQL$PROC_1_95292A_12A731(
				&SQLCA
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

    while (SQLCA.SQLCODE == SQL_SUCCESS)
    {
/*
	EXEC SQL FETCH TABLE_C INTO :relation_name, :flags;
*/
			{
			SQL$PROC_2_95292A_12A732(
				&SQLCA
				,relation_name
				,&flags
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

	if (SQLCA.SQLCODE != SQL_SUCCESS) break;    /* no more records  */

	for (i = 0;  i < sizeof (relation_name);  i++)
	{
	    if (relation_name[i] == ' ')
	    {
		relation_name[i] = '\0';
		break;
	    };
	};

	strcpy (out_buf, "SHOW TABLE ");
	strcat (out_buf, relation_name);
	write (out_file_ptr, &out_buf, strlen (out_buf));

	strcpy (out_buf, relation_name);
/*
   Append "\tab A view." to the names of views.
*/
	if ((flags & 1) == 1)
	{
	    strcat (out_buf, "\\tab A view.");
	};

	strcat (out_buf, "\\par");
	write (rtf_file_ptr, &out_buf, strlen (out_buf));
/*
   Count the number of tables, and insert a column break when needed.
*/
	num_tab = num_tab + 1;
	if (num_tab == 45)
	{
	    strcpy (out_buf, "\\cell \\pard \\intbl\\tx2500");
	    write (rtf_file_ptr, &out_buf, strlen (out_buf));
	};
    };

/*
    EXEC SQL CLOSE TABLE_C;
*/
			{
			SQL$PROC_3_95292A_12A8B7(
				&SQLCA
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

/*
    EXEC SQL ROLLBACK;
*/
			{
			SQL$PROC_4_95292A_12A8B8(
				&SQLCA
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

    strcpy (out_buf, "EXIT");
    write (out_file_ptr, &out_buf, strlen (out_buf));

    close (out_file_ptr);
/*
   If we didn't write anything into the right-hand column we must do so
   now, or else the remainder of the document goes into the right-hand
   column and MS Word hangs.
*/
    if (num_tab < 45)
    {
	strcpy (out_buf, "\\cell \\pard \\intbl\\tx2500 \\par { } \\par");
	write (rtf_file_ptr, &out_buf, strlen (out_buf));
    };

    strcpy (out_buf, "\\cell \\pard \\row \\par");
    write (rtf_file_ptr, &out_buf, strlen (out_buf));

    close (rtf_file_ptr);

/* Get the list of domains to be processed				*/

    out_file_ptr = creat (domain_file, 0, "rfm=var", "rat=cr", "mrs=255");

    if (out_file_ptr < 0) 
    {
	printf (" error %d opening %s \n", errno, domain_file);
	exit (errno);
    };

    strcpy (out_buf, "SET OUTPUT rdb_tables.temp4");
    write (out_file_ptr, &out_buf, strlen (out_buf));

/*
    EXEC SQL OPEN DOMAIN_C;
*/
			{
			SQL$PROC_5_95292A_12AA3E(
				&SQLCA
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

    while (SQLCA.SQLCODE == SQL_SUCCESS)
    {
/*
	EXEC SQL FETCH DOMAIN_C INTO :field_name;
*/
			{
			SQL$PROC_6_95292A_12AA3F(
				&SQLCA
				,field_name
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

	if (SQLCA.SQLCODE != SQL_SUCCESS) break;    /* no more records  */

	for (i = 0;  i < sizeof (field_name);  i++)
	{
	    if (field_name[i] == ' ')
	    {
		field_name[i] = '\0';
		break;
	    };
	};

	strcpy (out_buf, "SHOW DOMAIN ");
	strcat (out_buf, field_name);
	write (out_file_ptr, &out_buf, strlen (out_buf));
    };

/*
    EXEC SQL CLOSE DOMAIN_C;
*/
			{
			SQL$PROC_7_95292A_12AA40(
				&SQLCA
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

/*
    EXEC SQL ROLLBACK;
*/
			{
			SQL$PROC_8_95292A_12ABC5(
				&SQLCA
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

    strcpy (out_buf, "EXIT");
    write (out_file_ptr, &out_buf, strlen (out_buf));

    close (out_file_ptr);

/* Output cross reference of domains in RTF format			*/

    out_file_ptr = creat (cross_file, 0, "rfm=var", "rat=cr", "mrs=255");

    if (out_file_ptr < 0) 
    {
	printf (" error %d opening %s \n", errno, cross_file);
	exit (errno);
    };

    strcpy (out_buf, "\\sectd\\page\\par\\pard\\tx3000\\tx7300");
    write (out_file_ptr, &out_buf, strlen (out_buf));

    strcpy (out_buf, "{\\header\\pard\\plain\\fs24");
    write (out_file_ptr, &out_buf, strlen (out_buf));

    write (out_file_ptr, out_desc.dsc$a_pointer, out_desc.dsc$w_length);
    strcpy (out_buf, "\\par{\\b\\ul Cross Reference of Domains}}\\par");
    write (out_file_ptr, &out_buf, strlen (out_buf));

/*
    EXEC SQL OPEN R_C;
*/
			{
			SQL$PROC_9_95292A_12ABC6(
				&SQLCA
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

    while (SQLCA.SQLCODE == SQL_SUCCESS)
    {
/*
	EXEC SQL FETCH R_C INTO :relation_name, :field_name,
		:field_source, field_type, field_length;
*/
			{
			SQL$PROC_10_95292A_12ABC7(
				&SQLCA
				,relation_name
				,field_name
				,field_source
				,&field_type
				,&field_length
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

	if (SQLCA.SQLCODE != SQL_SUCCESS) break;    /* no more records  */

	out_buf[0] = '\0';

	for (i = 0;  i < sizeof (field_source);  i++)
	{
	    if (field_source[i] == ' ')
	    {
		field_source[i] = '\0';
		break;
	    };
	};

	for (i = 0;  i < sizeof (field_name);  i++)	/* 'trim'	*/
	{						/* trailing	*/
	    if (field_name[i] == ' ')			/* blanks from	*/
	    {						/* the end of	*/
		field_name[i] = '\0';			/* the field	*/
		break;
	    };
	};

	for (i = 0;  i < sizeof (relation_name);  i++)
	{
	    if (relation_name[i] == ' ')
	    {
		relation_name[i] = '\0';
		break;
	    };
	};

	strcpy (out_buf, "\\par ");		/* build up the RTF	*/
	strcat (out_buf, field_source);		/* formatted line	*/
	strcat (out_buf, "\\tab ");
	strcat (out_buf, relation_name);
	strcat (out_buf, ".");
	strcat (out_buf, field_name);
	strcat (out_buf, "\\tab ");
	strcat (out_buf, dtype[field_type]);
	if ((field_type == 37) ||		/* VARCHAR(		*/
	    (field_type == 14))			/* CHAR(		*/
	{
	    sprintf (length_text, "%d", field_length);
	    strcat (out_buf, length_text);
	    strcat (out_buf, ")");
	};

	write (out_file_ptr, &out_buf, strlen (out_buf));
    };

/*
    EXEC SQL CLOSE R_C;
*/
			{
			SQL$PROC_11_95292A_12AD4B(
				&SQLCA
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

/*
    EXEC SQL ROLLBACK;
*/
			{
			SQL$PROC_12_95292A_12AD4C(
				&SQLCA
			);
			if ( SQLCA.SQLCODE < 0 ) goto ERROR_HANDLER;
			}

    strcpy (out_buf, "\\par}");
    write (out_file_ptr, &out_buf, strlen (out_buf));

    close (out_file_ptr);

    exit (1);

ERROR_HANDLER:

    status = SYS$PUTMSG (&RDB$MESSAGE_VECTOR, 0, 0, 0);

    SQL$SIGNAL ();
}
/*

Command Line Summary:

	/CC CROSS_REFERENCE


Database Summary:

    Database with Alias RDB$DBHANDLE
	Database Filename:        SQL$DATABASE
	Underlying software versions are: 
	    Rdb/VMS V4.0A 
	    Rdb/Dispatch V4.0-4


Statistics Summary:

    Run Time:      00:04.89
    Elapsed Time:  00:13.62
    Page Faults:   1730
*/