Rational Developer for System z, version 7.6.1

Fragment COBOL en vue de la création d'un fichier XML de suivi des erreurs

Le fragment de programme COBOL suivant présente quelques rubriques qui peuvent s'avérer utiles lors de la création de votre préprocesseur.

Le fragment permet de configurer des variables du fichier d'entrée pour le préprocesseur. SYSIN est utilisé comme variable d'entrée. Par défaut, la variable SYSIN est définie par Rational Developer for System z lors de la génération du JCL d'appel. Les variables de fichier der SYSXMLSD et SYSOUT sont également déclarées.

L'instruction PERFORM Extract-DDDSN du fragment exécute un paragraphe qui appelle DYNQUERY. La sortie de DYNQUERY est analogue à celle de ZFLDATA. Le traitement est différent et est écrit dans l'assembleur. Si votre site ne comporte aucun compilateur C, mais que vous disposez d'un assembleur de haut niveau, vous pouvez choisir d'appeler DYNQUERY à partir de votre préprocesseur afin d'extraire le nom de fichier d'un nom de définition de données.

L'instruction PERFORM Write-xml-line permet d'exécuter un paragraphe qui écrit les lignes d'un fichier XML au format UTF-8. Si vous rédigez votre fichier XML au format UTF-8, n'oubliez pas d'inclure ERRWDZ comme l'un de vos qualificatifs dans la zone d'entrée Qualificatif de fichier des erreurs de compilation lors de l'ajout d'une nouvelle étape pour votre préprocesseur dans l'Editeur de groupe de propriétés.

       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.
       Division de données.
        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
      *
       Section Working-Storage.
        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.

Conditions d'utilisation | Commentaires

Ce centre de documentation utilise la technologie Eclipse. (http://www.eclipse.org)