Quelle  manipc.cob   Sprache: Cobol

      *******************************************
      *
      * MODULE NAME      MANIPC.COB
      *
      * DESCRIPTIVE NAME CICS for MVS/ESA CWI Manipulator Sample Program
      *
      * Statement:       Licensed Materials - Property of IBM
      *
      *                  CA84 SupportPac
      *                  (c) Copyright IBM Corp. 1998
      *
      *                  All rights reserved.
      *
      *                  U.S. Government Users Restricted Rights - use,
      *                  duplication or disclosure restricted by GSA
      *                  ADP Schedule Contract with IBM Corp.
      *
      * Status:          Version 1 Release 0
      *
      *  NOTES :-
      *    DEPENDENCIES = CICS for MVS/ESA V4.1
      *
      * This program is a cobol CWI converter program which aims to
      * demonstrate how data passed to it can be manuipulated before
      * being passed on to a CICS application.
      *
      *******************************************

      *******************************************
      *
      * PROGRAM NAME: MANIPC
      *
      * TITLE: COBOL Sample CWI Manipulator Converter Program.
      *
      * PROGRAM DESCRIPTION:
      *
      * This program will show an example of how to code a simple
      * program to receive data from the web, extract part of it and
      * pass more data to a CICS application program.
      *
      * SYSTEM LEVEL:  CICS/ESA 4.1 or higher.
      *
      * INPUT:
      *
      * An HTTP request.
      *
      * OUTPUT:
      *
      * HTML to display a message.
      *
      *****************************************


       PROCESS XOPTS(NOLINKAGE)
       IDENTIFICATION DIVISION.
       PROGRAM-ID. MANIPC.
       ENVIRONMENT DIVISION.
       DATA DIVISION.

       WORKING-STORAGE SECTION.

       COPY DFHWBUCO.
      *
       01 LOWER         PIC X(26) VALUE 'abcdefghijklmnopqrstuvwxyz'.
       01 FILLER REDEFINES LOWER.
          05  LOWERC    PIC X OCCURS 26 INDEXED BY LOWERC-IDX.
       01 UPPER         PIC X(26) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
       01 FILLER REDEFINES UPPER.
          05  UPPERC    PIC X OCCURS 26.
      *
       77 CONV-POINTER  POINTER.
      *
       77 POSITION1     PIC S9(8) COMP VALUE 1.
       77 POSITION2     PIC S9(8) COMP VALUE ZERO.
       77 POSITION3     PIC S9(8) COMP VALUE ZERO.
       77 POSITION4     PIC S9(8) COMP VALUE ZERO.
      *
       77 HEADER        PIC X(23) VALUE "Content-Type: text/html".
       77 MESSAGE1      PIC X(8)  VALUE "Program ".
       77 MESSAGE2      PIC X(29) VALUE " successfully invoked. ".
       77 CRLF          PIC X(2)  VALUE X"0D25".
      *
       77 TEMP-PGM-DATA PIC X(32767) VALUE SPACES.
      *
       01 RETURNED-DATA.
          05 HTML-LEN      PIC 9(8) COMP VALUE ZERO.
          05 THE-HTML-PAGE PIC X(32767)  VALUE SPACES.
      *
       COPY DFHWBTLO.
      *
       LINKAGE SECTION.
      *
       COPY DFHEIBLC.
       COPY DFHWBCDO.
      *
       77 THE-URL       PIC X(1000).
       77 URL-CHARACTER PIC X.
       77 USER-PGM-DATA PIC X(32767).

       PROCEDURE DIVISION USING DFHEIBLK DFHCOMMAREA.

      ******
      *  First part: set up the pointers and structures, perform
      *  sanity checks and the call the decode/encode functions.
      ******
      *  Just return if no commarea because there's nowhere to work.
      ******

           IF EIBCALEN = 0
              EXEC CICS RETURN END-EXEC
           END-IF.

      ******
      *  Set up addressability to the commarea.
      ******

           EXEC CICS
                ADDRESS COMMAREA(CONV-POINTER)
           END-EXEC.

           SET ADDRESS OF CONVERTER-PARMS TO CONV-POINTER.

      ******
      *  Validate the commarea eyecatcher.
      ******

           IF (CONVERTER-EYECATCHER NOT = DECODE-EYECATCHER-INIT)
           AND (CONVERTER-EYECATCHER NOT = ENCODE-EYECATCHER-INIT)
               MOVE URP-INVALID TO CONVERTER-RESPONSE
               MOVE URP-CORRUPT-CLIENT-DATA TO CONVERTER-REASON

               EXEC CICS
                    RETURN
               END-EXEC
           END-IF.

           IF CONVERTER-RESPONSE NOT = 0
               EXEC CICS
                    RETURN
               END-EXEC
           END-IF.

           IF CONVERTER-REASON NOT = 0
               EXEC CICS
                    RETURN
               END-EXEC
           END-IF.

           EVALUATE CONVERTER-FUNCTION

      ******
      *  If decode is set then construct the commarea for the application.
      ******

           WHEN URP-DECODE
               PERFORM DECODE

      ******
      *  If encode is set then build data to be sent to the browser.
      ******

           WHEN URP-ENCODE
               PERFORM ENCODE

      ******
      *  Otherwise there is a problem.
      ******

           WHEN OTHER
               MOVE URP-INVALID TO CONVERTER-RESPONSE
               MOVE URP-CORRUPT-CLIENT-DATA TO CONVERTER-REASON
               EXEC CICS
                    RETURN
               END-EXEC
           END-EVALUATE.

      ******
      *  Now we return.
      ******

           EXEC CICS
                RETURN
           END-EXEC.

       A999-EXIT.
           EXIT.


      ********************
       BB-DECODE SECTION.
      ********************

       DECODE.
      ***************

      ******
      * Construct the commarea.
      ******

      ******
      *  First we need to find the application program name.
      ******
      *  Set up pointers to the url.
      ******

           SET ADDRESS OF USER-PGM-DATA   TO DECODE-DATA-PTR.

           MOVE DECODE-RESOURCE-LENGTH    TO POSITION2.

           SET ADDRESS OF THE-URL         TO DECODE-RESOURCE-PTR.
           SET ADDRESS OF URL-CHARACTER   TO
                                      ADDRESS OF THE-URL(POSITION2 : 1).

      ******
      *  Find the last '/' in the url.
      ******

           PERFORM WITH TEST BEFORE UNTIL URL-CHARACTER = '/'
               COMPUTE POSITION2 = POSITION2 - 1
               SET ADDRESS OF URL-CHARACTER TO
                   ADDRESS OF THE-URL(POSITION2 : 1)
           END-PERFORM.

           COMPUTE POSITION2 = POSITION2 + 1.

           SET ADDRESS OF THE-URL TO ADDRESS OF THE-URL(POSITION2 : 1).

      ******
      *  Save the program name and convert it to upper case.
      ******

           UNSTRING THE-URL
               DELIMITED BY SPACE
               INTO DECODE-SERVER-PROGRAM.

           PERFORM WITH TEST AFTER VARYING POSITION2 FROM 1 BY +1
               UNTIL POSITION2 = 26
               INSPECT DECODE-SERVER-PROGRAM REPLACING ALL
                   LOWERC(POSITION2) BY UPPERC(POSITION2)
           END-PERFORM.

      ******
      *  Extract data from the decode input commarea and put it,
      *  with other data, into the decode output commarea.
      ******
      *  Use the INSPECT verb to find the start and end positions of the
      *  data to be extracted.
      ******

           INSPECT USER-PGM-DATA TALLYING POSITION3
               FOR CHARACTERS
               BEFORE INITIAL "HTTP".
           INSPECT USER-PGM-DATA TALLYING POSITION4
               FOR CHARACTERS
               BEFORE INITIAL CRLF.

      ******
      *  Use the STRING verb to build up the decode output commarea, its
      *  length (the value in the pointer minus one) changing as data is
      *  added.
      ******

           STRING USER-PGM-DATA(POSITION3 + 1 : (POSITION4 - POSITION3))
               DELIMITED BY SIZE
               INTO TEMP-PGM-DATA
               WITH POINTER POSITION1.

           STRING " 200 OK"
               DELIMITED BY SIZE
               INTO TEMP-PGM-DATA
               WITH POINTER POSITION1.

           STRING CRLF HEADER CRLF CRLF
               DELIMITED BY SIZE
               INTO TEMP-PGM-DATA
               WITH POINTER POSITION1.

           STRING MESSAGE1
               DELIMITED BY SIZE
               INTO TEMP-PGM-DATA
               WITH POINTER POSITION1.

           STRING DECODE-SERVER-PROGRAM
               DELIMITED BY SIZE
               INTO TEMP-PGM-DATA
               WITH POINTER POSITION1.

           STRING MESSAGE2
               DELIMITED BY SIZE
               INTO TEMP-PGM-DATA
               WITH POINTER POSITION1.

      ******
      * Etc. etc. etc.....
      ******

           MOVE TEMP-PGM-DATA TO USER-PGM-DATA.

           SUBTRACT 1     FROM POSITION1.
           MOVE POSITION1 TO   DECODE-INPUT-DATA-LEN.
           MOVE POSITION1 TO   DECODE-OUTPUT-DATA-LEN.

           MOVE URP-OK    TO DECODE-RESPONSE.
           MOVE 0         TO DECODE-REASON.

      ********************
       BB-ENCODE SECTION.
      ********************

       ENCODE.
      ***************

      ******
      * Set up for output.
      ******

           SET ADDRESS OF USER-PGM-DATA TO ENCODE-DATA-PTR.

           MOVE USER-PGM-DATA TO THE-HTML-PAGE.
           MOVE 1035          TO HTML-LEN.
           MOVE RETURNED-DATA TO USER-PGM-DATA.

           MOVE URP-OK TO ENCODE-RESPONSE.
           MOVE 0      TO ENCODE-REASON.

       BB999-EXIT.
           EXIT.