6.2.3 例外処理のコードの例(COBOL)

アプリケーションプログラムで例外を検出した場合に呼び出される副プログラムとしての例外処理の例を示します。なお,この例外処理はクライアントアプリケーションおよびサーバアプリケーションに共通です。

      IDENTIFICATION DIVISION.
      PROGRAM-ID. OTM-EXCEPTION-HANDLER.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.

      DATA DIVISION.
      WORKING-STORAGE SECTION.

      COPY TSCSysExcept.

      01 OTM-ERROR-CODE            PIC S9(9) COMP.
      01 OTM-DETAIL-CODE           PIC S9(9) COMP.
      01 OTM-PLACE-CODE            PIC S9(9) COMP.
      01 OTM-COMPLET-CODE          PIC S9(9) COMP.
      01 OTM-MAINTENANCE-CODE1     PIC S9(9) COMP.
      01 OTM-MAINTENANCE-CODE2     PIC S9(9) COMP.
      01 OTM-MAINTENANCE-CODE3     PIC S9(9) COMP.
      01 OTM-MAINTENANCE-CODE4     PIC S9(9) COMP.

      LINKAGE SECTION.
      01 EXCEPTION-TYPE        PIC 9(9) COMP.
      01 CORBA-ENVIRONMENT.
       02 MAJOR                PIC 9(9) COMP.
        88 CORBA-NO-EXCEPTION     VALUE 0.
        88 CORBA-USER-EXCEPTION   VALUE 1.
        88 CORBA-SYSTEM-EXCEPTION VALUE 2.
       02 EXCEP                USAGE POINTER.
       02 FUNC-NAME            PIC X(256).

      PROCEDURE DIVISION USING
              BY REFERENCE EXCEPTION-TYPE
              BY REFERENCE CORBA-ENVIRONMENT.

          DISPLAY '!!!! An Exception Occurs in '
              FUNC-NAME OF CORBA-ENVIRONMENT ' !!!!'

          IF CORBA-SYSTEM-EXCEPTION
              DISPLAY 'OTM System Exception Occurs.'

              CALL 'TSCSysExcept-getErrorCode' USING
                      BY VALUE EXCEP
                  RETURNING OTM-ERROR-CODE
              DISPLAY 'Error-code is ' OTM-ERROR-CODE

              CALL 'TSCSysExcept-getDetailCode' USING
                      BY VALUE EXCEP
                  RETURNING OTM-DETAIL-CODE
              DISPLAY 'Detail-code is ' OTM-DETAIL-CODE

              CALL 'TSCSysExcept-getPlaceCode' USING
                      BY VALUE EXCEP
                  RETURNING OTM-PLACE-CODE
              DISPLAY 'Place-code is ' OTM-PLACE-CODE

              CALL 'TSCSysExcept-getCompletion' USING
                      BY VALUE EXCEP
                  RETURNING OTM-COMPLET-CODE
              DISPLAY 'Completion-code is ' OTM-COMPLET-CODE

              CALL 'TSCSysExcept-getMaintenance1' USING
                      BY VALUE EXCEP
                  RETURNING OTM-MAINTENANCE-CODE1
              DISPLAY 'Mainte-code1 is ' OTM-MAINTENANCE-CODE1

              CALL 'TSCSysExcept-getMaintenance2' USING
                      BY VALUE EXCEP
                  RETURNING OTM-MAINTENANCE-CODE2
              DISPLAY 'Mainte-code2 is ' OTM-MAINTENANCE-CODE2

              CALL 'TSCSysExcept-getMaintenance3' USING
                      BY VALUE EXCEP
                  RETURNING OTM-MAINTENANCE-CODE3
              DISPLAY 'Mainte-code3 is ' OTM-MAINTENANCE-CODE3

              CALL 'TSCSysExcept-getMaintenance4' USING
                      BY VALUE EXCEP
                  RETURNING OTM-MAINTENANCE-CODE4
              DISPLAY 'Mainte-code4 is ' OTM-MAINTENANCE-CODE4
          ELSE
     * ユーザ例外処理
              DISPLAY 'User Exception Occurs.'
          END-IF.

      END PROGRAM OTM-EXCEPTION-HANDLER.


      IDENTIFICATION DIVISION.
      PROGRAM-ID. EXCEPTION-HANDLER.
      ENVIRONMENT DIVISION.
      CONFIGURATION SECTION.

      DATA DIVISION.
      WORKING-STORAGE SECTION.

      01 EXCEPTION-NAME            PIC X(50).
      01 EXCEPTION-NAME-PTR        USAGE POINTER.
      01 EXCEPTION-NAME-LEN        PIC S9(9) COMP VALUE 50.
      01 MINOR-CODE                PIC S9(9) COMP.
      01 COMPLETED-CODE            PIC S9(9) COMP.

      LINKAGE SECTION.
      01 EXCEPTION-TYPE        PIC 9(9) COMP.
      01 CORBA-ENVIRONMENT.
       02 MAJOR                PIC 9(9) COMP.
        88 CORBA-NO-EXCEPTION     VALUE 0.
        88 CORBA-USER-EXCEPTION   VALUE 1.
        88 CORBA-SYSTEM-EXCEPTION VALUE 2.
       02 EXCEP                USAGE POINTER.
       02 FUNC-NAME            PIC X(256).


      PROCEDURE DIVISION USING
              BY REFERENCE EXCEPTION-TYPE
              BY REFERENCE CORBA-ENVIRONMENT.

          DISPLAY '!!!! An Exception Occurs in '
              FUNC-NAME OF CORBA-ENVIRONMENT

          IF CORBA-SYSTEM-EXCEPTION
              DISPLAY 'CORBA System Exception Occurs.'

          CALL 'CORBA-get-exception-name' USING
                  BY REFERENCE EXCEP
              RETURNING EXCEPTION-NAME-PTR.
          CALL 'CORBA_string_get' USING
                  BY REFERENCE EXCEPTION-NAME-PTR
                  BY REFERENCE EXCEPTION-NAME-LEN
                  BY REFERENCE EXCEPTION-NAME.

          DISPLAY 'Exception name is' EXCEPTION-NAME.

          IF CORBA-SYSTEM-EXCEPTION
              CALL 'CORBA-SysExcept-get-minor' USING
                      BY VALUE EXCEP
                  RETURNING MINOR-CODE
              DISPLAY 'Minor-code is ' MINOR-CODE

              CALL 'CORBA-SysExcept-get-completed' USING
                      BY VALUE EXCEP
                  RETURNING COMPLETED-CODE
              DISPLAY 'Completed-code is ' COMPLETED-CODE

          ELSE
              DISPLAY 'User Exception Occurs.'
          END-IF.

      END PROGRAM EXCEPTION-HANDLER.