home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1996 February / PCWK0296.iso / po7_win / db / rdbms71 / cbdem2.cob < prev    next >
Text File  |  1994-08-07  |  15KB  |  417 lines
  1.       *    
  2.       *    $Header: cbdem2.cob 7000901.1 92/03/21 18:05:47 twang Generic<base> $ 
  3.       *    
  4.       * Copyright (c) 1991 by Oracle Corporation 
  5.       *   NAME
  6.       *     cbdem2.cob - Cobol demo program #2
  7.       *   MODIFIED   (MM/DD/YY)
  8.       *    sjain      03/16/92 -  Creation
  9.       *
  10.       * The program CBDEM2 accepts SQL statements from the
  11.       * user at run time and processes them.
  12.  
  13.       * If the statement was a Data Definition Language (DDL),
  14.       * Data Control Language (DCL), or Data Manipulation
  15.       * Language (DML) statement, it is parsed and executed,
  16.       * and the next statement is retrieved.  (Note that
  17.       * performing the execute step for a DDL or DCL statement
  18.       * is not necessary, but it does no harm, and simplifies
  19.       * the program logic.)
  20.  
  21.       * If the statement was a query, the program describes
  22.       * the select list, and defines output variables of the
  23.       * appropriate type and size, depending on the internal
  24.       * datatype of the select-list item.
  25.  
  26.       * Then, each row of the query is fetched, and the results
  27.       * are displayed.
  28.  
  29.       * To keep the size of this example program to a
  30.       * reasonable limit for this book, the following
  31.       * restrictions are present:
  32.  
  33.       * (1) The SQL statement can contain only 25 elements (words
  34.       *   and punctuation), and must be entered on a single line.
  35.       *   There is no terminating ';'.
  36.       * (2) A maximum of 8 bind (input) variables is permitted.
  37.       *   Additional input variables are not bound, which will
  38.       *   cause an error at execute time.  Input values must be
  39.       *   enterable as character strings
  40.       *   (numeric or alphanumeric).
  41.       *   Placeholders for bind variables are :bv,
  42.       *   as for OBNDRV.
  43.       * (3) A maximum of 8 select-list items per table are
  44.       *   described and defined.  Additional columns are
  45.       *   not defined, which will cause unpredictable behavior
  46.       *   at fetch time.
  47.       * (4) Not all internal datatypes are handled for queries.
  48.       *   Selecting a RAW or LONG column could cause problems.
  49.  
  50.  
  51.        IDENTIFICATION DIVISION.
  52.        PROGRAM-ID.  CBDEM2.
  53.        ENVIRONMENT DIVISION.
  54.        DATA DIVISION.
  55.        WORKING-STORAGE SECTION.
  56.  
  57.       * Logon, cursor, and host data areas.
  58.        01  LDA.
  59.            02      LDA-V2RC    PIC S9(4) COMP.
  60.            02      FILLER      PIC X(10).
  61.            02      LDA-RC      PIC S9(4) COMP.
  62.            02      FILLER      PIC X(50).
  63.        01  CDA.
  64.            02      C-V2RC      PIC S9(4) COMP.
  65.            02      C-TYPE      PIC S9(4) COMP.
  66.            02      C-ROWS      PIC S9(9) COMP.
  67.            02      C-OFFS      PIC S9(4) COMP.
  68.            02      C-FNC       PIC S9(4) COMP.
  69.            02      C-RC        PIC S9(4) COMP.
  70.            02      FILLER      PIC X(50).
  71.        01  HDA                 PIC X(256).
  72.  
  73.       * Error message variables for the OERHMS routine.
  74.        01  MSGBUF              PIC X(256).
  75.        01  MSGBUF-L            PIC S9(9) VALUE 256 COMP.
  76.        01  ERR-FNC-D           PIC ZZZ.
  77.  
  78.       * Connect info.  Link the program single-task, or 
  79.       * modify to use a SQL*Net connect string appropriate
  80.       * to your site.
  81.        01  USER-ID             PIC X(5)  VALUE "SCOTT".
  82.        01  USER-ID-L           PIC S9(9) VALUE 5 COMP.
  83.        01  PSW                 PIC X(5)  VALUE "TIGER".
  84.        01  PSW-L               PIC S9(9) VALUE 5 COMP.
  85.        01  AUDIT               PIC S9(9) VALUE 0 COMP.
  86.  
  87.       * Parameters for OPARSE. 
  88.        01  SQL-STMT            PIC X(132).
  89.        01  SQLL                PIC S9(9) COMP.
  90.        01  DEF-MODE            PIC S9(9) VALUE 1 COMP.
  91.        01  NO-DEF-MODE         PIC S9(9) VALUE 0 COMP.
  92.        01  V7-FLG              PIC S9(9) VALUE 2 COMP.
  93.  
  94.       * Parameters for OBNDRV.
  95.        01  BVNX.
  96.            03  BV-NAME         OCCURS 25 TIMES.
  97.                05 BV-NAMEX     OCCURS 10 TIMES PIC X.
  98.        01  BVVX.
  99.            03  BV-VAL          OCCURS 10 TIMES PIC X(10).
  100.        01  BV-VAL-L            PIC S9(9) VALUE 10 COMP.
  101.        01  N-BV                PIC S9(9) COMP.
  102.  
  103.       * Parameters for ODESCR.  Note: some are two bytes (S9(4))
  104.       * some are four bytes (S9(9)).
  105.        01  DBSIZEX.
  106.            03  DBSIZE          OCCURS 8 TIMES PIC S9(9) COMP.
  107.        01  DBTYPEX.
  108.            03  DBTYPE          OCCURS 8 TIMES PIC S9(4) COMP.
  109.        01  NAMEX.
  110.            03  NAME            OCCURS 8 TIMES PIC X(10).
  111.        01  NAME-LX.
  112.            03  NAME-L          OCCURS 8 TIMES PIC S9(9) COMP.
  113.        01  DSIZEX.
  114.            03  DSIZE           OCCURS 8 TIMES PIC S9(9) COMP.
  115.        01  PRECX.
  116.            03  PREC            OCCURS 8 TIMES PIC S9(4) COMP.
  117.        01  SCALEX.
  118.            03  SCALE           OCCURS 8 TIMES PIC S9(4) COMP.
  119.        01  NULL-OKX.
  120.            03  NULL-OK         OCCURS 8 TIMES PIC S9(4) COMP.
  121.  
  122.       * Parameters for ODEFIN.
  123.        01  OV-CHARX.
  124.            03  OV-CHAR         OCCURS 8 TIMES PIC X(10).
  125.        01  OV-NUMX.
  126.            03  OV-NUM          OCCURS 8 TIMES
  127.                                   PIC S99999V99 COMP-3.
  128.        01  INDPX.
  129.            03  INDP            OCCURS 8 TIMES PIC S9(4) COMP.
  130.        01  N-OV                PIC S9(9) COMP.
  131.        01  N-ROWS              PIC S9(9) COMP.
  132.        01  N-ROWS-D            PIC ZZZ9 DISPLAY.
  133.        01  OV-CHAR-L           PIC S9(9) VALUE 10 COMP.
  134.        01  SEVEN               PIC S9(9) VALUE 7 COMP.
  135.        01  PACKED-DEC-L        PIC S9(9) VALUE 4 COMP.
  136.        01  PACKED-DEC-T        PIC S9(9) VALUE 7 COMP.
  137.        01  NUM-DISP            PIC ZZZZZ.ZZ.
  138.        01  FMT                 PIC X(6) VALUE "08.+02".
  139.        01  FMT-L               PIC S9(9) VALUE 6 COMP.
  140.  
  141.       * Miscellaneous parameters.
  142.        01  ZERO-A              PIC S9(9) VALUE 0 COMP.
  143.        01  ONE                 PIC S9(9) VALUE 1 COMP.
  144.        01  TWO                 PIC S9(9) VALUE 2 COMP.
  145.        01  FOUR                PIC S9(9) VALUE 4 COMP.
  146.        01  INDX                PIC S9(9) COMP.
  147.        01  NAME-D8             PIC X(8).
  148.        01  NAME-D10            PIC X(10).
  149.        01  VARCHAR2-T          PIC S9(9) VALUE 1 COMP.
  150.        01  NUMBER-T            PIC S9(9) VALUE 2 COMP.
  151.        01  INTEGER-T           PIC S9(9) VALUE 3 COMP.
  152.        01  DATE-T              PIC S9(9) VALUE 12 COMP.
  153.        01  CHAR-T              PIC S9(9) VALUE 96 COMP.
  154.  
  155.  
  156.  
  157.        PROCEDURE DIVISION.
  158.        BEGIN.
  159.  
  160.       * Connect to ORACLE using ORLON.
  161.            CALL "ORLON" USING LDA, HDA, USER-ID, USER-ID-L,
  162.                  PSW, PSW-L, AUDIT.
  163.       * Check for error, perform error routine if required.
  164.            IF LDA-RC NOT = 0
  165.               PERFORM ORA-ERROR
  166.               GO TO EXIT-STOP.
  167.  
  168.            DISPLAY "Logged on to ORACLE as user " USER-ID ".".
  169.  
  170.       * Open a cursor.  Only the first two parameters are
  171.       * used, the remainder (for V2 compatibility) are ignored.
  172.            CALL "OOPEN" USING CDA, LDA, USER-ID, ZERO-A,
  173.                  ZERO-A, USER-ID, ZERO-A.
  174.            IF C-RC IN CDA NOT = 0
  175.               PERFORM ORA-ERROR
  176.               GO TO EXIT-LOGOFF.
  177.  
  178.       * Process each SQL statement.
  179.        STMT-LOOP.
  180.            PERFORM DO-SQL-STMT.
  181.            GO TO STMT-LOOP.
  182.  
  183.        EXIT-CLOSE.
  184.            CALL "OCLOSE" USING CDA.
  185.        EXIT-LOGOFF.
  186.            CALL "OLOGOF" USING LDA.
  187.        EXIT-STOP.
  188.            STOP RUN.
  189.  
  190.       * Perform paragraphs.
  191.  
  192.        DO-SQL-STMT.
  193.            MOVE " " TO SQL-STMT.
  194.            DISPLAY "".
  195.            DISPLAY "> " NO ADVANCING.
  196.            ACCEPT SQL-STMT.
  197.       * Get first word of statement.
  198.            UNSTRING SQL-STMT DELIMITED BY ALL " "
  199.                     INTO BV-NAME(1).
  200.            IF (BV-NAME(1) = "exit" OR BV-NAME(1) = "EXIT")
  201.               GO TO EXIT-CLOSE.
  202.            MOVE 132 TO SQLL.
  203.       * Use non-deferred parse, to catch syntax errors
  204.       * right after the parse.
  205.            CALL "OPARSE" USING CDA, SQL-STMT, SQLL,
  206.                 NO-DEF-MODE, V7-FLG.
  207.            IF C-RC IN CDA NOT = 0
  208.               PERFORM ORA-ERROR
  209.               GO TO DO-SQL-STMT.
  210.  
  211.            PERFORM BIND-VARS.
  212.            DISPLAY "".
  213.            MOVE N-BV TO ERR-FNC-D.
  214.            DISPLAY "There were" ERR-FNC-D " bind variables.".
  215.  
  216.       * Execute the statement.
  217.            CALL "OEXN" USING CDA, ONE.
  218.            IF C-RC IN CDA NOT = 0
  219.               PERFORM ORA-ERROR
  220.               GO TO DO-SQL-STMT.
  221.  
  222.       * Describe the SQL statement, and define output
  223.       * variables if it is a query.  Limit output variables
  224.       * to eight.
  225.            PERFORM DESCRIBE-DEFINE THRU DESCRIBE-DEFINE-EXIT.
  226.  
  227.            SUBTRACT 1 FROM N-OV.
  228.            IF (N-OV > 0)
  229.                MOVE N-OV TO ERR-FNC-D
  230.                DISPLAY "There were" ERR-FNC-D
  231.                        " define variables."
  232.                DISPLAY ""
  233.                PERFORM VARYING INDX FROM 1 BY 1 UNTIL INDX > N-OV
  234.                   IF (DBTYPE(INDX) NOT = 2)
  235.                      MOVE NAME(INDX) TO NAME-D10
  236.                      DISPLAY NAME-D10 NO ADVANCING
  237.                   ELSE
  238.                      MOVE NAME(INDX) TO NAME-D8
  239.                      DISPLAY NAME-D8 NO ADVANCING
  240.                   END-IF
  241.                   DISPLAY " " NO ADVANCING
  242.                END-PERFORM
  243.                DISPLAY ""
  244.                PERFORM VARYING INDX FROM 1 BY 1 UNTIL INDX > N-OV
  245.                   DISPLAY "--------" NO ADVANCING
  246.                   IF DBTYPE(INDX) NOT = 2
  247.                      DISPLAY "--" NO ADVANCING
  248.                   END-IF
  249.                   DISPLAY " " NO ADVANCING
  250.                END-PERFORM
  251.                DISPLAY ""
  252.             END-IF.
  253.  
  254.       * If the statement was a query, fetch the rows and
  255.       * display them.
  256.            IF (C-TYPE IN CDA = 4)
  257.               PERFORM FETCHN THRU FETCHN-EXIT
  258.               MOVE N-ROWS TO N-ROWS-D
  259.               DISPLAY ""
  260.               DISPLAY N-ROWS-D " rows returned.".
  261.       * End of DO-SQL-STMT.
  262.  
  263.        BIND-VARS.
  264.            MOVE 0 TO N-BV.
  265.            PERFORM VARYING INDX FROM 1 BY 1 UNTIL INDX > 25
  266.              MOVE " " TO BV-NAME(INDX)
  267.            END-PERFORM.
  268.            UNSTRING SQL-STMT
  269.              DELIMITED BY "(" OR "," OR ";" OR "="
  270.                        OR ")" OR ALL " "
  271.                INTO BV-NAME(1)
  272.                     BV-NAME(2)
  273.                     BV-NAME(3)
  274.                     BV-NAME(4)
  275.                     BV-NAME(5)
  276.                     BV-NAME(6)
  277.                     BV-NAME(7)
  278.                     BV-NAME(8)
  279.                     BV-NAME(9)
  280.                     BV-NAME(10)
  281.                     BV-NAME(11)
  282.                     BV-NAME(12)
  283.                     BV-NAME(13)
  284.                     BV-NAME(14)
  285.                     BV-NAME(15)
  286.                     BV-NAME(16)
  287.                     BV-NAME(17)
  288.                     BV-NAME(18)
  289.                     BV-NAME(19)
  290.                     BV-NAME(20)
  291.                     BV-NAME(21)
  292.                     BV-NAME(22)
  293.                     BV-NAME(23)
  294.                     BV-NAME(24)
  295.                     BV-NAME(25).
  296.  
  297.       * Scan the words in the SQL statement.  If the
  298.       * word begins with ':', it is a placeholder for
  299.       * a bind variable.  Get a value for it (as a string)
  300.       * and bind using the OBNDRV routine, datatype 1.
  301.            MOVE 0 TO INDP(1).
  302.  
  303.            PERFORM VARYING INDX FROM 1 BY 1 UNTIL INDX > 25
  304.               IF BV-NAMEX(INDX,1) = ':'
  305.                  ADD 1 TO N-BV
  306.                  MOVE 0 TO SQLL
  307.                  INSPECT BV-NAME(INDX) TALLYING SQLL
  308.                     FOR CHARACTERS BEFORE INITIAL ' '
  309.                  DISPLAY "Enter value for " BV-NAME(INDX) " --> "
  310.                     NO ADVANCING
  311.                  ACCEPT BV-VAL(N-BV)
  312.                  CALL "OBNDRV" USING CDA, BV-NAME(INDX), SQLL,
  313.                       BV-VAL(N-BV), BV-VAL-L, VARCHAR2-T,
  314.                       ZERO-A, INDP(1)
  315.                  IF C-RC IN CDA NOT = 0
  316.                     PERFORM ORA-ERROR
  317.                     GO TO EXIT-CLOSE
  318.                  ELSE
  319.                     DISPLAY "Bound " BV-VAL(N-BV)
  320.                  END-IF
  321.               END-IF
  322.            END-PERFORM.
  323.  
  324.        DESCRIBE-DEFINE.
  325.            MOVE 0 TO N-OV.
  326.            PERFORM 9 TIMES
  327.               ADD 1 TO N-OV
  328.               IF (N-OV > 8)
  329.                  GO TO DESCRIBE-DEFINE-EXIT
  330.               END-IF
  331.               MOVE 10 TO NAME-L(N-OV)
  332.               MOVE " " TO NAME(N-OV)
  333.               CALL "ODESCR" USING CDA, N-OV, DBSIZE(N-OV),
  334.                     DBTYPE(N-OV),
  335.                     NAME(N-OV), NAME-L(N-OV), DSIZE(N-OV),
  336.                     PREC(N-OV), SCALE(N-OV), NULL-OK(N-OV)
  337.       * Check for end of select list.
  338.               IF (C-RC IN CDA = 1007)
  339.                  GO TO DESCRIBE-DEFINE-EXIT
  340.               END-IF
  341.  
  342.       * Check for error.
  343.               IF (C-RC IN CDA NOT = 0)
  344.                  PERFORM ORA-ERROR
  345.                  GO TO DESCRIBE-DEFINE-EXIT
  346.               END-IF
  347.       * Define an output variable for the select-list item.
  348.       * If it is a number, define a packed decimal variable,
  349.       * and create a format string for it.
  350.               IF (DBTYPE(N-OV) = 2)
  351.                  CALL "ODEFIN" USING CDA, N-OV, OV-NUM(N-OV),
  352.                       PACKED-DEC-L, PACKED-DEC-T, TWO,
  353.                       INDP(N-OV), FMT, FMT-L, PACKED-DEC-T
  354.               ELSE
  355.       * For all other types, convert to a VARCHAR2 of length 10.
  356.                  CALL "ODEFIN" USING CDA, N-OV, OV-CHAR(N-OV),
  357.                       OV-CHAR-L, VARCHAR2-T, ZERO-A, INDP(N-OV),
  358.                       FMT, ZERO-A, ZERO-A
  359.               END-IF
  360.               IF (C-RC IN CDA NOT = 0)
  361.                  PERFORM ORA-ERROR
  362.                  GO TO DESCRIBE-DEFINE-EXIT
  363.               END-IF
  364.            END-PERFORM.
  365.        DESCRIBE-DEFINE-EXIT.
  366.  
  367.  
  368.        FETCHN.
  369.            MOVE 0 TO N-ROWS.
  370.            PERFORM 10000 TIMES
  371.               CALL "OFETCH" USING CDA
  372.       * Check for end of fetch ("no data found")
  373.               IF C-RC IN CDA = 1403
  374.                  GO TO FETCHN-EXIT
  375.               END-IF
  376.               IF C-RC IN CDA NOT = 0
  377.                  PERFORM ORA-ERROR
  378.                  GO TO FETCHN-EXIT
  379.               END-IF
  380.               ADD 1 TO N-ROWS
  381.               PERFORM VARYING INDX FROM 1
  382.                       BY 1 UNTIL INDX > N-OV
  383.                  IF (DBTYPE(INDX) = 2)
  384.                     MOVE OV-NUM(INDX) TO NUM-DISP
  385.                     INSPECT NUM-DISP REPLACING ALL ".00" BY "   "
  386.                     DISPLAY NUM-DISP NO ADVANCING
  387.                  ELSE
  388.                     DISPLAY OV-CHAR(INDX) NO ADVANCING
  389.                  END-IF
  390.                  DISPLAY " " NO ADVANCING
  391.               END-PERFORM
  392.               DISPLAY ""
  393.            END-PERFORM.
  394.        FETCHN-EXIT.
  395.  
  396.  
  397.       * Report an error.  Obtain the error message
  398.       * text using the OERHMS routine.
  399.        ORA-ERROR.
  400.            IF LDA-RC IN LDA NOT = 0
  401.               DISPLAY "OLOGON error"
  402.               MOVE 0 TO C-FNC IN CDA
  403.               MOVE LDA-RC IN LDA TO C-RC IN CDA.
  404.            DISPLAY "ORACLE error " NO ADVANCING.
  405.            IF C-FNC NOT = 0
  406.               DISPLAY "processing OCI function" NO ADVANCING
  407.               MOVE C-FNC IN CDA TO ERR-FNC-D
  408.               DISPLAY ERR-FNC-D
  409.            ELSE
  410.               DISPLAY ":".
  411.  
  412.            MOVE " " TO MSGBUF.
  413.            CALL "OERHMS" USING LDA, C-RC IN CDA, MSGBUF,MSGBUF-L.
  414.            DISPLAY MSGBUF.
  415.  
  416.  
  417.