home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l360 / 3.ddi / SQLDEMO.@EM / SQLDDLEX.CBL < prev    next >
Encoding:
Text File  |  1991-04-08  |  39.1 KB  |  970 lines
  1.       $set mf warning(3)
  2.       $set sql sqlinit
  3.       ***************************************************************
  4.       *                                                             *
  5.       *     (c) Micro Focus Ltd. 1990                               *
  6.       *                                                             *
  7.       *        SQLDDLEX                                             *
  8.       *                                                             *
  9.       *        This program  executes single or multiple SQL DDL    *
  10.       *        Data Definition Language statements from a file      *
  11.       *        defined by user parameters.                          *
  12.       *        Parameters may be command line, file or interactive. *
  13.       *        SQL DDL statements must be delimited, the delimiter  *
  14.       *        is specified by user parameter, the default is <;>   *
  15.       *        (semi-colon).                                        *
  16.       *                                                             *
  17.       *        FILES                                                *
  18.       *        =====                                                *
  19.       *                                                             *
  20.       *        1. parameter-ds                                      *
  21.       *                                                             *
  22.       *        This file is read-only, and can contain parameters   *
  23.       *        to control the execution of the program in 'batch'   *
  24.       *        or 'detached' run modes.                             *
  25.       *                                                             *
  26.       *        The name of this file is hard coded.                 *
  27.       *                                                             *
  28.       *        2. message-ds                                        *
  29.       *                                                             *
  30.       *        This file is write-only, and logs program activity.  *
  31.       *        Each run appends to the file, so occasional clearing *
  32.       *        is required.                                         *
  33.       *                                                             *
  34.       *        The name of this file is hard coded.                 *
  35.       *                                                             *
  36.       *        3. dbmddl-ds                                         *
  37.       *                                                             *
  38.       *        This file is read-only, and contains the OS/2        *
  39.       *        Database Manager SQL Data Definition Language (DDL)  *
  40.       *        which is to be executed against the database         *
  41.       *        in the parameters.                                   *
  42.       *                                                             *
  43.       *        The name of this file is specified by parameter.     *
  44.       *                                                             *
  45.       *        RUNNING                                              *
  46.       *        =======                                              *
  47.       *                                                             *
  48.       *        The program is controlled by parameters.             *
  49.       *        The parameters may be specified interactively,       *
  50.       *        in a file, and on the command line.                  *
  51.       *                                                             *
  52.       *        These methods of specifying parameters may be        *
  53.       *        mixed by entering the correct run MODE TYPE (MT)     *
  54.       *        parameter when invoking the program.                 *
  55.       *                                                             *
  56.       ***************************************************************
  57.        environment division.
  58.       *=====================
  59.        configuration section.
  60.       *======================
  61.        special-names.
  62.       *==============
  63.                command-line is os2-cmd-line.
  64.       *
  65.        input-output section.
  66.       *=====================
  67.       *
  68.        file-control.
  69.       *=============
  70.       *
  71.        select parameter-ds
  72.                assign to dynamic parameter-ds-z1
  73.                organization is line sequential
  74.                file status is file-status-z1
  75.                .
  76.        select message-ds
  77.                assign to dynamic message-ds-z1
  78.                organization is line sequential
  79.                file status is file-status-z1
  80.                .
  81.        select dbmddl-ds
  82.                assign to dynamic dbmddl-ds-z1
  83.                organization is line sequential
  84.                file status is file-status-z1
  85.                .
  86.  
  87.        data division.
  88.       *==============
  89.  
  90.        file section.
  91.       *=============
  92.  
  93.        fd parameter-ds
  94.        recording mode v.
  95.       *=================
  96.  
  97.        01 parameter-rec.
  98.         03 parameter-line                  pic x(80).
  99.  
  100.        fd message-ds.
  101.       *==============
  102.  
  103.        01 message-rec.
  104.         03 message-line                    pic x(80).
  105.  
  106.        fd dbmddl-ds.
  107.       *=============
  108.  
  109.        01 dbmddl-rec.
  110.         03 dbmddl-line                     pic x(80).
  111.       * Redefines enables character by character move of DDL
  112.       * into the PREPARE buffer to remove redundant spaces
  113.         03 dbmddl-char
  114.            redefines
  115.            dbmddl-line                     pic x
  116.                                            occurs 80.
  117.  
  118.        working-storage section.
  119.       *========================
  120.       *
  121.        exec sql include sqlca end-exec.
  122.  
  123.        exec sql begin declare section end-exec.
  124.  
  125.       * Large buffer for SQL PREPARE
  126.        01 dbm-util-a0.
  127.         03 dbm-statement-a0.
  128.          49 dbm-statement-len-a0           pic s9(4) comp-5.
  129.          49 dbm-statement-text-a0          pic x(32640).
  130.  
  131.        exec sql end declare section end-exec.
  132.  
  133.       * Area for set up of PREPARE buffer defined as occurs
  134.       * to enable character by character move / space stripping
  135.        01 dbm-util-a1.
  136.         03 dbm-statement-a1.
  137.          49 dbm-ddl-char-a1                pic x
  138.                                            occurs 32640.
  139.  
  140.       * Log file formatted message area
  141.        01 message-line-01-a1.
  142.         03 message-lines-a1.
  143.          05 mess-line-1-a1.
  144.           07 margin-a1                     pic x(20).
  145.           07 literal-1-1-a1                pic x(8).
  146.           07 date-a1                       pic x(8).
  147.           07 literal-1-2-a1                pic x(8).
  148.           07 time-a1                       pic x(6).
  149.           07 space-1-1-a1                  pic x(30).
  150.          05 mess-line-2-a1.
  151.           07 mess-text-a1.
  152.            09 param-name-a1                pic x(2).
  153.            09 space-2-1-a1                 pic x(6).
  154.            09 param-value-a1               pic x(32).
  155.            09 space-2-2-a1                 pic x(30).
  156.           07 mess-dbmcode-a1               pic -9(9).
  157.         03 message-line-n-a1
  158.            redefines
  159.            message-lines-a1                pic x(80)
  160.                                            occurs 2.
  161.  
  162.       * Flags, hard coded names, counts, file status etc
  163.        01 utils-z1.
  164.         03 delimiter-found-z1              pic s9(4) comp-5.
  165.         03 dbm-statement-found-z1          pic s9(4) comp-5.
  166.         03 date-z1                         pic x(6).
  167.         03 time-z1                         pic x(8).
  168.         03 parameter-ds-z1                 pic x(64)
  169.                                            value
  170.        'd:\test\SQLDDLEX\SQLDDLEX.par'.
  171.         03 end-parameter-ds-z1             pic s9(4) comp-5
  172.                                            value -1.
  173.         03 end-dbmddl-ds-z1                pic s9(4) comp-5
  174.                                            value -1.
  175.         03 message-ds-z1                   pic x(64)
  176.                                            value
  177.            'd:\test\SQLDDLEX\SQLDDLEX.log   '.
  178.         03 dbmddl-ds-z1                    pic x(64).
  179.  
  180.         03 dbm-message-z1.
  181.          05 dbm-message-text-z1            pic x(70).
  182.          05 dbmcode-z1                     pic -9(9).
  183.         03 dbm-error-z1                    pic s9(4) comp-5
  184.                                            value -1.
  185.         03 dbm-codes-allowable-z1.
  186.          05 allow-dbmcode-z1               pic s9(4) comp-5.
  187.         03 files-opened-z1.
  188.          05 message-ds-open-z1             pic s9(4) comp-5.
  189.          05 parameter-ds-open-z1           pic s9(4) comp-5.
  190.          05 dbmddl-ds-open-z1              pic s9(4) comp-5.
  191.         03 file-status-z1                  pic x(2).
  192.         03 last-file-status-z1.
  193.          05 last-file-status-x-z1          pic x.
  194.          05 last-file-status-b-z1          pic 99 comp-x.
  195.         03 display-file-status-z1.
  196.          05 literal-status-z1              pic xx
  197.                                            value "9/".
  198.          05 display-status-z1              pic 999.
  199.         03 current-file-z1                 pic x(12)
  200.                                            value space.
  201.         03 mt-parameter-found-z1           pic s9(4) comp-5.
  202.         03 mode-type-save-z1               pic x(2).
  203.         03 char-sub-1-z1                   pic s9(4) comp-5.
  204.         03 char-sub-2-z1                   pic s9(4) comp-5.
  205.         03 dbm-statement-sub-z1            pic s9(4) comp-5.
  206.         03 ddl-char-action-z1              pic s9(4) comp-5.
  207.  
  208.       * Area for parameter storage in correct pictures
  209.        01 parameters-z2.
  210.         03 mode-z2                         pic x.
  211.         03 db-z2                           pic x(8).
  212.         03 delimiter-z2                    pic x
  213.                                            value ";".
  214.         03 dbmddl-ds-z2                    pic x(64).
  215.  
  216.       * Area for parameter specification
  217.        01 parameter-util-z3.
  218.         03 param-cmd-line-z3.
  219.          05 param-cmd-line-1-z3            pic x(120).
  220.         03 parameter-name-z3               pic x(4).
  221.         03 parameter-value-z3              pic x(64).
  222.         03 parameter-error-z3              pic s9(4) comp-5
  223.                                            value -1.
  224.         03 last-parameter-z3               pic s9(4) comp-5
  225.                                            value -1.
  226.         03 parameter-table-z3.
  227.          05 parameter-1-z3                 pic x(2)
  228.                                            value 'MT'.
  229.          05 parameter-1-ok-z3              pic s9(4) comp-5.
  230.          05 parameter-2-z3                 pic x(2)
  231.                                            value 'DB'.
  232.          05 parameter-2-ok-z3              pic s9(4) comp-5.
  233.          05 parameter-3-z3                 pic x(2)
  234.                                            value 'DL'.
  235.          05 parameter-3-ok-z3              pic s9(4) comp-5.
  236.          05 parameter-4-z3                 pic x(2)
  237.                                            value 'FN'.
  238.          05 parameter-4-ok-z3              pic s9(4) comp-5.
  239.         03 parameters-z3
  240.            redefines
  241.            parameter-table-z3              occurs 4.
  242.          05 parameter-name-n-z3            pic x(2).
  243.          05 parameter-ok-n-z3              pic s9(4) comp-5.
  244.         03 parameter-subscript-z3          pic s9(4) comp-5.
  245.         03 get-pars-type-z3                pic x.
  246.  
  247.       * Temporary area for parameters whilst checked
  248.        01 parameter-util-z4.
  249.         03 param-cmd-line-z4.
  250.          05 param-cmd-line-1-z4            pic x(120).
  251.         03 parameter-name-z4               pic x(4).
  252.         03 parameter-value-z4              pic x(64).
  253.         03 parameter-error-z4              pic s9(4) comp-5
  254.                                            value -1.
  255.         03 parameter-table-z4.
  256.          05 param-val-1-z4                 pic x(64).
  257.          05 param-val-2-z4                 pic x(64).
  258.          05 param-val-3-z4                 pic x(64).
  259.          05 param-val-4-z4                 pic x(64).
  260.         03 parameters-z4
  261.            redefines
  262.            parameter-table-z4              occurs 4.
  263.          05 param-val-n-z4                 pic x(64).
  264.         03 parameter-subscript-z4          pic s9(4) comp-5.
  265.  
  266.       * Data items for DBM CALL to start_using_database
  267.        01 dbm-call.
  268.         03 spare1                         pic 9(4) comp-5 value 0.
  269.         03 db-length                      pic 9(4) comp-5 value 0.
  270.         03 spare2                         pointer.
  271.         03 database                       pic x(10).
  272.         03 d-use                          pic 9(4) comp-5.
  273.         03 u                              pic x redefines d-use.
  274.  
  275.        procedure division.
  276.       *===================
  277.       *
  278.        a-1-start.
  279.       *==========
  280.       *
  281.       * Start up and main control
  282.                perform a-2-initial
  283.                if  parameter-error-z3 negative
  284.                    if  parameter-ok-n-z3(2) positive
  285.                    and parameter-ok-n-z3(4) positive
  286.                       perform a-3-main
  287.                    else
  288.                       move "Not all mandatory parameters specified"
  289.                       to   message-line
  290.                       perform z-1-write-message-rec
  291.                    end-if
  292.                end-if
  293.                perform z-9-stop
  294.                .
  295.       *
  296.        a-2-initial.
  297.       *============
  298.       *
  299.       * Examine command line invoking program and ensure
  300.       * at least MT (mode type) parameter specified
  301.       *
  302.       * Initialise log for this run, control parameter read and check
  303.       *
  304.                move -1 to message-ds-open-z1
  305.                move -1 to parameter-ds-open-z1
  306.                move -1 to allow-dbmcode-z1
  307.                accept param-cmd-line-z4 from os2-cmd-line
  308.                unstring param-cmd-line-z4
  309.                         delimited by space
  310.                         into
  311.                              param-val-n-z4(1)
  312.                              param-val-n-z4(2)
  313.                              param-val-n-z4(3)
  314.                              param-val-n-z4(4)
  315.                end-unstring
  316.                move -1 to mt-parameter-found-z1
  317.                perform with test before
  318.                        varying parameter-subscript-z4
  319.                        from    1
  320.                        by      1
  321.                        until parameter-subscript-z4 > 4
  322.                        or    mt-parameter-found-z1 positive
  323.                        move space to parameter-name-z4
  324.                        move space to parameter-value-z4
  325.                        unstring param-val-n-z4(parameter-subscript-z4)
  326.                           delimited by "="
  327.                           into
  328.                           parameter-name-z4
  329.                           parameter-value-z4
  330.                        end-unstring
  331.                        if  parameter-name-z4 = "MT"
  332.                            move 1 to mt-parameter-found-z1
  333.                            move parameter-value-z4 to mode-type-save-z1
  334.                        end-if
  335.                end-perform
  336.                move 'Messages' to current-file-z1
  337.                open extend message-ds
  338.                if  file-status-z1 = '00'
  339.                    move 1 to message-ds-open-z1
  340.                else
  341.                    move file-status-z1 to last-file-status-z1
  342.                    perform z-4-bad-file-status
  343.                    perform z-9-stop
  344.                end-if
  345.                accept date-z1 from date
  346.                accept time-z1 from time
  347.                move space to message-line-01-a1
  348.                move "===> SQLDDLEX" to margin-a1
  349.                move " Date:  " to literal-1-1-a1
  350.                move date-z1 to date-a1
  351.                move " Time:  " to literal-1-2-a1
  352.                move time-z1 to time-a1
  353.                move message-line-n-a1(1) to message-line
  354.                perform z-1-write-message-rec
  355.                move space to message-line-01-a1
  356.                if  mt-parameter-found-z1 negative
  357.                    move "No mode type parameter specified"
  358.                    to message-line
  359.                    perform z-1-write-message-rec
  360.                    move 1 to parameter-error-z3
  361.                end-if
  362.                perform with test before
  363.                        varying parameter-subscript-z3
  364.                        from 1 by 1
  365.                        until   parameter-subscript-z3 > 4
  366.                        move -1
  367.                        to parameter-ok-n-z3(parameter-subscript-z3)
  368.                end-perform
  369.                perform a-4-help
  370.                perform a-9-parameter-sequence
  371.                .
  372.       *
  373.        a-3-main.
  374.       *=========
  375.       *
  376.       *
  377.       * Parameters are OK, so now open up the DDL file and start
  378.       * using the correct datbase.
  379.       *
  380.       * Control for the reception and execution of DDL statements
  381.       *
  382.                move 'SQLDDL' to current-file-z1
  383.                open input dbmddl-ds
  384.                if  file-status-z1 = '00'
  385.                    move 1 to dbmddl-ds-open-z1
  386.                else
  387.                    move file-status-z1 to last-file-status-z1
  388.                    perform z-4-bad-file-status
  389.                    perform z-9-stop
  390.                end-if
  391.                move "++++++++ DDL follows (if found) ++++++++"
  392.                to   message-line
  393.                perform z-1-write-message-rec
  394.                move db-z2 to database
  395.                move zero to db-length
  396.                inspect database
  397.                        tallying db-length
  398.                        for characters before initial space
  399.       * Value 83 here causes character <S> in u data item of CALL
  400.       * This sets database usage to SHARE
  401.                move 83 to d-use
  402.                call    "__SQLGSTPD"
  403.                using   sqlca
  404.                if  sqlcode not = 0
  405.                    perform z-2-dbm-error
  406.                end-if
  407.                call    "__SQLGSTRD"
  408.                using   database
  409.                        spare2
  410.                        sqlca
  411.                        by value d-use
  412.                        by value db-length
  413.                        by value spare1
  414.                if  sqlcode not = 0
  415.                    perform z-2-dbm-error
  416.                end-if
  417.                perform with test before
  418.                        until end-dbmddl-ds-z1 positive
  419.                        or    dbm-error-z1     positive
  420.                    perform b-3-1-get-ddl-statement
  421.                    if  dbm-statement-found-z1 positive
  422.                        perform b-3-2-exec-ddl-statement
  423.                    end-if
  424.                end-perform
  425.                .
  426.       *
  427.        a-4-help.
  428.       *=========
  429.       *
  430.       * If no parameters specified or help requested
  431.       * put parameter details into LG
  432.       *
  433.                if  param-cmd-line-z4 = space
  434.                or  param-cmd-line-z4 = "H"
  435.                or  param-cmd-line-z4 = "h"
  436.                or  param-cmd-line-z4 = "HELP"
  437.                or  param-cmd-line-z4 = "Help"
  438.                or  param-cmd-line-z4 = "help"
  439.                    move 1 to parameter-error-z3
  440.                    move "Parameter names and meaning/values follow."
  441.                    to   message-line
  442.                    perform z-1-write-message-rec
  443.                    move "Parameters can be in any sequence."
  444.                    to   message-line
  445.                    perform z-1-write-message-rec
  446.                    perform z-1-write-message-rec
  447.                    move "MT=0<value<16 where value is mode-type"
  448.                    to   message-line
  449.                    perform z-1-write-message-rec
  450.                    move "DB=<database name>"
  451.                    to message-line
  452.                    perform z-1-write-message-rec
  453.                    move "DL=<delimiter character>"
  454.                    to   message-line
  455.                    perform z-1-write-message-rec
  456.                    move "FN=<Source file name for DDL statements>"
  457.                    to   message-line
  458.                    perform z-1-write-message-rec
  459.                    perform z-1-write-message-rec
  460.                end-if
  461.                .
  462.       *
  463.        a-5-file-parameters.
  464.       *====================
  465.       *
  466.       * Initialisation and control of reception of file parameters
  467.       *
  468.                if  parameter-error-z3 negative
  469.                    move 'Parameters' to current-file-z1
  470.                    open input parameter-ds
  471.                    if  file-status-z1 = '00'
  472.                        move 1 to parameter-ds-open-z1
  473.                    else
  474.                        move file-status-z1 to last-file-status-z1
  475.                        perform z-4-bad-file-status
  476.                        perform z-9-stop
  477.                    end-if
  478.                    perform b-2-1-get-pars-f
  479.                end-if
  480.                .
  481.       *
  482.        a-6-command-parameters.
  483.       *=======================
  484.       *
  485.       * Control of reception of command line parameters
  486.       *
  487.                if  parameter-error-z3 negative
  488.                    perform b-2-0-get-pars-c
  489.                end-if
  490.                .
  491.       *
  492.        a-7-interactive-parameters.
  493.       *===========================
  494.       *
  495.       * Control of reception of interactive parameters
  496.       *
  497.                if  parameter-error-z3 negative
  498.                    perform b-2-2-get-pars-i
  499.                end-if
  500.                .
  501.       *
  502.        a-9-parameter-sequence.
  503.       *=======================
  504.       *
  505.       * LOTS OF CHOICE HERE - ALL POSSIBLE COMBINATIONS
  506.       * You may want to comment out the ones you don't want active
  507.       *
  508.       * The differing sequence of reading parameters may offer a
  509.       * suitable choice for your environment or specific needs
  510.       *
  511.       * NOTE that the MT parameter is ONLY valid on the command line
  512.       *
  513.                if  parameter-error-z3 negative
  514.                    evaluate true
  515.                    when  mode-type-save-z1 = "1"
  516.                        perform a-6-command-parameters
  517.                    when  mode-type-save-z1 = "2"
  518.                        perform a-5-file-parameters
  519.                    when  mode-type-save-z1 = "3"
  520.                        perform a-7-interactive-parameters
  521.                    when  mode-type-save-z1 = "4"
  522.                        perform a-6-command-parameters
  523.                        perform a-5-file-parameters
  524.                    when  mode-type-save-z1 = "5"
  525.                        perform a-5-file-parameters
  526.                        perform a-6-command-parameters
  527.                    when  mode-type-save-z1 = "6"
  528.                        perform a-6-command-parameters
  529.                        perform a-7-interactive-parameters
  530.                    when  mode-type-save-z1 = "7"
  531.                        perform a-7-interactive-parameters
  532.                        perform a-6-command-parameters
  533.                    when  mode-type-save-z1 = "8"
  534.                        perform a-5-file-parameters
  535.                        perform a-7-interactive-parameters
  536.                    when  mode-type-save-z1 = "9"
  537.                        perform a-7-interactive-parameters
  538.                        perform a-5-file-parameters
  539.                    when  mode-type-save-z1 = "10"
  540.                        perform a-6-command-parameters
  541.                        perform a-7-interactive-parameters
  542.                        perform a-5-file-parameters
  543.                    when  mode-type-save-z1 = "11"
  544.                        perform a-7-interactive-parameters
  545.                        perform a-6-command-parameters
  546.                        perform a-5-file-parameters
  547.                    when  mode-type-save-z1 = "12"
  548.                        perform a-6-command-parameters
  549.                        perform a-5-file-parameters
  550.                        perform a-7-interactive-parameters
  551.                    when  mode-type-save-z1 = "13"
  552.                        perform a-5-file-parameters
  553.                        perform a-6-command-parameters
  554.                        perform a-7-interactive-parameters
  555.                    when  mode-type-save-z1 = "14"
  556.                        perform a-5-file-parameters
  557.                        perform a-7-interactive-parameters
  558.                        perform a-6-command-parameters
  559.                    when  mode-type-save-z1 = "15"
  560.                        perform a-7-interactive-parameters
  561.                        perform a-5-file-parameters
  562.                        perform a-6-command-parameters
  563.                    when other
  564.                        move "Invalid mode type (MT) specified follows:"
  565.                        to   message-line
  566.                        perform z-1-write-message-rec
  567.                        move mode-type-save-z1
  568.                        to   message-line
  569.                        perform z-1-write-message-rec
  570.                        move 1 to parameter-error-z3
  571.                    end-evaluate
  572.                end-if
  573.                .
  574.       *
  575.        b-2-0-get-pars-c.
  576.       *=================
  577.       *
  578.       * Get parameters from the command line
  579.       * LOG the source and each parameter
  580.       *
  581.                move 'Command line parameters:'
  582.                to   message-line
  583.                perform z-1-write-message-rec
  584.                perform with test before
  585.                        varying parameter-subscript-z4
  586.                        from    1
  587.                        by      1
  588.                        until parameter-subscript-z4 > 4
  589.                        or    parameter-error-z3 positive
  590.                        or    last-parameter-z3 positive
  591.                        move space to parameter-name-z4
  592.                        move space to parameter-value-z4
  593.                        unstring param-val-n-z4(parameter-subscript-z4)
  594.                           delimited by "="
  595.                           into
  596.                           parameter-name-z4
  597.                           parameter-value-z4
  598.                        end-unstring
  599.                        if  parameter-name-z4 = space
  600.                            move 1 to last-parameter-z3
  601.                        else
  602.                            move parameter-name-z4
  603.                            to   parameter-name-z3
  604.                            move parameter-value-z4
  605.                            to   parameter-value-z3
  606.                            move 'C' to get-pars-type-z3
  607.                            perform c-2-0-what-par
  608.                        end-if
  609.                end-perform
  610.                .
  611.       *
  612.        b-2-1-get-pars-f.
  613.       *=================
  614.       *
  615.       * Get and control check for parameters from the parameter file
  616.       * LOG the source and each parameter
  617.       *
  618.                move 'File parameters file name follows:'
  619.                to   message-line
  620.                perform z-1-write-message-rec
  621.                move parameter-ds-z1
  622.                to   message-line
  623.                perform z-1-write-message-rec
  624.                perform until end-parameter-ds-z1 = 1
  625.                        or    parameter-error-z3 positive
  626.                    read parameter-ds
  627.                         at end
  628.                         move 1 to end-parameter-ds-z1
  629.                    end-read
  630.                    if end-parameter-ds-z1 negative
  631.                       unstring parameter-line
  632.                                delimited by '='
  633.                                into parameter-name-z3
  634.                                     parameter-value-z3
  635.                       end-unstring
  636.                       move 'F' to get-pars-type-z3
  637.                       perform c-2-0-what-par
  638.                    end-if
  639.                end-perform
  640.                .
  641.       *
  642.        b-2-2-get-pars-i.
  643.       *=================
  644.       *
  645.       * Get and control check for parameters from the screen
  646.       * LOG the source and each parameter
  647.       *
  648.                move 'Interactive parameters:'
  649.                to   message-line
  650.                perform z-1-write-message-rec
  651.                perform varying parameter-subscript-z3
  652.                        from    2
  653.                        by      1
  654.                        until parameter-subscript-z3 > 4
  655.                        move parameter-name-n-z3(parameter-subscript-z3)
  656.                        to   parameter-name-z3
  657.                        if  parameter-ok-n-z3(parameter-subscript-z3)
  658.                            negative
  659.                            display 'Please enter value for '
  660.                                    parameter-name-z3
  661.                            accept parameter-value-z3
  662.                            move 'I' to get-pars-type-z3
  663.                            perform c-2-0-what-par
  664.                        end-if
  665.                end-perform
  666.                .
  667.       *
  668.        b-3-1-get-ddl-statement.
  669.       *========================
  670.       *
  671.       * Move the DDL file SQL statements into the PREPARE buffer
  672.       * one character at a time, ignoring redundant spaces and comments
  673.       * until the delimiter is reached or file end on the DDL file
  674.       * LOG each line read from the DDL file
  675.       *
  676.                move -1 to delimiter-found-z1
  677.                move zero to dbm-statement-sub-z1
  678.                move -1 to dbm-statement-found-z1
  679.                perform until delimiter-found-z1 positive
  680.                        or    end-dbmddl-ds-z1   positive
  681.                    perform z-3-read-dbmddl-ds
  682.                    if  end-dbmddl-ds-z1 negative
  683.                        move dbmddl-rec to message-line
  684.                        perform z-1-write-message-rec
  685.                        perform with test before
  686.                            varying char-sub-1-z1
  687.                            from 1 by 1
  688.                            until char-sub-1-z1 > 80
  689.                        if  char-sub-1-z1 < 80
  690.                            add 1 char-sub-1-z1
  691.                                giving char-sub-2-z1
  692.                        end-if
  693.                        if  dbmddl-char(char-sub-1-z1)
  694.                            = space
  695.                        and dbmddl-char(char-sub-2-z1)
  696.                            = space
  697.                            move 0 to ddl-char-action-z1
  698.                        end-if
  699.                        if  dbmddl-char(char-sub-1-z1)
  700.                            not = space
  701.                        and dbmddl-char(char-sub-1-z1)
  702.                            not = delimiter-z2
  703.                        and dbmddl-char(char-sub-1-z1)
  704.                            not = "-"
  705.                            move 1 to ddl-char-action-z1
  706.                            add 1 to dbm-statement-sub-z1
  707.                            move dbmddl-char(char-sub-1-z1)
  708.                            to   dbm-ddl-char-a1(dbm-statement-sub-z1)
  709.                            move 1 to dbm-statement-found-z1
  710.                        end-if
  711.                        if  dbmddl-char(char-sub-1-z1)
  712.                            = space
  713.                        and dbmddl-char(char-sub-2-z1)
  714.                            not = space
  715.                            move 2 to ddl-char-action-z1
  716.                            add 1 to dbm-statement-sub-z1
  717.                            move dbmddl-char(char-sub-1-z1)
  718.                            to   dbm-ddl-char-a1(dbm-statement-sub-z1)
  719.                        end-if
  720.                        if  dbmddl-char(char-sub-1-z1)
  721.                            = space
  722.                        and char-sub-1-z1 = 80
  723.                            move 2 to ddl-char-action-z1
  724.                            add 1 to dbm-statement-sub-z1
  725.                            move dbmddl-char(char-sub-1-z1)
  726.                            to   dbm-ddl-char-a1(dbm-statement-sub-z1)
  727.                        end-if
  728.                        if  dbmddl-char(char-sub-1-z1)
  729.                            = "-"
  730.                        and dbmddl-char(char-sub-2-z1)
  731.                            = "-"
  732.                            move 3 to ddl-char-action-z1
  733.                            move 80 to char-sub-1-z1
  734.                        end-if
  735.                        if  dbmddl-char(char-sub-1-z1)
  736.                            = delimiter-z2
  737.                            move 4 to ddl-char-action-z1
  738.                            move 1 to delimiter-found-z1
  739.                            move dbm-statement-sub-z1
  740.                            to   dbm-statement-len-a0
  741.                        end-if
  742.                    end-if
  743.                end-perform
  744.                move dbm-statement-a1 to dbm-statement-text-a0
  745.                .
  746.       *
  747.        b-3-2-exec-ddl-statement.
  748.       *=========================
  749.       *
  750.       * PREPARE and EXECUTE the DDL statement from the buffer
  751.       * LOG the SQLCODEs
  752.       *
  753.                exec sql
  754.                        prepare dbmddl1
  755.                        from :dbm-statement-a0
  756.                end-exec
  757.                if  sqlcode not = 0
  758.                    perform z-2-dbm-error
  759.                end-if
  760.                move "**** PREPARE SQL CODE:"
  761.                to dbm-message-text-z1
  762.                move sqlcode to dbmcode-z1
  763.                move dbm-message-z1 to message-line
  764.                perform z-1-write-message-rec
  765.                exec sql
  766.                        execute dbmddl1
  767.                end-exec
  768.                if  sqlcode not = 0
  769.                    perform z-2-dbm-error
  770.                end-if
  771.                move "**** EXECUTE SQL CODE:"
  772.                to dbm-message-text-z1
  773.                move sqlcode to dbmcode-z1
  774.                move dbm-message-z1 to message-line
  775.                perform z-1-write-message-rec
  776.                .
  777.       *
  778.        c-2-0-what-par.
  779.       *===============
  780.       *
  781.       * Determine which parameter type is current
  782.       * Control specific check for each type
  783.       *
  784.                move space to mess-line-2-a1
  785.                string parameter-name-z3 delimited by space
  786.                       "=" delimited by size
  787.                into   param-name-a1
  788.                end-string
  789.                move parameter-value-z3 to param-value-a1
  790.                move mess-line-2-a1 to message-line
  791.                perform z-1-write-message-rec
  792.                evaluate true
  793.                         when parameter-name-z3 = 'MT'
  794.                                perform c-2-2-mode
  795.                         when parameter-name-z3 = 'DB'
  796.                                perform c-2-3-db
  797.                         when parameter-name-z3 = 'DL'
  798.                                perform c-2-4-dl
  799.                         when parameter-name-z3 = 'FN'
  800.                                perform c-2-5-fn
  801.                         when other
  802.                                perform c-2-1-pars-error
  803.                end-evaluate
  804.                .
  805.       *
  806.        c-2-1-pars-error.
  807.       *=================
  808.       *
  809.       * LOG parameter error and current parameter
  810.       *
  811.                move 1 to parameter-error-z3
  812.                if  get-pars-type-z3 not = 'C'
  813.                and parameter-name-z3 = 'MT'
  814.                    move 'MT invalid from file or interactive'
  815.                    to   message-line
  816.                    perform z-1-write-message-rec
  817.                else
  818.                    move 'Unknown or invalid parameter specified'
  819.                    to   message-line
  820.                    perform z-1-write-message-rec
  821.                end-if
  822.                move 'See last parameter in above list.'
  823.                to   message-line
  824.                perform z-1-write-message-rec
  825.                .
  826.       *
  827.        c-2-2-mode.
  828.       *===========
  829.       *
  830.       * Specific check/move for MODE TYPE
  831.       *
  832.                if parameter-error-z3 negative
  833.                   move parameter-value-z3 to mode-z2
  834.                   move 1 to parameter-ok-n-z3(1)
  835.                   if get-pars-type-z3 not = 'C'
  836.                      perform c-2-1-pars-error
  837.                   end-if
  838.                end-if
  839.                .
  840.       *
  841.        c-2-3-db.
  842.       *=========
  843.       *
  844.       * Specific check/move for DATABASE
  845.       *
  846.                if parameter-error-z3 negative
  847.                   move parameter-value-z3 to db-z2
  848.                   move 1 to parameter-ok-n-z3(2)
  849.                end-if
  850.                .
  851.       *
  852.        c-2-4-dl.
  853.       *=========
  854.       *
  855.       * Specific check/move for DELIMITER
  856.       *
  857.                if parameter-error-z3 negative
  858.                   move parameter-value-z3 to delimiter-z2
  859.                   move 1 to parameter-ok-n-z3(3)
  860.                end-if
  861.                .
  862.       *
  863.        c-2-5-fn.
  864.       *=========
  865.       *
  866.       * Specific check/move for file name
  867.       *
  868.                if parameter-error-z3 negative
  869.                   move parameter-value-z3 to dbmddl-ds-z1
  870.                   move parameter-value-z3 to dbmddl-ds-z2
  871.                   move 1 to parameter-ok-n-z3(4)
  872.                end-if
  873.                .
  874.       *
  875.        z-1-write-message-rec.
  876.       *======================
  877.       *
  878.       * Write out a line to the LOG File
  879.       *
  880.                write message-rec
  881.                move space to message-line
  882.                .
  883.       *
  884.        z-2-dbm-error.
  885.       *==============
  886.       *
  887.       * SQLCODE was bad, so write message and code to LOG
  888.       *
  889.                if  sqlcode not = allow-dbmcode-z1
  890.                    move 1 to dbm-error-z1
  891.                    move sqlcode to dbmcode-z1
  892.                    move 'sqlcode returned with bad value'
  893.                    to   dbm-message-text-z1
  894.                    move dbm-message-z1 to message-line
  895.                    perform z-1-write-message-rec
  896.                    move "SQLCA sqlerrmc contents follow:"
  897.                    to message-line
  898.                    perform z-1-write-message-rec
  899.                    move sqlerrmc
  900.                    to   dbm-message-text-z1
  901.                    move dbm-message-z1 to message-line
  902.                    perform z-1-write-message-rec
  903.                    perform z-9-stop
  904.                .
  905.       *
  906.        z-3-read-dbmddl-ds.
  907.       *===================
  908.       *
  909.       * Read the DDL file
  910.       *
  911.                read dbmddl-ds
  912.                    at end
  913.                        move 1 to end-dbmddl-ds-z1
  914.                .
  915.       *
  916.        z-4-bad-file-status.
  917.       *====================
  918.       *
  919.       * LOG bad file status code
  920.       *
  921.                move "Bad file status on open."
  922.                to   message-line
  923.                perform z-1-write-message-rec
  924.                move "File name and status follow:"
  925.                to   message-line
  926.                perform z-1-write-message-rec
  927.                move current-file-z1
  928.                to   message-line
  929.                perform z-1-write-message-rec
  930.                move last-file-status-b-z1
  931.                to   display-status-z1
  932.                move display-file-status-z1
  933.                to   message-line
  934.                perform z-1-write-message-rec
  935.                .
  936.       *
  937.        z-9-stop.
  938.       *=========
  939.       *
  940.       * JOY or MISERY depending on what happened back there
  941.       * LOG end of run <==== EYECATCHER <====
  942.       *
  943.                move "<=== End of RUN" to message-line
  944.                perform z-1-write-message-rec
  945.                perform z-9-100
  946.                perform z-9-999
  947.                .
  948.       *
  949.        z-9-100.
  950.       *========
  951.       *
  952.                if  parameter-ds-open-z1 positive
  953.                    close parameter-ds
  954.                end-if
  955.                if  message-ds-open-z1 positive
  956.                    close message-ds
  957.                end-if
  958.                if  dbmddl-ds-open-z1 positive
  959.                    close dbmddl-ds
  960.                end-if
  961.                .
  962.       *
  963.        z-9-999.
  964.       *========
  965.       *
  966.       * Finally its all over!
  967.       *
  968.                stop run
  969.                .
  970.