Rational Developer for System z, Versión 7.6.1

Fragmento de código COBOL para generar el archivo XML de información de retorno de error

El siguiente fragmento de código de programa COBOL expone unos cuantos temas que pueden ser de utilidad al crear su propio preprocesador.

El fragmento de código configura variables de archivo para el archivo de entrada para el preprocesador. SYSIN se utiliza como la variable de entrada. De forma predeterminada, Rational Developer for System z establece la variable SYSIN cuando se genera el JCL para invocación. También se declaran las variables de archivo para SYSXMLSD y SYSOUT.

La sentencia PERFORM Extract-DDDSN del fragmento de código realiza un párrafo que llama a DYNQUERY. La salida de DYNQUERY es similar a la salida de ZFLDATA. El proceso es distinto y se escribe en Assembler. Si no tiene un compilador de C pero tiene Assembler de alto nivel, podría decidir llamar a DYNQUERY desde su preprocesador para recuperar el nombre de conjunto de datos desde un nombre DD.

La sentencia PERFORM Write-xml-line realiza un párrafo que escribe las líneas de un archivo XML en UTF-8. Si escribe su archivo XML en UTF-8, asegúrese de incluir ERRWDZ como uno de los calificadores en el campo de entrada Calificador de conjunto de datos para errores de compilador cuando añada un paso nuevo para el preprocesador en el Editor de grupos de propiedades.

       Identification DIVISION.
         Program-ID. MPREPROC.
       Environment DIVISION.
        Input-output section.
         File-control.
           Select in-file
               Assign to SYSIN
      *         Organization is line sequential
               File status is in-file-status.
           Select out-file
               Assign to outfile
      *         Organization is line sequential
               File status is out-file-status.
           Select xml-file
               Assign to SYSXMLSD
      *         Organization is line sequential
               File status is xml-file-status.
       Data Division.
        File section.
        Fd in-file
             label records are standard
      *       recording mode is f
             record contains 80 characters
             block contains 0 records
             data record is Input-data.
        01 Input-data pic x(80).
        Fd out-file
             label records are standard
      *       recording mode is f
             record contains 80 characters
             block contains 0 records
             data record is output-data.
        01 output-data pic x(80).
        Fd xml-file
             label records are standard
      *       recording mode is v
      *      16383 - word for storing the record length
             record varying from 1 to 16379 characters
               DEPENDING ON xml-length
             block contains 0 records
             data record is xml-data.
        01 xml-data pic x(16379).
      *
      *  To run this, use a ddname
      *  //OUTFILE DD DSN=[DATASET](MEMBER),DISP=SHR
      *
       Working-Storage Section.
        01 Source-name pic x(54).
        01 Target-name pic x(54).
        01 Reverse-data pic x(16379).
        01 Temp-data pic x(16379).
        01 Nat-data pic n(16379) USAGE National.
        01 Num-chars pic 99999.
        01 xml-length pic 9(5).
        01 Program-flags.
          05 in-file-status pic xx value "00".
            88 inputfile-success value "00".
          05 out-file-status pic xx value "00".
            88 outputfile-success value "00".
          05 xml-file-status pic xx value "00".
            88 xmlfile-success value "00".
          05 In-file-count pic 999.
          05 Out-file-count pic 999.
          05 Input-eof pic x value " ".
          05 line-cursor pic 99999.
          05 line-cursor-end pic 99999.

          =================
          =================
          =================
        01 ddname-routine-data.
          05 ddname pic x(8).
          05 dsn pic x(54).
          05 spacestart pic 99.
          05 spaceend pic 99.
          =================
          =================
          =================
       Procedure DIVISION .
        mainline SECTION.
          =================
          =================
          =================
           PERFORM Extract-dsnnames
      * Open the input and output files
           OPEN INPUT in-file
           if not inputfile-success
             display 'Error opening input file ' in-file-status
             stop run
           end-if
           OPEN OUTPUT out-file
           if not outputfile-success
             display 'Error opening output file ' out-file-status
             stop run
           end-if
           OPEN OUTPUT xml-file
           if not xmlfile-success
             display 'Error opening xml file ' xml-file-status
             stop run
           end-if
          =================
          =================
          =================
           Perform until Input-eof IS EQUAL TO "1"
          =================
          =================
          =================
               READ in-file into Temp-data at end move "1" to Input-eof
               END-READ
               IF Input-eof IS EQUAL TO "0"
                 PERFORM Process-line
               End-IF
           End-perform.
          =================
          =================
          =================
           PERFORM Generate-xml-end-package
           goback
           .
      * Output: Source-name, Target-name
        Extract-dsnnames.
           MOVE SPACES to ddname
           MOVE "SYSIN" to ddname
           PERFORM Extract-DDDSN
           MOVE SPACES to Source-name
           MOVE dsn to Source-name
           MOVE SPACES to ddname
           MOVE "OUTFILE" to ddname
           PERFORM Extract-DDDSN
           MOVE SPACES to Target-name
           MOVE dsn to Target-name
           .
      * Input: DDNAME
      * Output: DSN
        Extract-DDDSN.
           MOVE SPACES TO dsn
           CALL "DYNQUERY" USING DDNAME, DSN.
           IF RETURN-CODE > 0 THEN
             DISPLAY "Error retrieving DSN for DDNAME " DDNAME
             DISPLAY "Return Code = " RETURN-CODE
             EVALUATE RETURN-CODE
               WHEN 1080
                 DISPLAY "DD for " DDNAME " was not found"
                 STOP RUN
               WHEN OTHER
                 STOP RUN
             END-EVALUATE
           END-IF
           PERFORM Remove-DSN-Spaces
          =================
          =================
          =================
        Generate-xml-end-package.
           MOVE SPACES TO Temp-data
           MOVE end-package TO Temp-data
           PERFORM Write-xml-line
          =================
          =================
          =================


        Write-xml-line.
      *    Assume text to be written to xml-file is in Temp-data
      *    Convert text to UTF-8 text
           Move Temp-data to Nat-data
           Move Function Display-of(Nat-data, 01208)
             to xml-data
      *    Calculate length of UTF-8 text
           Move Function Reverse(Temp-data) to Reverse-data
           Move 0 to Num-chars
           INSPECT Function Reverse(Temp-data)
             TALLYING Num-chars FOR LEADING SPACES
           Compute Num-chars = Function Length(Temp-data) - Num-chars
           Compute xml-length = Function LENGTH(
             Function Display-of(Nat-data(1:Num-chars),
                                 01208)
           )
           WRITE xml-data
           .
       End program MPREPROC.

Términos de uso | Comentarios

Este Information Center está basado en tecnología Eclipse. (http://www.eclipse.org)