SSMTEP2: PROCEDURE(PARMS) OPTIONS(MAIN); /* DYNAMIC SQL */ 00010000 /* INCLUDING PROGRAM PARMS */ 00020000 %DCL DEBUG FIXED; 00030000 %DCL $TRACE ENTRY; 00040000 % DEBUG = 0; /* 1=TRACE ON. 0=TRACE OFF */ 00050000 % $TRACE:PROC (MODSTR, PUTTYPE, DATA) RETURNS(CHAR) STMT; 00060000 00070000 /*******************************************************************/ 00080000 /* This macro generates program trace statements. */ 00090000 /* */ 00100000 /* Invoked as: */ 00110000 /* */ 00120000 /* $TRACE (STRING) */ 00130000 /* */ 00140000 /* where */ 00150000 /* */ 00160000 /* STRING is an identifying character string. */ 00170000 /* DATA Is a list of variables to be printed. If omitted, */ 00180000 /* no variables will be printed. */ 00190000 /* PUTTYPE Indicates the type of "PUT" statement to be */ 00200000 /* generated whenever a list of DATA variables is */ 00210000 /* specified. If LIST, a "PUT LIST" statement will be */ 00220000 /* generated as follows: */ 00230000 /* */ 00240000 /* PUT SKIP LIST( 'VAR1 = ', VAR1, */ 00250000 /* 'VAR2 = ', VAR2,...). */ 00260000 /* */ 00270000 /* If DATA, a "PUT DATA" statement will be generated */ 00280000 /* as follows: */ 00290000 /* */ 00300000 /* PUT SKIP DATA( VAR1, VAR2, ...). */ 00310000 /* */ 00320000 /* If omitted, the PUTTYPE parameter will default to */ 00330000 /* PUTTYPE(DATA). */ 00340000 /* */ 00350000 /* The external macro variable DEBUG will control whether a trace */ 00360000 /* statement is generated. The values checked are: */ 00370000 /* */ 00380000 /* =1 Generate the specified trace statements, */ 00390000 /* ¬=1 Do not generate the trace statements. */ 00400000 /*******************************************************************/ 00410000 00420000 /*******************************************************************/ 00430000 /* DECLARATONS */ 00440000 /*******************************************************************/ 00450000 00460000 DCL 00470000 MODSTR CHAR, 00480000 DATA CHAR, 00490000 PUTTYPE CHAR, 00500000 $PUTT CHAR, 00510000 $DEF CHAR, 00520000 $STRING CHAR, 00530000 $BLANK CHAR, 00540000 STMT0 CHAR, 00550000 STMT1 CHAR, 00560000 STMT2 CHAR, 00570000 STMT3 CHAR, 00580000 STMT4 CHAR, 00590000 $M FIXED, 00600000 $ENDSTR FIXED; 00610000 00620000 /*******************************************************************/ 00630000 /* INITIALIZE RETURN STATEMENT VARIABLES TO ZERO */ 00640000 /*******************************************************************/ 00650000 00660000 STMT0 = ' '; 00670000 STMT1 = ' '; 00680000 STMT2 = ' '; 00690000 STMT3 = ' '; 00700000 STMT4 = ' '; 00710000 00720000 /*******************************************************************/ 00730000 /* TRACE ONLY IF THE DEBUG FLAG IS SET */ 00740000 /*******************************************************************/ 00750000 00760000 IF DEBUG = 1 THEN 00770000 DO; 00780000 $ENDSTR = 0; /* INITIALIZE MACRO EOS VARIABLE */ 00790000 $DEF = ' '; /* INITIALIZE MACRO DEFAULT VAR */ 00800000 00810000 /*******************************************************************/ 00820000 /* IS PUTTYPE SPECIFIED? IF NOT, GENERATE A DEFAULT VALUE */ 00830000 /*******************************************************************/ 00840000 00850000 IF ¬PARMSET(PUTTYPE) & PARMSET(DATA) THEN 00860000 DO; /* NO PUTTYPE SPECIFIED */ 00870000 $PUTT = 'DATA'; /* DEFAULT IS DATA */ 00880000 $DEF = ' *DEF*'; /* INDICATE DEFAULT GENERATED */ 00890000 END; /* END NO PUTTYPE SPECIFIED */ 00900000 ELSE /* PUTTYPE IS SPECIFIED */ 00910000 $PUTT = PUTTYPE; 00920000 00930000 /*******************************************************************/ 00940000 /* SET STMT0 TO THE BEGINNING COMMENT AND STMT1 TO THE "DO" STMT */ 00950000 /*******************************************************************/ 00960000 00970000 STMT0 = ' DO;'; 00980000 STMT1 = ' /* $TRACE ('||MODSTR||') DATA('||DATA||') PUTTYPE(' 00990000 ||$PUTT||$DEF||') */'; 01000000 01010000 /*******************************************************************/ 01020000 /* DETERMINE IF MODSTR STRING IS SPECIFIED */ 01030000 /*******************************************************************/ 01040000 01050000 IF ¬PARMSET(MODSTR) THEN 01060000 DO; /* MODSTR NOT SPECIFIED */ 01070000 /* GENERATE AN ERROR MESSAGE */ 01080000 NOTE('$TRACE ERROR - INPUT STRING NOT DEFINED',12); 01090000 $ENDSTR = 1; 01100000 END; /* MODSTR NOT SPECIFIED */ 01110000 ELSE /* ELSE SET STMT2 TO THE PUT EDIT */ 01120000 STMT2 = ' PUT EDIT('||MODSTR||') (COL(2),A);'; 01130000 01140000 /*******************************************************************/ 01150000 /* DETERMINE IF DATA LIST IS SPECIFIED. */ 01160000 /*******************************************************************/ 01170000 01180000 IF PARMSET(DATA) THEN 01190000 DO; 01200000 $STRING = DATA; /* INITIALIZE $STRING VARIABLE */ 01210000 STMT3 = ' PUT '||$PUTT||' ( '; 01220000 01230000 /*******************************************************************/ 01240000 /* PROCESS EACH VARIABLE IN THE SPECIFIED STRING */ 01250000 /*******************************************************************/ 01260000 01270000 $AGN: 01280000 IF $ENDSTR = 0 THEN 01290000 DO; /* NOT END OF STRING */ 01300000 $M = INDEX($STRING,','); /* FIND END OF FIRST VAR */ 01310000 01320000 /*******************************************************************/ 01330000 /* IF NO COMMA FOUND, THE END OF THE STRING HAS BEEN REACHED */ 01340000 /*******************************************************************/ 01350000 01360000 IF $M = 0 THEN 01370000 DO; /* NO COMMA WAS FOUND */ 01380000 IF $PUTT = 'LIST' THEN 01390000 STMT3 = STMT3||''''||SUBSTR($STRING,1)||' = '', ';01400000 STMT3 = STMT3 || SUBSTR($STRING,1)||' );'; 01410000 $ENDSTR = 1; 01420000 END; /* NO COMMA WAS FOUND */ 01430000 01440000 /*******************************************************************/ 01450000 /* COMMA WAS FOUND, SO MOVE THE STRING INTO STMT3 */ 01460000 /*******************************************************************/ 01470000 01480000 ELSE 01490000 DO; /* COMMA WAS FOUND */ 01500000 IF $PUTT = 'LIST' THEN /* GEN 'VAR = ' STRING */ 01510000 DO; 01520000 STMT3 = 01530000 STMT3||''''||SUBSTR($STRING,1,$M-1)||' = '', '; 01540000 END; 01550000 STMT3 = STMT3 || SUBSTR($STRING,1,$M-1)||', '; 01560000 $STRING = SUBSTR($STRING,$M+1); /* SKIP OVER COMMA */ 01570000 END; /* END COMMA WAS FOUND */ 01580000 01590000 /*******************************************************************/ 01600000 /* PROCESS THE NEXT VARIABLE IN THE LIST */ 01610000 /*******************************************************************/ 01620000 01630000 GOTO $AGN; 01640000 END; /* DO UNTIL ENDSTR = 1 */ 01650000 END; /* DATA PARM FOUND */ 01660000 01670000 /*******************************************************************/ 01680000 /* SET STMT4 TO THE 'END' OF THE 'DO' STATMENT */ 01690000 /*******************************************************************/ 01700000 01710000 STMT4 = ' END; /* $TRACE MACRO GENERATION */'; 01720000 $BLANK = ' '; 01730000 01740000 /*******************************************************************/ 01750000 /* CLEAR OUT THE STMT BUFFERS TO THE END OF THE LINE */ 01760000 /*******************************************************************/ 01770000 01780000 DO $M = LENGTH(STMT1)+1 TO 72; /* CLEAR LINE AFTER BEGINNING */ 01790000 STMT1 = STMT1||$BLANK; /* COMMENT */ 01800000 END; 01810000 DO $M = LENGTH(STMT2)+1 TO 72; /* CLEAR LINE AFTER PUT EDIT */ 01820000 STMT2 = STMT2||$BLANK; /* STRING */ 01830000 END; 01840000 DO $M = LENGTH(STMT3)+1 TO 72; /* CLEAR LINE AFTER PUT DATA / */ 01850000 STMT3 = STMT3||$BLANK; /* PUT LIST VARIABLES */ 01860000 END; 01870000 DO $M = LENGTH(STMT4)+1 TO 72; /* CLEAR LINE AFTER ENDING */ 01880000 STMT4 = STMT4||$BLANK; /* COMMENT */ 01890000 END; 01900000 END; /* END DEBUG = 1 */ 01910000 01920000 RETURN(STMT0||STMT1||STMT2||STMT3||STMT4); 01930000 % END $TRACE; 01940000 %PAGE; 01950000 /******************************************************************** 01960000 * MODULE NAME = SSMTEP2 (SAMPLE PROGRAM 2) * 01970000 * ## Modified version: output report width up to 4000 bytes * 01980000 * ## MAXPAGWD value set to 4000 * 01980000 * ## PAGEWIDTH value set to 4096 * 01980000 * ## DSNTIARW new variable to control size of DSNTIAR area * 01980000 * ## BLKSIZE changed to 0 * 01980000 * ## MESSAGEL = MSGBLEN * DSNTIARW * 01980000 * ## CALL DSNTIAR ( SQLCA, MESSAGE, DSNTIARW) * 01980000 * ## PUT EDIT ( MESSAGET(I) ) (COL(1), A(DSNTIARW)) * 01980000 * DESCRIPTIVE NAME = SQL execution program * 01990000 * * 02000000 * LICENSED MATERIALS - PROPERTY OF IBM * 02010000 * 5675-DB2 * 02020000 * (C) COPYRIGHT 1982, 2000 IBM CORP. ALL RIGHTS RESERVED. * 02030000 * * 02040000 * STATUS = VERSION 7 * 02050000 * * 02060000 * FUNCTION = * 02070000 * * 02080000 * Execute SQL statements that are read into the program. * 02090000 * Get input from SYSIN. Write results to SYSPRINT. * 02100000 * This program uses the dynamic SQL facilities to execute * 02110000 * the SQL statements. * 02120000 * * 02130000 * NOTES = * 02140000 * * 02150000 * * 02160000 * ALL DYNAMIC SQL COMMANDS ARE SUPPORTED. * 02170000 * THE FOLLOWING STATIC SQL COMMANDS ARE ALSO SUPPORTED: * 02180000 * * 02190000 * CONNECT SET CONNECTION SET QUERYNO RELEASE * 02200000 * * 02210000 * SQL DATA TYPES SUPPORTED * 02220000 * * 02230000 * CHAR VARCHAR LONG VARCHAR * 02240000 * DECIMAL SMALLINT INTEGER * 02250000 * DATE TIME TIMESTAMP * 02260000 * FLOAT FLOAT(n) DOUBLE PRECISION * 02270000 * REAL BLOB CLOB * 02280000 * DBCLOB ROWID * 02290000 * * 02300000 * DEPENDENCIES = None * 02310000 * * 02320000 * RESTRICTIONS = * 02330000 * * 02340000 * 1. This module uses the semicolon as the default * 02350000 * terminator for SQL statements. The user may specify * 02360000 * an alternate termination character by either of these * 02370000 * means: * 02380000 * - Use the SQLTERM parameter when invoking DSNTEP2. * 02390000 * SQLTERM parameter. * 02400000 * - Use the following "functional comment" in the SQL * 02410000 * statement stream. Note that this allows you to * 02420000 * change the SQL terminator "on the fly": * 02430000 * * 02440000 * --#SET TERMINATOR x * 02450000 * * 02460000 * where 'x' is the terminator character. * 02470000 * * 02480000 * For either SQLTERM or TERMINATOR, any character is * 02490000 * valid except a blank, comma, single or double quote, * 02500000 * underscore, or parenthesis. * 02510000 * * 02520000 * 2. Comments prefixed by two hyphens (--) are allowed * 02530000 * within SQL statements. * 02540000 * * 02550000 * 3. The maximum length of SQL statements that this * 02560000 * program can handle is STMTMAX, due to its allocation * 02570000 * of space (STMTBUF). The first INPUTL characters of * 02580000 * each input record are inserted into this buffer. * 02590000 * * 02600000 * 4. For statements other than SELECT, only error * 02610000 * information or 'SUCCESSFUL" is put out, with the * 02620000 * number of rows updated, inserted, or deleted. For * 02630000 * a SELECT statement, the output is more detailed. * 02640000 * * 02650000 * SELECT PROCESSING = * 02660000 * * 02670000 * The answer for a select may be visualized by a table, W * 02680000 * characters wide and L characters long. This answer is * 02690000 * split into pages if necessary, which will show the * 02700000 * answer, giving the pages from left to right, then top * 02710000 * to bottom, as shown in an example below. The numbers * 02720000 * and internal boxes represent pages inside the answer. * 02730000 * * 02740000 * * 02750000 * |-------------------------------------------| * 02760000 * | | | | * 02770000 * | | | | * 02780000 * | 1 | 2 | 3 | * 02790000 * | | | | * 02800000 * | | | | * 02810000 * |-------------------------------------------| * 02820000 * | | | | * 02830000 * | | | | * 02840000 * | 4 | 5 | 6 | * 02850000 * | | | | * 02860000 * | | | | * 02870000 * |-------------------------------------------| * 02880000 * | | | | * 02890000 * | | | | * 02900000 * | 7 | 8 | 9 | * 02910000 * | | | | * 02920000 * | | | | * 02930000 * |-------------------------------------------| * 02940000 * * 02950000 * PROGRAM SIZES = * 02960000 * * 02970000 * The following variables can be changed to fit the * 02980000 * specific environment of the user. * 02990000 * * 03000000 * Variable Value Meaning * 03010000 * Name * 03020000 * -------- ----- -------------------------- * 03030000 * * 03040000 * PAGEWIDTH 133 Maximum width of a page in * 03050000 * characters (including the control * 03060000 * character in column one) * 03070000 * * 03080000 * MAXROW#LN 6 Maximum number of digits for the * 03090000 * row numbers in the output. * 03100000 * * 03110000 * MAXPAGWD 125 Print line width controller = * 03120000 * maximum width - 1 (for control * 03130000 * character) - MAXROW#LN (length of * 03140000 * the column display) - 1 ( a '-' * 03150000 * between the column number display * 03160000 * the SQL output display). * 03170000 * * 03180000 * MAXCOLWD 120 Maximum number of characters in a * 03190000 * character data type column. * 03200000 * Truncation occurs when this number * 03210000 * is exceeded. * 03220000 * * 03230000 * MAXPAGLN 60 Maximum number of lines on the * 03240000 * print output pages 2 thrn N. Page * 03250000 * 1 will have MAXPAGLN + 1 lines. * 03260000 * * 03270000 * PAGESIZE 4096 Size of a page. All storage * 03280000 * allocation of the SQL buffer area * 03290000 * will be a multiple of this value. * 03300000 * * 03310000 * MAXNCOLS 100 Initial maximum number of col- @34* 03320000 * umns in an answer, times 2 in @34* 03330000 * case a double SQLDA is required @34* 03340000 * for LOBs and/or UDTs. An initial @34* 03350000 * setting of 100 will handle an @34* 03360000 * SQL statement of at least 50 @34* 03370000 * columns. @34* 03380000 * If an SQL statement described * 03390000 * into a single SQLDA has more @34* 03400000 * than 100 columns -or- an SQLDA @34* 03410000 * described into a double SQLDA @34* 03420000 * has more than 50 columns, a larger * 03430000 * SQLDA area will be allocated * 03440000 * * 03450000 * MAXARRAY 32670 Maximum length of any large array * 03460000 * size (OUTBUF, BUFFSQL, COLSTART, * 03470000 * COLLN and STMTBUF) * 03480000 * * 03490000 * INPUTL 72 Length of the input record * 03500000 * * 03510000 * MAXERRORS 10 Number of errors allowed before the * 03520000 * program is terminated. Severe SQL * 03530000 * errors will cause program * 03540000 * termination whenever encountered. * 03550000 * INPUT = * 03560000 * * 03570000 * 1. Input SQL statements will be transferred * 03580000 * to the statement buffer with one blank between * 03590000 * words. * 03600000 * * 03610000 * 2. Blanks in delimited strings will be * 03620000 * transferred into the statement buffer * 03630000 * exactly as they appear in the input * 03640000 * statement. * 03650000 * * 03660000 * 3. An input line consists of characters from * 03670000 * columns 1-72. If an input statement spans over * 03680000 * multiple lines, the lines are concatenated * 03690000 * and blanks are removed such that only one * 03700000 * blank occurs between words. * 03710000 * * 03720000 * MISCELLANEOUS = * 03730000 * * 03740000 * THE FOLLOWING ARE CONSIDERED VALID INPUT TO SYSIN: * 03750000 * * 03760000 * 1. All valid dynamic SQL commands * 03770000 * * 03780000 * 2. These static SQL commands: * 03790000 * CONNECT SET CONNECTION SET QUERYNO RELEASE * 03800000 * * 03810000 * 3. These commands, which are used to terminate processing: * 03820000 * END EXIT QUIT * 03830000 * * 03840000 * 4. These commands, which provide brief HELP text: * 03850000 * HELP H ? * 03860000 * * 03870000 * 5. EXEC SQL, which is permitted as a prefix to test state- * 03880000 * ments that will be put in programs. * 03890000 * * 03900000 * 6. Standard comments, which are of these forms: * 03910000 * - All text in any line that starts with an asterisk (*) * 03920000 * - Not valid within an SQL statement * 03930000 * - All text that follows a double hyphen (--), to the * 03940000 * end of the line * 03950000 * - Can start in any column * 03960000 * - Is valid within an SQL statement * 03970000 * * 03980000 * 7. Functional comments, which are of these forms: * 03990000 * --#SET ROWS_FETCH n * 04000000 * where 'n' is a non-negative integer that indicates * 04010000 * the maximum number of rows to be FETCHed for each * 04020000 * subsequent SELECT statement. Use -1 to indicate * 04030000 * that all rows should be fetched. * 04040000 * --#SET ROWS_OUT n * 04050000 * where 'n' is a non-negative integer that indicates * 04060000 * the maximum number of rows to be outputted for each * 04070000 * subsequent SELECT statement. Use -1 to indicate * 04080000 * that all rows should be outputted. * 04090000 * --#SET TOLWARN x * 04091000 * where 'x' is a YES/NO * 04092000 * --#SET TERMINATOR x * 04100000 * where 'x' is a one-byte character to be used to * 04110000 * terminate the next SQL statement. Any character is * 04120000 * valid except a blank, comma, single or double quote, * 04130000 * underscore, or parenthesis. * 04140000 * --#SET TOLARTHWRN x (PQ66462) * 04142990 * where 'x' is a YES/NO * 04145980 * * 04150000 * MODULE TYPE = Procedure * 04160000 * PROCESSOR = * 04170000 * ADMF precompiler * 04180000 * PL/I optimizer * 04190000 * MODULE SIZE = 40K * 04200000 * ATTRIBUTES = Re-enterable * 04210000 * * 04220000 * ENTRY POINT = DSNTEP2 * 04230000 * PURPOSE = See Function * 04240000 * LINKAGE = Standard MVS program invocation, no parameters. * 04250000 * INPUT = Parameters explicitly passed to this function: * 04260000 * SYMBOLIC LABEL/NAME = SYSIN * 04270000 * DESCRIPTION = DDNAME of sequential data set containing * 04280000 * SQL statements to be executed. * 04290000 * OUTPUT = Parameters explicitly returned: * 04300000 * SYMBOLIC LABEL/NAME = SYSPRINT * 04310000 * DESCRIPTION = DDNAME of sequential output data set to * 04320000 * contain results of the statements executed.* 04330000 * * 04340000 * EXIT NORMAL = * 04350000 * * 04360000 * No errors were found in the source and no * 04370000 * errors occurred during processing. * 04380000 * * 04390000 * NOTE: If the only non-zero SQL codes generated are +100s, * 04400000 * the return code from DSNTEP2 will be 0. KYF1749* 04410000 * * 04420000 * NORMAL MESSAGES = * 04430000 * * 04440000 * 1. The following message will be generated when a HELP * 04450000 * request is made: * 04460000 * * 04470000 * ALL DYNAMIC SQL COMMANDS ARE SUPPORTED. * 04480000 * THE FOLLOWING STATIC SQL COMMANDS ARE ALSO * 04490000 * SUPPORTED: * 04500000 * CONNECT SET CONNECTION SET QUERYNO RELEASE * 04510000 * * 04520000 * 2. The following message will be generated for all input * 04530000 * statements: * 04540000 * * 04550000 * ***INPUT STATEMENT: SQL input statement * 04560000 * * 04570000 * 3. The following message will be generated when a non * 04580000 * select SQL statement is entered: * 04590000 * * 04600000 * RESULT OF SQL STATEMENT: * 04610000 * -- all SQL messages printed --- * 04620000 * * 04630000 * 4. The following messages will be generated when a zero * 04640000 * SQLCODE is returned: * 04650000 * * 04660000 * - SUCCESSFUL command OF nnn OBJECT(S) * 04670000 * The command is ALTER, CREATE, or DROP. * 04680000 * * 04690000 * - command SUCCESSFUL * 04700000 * The command is COMMIT,GRANT,LOCK,REVOKE, ROLLBACK, * 04710000 * or SET * 04720000 * * 04730000 * - SUCCESSFUL command OF nnn ROW(S) * 04740000 * The command is SELECT, DELETE, INSERT, or UPDATE * 04750000 * * 04760000 * 5. The following message will be generated when a * 04770000 * 'not found' condition was encountered as a result of an * 04780000 * open cursor: * 04790000 * * 04800000 * "NOT FOUND" CONDITION ENCOUNTERED DURING OPEN * 04810000 * * 04820000 * 6. The following message will be generated when an * 04830000 * unrecognizable SQLTYPE is encountered: * 04840000 * * 04850000 * INVALID SQLTYPE mmm ENCOUNTERED FOR FIELD # nnn * 04860000 * mmm is the SQLTYPE code * 04870000 * nnn is the field number on the SELECT that was * 04880000 * unrecognized. * 04890000 * * 04900000 * EXIT-ERROR = * 04910000 * * 04920000 * Errors were found in the source, or occurred during * 04930000 * processing. * 04940000 * * 04950000 * RETURN CODE = 4 - warning-level errors detected. * 04960000 * SQLWARNING found during execution. * 04970000 * REASON CODE = none * 04980000 * * 04990000 * RETURN CODE = 8 - errors detected. * 05000000 * SQLERROR found during execution. * 05010000 * REASON CODE = none * 05020000 * * 05030000 * RETURN CODE = 12 - severe errors detected. * 05040000 * Unable to open files. * 05050000 * Internal error, error message routine return code. * 05060000 * Statement is too long. * 05070000 * SQL buffer overflow. * 05080000 * REASON CODE = none * 05090000 * Invalid functional comment (--#SET) encountered * 05100000 * * 05110000 * ABEND CODES = none * 05120000 * * 05130000 * ERROR MESSAGES = * 05140000 * * 05150000 * 1. The following message will be generated when a SQL * 05160000 * error is found: * 05170000 * * 05180000 * SQLERROR ON command COMMAND SQL_function FUNCTION * 05190000 * * 05200000 * * 05210000 * 2. The following message will be generated when a SQL * 05220000 * warning is found: * 05230000 * * 05240000 * SQLWARNING ON command COMMAND SQL_function FUNCTION * 05250000 * * 05260000 * * 05270000 * 3. The following message will be generated when an input * 05280000 * SQL statement is greater than MAXARRAY size: * 05290000 * * 05300000 * **ERROR: SQL STATEMENT GREATER THAN nnn CHARACTERS. * 05310000 * STMT: * 05320000 * SQL_statement. * 05330000 * * 05340000 * nnn is MAXARRAY which is the maximum array defined in * 05350000 * the program. * 05360000 * SQL_statement is the current SQL statement being * 05370000 * processed. * 05380000 * * 05390000 * * 05400000 * 5. The following message will be generated when the size of * 05410000 * the SQL statement (SQLDA + FIELD BUFFERS) is greater * 05420000 * than MAXARRAY: * 05430000 * * 05440000 * **ERROR: SQL BUFFER OVERFLOW. MAXIMUM SIZE IS nn * 05450000 * nn is MAXARRAY. A return code of 12 is set. * 05460000 * * 05470000 * 6. The following message will be generated when a non * 05480000 * select SQL statement is entered: * 05490000 * * 05500000 * RESULT OF SQL STATEMENT: * 05510000 * RETURN CODE nnn FROM MESSAGE ROUTINE DSNTIAR. * 05520000 * -- any SQL messages printed --- * 05530000 * * 05540000 * 7. The following message will be generated when an invalid * 05550000 * functional comment (--#SET) is entered * 05560000 * DSNTEP2 halted due to a functional comment (--#SET) * 05570000 * error: * 05580000 * Invalid value, specified for * 05590000 * * 05600000 * EXTERNAL REFERENCES = * 05610000 * ROUTINES/SERVICES = none * 05620000 * DSNTIAR - SQL Communication Area formatting * 05630000 * DATA-AREAS = none * 05640000 * CONTROL-BLOCKS = * 05650000 * SQLCA - SQL Communication Area * 05660000 * SQLDA - SQL Descriptor Area * 05670000 * * 05680000 * PSEUDOCODE = * 05690000 * * 05700000 * DSNTEP2: PROCEDURE. * 05710000 * DECLARATIONS. * 05720000 * INITIALIZE READING FLAGS, POINTERS AND MAXIMUM CONSTANTS. * 05730000 * ALLOCATE THE SQLDA BASED UPON THE POSSIBILITY OF 50 COLUMNS * 05740000 * TO BE RETRIEVED. * 05750000 * CALL READRTN TO READ IN A SQL STATEMENT. * 05760000 * DO WHILE EXIT IS NOT SIGNALLED BY THE USER * 05770000 * INTITIALZE THE FIXED PORTION OF THE SQLDA. * 05780000 * PREPARE THE SQL STATEMENT INTO THE SQLDA. * 05790000 * SELECT. * 05800000 * WHEN( A NON-SELECT STATEMENT WAS PREPARED) THEN * 05810000 * DO. * 05820000 * EXECUTE THE SQL STATEMENT. * 05830000 * CALL PRINTCA TO INDICATE THE RESULTS OF THE STATEMENT. * 05840000 * END. * 05850000 * WHEN A SELECT STATEMENT WAS PREPARED AND THE NUMBER OF * 05860000 * COLUMNS TO RETRIEVE IS LESS THAN OR EQUAL THE NUMBER * 05870000 * COLUMNS IN THE ALLOCATED SQLDA AREA THEN * 05880000 * DO. * 05890000 * CALL SETUPOUT TO SET UP THE OUTPUT AREA. * 05900000 * OPEN A CURSOR. * 05910000 * DO UNTIL ALL VALUES ARE RETURNED. * 05920000 * or until the ROWS_FETCH limit is reached * 05930000 * FETCH A ROW. * 05940000 * If ROWS_OUT limit not reached then * 05950000 * CALL CONROW TO CONVERT THE RESULTS OF THE FETCH * 05960000 * INTO AN OUTPUT BUFFER. * 05970000 * END. * 05980000 * CALL SELRES TO OUTPUT THE RESULTS OF THE SELECT. * 05990000 * CLOSE THE CURSOR. * 06000000 * END. * 06010000 * OTHERWISE * 06020000 * DO. * 06030000 * ALLOCATE A LARGER SQLDA BY CALLING ALLOCTE. * 06040000 * CALCULATE A NEW MAXIMUM FOR SQLDA SIZE. * 06050000 * DESCRIBE THE SQLDA. * 06060000 * GO BACK TO THE BEGINNING OF THE SELECT. * 06070000 * END. * 06080000 * END. * 06090000 * CALL READRTN TO READ A NEW SQL STATEMENT. * 06100000 * END. * 06110000 * FREE ANY ALLOCATED SPACE. * 06120000 * * 06130000 * READRTN: PROCEDURE. * 06140000 * SET ENDSTR = "NO". * 06150000 * SET REREAD = "NO". * 06160000 * DO WHILE (ENDSTR = NO). * 06170000 * READ IN A STATEMENT, LINE BY LINE, AND MIRROR EACH LINE TO * 06180000 * THE OUTPUT DATA SET. * 06190000 * FILL THE STATEMENT BUFFER FROM THE CURRENT INPUT LINE. * 06200000 * AVOID INITIAL BLANKS. * 06210000 * Call PROCESS_FUNCTIONAL_COMMENT if a functional comment is * 06220000 * detected * 06230000 * TERMINATE A STATEMENT WHEN AN UNDELIMITED INSTANCE OF THE * 06240000 * STATEMENT TERMINATION CHARACTER IS FOUND. * 06250000 * CALL FINDCMD TO DETERMINE THE COMMAND. * 06260000 * SELECT. * 06270000 * WHEN(COMMAND IS EXEC) * 06280000 * DO. * 06290000 * CALL FINDCMD TO DETERMINE SECOND WORD. * 06300000 * IF SECOND WORD IS 'SQL' THEN * 06310000 * CALL FINDCMD TO LOOK FOR REAL COMMAND. * 06320000 * END. * 06330000 * WHEN(COMMAND IS HELP) * 06340000 * DO. * 06350000 * ISSUE VALID COMMANDS MESSAGE. * 06360000 * SET REREAD INDICATOR. * 06370000 * END. * 06380000 * WHEN(COMMAND IS CONNECT) * 06390000 * CALL CONNSTMT TO PROCESS CONNECT. * 06400000 * SET REREAD FLAG. * 06410000 * WHEN(COMMAND IS SET) * 06420000 * IF SECOND WORD IS 'CONNECTION' THEN * 06430000 * DO. * 06440000 * CALL SETCSTMT TO PROCESS SET CONNECTION. * 06450000 * SET REREAD FLAG. * 06460000 * END. * 06470000 * WHEN(COMMAND IS RELEASE) * 06480000 * CALL RELSTMT TO PROCESS RELEASE. * 06490000 * SET REREAD FLAG. * 06500000 * RETURN TO CALLER. * 06510000 * END SELECT. * 06520000 * IF FINDCMD'S REREAD FLAG IS SET, GET NEW STATEMENT. * 06530000 * END. * 06540000 * END READRTN. * 06550000 * * 06560000 * FINDCMD: PROCEDURE. * 06570000 * EXAMINE THE STATEMENT BUFFER TO FIND THE FIRST TOKEN * 06580000 * (NON-BLANK CHARACTERS SURROUNDED BY BLANKS). THIS * 06590000 * IS THE COMMAND. * 06600000 * END FINDCMD. * 06610000 * * 06620000 * CONNSTMT: PROCEDURE. * 06630000 * SELECT. * 06640000 * WHEN(CONNECT IS THE ONLY WORD) * 06650000 * ISSUE 'EXEC SQL CONNECT'. * 06660000 * WHEN(SECOND WORD IS 'RESET') * 06670000 * ISSUE 'EXEC SQL CONNECT RESET'. * 06680000 * WHEN(SECOND WORD IS 'TO') * 06690000 * DO. * 06700000 * PUT THIRD WORD IN HOST VARIABLE CONNLOC. * 06710000 * ISSUE 'EXEC SQL CONNECT TO :CONNLOC'. * 06720000 * END. * 06730000 * OTHERWISE * 06740000 * ISSUE INVALID CONNECT MESSAGE. * 06750000 * END SELECT. * 06760000 * IF CONNECT ERROR THEN ISSUE MESSAGE. * 06770000 * RETURN TO CALLER. * 06780000 * END CONNSTMT. * 06790000 * * 06800000 * SETCSTMT: PROCEDURE. * 06810000 * PUT THIRD WORD IN :CONNLOC. * 06820000 * ISSUE 'EXEC SQL SET CONNECTION :CONNLOC'. * 06830000 * IF SET CONNECTION ERROR THEN ISSUE MESSAGE. * 06840000 * RETURN TO CALLER. * 06850000 * END SETCSTMT. * 06860000 * * 06870000 * RELSTMT: PROCEDURE. * 06880000 * SELECT. * 06890000 * WHEN(SECOND WORD IS 'SAVEPOINT') * 06900000 * DO. * 06910000 * IF SECOND WORD IS END OF INPUT THEN * 06920000 * INDICATE RELEASE ERROR. * 06930000 * ELSE * 06940000 * RETURN STATEMENT FOR DYNAMIC PROCESSING. * 06950000 * END. * 06960000 * WHEN(SECOND WORD IS 'TO') * 06970000 * DO. * 06980000 * IF SECOND WORD IS END OF INPUT THEN * 06990000 * INDICATE RELEASE ERROR. * 07000000 * ELSE * 07010000 * IF THIRD WORD IS 'SAVEPOINT' * 07020000 * RETURN STATEMENT FOR DYNAMIC PROCESSING. * 07030000 * ELSE * 07040000 * INDICATE RELEASE ERROR. * 07050000 * END. * 07060000 * WHEN(SECOND WORD IS 'CURRENT') * 07070000 * ISSUE 'EXEC SQL RELEASE CURRENT'. * 07080000 * WHEN(SECOND WORD IS 'ALL') * 07090000 * DO. * 07100000 * IF SECOND WORD IS END OF INPUT THEN * 07110000 * ISSUE 'EXEC SQL RELEASE ALL'. * 07120000 * ELSE * 07130000 * IF THIRD WORD IS 'SQL' THEN * 07140000 * ISSUE 'EXEC SQL RELEASE ALL SQL'. * 07150000 * ELSE * 07160000 * IF THIRD WORD IS 'PRIVATE' THEN * 07170000 * ISSUE 'EXEC SQL RELEASE ALL PRIVATE'. * 07180000 * ELSE * 07190000 * INDICATE RELEASE ERROR. * 07200000 * END. * 07210000 * OTHERWISE * 07220000 * DO. * 07230000 * PUT THIRD WORD IN CONNLOC HOST VARIABLE. * 07240000 * ISSUE 'EXEC SQL RELEASE :RELLOC'. * 07250000 * END. * 07260000 * END SELECT. * 07270000 * IF RELEASE ERROR THEN ISSUE MESSAGE. * 07280000 * RETURN TO CALLER. * 07290000 * END RELSTMT. * 07300000 * * 07310000 * ALLOCTE: PROCEDURE. * 07320000 * SAVE THE CURRENT POINTER OF THE SQL BUFFER AREA AND THE * 07330000 * SIZE. * 07340000 * INCREASE THE SQL BUFFER SIZE BY 4K. * 07350000 * ALLOCATE A NEW SQL BUFFER AREA. * 07360000 * IF THE SQL BUFFER POINTER IS NON-NULL, COPY THE CONTENTS OF * 07370000 * THE PREVIOUS SQL BUFFER AREA INTO THE NEWLY ACQUIRED AREA. * 07380000 * FREE THE OLD SQL BUFFER AREA. * 07390000 * RETURN TO CALLER. * 07400000 * END ALLOCTE. * 07410000 * * 07420000 * SETUPOUT: PROCEDURE. * 07430000 * FILL IN SQLDA ADDRESSES TO RETURN DATA. * 07440000 * ALLOCATE AN OUTPUT COLUMN BUFFERS. * 07450000 * DETERMINE THE WIDTH NEEDED FOR EACH COLUMN, THE GREATER * 07460000 * OF SPACE FOR THE COLUMN NAME OR SPACE FOR THE DATA. * 07470000 * ALLOCATE AND CLEAR THE OUTPUT BUFFER, THEN INSERT THE * 07480000 * HORIZONTAL (-) PART OF THE ANSWER BOXES. * 07490000 * PUT IN COLUMN HEADINGS ( NAMES OF THE COLUMNS ). * 07500000 * BREAK UP THE ANSWER INTO HORIZONTAL PARTITIONS OF MAXPAGWD. * 07510000 * THIS WILL ALLOW ANSWERS TOO WIDE FOR A PAGE TO BE PRINTED. * 07520000 * END SETUPOUT. * 07530000 * * 07540000 * CONROW: PROCEDURE. * 07550000 * THE ROW WAS RETURNED BY FETCH AS DETERMINED BY SETUPOUT. * 07560000 * NOW CONVERT THE DATA TO CHARACTERS AND PLACE THE CHARACTERS * 07570000 * INTO AN OUTPUT BUFFER. * 07580000 * END CONROW. * 07590000 * * 07600000 * SELRES: PROCEDURE. * 07610000 * FINISH THE OUTPUT BUFFER. * 07620000 * PRINT OUT EACH HORIZONTAL PARTITION PAGE. IF THE PARTITION * 07630000 * CONTAINS A COLUMN WHICH IS TOO WIDE FOR THE PAGE, BREAK IT * 07640000 * INTO MULTIPLE PAGES. * 07650000 * PRINT ALL THE ROWS FOR EACH PAGE. * 07660000 * END SELRES. * 07670000 * * 07680000 * PROCESS_FUNCTIONAL_COMMENT: Procedure * 07690000 * Call GET_NEXT_TOKEN to return the next token in the input * 07700000 * If the token is #SET then * 07710000 * Call GET_NEXT_TOKEN * 07720000 * If the token is ROWS_FETCH * 07730000 * Call GET_NEXT_TOKEN * 07740000 * Verify the token is an integer greater than -2 * 07750000 * Apply to the ROWS_FETCH variable * 07760000 * Else if the token is ROWS_OUT * 07770000 * Call GET_NEXT_TOKEN * 07780000 * Verify the token is an integer greater than -2 * 07790000 * Apply to the ROWS_OUT variable * 07800000 * Else if the token is TERMINATOR * 07810000 * Call GET_NEXT_TOKEN * 07820000 * Verify the token is a 1-byte character * 07830000 * Apply to the SQLTERM variable * 07831990 * Else if the token is TOLARTHWRN * 07833980 * Call GET_NEXT_TOKEN * 07835970 * Verify the token is a YES/NO * 07837960 * Apply to the SQLTERM variable * 07840000 * Call REPORT_FUNCTIONAL_COMMENT_ERROR to post any errors * 07850000 * * 07860000 * GET_NEXT_TOKEN: Procedure * 07870000 * Scan the input record from a given starting position and * 07880000 * return all bytes up to the next blank. * 07890000 * * 07900000 * PROCESS_FUNCTIONAL_COMMENT_ERROR: Procedure * 07910000 * Post messages for errors detected in PROCESS_FUNCTIONAL_COMMENT* 07920000 * * 07930000 * PRINTCA: PROCEDURE. * 07940000 * CALL DSNTIAR TO FORMAT ANY MESSAGES. * 07950000 * IF A RETURN CODE WAS PASSED FROM DSNTIAR, INDICATE IT. * 07960000 * PRINT THE DATA FORMATTED FORMATTED BY DSNTIAR. * 07970000 * CHECK FOR FATAL ERROR CODES AND COUNT ERRORS. * 07980000 * TERMINATE IF THE ERROR IS FATAL OR IF THE ERROR COUNT * 07990000 * EXCEEDS THE MAXIMUM NUMBER PERMITTED (MAXERROR). * 08000000 * END PRINTCA. * 08010000 * * 08020000 * PROCEDURE STRUCTURE. * 08030000 * DSNTEP2 CALLS: * 08040000 * ALLOCTE * 08050000 * READRTN WHICH CALLS FINDCMD, CONNSTMT, SETCSTMT, RELSTMT * 08060000 * SETUPOUT WHICH CALLS ALLOCTE * 08070000 * CONROW * 08080000 * SELRES WHICH CALLS PRINTBUF * 08090000 * PRINTCA WHICH CALLS DSNTIAR * 08100000 * * 08110000 * CHANGE ACTIVITY = * 08120000 * 04-18-86 REVISIONS TO HANDLE ARITHMETIC WARNING * 08130000 * SQLCODE. KCW0006* 08140000 * REVISED END PROCESSING TO ALWAYS GO TO * 08150000 * ENDDATA. * 08160000 * 04-29-86 REVISIONS TO HANDLE PRECEDING PARENTHESES * 08170000 * IN A SQL STATEMENT. KCL0009* 08180000 * 08-07-86 REVISIONS TO HANDLE APOSTROPHES AND * 08190000 * QUOTATION MARKS PROPERLY. KCF0253* 08200000 * 08-20-86 REVISIONS TO CORRECTLY HANDLE BLANKS * 08210000 * WITHIN A DELIMITED STRING. KCF0262* 08220000 * 12-02-86 REVISIONS TO CHANGE THE PROLOG TO * 08230000 * INCLUDE COMMANDS AND DATA TYPES * 08240000 * SUPPORTED BY THIS PROGRAM. * 08250000 * CHANGED SELRES SO RAVELING PERFORMS * 08260000 * CORRECTLY. KBW0104* 08270000 * 05-14-87 REVISIONS TO HANDLE A MULTILINE QUERY * 08280000 * WHERE THE COMMAND ENDS IN COLUMN 72 KCF1707* 08290000 * 06-25-87 ADD THE SET COMMAND TO THE LIST OF * 08300000 * VALID COMMANDS KCL1174* 08310000 * 07-22-87 REVISION TO HANDLE DELETE FROM AN * 08320000 * UNPOPULATED TABLE KCW1199* 08330000 * 08-26-87 REMOVE SECOND PRINT OF SQLCA WHEN AN * 08340000 * SQLERROR OCCURS KCW1278* 08350000 * 11-06-87 SET RC=4 FOR INVALID COMMAND, DISPLAY * 08360000 * EXEC SQL PREFIXED LINES, HANDLE BLANK * 08370000 * LINES AROUND COMMENTS KCF2049* 08380000 * 02-19-90 REVISIONS TO ALLOW FOR LASTROW + LCT * 08390000 * TO BE GREATER THAN MAXPAGLN (PL56283) KYF1091* 08400000 * 01-21-91 ADD ALLOCRC VARIABLE FOR ALLOCATE * 08410000 * RETURN CODE IN ALLOCTE (PL74887-@87) KYF1626* 08420000 * 05-20-91 NOTE IN EXIT NORMAL SECTION THAT +100 * 08430000 * SQL CODES GENERATE 0 RETURN CODE KYF1749* 08440000 * 12-04-91 DSNTEP2 FORMAT ERROR IN THE PUT EDIT KDF0548* 08450000 * STATEMENT WHEN INPUT STATEMENT TOO LONG @BA06177* 08460000 * 12-04-91 SQL STATEMENTS TRUNCATED WHEN LRECL KDF0549* 08470000 * SET TO A VALUE GREATER THAN 72 @BA07832* 08480000 * 08-27-92 REMOVE -501 SQLCODE HANDLING KDP0095* 08490000 * 03-04-93 MAKE DSNTEP2 TERMINATE AFTER BAD CONN. KDW2023* 08500000 * 03-18-93 ENSURE AN SQL WARNING RETURNED FROM A KEF0059* 08510000 * FETCH IS REPORTED PN33339 * 08520000 * 08-17-93 REMOVE REFERENCE TO OBSOLETE VARIABLES KEF0728* 08530000 * VALID AND VALCDEL PN45163 * 08540000 * 10/19/93 ENABLE THE EXECUTION OF RELEASE ALL @66 KEF0866* 08550000 * 01/11/94 DELETE AN EXTRANEOUS FORMAT DIRECTIVE KEF0979* 08560000 * "A" FROM THE GRAPHICS NOT SUPPORTED MESSAGE @79* 08570000 * 01/20/94 ADD A COMMENT COUNTER AND LOGIC TO KEF0987* 08580000 * FORMAT OUTPUT WITH COMMENTS PN51135 @09* 08590000 * 02/25/94 ENHANCE OUTPUT FORMATTING FOR ONE PAGE KEW0133* 08600000 * OR MORE OF COMMENTS PN51135 KEF0987 @33* 08610000 * 03/10/94 ADD DBCS, DOUBLE-HYPHEN COMMENT DELIMITER, * 08620000 * AND OUTPUT ALIGNMENT OPTION SUPPORT * 08630000 * 03/21/94 ADD SUPPORT FOR NO OR NULL PARAMETER VALUES * 08640000 * FOR THE OUTPUT ALIGNMENT OPTION @04 KER0004* 08650000 * 09/12/94 DELETED EXTRANEOUS ELSE FROM TEST PATH WHEN * 08660000 * THE INPUT CHARACTER IS A HYPHEN @42 KER0042* 08670000 * 06/22/95 ADD MIXED AND NOMIXED INPUT PARAMETERS TO * 08680000 * RECOGNIZE MIXED CHARACTER DATA @46 KFF0346* 08690000 * 07/07/97 Do not issue warning message or return * 08700000 * code 004 if the only SQL WARNING is that * 08710000 * an UPDATE or DELETE statement does not * 08720000 * include a WHERE clause @31 PQ05631* 08730000 * 07/22/97 ADD SUPPORT FOR LOBS AND ROWID @34 li334tep2* 08740000 * * 08750000 * 04/17/00 Initialize storage to prevent abend 0c4 PQ36800* 08760000 * 05/08/01 Don't need to re-precompiled for use * 08762990 * with non-EBCDIC servers PQ48500* 08765980 * 01/09/02 Fix ALIGN(LHS) output wrapping error @54 PQ54769* 08767970 * 04/19/02 Remove codepage dependency on STMTBUF@14 PQ60214* 08768960 * 09/25/02 Format msgs for SQLCODEs +394 & +395 @78 PQ62778* 08769450 * 11/18/02 Modify to accept TOLARTHWRN as a PQ66462 * 08769540 * functional comment * 08769630 < * 12/18/04 Permit fetching of UTF-16 data when @02 PQ98170* 08769720 < * current application encoding scheme @02 PQ98170* 08769810 < * is a SBCS CCSID. @02 PQ98170* 08769900 * 01/18/04 Modify to accept TOLWARN as a * 08769930 * functional comment * 08769960 *******************************************************************/ 08770000 %PAGE; 08780000 /*******************************************************************/ 08790000 /* VARIABLE DECLARATIONS */ 08800000 /*******************************************************************/ 08810000 08820000 DCL COMMAND CHAR(9) INIT( ' ' ); /* USER SPECIFIED COMMAND */ 08830000 08840000 /*******************************************************************/ 08850000 /* CONSTANTS DECLARATIONS */ 08860000 /*******************************************************************/ 08870000 08880000 /*******************************************************************/ 08890000 /* DECLARE DBCS-RELATED CONSTANTS */ 08900000 /*******************************************************************/ 08910000 08920000 DCL 08930000 (SOB BIT(8) INIT('00001110'B), /* SHIFT-OUT DATA */ 08940000 SIB BIT(8) INIT('00001111'B), /* SHIFT-IN DATA */ 08950000 SO CHAR(1) BASED(ADDR(SOB)), /* CHARACTER OF SO */ 08960000 SI CHAR(1) BASED(ADDR(SIB))); /* CHARACTER OF SI */ 08970000 08980000 /*******************************************************************/ 08990000 /* CHARACTER CONSTANTS */ 09000000 /*******************************************************************/ 09010000 09020000 DCL 09030000 ASTERISK CHAR(1) INIT('*') STATIC, /* COMMENT INDICATOR */ 09040000 BLANK CHAR(1) INIT(' ') STATIC, /* INITIALIZATION BLANKS */ 09050000 HDASH CHAR(1) INIT('-') STATIC, /* OUTPUT BOX CHARACTER */ 09060000 HPLUS CHAR(1) INIT('+') STATIC, /* OUTPUT BOX TERMINATOR */ 09070000 HUNDER CHAR(1) INIT('_') STATIC, /* UNDERLINE CHARACTER */ 09080000 HYPHEN CHAR(1) INIT('-') STATIC, /* HYPHEN */ 09090000 NULLCHAR CHAR(1) VAR INIT('') STATIC, /* NULL CHARACTER */ 09100000 PERIOD CHAR(1) INIT('.') STATIC, /* PERIOD */ 09110000 QUOTE CHAR(1) INIT('''') STATIC, /* QUOTATION MARK */ 09120000 DQUOTE CHAR(1) INIT('"') STATIC, /* DOUBLE QUOTATION MARK */ 09130000 SEMICOLON CHAR(1) INIT(';') STATIC, /* SQL STMT TERMINATOR */ 09140000 VBAR CHAR(1) INIT('|') STATIC, /* OUTPUT VERTICAL BAR */ 09150000 BLNKLINE CHAR(72) INIT(' ') STATIC;/* BLANK INPUT LINE */ 09160000 09170000 /*******************************************************************/ 09180000 /* PROGRAM INPUT/OUTPUT CONSTANTS */ 09190000 /*******************************************************************/ 09200000 09210000 DCL 09220000 INPUTL FIXED BIN(15) INIT(72) STATIC, /* SYSIN LRECL */ 09230000 MAXARRAY FIXED BIN(15) INIT(32670) STATIC, /* MAX ARRY SIZE*/ 09240000 MAXCOLWD FIXED BIN(15) INIT(120) STATIC, /* MAX STRING SIZE */ 09250000 MAXERRORS FIXED BIN(15) INIT(10) STATIC, /* MAX # ERRORS */ 09260000 /* ALLOWED BEFORE */ 09270000 /* TERMINATION */ 09280000 MAXNCOLS FIXED BIN(15) INIT(100) STATIC, /* MAX # OF COLS@34*/ 09290000 MAXROW#LN FIXED BIN(15) INIT(6) STATIC, /* ROW # DIGITS */ 09300000 MAXPAGWD FIXED BIN(31) INIT(4000) STATIC, /* OUPUT WIDTH */ 09310000 DSNTIARW FIXED BIN(31) INIT(125) STATIC, /* DSNTIAR WIDTH */ 09310000 MAXPAGLN FIXED BIN(15) INIT(60) STATIC, /* # LINES / PAGE */ 09320000 PAGESIZE FIXED BIN(31) INIT(4096) STATIC,/* STORAGE IS */ 09330000 /* OBTAINED IN */ 09340000 /* 4K INCREMENTS */ 09350000 PAGEWIDTH FIXED BIN(31) INIT(4096) STATIC; /* SYSOUT LRECL */ 09360000 09370000 /*******************************************************************/ 09380000 /* SQLCODE CONSTANTS */ 09390000 /*******************************************************************/ 09400000 09410000 DCL 09420000 ARITHWRN FIXED BIN(15) INIT(802) STATIC, /* ARITH. WARNING */ 09430000 TRUNCWRN FIXED BIN(15) INIT(445) STATIC, /* TRUNC. WARNING */ 09440000 RETERR FIXED BIN(15) INIT(8) STATIC,/* SQL ERRORS RC */ 09450000 RETWARN FIXED BIN(15) INIT(4) STATIC,/* SQL WARNINGS RC */ 09460000 SEVERE FIXED BIN(15) INIT(12) STATIC; /* SEVERE SQL ERROR*/ 09470000 /* RETURN CODE */ 09480000 09490000 /*******************************************************************/ 09500000 /* NUMBER CONSTANTS */ 09510000 /*******************************************************************/ 09520000 09530000 DCL 09540000 ZERO FIXED BIN(15) INIT(0) STATIC, 09550000 ONE FIXED BIN(15) INIT(1) STATIC, 09560000 TWO FIXED BIN(15) INIT(2) STATIC, 09570000 THREE FIXED BIN(15) INIT(3) STATIC, 09580000 FOUR FIXED BIN(15) INIT(4) STATIC, 09590000 FIVE FIXED BIN(15) INIT(5) STATIC, 09600000 EIGHT FIXED BIN(15) INIT(8) STATIC, 09610000 NINE FIXED BIN(15) INIT(9) STATIC, 09620000 TEN FIXED BIN(15) INIT(10) STATIC, 09630000 LOCLEN FIXED BIN(15) INIT(16) STATIC, 09640000 < UTF_16 FIXED BIN(31) INIT(1200) STATIC; /*@02*/ 09643000 09650000 /*******************************************************************/ 09660000 /* FLAG CONSTANTS */ 09670000 /*******************************************************************/ 09680000 09690000 DCL 09700000 YES BIT(1) INIT('1'B) STATIC, /* BIT FLAG ON */ 09710000 NO BIT(1) INIT('0'B) STATIC; /* BIT FLAG OFF */ 09720000 09730000 09740000 /*******************************************************************/ 09750000 /* INPUT / OUTPUT BUFFER VARIABLES DECLARATION */ 09760000 /*******************************************************************/ 09770000 09780000 DCL 09790000 ALIGNLHS BIT(1) INIT('0'B), /* ALIGN OUTPUT LEFT FLAG */ 09800000 < APPENSCH FIXED BIN(15) INIT(0), /* Receiver for @02*/ 09802000 < /* CURRENT APPLICATION @02*/ 09804000 < /* ENCODING SCHEME @02*/ 09806000 BEGREC FIXED BIN(31) INIT(0), /* FIRST ROW # IN OUTPUT */ 09810000 COLTITL FIXED BIN(15) INIT(0), /*1ST ROW OF COLUMN TITLES*/ 09820000 COMMENT BIT(1) INIT('0'B), /* COMMENT ENCOUNTERED? */ 09830000 CMTONLY BIT(1) INIT('0'B), /* FULL-LINE CMNTS SO FAR */ 09840000 ALLBLANK BIT(1) INIT('0'B), /* ALL-BLANK LINE FOUND */ 09850000 ENDSTR BIT(1) INIT('0'B), /* END OF STATEMENT FLAG */ 09860000 EODIN BIT(1) INIT('0'B), /* END OF INPUT DATA FLAG */ 09870000 ERR FIXED BIN(15) INIT(0), /* THE CURRENT RETURN CODE*/ 09880000 ERRCOUNT FIXED BIN(15) INIT(0), /* # OF ERRORS ENCOUNTERED*/ 09890000 EXIT BIT(1) INIT('0'B), /* PROGRAM EXIT INDICATOR */ 09900000 FIRSTPAGE BIT(1) INIT('0'B), /* FIRST PAGE OF OUTPUT? */ 09910000 FUNCTION CHAR(9) INIT(' '), /* SQL FUNCTION SPECIFIED */ 09920000 HEADEND FIXED BIN(15) INIT(0), /* LAST ROW, HDNG & TITLES*/ 09930000 I FIXED BIN(15) INIT(0), /* LOOP COUNTER VARIABLE */ 09940000 INCOL FIXED BIN(15) INIT(0), /* CURRENT INPUT COLUMN */ 09950000 INPUT(INPUTL) CHAR(1), /* CURRENT INPUT DATA */ 09960000 J FIXED BIN(15) INIT(0), /* LOOP COUNTER VARIABLE */ 09970000 J2 FIXED BIN(15) INIT(0), /* Indexes double SQLDA */ 09980000 K FIXED BIN(15) INIT(0), /* LOOP COUNTER VARIABLE */ 09990000 KK FIXED BIN(15) INIT(0), /* LOOP COUNTER VARIABLE */ 10000000 KNT FIXED BIN(15) INIT(0), /* LOOP COUNTER VARIABLE */ 10010000 LASTCOL FIXED BIN(15) INIT(0), /* OUTBUF LAST COL PUT OUT*/ 10020000 LASTROW FIXED BIN(15) INIT(0), /* OUTBUF LAST ROW PUT OUT*/ 10030000 LCT FIXED BIN(15) INIT(0), /* NUM EXTRA LINES ON PAGE*/ 10040000 LINECNT FIXED BIN(31) INIT(0), /* ROWS OUTPUTTED COUNTER */ 10050000 < MBCS_APPENSCH BIT(1) INIT('0'B), /* CURRENT APPL ENCOD- @02*/ 10053000 < /* ING SCHEME = MBCS? @02*/ 10056000 MIXEDFLG BIT(1) INIT('0'B), /* MIXED CHAR DATA OKAY@46*/ 10060000 OSTMTLN FIXED BIN(15) INIT(0), /* # OUTPUT LINES NEEDED */ 10070000 /* FOR INPUT STATEMENT */ 10080000 PAGEBUF CHAR(15) VAR INIT(' '), /* OUTPUT PAGE INFO */ 10090000 PAGENO PIC 'ZZZ9' INIT(0), /* OUTPUT PAGE COUNTER */ 10100000 PARMLEN FIXED BIN(15) INIT(0), /* INPUT PARM LENGTH @46*/ 10110000 PARMMAX FIXED BIN(15) INIT(11) STATIC, /*MAX PARM LGTH @46*/ 10120000 PARMS CHAR(50) VAR, /* INPUT PARM STRING @46*/ 10130000 PARM1 CHAR(12) VAR INIT(' '), /* FIRST INPUT PARM @46*/ 10140000 PARM2 CHAR(12) VAR INIT(' '), /* SECOND INPUT PARM @46*/ 10147000 PARM3 CHAR(12) VAR INIT(' '), /* Third input parm */ 10154000 PRTPNO BIT(1) INIT('0'B), /* SELRES=YES->PRINT PG #S*/ 10170000 PARMCNT FIXED BIN(15) INIT(0), /* INPUT PARM COUNTER @46*/ 10180000 PARMOFF FIXED BIN(15) INIT(0), /* INPUT PARM OFFSET @46*/ 10190000 WRNING BIT(1) INIT('0'B), /* YES: PRNT SQLCA WARNING*/ 10200000 RECNT FIXED BIN(31) INIT(0), /* NO. OF ROWS RETRIEVED */ 10210000 RETCODE FIXED BIN(31) INIT(0), /* DSNTEP2 RETURN CODE */ 10220000 SETUPRC FIXED BIN(15) INIT(0), /* SETUPOUT RETURN CODE */ 10230000 SQLTERM CHAR(1) INIT(' '), /* SQL stmt term char */ 10240000 ALLOCRC FIXED BIN(15) INIT(0); /* ALLOCTE RETURN CODE @87*/ 10250000 10260000 /*******************************************************************/ 10270000 /* BUILT IN FUNCTIONS DECLARATIONS */ 10280000 /*******************************************************************/ 10290000 10300000 DCL 10310000 ADDR BUILTIN, /* FUNCTION TO RETURN THE ADDRESS */ 10320000 ALLOCATION BUILTIN, /* CHECK IF A BLOCK IS ALLOCATED */ 10330000 CHAR BUILTIN, /* RETURNS CHAR REPRESENTATION */ 10340000 DIM BUILTIN, /* FUNCTION TO RETURN DIMENSION */ 10350000 FLOOR BUILTIN, /* Largest integer <= argument */ 10360000 LENGTH BUILTIN, /* RETURNS LENGTH OF A STRING */ 10370000 LOW BUILTIN, /* Smallest value in collation */ 10380000 MAX BUILTIN, /* FUNCTION TO RETURN MAXIMUM */ 10390000 MIN BUILTIN, /* FUNCTION TO RETURN MINIMUM */ 10400000 MOD BUILTIN, /* RETURNS MODULO VALUE */ 10410000 NULL BUILTIN, /* NULL VALUE */ 10420000 PLIRETC BUILTIN, /* FUNCTION TO SET RETURN CODE */ 10430000 PLIRETV BUILTIN, /* PL/I RETURN CODE VALUE */ 10440000 REPEAT BUILTIN, /* STRING REPEATER FUNCTION @34*/ 10450000 SUBSTR BUILTIN, /* FUNCTION TO RETURN SUBSTRING */ 10460000 TRANSLATE BUILTIN, /* PERFORMS CHAR TRANSLATION @34*/ 10470000 TRUNC BUILTIN, /* RETURNS TRUNCATED VALUE */ 10480000 UNSPEC BUILTIN, /* IGNORES VARIABLE TYPING */ 10490000 VERIFY BUILTIN; /* Audits contents of a string */ 10500000 10510000 /*******************************************************************/ 10520000 /* SQLTYPE VALUES TO BE RETURNED ON A DESCRIBE STATEMENT */ 10530000 /*******************************************************************/ 10540000 10550000 DCL 10560000 DATETYP FIXED BIN(15) INITIAL(384) STATIC, /* DATE TYPE */ 10570000 NDATETYP FIXED BIN(15) INITIAL(385) STATIC, /* NULL DATE */ 10580000 TIMETYP FIXED BIN(15) INITIAL(388) STATIC, /* TIME TYPE */ 10590000 NTIMETYP FIXED BIN(15) INITIAL(389) STATIC, /* NULL TIME */ 10600000 TIMES FIXED BIN(15) INITIAL(392) STATIC, /* TIMESTAMP */ 10610000 NTIMES FIXED BIN(15) INITIAL(393) STATIC, /* NULL TIMESTMP*/ 10620000 /* -- begin @34 */ 10630000 BLOBT FIXED BIN(15) INITIAL(404) STATIC, /* BINARY LOB */ 10640000 BLOBNT FIXED BIN(15) INITIAL(405) STATIC, /* NULL BIN LOB */ 10650000 CLOBT FIXED BIN(15) INITIAL(408) STATIC, /* CHARACTER LOB*/ 10660000 CLOBNT FIXED BIN(15) INITIAL(409) STATIC, /* NULL CHAR LOB*/ 10670000 DBCLOBT FIXED BIN(15) INITIAL(412) STATIC, /* DBL BYTE CLOB*/ 10680000 DBCLOBNT FIXED BIN(15) INITIAL(413) STATIC, /* NULL DBCLOB */ 10690000 /* -- end @34 */ 10700000 VCHART FIXED BIN(15) INITIAL(448) STATIC, /* VARYING CHAR */ 10710000 VCHARNT FIXED BIN(15) INITIAL(449) STATIC, /* NULL VARCHAR */ 10720000 CHART FIXED BIN(15) INITIAL(452) STATIC, /* CHARACTER */ 10730000 CHARNT FIXED BIN(15) INITIAL(453) STATIC, /* CHAR NULL */ 10740000 LVCHART FIXED BIN(15) INITIAL(456) STATIC, /* LONG VARCHAR */ 10750000 LVCHARNT FIXED BIN(15) INITIAL(457) STATIC, /* NULL LONG */ 10760000 /* VARCHAR */ 10770000 GVCHAR FIXED BIN(15) INITIAL(464) STATIC, /* GRAPHIC */ 10780000 /* VARCHAR */ 10790000 GVCHARN FIXED BIN(15) INITIAL(465) STATIC, /* NULL GRAPHIC */ 10800000 /* VARCHAR */ 10810000 GCHAR FIXED BIN(15) INITIAL(468) STATIC, /* GRAPHIC CHAR */ 10820000 GCHARN FIXED BIN(15) INITIAL(469) STATIC, /* NULL GRAPHIC */ 10830000 GLCHAR FIXED BIN(15) INITIAL(472) STATIC, /* GRAPHIC LONG */ 10840000 /* VARCHAR */ 10850000 GLCHARN FIXED BIN(15) INITIAL(473) STATIC, /* NULL GRAPHIC */ 10860000 /* LONG VARCHAR */ 10870000 FLOATT FIXED BIN(15) INITIAL(480) STATIC, /* FLOAT POINT */ 10880000 FLOATNT FIXED BIN(15) INITIAL(481) STATIC, /* NULL FLOAT */ 10890000 DECT FIXED BIN(15) INITIAL(484) STATIC, /* PACKED DEC */ 10900000 DECNT FIXED BIN(15) INITIAL(485) STATIC, /* NULL PACK DEC*/ 10910000 INTT FIXED BIN(15) INITIAL(496) STATIC, /* INTEGER TYPE */ 10920000 INTNT FIXED BIN(15) INITIAL(497) STATIC, /* INTEGER NULL */ 10930000 SMINTT FIXED BIN(15) INITIAL(500) STATIC, /* SMALL INTEGER*/ 10940000 SMINTNT FIXED BIN(15) INITIAL(501) STATIC, /* NULL SM. INT */ 10950000 /* -- begin @34 */ 10960000 ROWIDT FIXED BIN(15) INITIAL(904) STATIC, /* ROWID */ 10970000 ROWIDNT FIXED BIN(15) INITIAL(905) STATIC, /* NULL ROWID */ 10980000 BLOBLOCT FIXED BIN(15) INITIAL(960) STATIC, /* BLOB LOCATOR */ 10990000 BLOBLOCNT FIXED BIN(15) INITIAL(961) STATIC, /* NULL BLOB IND*/ 11000000 CLOBLOCT FIXED BIN(15) INITIAL(964) STATIC, /* CLOB LOCATOR */ 11010000 CLOBLOCNT FIXED BIN(15) INITIAL(965) STATIC, /* NULL CLOB IND*/ 11020000 DBCLOBLOCT FIXED BIN(15) INITIAL(968) STATIC, /* DBCLOB LOCATR*/ 11030000 DBCLOBLOCNT FIXED BIN(15) INITIAL(969) STATIC; /* NL DBCLOB IND*/ 11040000 /* -- end @34 */ 11050000 11060000 /*******************************************************************/ 11070000 /* DECLARE BUFFER AREAS FOR THE SQLCA AND THE SQLDA */ 11080000 /*******************************************************************/ 11090000 11100000 EXEC SQL INCLUDE SQLCA; /* DEFINE THE SQLCA */ 11110000 EXEC SQL INCLUDE SQLDA; /* DEFINE THE SQLDA (BASED) */ 11120000 11130000 DCL 11140000 11150000 /*******************************************************************/ 11160000 /* LENGTH OF THE FIXED PORTION OF THE SQLDA */ 11170000 /*******************************************************************/ 11180000 11190000 LEN_SQLDA FIXED BIN(15) INIT(16) STATIC, 11200000 11210000 /*******************************************************************/ 11220000 /* LENGTH OF THE VARIABLE PORTION OF THE SQLDA. THIS IS */ 11230000 /* DETERMINED BY THE NUMBER OF FIELDS IN THE CURRENT SQL STATEMENT */ 11240000 /*******************************************************************/ 11250000 11260000 LEN_SQLVAR FIXED BIN(15) INIT(44) STATIC, 11270000 11271000 MAXPAGWD) IS */ 11800000 /* IN THIS HORIZ PARTITION */ 11810000 NPART FIXED BIN(15) INIT(0), /* PARTITION COUNTER */ 11820000 OBUFWID FIXED BIN(31) INIT(0), /* ALLOC'D OUTPT BUFR WIDTH*/ 11830000 OUTBUF(*) CHAR(*) CTL, /* FLD VALS ARE PACKED INTO*/ 11840000 /* OUTBUF FOR PRINTING */ 11850000 OUTBUFLN FIXED BIN(15) INIT(0), /* LENGTH OF OUTPUT BUFFER */ 11860000 OUTPARTL FIXED BIN(15) INIT(0), /* LEN OF OUTPUT BUFFERS */ 11870000 PARTBEG(*) FIXED BIN(15) CTL; /* INDEX INTO COLSTART */ 11880000 /* INDICATING START OF */ 11890000 /* THE HORIZONTAL PARTI- */ 11900000 /* TION OF A PAGE */ 11910000 /*******************************************************************/ 11920000 /* DECLARES FOR DECIMAL FIELDS */ 11930000 /*******************************************************************/ 11940000 DCL DECMASK (32) BIT(4) BASED; /* MASK FOR LOOKING FOR SIGN, */ 11950000 /* BEGINNING OF SIGNIFICANT DIGITS*/ 11960000 DCL 1 DECTEMP, /* USED FOR BUILDING EBCDIC CHARS */ 11970000 2 DECFMT1 BIT(4) INIT('1111'B), 11980000 2 DECFMT2 BIT(4) INIT('0000'B); 11990000 DCL DECFMT CHAR(1) BASED(ADDR(DECTEMP)); 12000000 DCL DIND FIXED BIN(31) INIT(0); /* INDEX INTO DECIMAL NO. */ 12010000 DCL DECPREC FIXED BIN(15) INIT(0); /* PRECISION */ 12020000 DCL DECSCAL FIXED BIN(15) INIT(0); /* SCALE */ 12030000 12040000 /*******************************************************************/ 12050000 /* Variable to indicate whether next statement should be read */ 12060000 /*******************************************************************/ 12070000 DCL NEWSTMT BIT(1) INIT('1'B); /* NEW STMT TO PROCESS? */ 12080000 12090000 /*******************************************************************/ 12100000 /* VARIABLE FOR INDICATING A COLUMN IS DEFINED AS NOT NULL */ 12110000 /*******************************************************************/ 12120000 DCL NOTNULL BIN FIXED(15) INIT(1); 12130000 12140000 /********************************************************************* 12150000 * Variable for staging eoj in the event of CREATE TRIGGER failure * 12160000 *********************************************************************/ 12170000 DCL CREATE_TRIGGER_STMT BIT( 1 ) INIT( '0'B ); 12180000 12190000 /* -- begin @34 */ 12200000 /********************************************************************/ 12210000 /* Variables for translating to displayable hex format */ 12220000 /********************************************************************/ 12230000 DCL HEX_DISPLAY BIT(1) INIT('0'B); /* HEX display indicator */ 12240000 DCL EBCDIC_CHARS CHAR(256) INIT(' '); /* EBCDIC source char vectr*/ 12250000 DCL HIGH_NIBBLES CHAR(256) INIT(' '); /* HEX hi nibble equiv vect*/ 12260000 DCL LOW_NIBBLES CHAR(256) INIT(' '); /* HEX lo nibble equiv vec */ 12270000 DCL HEXBUFH CHAR(*) CTL; /* HEX xlate buff, hi nibs */ 12280000 DCL HEXBUFL CHAR(*) CTL; /* HEX xlate buff, lo nibs */ 12290000 /* -- end @34 */ 12300000 12310000 /********************************************************************* 12320000 * Variables for controlling number of rows fetched and outputted * 12330000 *********************************************************************/ 12340000 DCL ROWS_FETCH FIXED BIN(31) INIT( -1 ); 12350000 DCL ROWS_OUT FIXED BIN(31) INIT( -1 ); 12360000 DCL TOLARTHWRN BIT(1) INIT('0'B); /*Allow Arithmetic warning*/ 12364990 DCL TOLWARN BIT(1) INIT('0'B); /* Allow sqlwarning */ 12370000 /*******************************************************************/ 12380000 /* MESSAGE FORMATTING ROUTINE AND VARIABLES DECLARATIONS */ 12390000 /*******************************************************************/ 12400000 12410000 DCL 12420000 DSNTIAR ENTRY EXTERNAL OPTIONS(ASM INTER RETCODE); 12430000 12440000 DCL 12450000 MSGBLEN FIXED BIN(15) INIT(10); /* MAX # SQL MESSAGES */ 12460000 /* RETURNED FROM DSNTIAR */ 12470000 DCL 12480000 01 MESSAGE, /* RETURNED MESSAGES AREA */ 12490000 02 MESSAGEL FIXED BIN(15) /* MESSAGE BUFFER LENGTH */ 12500000 INIT(0), 12510000 02 MESSAGET(MSGBLEN) CHAR(DSNTIARW) /* SQLCA MSGS SPACE */ 12520000 INIT(' '); 12530000 12540000 /*******************************************************************/ 12550000 /* BUFFER DECLARATION FOR THE INPUT SQL STATEMENT */ 12560000 /* *** NOTE *** : THE CHARACTER SIZE MUST BE EXPLICIT FOR THE */ 12570000 /* PRECOMPILER */ 12580000 /*******************************************************************/ 12590000 12600000 DCL 12610000 INPLLEN FIXED BIN(15) INIT(100), /* LEN OF SQL PRINT STMT */ 12620000 STMTBUF CHAR(32670) VAR INIT(' '),/* SQL STATEMENT STRING */ 12630000 STMTLEN FIXED BIN(15) INIT(0), /* SQL STMT STRING LGTH */ 12640000 STMTMAX FIXED BIN INIT(MAXARRAY); /* SQL STATEMENT BUFFER */ 12650000 /* MAXIMUM LENGTH */ 12660000 12670000 /***************************************************************@14*/ 12675180 /* Declare a dummy host variable to force the precompiler to inter-*/ 12675370 /* pret STMTBUF as a host variable instead of as a PL/I string ex- */ 12675560 /* pression. See the discussion of PREPARE in the SQL Reference */ 12675750 /* for more information. */ 12675940 /***************************************************************@14*/ 12676130 /* WARNING: The EBCDIC CCSID for HVDUMMY (or any SQL DECLARED var- */ 12676320 /* iable) is assigned in the DB2 precompilation phase rather than */ 12676510 /* the BIND phase. Use of HVDUMMY in any other SQL statement in */ 12676700 /* this program can lead to character conversion errors if the */ 12676890 /* EBCDIC CCSID used to precompile DSNTEP2 is different from EBC- */ 12677080 /* DIC CCSID used to BIND DSNTEP2. See the discussion of DECLARE */ 12677270 /* VARIABLE in the SQL Reference for more information. */ 12677460 /*******************************************************************/ 12677650 DCL HVDUMMY CHAR(1) INIT(' '); /* Dummy host var @14*/ 12677840 EXEC SQL DECLARE :HVDUMMY VARIABLE CCSID EBCDIC; /*@14*/ 12678030 12680000 /* -- begin @34 */ 12690000 /*******************************************************************/ 12700000 /* SQL ROWID declarations */ 12710000 /*******************************************************************/ 12720000 DCL ROWIDBUF CHAR( 40 ) VAR BASED; /* ROWID data buffer */ 12730000 DCL ROWIDLEN FIXED BIN(15) INIT(42); /* ROWID data buffer length */ 12740000 /* -- end @34 */ 12750000 12760000 /*******************************************************************/ 12770000 /* SQL CURSOR AND INPUT STATEMENT DECLARATION */ 12780000 /*******************************************************************/ 12790000 12800000 EXEC SQL DECLARE STATEMENT STATEMENT; 12810000 EXEC SQL DECLARE C1 CURSOR FOR STATEMENT; 12820000 12830000 /*******************************************************************/ 12840000 /* FILE DECLARATIONS */ 12850000 /*******************************************************************/ 12860000 12870000 DCL 12880000 SYSIN FILE STREAM INPUT, /* INPUT FILE */ 12890000 SYSPRINT FILE STREAM OUTPUT /* OUTPUT FILE */ 12900000 ENV(VB,RECSIZE(PAGEWIDTH),BLKSIZE(0)); 12910000 12920000 %PAGE; 12930000 12940000 /*******************************************************************/ 12950000 /* MAIN PROGRAM */ 12960000 /*******************************************************************/ 12970000 12980000 $TRACE ('SSMTEP2 IN'); 12990000 13000000 /*******************************************************************/ 13010000 /* GENERAL INITIALIZATION */ 13020000 /*******************************************************************/ 13030000 13040000 RETCODE = ZERO; /* INITIALIZE THE RETURN CODE */ 13050000 ERRCOUNT = ZERO; /* INITIALIZE THE ERROR COUNTER */ 13060000 ALLOCRC = ZERO; /* INITIALIZE ALLOCATE RET CODE@87*/ 13070000 13080000 FIRSTPAGE = YES; /* INITIALIZE FIRST PAGE FLAG */ 13090000 TOLARTHWRN = NO;/* INITIALIZE TOLERATE ARITHWRN */ 13094990 TOLWARN = NO; /* INITIALIZE TOLERATE SQLWARNING */ 13095000 WRNING = NO; /* INITIALIZE PRINTING SQLCA ON */ 13100000 /* WARNING FLAG */ 13110000 BUFFPTR = NULL; /* INITIALIZE THE BUFFER POINTER */ 13120000 OUTBUFLN = ZERO; /* INIT OUTPUT BUFFER LENGTH */ 13130000 COLBUFLN = ZERO; /* INIT COLUMN BUFFER LENGTH */ 13140000 OUTPARTL = ZERO; /* INIT PARTITION BUFFER LENGTH */ 13150000 MESSAGEL = MSGBLEN * DSNTIARW; /* SET MESSAGE BUFFER LENGTH */ 13160000 ALIGNLHS = NO; /* INITIALIZE OUTPUT ALIGNMENT @46*/ 13170000 /* TO THE CENTER OF THE PAGE @46*/ 13180000 MIXEDFLG = NO; /* INITIALIZE MIXED CHARACTER @46*/ 13190000 /* DATA RECOGNITION FLAG @46*/ 13200000 13210000 /* -- begin @34 */ 13220000 /*******************************************************************/ 13230000 /* Base initial SQL buffer size on max. initial max. columns value */ 13240000 /* - PAGESIZE is the number of bytes in a page of storage */ 13250000 /* - MAXNCOLS is the initial maximum no. of columns setting */ 13260000 /* - 16 is the number of bytes in the SQLDA header area */ 13270000 /* - 44 is the number of bytes in each SQLVAR entry in the SQLDA */ 13280000 /*******************************************************************/ 13290000 BUFFSIZE = PAGESIZE * FLOOR( ( 16 + (MAXNCOLS * 44) ) / PAGESIZE ); 13300000 13310000 /*******************************************************************/ 13320000 /* Initialize arrays for mapping EBCDIC to displayable hex */ 13330000 /*******************************************************************/ 13340000 HEX_DISPLAY = NO; /* Set HEX display format off */ 13350000 13360000 EBCDIC_CHARS = '000102030405060708090A0B0C0D0E0F'X 13370000 || '101112131415161718191A1B1C1D1E1F'X 13380000 || '202122232425262728292A2B2C2D2E2F'X 13390000 || '303132333435363738393A3B3C3D3E3F'X 13400000 || '404142434445464748494A4B4C4D4E4F'X 13410000 || '505152535455565758595A5B5C5D5E5F'X 13420000 || '606162636465666768696A6B6C6D6E6F'X 13430000 || '707172737475767778797A7B7C7D7E7F'X 13440000 || '808182838485868788898A8B8C8D8E8F'X 13450000 || '909192939495969798999A9B9C9D9E9F'X 13460000 || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'X 13470000 || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'X 13480000 || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'X 13490000 || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'X 13500000 || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'X 13510000 || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'X; 13520000 HIGH_NIBBLES = '000000000000000011111111111111112222222222222222' 13530000 || '333333333333333344444444444444445555555555555555' 13540000 || '666666666666666677777777777777778888888888888888' 13550000 || '9999999999999999AAAAAAAAAAAAAAAABBBBBBBBBBBBBBBB' 13560000 || 'CCCCCCCCCCCCCCCCDDDDDDDDDDDDDDDDEEEEEEEEEEEEEEEE' 13570000 || 'FFFFFFFFFFFFFFFF'; 13580000 LOW_NIBBLES = '0123456789ABCDEF0123456789ABCDEF0123456789ABCDEF' 13590000 || '0123456789ABCDEF0123456789ABCDEF0123456789ABCDEF' 13600000 || '0123456789ABCDEF0123456789ABCDEF0123456789ABCDEF' 13610000 || '0123456789ABCDEF0123456789ABCDEF0123456789ABCDEF' 13620000 || '0123456789ABCDEF0123456789ABCDEF0123456789ABCDEF' 13630000 || '0123456789ABCDEF'; 13640000 /* -- end @34 */ 13650000 13660000 13670000 /*******************************************************************/ 13680000 /* PROGRAM PARAMETER PROCESSING @46*/ 13690000 /*******************************************************************/ 13700000 13710000 PARMLEN = LENGTH(PARMS); /* INPUT PARM STRING LENGTH @46*/ 13720000 13730000 /*******************************************************************/ 13740000 /* ELIMINATE COMMAS FROM THE INPUT PARAMETER STRING @46*/ 13750000 /*******************************************************************/ 13760000 13770000 DO I = 1 TO PARMLEN; /*@46*/ 13780000 IF SUBSTR(PARMS,I,ONE) = ',' /*@46*/ 13790000 THEN SUBSTR(PARMS,I,ONE) = BLANK; /*@46*/ 13800000 END; /*@46*/ 13810000 13820000 /*******************************************************************/ 13830000 /* INTITIALIZE THE PARAMETERS AND COUNTERS @46*/ 13840000 /*******************************************************************/ 13850000 13860000 PARMCNT = 0; /* INITIALIZE PARM COUNTER @46*/ 13870000 PARMOFF = 1; /* INITIALIZE PARM OFFSET @46*/ 13880000 PARM1 = BLANK; /* CLEAR OUT THE PARM1 FIELD @46*/ 13890000 PARM2 = BLANK; /* CLEAR OUT THE PARM2 FIELD @46*/ 13900000 PARM3 = BLANK; /* Clear the PARM3 field */ 13910000 SQLTERM = SEMICOLON; /* Set default SQL termination char*/ 13920000 13930000 /*******************************************************************/ 13940000 /* BYPASS PRECEDING BLANKS @46*/ 13950000 /*******************************************************************/ 13960000 13970000 DO WHILE (SUBSTR(PARMS,PARMOFF,ONE) = BLANK) ; /*@46*/ 13980000 PARMOFF = PARMOFF + ONE ; /*@46*/ 13990000 END ; /*@46*/ 14000000 14010000 /*******************************************************************/ 14020000 /* TRACK PARAMETER LENGTH UP TO THE MAXIMUM LENGTH OR UNTIL A @46*/ 14030000 /* BLANK IS ENCOUNTERED @46*/ 14040000 /*******************************************************************/ 14050000 14060000 DO I = PARMOFF TO PARMLEN /* IF NOT A BLANK THEN @46*/ 14070000 WHILE (PARMCNT <= PARMMAX & SUBSTR(PARMS,I,ONE) ¬= BLANK) ; /*@46*/ 14080000 PARMCNT = PARMCNT + 1; /* INCREASE COUNTER BY 1 @46*/ 14090000 END; /* END DO I @46*/ 14100000 14110000 PARM1 = SUBSTR(PARMS,PARMOFF,PARMCNT); /*SET PARAMETER NUMBER 1 @46*/ 14120000 14130000 PARMOFF = I; /* SET OFFSET FOR NEXT STRING @46*/ 14140000 14150000 /*******************************************************************/ 14160000 /* BYPASS PRECEDING BLANKS PRIOR TO SECOND STRING @46*/ 14170000 /*******************************************************************/ 14180000 14190000 IF I <= PARMLEN THEN /*@46*/ 14200000 DO; /*@46*/ 14210000 DO WHILE (SUBSTR(PARMS,PARMOFF,ONE) = BLANK) ; /*@46*/ 14220000 PARMOFF = PARMOFF + ONE ; /*@46*/ 14230000 END ; /* END DO WHILE @46*/ 14240000 END; /* END IF I <= PARMLEN @46*/ 14250000 14260000 PARMCNT = 0; /* INITIALIZE PARM2 COUNT @46*/ 14270000 14280000 /*******************************************************************/ 14290000 /* TRACK PARAMETER LENGTH UP TO THE MAXIMUM LENGTH OR UNTIL A @46*/ 14300000 /* BLANK IS ENCOUNTERED @46*/ 14310000 /*******************************************************************/ 14320000 14330000 IF I <= PARMLEN THEN /* MORE CHARS TO READ? @46*/ 14340000 DO; /*@46*/ 14350000 DO I = PARMOFF TO PARMLEN /* YES, CONTINUE READING @46*/ 14360000 WHILE (PARMCNT <= PARMMAX & SUBSTR(PARMS,I,ONE) ¬= BLANK); /*@46*/ 14370000 PARMCNT = PARMCNT + 1; /* INCREASE COUNTER BY 1 @46*/ 14380000 END; /* END DO I = PARMOFF @46*/ 14390000 IF PARMCNT > 0 THEN /* NON-BLANK CHAR FOUND? @46*/ 14400000 DO; /*@46*/ 14410000 PARM2 = SUBSTR(PARMS,PARMOFF,PARMCNT); /*YES, SET PARM 2 @46*/ 14420000 END; /* END IF PARMCNT > 0 @46*/ 14430000 END; /* END IF I <= PARMLEN @46*/ 14440000 ELSE /*@46*/ 14450000 DO; /* NO MORE CHARS TO READ @46*/ 14460000 PARM2 = BLANK; /* PARAMETER 2 IS EMPTY @46*/ 14470000 END; /* END ELSE DO @46*/ 14480000 14490000 /*******************************************************************/ 14500000 /* BYPASS PRECEDING BLANKS PRIOR TO THIRD STRING */ 14510000 /*******************************************************************/ 14520000 PARMOFF = I; 14530000 IF I <= PARMLEN THEN 14540000 DO; 14550000 DO WHILE (SUBSTR(PARMS,PARMOFF,ONE) = BLANK) ; 14560000 PARMOFF = PARMOFF + ONE ; 14570000 END ; /* END DO WHILE */ 14580000 END; /* END IF I <= PARMLEN */ 14590000 14600000 PARMCNT = 0; /* INITIALIZE PARM3 COUNT */ 14610000 14620000 /*******************************************************************/ 14630000 /* TRACK PARAMETER LENGTH UP TO THE MAXIMUM LENGTH OR UNTIL A */ 14640000 /* BLANK IS ENCOUNTERED */ 14650000 /*******************************************************************/ 14660000 14670000 IF I <= PARMLEN THEN /* MORE CHARS TO READ? */ 14680000 DO; 14690000 DO I = PARMOFF TO PARMLEN /* YES, CONTINUE READING */ 14700000 WHILE (PARMCNT <= PARMMAX & SUBSTR(PARMS,I,ONE) ¬= BLANK); 14710000 PARMCNT = PARMCNT + 1; /* INCREASE COUNTER BY 1 */ 14720000 END; /* END DO I = PARMOFF */ 14730000 IF PARMCNT > 0 THEN /* NON-BLANK CHAR FOUND? */ 14740000 DO; 14750000 PARM3 = SUBSTR(PARMS,PARMOFF,PARMCNT); /*YES, SET PARM 3 */ 14760000 END; /* END IF PARMCNT > 0 */ 14770000 END; /* END IF I <= PARMLEN */ 14780000 ELSE 14790000 DO; /* NO MORE CHARS TO READ */ 14800000 PARM3 = BLANK; /* PARAMETER 3 IS EMPTY */ 14810000 END; /* END ELSE DO */ 14820000 14830000 /*******************************************************************/ 14840000 /* SET PARAMETER FLAGS @46*/ 14850000 /*******************************************************************/ 14860000 14870000 SELECT (PARM1); /* @46*/ 14880000 WHEN ('ALIGN(MID)') /*IF PARM 1 = ALIGN(MID) THEN @46*/ 14890000 DO; /* @46*/ 14900000 ALIGNLHS = NO; /* SET ALIGNMENT TO CENTER @46*/ 14910000 END; /* @46*/ 14920000 14930000 WHEN ('ALIGN(LHS)') /*IF PARM 1 = ALIGN(LHS) THEN @46*/ 14940000 DO; /* @46*/ 14950000 ALIGNLHS = YES; /* SET ALIGNMENT TO LEFT @46*/ 14960000 END; /* @46*/ 14970000 14980000 WHEN ('NOMIXED') /* IF PARM 1 = NOMIXED THEN @46*/ 14990000 DO; /* @46*/ 15000000 MIXEDFLG = NO; /* ASSUME ALL SBCS CHARACTERS @46*/ 15010000 END; /* @46*/ 15020000 15030000 WHEN ('MIXED') /* IF PARM 1 = MIXED THEN @46*/ 15040000 DO; /* @46*/ 15050000 MIXEDFLG = YES; /* RECOGNIZE MIXED CHAR DATA @46*/ 15060000 END; /* @46*/ 15070000 15080000 WHEN ('TOLWARN(YES)') 15080900 DO; 15081800 TOLWARN = YES; 15082700 END; 15083600 15084500 WHEN ('TOLWARN(NO)') 15085400 DO; 15086300 TOLWARN = NO; 15087200 END; 15088100 15089000 OTHERWISE /* @46*/ 15090000 IF SUBSTR( PARM1,1,8 ) /* IF PARM 1 CONTAINS THE */ 15100000 = 'SQLTERM(' THEN /* TERMINATING CHAR FOR SQL STMTS */ 15110000 CALL SET_SQLTERM(PARM1);/* ..EXTRACT THAT CHARACTER */ 15120000 ELSE IF PARM1 ¬= BLANK THEN /* PARM 1 = BLANK? @46*/ 15130000 DO; /* NO, THEN ERROR @46*/ 15140000 PUT EDIT ('DSNT499I ERROR IN INPUT PARAMETER LIST')/*@46*/ 15150000 ( COL(2), A(39) ); /* PRINT ERROR MESSAGE @46*/ 15160000 RETCODE = RETERR; /* SET ERROR RETURN CODE @46*/ 15170000 GOTO STOPRUN; /* END PROGRAM @46*/ 15180000 END; /* END ERROR STATEMENT @46*/ 15190000 END; /* END SELECT PARM1 @46*/ 15200000 15210000 SELECT (PARM2); /* @46*/ 15220000 WHEN ('ALIGN(MID)') /*IF PARM 2 = ALIGN(MID) THEN @46*/ 15230000 DO; /* @46*/ 15240000 ALIGNLHS = NO; /* SET ALIGNMENT TO CENTER @46*/ 15250000 END; /* @46*/ 15260000 15270000 WHEN ('ALIGN(LHS)') /*IF PARM 2 = ALIGN(LHS) THEN @46*/ 15280000 DO; /* @46*/ 15290000 ALIGNLHS = YES; /* SET ALIGNMENT TO LEFT @46*/ 15300000 END; /* @46*/ 15310000 15320000 WHEN ('NOMIXED') /* IF PARM 2 = NOMIXED THEN @46*/ 15330000 DO; /* @46*/ 15340000 MIXEDFLG = NO; /* ASSUME ALL SBCS CHARACTERS @46*/ 15350000 END; /* @46*/ 15360000 15370000 WHEN ('MIXED') /* IF PARM 2 = MIXED THEN @46*/ 15380000 DO; /* @46*/ 15390000 MIXEDFLG = YES; /* RECOGNIZE MIXED CHAR DATA @46*/ 15400000 END; /* @46*/ 15410000 15410900 WHEN ('TOLWARN(YES)') 15411800 DO; 15412700 TOLWARN = YES; 15413600 END; 15414500 15415400 WHEN ('TOLWARN(NO)') 15416300 DO; 15417200 TOLWARN = NO; 15418100 END; 15419000 15420000 OTHERWISE /* @46*/ 15430000 IF SUBSTR( PARM2,1,8 ) /* IF PARM 2 CONTAINS THE */ 15440000 = 'SQLTERM(' THEN /* TERMINATING CHAR FOR SQL STMTS */ 15450000 CALL SET_SQLTERM(PARM2);/* ..EXTRACT THAT CHARACTER */ 15460000 ELSE IF PARM2 ¬= BLANK THEN /* PARM 2 = BLANK? @46*/ 15470000 DO; /* NO, THEN ERROR @46*/ 15480000 PUT EDIT ('DSNT499I ERROR IN INPUT PARAMETER LIST')/*@46*/ 15490000 ( COL(2), A(39) ); /* PRINT ERROR MESSAGE @46*/ 15500000 RETCODE = RETERR; /* SET ERROR RETURN CODE @46*/ 15510000 GOTO STOPRUN; /* END PROGRAM @46*/ 15520000 END; /* END ERROR STATEMENT @46*/ 15530000 END; /* END SELECT PARM2 @46*/ 15540000 15550000 SELECT (PARM3); /* */ 15560000 WHEN ('ALIGN(MID)') /*IF PARM 3 = ALIGN(MID) THEN */ 15570000 DO; /* */ 15580000 ALIGNLHS = NO; /* SET ALIGNMENT TO CENTER */ 15590000 END; /* */ 15600000 15610000 WHEN ('ALIGN(LHS)') /*IF PARM 3 = ALIGN(LHS) THEN */ 15620000 DO; /* */ 15630000 ALIGNLHS = YES; /* SET ALIGNMENT TO LEFT */ 15640000 END; /* */ 15650000 15660000 WHEN ('NOMIXED') /* IF PARM 3 = NOMIXED THEN */ 15670000 DO; /* */ 15680000 MIXEDFLG = NO; /* ASSUME ALL SBCS CHARACTERS */ 15690000 END; /* */ 15700000 15710000 WHEN ('MIXED') /* IF PARM 3 = MIXED THEN */ 15720000 DO; /* */ 15730000 MIXEDFLG = YES; /* RECOGNIZE MIXED CHAR DATA */ 15740000 END; /* */ 15750000 15750900 WHEN ('TOLWARN(YES)') 15751800 DO; 15752700 TOLWARN = YES; 15753600 END; 15754500 15755400 WHEN ('TOLWARN(NO)') 15756300 DO; 15757200 TOLWARN = NO; 15758100 END; 15759000 15760000 OTHERWISE /* */ 15770000 IF SUBSTR( PARM3,1,8 ) /* IF PARM 3 CONTAINS THE */ 15780000 = 'SQLTERM(' THEN /* TERMINATING CHAR FOR SQL STMTS */ 15790000 CALL SET_SQLTERM(PARM3);/* ..EXTRACT THAT CHARACTER */ 15800000 ELSE IF PARM3 ¬= BLANK THEN /* PARM 3 = BLANK? */ 15810000 DO; /* NO, THEN ERROR */ 15820000 PUT EDIT ('DSNT499I ERROR IN INPUT PARAMETER LIST') 15830000 ( COL(2), A(39) ); /* PRINT ERROR MESSAGE */ 15840000 RETCODE = RETERR; /* SET ERROR RETURN CODE */ 15850000 GOTO STOPRUN; /* END PROGRAM */ 15860000 END; /* END ERROR STATEMENT */ 15870000 END; /* END SELECT PARM3 */ 15880000 15890000 /*******************************************************************/ 15900000 /* ALLOCATE THE SQLDA AREA @46*/ 15910000 /*******************************************************************/ 15920000 15930000 CALL ALLOCTE; /* ALLOCATE THE SQLDA AREA */ 15940000 15950000 IF ALLOCRC > 0 THEN GOTO ENDPGM; /* CHECK ALLOCTE RET CODE VAL @87*/ 15960000 15970000 SQLN = MAXNCOLS; /* ESTIMATED # COLUMNS IN TABLE */ 15980000 SQLDABC = LEN_SQLDA + SQLN * LEN_SQLVAR; /* ALLOCATED SQLDA LGTH */ 15990000 16000000 /*******************************************************************/ 16010000 /* INPUT PROCESSING INITIALIZATION */ 16020000 /*******************************************************************/ 16030000 16040000 EXIT = NO; /* DON'T EXIT-CONTINUE PROCESSING */ 16050000 EODIN = NO; /* NOT AT THE END OF INPUT DATA */ 16060000 INPUT = NULLCHAR; /* NULL THE INPUT DATA ARRAY */ 16070000 INCOL = INPUTL+ONE; /* SET COLUMN TO 73 TO INDICATE A */ 16080000 /* NEW LINE IS TO BE READ IN */ 16090000 /* READRTN */ 16100000 16100400 ZERO THEN /* IF SETUPRC > 0 THEN AN ERROR */ 17060000 GOTO ENDDO; /* HAS OCCURRED. STOP PROCESSING */ 17070000 /* CURRENT STMT. READ NEXT STMT. */ 17080000 17090000 /*******************************************************************/ 17100000 /* SET UP A CURSOR TO FETCH THE ROWS FOR THE SELECT EXPRESSION */ 17110000 /*******************************************************************/ 17120000 EXEC SQL WHENEVER SQLWARNING CONTINUE; 17130000 FUNCTION = 'OPEN '; 17140000 EXEC SQL OPEN C1; /* OPEN CURSOR C1 */ 17150000 /* TOLERATE SQLCODE +595 */ 17151000 17152000 IF SQLCODE ¬= 0 & SQLCODE ¬= 595 & TOLWARN = NO THEN DO; 17152300 GOTO HANDLWRN; 17153000 END; 17154000 IF SQLCODE > 0 & TOLWARN = YES THEN 17154600 DO; 17155200 PUT EDIT ('SQLWARNING ON ', COMMAND, ' COMMAND, ', 17155800 FUNCTION, ' FUNCTION ') 17156400 ( COL(1), A(14), A(9), A(10), A(9), A(10) ); 17157000 CALL PRINTCA; 17157600 END; 17158200 17160000 BEGFETCH: 17170000 FUNCTION = 'FETCH '; 17180000 EXEC SQL WHENEVER SQLWARNING CONTINUE; 17190000 17200000 /*******************************************************************/ 17210000 /* FETCH ALL ROWS THAT FULFILL THE SELECT EXPRESSION. THE END OF */ 17220000 /* DATA AND SQL ERRORS ARE DENOTED BY A NON ZERO SQLCODE. */ 17230000 /*******************************************************************/ 17240000 17250000 DO WHILE( ( SQLCODE = ZERO /* FETCH while no errors*/ 17260000 | SQLCODE = TRUNCWRN /* or truncation only */ 17272990 | SQLCODE = 595 17273000 | (SQLCODE = ARITHWRN & TOLARTHWRN = YES) 17275980 | (SQLCODE > 0 & TOLWARN = YES)) 17276980 & ( ROWS_FETCH = -1 /* and unresticted limit*/ 17280000 | ROWS_FETCH > RECNT ) ); /* or still under limit */ 17290000 EXEC SQL FETCH C1 USING DESCRIPTOR :SQLDA; /* GET DATA */ 17300000 RECNT = RECNT+ONE; /* COUNT THE # OF RECORDS FETCHED */ 17310000 IF SQLWARN0 ¬= ' ' /* IF WE GET A WARNING */ 17320000 | ( SQLWARN0 = ' ' /* ... OR WE DIDN'T GET A WARNING */ 17330000 & SQLCODE > 0 /* ... BUT SQLCODE IS POSITIVE*/ 17340000 & SQLCODE ¬= 100 ) /* ... AND NOT AT END OF DATA */ 17350000 THEN /* SAY SO */ 17360000 DO; /* KEF0059 */ 17370000 PUT EDIT ('SQLWARNING ON ', COMMAND, ' COMMAND, ', 17380000 FUNCTION, ' FUNCTION ') 17390000 ( COL(1), A(14), A(9), A(10), A(9), A(10) ); 17400000 WRNING = YES; /* INDICATE SQLCA IS BEING PRINTED */ 17410000 /* ...BECAUSE A WARNING OCCURRED. */ 17420000 CALL PRINTCA; /* PRINT OUT THE SQLCA */ 17430000 WRNING = NO; /* FINISHED PRINTING SQLCA FOR WRNG*/ 17440000 IF RETCODE < RETWARN THEN /* SAVE THE LARGEST RETURN */ 17450000 RETCODE = RETWARN; /* ... CODE. */ 17460000 ERR = RETWARN; /* SAVE THE CURRENT ERROR */ 17470000 END; /* END KEF0059 */ 17480000 IF( ROWS_OUT = -1 /* If output count is unrestricted */ 17490000 | ROWS_OUT >= RECNT ) THEN /* or <= actual output */ 17500000 CALL CONROW; /* CONVERT FETCHED RECORD INTO */ 17510000 /* CHAR FORMAT AND PLACE IN THE */ 17520000 /* THE BUFFER, OUTBUF */ 17530000 17540000 /*******************************************************************/ 17550000 /* IF A PAGE FULL OF INFORMATION HAS BEEN COLLECTED THEN PRINT OUT */ 17560000 /* THE INFORMATION. RESET THE NECESSARY VARIABLES. */ 17570000 /*******************************************************************/ 17580000 17590000 IF LASTROW+LCT >= MAXPAGLN THEN /* @PL56283 */ 17600000 DO; /* LASTROW + LCT = MAXPAGLN */ 17610000 CALL SELRES; /* PRINT OUT INFORMATION */ 17620000 LASTROW = HEADEND; /* RESET LINE COUNTER */ 17630000 BEGREC = RECNT + ONE; /* UPDATE BEGINNING ROW NUMBER */ 17640000 LCT = ONE; /* RESET PAGE LINE COUNT TO */ 17650000 /* INCLUDE PAGE NUMBER ONLY */ 17660000 END; /* END LASTROW + LCT = MAXPAGLN */ 17670000 END; /* END DO UNTIL */ 17680000 END; /* END WHEN SQLD <= SQLN */ 17690000 17700000 %PAGE; 17710000 17720000 /*******************************************************************/ 17730000 /* INPUT STATEMENT IS A SELECT. IT WAS NOT DESCRIBED BECAUSE THE */ 17740000 /* SQLDA IS TOO SMALL. ALLOCATE A LARGER SQLDA AND PROCESS THE */ 17750000 /* STATEMENT. */ 17760000 /*******************************************************************/ 17770000 17780000 OTHERWISE 17790000 DO; /* SQLD > SQLN */ 17800000 $TRACE ('SQLDA TOO SMALL, GET BIGGER ONE. SQLD > SQLN'); 17810000 CALL ALLOCTE; /* ALLOCATE A LARGER SQL BUFFER */ 17820000 IF ALLOCRC > 0 THEN /* IF ALLOCATION FAILED, STOP @87*/ 17830000 LEAVE PRC; /* PROCESSING THE STATEMENT */ 17840000 SQLDABC= BUFFSIZE; /* SPECIFY SQLDA BUFFER SIZE */ 17850000 17860000 /*******************************************************************/ 17870000 /* CALCULATE THE MAXIMUM NUMBER OF COLUMNS THAT CAN BE PUT INTO */ 17880000 /* THE LARGER SQLDA BUFFER. */ 17890000 /*******************************************************************/ 17900000 17910000 MAXNCOLS = (SQLDABC - LEN_SQLDA) / LEN_SQLVAR; 17920000 SQLN = MAXNCOLS; 17930000 17940000 /*******************************************************************/ 17950000 /* DESCRIBE THE STATEMENT WITH THE NEW VALUES IN THE PARAMETERS */ 17960000 /* THAT WERE CALCULATED USING THE LARGER SQLDA BUFFER */ 17970000 /*******************************************************************/ 17980000 17990000 $TRACE ('CALL DESC') DATA(MAXNCOLS,SQLN,SQLD,SQLDABC) 18000000 PUTTYPE(LIST); 18010000 FUNCTION = 'DESCRIBE'; 18020000 EXEC SQL DESCRIBE STATEMENT INTO :SQLDA; 18030000 $TRACE ('AFTER DESCRIBE') DATA(SQLN,SQLD) 18040000 PUTTYPE(LIST); 18050000 GOTO BEGSELECT; /* TRY PROCESSING STATEMENT AGAIN */ 18060000 END; /* END OTHERWISE (SQLD > SQLN) */ 18070000 18080000 END; /* END SELECT */ 18090000 18100000 IF( ROWS_FETCH ¬= -1 /* If rows fetched restricted */ 18110000 & ROWS_FETCH >= RECNT ) THEN /* and restriction exceeded */ 18120000 DO; 18130000 GOTO ENDDATA; /* .. print out rows fetched */ 18140000 END; 18150000 IF (SQLCODE = ARITHWRN & TOLARTHWRN = NO & TOLWARN = NO) THEN 18162990 /* HANDLING THE ARITHMETIC */ 18165980 DO; /* WARNING SQLCODE */ 18170000 GOTO HANDLWRN; 18180000 END; 18190000 ELSE /* END PROCESSING OF THE INPUT */ 18200000 DO; /* STATEMENT */ 18210000 GOTO ENDDO; 18220000 END; 18230000 18240000 %PAGE; 18250000 18260000 /*******************************************************************/ 18270000 /* SQL ERROR HANDLING ROUTINE */ 18280000 /*******************************************************************/ 18290000 18300000 HANDLERR: 18310000 18320000 IF( SQLCODE = -905 /* If query cancelled by RLF */ 18330000 & FUNCTION = 'FETCH' /* during a FETCH */ 18340000 & BEGREC <= RECNT ) THEN /* and rows are waiting for output*/ 18350000 DO; /* ..before printing error message*/ 18360000 CALL SELRES; /* ..print the waiting rows */ 18370000 PUT SKIP(2) EDIT( 'PRECEDING QUERY WAS CANCELLED BY RLF AFTER ' 18380000 || 'SUCCESSFUL RETRIEVAL OF ',RECNT,' ROW(S)') 18390000 ( COL(1), A(67), F(8), A(7)); 18400000 PUT EDIT ('SQLERROR ON ', COMMAND, ' COMMAND, ', FUNCTION, 18410000 ' FUNCTION ') ( COL(1), A(14), A(9), A(10), A(9), A(10) ); 18420000 FUNCTION = 'CLOSE C1'; /* ..and clean up for next query */ 18430000 END; 18440000 ELSE /* Otherwise, print error messages*/ 18450000 DO; /* ..and then output waiting rows */ 18460000 PUT EDIT ('SQLERROR ON ', COMMAND, ' COMMAND, ', FUNCTION, 18470000 ' FUNCTION ') ( COL(1), A(14), A(9), A(10), A(9), A(10) ); 18480000 END; 18490000 18500000 18510000 CALL PRINTCA; /* PRINT OUT THE SQLCA */ 18520000 18530000 /*******************************************************************/ 18540000 /* COMPARE THE CURRENT RETURN CODE WITH THE PREVIOUS RETURN CODE. */ 18550000 /* SAVE THE LARGEST RETURN CODE. */ 18560000 /*******************************************************************/ 18570000 18580000 IF RETCODE < RETERR THEN 18590000 RETCODE = RETERR; 18600000 ERR = RETERR; /* SAVE THE CURRENT ERROR */ 18610000 GOTO ENDDATA; /* SKIP PAST OTHER ERROR PRINTING */ 18620000 18630000 /*******************************************************************/ 18640000 /* SQL ERROR HANDLING ROUTINE FOR CONNECTION PROBLEMS */ 18650000 /* (CONNECT, SET CONNECTION, OR RELEASE). */ 18660000 /* TERMINATE DSNTEP2 AFTER A CONNECTION FAILURE. */ 18670000 /*******************************************************************/ 18680000 18690000 HNDLCONN: 18700000 18710000 PUT EDIT ('SQLERROR ON CONNECT, SET CONNECTION, OR RELEASE. ', 18720000 'SSMTEP2 WILL TERMINATE.') 18730000 ( COL(1), A(49), A(23) ); 18740000 18750000 CALL PRINTCA; /* PRINT OUT THE SQLCA */ 18760000 IF RETCODE < RETERR THEN /* SET AN ERROR RETURN CODE */ 18770000 RETCODE = RETERR; 18780000 GOTO STOPRUN; 18790000 18800000 /*******************************************************************/ 18810000 /* SQL WARNING HANDLING ROUTINE */ 18820000 /*******************************************************************/ 18830000 18840000 HANDLWRN: 18850000 18860000 IF FUNCTION = 'PREPARE ' /* If the -only- SQL warning @31*/ 18870000 & SQLWARN1 = ' ' /* flag raised at PREPARE @31*/ 18880000 & SQLWARN2 = ' ' /* time is SQLWARN4 (UPDATE @31*/ 18890000 & SQLWARN3 = ' ' /* or DELETE stmt does not @31*/ 18900000 & SQLWARN5 = ' ' /* include a WHERE clause) @31*/ 18910000 & SQLWARN4 ¬= ' ' /* then suppress the warning @31*/ 18920000 & SQLWARN6 = ' ' /* message and continue @31*/ 18930000 & SQLWARN7 = ' ' /* processing ... @31*/ 18940000 & SQLWARN8 = ' ' /* @31*/ 18950000 & SQLWARN9 = ' ' /* @31*/ 18960000 & SQLWARNA = ' ' THEN /* @31*/ 18970000 GOTO BEGDESCRIBE; /* @31*/ 18980000 18990000 19000000 PUT EDIT ('SQLWARNING ON ', COMMAND, ' COMMAND, ', FUNCTION, 19010000 ' FUNCTION ') ( COL(1), A(14), A(9), A(10), A(9), A(10) ); 19020000 IF FUNCTION ¬= 'PREPARE ' THEN 19030000 DO; 19040000 WRNING = YES; /* INDICATE SQLCA IS BEING PRINTED*/ 19050000 /* BECAUSE A WARNING OCCURRED */ 19060000 CALL PRINTCA; /* PRINT OUT THE SQLCA */ 19070000 WRNING = NO; /* FINISHED PRINTING SQLCA FOR WRN*/ 19080000 END; 19090000 ELSE IF SQLCODE = 098 THEN /* UNEXPECTED SEMICOLON FOUND */ 19100000 DO; /* - INDICATES MORE THAN ONE STMT */ 19110000 WRNING = YES; /* INDICATE SQLCA IS BEING PRINTED*/ 19120000 CALL PRINTCA; /* PRINT OUT THE SQLCA */ 19130000 WRNING = NO; /* FINISHED PRINTING SQLCA FOR WRN*/ 19140000 IF RETCODE < RETERR THEN /* WAS PASSED TO PREPARE WHICH */ 19150000 RETCODE = RETERR; /* MEANS WE'RE OUT OF CONTROL! */ 19160000 ERR = RETERR; /* SAVE THE CURRENT ERROR */ 19170000 GOTO STOPRUN; /* STOP RUN */ 19180000 END; 19190000 ELSE IF SQLCODE = 394 /* IF OPT HINT SPEC'D AND USED @78*/ 19190990 | SQLCODE = 395 THEN /* OR SPEC'D BUT IGNORED @78*/ 19191980 DO; /* @78*/ 19192970 WRNING = YES; /* INDIC SQLCA IS BEING PRINTED@78*/ 19193960 CALL PRINTCA; /* PRINT OUT THE SQLCA @78*/ 19194950 WRNING = NO; /* FINISHED PRINTING SQLCA @78*/ 19195940 END; /* @78*/ 19196930 19200000 /*******************************************************************/ 19210000 /* COMPARE THE CURRENT RETURN CODE WITH THE PREVIOUS RETURN CODE. */ 19220000 /* SAVE THE LARGEST RETURN CODE. */ 19230000 /*******************************************************************/ 19240000 19250000 IF RETCODE < RETWARN THEN 19260000 RETCODE = RETWARN; 19270000 19280000 ERR = RETWARN; /* SAVE THE CURRENT ERROR */ 19290000 19300000 /******************************************************************* 19310000 * If warning occurred on OPEN, proceed to FETCH * 19320000 *******************************************************************/ 19330000 IF FUNCTION = 'OPEN' THEN 19340000 GOTO BEGFETCH; 19350000 19360000 /*******************************************************************/ 19370000 /* END OF DATA PROCESSING */ 19380000 /*******************************************************************/ 19390000 19400000 ENDDATA: 19410000 19420000 SELECT(FUNCTION); 19430000 WHEN ('OPEN ') /* OPEN */ 19440000 DO; 19450000 IF ERR <= RETWARN THEN /* ERR <= RETWARN */ 19460000 DO; 19470000 PUT SKIP(2) EDIT (' "NOT FOUND" CONDITION', 19480000 ' ENCOUNTERED DURING OPEN.') 19490000 ( COL(1), A(22),A(26)); 19500000 FUNCTION = 'CLOSE C1'; 19510000 GOTO ENDDATA; 19520000 END; /* END ERR <= RETWARN */ 19530000 END; /* END WHEN OPEN */ 19540000 19550000 WHEN('FETCH ') 19560000 DO; /* FETCH */ 19570000 IF BEGREC <= RECNT THEN 19580000 CALL SELRES; /* PRINT THE RESULTS OF THE FETCH */ 19590000 PUT SKIP(2) EDIT ( 'SUCCESSFUL RETRIEVAL OF ',RECNT,' ROW(S)') 19600000 ( COL(1), A(24), F(8), A(7)); 19610000 FUNCTION = 'CLOSE C1'; 19620000 GOTO ENDDATA; 19630000 END; /* END WHEN FETCH */ 19640000 19650000 WHEN('CLOSE C1') 19660000 DO; /* CLOSE THE CURSOR */ 19670000 FUNCTION = 'CLOSN C1'; 19680000 EXEC SQL CLOSE C1; 19690000 END; /* END WHEN CLOSE */ 19700000 19710000 WHEN('PREPARE ') 19720000 DO; /* PREPARE */ 19730000 IF ERR <= RETWARN THEN /* IF ONLY A WARNING ON PREPARE, */ 19740000 GOTO BEGDESCRIBE; /* DESCRIBE THE STATEMENT */ 19750000 END; /* END PREPARE */ 19760000 19770000 WHEN('DESCRIBE') 19780000 DO; /* DESCRIBE */ 19790000 IF ERR <= RETWARN THEN /* IF ONLY A WARNING ON DESCRIBE, */ 19800000 GOTO BEGSELECT; /* CONTINUE TO PROCESS THE STMT */ 19810000 END; /* END DESCRIBE */ 19820000 19830000 WHEN('CLOSN C1'); /* THIS IS A DUMMY WHEN TO TAKE */ 19840000 /* CARE OF THE SITUATION WHERE A */ 19850000 /* CURSOR IS CLOSED TWICE. */ 19860000 19870000 OTHERWISE /* WARNING ON EXECUTE */ 19880000 DO; /* OTHERWISE */ 19890000 IF SQLCODE = ZERO | SQLCODE = 100 THEN 19900000 CALL PRINTCA; 19910000 END; /* END OTHERWISE */ 19920000 END; /* END SELECT */ 19930000 ENDDO: 19940000 19950000 FIRSTPAGE = YES; /* RESET FIRSTPAGE TO YES @33 */ 19960000 19970000 CALL READRTN; /* READ NEXT STATEMENT */ 19980000 19990000 END; /* END PRC */ 20000000 20010000 ENDPGM: 20020000 20030000 $TRACE ('SSMTEP2 OUT') DATA(RETCODE); 20040000 CALL PLIRETC(RETCODE); 20050000 RETURN; 20060000 20070000 %PAGE; 20080000 20090000 /********************************************************************* 20100000 * This procedure parses the SQLTERM input parameter to locate the * 20110000 * user-specified character that is used to terminate SQL statements * 20120000 * being processed by DSNTEP2. * 20130000 *********************************************************************/ 20140000 SET_SQLTERM: PROC( SQLTERM_PARM ); 20150000 20160000 DCL SQLTERM_PARM CHAR( 11 ); 20170000 20180000 /******************************************************************* 20190000 * It's already established that the first 8 bytes are SQLTERM( so * 20200000 * the next byte is the actual terminating character * 20210000 *******************************************************************/ 20220000 SQLTERM = SUBSTR( SQLTERM_PARM,9,1 ); 20230000 /******************************************************************* 20240000 * Now verify that the terminating character is valid * 20250000 *******************************************************************/ 20260000 SELECT( SQLTERM ); 20270000 WHEN( ' ', ',', '''', '"', '_', '(', ')' ) 20280000 DO; 20290000 PUT EDIT ('DSNT499I ERROR IN INPUT PARAMETER LIST') 20300000 ( COL(2), A(39) ); /* PRINT ERROR MESSAGE */ 20310000 RETCODE = RETERR; /* SET ERROR RETURN CODE */ 20320000 GOTO STOPRUN; /* END PROGRAM */ 20330000 END; 20340000 OTHERWISE; 20350000 END; /* SELECT */ 20360000 /******************************************************************* 20370000 * And verify that the last byte of the parameter is a closing paren* 20380000 *******************************************************************/ 20390000 IF( SUBSTR( SQLTERM_PARM,10,1 ) ¬= ')' ) THEN 20400000 DO; 20410000 PUT EDIT ('DSNT499I ERROR IN INPUT PARAMETER LIST') 20420000 ( COL(2), A(39) ); /* PRINT ERROR MESSAGE */ 20430000 RETCODE = RETERR; /* SET ERROR RETURN CODE */ 20440000 GOTO STOPRUN; /* END PROGRAM */ 20450000 END; 20460000 20470000 END SET_SQLTERM; 20480000 20490000 %PAGE; 20500000 20510000 /*******************************************************************/ 20520000 /* THIS PROCEDURE READS THE DATA FROM THE USER AND OBTAINS A SQL */ 20530000 /* STATEMENT. IT CALLS PROCEDURE FINDCMD TO FIND THE BEGINNING OF */ 20540000 /* THE COMMAND. */ 20550000 /*******************************************************************/ 20560000 20570000 READRTN: PROCEDURE; 20580000 20590000 DCL 20600000 CONTLINE FIXED BIN(15) /* CONTINUATION LINE - INPUT STMT */ 20610000 INIT(0), /* IS MORE THAN 72 CHARACTERS */ 20620000 DQUOTFLAG BIT(1) /* DOUBLE QUOTE (") ENCOUNTERED? */ 20630000 INIT('0'B), 20640000 FIRSTCHAR BIT(1) /* FIRST NON BLANK CHAR? */ 20650000 INIT('0'B), 20660000 LASTCHAR CHAR(1) /* LAST CHARACTER IN THE BUFFER */ 20670000 INIT(' '), 20680000 MOVECHAR BIT(1) /* MOVE CHAR INTO STMT BUFFER? */ 20690000 INIT('0'B), 20700000 NBLK FIXED BIN(15) /* NUMBER OF BLANKS FOUND */ 20710000 INIT( 0 ), 20720000 NEWOFSET FIXED BIN(15) /* FIRST POSITION OF THE COMMAND */ 20730000 INIT( 0 ), /* IN THE STATEMENT BUFFER */ 20740000 QUOTEFLAG BIT(1) /* QUOTE (') ENCOUNTERED? */ 20750000 INIT('0'B), 20760000 SHIFTMODE CHAR(1) /* VALUE IS SO OR SI */ 20770000 INIT(' '), 20780000 SAVE_COMMAND CHAR(9) /* For preserving current COMMAND */ 20790000 INIT(' '), 20800000 SAVE_OFFSET FIXED BIN(15) /* For preserving current offset */ 20810000 INIT( 0 ); 20820000 20830000 /*******************************************************************/ 20840000 /* ENDFILE CONDITIONS */ 20850000 /*******************************************************************/ 20860000 20870000 ON ENDFILE(SYSIN) /* PROCESS EOF ON INPUT FILE */ 20880000 BEGIN; /* END OF FILE */ 20890000 IF LENGTH(STMTBUF) = 0 THEN 20900000 DO; /* LENGTH(STMTBUF) = 0 */ 20910000 EXIT = YES; /* NO STMT TO PROCESS, SO END PGM */ 20920000 GOTO ENDRD; 20930000 END; /* END LENGTH(STMTBUF) = 0 */ 20940000 ELSE /* PROCESS THE CURRENT STATEMENT */ 20950000 DO; /* LENGTH(STMTBUF) ¬= 0 */ 20960000 EODIN = YES; /* SIGNAL END_OF_DATA */ 20970000 ENDSTR = YES; /* SIGNAL END_OF_STRING */ 20980000 GOTO CHKCOMM; /* PROCESS CURRENT COMMAND */ 20990000 END; /* END LENGTH(STMTBUF) ¬= 0 */ 21000000 END; /* END END OF FILE */ 21010000 21020000 /*******************************************************************/ 21030000 /* BEGIN READRTN PROCESSING */ 21040000 /*******************************************************************/ 21050000 21060000 $TRACE ('READRTN IN'); 21070000 NEWSTMT= YES; /* NEW STMT IS BEING PROCESSED */ 21080000 PAGENO = ONE; /* INITIALIZE PAGE COUNT @33 */ 21090000 PRTPNO = YES; /* SELRES WILL PRINT THE PAGE # */ 21100000 21110000 %PAGE; 21120000 21130000 /*******************************************************************/ 21140000 /* READ IN SQL STATEMENT */ 21150000 /*******************************************************************/ 21160000 21170000 RD: 21180000 21190000 DO WHILE (NEWSTMT = YES); 21200000 $TRACE ('INPUT') DATA(EXIT,EODIN,ENDSTR); 21210000 21220000 /*****************************************************************/ 21230000 /* NO MORE INPUT DATA (EOF) SO RETURN TO CALLER */ 21240000 /*****************************************************************/ 21250000 21260000 IF EODIN = YES THEN 21270000 DO; /* END OF DATA */ 21280000 EXIT = YES; /* EXIT PROGRAM */ 21290000 LEAVE RD; /* LEAVE THE LOOP */ 21300000 END; /* END END OF DATA */ 21310000 21320000 /*****************************************************************/ 21330000 /* PROCESS THE STATEMENT */ 21340000 /*****************************************************************/ 21350000 21360000 ELSE 21370000 DO; 21380000 NEWSTMT = NO; 21390000 CONTLINE = ZERO; /* CLEAR MULTILINE STMT COUNTER */ 21400000 ENDSTR = NO; /* NOT AT THE END OF THE STRING */ 21410000 QUOTEFLAG = NO; /* INITIALIZE QUOTE FLAG */ 21420000 DQUOTFLAG = NO; /* INITIALIZE DOUBLE QUOTE FLAG */ 21430000 STMTLEN = ZERO; /* INITIALIZE THE STMT LENGTH */ 21440000 STMTBUF = NULLCHAR; /* INIT STMT BUFFER TO NULLS */ 21450000 LASTCHAR = NULLCHAR; /* INIT. LAST CHARACTER TO NULL */ 21460000 COMMAND = BLANK; /* INITIALIZE COMMAND VARIABLE */ 21470000 SHIFTMODE = SI; /* SHIFTMODE IS EBCDIC */ 21480000 IF COMMENT = NO THEN /* IF NO COMMENTS FOUND */ 21490000 LCT = ONE; /* INITIALIZE THE # LINES ON PG */ 21500000 IF COMMENT = NO THEN /* RESET COMMENTS ONLY FLAG IF */ 21510000 CMTONLY = NO; /* COMMENT FLAG IS OFF */ 21520000 COMMENT = NO; /* NO IMBEDDED COMMENTS FND YET */ 21530000 FIRSTCHAR = NO; /* INIT. FIRST CHAR TO NO */ 21540000 NBLK = ZERO; /* INIT. BLANK COUNT TO 0 */ 21550000 21560000 /*************************************************************/ 21570000 /* READ AND PROCESS A NEW STATEMENT */ 21580000 /*************************************************************/ 21590000 21600000 DO WHILE (ENDSTR = NO); /* PUT INPUT STMT IN STMT BUFFER */ 21610000 21620000 /***********************************************************/ 21630000 /* IF THE COLUMN BEING PROCESSED IS GREATER THAN THE */ 21640000 /* LENGTH OF THE INPUT LINE THEN READ THE NEXT LINE */ 21650000 /***********************************************************/ 21660000 21670000 IF INCOL > INPUTL THEN 21680000 DO; /* GET SYSIN DATA */ 21690000 ALLBLANK= NO; /* NO ALL BLANK LINES FND YET */ 21700000 GET EDIT (INPUT) (COL(1), (INPUTL) A(1)); /* @BA07832 */ 21710000 DO J = 1 TO INPUTL UNTIL(INPUT(J) ¬= BLANK); 21720000 END; 21730000 IF J > INPUTL THEN 21740000 /* ALL BLANK LINE */ 21750000 ALLBLANK = YES; 21760000 IF PRTPNO = YES THEN /* PRINT OUT THE PAGE # */ 21770000 DO; 21780000 PAGEBUF = 'PAGE ' || PAGENO; 21790000 PUT PAGE EDIT(PAGEBUF) (COL(1),A); 21800000 PAGENO = PAGENO + ONE; /* INCR PAGE NUMBER */ 21810000 PRTPNO = NO; 21820000 FIRSTPAGE = NO; 21830000 LCT = LCT + 1; 21840000 END; 21850000 IF ALLBLANK = NO THEN 21860000 PUT SKIP; /* SKIP TO NEXT LINE */ 21870000 /*******************************************************/ 21880000 /* IF THIS IS A NEW STATEMENT AND NOT A COMMENT, */ 21890000 /* AND NOT AN ALL-BLANK LINE, DISPLAY THE TITLE */ 21900000 /* 'INPUT STATEMENT'. */ 21910000 /*******************************************************/ 21920000 IF STMTLEN = 0 THEN /* FOR A NEW STATEMENT */ 21930000 DO; 21940000 IF INPUT(1) = ASTERISK THEN /* STAR IN COLUMN 1 */ 21950000 COMMENT = YES; /* INDICATES A COMMENT */ 21960000 ELSE 21970000 DO; 21980000 DO J = 1 TO INPUTL UNTIL(INPUT(J) ¬= BLANK); 21990000 END; 22000000 IF J < INPUTL THEN 22010000 IF INPUT(J) = HDASH & INPUT(J+1) = HDASH THEN 22020000 /* -- ALSO INDICATES */ 22030000 DO; 22040000 COMMENT = YES; /* A COMMENT */ 22050000 CALL PROCESS_FUNCTIONAL_COMMENT( INPUT, J ); 22060000 END; 22070000 END; 22080000 IF (COMMENT = NO) & (ALLBLANK = NO) THEN 22090000 DO; 22100000 PUT EDIT ('***INPUT STATEMENT: ') (COL(1), A); 22110000 LCT = LCT + 1; 22120000 END; 22130000 ELSE /* WAS A FULL LINE COMMENT */ 22140000 DO; 22150000 ENDSTR = YES; /* FINISHED A STMT */ 22160000 NEWSTMT = YES; /* NEED A NEW STMT */ 22170000 END; 22180000 END; 22190000 IF ALLBLANK = NO THEN 22200000 DO; 22210000 PUT EDIT (((INPUT(KK)) 22220000 DO KK = 1 TO INPUTL BY 1)) 22230000 (COL(1+KK),A(1)); 22240000 LCT = LCT + 1; /* INCREMENT LINE COUNT */ 22250000 END; 22260000 IF LCT > MAXPAGLN THEN /* PRINTED A PAGE? */ 22270000 DO; 22280000 PRTPNO = YES; /* NEED TO PAGE DOWN */ 22290000 LCT = 1; /* RESET THE LINE CTR */ 22300000 END; 22310000 INCOL = ONE; 22320000 IF FIRSTCHAR = YES THEN /* FIRST CHAR SET? */ 22330000 CONTLINE = CONTLINE + 1; /* INCREMENT INPUT LINE CTR */ 22340000 END; 22350000 22360000 /***********************************************************/ 22370000 /* PROCESS THE INPUT SQL STATEMENT */ 22380000 /***********************************************************/ 22390000 IF COMMENT = NO THEN /* IF THIS IS AN SQL STATEMENT */ 22400000 DO; 22410000 22420000 /*******************************************************/ 22430000 /* MOVE THE INPUT LINE INTO THE STATEMENT BUFFER */ 22440000 /*******************************************************/ 22450000 22460000 /*******************************************************/ 22470000 /* MOVE THE CHARACTER FROM THE INPUT DATA INTO THE */ 22480000 /* STATEMENT BUFFER UNTIL AN END OF LINE CHARACTER */ 22490000 /* OR SQL STATEMENT TERMINATOR IS ENCOUNTERED */ 22500000 /*******************************************************/ 22510000 22520000 DO J = INCOL TO INPUTL WHILE (¬ENDSTR); 22530000 22540000 MOVECHAR = YES; /* Reset valid character flag */ 22550000 /*****************************************************/ 22560000 /* PREPROCESS ANY SHIFT CHARACTERS. IF THE @46*/ 22570000 /* MIXED FLAG IS OFF, THEN THE SHIFTMODE @46*/ 22580000 /* IS ALWAYS SI. @46*/ 22590000 /*****************************************************/ 22600000 IF MIXEDFLG = YES THEN /* RECOGNIZE MIXED CHAR? @46*/ 22610000 DO; /* YES, READ SHIFT CHARS @46*/ 22620000 IF INPUT(J) = SO THEN /* CURRENT CHARACTER */ 22630000 DO; /* IS SHIFT-OUT '0E' */ 22640000 SHIFTMODE = SO; /* SET DBCS FLAG ON */ 22650000 IF J = 1 THEN /* CURRENT POSITION */ 22660000 DO; /* IS THE FIRST CHAR */ 22670000 /*********************************************/ 22680000 /* FILL THE STATEMENT BUFFER WITH EVERYTHING */ 22690000 /* UP TO THE LAST COLUMN OF THE PREVIOUS */ 22700000 /* LINE IF THE LAST CHARACTER IS SHIFT-IN */ 22710000 /* OR UP TO THE NEXT TO LAST COLUMN IF THE */ 22720000 /* LAST TWO CHARACTERS OF THE PREVIOUS LINE */ 22730000 /* ARE SHIFT-IN FOLLOWED BY A BLANK. */ 22740000 /*********************************************/ 22750000 STMTLEN = LENGTH(STMTBUF); 22760000 IF SUBSTR(STMTBUF,STMTLEN,ONE)=SI THEN 22770000 DO; 22780000 STMTBUF = SUBSTR(STMTBUF,ONE,STMTLEN-1); 22790000 END; 22800000 IF SUBSTR(STMTBUF,STMTLEN-1,TWO)=SI || 22810000 BLANK THEN 22820000 DO; 22830000 STMTBUF = SUBSTR(STMTBUF,ONE,STMTLEN-2); 22840000 END; 22850000 END; /* END IF J=1 */ 22860000 END; /* END INPUT(J) = SO */ 22870000 ELSE IF INPUT(J) = SI THEN /* CURRENT CHAR IS */ 22880000 DO; /* SHIFT-IN '0F' */ 22890000 SHIFTMODE = SI; /* SET EBCDIC FLAG ON */ 22900000 END; 22910000 END; /* END IF MIXEDFLG=YES @46*/ 22920000 22930000 /*****************************************************/ 22940000 /* PREPROCESS ANY DOUBLE QUOTATION MARKS ("). IF THE */ 22950000 /* DOUBLE QUOTATION MARK IS CONTAINED BETWEEN */ 22960000 /* QUOTATION MARKS ('), THE QUOTATION MARK IS */ 22970000 /* CONSIDERED TO BE THE STRING DELIMITER. THE */ 22980000 /* DQUOTFLAG WILL NOT BE SET. IN THIS CASE THE */ 22990000 /* DOUBLE QUOTATION MARK IS CONSIDERED TO BE PART OF */ 23000000 /* THE STRING */ 23010000 /*****************************************************/ 23020000 23030000 IF INPUT(J) = DQUOTE THEN 23040000 DO; /* INPUT(J)=DQUOTE */ 23050000 IF ¬QUOTEFLAG & /* NOT DELIMITED BY QUOTES */ 23060000 SHIFTMODE = SI THEN /* AND EBCDIC */ 23070000 DO; /* THEN DOUBLE QUOTES ARE */ 23080000 DQUOTFLAG = ¬DQUOTFLAG; /* THE DELIMITER */ 23090000 END; 23100000 END; /* END INPUT(J) = DQUOTE */ 23110000 23120000 /*****************************************************/ 23130000 /* PREPROCESS ANY QUOTATION MARKS ('). IF THE */ 23140000 /* QUOTATION MARK IS CONTAINED BETWEEN DOUBLE */ 23150000 /* QUOTATION MARKS ("), THE DOUBLE QUOTATION MARK IS */ 23160000 /* CONSIDERED TO BE THE STRING DELIMITER. THE */ 23170000 /* QUOTEFLAG WILL NOT BE SET. IN THIS CASE THE */ 23180000 /* QUOTATION MARK IS CONSIDERED TO BE PART OF THE */ 23190000 /* STRING. */ 23200000 /*****************************************************/ 23210000 23220000 IF INPUT(J) = QUOTE THEN 23230000 DO; /* INPUT(J) = QUOTE */ 23240000 IF ¬DQUOTFLAG & /* NOT DELIMITED BY */ 23250000 /* DOUBLE QUOTES AND */ 23260000 SHIFTMODE = SI THEN /* EBCDIC */ 23270000 DO; /* THEN QUOTE IS THE */ 23280000 QUOTEFLAG = ¬QUOTEFLAG; /* DELIMITER */ 23290000 END; 23300000 END; /* END INPUT(J) = QUOTE */ 23310000 23320000 /*****************************************************/ 23330000 /* PROCESS A HYPHEN IF FOUND. THE HYPHEN IS */ 23340000 /* CONSIDERED PART OF A STRING IF A DELIMITER FLAG */ 23350000 /* IS SET. IF THE FOLLOWING CHARACTER IS A HYPHEN, */ 23360000 /* MOVE THE REMAINING CHARACTERS TO THE STATEMENT */ 23370000 /* BUFFER. */ 23380000 /*****************************************************/ 23390000 23400000 IF (INPUT(J) = HYPHEN) & /*INPUT CHAR IS '-' */ 23410000 (J < INPUTL) & /* STILL MORE & */ 23420000 ¬QUOTEFLAG & /* NOT CURRENTLY IN */ 23430000 ¬DQUOTFLAG & /* DELIMITED STRING */ 23440000 SHIFTMODE = SI THEN /* AND EBCDIC */ 23450000 DO; /* LOOK FOR '--' */ 23460000 IF INPUT(J+1) = HYPHEN THEN 23470000 DO; 23480000 CALL PROCESS_FUNCTIONAL_COMMENT( INPUT, J ); 23490000 MOVECHAR = NO; /* FOUND '--' */ 23500000 INCOL = INPUTL + ONE; /* SET INDEX TO 73 */ 23510000 J = INPUTL + ONE; /* DISCARD REST OF LINE */ 23520000 END; 23530000 END; /* END LOOK FOR '--' */ 23540000 /*****************************************************/ 23550000 /* PROCESS THE END-OF-STRING IF THE SQL STATEMENT */ 23560000 /* TERMINATION CHARACTER IS FOUND IN EBCDIC MODE AND */ 23570000 /* OUTSIDE A DELIMITED STRING. THE ACCEPTABLE STRING*/ 23580000 /* DELIMITERS ARE SINGLE QUOTE AND DOUBLE QOTE MARKS.*/ 23590000 /*****************************************************/ 23600000 23610000 /*@42*/ 23620000 IF (INPUT(J) = SQLTERM) & ¬DQUOTFLAG & ¬QUOTEFLAG & 23630000 SHIFTMODE = SI THEN /* SQL TERM CHAR & NOT */ 23640000 ENDSTR = ¬ENDSTR; /* DELIMITED & DBCS FLAG OFF*/ 23650000 /* THEN SET END OF STRING */ 23660000 /*****************************************************/ 23670000 /* NOT THE END OF THE STRING, PROCESS THE STATEMENT */ 23680000 /*****************************************************/ 23690000 23700000 ELSE IF( MOVECHAR = YES ) THEN 23710000 DO; 23720000 23730000 /***************************************************/ 23740000 /* MOVE ALL NON BLANK CHARACTERS INTO THE SQL */ 23750000 /* STATEMENT BUFFER */ 23760000 /***************************************************/ 23770000 23780000 IF INPUT(J)¬= BLANK THEN 23790000 DO; 23800000 MOVECHAR = YES; 23810000 FIRSTCHAR = YES; 23820000 NBLK = ZERO; 23830000 END; 23840000 23850000 /***************************************************/ 23860000 /* A BLANK SHOULD BE MOVED IN THE FOLLOWING CASES: */ 23870000 /* */ 23880000 /* 1. IF THE BLANK IS IN A DELIMITED STRING */ 23890000 /* */ 23900000 /* 2. IF AN INPUT STATEMENT SPANS MORE THAN */ 23910000 /* ONE LINE AND THE PREVIOUS LINE HAD A */ 23920000 /* CHARACTER IN COLUMN 72 AND THE CURRENT */ 23930000 /* LINE HAS BLANKS BEFORE THE FIRST WORD */ 23940000 /***************************************************/ 23950000 23960000 ELSE /* BLANK CHARACTER FOUND */ 23970000 DO; 23980000 IF QUOTEFLAG | DQUOTFLAG | 23990000 SHIFTMODE = SO | /* DBCS FLAG ON */ 24000000 (CONTLINE >= 1 & J = 1 & NBLK = 0) THEN 24010000 DO; /* BLANK IS DELIMITED, MOVE */ 24020000 MOVECHAR = YES; /* IT INTO STMT BUFFER*/ 24030000 NBLK = NBLK + ONE; /* & INC BLANK COUNT */ 24040000 END; 24050000 ELSE /* BLANK NOT DELIMITED */ 24060000 DO; 24070000 NBLK = NBLK + ONE; /* INCREASE BLANK CTR */ 24080000 IF (NBLK = ONE) & (FIRSTCHAR = YES) THEN 24090000 MOVECHAR = YES; 24100000 ELSE 24110000 MOVECHAR = NO; 24120000 END; /* END BLANK NOT DELIMITED */ 24130000 END; /* END BLANK CHARACTER FOUND */ 24140000 24150000 /*************************************************/ 24160000 /* IF MOVECHAR IS SET THEN MOVE THE INPUT */ 24170000 /* CHARACTER INTO SQL STATEMENT BUFFER AREA */ 24180000 /*************************************************/ 24190000 24200000 IF MOVECHAR = YES THEN 24210000 DO; 24220000 24230000 /*********************************************/ 24240000 /* WHEN THE STATEMENT LENGTH IS TOO LONG,THE */ 24250000 /* STATEMENT CANNOT BE PROCESSED. A RETURN */ 24260000 /* CODE IS SET TO INDICATE NO FURTHER */ 24270000 /* PROCESSING SHOULD BE DONE. AN ERROR */ 24280000 /* MESSAGE WILL BE PUT OUT. T */ 24290000 /*********************************************/ 24300000 24310000 STMTLEN = LENGTH(STMTBUF); 24320000 IF STMTLEN = STMTMAX THEN /* STMT TOO LONG */ 24330000 DO; 24340000 RETCODE = SEVERE; /* SET RETURN CODE */ 24350000 PUT EDIT('**ERROR: SQL STATEMENT GREATER ', 24360000 'THAN ',MAXARRAY,' CHARACTERS. ', 24370000 'STMT: ') /*@BA06177*/ 24380000 (COL(2),A(32),A(5),F(10),A(13), 24390000 A(7)); 24400000 PUT EDIT((SUBSTR(STMTBUF,KK, 24410000 MIN(100,STMTLEN-KK+1)) 24420000 DO KK = 1 TO STMTLEN BY 100)) 24430000 (COL(12),A(100)); /*@BA06177*/ 24440000 LEAVE RD; 24450000 END; /* END STMT TOO LONG */ 24460000 STMTBUF = STMTBUF || INPUT(J); 24470000 END; /* MOVE CHARACTER INTO BUFFER */ 24480000 LASTCHAR = INPUT(J); /* SAVE THIS CHARACTER */ 24490000 END; /* END CHARACTER NOT A TERM CHAR */ 24500000 END; /* END DO J = INCOL TO INPUTL */ 24510000 END; /* END PROCESS THE SQL STMT */ 24520000 IF COMMENT = NO THEN 24530000 INCOL = J; /* UPDATE THE INPUT COLUMN */ 24540000 ELSE 24550000 INCOL = INPUTL + 1; /* UPDATE THE INPUT COLUMN */ 24560000 END; /* END DO WHILE (ENDSTR = NO) */ 24570000 24580000 /*************************************************************/ 24590000 /* CHECK WHETHER THE COMMAND ENTERED IS THE BEGINNING OF A */ 24600000 /* DYNAMIC SQL STATEMENT. */ 24610000 /*************************************************************/ 24620000 24630000 CHKCOMM: 24640000 24650000 IF COMMENT = NO THEN 24660000 DO; 24670000 STMTLEN = LENGTH(STMTBUF); 24680000 NEWOFSET = ONE; /* FIRST POSITION OF THE CMD */ 24690000 CALL FINDCMD(NEWOFSET); /* CHECK IF THE CMD IS VALID */ 24700000 24710000 /*************************************************************/ 24720000 /* IF THE INPUT STATEMENT CONTAINS THE WORD 'EXEC', THE NEXT */ 24730000 /* WORD MUST BE 'SQL'. CLEAR THE WORDS 'EXEC SQL'. THIS IS */ 24740000 /* A USER FRIENDLY FEATURE THAT ALLOWS THE USER TO PREFACE */ 24750000 /* THE SQL STATEMENT WITH THOSE WORDS. */ 24760000 /*************************************************************/ 24770000 IF COMMAND = 'EXEC ' THEN /* IS THE COMMAND 'EXEC'? */ 24780000 DO; /* 'EXEC SQL' PROCESSING */ 24790000 CALL FINDCMD(NEWOFSET); /* GET NEXT WORD IN STMT */ 24800000 24810000 /*********************************************************/ 24820000 /* IF THE COMMAND IS 'EXEC SQL', BLANK THE WORDS OUT */ 24830000 /* OF THE STATEMENT BUFFER. SEARCH FOR ACTUAL SQL */ 24840000 /* COMMAND */ 24850000 /*********************************************************/ 24860000 24870000 IF COMMAND = 'SQL ' THEN 24880000 /* IS THE WORD 'SQL'? */ 24890000 DO; /* WORD 'SQL' FOUND */ 24900000 SUBSTR(STMTBUF,ONE,(NEWOFSET - ONE)) = BLNKLINE; 24910000 CALL FINDCMD(NEWOFSET); 24920000 END; /* END 'SQL' FOUND */ 24930000 END; /* END 'EXEC SQL' PROCESSING */ 24940000 24950000 /*************************************************************/ 24960000 /* COMMAND IS NOT 'EXEC SQL' */ 24970000 /*************************************************************/ 24980000 24990000 /*********************************************************/ 25000000 /* IF THE HELP COMMAND IS SPECIFIED, PUT OUT A MESSAGE */ 25010000 /* THAT LISTS THE VALID SQL COMMANDS. INDICATE THAT A */ 25020000 /* NEW STATEMENT SHOULD BE READ. */ 25030000 /*********************************************************/ 25040000 25050000 IF (COMMAND = 'HELP ') | (COMMAND = '? ') | 25060000 (COMMAND = 'H ') THEN 25070000 DO; /* HELP COMMAND */ 25080000 /* */ 25090000 PUT EDIT ('ALL DYNAMIC SQL COMMANDS ARE SUPPORTED.', 25100000 'THE FOLLOWING STATIC SQL COMMANDS ARE ', 25110000 'ALSO SUPPORTED:', 25120000 'CONNECT SET CONNECTION SET QUERYNO RELEASE') 25130000 (COL(2), A, SKIP, COL(2), A, A, 25140000 SKIP, COL(2), A); 25150000 NEWSTMT = YES; 25160000 END; /* END HELP COMMAND */ 25170000 25180000 /*********************************************************/ 25190000 /* COMMAND IS END, EXIT, QUIT */ 25200000 /*********************************************************/ 25210000 25220000 ELSE 25230000 IF (COMMAND = 'END ') | (COMMAND = 'QUIT ') THEN 25240000 EXIT = YES; /* */ 25250000 ELSE 25260000 DO; /* PRINT OUT STATEMENT */ 25270000 25280000 /***************************************************/ 25290000 /* PRINT OUT THE SQL INPUT STATEMENT */ 25300000 /***************************************************/ 25310000 25320000 J = STMTLEN; 25330000 25340000 /*************************************************/ 25350000 /* UPDATE THE OUTPUT LINE COUNTER */ 25360000 /*************************************************/ 25370000 25380000 25390000 /*************************************************/ 25400000 /* LINE COUNT = HEADERS + # OF LINES TO PRINT */ 25410000 /* THE INPUT STATEMENT + COMMENTS @09*/ 25420000 /*************************************************/ 25430000 /* ADD COMMENTS */ 25440000 END; /* END ELSE PRINT OUT STATEMENT */ 25450000 25460000 /*************************************************/ 25470000 /* CHECK FOR CONNECT, SET CONNECTION, RELEASE, */ 25480000 /* SET QUERYNO, AND CREATE TRIGGER */ 25490000 /*************************************************/ 25500000 CREATE_TRIGGER_STMT = NO; /* CLEAR CREATE TRIGGER FLAG */ 25510000 SELECT(COMMAND); 25520000 WHEN('CREATE ') /* FLAG 'CREATE TRIGGER' STMT*/ 25530000 DO; /* TO STOP RUN IF ERRORS */ 25540000 SAVE_COMMAND = COMMAND; /* Preserve current command */ 25550000 SAVE_OFFSET = NEWOFSET; /* ..and its offset */ 25560000 CALL FINDCMD(NEWOFSET); /* If the next word in stmt */ 25570000 IF COMMAND = 'TRIGGER ' THEN /* is TRIGGER, then set */ 25580000 CREATE_TRIGGER_STMT = YES; /* error handling flag */ 25590000 COMMAND = SAVE_COMMAND; /* Restore previous command */ 25600000 NEWOFSET = SAVE_OFFSET; /* ..and its offset */ 25610000 END; 25620000 WHEN('CONNECT ') 25630000 DO; 25640000 CALL CONNSTMT(NEWOFSET); 25650000 NEWSTMT = YES; 25660000 END; 25670000 WHEN('SET ') 25680000 DO; 25690000 DO I = NEWOFSET TO STMTLEN /* FIND NEXT WORD */ 25700000 WHILE (SUBSTR(STMTBUF,I,ONE) = BLANK); 25710000 END; 25720000 IF I <= STMTLEN-9 THEN /* IS THIS SET CONNECTION? */ 25730000 IF SUBSTR(STMTBUF,I,10) = 'CONNECTION' THEN 25740000 DO; 25750000 NEWOFSET = I+10; 25760000 CALL SETCSTMT(NEWOFSET); 25770000 NEWSTMT = YES; 25780000 END; 25790000 25800000 IF I <= STMTLEN-6 THEN /* IS THIS SET QUERYNO? */ 25810000 IF SUBSTR(STMTBUF,I,7) = 'QUERYNO' THEN 25820000 DO; 25830000 NEWOFSET = I+7; 25840000 CALL SETQUERYNO(NEWOFSET); 25850000 IF( STMTBUF = LOW(STMTLEN) ) THEN /* Stmt errs */ 25860000 NEWSTMT = YES; 25870000 END; 25880000 25890000 END; /* WHEN('SET ') */ 25900000 WHEN('RELEASE ') 25910000 DO; 25920000 NEWSTMT = YES; 25930000 CALL RELSTMT(NEWOFSET); 25940000 END; 25950000 OTHERWISE; 25960000 END; /* END SELECT(COMMAND) */ 25970000 END; /* IF COMMENT = NO */ 25980000 END; /* END ELSE MORE INPUT */ 25990000 END; /* END DO WHILE NEW STATEMENT */ 26000000 26010000 ENDRD:; 26020000 $TRACE ('READRTN OUT') DATA(STMTBUF,EXIT,EODIN,ENDSTR); 26030000 END READRTN; 26040000 26050000 %PAGE; 26060000 26070000 /*******************************************************************/ 26080000 /* THIS PROCEDURE DETERMINES WHETHER THE SPECIFIED COMMAND IS A */ 26090000 /* VALID COMMAND. IT WILL HANDLE ANY INVALID COMMANDS AND */ 26100000 /* REQUESTS FOR HELP INFORMATION. */ 26110000 /*******************************************************************/ 26120000 26130000 FINDCMD: PROCEDURE(NEWOFF); 26140000 26150000 DCL 26160000 CMDCNT FIXED BIN(15) /* COMMAND CHARACTER INDEX */ 26170000 INIT(0), 26180000 NEWOFF FIXED BIN(15); /* FIRST POSITION OF THE COMMAND */ 26190000 26200000 /*******************************************************************/ 26210000 /* MOVE THE COMMAND FROM THE BUFFER INTO A LOCAL VARIABLE */ 26220000 /*******************************************************************/ 26230000 26240000 $TRACE ('FINDCMD IN') DATA(NEWOFF,STMTBUF,STMTLEN); 26250000 26260000 CMDCNT = 1; /* INITIALIZE COMMAND CHAR INDEX */ 26270000 COMMAND = BLANK; /* CLEAR OUT THE COMMAND NAME */ 26280000 26290000 /*******************************************************************/ 26300000 /* BY PASS PRECEDING PARENTHESES AND BLANKS */ 26310000 /*******************************************************************/ 26320000 26330000 DO WHILE (SUBSTR(STMTBUF,NEWOFF,ONE) = '(' | 26340000 SUBSTR(STMTBUF,NEWOFF,ONE) = ' ') ; 26350000 NEWOFF = NEWOFF + ONE ; 26360000 END ; 26370000 26380000 /*******************************************************************/ 26390000 /* MOVE FIRST NINE CHARACTERS OR MOVE CHARACTERS UNTIL A BLANK IS */ 26400000 /* ENCOUNTERED */ 26410000 /*******************************************************************/ 26420000 26430000 DO I = NEWOFF TO STMTLEN 26440000 WHILE (CMDCNT <= NINE & SUBSTR(STMTBUF,I,ONE) ¬= BLANK) ; 26450000 SUBSTR(COMMAND,CMDCNT,ONE) = SUBSTR(STMTBUF,I,ONE); 26460000 CMDCNT = CMDCNT + 1; /* INCREASE INDEX BY 1 */ 26470000 END; /* MOVE COMMAND TO VARIABLE */ 26480000 26490000 NEWOFF = I; /* SAVE OFFSET FOR NEXT STRING */ 26500000 IF SUBSTR(STMTBUF,I,ONE)= BLANK THEN /* SKIP BLANK IF NEED BE */ 26510000 NEWOFF = NEWOFF + 1; 26520000 26530000 $TRACE ('FINDCMD OUT') DATA(NEWOFF,STMTBUF,COMMAND); 26540000 END FINDCMD; 26550000 26560000 %PAGE; 26570000 26580000 /*******************************************************************/ 26590000 /* THIS PROCEDURE DETERMINES WHETHER THE SPECIFIED COMMAND IS A */ 26600000 /* VALID CONNECT STATEMENT. IF SO, IT BUILDS AND EXECUTES A */ 26610000 /* CONNECT STATEMENT. */ 26620000 /*******************************************************************/ 26630000 26640000 CONNSTMT: PROCEDURE(NEWOFC); 26650000 26660000 DCL 26670000 NEWOFC FIXED BIN(15), /* OFFSET ON ENTRY */ 26680000 CONNERR FIXED BIN(15) /* INDICATES ERROR ON CONNECT */ 26690000 INIT(0), 26700000 CONNONLY FIXED BIN(15) /* INDICATES CONNECT W/ NO OPERAND*/ 26710000 INIT(0), 26720000 CONNLOC CHAR(16) /* LOCATION NAME */ 26730000 INIT(' '); 26740000 26750000 EXEC SQL WHENEVER SQLERROR GO TO HNDLCONN; 26760000 EXEC SQL WHENEVER SQLWARNING CONTINUE; 26770000 EXEC SQL WHENEVER NOT FOUND CONTINUE; 26780000 26790000 $TRACE ('CONNSTMT IN') DATA(STMTBUF); 26800000 CONNERR = ZERO; /* INDICATE NO CONNECTION ERRO */ 26810000 CONNONLY = ZERO; /* INIT TO CONNECT HAS OPERANDS */ 26820000 DO I = NEWOFC TO STMTLEN /* ANYTHING AFTER CONNECT? */ 26830000 WHILE (SUBSTR(STMTBUF,I,ONE) = BLANK); 26840000 END; 26850000 IF I > STMTLEN THEN /* NOTHING-JUST ISSUE CONNECT */ 26860000 DO; 26870000 EXEC SQL CONNECT; 26880000 CONNONLY = ONE; 26890000 END; 26900000 ELSE 26910000 DO; /* 'RESET'-ISSUE CONNECT RESET */ 26920000 IF I<=STMTLEN-4 THEN /* IF NOT AT STRING END */ 26930000 IF SUBSTR(STMTBUF,I,5) = 'RESET' THEN 26940000 DO; 26950000 DO J = I+5 to STMTLEN 26960000 WHILE (SUBSTR(STMTBUF,J,ONE) = BLANK); 26970000 /* REST OF STRING BLANK? */ 26980000 END; 26990000 IF J>STMTLEN THEN /* YES-ISSUE CONNECT RESET */ 27000000 DO; 27010000 EXEC SQL CONNECT RESET; /* */ 27020000 END; 27030000 ELSE CONNERR=1; /* NO-SET ERROR FLAG */ 27040000 END; 27050000 ELSE 27060000 DO; 27070000 IF I<=STMTLEN-2 THEN /* IF NOT AT STRING END */ 27080000 IF SUBSTR(STMTBUF,I,2) = 'TO' & 27090000 SUBSTR(STMTBUF,I+2,ONE) = BLANK THEN 27100000 /* CHECK FOR 'TO' AFTER CONN */ 27110000 DO; 27120000 I=I+2; /* POINT AFTER 'TO' */ 27130000 /* FIND THE LOCATION */ 27140000 DO J = I TO STMTLEN 27150000 WHILE (SUBSTR(STMTBUF,J,ONE) = BLANK); 27160000 /* FIND BEGINNING OF LOCATION */ 27170000 END; 27180000 IF (J > STMTLEN | J=I) THEN 27190000 CONNERR = ONE; /* NO LOCATION-ERROR */ 27200000 ELSE 27210000 DO; 27220000 DO I = J to STMTLEN 27230000 WHILE(SUBSTR(STMTBUF,I,ONE) ¬= BLANK); 27240000 /* FIND END OF LOCATION */ 27250000 END; 27260000 IF I>J THEN 27270000 CONNLOC = SUBSTR(STMTBUF,J,I-J); /* GET NAME */ 27280000 IF (I>J+LOCLEN | I<=J) THEN 27290000 /* LENGTH OF LOCATION OK? */ 27300000 CONNERR = ONE; /* NO-SET ERROR */ 27310000 ELSE 27320000 DO; /* DO THE CONNECT */ 27330000 DO J = I TO STMTLEN 27340000 WHILE(SUBSTR(STMTBUF,J,ONE) = BLANK); 27350000 END; /* ANYTHING AFTER LOCATION? */ 27360000 IF J>STMTLEN THEN 27370000 DO; /* NO-DO THE SET CONNECT */ 27380000 EXEC SQL CONNECT TO :CONNLOC; /* */ 27390000 END; 27400000 ELSE /* YES-SET ERROR FLAG */ 27410000 CONNERR=ONE; 27420000 END; 27430000 END; 27440000 END; 27450000 ELSE 27460000 CONNERR = ONE; /* NO 'TO' - ERROR */ 27470000 END; 27480000 ELSE; /* FROM IF I<=STMTLEN-4 */ 27490000 END; 27500000 IF CONNERR = ONE THEN /* CONNECT SYNTAX ERROR MSG */ 27510000 DO; 27520000 PUT EDIT ('CONNECT STATEMENT CONTAINED SYNTAX ERRORS') 27530000 (COL(2),A(41)); /* */ 27540000 IF RETCODE < RETERR THEN 27550000 RETCODE = RETERR; /* SET ERROR RETURN CODE */ 27560000 END; 27570000 ELSE /* CONNECT SYNTAX OK */ 27580000 DO; 27590000 IF SQLCODE = ZERO THEN 27600000 DO; 27610000 PUT EDIT ('CONNECT SUCCESSFUL') 27620000 (COL(2),A(18)); 27630000 IF CONNONLY = ONE THEN 27640000 CALL PRINTCA; /* PRINT SQLCA */ 27650000 END; 27660000 ELSE 27670000 CALL PRINTCA; /* PRINT SQLCA */ 27680000 END; 27690000 $TRACE ('CONNSTMT OUT') DATA(STMTBUF); 27700000 END CONNSTMT; 27710000 %PAGE; 27720000 27730000 /*******************************************************************/ 27740000 /* THIS PROCEDURE DETERMINES WHETHER THE SPECIFIED COMMAND IS A */ 27750000 /* VALID SET CONNECTION STATEMENT. IF SO, IT BUILDS AND EXECUTES A */ 27760000 /* SET CONNECTION STATEMENT; */ 27770000 /*******************************************************************/ 27780000 27790000 SETCSTMT: PROCEDURE(NEWOFS); 27800000 27810000 DCL 27820000 NEWOFS FIXED BIN(15), /* OFFSET ON ENTRY */ 27830000 SETCERR FIXED BIN(15) /* INDICATES ERROR ON SET CONN */ 27840000 INIT(0), 27850000 SETCLOC CHAR(16) /* LOCATION NAME */ 27860000 INIT(' '); 27870000 27880000 $TRACE ('SETCSTMT IN') DATA(STMTBUF); 27890000 EXEC SQL WHENEVER SQLERROR GO TO HNDLCONN; 27900000 EXEC SQL WHENEVER SQLWARNING CONTINUE; 27910000 EXEC SQL WHENEVER NOT FOUND CONTINUE; 27920000 /* */ 27930000 SETCERR = ZERO; /* INDICATE NO ERROR */ 27940000 DO I = NEWOFS TO STMTLEN /* WHAT FOLLOWS CONNECTION? */ 27950000 WHILE (SUBSTR(STMTBUF,I,ONE) = BLANK); 27960000 END; 27970000 IF I > STMTLEN THEN /* NOTHING-ERROR */ 27980000 SETCERR = ONE; /* SET ERROR INDICATOR */ 27990000 ELSE 28000000 DO; 28010000 DO J = I TO STMTLEN 28020000 WHILE(SUBSTR(STMTBUF,J,ONE) ¬= BLANK); 28030000 /* FIND END OF LOCATION */ 28040000 END; 28050000 IF J>I THEN 28060000 SETCLOC = SUBSTR(STMTBUF,I,J-I); /* GET LOCATION NAME */ 28070000 IF (J>I+LOCLEN | J<=I) THEN 28080000 /* LENGTH OF LOCATION OK? */ 28090000 SETCERR = ONE; /* NO-SET ERROR */ 28100000 ELSE 28110000 DO; /* YES-CHECK AFTER LOCATION */ 28120000 DO I = J TO STMTLEN 28130000 WHILE(SUBSTR(STMTBUF,I,ONE) = BLANK); 28140000 END; /* ANYTHING AFTER LOCATION? */ 28150000 IF I>STMTLEN THEN /* NO-DO THE SET CONNECT */ 28160000 DO; 28170000 EXEC SQL SET CONNECTION :SETCLOC; 28180000 END; 28190000 ELSE 28200000 SETCERR=ONE; /* YES-SET ERROR FLAG */ 28210000 END; 28220000 END; 28230000 IF SETCERR = ONE THEN /* CONNECT SYNTAX ERROR-GIVE MSG */ 28240000 DO; 28250000 PUT EDIT ('SET CONNECTION STATEMENT CONTAINED SYNTAX ERRORS') 28260000 (COL(2),A(48)); /* */ 28270000 IF RETCODE < RETERR THEN 28280000 RETCODE = RETERR; /* SET ERROR RETURN CODE */ 28290000 END; 28300000 ELSE /* CONNECT SYNTAX OK */ 28310000 DO; 28320000 IF SQLCODE = ZERO THEN 28330000 PUT EDIT ('SET CONNECTION SUCCESSFUL') 28340000 (COL(2),A(25)); /* */ 28350000 ELSE 28360000 CALL PRINTCA; /* PRINT SQLCA */ 28370000 END; 28380000 $TRACE ('SETCSTMT OUT') DATA(STMTBUF); 28390000 END SETCSTMT; 28400000 28410000 %PAGE; 28420000 28430000 /*******************************************************************/ 28440000 /* THIS PROCEDURE DETERMINES WHETHER THE SPECIFIED COMMAND IS A */ 28450000 /* VALID SET QUERYNO STATEMENT. IF SO, IT BUILDS AND EXECUTES A */ 28460000 /* SET QUERYNO STATEMENT; */ 28470000 /*******************************************************************/ 28480000 28490000 SETQUERYNO: PROCEDURE(NEWOFS); 28500000 28510000 DCL 28520000 NEWOFS FIXED BIN(15), /* OFFSET ON ENTRY */ 28530000 SETQERR FIXED BIN(15) /* INDICATES ERROR ON SET QUERYNO */ 28540000 INIT(0), 28550000 SETCLOC CHAR(16) /* LOCATION NAME */ 28560000 INIT(' '), 28570000 V FIXED BIN(15) /* LOOP VAR */ 28580000 INIT(0); 28590000 28600000 $TRACE ('SETQUERYNO IN') DATA(STMTBUF); 28610000 28620000 SETQERR = ZERO; /* INDICATE NO ERROR */ 28630000 28640000 /******************************************************************** 28650000 * Skip over blanks between 'SET QUERYNO' and the next token * 28660000 ********************************************************************/ 28670000 DO I = NEWOFS TO STMTLEN 28680000 WHILE( SUBSTR( STMTBUF,I,ONE ) = BLANK ); 28690000 END; 28700000 /******************************************************************** 28710000 * Verify that there is a token after 'SET QUERYNO' * 28720000 ********************************************************************/ 28730000 IF( I > STMTLEN ) THEN 28740000 SETQERR = ONE; 28750000 /******************************************************************** 28760000 * Verify that this token is an equal sign * 28770000 ********************************************************************/ 28780000 ELSE IF( SUBSTR( STMTBUF,I,1 ) ¬= '=' ) THEN 28790000 SETQERR = ONE; 28800000 /******************************************************************** 28810000 * Skip over blanks between 'SET QUERYNO =' and the next token * 28820000 ********************************************************************/ 28830000 I = I + 1; 28840000 DO I = I TO STMTLEN 28850000 WHILE( SUBSTR( STMTBUF,I,ONE ) = BLANK 28860000 & SETQERR = ZERO ); 28870000 END; 28880000 /******************************************************************** 28890000 * Verify that there is a token after 'SET QUERYNO =' * 28900000 ********************************************************************/ 28910000 IF( I > STMTLEN & SETQERR = ZERO ) THEN 28920000 SETQERR = ONE; 28930000 /******************************************************************** 28940000 * Skip over that token (presumed to be a string of 1+ numerics) * 28950000 ********************************************************************/ 28960000 DO I = I TO STMTLEN 28970000 WHILE( SUBSTR( STMTBUF,I,ONE ) ¬= BLANK 28980000 & SETQERR = ZERO ); 28990000 END; 29000000 /******************************************************************** 29010000 * Skip over blanks between 'SET QUERYNO = n' and the next token * 29020000 ********************************************************************/ 29030000 I = I + 1; 29040000 DO I = I TO STMTLEN 29050000 WHILE( SUBSTR( STMTBUF,I,ONE ) = BLANK 29060000 & SETQERR = ZERO ); 29070000 END; 29080000 /******************************************************************** 29090000 * Verify that there is a token after 'SET QUERYNO = n' * 29100000 ********************************************************************/ 29110000 IF( I+4 > STMTLEN ) THEN 29120000 SETQERR = ONE; 29130000 /******************************************************************** 29140000 * Verify that this token is the string 'FOR ' * 29150000 ********************************************************************/ 29160000 ELSE IF( SUBSTR( STMTBUF,I,4 ) ¬= 'FOR ' & SETQERR = ZERO ) THEN 29170000 SETQERR = ONE; 29180000 /******************************************************************** 29190000 * Skip over blanks between 'SET QUERYNO = n FOR' and the next token * 29200000 ********************************************************************/ 29210000 I = I + 4; 29220000 DO I = I TO STMTLEN 29230000 WHILE( SUBSTR( STMTBUF,I,ONE ) = BLANK 29240000 & SETQERR = ZERO ); 29250000 END; 29260000 /******************************************************************** 29270000 * Verify that there is a token after 'SET QUERYNO = n FOR ' * 29280000 ********************************************************************/ 29290000 IF( I > STMTLEN ) THEN 29300000 SETQERR = ONE; 29310000 /******************************************************************** 29320000 * If no errors, process what follows 'SET QUERYNO = n FOR ' * 29330000 ********************************************************************/ 29340000 IF( SETQERR = ZERO ) THEN 29350000 DO; 29360000 /**************************************************************** 29370000 * Reset COMMAND control word to the first token that follows * 29380000 * 'SET QUERYNO = n FOR ' * 29390000 ****************************************************************/ 29400000 COMMAND = BLANK; 29410000 DO V = I TO STMTLEN 29420000 WHILE( SUBSTR( STMTBUF,V,ONE ) ¬= BLANK ); 29430000 END; 29440000 COMMAND = SUBSTR( STMTBUF,I,V-I ); 29450000 END; 29460000 /******************************************************************** 29470000 * Otherwise, issue a diagnostic message * 29480000 ********************************************************************/ 29490000 ELSE 29500000 DO; 29510000 PUT EDIT( 'SET QUERYNO STATEMENT CONTAINED SYNTAX ERRORS' ) 29520000 ( COL(2),A(48) ); 29530000 IF( RETCODE < RETERR ) THEN 29540000 RETCODE = RETERR; /* Set error return code */ 29550000 STMTBUF = LOW( STMTLEN ); /* Signal invalid statement */ 29560000 END; 29570000 29580000 $TRACE ('SETQUERYNO OUT') DATA(STMTBUF); 29590000 END SETQUERYNO; 29600000 29610000 %PAGE; 29620000 29630000 /*******************************************************************/ 29640000 /* THIS PROCEDURE DETERMINES WHETHER THE SPECIFIED COMMAND IS A */ 29650000 /* VALID RELEASE STATEMENT. IF SO, IT BUILDS AND EXECUTES A */ 29660000 /* RELEASE STATEMENT; */ 29670000 /*******************************************************************/ 29680000 29690000 RELSTMT: PROCEDURE(NEWOFR); 29700000 29710000 DCL 29720000 NEWOFR FIXED BIN(15), /* OFFSET ON ENTRY */ 29730000 RELERR FIXED BIN(15) /* INDICATES ERROR ON RELEASE */ 29740000 INIT(0), 29750000 K FIXED BIN(15) /* LOOP COUNTER @66*/ 29760000 INIT(0), 29770000 RELDONE FIXED BIN(15) /* INDICATES DONE CHECKING REL @66*/ 29780000 INIT(0), 29790000 RELLOC CHAR(16) /* LOCATION NAME */ 29800000 INIT(' '); 29810000 29820000 EXEC SQL WHENEVER SQLERROR GO TO HNDLCONN; 29830000 EXEC SQL WHENEVER SQLWARNING CONTINUE; 29840000 EXEC SQL WHENEVER NOT FOUND CONTINUE; 29850000 29860000 RELERR = ZERO; /* INDICATE NO RELEASE ERROR */ 29870000 RELDONE= ZERO; /* INDICATE NOT DONE @66*/ 29880000 DO I = NEWOFR TO STMTLEN /* WHAT FOLLOWS RELEASE? */ 29890000 WHILE (SUBSTR(STMTBUF,I,ONE) = BLANK); 29900000 END; 29910000 IF I >= STMTLEN THEN /* NOTHING-ERROR */ 29920000 DO; /* @66*/ 29930000 RELERR = ONE; /* SET ERROR INDICATOR */ 29940000 RELDONE = ONE; /* INDICATE DONE @66*/ 29950000 END; /* @66*/ 29960000 /* Check for RELEASE SAVEPOINT */ 29970000 IF( I <= STMTLEN-9 /* If room for 'SAVEPOINT ' */ 29980000 & RELDONE ¬= ONE ) THEN /* and not done then */ 29990000 /* ..is the token 'SAVEPOINT'? */ 30000000 IF SUBSTR(STMTBUF,I,10) = 'SAVEPOINT ' THEN 30010000 DO; /* ..Yes: Does anything follow?*/ 30020000 DO J = I+11 TO STMTLEN 30030000 WHILE (SUBSTR(STMTBUF,J,ONE) = BLANK); 30040000 END; 30050000 IF J>=STMTLEN THEN /* ....No: Set error indicator */ 30060000 DO; 30070000 RELERR = ONE; 30080000 END; 30090000 ELSE /* ....Yes: Assume that it's */ 30100000 DO; /* the SAVEPOINT name */ 30110000 NEWSTMT = NO; /* ......Return statement for */ 30120000 END; /* dynamic processing */ 30130000 RELDONE = ONE; /* Either way, you're done here*/ 30140000 END; 30150000 ELSE; /* From IF 'SAVEPOINT ' */ 30160000 ELSE; /* FROM IF( I <= STMTLEN-9 ... */ 30170000 IF( I <= STMTLEN-2 /* If room for 'TO ' */ 30180000 & RELDONE ¬= ONE ) THEN /* and not done then */ 30190000 /* ..is the token 'TO'? */ 30200000 IF SUBSTR(STMTBUF,I,3) = 'TO ' THEN 30210000 DO; /* ..Yes: Does anything follow?*/ 30220000 DO J = I+3 TO STMTLEN 30230000 WHILE (SUBSTR(STMTBUF,J,ONE) = BLANK); 30240000 END; 30250000 IF J>=STMTLEN THEN /* ....No: Set error indicator */ 30260000 RELERR = ONE; 30270000 ELSE IF( J <= STMTLEN-9 ) THEN /* ....Yes: SAVEPOINT is next? */ 30280000 IF SUBSTR(STMTBUF,J,10) = 'SAVEPOINT ' THEN 30290000 DO; /* ......Yes: Anything follow? */ 30300000 DO J = J+11 TO STMTLEN 30310000 WHILE (SUBSTR(STMTBUF,J,ONE) = BLANK); 30320000 END; 30330000 IF J>=STMTLEN THEN /* ........No: Set err indic */ 30340000 DO; 30350000 RELERR = ONE; 30360000 END; 30370000 ELSE /* ........Yes: Assume it's the*/ 30380000 DO; /* SAVEPOINT name */ 30390000 NEWSTMT = NO; /* ..........Return stmt for */ 30400000 END; /* dynamic processing*/ 30410000 END; 30420000 ELSE /* ......No: SAVEPOINT not next*/ 30430000 DO; 30440000 RELERR = ONE; /* ........Set error indicator */ 30450000 END; 30460000 ELSE /* ....Not room for SAVEPOINT */ 30470000 DO; 30480000 RELERR = ONE; /* ......Set error indicator */ 30490000 END; 30500000 RELDONE = ONE; /* Either way, you're done here*/ 30510000 END; 30520000 ELSE; /* From IF 'TO' */ 30530000 ELSE; /* FROM IF( I <= STMTLEN-2 ... */ 30540000 IF (I<=STMTLEN-6) & (RELDONE ¬= ONE) THEN /* @66*/ 30550000 IF SUBSTR(STMTBUF,I,7) = 'CURRENT' & 30560000 (SUBSTR(STMTBUF,I+7,ONE) = BLANK | STMTLEN = I+6) THEN 30570000 DO; /* RELEASE CURRENT? */ 30580000 DO J = I+8 TO STMTLEN /* WHAT FOLLOWS CURRENT? */ 30590000 WHILE (SUBSTR(STMTBUF,J,ONE) = BLANK); 30600000 END; 30610000 IF J<=STMTLEN THEN /* SOMETHING BEFORE END-ERROR */ 30620000 RELERR = ONE; /* SET ERROR INDICATOR */ 30630000 ELSE 30640000 DO; 30650000 EXEC SQL RELEASE CURRENT; /* */ 30660000 END; 30670000 RELDONE = ONE; /* @66*/ 30680000 END; 30690000 ELSE; /* FROM IF 'CURRENT' @66*/ 30700000 ELSE; /* FROM IF (I<=STMTLEN-6) @66*/ 30710000 IF (I<=STMTLEN-2) & (RELDONE ¬= ONE) THEN /* @66*/ 30720000 IF SUBSTR(STMTBUF,I,3) = 'ALL' & 30730000 (SUBSTR(STMTBUF,I+3,ONE) = BLANK | STMTLEN = I+2) THEN 30740000 DO; /* RELEASE ALL? */ 30750000 DO J = I+4 TO STMTLEN /* WHAT FOLLOWS ALL? */ 30760000 WHILE (SUBSTR(STMTBUF,J,ONE) = BLANK); 30770000 END; 30780000 IF J > STMTLEN THEN /* NOTHING BEFORE END- */ 30790000 DO; /* RELEASE ALL */ 30800000 EXEC SQL RELEASE ALL; /* */ 30810000 END; 30820000 ELSE 30830000 IF J <= STMTLEN-2 & (SUBSTR(STMTBUF,J,3) = 'SQL') THEN 30840000 DO; 30850000 DO K = J+3 TO STMTLEN /* WHAT FOLLOWS SQL? @66*/ 30860000 WHILE (SUBSTR(STMTBUF,K,ONE) = BLANK); /* @66*/ 30870000 END; 30880000 IF K <= STMTLEN THEN /* SOMETHING-ERROR @66*/ 30890000 RELERR = ONE; /* SET ERROR INDICATOR */ 30900000 ELSE 30910000 DO; 30920000 EXEC SQL RELEASE ALL SQL; /* */ 30930000 END; 30940000 END; 30950000 ELSE 30960000 IF J <= STMTLEN-6 & SUBSTR(STMTBUF,J,7) = 'PRIVATE' THEN 30970000 DO; /* RELEASE ALL PRIVATE */ 30980000 DO K = J+7 TO STMTLEN /* WHAT FOLLOWS PRIVATE? @66*/ 30990000 WHILE (SUBSTR(STMTBUF,K,ONE) = BLANK); /* @66*/ 31000000 END; 31010000 IF K <= STMTLEN THEN /* SOMETHING-ERROR @66*/ 31020000 RELERR = ONE; /* SET ERROR INDICATOR */ 31030000 ELSE 31040000 DO; 31050000 EXEC SQL RELEASE ALL PRIVATE; /* */ 31060000 END; 31070000 END; 31080000 ELSE /* SOMETHING ELSE AFTER ALL */ 31090000 RELERR = ONE; /* SET ERROR INDICATOR */ 31100000 RELDONE = ONE; /* DONE WITH RELEASE @66*/ 31110000 END; /* END OF RELEASE ALL */ 31120000 ELSE; /* FROM IF 'ALL' */ 31130000 ELSE; /* FROM IF I<=STMTLEN-2 @66*/ 31140000 IF RELDONE ¬= ONE THEN /* LOCATION IS SPECIFIED @66*/ 31150000 DO; 31160000 DO J = I to STMTLEN /* */ 31170000 WHILE(SUBSTR(STMTBUF,J,ONE) ¬= BLANK); 31180000 /* FIND END OF LOCATION */ 31190000 END; 31200000 IF J>I THEN 31210000 RELLOC = SUBSTR(STMTBUF,I,J-I); 31220000 IF (J>I+LOCLEN | J<=I) THEN 31230000 /* LENGTH OF LOCATION OK? */ 31240000 RELERR = ONE; /* NO-SET ERROR */ 31250000 ELSE 31260000 DO; /* YES-CHECK AFTER LOCATION */ 31270000 DO K = J TO STMTLEN /* @66*/ 31280000 WHILE(SUBSTR(STMTBUF,K,ONE) = BLANK); /* @66*/ 31290000 END; /* ANYTHING AFTER LOCATION? */ 31300000 IF K>STMTLEN THEN /* NO-DO THE RELEASE @66*/ 31310000 DO; 31320000 EXEC SQL RELEASE :RELLOC; 31330000 END; 31340000 ELSE 31350000 RELERR=ONE; /* YES-SET ERROR FLAG */ 31360000 END; 31370000 END; 31380000 IF RELERR = ONE THEN /* RELEASE ERROR-PUT MESSAGE */ 31390000 DO; 31400000 PUT EDIT ('RELEASE STATEMENT CONTAINED SYNTAX ERRORS') 31410000 (COL(2),A(41)); /* */ 31420000 IF RETCODE < RETERR THEN 31430000 RETCODE = RETERR; /* SET ERROR RETURN CODE */ 31440000 END; 31450000 ELSE /* RELEASE SYNTAX OK */ 31460000 IF( NEWSTMT = YES ) THEN /* and stmt was processed here*/ 31470000 DO; 31480000 IF SQLCODE = ZERO THEN 31490000 PUT EDIT ('RELEASE SUCCESSFUL') 31500000 (COL(2),A(18)); /* */ 31510000 ELSE 31520000 CALL PRINTCA; /* PRINT SQLCA */ 31530000 END; 31540000 $TRACE ('RELSTMT OUT') DATA(STMTBUF); 31550000 END RELSTMT; 31560000 %PAGE; 31570000 31580000 /*******************************************************************/ 31590000 /* THIS PROCEDURE ALLOCATES THE SQL BUFFER AREAS AND MAP THE SQLCA */ 31600000 /* AND THE SQLDA TO THIS AREA. IF THE SQL BUFFER IS REALLOCATED */ 31610000 /* DUE TO INSUFFICIENT STORAGE FOR THE SQL PROCESSING, THE OLD */ 31620000 /* AREA WILL BE COPIED INTO THE NEW AREA BEFORE THE OLD AREA IS */ 31630000 /* FREED. */ 31640000 /*******************************************************************/ 31650000 31660000 ALLOCTE: PROCEDURE; 31670000 31680000 DCL 31690000 K FIXED BIN(15) /* USED AS AN INDEX TO COPY DATA */ 31700000 INIT(0), 31710000 OLDBPTR PTR; /* SAVE OLD BUFFER PTR IN CASE OF */ 31720000 /* REALLOCATION */ 31730000 31740000 $TRACE ('ALLOCTE IN') DATA(BUFFPTR, BUFFSIZE,PAGESIZE,MAXARRAY); 31750000 OLDBPTR = BUFFPTR; /* SAVE THE OLD SQL BUFFER PTR */ 31760000 31770000 /*******************************************************************/ 31780000 /* INCREASE THE SQL BUFFER BY 4K MAKING SURE THAT THE TOTAL LENGTH */ 31790000 /* OF THE BUFFER IS ON A PAGE BOUNDARY. */ 31800000 /*******************************************************************/ 31810000 31820000 BUFFSIZE = BUFFSIZE + PAGESIZE - BUFFLENL ; 31830000 IF BUFFSIZE > MAXARRAY THEN /* BUFFER OVERFLOW */ 31840000 DO; /* AN ERROR HAS OCCURRED */ 31850000 RETCODE = SEVERE; 31860000 ALLOCRC = SEVERE; /* SET ALLOCATE RETURN CODE @87*/ 31870000 PUT EDIT (' **ERROR: SQL BUFFER OVERFLOW. MAXIMUM SIZE IS', 31880000 MAXARRAY) (COL(2),A(48), F(10)); 31890000 END; 31900000 ELSE /* GET MORE STORAGE */ 31910000 DO; 31920000 ALLOCATE BUFF; /* ALLOCATE THE BUFFER AREA */ 31930000 IF OLDBPTR ¬= NULL THEN 31940000 DO; /* COPY OLD BUFFER TO NEW */ 31950000 DO K = 1 TO OLDBPTR->BUFFLEN; /* BUFFER, CHAR BY CHAR */ 31960000 BUFFSQL(K) = OLDBPTR->BUFFSQL(K); 31970000 END; /* END COPY */ 31980000 FREE OLDBPTR->BUFF; /* FREE OLD BUFFER AREA */ 31990000 END; /* END PROCESSING OLD BUFFER AREA */ 32000000 SQLDAPTR = ADDR(BUFFSQL); /* RE-ESTABLISH ADDR TO THE SQLDA */ 32010000 END; /* END GET MORE STORAGE */ 32020000 $TRACE ('ALLOCTE OUT') DATA(BUFFLEN,BUFFSIZE) PUTTYPE(LIST); 32030000 END ALLOCTE; 32040000 32050000 %PAGE; 32060000 32070000 32080000 /*******************************************************************/ 32090000 /* THIS PROCEDURE SETS UP OUTPUT AREAS FOR THE SPECIFIED FIELDS */ 32100000 /* IN A RESULT OF THE SQL STATEMENT. */ 32110000 /*******************************************************************/ 32120000 32130000 SETUPOUT: PROCEDURE; 32140000 32150000 DCL 32160000 PREVWD FIXED BIN(15) INIT(0),/* PREVIOUS PARTITION PAGE WIDTH */ 32170000 NULLS FIXED BIN(15) INIT(0),/* LENGTH OF NULL INDICATOR */ 32180000 LENSQL FIXED BIN(31) INIT(0),/* LENGTH OF SQL OUTPUT */ 32190000 SAVEJ FIXED BIN(31) INIT(0),/* SAVE J DURING PARTITION INIT */ 32200000 HLINE FIXED BIN(31) INIT(0),/* SAVE THE HEADING LINE NUMBER */ 32210000 DATAOFF FIXED BIN(31) INIT(0);/* SQL OUTPUT BUFFER AREA OFFSET */ 32220000 32230000 32240000 $TRACE ('SETUPOUT IN') PUTTYPE(LIST) DATA(SQLD); 32250000 SETUPRC = 0; /* INITIALIZE RETURN CODE */ 32260000 32270000 /* -- begin @34 */ 32280000 FREE LOBLN; /* Free LOB lengths tracking array*/ 32290000 ALLOCATE LOBLN(SQLN); /* Alloc LOB lens tracking array */ 32300000 DO J = ONE TO SQLN; /* Initialize dynamic storage */ 32310000 LOBLN(J) = 0; /* in LOB lengths tracking array*/ 32320000 END; 32330000 /* -- end @34 */ 32340000 /*******************************************************************/ 32350000 /* INSERT THE ANSWER ADDRESSES IN THE SQLDA */ 32360000 /*******************************************************************/ 32370000 32380000 DOAGAIN: 32390000 IF ( SUBSTR(SQLDAID, 7,1) = ' ' ) THEN /* If using single SQLDA */ 32400000 DATAOFF = LEN_SQLDA /* ..determine offset of */ 32410000 + SQLD * LEN_SQLVAR /* 1st byte past SQLDA */ 32420000 + ONE; /* +SQLVAR for all cols*/ 32430000 /* -- begin @34 */ 32440000 ELSE IF (SUBSTR(SQLDAID,7,1) = '2') THEN /* If using double SQLDA */ 32450000 DATAOFF = LEN_SQLDA /* ..determine offset of */ 32460000 + 2 * SQLD * LEN_SQLVAR /* 1st byte past SQLDA */ 32470000 + ONE; /* + SQLVAR for all cols */ 32480000 /* + SQLVAR2 for all cols*/ 32490000 /* -- end @34 */ 32500000 32510000 DO J = ONE TO SQLD; /* FOR EACH COLUMN IN RESULT */ 32520000 32530000 /****************************************************************** 32540000 * Set index for extended SQLDA (SQLVAR2) if needed for LOB columns* 32550000 ******************************************************************/ 32560000 J2 = J + SQLD; /* SQLVAR2 starts at end of SQLVAR*/ 32570000 < SQLCCSID_PTR = SQLDATA(J); /* Map CCSID of current column @02*/ 32575000 32580000 NULLS = ZERO; /* INIT LENGTH TO ZERO */ 32590000 32600000 /*****************************************************************/ 32610000 /* CALCULATE THE LENGTH OF EACH COLUMN ACCORDING TO THE TYPE OF */ 32620000 /* DATA IT CONTAINS */ 32630000 /*****************************************************************/ 32640000 32650000 SELECT (SQLTYPE( J)); 32660000 32670000 /*****************************************************************/ 32680000 /* GRAPHIC DATA */ 32690000 /*****************************************************************/ 32700000 32710000 WHEN (GCHAR,GCHARN) 32720000 DO; /* GRAPHIC CHAR OR NULL GRAPHIC CHAR */ 32730000 IF (SQLTYPE(J) = GCHARN) THEN /* IF NULL GRAPHIC CHAR, */ 32740000 NULLS = TWO; /* SET NULL INDICATOR */ 32750000 /* LENGTH */ 32760000 < /******************************************************+@02*/ 32770000 < /* If UTF-16 data selected when current appl encoding */ 32771000 < /* scheme is not a known MBCS CCSID, return the data in */ 32772000 < /* character format. */ 32773000 < /***********************************************************/ 32774000 < IF( SQLCCSID = UTF_16 & MBCS_APPENSCH = NO ) THEN 32775000 < DO; 32776000 < IF( SQLTYPE(J) = GCHAR ) THEN 32777000 < SQLTYPE(J) = CHART; 32778000 < ELSE 32779000 < SQLTYPE(J) = CHARNT; 32780000 < LENSQL = SQLLEN(J); 32781000 < END; /*-@02*/ 32782000 < ELSE 32783000 < DO; 32784000 IF SQLLEN(J) > (MAXCOLWD-2) / 2 THEN 32785000 SQLLEN(J) = (MAXCOLWD-2) / 2; /* CALC THE MAX */ 32786000 /* SQL COLUMN */ 32787000 LENSQL = SQLLEN(J) * 2 + 2; /* LENGTH */ 32788000 < END; 32789000 END; 32810000 WHEN (GVCHAR,GVCHARN,GLCHAR,GLCHARN) 32820000 DO; /* GRAPHIC & NULL GRAPHIC VARCHAR & */ 32830000 /* LONG GRAPHIC & NULL GRAPHIC VARCHAR */ 32840000 IF (SQLTYPE(J) = GVCHARN) | /* NULL GRAPH VARCHR */ 32850000 (SQLTYPE(J) = GLCHARN) THEN /* NULL LNG GRPH VAR */ 32860000 NULLS = TWO; /* SET NULL INDICATOR */ 32870000 /* LENGTH */ 32880000 < /******************************************************+@02*/ 32890000 < /* If UTF-16 data selected when current appl encoding */ 32891000 < /* scheme is not a known MBCS CCSID, return the data in */ 32892000 < /* character format. */ 32893000 < /***********************************************************/ 32894000 < IF( SQLCCSID = UTF_16 & MBCS_APPENSCH = NO ) THEN 32895000 < DO; 32896000 < IF( SQLTYPE(J) = GVCHAR | SQLTYPE(J) = GLCHAR ) THEN 32897000 < SQLTYPE(J) = VCHART; 32898000 < ELSE 32899000 < SQLTYPE(J) = VCHARNT; 32900000 < LENSQL = SQLLEN(J)+TWO; 32901000 < END; /*-@02*/ 32902000 < ELSE 32903000 < DO; 32904000 IF SQLLEN(J) > (MAXCOLWD-2) / 2 THEN 32905000 SQLLEN(J) = (MAXCOLWD-2) / 2; /* CALC THE MAX */ 32906000 /* SQL COLUMN */ 32907000 LENSQL = SQLLEN(J) * 2 + TWO + 2; /* LENGTH */ 32908000 < END; 32909000 32930000 END; /* END GRAPHIC DATA TYPES */ 32940000 32950000 /*****************************************************************/ 32960000 /* INTEGER DATA */ 32970000 /*****************************************************************/ 32980000 32990000 WHEN (INTT,SMINTT,FLOATT) 33000000 DO; 33010000 LENSQL = SQLLEN( J); /* INTEGER DATA LENGTH */ 33020000 END; 33030000 33040000 /*****************************************************************/ 33050000 /* INTEGER NULL TYPE DATA. INCLUDE THE LENGTH OF THE NULL */ 33060000 /* INDICATOR. */ 33070000 /*****************************************************************/ 33080000 33090000 WHEN (INTNT,SMINTNT,FLOATNT) 33100000 DO; 33110000 NULLS = TWO; /* NULL INDICATOR LENGTH */ 33120000 LENSQL = SQLLEN( J); /* INTEGER DATA LENGTH */ 33130000 END; 33140000 33150000 /*****************************************************************/ 33160000 /* CHARACTER DATA */ 33170000 /*****************************************************************/ 33180000 33190000 WHEN (CHARNT,CHART) 33200000 DO; /* CHARACTER DATA */ 33210000 IF SQLTYPE(J) = CHARNT THEN 33220000 NULLS = TWO; /* NULL INDICATOR LENGTH */ 33230000 IF SQLLEN(J) > MAXCOLWD THEN 33240000 SQLLEN(J) = MAXCOLWD; /* ALLOW ONLY THE # OF CHARS */ 33250000 /* FOR MAXIMUM COLUMN WIDTH */ 33260000 LENSQL = SQLLEN(J); /* CHARACTER DATA LENGTH */ 33270000 END; /* END CHARACTER DATA */ 33280000 33290000 /*****************************************************************/ 33300000 /* VARYING CHARACTER (VARCHAR) DATA */ 33310000 /*****************************************************************/ 33320000 33330000 WHEN (VCHARNT,VCHART,LVCHART,LVCHARNT) 33340000 DO; /* VARCHAR DATA */ 33350000 IF (SQLTYPE(J) = VCHARNT) | (SQLTYPE(J) = LVCHARNT) THEN 33360000 NULLS = TWO; /* NULL INDICATOR LENGTH */ 33370000 IF SQLLEN(J) > MAXCOLWD THEN 33380000 SQLLEN(J) = MAXCOLWD; /* ALLOW ONLY THE # OF CHARS */ 33390000 /* FOR MAXIMUM COLUMN WIDTH */ 33400000 LENSQL = SQLLEN(J)+TWO; /* LGTH = DATA LGTH + LGTH BYTE*/ 33410000 END; /* END VARCHAR DATA */ 33420000 33430000 /*****************************************************************/ 33440000 /* DECIMAL DATA */ 33450000 /*****************************************************************/ 33460000 33470000 WHEN (DECNT,DECT) 33480000 DO; /* DECIMAL DATA */ 33490000 IF SQLTYPE(J) = DECNT THEN 33500000 NULLS = TWO; /* NULL INDICATOR LENGTH */ 33510000 33520000 /*****************************************************************/ 33530000 /* RETRIEVE THE REAL SCALE. SET THE SQL LENGTH TO THE MAXIMUM */ 33540000 /* DECIMAL # PRECISION. THE LENGTH OF THE DATA IS PREDETERMINED */ 33550000 /* TO BE 31/2 + 1 (=16). */ 33560000 /*****************************************************************/ 33570000 LENSQL = 16; 33580000 END; /* END DECIMAL DATA */ 33590000 33600000 /*****************************************************************/ 33610000 /* DATE, TIME, TIMESTAMP DATA */ 33620000 /*****************************************************************/ 33630000 33640000 WHEN (DATETYP,NDATETYP,TIMETYP,NTIMETYP,TIMES,NTIMES) 33650000 DO; /* DATE AND TIME DATA */ 33660000 IF (SQLTYPE(J)=NDATETYP | SQLTYPE(J)=NTIMETYP | 33670000 SQLTYPE(J)=NTIMES) THEN 33680000 DO; 33690000 NULLS = TWO; 33700000 END; 33710000 IF SQLLEN(J) > MAXCOLWD THEN 33720000 SQLLEN(J) = MAXCOLWD; /* ALLOW ONLY THE # OF CHARS */ 33730000 /* FOR MAXIMUM COLUMN WIDTH */ 33740000 LENSQL = SQLLEN(J); /* CHARACTER DATA LENGTH */ 33750000 END; /* END DATE AND TIME DATA */ 33760000 33770000 /* -- begin @34 */ 33780000 /*****************************************************************/ 33790000 /* Binary Large OBject column: Convert host var to BLOB locator */ 33800000 /*****************************************************************/ 33810000 WHEN( BLOBT,BLOBNT ) 33820000 DO; /* BLOB column encountered */ 33830000 IF SQLTYPE(J) = BLOBNT THEN /* If col has NULL indicator*/ 33840000 DO; 33850000 NULLS = TWO; /* ..adjust output offset */ 33860000 END; 33870000 ELSE /* Else */ 33880000 DO; 33890000 NULLS = ZERO; /* ..disregard NULL ind len */ 33900000 END; 33910000 33920000 IF SQLLONGL( J2 ) /* Set hostvar size as the */ 33930000 > MAXCOLWD THEN /* smaller of BLOB column */ 33940000 SQLLONGL( J2 ) /* length or the max column */ 33950000 = MAXCOLWD; /* display width (MAXCOLWD) */ 33960000 33970000 LENSQL = /* Save (adjusted) display */ 33980000 SQLLONGL( J2 ); /* width of the BLOB column */ 33990000 34000000 SQLDATAL( J2 ) /* Tell DB2 where to store */ 34010000 = ADDR( LOBLN(J) ); /* length of fetched BLOB */ 34020000 34030000 HEX_DISPLAY = YES; /* Activate HEX display */ 34040000 34050000 END; /* BLOB column encountered */ 34060000 34070000 /*****************************************************************/ 34080000 /* Character Large OBject column: Convert host var to CLOB loc. */ 34090000 /*****************************************************************/ 34100000 WHEN( CLOBT,CLOBNT ) 34110000 DO; /* CLOB column encountered */ 34120000 IF SQLTYPE(J) = CLOBNT THEN /* If col has NULL indicator*/ 34130000 DO; 34140000 NULLS = TWO; /* ..adjust output offset */ 34150000 END; 34160000 ELSE /* Else */ 34170000 DO; 34180000 NULLS = ZERO; /* ..disregard NULL ind len */ 34190000 END; 34200000 34210000 IF SQLLONGL( J2 ) /* Set hostvar size as the */ 34220000 > MAXCOLWD THEN /* smaller of CLOB column */ 34230000 SQLLONGL( J2) /* length or the max column */ 34240000 = MAXCOLWD; /* display width (MAXCOLWD) */ 34250000 34260000 LENSQL = /* Save (adjusted) display */ 34270000 SQLLONGL( J2 ); /* width of the CLOB column */ 34280000 34290000 SQLDATAL( J2 ) /* Tell DB2 where to store */ 34300000 = ADDR( LOBLN(J) ); /* length of fetched CLOB */ 34310000 34320000 END; /* CLOB column encountered */ 34330000 34340000 /*****************************************************************/ 34350000 /* Double Byte Char Large OBj col: Convert host var to DBCLOB loc*/ 34360000 /*****************************************************************/ 34370000 WHEN( DBCLOBT,DBCLOBNT ) 34380000 DO; /* DBCLOB column encountered*/ 34390000 IF SQLTYPE(J) = DBCLOBNT THEN /* If col has NULL indicator*/ 34400000 DO; 34410000 NULLS = TWO; /* ..adjust output offset */ 34420000 END; 34430000 ELSE /* Else */ 34440000 DO; 34450000 NULLS = ZERO; /* ..disregard NULL ind len */ 34460000 END; 34470000 < /******************************************************+@02*/ 34480000 < /* If UTF-16 data selected when current appl encoding */ 34482000 < /* scheme is not a known MBCS CCSID, return the data in */ 34484000 < /* character format. */ 34486000 < /***********************************************************/ 34488000 < IF( SQLCCSID = UTF_16 & MBCS_APPENSCH = NO ) THEN 34490000 < DO; 34492000 < IF( SQLTYPE(J) = DBCLOBT ) THEN 34494000 < SQLTYPE(J) = CLOBT; 34496000 < ELSE 34498000 < SQLTYPE(J) = CLOBNT; 34500000 < IF SQLLONGL( J2 ) /* Set hostvar size as the */ 34502000 < > MAXCOLWD THEN /* smaller of CLOB column */ 34504000 < SQLLONGL( J2 ) /* length or the max column */ 34506000 < = MAXCOLWD; /* display width (MAXCOLWD) */ 34508000 < END; /*-@02*/ 34510000 < ELSE 34512000 < DO; 34514000 IF SQLLONGL( J2 ) /* Set hostvar size as the */ 34516000 > MAXCOLWD/2 THEN /* smaller of DBCLOB char */ 34518000 SQLLONGL( J2 ) /* count or max DBCLOB dis- */ 34520000 = MAXCOLWD/2; /* play width (MAXCOLWD/2) */ 34522000 < END; 34524000 34530000 LENSQL = /* Save (adjusted) display */ 34540000 SQLLONGL( J2 ); /* width of the LOB column */ 34550000 34560000 SQLDATAL( J2 ) /* Set pointer to area for */ 34570000 = ADDR( LOBLN(J) ); /* # bytes in a fetched col */ 34580000 34590000 END; /* DBCLOB column encountered*/ 34600000 34610000 /*****************************************************************/ 34620000 /* ROWID Data */ 34630000 /*****************************************************************/ 34640000 WHEN( ROWIDT,ROWIDNT ) 34650000 DO; /* ROWID column encountered */ 34660000 IF SQLTYPE(J) = ROWIDNT THEN /* If col has NULL indicator*/ 34670000 NULLS = TWO; /* ..adjust output offset */ 34680000 ELSE /* Else */ 34690000 NULLS = ZERO; /* ..disregard NULL ind len */ 34700000 LENSQL = ROWIDLEN; /* max len of ROWID buffer */ 34710000 34720000 HEX_DISPLAY = YES; /* Activate HEX display */ 34730000 END; /* ROWID column encountered */ 34740000 /* -- end @34 */ 34750000 34760000 /*****************************************************************/ 34770000 /* DATA DID NOT FIT INTO THE ABOVE DATA TYPES */ 34780000 /*****************************************************************/ 34790000 34800000 OTHERWISE 34810000 DO; /* INVALID DATA TYPE */ 34820000 PUT EDIT (' INVALID SQLTYPE ',SQLTYPE(J), 34830000 ' ENCOUNTERED FOR FIELD # ', J,'.') 34840000 (COL(1), A(17), F(8), A(25), F(8), A(1) ); 34850000 34860000 /*****************************************************************/ 34870000 /* A WARNING IS ISSUED SINCE THE DATA TYPE SPECIFIED IS NOT */ 34880000 /* SUPPORTED */ 34890000 /*****************************************************************/ 34900000 34910000 IF RETCODE < RETWARN THEN /* IF THIS IS THE LARGEST RC, */ 34920000 RETCODE = RETWARN; /* PUT IT IN THE RC VARIABLE */ 34930000 SETUPRC = RETWARN; /* SET SETUP RETURN CODE */ 34940000 GOTO ENDSETUP; /* RETURN TO THE CALLER */ 34950000 END; /* END INVALID DATA TYPE */ 34960000 END; /* END SELECT */ 34970000 34980000 /*****************************************************************/ 34990000 /* MOVE OFFSET OF DATA WITHIN THE SQL BUFFER INTO THE SQLDA */ 35000000 /*****************************************************************/ 35010000 /* Verify that the SQL buffer can accomodate another column. @34*/ 35020000 /* Note: If using a double SQLDA (for LOBs, UDFs), the @34*/ 35030000 /* buffer will be consumed twice as fast. @34*/ 35040000 /*****************************************************************/ 35050000 IF ( SUBSTR(SQLDAID, 7,1) = ' ' /* If single SQLDA & @34*/ 35060000 & DATAOFF+LENSQL+NULLS > BUFFSIZE ) /* NO ROOM IN SQL BUFF */ 35070000 | ( SUBSTR(SQLDAID, 7,1) = '2' /* Or double SQLDA & @34*/ 35080000 & DATAOFF+LENSQL+NULLS > BUFFSIZE/2 ) /* no room in SQL buff@34*/ 35090000 THEN 35100000 DO; /* FOR THIS COLUMN */ 35110000 CALL ALLOCTE; /* ALLOCATE BIGGER BUFFER */ 35120000 IF ALLOCRC >ZERO THEN DO; 35130000 SETUPRC=RETERR; 35140000 GOTO ENDSETUP; 35150000 END; 35160000 GOTO DOAGAIN; /* PUT ANSWER ADDRESSES IN SQLDA*/ 35170000 END; /* END CURRENT BUFFER TOO SMALL */ 35180000 35190000 /*****************************************************************/ 35200000 /* SQLIND IS EQUAL TO THE ADDRESS OF THE COLUMN IN THE BUFFER */ 35210000 /* SQLDATA IS EQUAL TO THE ADDRESS OF THE COLUMN IN THE BUFFER */ 35220000 /*****************************************************************/ 35230000 35240000 35250000 IF NULLS > ZERO THEN 35260000 SQLIND(J) = ADDR(BUFFSQL(DATAOFF)); 35270000 ELSE /* MAKE SURE SQLIND POINTS TO */ 35280000 SQLIND(J) = ADDR(NOTNULL); /* A POSITIVE VALUE IF COLUMN IS */ 35290000 /* DEFINED AS NOT NULL */ 35300000 SQLDATA(J) = ADDR(BUFFSQL(DATAOFF+NULLS)); 35310000 35320000 $TRACE ('SQLDATA') DATA(J,DATAOFF,LENSQL,NULLS,SQLLEN(J), 35330000 SQLTYPE(J)) PUTTYPE(LIST); 35340000 SUBSTR(SQLDATA(J)->CHARBUF,1,LENSQL) = NULLCHAR; 35350000 DATAOFF = DATAOFF + LENSQL + NULLS; /* CALCULATE NEW OFFSET */ 35360000 END; /* END FOR EACH RESULT COL */ 35370000 35380000 %PAGE; 35390000 35400000 /*******************************************************************/ 35410000 /* GET STORAGE FOR THE COLUMN BUFFERS */ 35420000 /*******************************************************************/ 35430000 35440000 $TRACE ('ALLOC COLBUFFS?') DATA(SQLN,COLBUFLN) PUTTYPE(LIST); 35450000 IF SQLN > COLBUFLN THEN /* IF # COLS > # ALLOCATED, */ 35460000 DO; /* REALLOCATE BUFFERS */ 35470000 IF COLBUFLN ¬=ZERO THEN /* IF BUFFERS ALREADY ALLOCATED, */ 35480000 DO; /* FREE BUFFERS */ 35490000 FREE COLSTART; /* FREE COLSTART BUFFER */ 35500000 FREE COLLN; /* FREE COLLEN BUFFER */ 35510000 FREE DECLN; /* FREE DECIMAL BUFFER */ 35520000 END; /* END FREE BUFFERS */ 35530000 35540000 ALLOCATE COLSTART(SQLN+ONE); /* ALLOCATE STARTING COL ARRAY */ 35550000 DO J = ONE TO SQLN+ONE; /* Initialize dynamic storage */ 35560000 COLSTART(J) = 0; /* in starting column array */ 35570000 END; 35580000 ALLOCATE COLLN(SQLN); /* ALLOCATE THE COLUMN LENGTH */ 35590000 DO J = ONE TO SQLN; /* Initialize dynamic storage */ 35600000 COLLN(J) = 0; /* in column length array */ 35610000 END; 35620000 ALLOCATE DECLN(SQLN); /* ALLOCATE DECIMAL BUFFER */ 35630000 DO J = ONE TO SQLN; /* Initialize dynamic storage */ 35640000 DECLN(J) = 0; /* in decimal buffer */ 35650000 END; 35660000 COLBUFLN = SQLN; /* UPDATE THE COLBUFLN VARIABLE */ 35670000 $TRACE('NEW COLBUFFERS ALLOCATED') DATA(COLBUFLN,SQLN) 35680000 PUTTYPE(LIST); 35690000 END; /* END ALLOCATE BUFFERS */ 35700000 35710000 %PAGE; 35720000 35730000 /*******************************************************************/ 35740000 /* CALCULATE THE LENGTH OF THE OUTPUT BUFFER AND INDICATE THE */ 35750000 /* PLACEMENT AND LENGTH OF EACH COLUMN WITHIN THAT BUFFER. */ 35760000 /*******************************************************************/ 35770000 35780000 35790000 /*******************************************************************/ 35800000 /* THE OUTPUT CONTAINS VERTICAL LINES THAT SEPARATE THE COLUMNS. */ 35810000 /* PLACING A SPACE BEFORE AND AFTER THE LINE MEANS THAT THE DATA */ 35820000 /* WILL BE PLACED IN COLUMN THREE */ 35830000 /*******************************************************************/ 35840000 35850000 COLSTART(ONE)=THREE; 35860000 DO J=ONE TO SQLD; /* FOR EACH COLUMN RETRIEVED */ 35870000 35880000 /****************************************************************** 35890000 * Set index for extended SQLDA (SQLVAR2) if needed for LOB columns* 35900000 ******************************************************************/ 35910000 J2 = J + SQLD; /* SQLVAR2 starts at end of SQLVAR*/ 35920000 35930000 /*****************************************************************/ 35940000 /* GET THE OUTPUT LENGTH FOR THE CURRENT SQL DATA COLUMN */ 35950000 /*****************************************************************/ 35960000 35970000 SELECT (SQLTYPE( J)); 35980000 WHEN (INTT,INTNT) /* INTEGER DATA */ 35990000 LENSQL = INTLEN; 36000000 WHEN (SMINTT,SMINTNT) /* SMALL INTEGER DATA */ 36010000 LENSQL = SMILEN; 36020000 WHEN (CHART,CHARNT,VCHART,VCHARNT,LVCHART,LVCHARNT) 36030000 LENSQL = SQLLEN(J); /* CHARACTER AND VARCHAR DATA */ 36040000 WHEN (FLOATT,FLOATNT) /* FLOAT DATA */ 36050000 LENSQL = FLOLEN; 36060000 WHEN (GCHAR,GCHARN,GVCHAR,GVCHARN,GLCHAR,GLCHARN) /* GRAPHIC */ 36070000 LENSQL = SQLLEN(J) * 2 + 2; /* & VARGRAPHIC DATA */ 36080000 WHEN (DECT,DECNT) /* DECIMAL DATA */ 36090000 DO; 36100000 DECPREC=SQLLEN(J)/256; /* GET PRECISION */ 36110000 DECLN(J)=DECPREC; 36120000 DECSCAL=SQLLEN(J)-TRUNC(SQLLEN(J)/256)*256; 36130000 /* GET SCALE */ 36140000 LENSQL = DECPREC + 3; /* EXTRA SPACE NEEDED FOR SIGN, */ 36150000 /* DECIMAL POINT, LEADING ZERO */ 36160000 DECPREC = 31; /* CALC MAXIMUM DECIMAL FIELD LEN */ 36170000 SQLLEN(J)=DECPREC*256+DECSCAL; 36180000 END; 36190000 WHEN (DATETYP,NDATETYP,TIMETYP,NTIMETYP,TIMES,NTIMES) 36200000 LENSQL = SQLLEN(J); /* DATA AND TIME DATA */ 36210000 /* -- begin @34 */ 36220000 WHEN( BLOBT,BLOBNT ) /* BLOB Data */ 36230000 DO; 36240000 LENSQL = /* Get (adjusted) display */ 36250000 SQLLONGL( J2 ); /* width of the BLOB column */ 36260000 END; 36270000 WHEN( CLOBT,CLOBNT ) /* CLOB Data */ 36280000 DO; 36290000 LENSQL = /* Get (adjusted) display */ 36300000 SQLLONGL( J2 ); /* width of the CLOB column */ 36310000 END; 36320000 WHEN( DBCLOBT,DBCLOBNT ) /* DBCLOB Data */ 36330000 DO; 36340000 LENSQL = /* Get (adjusted) display */ 36350000 SQLLONGL( J2 ); /* width of the BLOB column */ 36360000 END; 36370000 WHEN( ROWIDT,ROWIDNT ) /* ROWID Data */ 36380000 DO; 36390000 LENSQL = ROWIDLEN; /* max length of ROWID bufr */ 36400000 END; 36410000 /* -- end @34 */ 36420000 36430000 END; /* END SELECT */ 36440000 36450000 /*****************************************************************/ 36460000 /* THE COLUMN LENGTH IS SET TO THE GREATER OF */ 36470000 /* A) LENGTH NEEDED FOR COLUMN NAME */ 36480000 /* B) LENGTH NEEDED FOR COLUMN DATA */ 36490000 /*****************************************************************/ 36500000 36510000 COLLN(J)=MAX(LENGTH(SQLNAME(J)),LENSQL); /* LGTH OF THIS COLUMN*/ 36520000 36530000 /*****************************************************************/ 36540000 /* CALCULATE THE START OF THE NEXT COLUMN. ADD THREE TO ACCOUNT */ 36550000 /* FOR THE SPACE, VERTICAL BAR, SPACE BETWEEN THE COLUMNS. */ 36560000 /*****************************************************************/ 36570000 36580000 COLSTART(J+ONE) = COLSTART(J) + COLLN(J) + THREE ; 36590000 $TRACE ('COL DATA') DATA(J,LENSQL,COLLN(J),COLSTART(J), 36600000 COLSTART(J+ONE)); 36610000 END; /* FOR EACH SQL COLUMN */ 36620000 LASTCOL = COLSTART(SQLD+ONE)-TWO; /* GET RID OF TRAILING BLANK */ 36630000 36640000 /*******************************************************************/ 36650000 /* ALLOCATE AND INITIALIZE THE OUTPUT BUFFER */ 36660000 /*******************************************************************/ 36670000 36680000 OBUFWID = LASTCOL; /* FOR OUTPUT BUFFER ALLOCATION */ 36690000 $TRACE ('ALLOC OUTBUF?') DATA(OBUFWID,LASTCOL,OUTBUFLN,MAXPAGLN); 36700000 IF OBUFWID > OUTBUFLN THEN /* IF SQLDA # COLS > # ENTRIES, */ 36710000 DO; /* REALLOCATE BUFFER */ 36720000 IF OUTBUFLN ¬= ZERO THEN /* IF BUFFER ALREADY ALLOCATED */ 36730000 FREE OUTBUF; /* FREE OUTPUT BUFFER */ 36740000 ALLOCATE OUTBUF(MAXPAGLN+1) CHAR(OBUFWID); /* ALLOCATE BUFFER */ 36750000 /* -- begin @34 */ 36760000 FREE HEXBUFH; /* Free HEX high nibble xlate buff*/ 36770000 ALLOCATE HEXBUFH /* Alloc " " " " " */ 36780000 CHAR(OBUFWID); 36790000 FREE HEXBUFL; /* Free HEX low nibble xlate buff */ 36800000 ALLOCATE HEXBUFL /* Alloc " " " " " */ 36810000 CHAR(OBUFWID); 36820000 /* -- end @34 */ 36830000 OUTBUFLN = OBUFWID; /* UPDATE THE OUTBUFLN VARIABLE */ 36840000 $TRACE('NEW OUTBUF ALLOCATED') DATA(OUTBUFLN,OBUFWID); 36850000 END; /* END ALLOCATE BUFFER */ 36860000 DO J=ONE TO MAXPAGLN+1; /* INITIALIZE THE OUTPUT BUFFER */ 36870000 OUTBUF(J)=BLANK; 36880000 END; 36890000 /* -- begin @34 */ 36900000 IF( HEX_DISPLAY = YES ) THEN /* If hex display activated then */ 36910000 HEXBUFH, HEXBUFL = BLANK; /* ..clear HEX translate buffers */ 36920000 /* -- end @34 */ 36930000 36940000 %PAGE; 36950000 36960000 /*******************************************************************/ 36970000 /* INITIALIZE THE ROW INDICES */ 36980000 /*******************************************************************/ 36990000 37000000 HLINE= ONE; /* INITIALIZE THE FIRST ROW INDEX */ 37010000 LASTROW=THREE; /* INITIALIZE THE LAST ROW INDEX */ 37020000 37030000 /*******************************************************************/ 37040000 /* PRINT HORIZONTAL LINE FOR COLUMN TITLES */ 37050000 /*******************************************************************/ 37060000 37070000 COLTITL = LASTROW; /* SAVE FIRST ROW OF COL TITLES */ 37080000 DO J=ONE TO LASTCOL; /* FOR EVERY COLUMN OF OUTPUT */ 37090000 IF (J = ONE) | (J = LASTCOL) THEN /* IF START OR STOP COLUMN */ 37100000 SUBSTR(OUTBUF(LASTROW),J,ONE)=HPLUS; /* INSERT A PLUS */ 37110000 ELSE /* NOT START OR STOP COLUMN */ 37120000 SUBSTR(OUTBUF(LASTROW),J,ONE)=HDASH; /* SO INSERT A DASH */ 37130000 END; /* END FOR EVERY COLUMN OF OUTPUT */ 37140000 37150000 /*******************************************************************/ 37160000 /* PUT COLUMN NAMES INTO THE OUTPUT BUFFER */ 37170000 /*******************************************************************/ 37180000 37190000 LASTROW=LASTROW+ONE; /* RESET THE LAST ROW NEEDED */ 37200000 DO J=ONE TO SQLD; /* FOR EVERY COLUMN IN RESULT */ 37210000 37220000 /*****************************************************************/ 37230000 /* CENTER THE COLUMN NAME IN THE FIELD */ 37240000 /*****************************************************************/ 37250000 37260000 K=COLSTART(J)+(COLLN(J)-LENGTH(SQLNAME(J)))/TWO; 37270000 37280000 /*****************************************************************/ 37290000 /* PUT THE COLUMN NAME AND VERTICAL BAR INTO THE OUTPUT BUFFER */ 37300000 /*****************************************************************/ 37310000 37320000 SUBSTR(OUTBUF(LASTROW),K,LENGTH(SQLNAME(J)))=SQLNAME(J); 37330000 SUBSTR(OUTBUF(LASTROW),COLSTART(J)-TWO,ONE)=VBAR; 37340000 SUBSTR(OUTBUF(MAXPAGLN+1),COLSTART(J)-TWO,ONE)=VBAR; 37350000 END; /* END FOR EACH COLUMN IN RESULT */ 37360000 37370000 SUBSTR(OUTBUF(LASTROW),LASTCOL,ONE)=VBAR; /* MOVE IN LAST VERT BAR */ 37380000 SUBSTR(OUTBUF(MAXPAGLN+1),LASTCOL,ONE)=VBAR; 37390000 $TRACE ('COLUMN HEADINGS') DATA(OUTBUF(LASTROW),LASTROW); 37400000 37410000 /*******************************************************************/ 37420000 /* PRINT HORIZONTAL LINE FOR COLUMN TITLES */ 37430000 /*******************************************************************/ 37440000 37450000 LASTROW = LASTROW + ONE; /* GET TO THE NEXT LINE */ 37460000 OUTBUF(LASTROW)=OUTBUF(THREE); /* COPY THE HORIZONTAL LINE */ 37470000 HEADEND = LASTROW; /* SET END OF HEADINGS */ 37480000 37490000 %PAGE; 37500000 37510000 /*******************************************************************/ 37520000 /* CALCULATE THE NUMBER OF OUTPUT PAGE PARTITIONS AND ALLOCATE THE */ 37530000 /* PARTITION BUFFERS */ 37540000 /*******************************************************************/ 37550000 37560000 /*******************************************************************/ 37570000 /* CALCULATE THE NUMBER OF OUTPUT PAGE PARTITIONS */ 37580000 /*******************************************************************/ 37590000 37600000 NPART = ZERO; /* INITIALIZE PARTITION COUNTER */ 37610000 PREVWD = ZERO; /* INITIALIZE PREVIOUS PAGE WIDTH */ 37620000 J = ONE; /* INITIALIZE COLUMN INDEX */ 37630000 DO WHILE (J <= SQLD + ONE); /* DO FOR EVERY COLUMN OR FIELD */ 37640000 NPART = NPART + ONE; /* INCREASE COUNTER BY ONE */ 37650000 SAVEJ = J; /* SAVE THE CURRENT VALUE OF J */ 37660000 37670000 /*******************************************************************/ 37680000 /* FIND THE END OF A HORIZONTAL PAGE PARTITION */ 37690000 /*******************************************************************/ 37700000 37710000 DO WHILE (J <= SQLD + ONE & COLSTART(J) - PREVWD <= MAXPAGWD); 37720000 J = J + ONE; /* INCREMENT COLUMN INDEX */ 37730000 END; /* OF DO UNTIL PARTITION FULL */ 37740000 37750000 IF J <= SQLD + ONE THEN /* GET VALUES FOR NEXT ITERATION */ 37760000 DO; 37770000 37780000 /***************************************************************/ 37790000 /* IF THE CALCULATED PARTITION SIZE IS TOO LARGE AND THE */ 37800000 /* PARTITION CONTAINS MORE THAN ONE COLUMN, DECREASE THE */ 37810000 /* INDEX */ 37820000 /***************************************************************/ 37830000 37840000 IF (COLSTART(J)-PREVWD > MAXPAGWD) & (J > SAVEJ+ONE) THEN 37850000 J = J - ONE; 37860000 PREVWD = COLSTART(J); /* SAVE LAST COLUMN WIDTH */ 37870000 END; /* END GET VALUES FOR NXT ITERTN */ 37880000 ELSE 37890000 IF (SAVEJ = SQLD+ONE) THEN /* SAVEJ = MAXIMUM COLSTART INDEX */ 37900000 NPART = NPART - ONE; /* THEN LARGE FIELD WAS FOUND AT */ 37910000 /* END OF RETRIEVED FIELDS */ 37920000 END; /* END FOR EACH COLUMN */ 37930000 37940000 /*******************************************************************/ 37950000 /* ALLOCATE THE PARTITION BUFFERS */ 37960000 /*******************************************************************/ 37970000 37980000 IF NPART > OUTPARTL THEN 37990000 DO; 38000000 IF OUTPARTL ¬= 0 THEN /* BUFFERS ALREADY ALLOCATED? */ 38010000 DO; /* FREE BUFFERS */ 38020000 FREE PARTBEG; /* FREE HORIZ PART START INDEX */ 38030000 FREE LARGEFLD; /* FREE LARGE FIELD FLAGS */ 38040000 END; /* END FREE BUFFERS */ 38050000 ALLOCATE PARTBEG(NPART+ONE); /* ALLOCATE HORIZ PART BUFFER */ 38060000 DO J = ONE TO NPART+ONE; /* Initialize dynamic storage */ 38070000 PARTBEG(J) = 0; /* in horizontal partition buff */ 38080000 END; 38090000 ALLOCATE LARGEFLD(NPART+ONE);/* ALLOCATE THE LARGE FIELD FLAGS */ 38100000 DO J = ONE TO NPART+ONE; /* Initialize dynamic storage */ 38110000 LARGEFLD(J) = NO; /* in large field flag buffer */ 38120000 END; 38130000 OUTPARTL = NPART; /* UPDATE THE OUTPARTL VARIABLE */ 38140000 END; /* END ALLOCATE BUFFERS */ 38150000 38160000 %PAGE; 38170000 38180000 /*******************************************************************/ 38190000 /* INITIALIZE THE PARTITION BUFFERS */ 38200000 /*******************************************************************/ 38210000 38220000 PREVWD = ZERO; /* INITIALIZE PREVIOUS PAGE WIDTH */ 38230000 J = ONE; /* INITIALIZE COLUMN INDEX */ 38240000 DO K = ONE TO NPART; /* DO FOR EVERY COLUMN OR FIELD */ 38250000 LARGEFLD(K) = NO; /* NO LRG FIELDS IN HORIZ PAGE */ 38260000 PARTBEG(K) = J; /* SET BEGINNING COLUMN IN PART */ 38270000 38280000 /*****************************************************************/ 38290000 /* FIND THE LAST COLUMN IN THE HORIZONTAL PAGE PARTITION */ 38300000 /*****************************************************************/ 38310000 38320000 DO WHILE (J <= SQLD+ONE & COLSTART(J)-PREVWD <= MAXPAGWD); 38330000 J = J + ONE; /* INCREMENT COLUMN INDEX */ 38340000 END; /* END DO UNTIL PARTITION FULL */ 38350000 38360000 IF (J <= SQLD + ONE) THEN 38370000 DO; /* GET VALUES FOR NEXT ITERATION */ 38380000 IF (COLSTART(J)-PREVWD > MAXPAGWD) THEN 38390000 DO; 38400000 IF (J=PARTBEG(K)+ONE) THEN /* FIELD > PAGE WIDTH */ 38410000 LARGEFLD(K) = YES; /* SET LARGE FIELD INDICATOR */ 38420000 ELSE /* NOT A LARGE FIELD */ 38430000 J = J - ONE; /* BACK UP ONE COLUMN */ 38440000 END; 38450000 PREVWD = COLSTART(J); /* SAVE LAST COLUMN WIDTH */ 38460000 END; /* END GET VALUES FOR NXT ITERATN*/ 38470000 END; /* END FOR EACH COL OR FIELD */ 38480000 PARTBEG(NPART+ONE) = SQLD + ONE; 38490000 LARGEFLD(NPART+ONE) = NO; 38500000 38510000 %PAGE; 38520000 38530000 ENDSETUP: 38540000 38550000 $TRACE ('SETUPOUT OUT') DATA(LASTROW,HEADEND,COLTITL,NPART,HLINE, 38560000 PARTBEG,LARGEFLD,COLLN,COLSTART); 38570000 END SETUPOUT; 38580000 38590000 %PAGE; 38600000 38610000 38620000 /*******************************************************************/ 38630000 /* THIS PROCEDURE CONVERTS ONE ROW OF DATA INTO CHARACTERS. THE */ 38640000 /* DATA RESIDES IN VARIOUS BUFFERS. IT IS CONVERTED INTO */ 38650000 /* CHARACTER DATA AND PLACED INTO THE OUTPUT BUFFER. */ 38660000 /*******************************************************************/ 38670000 38680000 CONROW: PROCEDURE; 38690000 38700000 DCL 38710000 STARTCOL FIXED BIN(31) /* LOCAL COPY OF COLSTART @34*/ 38720000 INIT(0), 38730000 COLLGTH FIXED BIN(31) /* LOCAL COPY OF SQLLEN @34*/ 38740000 INIT(0), 38750000 DATAPTR POINTER; /* LOCAL COPY OF SQLDATA */ 38760000 38770000 DCL LOBLEN FIXED BIN(31) /* Length of LOB @34*/ 38780000 INIT( 0 ); 38790000 DCL LOBBUFFER CHAR(32767) VAR /* LOB work buffer @34*/ 38800000 INIT( ' ' ); 38810000 38820000 $TRACE ('CONROW IN') DATA(LASTROW); 38830000 LASTROW = LASTROW + ONE; /* START ON THE NEXT ROW */ 38840000 OUTBUF(LASTROW)=OUTBUF(MAXPAGLN+1); 38850000 /* -- begin @34 */ 38860000 IF( HEX_DISPLAY = YES ) THEN /* If hex display activated then */ 38870000 DO; 38880000 HEXBUFH = OUTBUF(MAXPAGLN+1);/* ..initialize HEX display buffs */ 38890000 HEXBUFL = OUTBUF(MAXPAGLN+1); 38900000 END; 38910000 /* -- end @34 */ 38920000 DO J=ONE TO SQLD; /* FOR EACH COLUMN IN THE RESULT */ 38930000 38940000 /****************************************************************** 38950000 * Set index for extended SQLDA (SQLVAR2) if needed for LOB columns* 38960000 ******************************************************************/ 38970000 J2 = J + SQLD; /* SQLVAR2 starts at end of SQLVAR*/ 38980000 38990000 STARTCOL = COLSTART(J); 39000000 COLLGTH = SQLLEN(J); 39010000 DATAPTR = SQLDATA(J); 39020000 39030000 /*****************************************************************/ 39040000 /* IF DATA IS NULL, PUT QUESTION MARKS IN THE OUTPUT COLUMN */ 39050000 /*****************************************************************/ 39060000 IF SQLIND(J)->NULLIND < 0 THEN 39070000 SUBSTR(OUTBUF(LASTROW),STARTCOL,1) = '?'; 39080000 ELSE 39090000 /*****************************************************************/ 39100000 /* MOVE THE RETRIEVED DATA TO THE OUTPUT BUFFER */ 39110000 /*****************************************************************/ 39120000 SELECT (SQLTYPE( J)); /* DATA TYPE */ 39130000 39140000 /*****************************************************************/ 39150000 /* INTEGER DATA */ 39160000 /*****************************************************************/ 39170000 39180000 WHEN (INTT,INTNT) 39190000 SUBSTR(OUTBUF(LASTROW),STARTCOL,INTLEN) = 39200000 CHAR(DATAPTR->INTBUF,INTLEN); /* CONVERT & MOVE */ 39210000 39220000 /*****************************************************************/ 39230000 /* SMALL INTEGER DATA */ 39240000 /*****************************************************************/ 39250000 39260000 WHEN (SMINTT,SMINTNT) 39270000 SUBSTR(OUTBUF(LASTROW),STARTCOL,SMILEN) = 39280000 CHAR(DATAPTR->SMIBUF,SMILEN); /* CONVERT & MOVE */ 39290000 39300000 /*****************************************************************/ 39310000 /* DECIMAL DATA */ 39320000 /*****************************************************************/ 39330000 39340000 WHEN (DECT,DECNT) 39350000 DO; /* DECIMAL DATA TYPE */ 39360000 DECPREC = DECLN(J); /* GET PRECISION */ 39370000 DECSCAL=SQLLEN(J)-31*256; /* GET SCALE */ 39380000 DIND=32-DECPREC; 39390000 /* LOOK FOR BEGINNING OF */ 39400000 /* SIGNIFICANT DIGITS */ 39410000 DO WHILE (DIND < 31-DECSCAL & 39420000 DATAPTR->DECMASK(DIND) = '0000'B); 39430000 STARTCOL=STARTCOL+1; 39440000 DIND=DIND+1; 39450000 END; 39460000 IF DATAPTR->DECMASK(32) = '1101'B THEN 39470000 SUBSTR(OUTBUF(LASTROW),STARTCOL,1)='-'; 39480000 /* IF NUMBER NEGATIVE START WITH*/ 39490000 /* MINUS SIGN */ 39500000 STARTCOL=STARTCOL+1; 39510000 DO UNTIL (DIND=32); 39520000 IF DIND=32-DECSCAL THEN 39530000 DO; 39540000 SUBSTR(OUTBUF(LASTROW),STARTCOL,1)='.'; 39550000 /* INSERT THE PERIOD */ 39560000 STARTCOL=STARTCOL+1; 39570000 END; 39580000 DECFMT2=DATAPTR->DECMASK(DIND); 39590000 SUBSTR(OUTBUF(LASTROW),STARTCOL,1) = DECFMT; 39600000 /* GENERATE THE EBCDIC EQUIVA- */ 39610000 /* LENT OF THE DIGIT */ 39620000 STARTCOL=STARTCOL+1; 39630000 DIND=DIND+1; 39640000 END; 39650000 END; 39660000 39670000 /*****************************************************************/ 39680000 /* FLOAT DATA */ 39690000 /*****************************************************************/ 39700000 39710000 WHEN (FLOATT,FLOATNT) 39720000 IF (COLLGTH = 4) THEN /* SINGLE PRECISION FLOAT */ 39730000 SUBSTR(OUTBUF(LASTROW),STARTCOL,FLOLEN) = 39740000 CHAR(DATAPTR->SMFLOBUF,FLOLEN); 39750000 ELSE /* DOUBLE PRECISION FLOAT */ 39760000 SUBSTR(OUTBUF(LASTROW),STARTCOL,FLOLEN) = 39770000 CHAR(DATAPTR->FLOBUF,FLOLEN); 39780000 39790000 /*****************************************************************/ 39800000 /* VARYING CHARACTER (VARCHAR) DATA */ 39810000 /*****************************************************************/ 39820000 39830000 WHEN (VCHART,VCHARNT, LVCHART,LVCHARNT) 39840000 SUBSTR(OUTBUF(LASTROW),STARTCOL, 39850000 LENGTH(DATAPTR->VCHARBUF)) = 39860000 DATAPTR->VCHARBUF; 39870000 39880000 /*****************************************************************/ 39890000 /* CHARACTER DATA */ 39900000 /*****************************************************************/ 39910000 39920000 WHEN(CHART,CHARNT) 39930000 SUBSTR(OUTBUF(LASTROW),STARTCOL,COLLGTH) = 39940000 DATAPTR->CHARBUF; /* MOVE DATA */ 39950000 39960000 /*****************************************************************/ 39970000 /* GRAPHIC DATA */ 39980000 /*****************************************************************/ 39990000 WHEN (GCHAR,GCHARN) 40000000 DO; /* GRAPHIC CHAR & NULL GRAPHIC CHAR DATA */ 40010000 IF SQLTYPE(J) = GCHARN & SQLIND(J) 40020000 -> NULLIND < 0 THEN /* NULL INDICATOR IS ON */ 40030000 /* THEN SET COLUMN = '?' */ 40040000 SUBSTR(OUTBUF(LASTROW),COLSTART(J),1) = '?'; 40050000 ELSE 40060000 SUBSTR(OUTBUF(LASTROW),COLSTART(J),SQLLEN(J) 40070000 * 2 + 2) = SO || SUBSTR(SQLDATA(J) 40080000 -> CHARBUF,1,SQLLEN(J) * 2) || SI; /* NOT NULL */ 40090000 /* SO MOVE DATA */ 40100000 END; 40110000 WHEN(GVCHAR,GVCHARN,GLCHAR,GLCHARN) 40120000 DO; /* GRAPHIC VARCHAR, NULL GRAPHIC VARCHAR */ 40130000 /* LNG GPH VARCHAR, NULL LNG GPH VARCHAR */ 40140000 IF (SQLTYPE(J) = GVCHARN | SQLTYPE(J) = GLCHARN) 40150000 & SQLIND(J) -> NULLIND < 0 THEN /* NULL INDICATOR */ 40160000 /* IS ON THEN SET */ 40170000 /* COLUMN = '?' */ 40180000 SUBSTR(OUTBUF(LASTROW),COLSTART(J),1) = '?'; 40190000 ELSE /* NOT NULL SO */ 40200000 /* MOVE DATA */ 40210000 SUBSTR(OUTBUF(LASTROW),COLSTART(J), 40220000 LENGTH(SQLDATA(J) -> VCHARBUF) * 2 + 2) 40230000 = SO||SUBSTR(SQLDATA(J) -> VCHARBUF, 40240000 1,LENGTH(SQLDATA(J) -> VCHARBUF) * 2)||SI; 40250000 END; 40260000 40270000 /*****************************************************************/ 40280000 /* DATE, TIME, TIMESTAMP DATA */ 40290000 /*****************************************************************/ 40300000 40310000 WHEN (DATETYP,NDATETYP,TIMETYP,NTIMETYP,TIMES,NTIMES) 40320000 SUBSTR(OUTBUF(LASTROW),STARTCOL,COLLGTH) = 40330000 DATAPTR->CHARBUF; 40340000 40350000 /* -- begin @34 */ 40360000 WHEN( BLOBT,BLOBNT ) /* BLOB Data */ 40370000 DO; /* Process BLOB data */ 40380000 COLLGTH = /* Recover col display width*/ 40390000 SQLLONGL( J2 ); /* */ 40400000 IF LOBLN(J) < COLLGTH THEN /* Adjust for case where len*/ 40410000 COLLGTH = LOBLN(J); /* of data fetched < col wid*/ 40420000 LOBLEN = COLLGTH; /* */ 40430000 40440000 SUBSTR( OUTBUF(LASTROW), /* Move the extracted BLOB */ 40450000 STARTCOL,LOBLEN ) /* data into position in */ 40460000 = DATAPTR->CHARBUF; /* the output buffer. */ 40470000 40480000 SUBSTR( HEXBUFH, /* Translate data to dis- */ 40490000 STARTCOL, /* playable hex - high */ 40500000 COLLGTH ) /* nibbles */ 40510000 = TRANSLATE( SUBSTR( OUTBUF(LASTROW),STARTCOL,COLLGTH ), 40520000 HIGH_NIBBLES, 40530000 EBCDIC_CHARS ); 40540000 40550000 SUBSTR( HEXBUFL, /* Translate data to dis- */ 40560000 STARTCOL, /* playable hex - low */ 40570000 COLLGTH ) /* nibbles */ 40580000 = TRANSLATE( SUBSTR( OUTBUF(LASTROW),STARTCOL,COLLGTH ), 40590000 LOW_NIBBLES, 40600000 EBCDIC_CHARS ); 40610000 END; /* End: Process BLOB data */ 40620000 40630000 WHEN( CLOBT,CLOBNT ) /* CLOB Data */ 40640000 DO; 40650000 COLLGTH = /* Recover col display width*/ 40660000 SQLLONGL( J2 ); /* */ 40670000 IF LOBLN(J) < COLLGTH THEN /* Adjust for case where len*/ 40680000 COLLGTH = LOBLN(J); /* of data fetched < col wid*/ 40690000 LOBLEN = COLLGTH; /* */ 40700000 SUBSTR( OUTBUF(LASTROW), /* Move the extracted CLOB */ 40710000 STARTCOL,LOBLEN ) /* data into position in */ 40720000 = DATAPTR->CHARBUF; /* the output buffer. */ 40730000 END; /* End: Process CLOB Data */ 40740000 40750000 WHEN( DBCLOBT,DBCLOBNT ) /* DBCLOB Data */ 40760000 DO; 40770000 COLLGTH = /* Recover col display width*/ 40780000 SQLLONGL( J2 ); /* */ 40790000 IF LOBLN(J) < COLLGTH THEN /* Adjust for case where len*/ 40800000 COLLGTH = LOBLN(J); /* of data fetched < col wid*/ 40810000 LOBLEN = COLLGTH; /* */ 40820000 40830000 SUBSTR( OUTBUF(LASTROW), /* Move the extracted DBCLOB*/ 40840000 STARTCOL, /* data into position in the*/ 40850000 LOBLEN * 2 + 2 ) /* output buffer, including */ 40860000 = SO /* ..the "shift out", */ 40870000 || SUBSTR(SQLDATA(J)->CHARBUF,/* ..length adjustments */ 40880000 1, /* for */ 40890000 2 * LOBLEN ) /* double byte chars, */ 40900000 || SI; /* ..and the "shift in". */ 40910000 40920000 END; /* End: Process DBCLOB Data */ 40930000 40940000 /*****************************************************************/ 40950000 /* ROWID data */ 40960000 /*****************************************************************/ 40970000 WHEN( ROWIDT,ROWIDNT ) 40980000 DO; /* Process ROWID data */ 40990000 SUBSTR( OUTBUF(LASTROW), /* Move the ROWID data into */ 41000000 STARTCOL, /* pos'n in the output buff */ 41010000 COLLGTH ) 41020000 = DATAPTR->ROWIDBUF; 41030000 SUBSTR( HEXBUFH, /* Load hi-nibble xlate buff*/ 41040000 STARTCOL, /* ..align under ROWID data */ 41050000 COLLGTH ) /* ..for len of ROWID data */ 41060000 = TRANSLATE( /* ..translating */ 41070000 SUBSTR(OUTBUF(LASTROW), /* ....ROWID data */ 41080000 STARTCOL, /* */ 41090000 COLLGTH), /* */ 41100000 HIGH_NIBBLES, /* ....high-order nibble */ 41110000 EBCDIC_CHARS ); /* ....to displayable chars */ 41120000 SUBSTR( HEXBUFL, /* Load lo-nibble xlate buff*/ 41130000 STARTCOL, /* ..align under ROWID data */ 41140000 COLLGTH ) /* ..for len of ROWID data */ 41150000 = TRANSLATE( /* ..translating */ 41160000 SUBSTR(OUTBUF(LASTROW), /* ....ROWID data */ 41170000 STARTCOL, /* */ 41180000 COLLGTH), /* */ 41190000 LOW_NIBBLES, /* ....low-order nibble */ 41200000 EBCDIC_CHARS ); /* ....to displayable chars */ 41210000 END; /* End: Process ROWID data */ 41220000 41230000 /*****************************************************************/ 41240000 /* Unknown datatype */ 41250000 /*****************************************************************/ 41260000 OTHERWISE 41270000 DO; /* Process unknown data type*/ 41280000 END; /* End: Unknown data type */ 41290000 /* -- end @34 */ 41300000 41310000 END; /* END SELECT DATA TYPE */ 41320000 41330000 END; /* END FOR EACH COLUMN OF RESULT */ 41340000 /* -- begin @34 */ 41350000 /*******************************************************************/ 41360000 /* If HEX display is in effect, insert hi/low nibbles below text */ 41370000 /*******************************************************************/ 41380000 IF HEX_DISPLAY = YES THEN 41390000 DO; 41400000 LASTROW = LASTROW + ONE; /* Advance to the next print line */ 41410000 OUTBUF(LASTROW) = HEXBUFH; /* ..and place high nibbles there */ 41420000 LASTROW = LASTROW + ONE; /* Advance to the next print line */ 41430000 OUTBUF(LASTROW) = HEXBUFL; /* ..and place low nibbles there */ 41440000 41450000 IF( LASTROW+LCT+4 /* If sufficient room for next */ 41460000 <= MAXPAGLN ) THEN /* iteration (4 lines for template*/ 41470000 DO; /* + text + hi nib + lo nib) .. */ 41480000 LASTROW = LASTROW + ONE; /* ..advance to next print line */ 41490000 OUTBUF(LASTROW) /* ..and fill it */ 41500000 = OUTBUF(MAXPAGLN+1); /* ..with the row template only */ 41510000 END; 41520000 41530000 ELSE IF( LASTROW+LCT+3 /* If insufficient room for next */ 41540000 = MAXPAGLN ) THEN /* iteration (4 lines for template*/ 41550000 DO; /* + hi nib + lo nib + texfld) .. */ 41560000 LASTROW = LASTROW + ONE; /* ..advance to next print line */ 41570000 OUTBUF(LASTROW) /* ..and fill it */ 41580000 = OUTBUF(MAXPAGLN+1); /* ..with the row template only */ 41590000 END; 41600000 41610000 IF( LASTROW+LCT+2 /* If insufficient room for next */ 41620000 = MAXPAGLN ) THEN /* iteration (4 lines for template*/ 41630000 DO; /* + text + hi nib + lo nib) .. */ 41640000 LASTROW = LASTROW + ONE; /* ..advance to next print line */ 41650000 OUTBUF(LASTROW) /* ..and fill it */ 41660000 = OUTBUF(MAXPAGLN+1); /* ..with the row template only */ 41670000 END; 41680000 41690000 IF( LASTROW+LCT+1 /* If insufficient room for next */ 41700000 = MAXPAGLN ) THEN /* iteration (4 lines for template*/ 41710000 DO; /* + text + hi nib + lo nib) .. */ 41720000 LASTROW = LASTROW + ONE; /* ..advance to next print line */ 41730000 OUTBUF(LASTROW) /* ..and fill it */ 41740000 = OUTBUF(MAXPAGLN+1); /* ..with the row template only */ 41750000 END; 41760000 41770000 END; /* IF HEX_DISPLAY = YES THEN DO */ 41780000 /* -- end @34 */ 41790000 41800000 $TRACE ('CONROW OUT'); 41810000 END CONROW; 41820000 41830000 %PAGE; 41840000 41850000 /*******************************************************************/ 41860000 /* PROCEDURE TO PRINT RESULTS OF A SELECT STATEMENT */ 41870000 /*******************************************************************/ 41880000 41890000 SELRES: PROCEDURE; 41900000 41910000 DCL 41920000 HOFFSET FIXED BIN(15) /* VARIABLE USED TO CENTER HEADERS */ 41930000 INIT(0), 41940000 OFFSET FIXED BIN(15) /* VARIABLE USED TO CENTER OUTPUT */ 41950000 INIT(0), 41960000 FMTLEN FIXED BIN(15) /* LENGTH OF AREA TO OUTPUT */ 41970000 INIT(0), 41980000 STARTROW FIXED BIN(15) /* STARTING ROW IN OUTBUF */ 41990000 INIT(0), 42000000 STARTC FIXED BIN(15) /* STARTING CHARACTER IN OUTBUF */ 42010000 INIT(0), 42020000 STARTI FIXED BIN(15) /* STARTING CHARACTER INDEX */ 42030000 INIT(0), 42040000 HENDC FIXED BIN(15) /* ENDING CHARACTER OF HEADING */ 42050000 INIT(0), 42060000 ENDC FIXED BIN(15) /* ENDING CHARACTER IN OUTBUF */ 42070000 INIT(0), 42080000 FIRST BIT(1) /* FIRST TIME FLAG */ 42090000 INIT('0'B), 42100000 LPAGE PIC '9' /* ADDITIONAL PAGE # FOR LRGE FLDS */ 42110000 INIT(0); 42120000 42130000 $TRACE ('SELRES IN') DATA(LASTCOL,LASTROW); 42140000 42150000 /*******************************************************************/ 42160000 /* DRAW FINAL HORIZONTAL LINE */ 42170000 /*******************************************************************/ 42180000 42190000 LASTROW=LASTROW+ONE; /* GET TO THE NEXT LINE */ 42200000 OUTBUF(LASTROW)=OUTBUF(THREE); /* COPY HORIZONTAL LINE */ 42210000 42220000 %PAGE; 42230000 42240000 /*******************************************************************/ 42250000 /* PRINT THE OUTPUT BUFFER BY PARTITIONS */ 42260000 /*******************************************************************/ 42270000 42280000 STARTROW = HEADEND + ONE; /* CALCULATE BEGINNING ROW NUMBER */ 42290000 FIRST = YES; /* INITIALIZE FIRST TIME FLAG */ 42300000 DO K=ONE TO NPART; /* OUTPUT THE HORIZONTAL PARTS */ 42310000 LPAGE = ZERO; /* INIT LARGE FIELD PAGE CTR */ 42320000 ENDC = COLSTART(PARTBEG(K)) - THREE; /* INIT END VALUE. ENSURE */ 42330000 /* COL SEPARATOR IS PRINTED */ 42340000 42350000 /*****************************************************************/ 42360000 /* PRINT OUT THE BUFFER IN A SERIES OF MAXIMUM PAGE WIDTH PAGE */ 42370000 /* LENGTHS. THIS PROCESS IS USED TO PRINT NORMAL AND LARGE */ 42380000 /* SIZED COLUMNS (> 125 CHAR) */ 42390000 /*****************************************************************/ 42400000 42410000 DO WHILE (ENDC+TWO < COLSTART(PARTBEG(K+ONE))); 42420000 $TRACE('PAGE LOOP') DATA(K,ENDC,TWO,COLSTART(PARTBEG(K+ONE)), 42430000 LASTCOL,STARTC); 42440000 42450000 /***************************************************************/ 42460000 /* CALCULATE BEGINNING AND ENDING PRINT CHARACTERS WIDTH PAGE */ 42470000 /***************************************************************/ 42480000 42490000 LINECNT = BEGREC - 1; /* INITIALIZE THE LINE COUNTER */ 42500000 STARTC = ENDC + ONE; /* CALCULATE THE STARTING CHAR. */ 42510000 ENDC = STARTC + MAXPAGWD-ONE;/* CALCULATE ENDING CHARACTER */ 42520000 42530000 /***************************************************************/ 42540000 /* KBW0104 */ 42550000 /* DETERMINING IF THE END COLUMN WAS GREATER THAN THE START */ 42560000 /* COLUMN OF THE NEXT PARTITION IS NOT A THOROUGH TEST. IT */ 42570000 /* MUST BE ENSURED THAT THE END COLUMN IS NOT EQUAL TO THE */ 42580000 /* START COLUMN OF THE NEXT PARTITION. IF IT IS, THEN THE */ 42590000 /* COLUMN RAVELING PRODUCES EXTRANEOUS CHARACTERS. */ 42600000 /***************************************************************/ 42610000 42620000 IF ENDC >= COLSTART(PARTBEG(K+ONE)) | ENDC > LASTCOL THEN 42630000 ENDC = COLSTART(PARTBEG(K+ONE))-TWO; 42640000 FMTLEN = ENDC - STARTC + ONE; /* CALCULATE FORMAT WIDTH */ 42650000 IF (FMTLEN > 2) THEN /* @BA31711 */ 42660000 DO; 42670000 IF ALIGNLHS = YES THEN /* ALIGN LEFT FLAG ON */ 42680000 OFFSET = ONE; /* ALIGN OUTPUT LEFT @54*/ 42690000 ELSE /* ALIGN LEFT FLAG OFF */ 42700000 OFFSET = MAX(TWO,MAXPAGWD-FMTLEN)/TWO; 42710000 /*************************************************************/ 42720000 /* PRINT OUT THE PAGE HEADINGS */ 42730000 /*************************************************************/ 42740000 42750000 IF LARGEFLD(K) THEN 42760000 DO; /* LARGE COLUMN */ 42770000 LPAGE = LPAGE + ONE; /* INCREMENT LARGE FIELD PAGE CTR */ 42780000 PAGEBUF = 'PAGE ' || PAGENO||'.'||LPAGE; 42790000 END; /* END LARGE COLUMN */ 42800000 ELSE 42810000 PAGEBUF= 'PAGE ' || PAGENO; /* PUT PAGE # IN BUFFER */ 42820000 42830000 IF (PAGENO = 1 | CMTONLY = YES) & FIRST THEN /* @33 */ 42840000 DO; /* FIRST PAGE OF RESULT */ 42850000 HENDC = ENDC; 42860000 IF ALIGNLHS = YES THEN /* ALIGN LEFT FLAG ON */ 42870000 HOFFSET = ONE; /* ALIGN OUTPUT LEFT @54*/ 42880000 ELSE /* ALIGN LEFT FLAG OFF */ 42890000 HOFFSET = MAX(TWO,MAXPAGWD-HENDC)/TWO; 42900000 PUT SKIP(2); 42910000 CALL PRINTBUF(STARTC,HENDC,ONE,TWO,HOFFSET,HENDC); 42920000 END; /* END FIRST PAGE OF RESULT */ 42930000 /* OF SELECT OUTPUT SO DON'T @33 */ 42940000 /* COUNT COMMENTS ANYMORE @33 */ 42950000 42960000 IF PRTPNO = YES THEN 42970000 DO; /* @33 */ 42980000 PUT PAGE EDIT(PAGEBUF) (COL(1),A); 42990000 PAGENO = PAGENO + ONE; /* INCR PAGE NUMBER @33 */ 43000000 END; /* @33 */ 43010000 43020000 /*************************************************************/ 43030000 /* PRINT OUT THE RESULTS */ 43040000 /*************************************************************/ 43050000 43060000 CALL PRINTBUF(STARTC,ENDC,COLTITL,HEADEND,OFFSET,FMTLEN); 43070000 CALL PRINTBUF(STARTC,ENDC,STARTROW,LASTROW,OFFSET,FMTLEN); 43080000 FIRST = NO; /* TURN OFF FIRST TIME INDICATOR */ 43090000 IF PRTPNO = NO THEN 43100000 PRTPNO = ¬PRTPNO; 43110000 END; /* END CALCULATION WIDTH */ 43120000 END; /* END PRINT MAXPAGWD PIECES */ 43130000 END; /* END PRINT VERTICAL PARTITIONS */ 43140000 43150000 %PAGE; 43160000 43170000 /*******************************************************************/ 43180000 /* CLEAR THE FINAL HORIZONTAL LINE OF OUTPUT */ 43190000 /*******************************************************************/ 43200000 OUTBUF(LASTROW) = BLANK; /* INSERT A BLANK */ 43210000 $TRACE ('SELRES OUT'); 43220000 END SELRES; /* OF SELRES PROCEDURE */ 43230000 43240000 43250000 %PAGE; 43260000 /********************************************************************* 43270000 * Test text after SQL comment (--) to see if it contains a functional* 43280000 * comment. * 43290000 *********************************************************************/ 43300000 PROCESS_FUNCTIONAL_COMMENT: PROC( INPUT_BUFFER, START_POS ); 43310000 43320000 DCL INPUT_BUFFER( 132 ) CHAR( 01 ); 43330000 DCL START_POS FIXED BIN( 15 ); 43340000 43350000 DCL TOKEN VARYING CHAR( 10 ) INIT( ' ' ); 43360000 43370000 DCL FIRST_TOKEN BIT( 01 ) INIT( '0'B );43380000 DCL FUNCTIONAL_COMMENT_ERROR BIT( 01 ) INIT( '0'B );43390000 43400000 /******************************************************************* 43410000 * Initialize * 43420000 *******************************************************************/ 43430000 FIRST_TOKEN = YES; 43440000 FUNCTIONAL_COMMENT_ERROR = NO; 43450000 TOKEN = GET_NEXT_TOKEN( INPUT_BUFFER, START_POS ); 43460000 /******************************************************************* 43470000 * Analyze the token: Is it --#SET? * 43480000 *******************************************************************/ 43490000 IF( TOKEN = '--#SET' ) THEN 43500000 DO WHILE( START_POS <= INPUTL /* Not at end of buffer*/ 43510000 & TOKEN ¬= '' /* and have a token */ 43520000 & ¬FUNCTIONAL_COMMENT_ERROR ); /* and not an error */ 43530000 TOKEN = GET_NEXT_TOKEN( INPUT_BUFFER,START_POS ); 43540000 SELECT( TOKEN ); 43550000 WHEN( '' ) 43560000 /*********************************************************** 43570000 * No token returned: OK except right after --#SET * 43580000 ***********************************************************/ 43590000 IF( FIRST_TOKEN ) THEN /* Nothing after #SET */ 43600000 DO; 43610000 FUNCTIONAL_COMMENT_ERROR = YES; 43620000 CALL REPORT_FUNCTIONAL_COMMENT_ERROR( '--#SET',TOKEN ); 43630000 END; 43640000 WHEN( 'ROWS_FETCH' ) 43650000 /*********************************************************** 43660000 * Reset number of rows to be fetched from result set * 43670000 ***********************************************************/ 43680000 DO; 43690000 TOKEN = GET_NEXT_TOKEN( INPUT_BUFFER, START_POS ); 43700000 IF( TOKEN = '' ) THEN 43710000 FUNCTIONAL_COMMENT_ERROR = YES; 43720000 ELSE IF( TOKEN = '-1' ) THEN 43730000 ROWS_FETCH = -1; 43740000 ELSE IF( VERIFY(TOKEN,'0123456789') = 0 ) THEN 43750000 ROWS_FETCH = TOKEN; 43760000 ELSE 43770000 FUNCTIONAL_COMMENT_ERROR = YES; 43780000 IF( FUNCTIONAL_COMMENT_ERROR = YES ) THEN 43790000 CALL REPORT_FUNCTIONAL_COMMENT_ERROR( 'ROWS_FETCH', 43800000 TOKEN ); 43810000 END; /* WHEN( 'ROWS_FETCH' ) */ 43820000 WHEN( 'ROWS_OUT' ) 43830000 /*********************************************************** 43840000 * Reset number of rows to be outputted * 43850000 ***********************************************************/ 43860000 DO; 43870000 TOKEN = GET_NEXT_TOKEN( INPUT_BUFFER, START_POS ); 43880000 IF( TOKEN = '' ) THEN 43890000 FUNCTIONAL_COMMENT_ERROR = YES; 43900000 ELSE IF( TOKEN = '-1' ) THEN 43910000 ROWS_OUT = -1; 43920000 ELSE IF( VERIFY(TOKEN,'0123456789') = 0 ) THEN 43930000 ROWS_OUT = TOKEN; 43940000 ELSE 43950000 FUNCTIONAL_COMMENT_ERROR = YES; 43960000 IF( FUNCTIONAL_COMMENT_ERROR = YES ) THEN 43970000 CALL REPORT_FUNCTIONAL_COMMENT_ERROR( 'ROWS_OUT', 43980000 TOKEN ); 43990000 END; /* WHEN( 'ROWS_OUT' ) */ 44000000 WHEN( 'TERMINATOR' ) 44010000 /*********************************************************** 44020000 * Reset SQL statement terminator * 44030000 ***********************************************************/ 44040000 DO; 44050000 TOKEN = GET_NEXT_TOKEN( INPUT_BUFFER, START_POS ); 44060000 IF( LENGTH(TOKEN) = 1 /* If token = 1 byte */ 44070000 & VERIFY(TOKEN,',"_()''')¬= 0) THEN /* and valid char */ 44080000 SQLTERM = TOKEN; /* ..reset SQL term */ 44090000 ELSE /* Otherwise */ 44100000 DO; 44110000 FUNCTIONAL_COMMENT_ERROR = YES; 44120000 CALL REPORT_FUNCTIONAL_COMMENT_ERROR( 'TERMINATOR', 44130000 TOKEN ); 44140000 END; 44150000 END; /* WHEN( 'TERMINATOR' ) */ 44160000 WHEN( 'TOLARTHWRN' ) 44160490 /***********************************************************44160980 * Reset the tolerate arithmetic warning *44161470 ***********************************************************/44161960 DO; 44162450 TOKEN = GET_NEXT_TOKEN( INPUT_BUFFER, START_POS ); 44162940 IF( TOKEN = '' ) THEN 44163430 FUNCTIONAL_COMMENT_ERROR = YES; 44163920 ELSE IF(TOKEN = 'YES' ) THEN 44164410 TOLARTHWRN = YES; 44164900 ELSE IF( TOKEN = 'NO' ) THEN 44165390 TOLARTHWRN = NO; 44165880 ELSE 44166370 FUNCTIONAL_COMMENT_ERROR = YES; 44166860 IF( FUNCTIONAL_COMMENT_ERROR = YES ) THEN 44167350 CALL REPORT_FUNCTIONAL_COMMENT_ERROR( 'TOLARTHWRN', 44167840 TOKEN ); 44168330 END; /* WHEN( 'TOLARTHWRN' ) */ 44168820 WHEN( 'TOLWARN' ) 44168901 /*********************************************************** 44169001 * Reset the tolerate arithmetic warning * 44169101 ***********************************************************/ 44169201 DO; 44169301 TOKEN = GET_NEXT_TOKEN( INPUT_BUFFER, START_POS ); 44169401 IF( TOKEN = '' ) THEN 44169501 FUNCTIONAL_COMMENT_ERROR = YES; 44169601 ELSE IF(TOKEN = 'YES' ) THEN 44169701 TOLWARN = YES; 44169801 ELSE IF( TOKEN = 'NO' ) THEN 44169901 TOLWARN = NO; 44169911 ELSE 44169921 FUNCTIONAL_COMMENT_ERROR = YES; 44169931 IF( FUNCTIONAL_COMMENT_ERROR = YES ) THEN 44169941 CALL REPORT_FUNCTIONAL_COMMENT_ERROR( 'TOLWARN', 44169951 TOKEN ); 44169961 END; /* WHEN( 'TOLWARN' ) */ 44169971 OTHERWISE 44170000 DO; 44180000 FUNCTIONAL_COMMENT_ERROR = YES; 44190000 CALL REPORT_FUNCTIONAL_COMMENT_ERROR( 'function',TOKEN ); 44200000 END; /* OTHERWISE */ 44210000 END; /* SELECT( TOKEN ) */ 44220000 FIRST_TOKEN = NO; 44230000 END; /* DO WHILE( START_POS >= INPUTL & ¬FUNCTIONAL_COMMENT_ */ 44240000 /******************************************************************* 44250000 * Stop run if an error was detected in a functional commnent * 44260000 *******************************************************************/ 44270000 IF( FUNCTIONAL_COMMENT_ERROR = YES ) THEN 44280000 DO; 44290000 RETCODE = SEVERE; 44300000 GOTO STOPRUN; 44310000 END; 44320000 44330000 END PROCESS_FUNCTIONAL_COMMENT; 44340000 44350000 44360000 %PAGE; 44370000 /********************************************************************* 44380000 * Look for and return the next token in INPUT_BUFFER * 44390000 *********************************************************************/ 44400000 GET_NEXT_TOKEN: PROC( INPUT_BUFFER, START_POS ) 44410000 RETURNS( VARYING CHAR(10) ); 44420000 44430000 DCL INPUT_BUFFER( 132 ) CHAR( 01 ); 44440000 DCL START_POS FIXED BIN( 15 ); 44450000 DCL TOKEN VARYING CHAR( 10 ) INIT( ' ' ); 44460000 44470000 /******************************************************************* 44480000 * Locate the next non-blank byte in the INPUT_BUFFER * 44490000 *******************************************************************/ 44500000 DO START_POS = START_POS TO INPUTL 44510000 WHILE( INPUT_BUFFER(START_POS) = BLANK ); 44520000 END; 44530000 /******************************************************************* 44540000 * If not at the end of the buffer, build the token from the first * 44550000 * non-blank byte to the next blank byte (exclusive) * 44560000 *******************************************************************/ 44570000 TOKEN = ''; 44580000 IF( START_POS <= INPUTL ) THEN 44590000 DO START_POS = START_POS TO INPUTL 44600000 WHILE( INPUT_BUFFER(START_POS) ¬= BLANK ); 44610000 TOKEN = TOKEN || INPUT_BUFFER(START_POS); 44620000 END; 44630000 44640000 RETURN( TOKEN ); 44650000 44660000 END GET_NEXT_TOKEN; 44670000 44680000 44690000 44700000 %PAGE; 44710000 /********************************************************************* 44720000 * Called to generate a diagnostic message when a functional comment * 44730000 * error is detected. * 44740000 *********************************************************************/ 44750000 REPORT_FUNCTIONAL_COMMENT_ERROR: PROC( COMMAND, TOKEN ); 44760000 44770000 DCL COMMAND VARYING CHAR( 10 ); 44780000 DCL TOKEN VARYING CHAR( 10 ); 44790000 44800000 /******************************************************************* 44810000 * Generate the message * 44820000 *******************************************************************/ 44830000 PUT SKIP; 44840000 PUT SKIP LIST( '*** ERROR **************************' 44850000 || '************************************' ); 44860000 PUT SKIP LIST( '* SSMTEP2 halted due to a functional ' 44870000 || 'comment (--#SET) statement error:' ); 44880000 PUT SKIP LIST( '* Invalid value, "' 44890000 || TOKEN 44900000 || '", specified for ' 44910000 || COMMAND 44920000 || '.' ); 44930000 PUT SKIP LIST( REPEAT('*',71) ); 44940000 44950000 END REPORT_FUNCTIONAL_COMMENT_ERROR; 44960000 44970000 44980000 %PAGE; 44990000 45000000 /*******************************************************************/ 45010000 /* PROCEDURE TO PRINT THE OUTPUT BUFFERS */ 45020000 /*******************************************************************/ 45030000 45040000 PRINTBUF: PROCEDURE(STARTCOL,ENDCOL,STARTROW,ENDROW,OF,FMTLEN); 45050000 45060000 DCL 45070000 STARTCOL FIXED BIN(15), 45080000 ENDCOL FIXED BIN(15), 45090000 STARTROW FIXED BIN(15), 45100000 ENDROW FIXED BIN(15), 45110000 OF FIXED BIN(15), 45120000 FMTLEN FIXED BIN(15); 45130000 DCL HEX_DISPLAY_LINE FIXED BIN(31) INIT(0); /*@34*/ 45140000 45150000 $TRACE ('PRINTBUF IN') DATA(STARTCOL,ENDCOL,STARTROW,ENDROW,OF, 45160000 FMTLEN,HEADEND,LASTROW); 45170000 45180000 DO KNT=STARTROW TO ENDROW; /* FOR EACH LINE OF TEXT PREPARED */ 45190000 IF (KNT <= HEADEND) | (KNT = LASTROW) THEN /* HDR OR LAST ROW */ 45200000 PUT EDIT(SUBSTR(OUTBUF(KNT),STARTCOL,ENDCOL)) 45210000 (SKIP,COL(OF+MAXROW#LN),X(1),A(FMTLEN)); 45220000 /* -- begin @34 */ 45230000 ELSE IF HEX_DISPLAY = NO THEN /* NORMAL ROW: 1 PRINT LINE/ROW */ 45240000 DO; 45250000 /* -- end @34 */ 45260000 LINECNT = LINECNT + 1; 45270000 PUT EDIT(LINECNT,HUNDER,SUBSTR(OUTBUF(KNT),STARTCOL,ENDCOL)) 45280000 (SKIP,COL(OF),F(MAXROW#LN,0),A(1),A(FMTLEN)); 45290000 /* -- begin @34 */ 45300000 END; 45310000 ELSE /* HEX_DISPLAY = YES */ /* HEX OUTPUT: 4 PRINT LINES/ROW */ 45320000 SELECT(HEX_DISPLAY_LINE); 45330000 WHEN( 0,1 ) /* PUT ROW NO. ON 1ST PRINT LINE */ 45340000 DO; 45350000 LINECNT = LINECNT + 1; 45360000 PUT EDIT(LINECNT,HUNDER, 45370000 SUBSTR(OUTBUF(KNT),STARTCOL,ENDCOL)) 45380000 (SKIP,COL(OF),F(MAXROW#LN,0),A(1),A(FMTLEN)); 45390000 HEX_DISPLAY_LINE = 2; 45400000 END; 45410000 WHEN( 2,3 ) /* NO ROW NO. ON PRINT LINES 2,3 */ 45420000 DO; 45430000 PUT EDIT(REPEAT( ' ',MAXROW#LN+1 ), 45440000 SUBSTR(OUTBUF(KNT),STARTCOL,ENDCOL)) 45450000 (SKIP,COL(OF),A(MAXROW#LN+1),A(FMTLEN)); 45460000 HEX_DISPLAY_LINE = HEX_DISPLAY_LINE + 1; 45470000 END; 45480000 OTHERWISE /* NO ROW NO. ON PRINT LINE 4 */ 45490000 DO; 45500000 PUT EDIT(REPEAT( ' ',MAXROW#LN+1 ), 45510000 SUBSTR(OUTBUF(KNT),STARTCOL,ENDCOL)) 45520000 (SKIP,COL(OF),A(MAXROW#LN+1),A(FMTLEN)); 45530000 45540000 IF KNT+4 <= LASTROW THEN/* IF ROOM FOR 4 MORE PRINT LINES */ 45550000 HEX_DISPLAY_LINE = 1;/* ..SET TRIGGER FOR NEXT ROW NO. */ 45560000 END; 45570000 END; /* SELECT( HEX_DISPLAY_LINE ) */ 45580000 /* -- end @34 */ 45590000 END; /* END FOR EACH LINE OF OUTPUT */ 45600000 45610000 $TRACE ('PRINTBUF OUT'); 45620000 END PRINTBUF; 45630000 45640000 %PAGE; 45650000 45660000 /*******************************************************************/ 45670000 /* PROCEDURE TO PRINT THE SQLCA ERROR INDICATION AND CLEAR OUT THE */ 45680000 /* SQLCA. OUTPUT MOST OF THE DATA ON AN EXCEPTION BASIS */ 45690000 /*******************************************************************/ 45700000 45710000 PRINTCA: PROCEDURE; 45720000 45730000 /*******************************************************************/ 45740000 /* *** SEVERE SQL ERRORS *** */ 45750000 /* */ 45760000 /* IF ONE OF THESE ERRORS ARE ENCOUNTERED, STOP PROCESSING. */ 45770000 /* THIS LIST MUST BE KEPT AS UP TO DATE AS POSSIBLE. */ 45780000 /*******************************************************************/ 45790000 45800000 DCL 45810000 FATALCODE(11) FIXED BIN(15) INIT 45820000 (-804, /* BAD PARMLIST OR SQLDA */ 45830000 -805, /* NO PLAN FOR APPLICATION PGM */ 45840000 -902, /* SYSTEM ERROR */ 45850000 -904, /* UNAVAILABLE RESOURCE */ 45860000 -906, /* PRIOR SQL ERROR DISABLED */ 45870000 /* FURTHER EXECUTION */ 45880000 -911, /* ROLLBACK DUE TO DEADLOCK */ 45890000 -913, /* FAILURE DUE TO DEADLOCK */ 45900000 -922, /* CONNECTION NOT AUTHORIZED */ 45910000 -923, /* CONNECTION NOT ESTABLISHED */ 45920000 -924, /* DB2 CONNECTION INTERNAL ERR */ 45930000 -927) STATIC; /* LANGUAGE INTERFACE WAS */ 45940000 /* CALLED WHEN CONNECTING ENVT */ 45950000 /* WAS NOT ESTABLISHED */ 45960000 45970000 $TRACE ('PRINTCA IN') PUTTYPE(LIST) DATA(SQLCA); 45980000 45990000 /*******************************************************************/ 46000000 /* PROCESS SQL OUTPUT MESSAGE */ 46010000 /*******************************************************************/ 46020000 46030000 PUT SKIP EDIT (' RESULT OF SQL STATEMENT: ') (COL(1), A(29)); 46040000 CALL DSNTIAR ( SQLCA, MESSAGE, DSNTIARW); /* FORMAT ANY MESSAGES */ 46050000 IF PLIRETV ¬= ZERO THEN /* IF THE RETURN CODE ISN'T ZERO */ 46060000 DO; /* ISSUE AN ERROR MESSAGE */ 46070000 PUT EDIT (' RETURN CODE ', PLIRETV, 46080000 ' FROM MESSAGE ROUTINE DSNTIAR.') 46090000 (COL(1), A(13), F(8), A(30)); /* ISSUE THE MESSAGE */ 46100000 RETCODE = SEVERE; /* SET THE RETURN CODE */ 46110000 END; /* END ISSUE AN ERROR MESSAGE */ 46120000 46130000 DO I = ONE TO MSGBLEN /* PRINT OUT THE DSNTIAR BUFFER */ 46140000 WHILE (MESSAGET(I) ¬= BLANK); /* PRINT NON BLANK LINES */ 46150000 PUT EDIT ( MESSAGET(I) ) (COL(1), A(DSNTIARW)); 46160000 END; 46170000 46180000 /*******************************************************************/ 46190000 /* PRINT THE NUMBER OF ROWS UPDATED MESSAGE */ 46200000 /*******************************************************************/ 46210000 46220000 IF SQLCODE = ZERO THEN 46230000 DO; /* DELETE,UPDATE,INSERT COMMAND? */ 46240000 /* PRINT # ROWS AFFECTED */ 46250000 IF (COMMAND = 'DELETE ' | COMMAND = 'UPDATE ' | 46260000 COMMAND = 'INSERT ') 46270000 & WRNING = NO THEN 46280000 DO; 46290000 IF (SQLERRD(THREE) = -1 & (COMMAND = 'DELETE ')) THEN /*@28*/ 46300000 PUT EDIT ('SUCCESSFUL DELETE OF ALL ROWS') (COL(1), A); 46310000 ELSE 46320000 PUT EDIT ('SUCCESSFUL ', COMMAND, ' OF ', 46330000 SQLERRD(THREE), ' ROW(S)') 46340000 ( COL(1), A(11), A(9), A(4), F(8), A(7)); 46350000 END; 46360000 ELSE /* PRINT SUCCESSFUL EXECUTION MSG */ 46370000 PUT EDIT (COMMAND, ' SUCCESSFUL') (COL(1), A(9), A(11)); 46380000 END; /* END SQLCODE = 0 */ 46390000 46400000 %PAGE; 46410000 46420000 /*******************************************************************/ 46430000 /* COUNT ERRORS AND TERMINATE IF THE COUNT EXCEEDS THE MAXIMUM */ 46440000 /* ERROR COUNT OR SOME FATAL ERRORS ARE FOUND */ 46450000 /*******************************************************************/ 46460000 46470000 IF SQLCODE < ZERO THEN 46480000 DO; /* SQLCODE < 0 */ 46490000 ERRCOUNT = ERRCOUNT + ONE; /* INCREMENT COUNT OF ERRORS */ 46500000 IF ERRCOUNT > MAXERRORS THEN 46510000 DO; /* ERRORS > MAX */ 46520000 RETCODE = RETERR; /* SET RETURN CODE TO 8 */ 46530000 GOTO STOPRUN; /* STOP PROGRAM EXECUTION */ 46540000 END; /* END ERRORS > MAX */ 46550000 ELSE IF CREATE_TRIGGER_STMT THEN 46560000 DO; /* ERROR ON CREATE TRIGGER STMT? */ 46570000 RETCODE = RETERR; /* ..SET RETURN CODE TO 8 */ 46580000 GOTO STOPRUN; /* ..STOP PROGRAM EXECUTION */ 46590000 END; 46600000 ELSE 46610000 DO I = ONE TO DIM(FATALCODE,1); /* SEVERE SQL ERRORS? */ 46620000 IF SQLCODE = FATALCODE(I) THEN 46630000 DO; /* SEVERE SQL ERROR ENCOUNTERED */ 46640000 RETCODE = RETERR; /* SET RETURN CODE TO 8 */ 46650000 GOTO STOPRUN; /* STOP PROGRAM EXECUTION */ 46660000 END; /* END SEVERE SQL ERROR */ 46670000 END; /* END DO LOOP */ 46680000 END; /* END IF SQLCODE < 0 */ 46690000 46700000 $TRACE ('PRINTCA OUT'); 46710000 END PRINTCA; 46720000 46730000 STOPRUN: 46740000 CALL PLIRETC(RETCODE); /* SET PLI RETURN CODE */ 46750000 END SSMTEP2; /* END DSNTEP2 */ 46760000