*----------------------------------------------------------------- * Algemeen binnen services gebruikte routine * * LET OP!! deze versie is voor normale lengte XML-bestanden * dus programma's die gebruik maken van VBNCSA03 ipv VBNCSA04. * *----------------------------------------------------------------- * Service : alle * Omschrijving: toevoegen van XSI-informatie aan XML en * deze converteren naar UTF-8 met pic x(10000). * * Wijzigingen : * * Naam Datum Userstory Omschrijving * SOMMM00 20200617 VPBK-7852 Initiële versie. * HAARR04 202010 VPBK-9274 Verwerking CDATA ingebouwd. * Replaces efficiënter gemaakt. *----------------------------------------------------------------- IDENTIFICATION DIVISION. PROGRAM-ID. VBNSG2. ENVIRONMENT DIVISION. CONFIGURATION SECTION. *SOURCE-COMPUTER. SERVICE-COMPUTER WITH DEBUGGING MODE. SPECIAL-NAMES. DECIMAL-POINT COMMA. DATA DIVISION. WORKING-STORAGE SECTION. 01 FILLER. 06 ASRP0080 PIC X(008) VALUE 'ASRP0080'. 06 PROGRAMMANAAM PIC X(008) VALUE 'VBNSG2'. 06 WC-CDATA-BEGIN PIC X(012) VALUE '<![CDATA['. 06 WC-CDATA-EINDE PIC X(006) VALUE ']]>'. 06 WC-NS-VAN PIC X(020) VALUE 'xmlns="__NAMESPACE__'. 01 ASRC0080-INTERFACE-PLUS. COPY ASRC0080. 01 HULPVELDEN. 06 WS-BERICHT-BODY PIC X(10000). 06 WS-BERICHT-HEADER PIC X(00500). 06 WS-BERICHT-HULP PIC X(10000). 06 WS-CDATA-BEGIN-POS PIC S9(009) COMP. 06 WS-CDATA-EINDE-POS PIC S9(009) COMP. 06 WS-CDATA PIC X(5000). 06 WS-CDATA-LENGTE PIC S9(009) COMP. 06 WS-EINDE-RESP-HEADER PIC S9(009) COMP. 06 WS-RESPONSE-LENGTE PIC 9(005) COMP-3. 06 WS-SYS-NAME PIC X(008) VALUE SPACE. 88 SYS-NAME-VALIDE VALUE 'RCT1', 'RCT2', 'RCQ1', 'RCQ2' . COPY VBNCS001 REPLACING ==($$)== BY ====. test D 06 ws-sqlcode pic +9999. EXEC SQL INCLUDE SQLCA END-EXEC. LINKAGE SECTION. 01 LS-BERICHT PIC X(10000). 01 LS-NS-NAAR PIC X(250). PROCEDURE DIVISION USING LS-BERICHT LS-NS-NAAR. A000 SECTION. INITIALIZE HULPVELDEN PERFORM Z001-PREAMBULE IF TOON-DISPLAYS PERFORM Z002-DISPLAY-INIT END-IF *--------------------------------------------------------------- * Zoeken van het einde van de string 'xmlns="__NAMESPACE__' in * de header. De te vervangen waarden voor de namespace en de * encoding zitten hierin. * De rest van de invoer wordt hier later weer achter geplakt. *--------------------------------------------------------------- EXEC SQL SELECT INSTR ( LEFT (:LS-BERICHT, 250) , :WC-NS-VAN ) + 20 INTO :WS-EINDE-RESP-HEADER FROM SYSIBM.SYSDUMMY1 END-EXEC *--------------------------------------------------------------- * GENERATE gebeurt in aanroeper met EBCDIC CCSID dus: * replace DB2 om * te wijzigen in . * en * replace de door COBOL gegenereerde namespace in een XML- * compatible namespace inclusief XSI informatie. * WC-NS-VAN en LS-NS-NAAR worden gebruikt om de * GENERATEd berichtheader te wijzigen. *--------------------------------------------------------------- EXEC SQL SELECT REPLACE(REPLACE (LEFT(:LS-BERICHT, :WS-EINDE-RESP-HEADER) , 'IBM-1140', 'UTF-8') , :WC-NS-VAN, RTRIM(:LS-NS-NAAR)) INTO :WS-BERICHT-HEADER FROM SYSIBM.SYSDUMMY1 END-EXEC MOVE LS-BERICHT(WS-EINDE-RESP-HEADER + 1:) TO WS-BERICHT-BODY *--------------------------------------------------------------- * In evt. CDATA de escape-characters vervangen door de * oorspronkelijke tekens. * CDATA komt - hopelijk - alleen voor in de bericht-body. *--------------------------------------------------------------- PERFORM B010-CDATA-ESCAPE-CHARS STRING FUNCTION TRIM(WS-BERICHT-HEADER, TRAILING) FUNCTION TRIM(WS-BERICHT-BODY , TRAILING) DELIMITED BY SIZE INTO WS-BERICHT-HULP END-STRING *---------------------------------------------------------------- * Zoek de eerste 'spatie' t.b.v. initialize verderop *---------------------------------------------------------------- COMPUTE WS-RESPONSE-LENGTE = FUNCTION LENGTH (FUNCTION TRIM(WS-BERICHT-HULP, TRAILING)) test D display 'ws-response-lengte: ' ws-response-lengte *---------------------------------------------------------------- * Conversie van EBCDIC naar UTF-8 CCSID en retour aanroeper *---------------------------------------------------------------- MOVE FUNCTION DISPLAY-OF (FUNCTION NATIONAL-OF (WS-BERICHT-HULP(1: WS-RESPONSE-LENGTE) , EBCDIC-CCSID), UTF8-CCSID) TO LS-BERICHT *---------------------------------------------------------------- * Alle posities achter het bericht van x'20' spaties voorzien *---------------------------------------------------------------- IF WS-RESPONSE-LENGTE < 10000 MOVE ALL x'20' TO LS-BERICHT(WS-RESPONSE-LENGTE + 1:) END-IF IF TOON-DISPLAYS PERFORM Z003-DISPLAY-EXIT END-IF . A000-999. GOBACK. B010-CDATA-ESCAPE-CHARS SECTION. MOVE 1 TO WS-CDATA-BEGIN-POS PERFORM X010-ZOEK-CDATA-BEGIN PERFORM UNTIL WS-CDATA-BEGIN-POS = 0 PERFORM X020-ZOEK-CDATA-EINDE PERFORM X030-REPLACE-ESCAPE-CHARS MOVE SPACE TO WS-BERICHT-HULP COMPUTE WS-CDATA-EINDE-POS = WS-CDATA-BEGIN-POS + WS-CDATA-LENGTE - 1 STRING WS-BERICHT-BODY(1: WS-CDATA-BEGIN-POS - 1) FUNCTION TRIM(WS-CDATA, TRAILING) FUNCTION TRIM(WS-BERICHT-BODY(WS-CDATA-EINDE-POS + 1:) , TRAILING) DELIMITED BY SIZE INTO WS-BERICHT-HULP END-STRING MOVE WS-BERICHT-HULP TO WS-BERICHT-BODY PERFORM X010-ZOEK-CDATA-BEGIN END-PERFORM . B010-999. EXIT SECTION. X010-ZOEK-CDATA-BEGIN SECTION. EXEC SQL SELECT INSTR ( SUBSTR (:WS-BERICHT-BODY, :WS-CDATA-BEGIN-POS) , :WC-CDATA-BEGIN ) INTO :WS-CDATA-BEGIN-POS FROM SYSIBM.SYSDUMMY1 END-EXEC test D if sqlcode = 0 display 'SQL 4 ok.' test D else move sqlcode to ws-sqlcode test D display 'SQL 4 niet ok. ' ws-sqlcode end-if . X010-999. EXIT SECTION. X020-ZOEK-CDATA-EINDE SECTION. EXEC SQL SELECT INSTR ( SUBSTR (:WS-BERICHT-BODY, :WS-CDATA-BEGIN-POS) , :WC-CDATA-EINDE ) +5 INTO :WS-CDATA-LENGTE FROM SYSIBM.SYSDUMMY1 END-EXEC test D if sqlcode = 0 display 'SQL 5 ok.' test D else move sqlcode to ws-sqlcode test D display 'SQL 5 niet ok. ' ws-sqlcode end-if . X020-999. EXIT SECTION. X030-REPLACE-ESCAPE-CHARS SECTION. MOVE WS-BERICHT-BODY(WS-CDATA-BEGIN-POS: WS-CDATA-LENGTE) TO WS-CDATA EXEC SQL SELECT REPLACE (:WS-CDATA, '&', '&' ) INTO :WS-CDATA FROM SYSIBM.SYSDUMMY1 END-EXEC EXEC SQL SELECT REPLACE (:WS-CDATA, ''', '''' ) INTO :WS-CDATA FROM SYSIBM.SYSDUMMY1 END-EXEC EXEC SQL SELECT REPLACE (:WS-CDATA, '>', '>' ) INTO :WS-CDATA FROM SYSIBM.SYSDUMMY1 END-EXEC EXEC SQL SELECT REPLACE (:WS-CDATA, '<' , '<' ) INTO :WS-CDATA FROM SYSIBM.SYSDUMMY1 END-EXEC EXEC SQL SELECT REPLACE (:WS-CDATA, '"', '"' ) INTO :WS-CDATA FROM SYSIBM.SYSDUMMY1 END-EXEC . X030-999. EXIT SECTION. Z001-PREAMBULE SECTION. CALL ASRP0080 USING ASRC0080-INTERFACE-PLUS MOVE ASRC0080-SYS-NAME TO WS-SYS-NAME IF (ASRC0080-RETURNCODE = '00') AND SYS-NAME-VALIDE SET TOON-DISPLAYS TO TRUE END-IF IF TOON-DISPLAYS DISPLAY PROGRAMMANAAM END-IF . Z001-99. EXIT SECTION. Z002-DISPLAY-INIT SECTION. DISPLAY 'VBNSG2 Invoer : ' FUNCTION TRIM(LS-BERICHT, TRAILING) DISPLAY ' ' . Z002-99. EXIT SECTION. Z003-DISPLAY-EXIT SECTION. MOVE FUNCTION DISPLAY-OF ( FUNCTION NATIONAL-OF (LS-BERICHT, UTF8-CCSID) , EBCDIC-CCSID ) TO CV-DISP-EBCDIC DISPLAY 'VBNSG2 Uitvoer: ' FUNCTION TRIM(CV-DISP-EBCDIC TRAILING) DISPLAY ' ' . Z003-99. EXIT SECTION.