MODULE KMT_FH_MODULE; @******************************************************************************@ @* *@ @* Mode definitions *@ @* *@ @******************************************************************************@ MODE CTM_ACCESS_1 IS GPROC ( REF () CTM_PARAMETER_PAIRS, RESPONSE); MODE CTM_ACCESS_2 IS GPROC ( RESPONSE); MODE CTM_PARAMETER_VALUES IS ANY ( INT INT_VALUE, LONG WORD LONG_WORD_VALUE, REF INT REF_INT_VALUE, REF () BYTE STRING_VALUE, REF CTM_ACCESS_1 REF_ACCESS_1_VALUE, REF CTM_ACCESS_2 REF_ACCESS_2_VALUE); MODE CTM_PARAMETER_PAIRS IS WSTRUCT ( INT TYPE, CTM_PARAMETER_VALUES VALUE); MODE KMT_TRACE_FLAGS_S IS WORD STRUCT ( BIT PH_TRACING, PP_TRACING, FH_TRACING, DH_TRACING, 28-BIT SPARE); MODE KMT_FH_FILE_OPTIONS_S IS BYTE STRUCT ( BIT APPEND_CREATE, APPEND, REPLACE_CREATE, REPLACE, CREATE_APPEND, CREATE_REPLACE, CREATE, READ); MODE KMT_FH_RECORD_DETAILS_S IS STRUCT ( BOOL FILE_OPEN, NEW_RECORD, END_OF_FILE, WORD TEXT_TYPE, @ 0 = EBCDIC @ @ 1 = IA5 @ @ 2 = BINARY @ INT MAX_RECORD_LENGTH, RECORD_LENGTH, (4098) BYTE RECORD); @ Maximum record size of 4096 @ @ plus 2 bytes for CRLF pair @ @ when constructing output @ @ records @ MODE KMT_FH_FILE_STATISTICS_S IS STRUCT ( INT INPUT_TOTAL, INT OUTPUT_TOTAL); MODE KMT_FH_FILE_DETAILS_S IS STRUCT ( LONG WORD FILE_CURRENCY, BOOL NEW_FILE, KMT_FH_FILE_OPTIONS_S FILE_OPTION, CTM_ACCESS_1 ACCESS_1, CTM_ACCESS_2 ACCESS_2); MODE KMT_MTM_VALUES IS ANY ( LONG WORD LW_VALUE, LONG INT LI_VALUE, REF WORD RW_VALUE, REF INT RI_VALUE, REF LONG WORD RLW_VALUE, REF LONG INT RLI_VALUE, REF () BYTE RVB_VALUE, REF () REF () BYTE RVRVB_VALUE); ***PAGE @******************************************************************************@ @* *@ @* External procedure references *@ @* *@ @******************************************************************************@ EXT () PROC (REF LONG WORD, @ FILE_CURRENCY @ REF () BYTE, @ FILE_LOCAL_NAME @ REF () BYTE, @ FULL_FILE_NAME @ RESPONSE @ RESPONSE @ ) CTM_ASSIGN_FILE; EXT () PROC (REF LONG WORD, @ NEW_FILE_CURRENCY @ REF () BYTE, @ NEW_FILE_LOCAL_NAME @ LONG WORD, @ FILE_CURRENCY, @ REF () BYTE, @ FILE_LOCAL_NAME @ REF () BYTE, @ FULL_FILE_NAME @ LONG WORD, @ DESCRIPTION_CURRENCY @ REF () BYTE, @ DESCRIPTION_LOCAL_NAME @ REF () BYTE, @ FULL_DESCRIPTION_NAME @ INT, @ INITIAL_SIZE @ INT, @ MAXIMUM_SIZE @ INT, @ OPTION @ RESPONSE @ RESPONSE @ ) CTM_GET_FILE; EXT () PROC (LONG WORD, @ FILE_CURRENCY @ REF () BYTE, @ FILE_LOCAL_NAME @ RESPONSE @ RESPONSE @ ) CTM_SAVE_FILE; EXT () PROC (LONG WORD, @ FILE_CURRENCY @ REF () BYTE, @ FILE_LOCAL_NAME @ REF () BYTE, @ FULL_FILE_NAME @ REF () WORD, @ PROPERTIES @ RESPONSE @ RESPONSE @ ) CTM_READ_DESC; EXT () PROC (RESPONSE @ RESPONSE @ ) CTM_SCHEDULE; EXT () PROC (LONG WORD, @ FILE_CURRENCY @ REF () BYTE, @ FILE_LOCAL_NAME @ REF () CTM_PARAMETER_PAIRS, @ PARAMETER_PAIRS @ RESPONSE @ RESPONSE @ ) CTM_SELECT_RAM; EXT () PROC (LONG WORD, @ FILE_CURRENCY @ REF () BYTE, @ FILE_LOCAL_CURRENCY @ REF () BYTE, @ FULL_FILE_NAME @ REF INT, @ NAME_LENGTH @ RESPONSE @ RESPONSE @ ) CTM_GIVE_NAME; EXT PROC (INT, @ TYPE @ REF () KMT_MTM_VALUES @ PARAMS @ ) KMT_SP_LOG_TRACE_MESSAGE; EXT PROC (INT, @ RESULT_CODE @ WORD, @ DESTINATION @ REF () KMT_MTM_VALUES, @ PARAMS @ LONG WORD, @ PE_CONTINGENCY_MESSAGE @ BOOL, @ DUMP @ BOOL @ UNRECOVERABLE @ ) KMT_EH_LOG_ERROR; ***PAGE @******************************************************************************@ @* *@ @* External data references *@ @* *@ @******************************************************************************@ @ Constants: @ @ ********** @ ***LINES(4) @ Variables: @ @ ********** @ EXT () REF KMT_TRACE_FLAGS_S KMT_TRACE_FLAGS; EXT () REF KMT_FH_RECORD_DETAILS_S KMT_FH_RECORD_DETAILS; EXT () REF KMT_FH_FILE_STATISTICS_S KMT_FH_FILE_STATISTICS; ***LINES(4) @ Results: @ @ ******** @ ***LINES(4) ***PAGE @******************************************************************************@ @* *@ @* Static data declarations *@ @* *@ @******************************************************************************@ @ Constants: @ @ ********** @ ***LINES(4) @ Variables: @ @ ********** @ STATIC KMT_FH_FILE_DETAILS_S KMT_FH_FILE_DETAILS; ***LINES(4) @ Results: @ @ ******** @ ***LINES(4) ***PAGE @******************************************************************************@ @* *@ @* Procedure declarations *@ @* *@ @******************************************************************************@ GLOBAL STATIC () PROC KMT_FH_OPEN_FILE IS ( REF () BYTE FILE_NAME, WORD OPTION, RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to create (if required), assign and open the data *@ @* file specified by FILE_NAME for read or write access depending upon the *@ @* value of OPTION. *@ @* *@ @******************************************************************************@ BEGIN INT FC_CTM_FILE_ALREADY_EXISTS IS 9113, FC_CTM_FILE_DOES_NOT_EXIST IS 9114, FC_CTM_NEW_FILE_WARNING IS -44900; INT KMT_EH_SOFTWARE_ERROR IS 80101; REF LONG WORD FILE_CURRENCY IS KMT_FH_FILE_DETAILS.FILE_CURRENCY; REF KMT_FH_FILE_OPTIONS_S FILE_OPTION IS KMT_FH_FILE_DETAILS.FILE_OPTION; FILE_OPTION := (WORD: X'01') SCALE OPTION; IF ( IF FILE_OPTION.READ THEN @ Read @ CTM_ASSIGN_FILE (FILE_CURRENCY, NIL, FILE_NAME, RESULT) ELSE @ Write @ CTM_GET_FILE (FILE_CURRENCY, NIL, 0, NIL, FILE_NAME, 0, NIL, NIL, -1, -1, (IF (FILE_OPTION & X"0E") NE 0 THEN @ Create, create_replace or @ @ create_append @ 0 ELSE @ Replace, replace_create, @ @ append or append_create @ 2 FI), RESULT); IF (RESULT EQ 0) AND FILE_OPTION.CREATE THEN @ Create but file already @ @ exists @ RESULT := FC_CTM_FILE_ALREADY_EXISTS ELSF (RESULT EQ FC_CTM_NEW_FILE_WARNING) AND (FILE_OPTION & X"50" NE 0) THEN @ Replace or append but file @ @ does not exist @ RESULT := FC_CTM_FILE_DOES_NOT_EXIST FI FI; KMT_FH_FILE_DETAILS.NEW_FILE := (RESULT EQ FC_CTM_NEW_FILE_WARNING); RESULT LE 0 ) AND ( CTM_SCHEDULE (RESULT); RESULT LE 0 ) AND ( () CTM_PARAMETER_PAIRS PARAMETER_PAIRS := ((7, KMT_FH_RECORD_DETAILS.RECORD AS CTM_PARAMETER_VALUES.STRING_VALUE), (9, KMT_FH_RECORD_DETAILS.RECORD_LENGTH AS CTM_PARAMETER_VALUES.REF_INT_VALUE), (12, (IF FILE_OPTION.READ THEN @ Read @ 1 @ Select and read @ ELSE @ Write @ 2 @ Select and new write @ FI) AS CTM_PARAMETER_VALUES.INT_VALUE), (19, KMT_FH_FILE_DETAILS.ACCESS_2 AS CTM_PARAMETER_VALUES.REF_ACCESS_2_VALUE), (24, KMT_FH_FILE_DETAILS.ACCESS_1 AS CTM_PARAMETER_VALUES.REF_ACCESS_1_VALUE), (29, (IF (FILE_OPTION & X"C8") NE 0 THEN @ Append @ 3 @ End of file @ ELSE @ Read, create or replace @ 2 @ Beginning of file @ FI) AS CTM_PARAMETER_VALUES.INT_VALUE) ); CTM_SELECT_RAM (FILE_CURRENCY, NIL, PARAMETER_PAIRS, RESULT); RESULT LE 0 ) AND ( IF (FILE_OPTION & X"34") NE 0 THEN @ Replacing file, @ @ destroy file contents @ () CTM_PARAMETER_PAIRS PARAMETER_PAIRS := DISPLAY((0, 11 @ Extended destroy @ AS CTM_PARAMETER_VALUES.INT_VALUE) ); KMT_FH_FILE_DETAILS.ACCESS_1 (PARAMETER_PAIRS, RESULT) FI; RESULT LE 0 ) THEN WORD R_LEN IS LENGTH KMT_FH_RECORD_DETAILS.RECORD - 2; @ Allows for CRLF end of @ @ record terminator @ () WORD PROPERTIES := (104, @ Maximum record size @ 0, 0); KMT_FH_RECORD_DETAILS.MAX_RECORD_LENGTH := IF ( CTM_READ_DESC ( FILE_CURRENCY, NIL, NIL, PROPERTIES, RESULT); RESULT EQ 0 ) AND PROPERTIES(1) LT R_LEN THEN PROPERTIES(1) ELSE R_LEN FI FI; IF RESULT LE 0 THEN @ File opened successfully @ KMT_FH_RECORD_DETAILS.FILE_OPEN := TRUE; KMT_FH_RECORD_DETAILS.NEW_RECORD := TRUE; KMT_FH_RECORD_DETAILS.END_OF_FILE := FALSE; KMT_FH_FILE_STATISTICS := (0,0); RESULT := 0 @ Ignore warnings @ ELSE () @ Open error @ ( () BYTE PROC_NAME := "KMT_FH_OPEN_FILE"; () KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME AS KMT_MTM_VALUES.RVB_VALUE); KMT_FH_RECORD_DETAILS.FILE_OPEN := FALSE; KMT_EH_LOG_ERROR (RESULT, 2, PARAMS, 0, FALSE, FALSE); RESULT := KMT_EH_SOFTWARE_ERROR ) FI END; @ KMT_FH_OPEN_FILE @ ***PAGE GLOBAL STATIC () PROC KMT_FH_CLOSE_FILE IS ( RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to close the file previously opened by the *@ @* KMT_FH_OPEN_FILE. *@ @* *@ @******************************************************************************@ BEGIN INT KMT_EH_SOFTWARE_ERROR IS 80101; REF BOOL FILE_OPEN IS KMT_FH_RECORD_DETAILS.FILE_OPEN; RESULT := 0; IF FILE_OPEN THEN @ File open, close it @ INT RC; () CTM_PARAMETER_PAIRS PARAMETER_PAIRS := DISPLAY((0, 12 @ Deselect RAM @ AS CTM_PARAMETER_VALUES.INT_VALUE) ); @ When receiving a binary @ @ file, must output last @ @ record to file @ IF KMT_FH_FILE_DETAILS.FILE_OPTION.READ OR KMT_FH_RECORD_DETAILS.TEXT_TYPE NE 2 OR KMT_FH_RECORD_DETAILS.NEW_RECORD THEN @ File open for reading, not @ @ a binary file or @ RC := 0 @ no record to output @ ELSE @ Flush remaining buffer @ KMT_FH_WRITE (RC) FI; IF ( KMT_FH_FILE_DETAILS.ACCESS_1 (PARAMETER_PAIRS, RESULT); RESULT GT 0 ) THEN () @ Close error @ ( () BYTE PROC_NAME := "KMT_FH_CLOSE_FILE"; () KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME AS KMT_MTM_VALUES.RVB_VALUE); KMT_EH_LOG_ERROR (RESULT, 2, PARAMS, 0, FALSE, FALSE); RESULT := KMT_EH_SOFTWARE_ERROR ) ELSE RESULT := RC FI; FILE_OPEN := FALSE FI END; @ KMT_FH_CLOSE_FILE @ ***PAGE GLOBAL STATIC () PROC KMT_FH_READ IS ( RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to read a record from the file previously opened *@ @* (for read access) by the procedure KMT_FH_OPEN_FILE. *@ @* The record and length are returned in the areas *@ @* KMT_FH_RECORD_DETAILS.RECORD and KMT_FH_RECORD.DETAILS.RECORD_LENGTH *@ @* respectively. *@ @* *@ @******************************************************************************@ BEGIN INT DML_READ_PSEUDO_NODE IS 9034; INT KMT_FH_RECORD_IN_MSG IS 200, KMT_EH_SOFTWARE_ERROR IS 80101, KMT_FH_RECORD_TOO_BIG IS 80200; REF INT RECORD_LENGTH IS KMT_FH_RECORD_DETAILS.RECORD_LENGTH; REF () BYTE RECORD IS KMT_FH_RECORD_DETAILS.RECORD; IF ( KMT_FH_FILE_DETAILS.ACCESS_2 (RESULT); RESULT LE 0 ) THEN @ Read successful @ REF INT MAX_RECORD_LENGTH IS KMT_FH_RECORD_DETAILS.MAX_RECORD_LENGTH; BOOL TRACING IS KMT_TRACE_FLAGS.FH_TRACING; REF INT STATISTICS IS KMT_FH_FILE_STATISTICS.INPUT_TOTAL; STATISTICS := STATISTICS + 1; IF RECORD_LENGTH GT MAX_RECORD_LENGTH THEN () @ Record exceeds buffer size @ ( () KMT_MTM_VALUES PARAMS := (RECORD_LENGTH AS KMT_MTM_VALUES.RI_VALUE, MAX_RECORD_LENGTH AS KMT_MTM_VALUES.RI_VALUE); RESULT := KMT_FH_RECORD_TOO_BIG; KMT_EH_LOG_ERROR (RESULT, 2, PARAMS, 0, FALSE, FALSE); RECORD_LENGTH := MAX_RECORD_LENGTH ) ELSE @ Ignore warnings @ RESULT := 0 FI; IF TRACING THEN () ( () KMT_MTM_VALUES PARAMS := DISPLAY(RECORD(SIZE RECORD_LENGTH) AS KMT_MTM_VALUES.RVB_VALUE); KMT_SP_LOG_TRACE_MESSAGE (KMT_FH_RECORD_IN_MSG, PARAMS) ) FI ELSF ( RECORD_LENGTH := 0; RESULT EQ DML_READ_PSEUDO_NODE ) THEN @ End of file reached @ SKIP ELSE () @ Read error @ ( () BYTE PROC_NAME := "KMT_FH_READ"; () BYTE ERROR_TEXT := " WHILST READING FROM FILE"; () KMT_MTM_VALUES PARAMS := (PROC_NAME AS KMT_MTM_VALUES.RVB_VALUE, ERROR_TEXT AS KMT_MTM_VALUES.RVB_VALUE); KMT_EH_LOG_ERROR (RESULT, 2, PARAMS, 0, FALSE, FALSE); RESULT := KMT_EH_SOFTWARE_ERROR ) FI END; @ KMT_FH_READ @ ***PAGE GLOBAL STATIC () PROC KMT_FH_WRITE IS ( RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to write a record to the file previously opened *@ @* (for write access) by the procedure KMT_FH_OPEN_FILE. *@ @* The record to be output and length are contained in the areas *@ @* KMT_FH_RECORD_DETAILS.RECORD and KMT_FH_RECORD_DETAILS.RECORD_LENGTH *@ @* respectively. *@ @* *@ @******************************************************************************@ BEGIN INT KMT_FH_RECORD_OUT_MSG IS 201, KMT_EH_SOFTWARE_ERROR IS 80101; IF ( KMT_FH_FILE_DETAILS.ACCESS_2 (RESULT); RESULT LE 0 ) THEN @ Write successful @ BOOL TRACING IS KMT_TRACE_FLAGS.FH_TRACING; REF INT STATISTICS IS KMT_FH_FILE_STATISTICS.OUTPUT_TOTAL; STATISTICS := STATISTICS + 1; IF TRACING THEN () ( () KMT_MTM_VALUES PARAMS := DISPLAY( KMT_FH_RECORD_DETAILS.RECORD(SIZE KMT_FH_RECORD_DETAILS.RECORD_LENGTH) AS KMT_MTM_VALUES.RVB_VALUE); KMT_SP_LOG_TRACE_MESSAGE (KMT_FH_RECORD_OUT_MSG, PARAMS) ) FI; RESULT := 0 @ Ignore warnings @ ELSE () @ Write error @ ( () BYTE PROC_NAME := "KMT_FH_WRITE"; () BYTE ERROR_TEXT := " WHILST WRITING TO FILE"; () KMT_MTM_VALUES PARAMS := (PROC_NAME AS KMT_MTM_VALUES.RVB_VALUE, ERROR_TEXT AS KMT_MTM_VALUES.RVB_VALUE); KMT_EH_LOG_ERROR (RESULT, 2, PARAMS, 0, FALSE, FALSE); RESULT := KMT_EH_SOFTWARE_ERROR ) FI END; @ KMT_FH_WRITE @ ***PAGE GLOBAL STATIC () PROC KMT_FH_SAVE_FILE IS ( RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to save the file previously opened by the procedure *@ @* KMT_FH_OPEN_FILE. *@ @* *@ @******************************************************************************@ BEGIN INT KMT_EH_SOFTWARE_ERROR IS 80101; IF KMT_FH_FILE_DETAILS.NEW_FILE AND ( CTM_SAVE_FILE (KMT_FH_FILE_DETAILS.FILE_CURRENCY, NIL, RESULT); RESULT GT 0 ) THEN () @ Save error @ ( () BYTE PROC_NAME := "KMT_FH_SAVE_FILE"; () KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME AS KMT_MTM_VALUES.RVB_VALUE); KMT_EH_LOG_ERROR (RESULT, 2, PARAMS, 0, FALSE, FALSE); RESULT := KMT_EH_SOFTWARE_ERROR ) ELSE @ Ignore warnings @ RESULT := 0 FI END; @ KMT_FH_SAVE_FILE @ ***PAGE GLOBAL STATIC () PROC KMT_FH_GIVE_NAME IS ( REF () BYTE NAME, REF INT NAME_LENGTH, BOOL FULL_NAME, RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to obtain either the full file name or the terminal *@ @* file name of the file previously opened by KMT_FH_OPEN_FILE. *@ @* The name of the file and length are returned in the areas referenced by *@ @* NAME and NAME_LENGTH respectively. *@ @* If FULL_NAME is set TRUE then the full file name will be returned, *@ @* otherwise the terminal file name will be returned. *@ @* If the area referenced by NAME is too small to contain the file name then *@ @* the file name will be truncated and resultcode FC_CTM_BUFFER_TOO_SHORT *@ @* returned. *@ @* *@ @******************************************************************************@ BEGIN INT KMT_EH_SOFTWARE_ERROR IS 80101; IF ( CTM_GIVE_NAME (KMT_FH_FILE_DETAILS.FILE_CURRENCY, NIL, NAME, NAME_LENGTH, RESULT); RESULT GT 0 ) THEN () @ Error @ ( () BYTE PROC_NAME := "KMT_FH_GIVE_NAME"; () KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME AS KMT_MTM_VALUES.RVB_VALUE); KMT_EH_LOG_ERROR (RESULT, 2, PARAMS, 0, FALSE, FALSE); RESULT := KMT_EH_SOFTWARE_ERROR ) ELSF FULL_NAME THEN @ Full file name required @ @ Exit @ SKIP ELSF NAME_LENGTH EQ 0 THEN @ No file name returned, exit @ SKIP ELSE @ Terminal file name required @ () BYTE NAME_COPY := NAME(SIZE NAME_LENGTH); REF () BYTE TERMINAL_NAME, REM; TERMINAL_NAME := NAME_COPY; REM := TERMINAL_NAME; UNTIL @ Search for part of name @ SCANUNQ (".", @ after last dot @ REM, 0, REM) DO REM := REM(1::); TERMINAL_NAME := REM REPEAT; SCANUNQ ("(", @ Remove generation number @ TERMINAL_NAME, 0, REM); NAME_LENGTH := LENGTH TERMINAL_NAME - LENGTH REM; NAME(SIZE NAME_LENGTH) := TERMINAL_NAME(SIZE NAME_LENGTH); RESULT := 0 FI; END; @ KMT_FH_GIVE_NAME @ ENDMODULE @ KMT_FH_MODULE @