 Main Menu 
Download Documentation Development Who's Online 24 user(s) are online ( 6 user(s) are browsing Forum) Members: 0 Guests: 24 more...
Powered by |
| Poster |
Thread |
| the_piper |
Posted on: 2012/4/21 0:30 |
Just popping in   Joined: 2009/9/18 From: Posts: 17 |
OpenCobol and MySql precompiler WARNING! WALL OF TEXT!! Recently i had some spare time, so i worked on some stuff to create an environment for OpenCobol, like i used to work with on IBM mainframes and COBOL and DB2 for years. The result right now is a framework and a precompiler for MySql, which should make it easier to write applications using MySql. It's not even beta stage right now, but the first test program is working, so i wanted to post it here and ask for comments, suggesion or better ideas. This all is based on the api for MySql posted in this forum here some years ago. I had to modify that a little bit, add some stuff, but now it's working. So the credits don't only go to me, but too to the people, who created cobmysqlapi.c. And while we are on it, you have to create a table, as they described in their thread about cobmysqlapi.c, example_table, containing field1, field2, field3 to run this example (later, when i release the full source code). The input file for the precompiler is named PCTB001B.scb. This is a naming convention, no idea, how important it will be at the end: PCTB - The category of the program, you can group programs, which belong together with this naming convention. Just 4 letters like PCTB, or TEST, or ACCT or whatever. 001 - just a number to identify a program within a category B - it is a Batch program, future plan is "T" = transactions, which will run in a http server .scb - the suffix, Sql CoBol, the input for the preprocessor The framework itself handles stuff like connecting to a database, provide error handling procedures and such. So, this is how an input for the preprocessor might look like:
----+-*--1----+----2----+----3----+----4----+----5----+----6----+----7-*--+----8
**************************************************************************
* I D E N T I F I C A T I O N D I V I S I O N *
**************************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. PCTB001B.
AUTHOR. THE_PIPER.
DATE-WRITTEN. TODAY.
/
**************************************************************************
* D A T A D I V I S I O N *
**************************************************************************
DATA DIVISION.
/
**************************************************************************
* W O R K I N G S T O R A G E S E C T I O N *
**************************************************************************
WORKING-STORAGE SECTION.
*
* The needed working storage stuff for the framework
COPY POCTBBATWS.
*
* This will be displayed in the logfile at runtime
01 POCTB-VERSION PIC X(38)
VALUE '20120408 1.0 INITIAL RELEASE'.
*
01 FIELD1 PIC X(20).
01 FIELD2 PIC X(16).
01 FIELD3 PIC X(32).
*
* The communication area for the database
EXEC SQL
INCLUDE SQLCA.
END-EXEC.
/
**************************************************************************
* P R O C E D U R E D I V I S I O N *
**************************************************************************
PROCEDURE DIVISION.
* The framework itself, calling POCTB-ACTION to run the users coding
EXEC SQL
INCLUDE POCTBBAT REPLACING 'TTTTNNNB' BY 'PCTB001B'.
END-EXEC.
/
**************************************************************************
* P O C T B - A C T I O N S E C T I O N *
**************************************************************************
POCTB-ACTION SECTION.
*
DISPLAY 'In POCTB-ACTION.'
*
PERFORM DISPLAY-ALL-RECORDS
*
DISPLAY 'Delete entire table'
*
EXEC SQL
DELETE
FROM example_table
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
DISPLAY 'Insert new records'
*
EXEC SQL
INSERT
INTO example_table
(
FIELD1,
FIELD2,
FIELD3
)
VALUES
(
'Value1' ,
'Value2' ,
'Value3'
)
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
EXEC SQL
INSERT
INTO example_table
(
FIELD1,
FIELD2,
FIELD3
)
VALUES
(
'2Value1' ,
'2Value2' ,
'2Value3'
)
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
EXEC SQL
INSERT
INTO example_table
(
FIELD1,
FIELD2,
FIELD3
)
VALUES
(
'3Value1' ,
'3Value2' ,
'3Value3'
)
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
PERFORM DISPLAY-ALL-RECORDS
*
DISPLAY 'Update the first record'
*
EXEC SQL
UPDATE example_table
SET FIELD1 = 'UpdatedValue1'
WHERE FIELD1 = 'Value1'
END-EXEC.
* DISPLAY 'SQLCA-STATEMENT=' SQLCA-STATEMENT
* DISPLAY 'SQLCODE=' SQLCODE
* DISPLAY 'SQLCA-COUNT=' SQLCA-COUNT
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
PERFORM DISPLAY-ALL-RECORDS
*
DISPLAY 'Ende POCTB-ACTION.'
*
* test test test test test test
* MOVE 123 TO SQLCODE
*
.
POCTB-ACTION-EXIT.
EXIT.
/
**************************************************************************
DISPLAY-ALL-RECORDS SECTION.
*
DISPLAY '-------------------------------------------'
* Attention !! Table name is CaSe sensitive!!!!!!!!!!!!!
EXEC SQL
SELECT FIELD1, FIELD2, FIELD3
INTO :FIELD1 :FIELD2 :FIELD3
FROM example_table
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN DB-NOT-FOUND
SET DB-OK TO TRUE
MOVE SPACE TO FIELD1
MOVE SPACE TO FIELD2
MOVE SPACE TO FIELD3
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
DISPLAY 'FIELD1=' FIELD1 ' FIELD2=' FIELD2
' FIELD3=' FIELD3
SET DB-OK TO TRUE
PERFORM UNTIL NOT DB-OK
EXEC SQL
FETCH RESULT
INTO :FIELD1 :FIELD2 :FIELD3
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
DISPLAY 'FIELD1=' FIELD1 ' FIELD2=' FIELD2
' FIELD3=' FIELD3
WHEN DB-NOT-FOUND
MOVE SPACE TO FIELD1
MOVE SPACE TO FIELD2
MOVE SPACE TO FIELD3
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
END-PERFORM
SET DB-OK TO TRUE
DISPLAY '-------------------------------------------'
.
DISPLAY-ALL-RECORDS-EXIT.
EXIT.
The output of the precompiler, the *.cob file, looks like this:
* dbprae: PCTB001B.cob 20120420-224206
------*-------------------------------------------------------------------------
----+-*--1----+----2----+----3----+----4----+----5----+----6----+----7-*--+----8
**************************************************************************
* I D E N T I F I C A T I O N D I V I S I O N *
**************************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. PCTB001B.
DBPRE * AUTHOR. THE_PIPER.
DBPRE * DATE-WRITTEN. TODAY.
/
**************************************************************************
* D A T A D I V I S I O N *
**************************************************************************
DATA DIVISION.
/
**************************************************************************
* W O R K I N G S T O R A G E S E C T I O N *
**************************************************************************
WORKING-STORAGE SECTION.
*
* The needed working storage stuff for the framework
COPY POCTBBATWS.
*
* This will be displayed in the logfile at runtime
01 POCTB-VERSION PIC X(38)
VALUE '20120408 1.0 INITIAL RELEASE'.
*
01 FIELD1 PIC X(20).
01 FIELD2 PIC X(16).
01 FIELD3 PIC X(32).
*
* The communication area for the database
* EXEC SQL
* INCLUDE SQLCA.
01 SQLCA.
05 SQLCA-CID USAGE POINTER.
05 SQLCA-RESULT USAGE POINTER.
05 SQLCA-SEQUENCE PIC 9(08).
05 SQLCA-COUNT PIC 9(08).
05 FILLER PIC X VALUE LOW-VALUE.
05 SQLCA-RETURN-CODE PIC 9(03).
05 SQLCA-CROWCNT PIC X(08).
05 SQLCA-ROWCNT PIC 9(08).
88 SQLCA-NO-ROW VALUE 0.
88 SQLCA-ONE-ROW VALUE 1.
88 SQLCA-MORE-THAN-ONE-ROW VALUE 2 THRU 99999999.
05 FILLER PIC X VALUE LOW-VALUE.
05 SQLCA-HOST PIC X(32).
05 FILLER PIC X VALUE LOW-VALUE.
05 SQLCA-USER PIC X(32).
05 FILLER PIC X VALUE LOW-VALUE.
05 SQLCA-PASSWD PIC X(32).
05 FILLER PIC X VALUE LOW-VALUE.
05 SQLCA-DBNAME PIC X(32).
05 FILLER PIC X VALUE LOW-VALUE.
05 SQLCA-PORT PIC 9(05).
05 FILLER PIC X VALUE LOW-VALUE.
05 SQLCA-SOCKET PIC X(32).
05 FILLER PIC X VALUE LOW-VALUE.
05 SQLCA-QUOTE PIC X VALUE "'".
05 SQLCA-CARD PIC X(80).
05 SQLCA-STATEMENT.
10 SQLCA-STAT-LINE OCCURS 80 PIC X(25).
05 FILLER PIC X VALUE LOW-VALUE.
05 SQLCODE PIC 9(03).
88 DB-OK VALUE 0.
88 DB-NOT-FOUND VALUE 100.
DBPRE * END-EXEC.
/
**************************************************************************
* P R O C E D U R E D I V I S I O N *
**************************************************************************
PROCEDURE DIVISION.
* The framework itself, calling POCTB-ACTION to run the users coding
DBPRE MOVE 1 TO SQLCA-SEQUENCE
* EXEC SQL
* INCLUDE POCTBBAT REPLACING 'TTTTNNNB' BY 'PCTB001B'.
----+-*--1-!--+----2----+----3----+----4----+----5----+----6----+----7-!--+----8
*
MOVE 'PCTB001B' TO POCTB-PROGRAM-NAME
*
ACCEPT SQLCA-CARD FROM SYSIN
IF SQLCA-CARD(1:7) = 'DBHOST='
MOVE SQLCA-CARD(8:38) TO SQLCA-HOST
ELSE
MOVE SPACES TO POCTB-ERROR-MESSAGE
STRING 'Invalid SYSIN card, DBHOST= expected: '
DELIMITED SIZE
SQLCA-CARD DELIMITED SIZE
INTO POCTB-ERROR-MESSAGE
END-STRING
PERFORM POCTB-DISPLAY-ERROR
MOVE 1 TO RETURN-CODE
STOP RUN
END-IF
*
ACCEPT SQLCA-CARD FROM SYSIN
IF SQLCA-CARD(1:7) = 'DBUSER='
MOVE SQLCA-CARD(8:38) TO SQLCA-USER
ELSE
MOVE SPACES TO POCTB-ERROR-MESSAGE
STRING 'Invalid SYSIN card, DBUSER= expected: '
DELIMITED SIZE
SQLCA-CARD DELIMITED SIZE
INTO POCTB-ERROR-MESSAGE
END-STRING
PERFORM POCTB-DISPLAY-ERROR
MOVE 1 TO RETURN-CODE
STOP RUN
END-IF
*
ACCEPT SQLCA-CARD FROM SYSIN
IF SQLCA-CARD(1:9) = 'DBPASSWD='
MOVE SQLCA-CARD(10:40) TO SQLCA-PASSWD
ELSE
MOVE SPACES TO POCTB-ERROR-MESSAGE
STRING 'Invalid SYSIN card, DBPASSWD= expected: '
DELIMITED SIZE
SQLCA-CARD DELIMITED SIZE
INTO POCTB-ERROR-MESSAGE
END-STRING
PERFORM POCTB-DISPLAY-ERROR
MOVE 1 TO RETURN-CODE
STOP RUN
END-IF
*
ACCEPT SQLCA-CARD FROM SYSIN
IF SQLCA-CARD(1:7) = 'DBNAME='
MOVE SQLCA-CARD(8:38) TO SQLCA-DBNAME
ELSE
MOVE SPACES TO POCTB-ERROR-MESSAGE
STRING 'Invalid SYSIN card, DBNAME= expected: '
DELIMITED SIZE
SQLCA-CARD DELIMITED SIZE
INTO POCTB-ERROR-MESSAGE
END-STRING
PERFORM POCTB-DISPLAY-ERROR
MOVE 1 TO RETURN-CODE
STOP RUN
END-IF
*
ACCEPT SQLCA-CARD FROM SYSIN
IF SQLCA-CARD(1:7) = 'DBPORT='
MOVE SQLCA-CARD(8:5) TO SQLCA-PORT
ELSE
MOVE SPACES TO POCTB-ERROR-MESSAGE
STRING 'Invalid SYSIN card, DBPORT= expected: '
DELIMITED SIZE
SQLCA-CARD DELIMITED SIZE
INTO POCTB-ERROR-MESSAGE
END-STRING
PERFORM POCTB-DISPLAY-ERROR
MOVE 1 TO RETURN-CODE
STOP RUN
END-IF
*
ACCEPT SQLCA-CARD FROM SYSIN
IF SQLCA-CARD(1:9) = 'DBSOCKET='
MOVE SQLCA-CARD(10:40) TO SQLCA-SOCKET
ELSE
MOVE SPACES TO POCTB-ERROR-MESSAGE
STRING 'Invalid SYSIN card, DBSOCKET= expected: '
DELIMITED SIZE
SQLCA-CARD DELIMITED SIZE
INTO POCTB-ERROR-MESSAGE
END-STRING
PERFORM POCTB-DISPLAY-ERROR
MOVE 1 TO RETURN-CODE
STOP RUN
END-IF
ACCEPT POCTB-DATE FROM DATE
ACCEPT POCTB-TIME FROM TIME
*
DISPLAY '*******************************************'
'*********'
DISPLAY '* '
' *'
DISPLAY '* ' POCTB-PROGRAM-NAME(1:1) ' '
POCTB-PROGRAM-NAME(2:1) ' '
POCTB-PROGRAM-NAME(3:1) ' '
POCTB-PROGRAM-NAME(4:1) ' '
POCTB-PROGRAM-NAME(5:1) ' '
POCTB-PROGRAM-NAME(6:1) ' '
POCTB-PROGRAM-NAME(7:1) ' '
POCTB-PROGRAM-NAME(8:1) ' '
' *'
DISPLAY '* '
' *'
DISPLAY '* Start..: 20' POCTB-DATE(1:2) '-'
POCTB-DATE(3:2) '-' POCTB-DATE(5:2) ' '
POCTB-TIME(1:2) ':' POCTB-TIME(3:2) ':'
POCTB-TIME(5:2) ' '
' *'
DISPLAY '* '
' *'
DISPLAY '* Version..: ' POCTB-VERSION
'*'
DISPLAY '* '
' *'
DISPLAY '*******************************************'
'*********'
DISPLAY '* DBHOST.......: ' SQLCA-HOST ' *'
DISPLAY '* DBUSER.......: ' SQLCA-USER ' *'
DISPLAY '* DBPASSWD.....: ' SQLCA-PASSWD ' *'
DISPLAY '* DBNAME.......: ' SQLCA-DBNAME ' *'
DISPLAY '* DBPORT.......: ' SQLCA-PORT
' *'
DISPLAY '* DBSOCKET.....: ' SQLCA-SOCKET ' *'
DISPLAY '*******************************************'
'*********'
*
* Initialize the database connection
DBPRE MOVE 2 TO SQLCA-SEQUENCE
* EXEC SQL
* INIT DB
DBPRE CALL "MySQL_init" USING SQLCA-CID
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
DBPRE * END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN DB-NOT-FOUND
SET DB-OK TO TRUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
DBPRE MOVE 3 TO SQLCA-SEQUENCE
* EXEC SQL
* CONNECT DB
DBPRE CALL "MySQL_real_connect" USING
DBPRE SQLCA-HOST
DBPRE SQLCA-USER
DBPRE SQLCA-PASSWD
DBPRE SQLCA-DBNAME
DBPRE SQLCA-PORT
DBPRE SQLCA-SOCKET
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
DBPRE * END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN DB-NOT-FOUND
SET DB-OK TO TRUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
* Now execute the user's code
PERFORM POCTB-ACTION
*
* Any errors?
PERFORM DB-ERROR
*
* Commit the work
DBPRE MOVE 4 TO SQLCA-SEQUENCE
* EXEC SQL
* COMMIT
DBPRE CALL "MySQL_commit"
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
DBPRE IF RETURN-CODE NOT = 0 THEN
DBPRE PERFORM DB-ERROR
DBPRE END-IF
DBPRE * END-EXEC.
*
* We're done, now close the database and stop the program
DBPRE MOVE 5 TO SQLCA-SEQUENCE
* EXEC SQL
* CLOSE DB
DBPRE CALL "MySQL_close"
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
DBPRE * END-EXEC.
PERFORM DB-ERROR
*
ACCEPT POCTB-DATE FROM DATE
ACCEPT POCTB-TIME FROM TIME
DISPLAY '*******************************************'
'*********'
DISPLAY '* '
' *'
DISPLAY '* '
' *'
DISPLAY '* End....: 20' POCTB-DATE(1:2) '-'
POCTB-DATE(3:2) '-' POCTB-DATE(5:2) ' '
POCTB-TIME(1:2) ':' POCTB-TIME(3:2) ':'
POCTB-TIME(5:2) ' '
' *'
DISPLAY '* '
' *'
DISPLAY '* '
' *'
DISPLAY '*******************************************'
'*********'
*
* No error, return zero
*
MOVE 0 TO RETURN-CODE
.
POCTB-MAIN-EXIT.
STOP RUN.
/
*************************************************************************
POCTB-STATUS SECTION.
IF POCTB-ERROR
IF POCTB-ERROR-MESSAGE = SPACES
STRING POCTB-PROGRAM-NAME DELIMITED BY SIZE
': POCTB-STATUS-FLD ' DELIMITED BY SIZE
POCTB-STATUS-FLD DELIMITED BY SIZE
' is set!' DELIMITED BY SIZE
INTO POCTB-ERROR-MESSAGE
END-IF
*
* Rollback the work
DBPRE MOVE 6 TO SQLCA-SEQUENCE
* EXEC SQL
* ROLLBACK
DBPRE CALL "MySQL_rollback"
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
DBPRE IF RETURN-CODE NOT = 0 THEN
DBPRE PERFORM DB-ERROR
DBPRE END-IF
DBPRE * END-EXEC.
MOVE 2 TO RETURN-CODE
STOP RUN
END-IF
.
POCTB-STATUS-EXIT.
EXIT.
*************************************************************************
POCTB-DISPLAY-ERROR SECTION.
DISPLAY '*******************************************'
'******************************'
DISPLAY '* E R R O R * E R R O R * E R R O R * E R R'
' O R * E R R O R * E R R O R *'
DISPLAY '*******************************************'
'******************************'
DISPLAY '*** '
' ***'
DISPLAY '** ' POCTB-ERROR-MESSAGE ' **'
DISPLAY '*** '
' ***'
DISPLAY '*******************************************'
'******************************'
DISPLAY '* E R R O R * E R R O R * E R R O R * E R R'
' O R * E R R O R * E R R O R *'
DISPLAY '*******************************************'
'******************************'
DISPLAY '* D A T A B A S E W O R K U N I T '
' R O L L E D B A C K *'
DISPLAY '*******************************************'
'******************************'
.
POCTB-DISPLAY-ERROR-EXIT.
EXIT.
*************************************************************************
DB-ERROR SECTION.
IF SQLCODE NOT = 0
CALL "MySQL_errno" USING POCTB-ERRNO
END-CALL
DISPLAY 'ERRNO: ' POCTB-ERRNO
CALL "MySQL_error" USING POCTB-ERROR-MESSAGE
END-CALL
DISPLAY POCTB-ERROR-MESSAGE
MOVE SPACES TO POCTB-ERROR-MESSAGE
STRING 'DB-ERROR: Program ' DELIMITED BY SIZE
POCTB-PROGRAM-NAME DELIMITED BY SIZE
' SQLCODE=' DELIMITED BY SIZE
SQLCODE DELIMITED BY SIZE
' SQLCA-SEQUENCE=' DELIMITED BY SIZE
SQLCA-SEQUENCE DELIMITED BY SIZE
' ' DELIMITED BY SIZE
INTO POCTB-ERROR-MESSAGE
PERFORM POCTB-DISPLAY-ERROR
*
* Rollback the work
DBPRE MOVE 7 TO SQLCA-SEQUENCE
* EXEC SQL
* ROLLBACK
DBPRE CALL "MySQL_rollback"
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
DBPRE IF RETURN-CODE NOT = 0 THEN
DBPRE PERFORM DB-ERROR
DBPRE END-IF
DBPRE * END-EXEC.
MOVE 3 TO RETURN-CODE
STOP RUN
END-IF
.
DB-ERROR-EXIT.
EXIT.
DBPRE * END-EXEC.
/
**************************************************************************
* P O C T B - A C T I O N S E C T I O N *
**************************************************************************
POCTB-ACTION SECTION.
*
DISPLAY 'In POCTB-ACTION.'
*
PERFORM DISPLAY-ALL-RECORDS
*
DISPLAY 'Delete entire table'
*
DBPRE MOVE 8 TO SQLCA-SEQUENCE
* EXEC SQL
DBPRE * DELETE
DBPRE * FROM example_table
DBPRE * END-EXEC.
DBPRE MOVE LOW-VALUES TO SQLCA-STATEMENT
DBPRE STRING
DBPRE 'DELETE ' DELIMITED SIZE
DBPRE 'FROM ' DELIMITED SIZE
DBPRE 'example_table ' DELIMITED SIZE
DBPRE INTO SQLCA-STATEMENT
DBPRE END-STRING
DBPRE CALL 'MySQL_query' USING SQLCA-STATEMENT
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
DISPLAY 'Insert new records'
*
DBPRE MOVE 9 TO SQLCA-SEQUENCE
* EXEC SQL
DBPRE * INSERT
DBPRE * INTO example_table
DBPRE * (
DBPRE * FIELD1,
DBPRE * FIELD2,
DBPRE * FIELD3
DBPRE * )
DBPRE * VALUES
DBPRE * (
DBPRE * 'Value1' ,
DBPRE * 'Value2' ,
DBPRE * 'Value3'
DBPRE * )
DBPRE * END-EXEC.
DBPRE MOVE LOW-VALUES TO SQLCA-STATEMENT
DBPRE STRING
DBPRE 'INSERT ' DELIMITED SIZE
DBPRE 'INTO ' DELIMITED SIZE
DBPRE 'example_table ' DELIMITED SIZE
DBPRE '( ' DELIMITED SIZE
DBPRE 'FIELD1, ' DELIMITED SIZE
DBPRE 'FIELD2, ' DELIMITED SIZE
DBPRE 'FIELD3 ' DELIMITED SIZE
DBPRE ') ' DELIMITED SIZE
DBPRE 'VALUES ' DELIMITED SIZE
DBPRE '( ' DELIMITED SIZE
DBPRE '''Value1'' ' DELIMITED SIZE
DBPRE ', ' DELIMITED SIZE
DBPRE '''Value2'' ' DELIMITED SIZE
DBPRE ', ' DELIMITED SIZE
DBPRE '''Value3'' ' DELIMITED SIZE
DBPRE ') ' DELIMITED SIZE
DBPRE INTO SQLCA-STATEMENT
DBPRE END-STRING
DBPRE CALL 'MySQL_query' USING SQLCA-STATEMENT
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
DBPRE MOVE 10 TO SQLCA-SEQUENCE
* EXEC SQL
DBPRE * INSERT
DBPRE * INTO example_table
DBPRE * (
DBPRE * FIELD1,
DBPRE * FIELD2,
DBPRE * FIELD3
DBPRE * )
DBPRE * VALUES
DBPRE * (
DBPRE * '2Value1' ,
DBPRE * '2Value2' ,
DBPRE * '2Value3'
DBPRE * )
DBPRE * END-EXEC.
DBPRE MOVE LOW-VALUES TO SQLCA-STATEMENT
DBPRE STRING
DBPRE 'INSERT ' DELIMITED SIZE
DBPRE 'INTO ' DELIMITED SIZE
DBPRE 'example_table ' DELIMITED SIZE
DBPRE '( ' DELIMITED SIZE
DBPRE 'FIELD1, ' DELIMITED SIZE
DBPRE 'FIELD2, ' DELIMITED SIZE
DBPRE 'FIELD3 ' DELIMITED SIZE
DBPRE ') ' DELIMITED SIZE
DBPRE 'VALUES ' DELIMITED SIZE
DBPRE '( ' DELIMITED SIZE
DBPRE '''2Value1'' ' DELIMITED SIZE
DBPRE ', ' DELIMITED SIZE
DBPRE '''2Value2'' ' DELIMITED SIZE
DBPRE ', ' DELIMITED SIZE
DBPRE '''2Value3'' ' DELIMITED SIZE
DBPRE ') ' DELIMITED SIZE
DBPRE INTO SQLCA-STATEMENT
DBPRE END-STRING
DBPRE CALL 'MySQL_query' USING SQLCA-STATEMENT
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
DBPRE MOVE 11 TO SQLCA-SEQUENCE
* EXEC SQL
DBPRE * INSERT
DBPRE * INTO example_table
DBPRE * (
DBPRE * FIELD1,
DBPRE * FIELD2,
DBPRE * FIELD3
DBPRE * )
DBPRE * VALUES
DBPRE * (
DBPRE * '3Value1' ,
DBPRE * '3Value2' ,
DBPRE * '3Value3'
DBPRE * )
DBPRE * END-EXEC.
DBPRE MOVE LOW-VALUES TO SQLCA-STATEMENT
DBPRE STRING
DBPRE 'INSERT ' DELIMITED SIZE
DBPRE 'INTO ' DELIMITED SIZE
DBPRE 'example_table ' DELIMITED SIZE
DBPRE '( ' DELIMITED SIZE
DBPRE 'FIELD1, ' DELIMITED SIZE
DBPRE 'FIELD2, ' DELIMITED SIZE
DBPRE 'FIELD3 ' DELIMITED SIZE
DBPRE ') ' DELIMITED SIZE
DBPRE 'VALUES ' DELIMITED SIZE
DBPRE '( ' DELIMITED SIZE
DBPRE '''3Value1'' ' DELIMITED SIZE
DBPRE ', ' DELIMITED SIZE
DBPRE '''3Value2'' ' DELIMITED SIZE
DBPRE ', ' DELIMITED SIZE
DBPRE '''3Value3'' ' DELIMITED SIZE
DBPRE ') ' DELIMITED SIZE
DBPRE INTO SQLCA-STATEMENT
DBPRE END-STRING
DBPRE CALL 'MySQL_query' USING SQLCA-STATEMENT
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
PERFORM DISPLAY-ALL-RECORDS
*
DISPLAY 'Update the first record'
*
DBPRE MOVE 12 TO SQLCA-SEQUENCE
* EXEC SQL
DBPRE * UPDATE example_table
DBPRE * SET FIELD1 = 'UpdatedValue1'
DBPRE * WHERE FIELD1 = 'Value1'
DBPRE * END-EXEC.
DBPRE MOVE LOW-VALUES TO SQLCA-STATEMENT
DBPRE STRING
DBPRE 'UPDATE ' DELIMITED SIZE
DBPRE 'example_table ' DELIMITED SIZE
DBPRE 'SET ' DELIMITED SIZE
DBPRE 'FIELD1 ' DELIMITED SIZE
DBPRE '= ' DELIMITED SIZE
DBPRE '''UpdatedValue1'' ' DELIMITED SIZE
DBPRE 'WHERE ' DELIMITED SIZE
DBPRE 'FIELD1 ' DELIMITED SIZE
DBPRE '= ' DELIMITED SIZE
DBPRE '''Value1'' ' DELIMITED SIZE
DBPRE INTO SQLCA-STATEMENT
DBPRE END-STRING
DBPRE CALL 'MySQL_query' USING SQLCA-STATEMENT
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
* DISPLAY 'SQLCA-STATEMENT=' SQLCA-STATEMENT
* DISPLAY 'SQLCODE=' SQLCODE
* DISPLAY 'SQLCA-COUNT=' SQLCA-COUNT
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
*
PERFORM DISPLAY-ALL-RECORDS
*
DISPLAY 'Ende POCTB-ACTION.'
*
* test test test test test test
* MOVE 123 TO SQLCODE
*
.
POCTB-ACTION-EXIT.
EXIT.
/
**************************************************************************
DISPLAY-ALL-RECORDS SECTION.
*
DISPLAY '-------------------------------------------'
* Attention !! Table name is CaSe sensitive!!!!!!!!!!!!!
DBPRE MOVE 13 TO SQLCA-SEQUENCE
* EXEC SQL
DBPRE * SELECT FIELD1, FIELD2, FIELD3
DBPRE * INTO :FIELD1 :FIELD2 :FIELD3
DBPRE * FROM example_table
DBPRE * END-EXEC.
DBPRE MOVE LOW-VALUES TO SQLCA-STATEMENT
DBPRE MOVE 'SELECT FIELD1, FIELD2, FI' TO SQLCA-STAT-LINE (1)
DBPRE MOVE 'ELD3 FROM example_table ' TO SQLCA-STAT-LINE (2)
DBPRE CALL 'MySQL_query' USING SQLCA-STATEMENT
DBPRE END-CALL
DBPRE MOVE RETURN-CODE TO SQLCODE
DBPRE IF DB-OK
DBPRE CALL 'MySQL_use_result' USING SQLCA-RESULT
DBPRE END-CALL
DBPRE IF SQLCA-RESULT = NULL
DBPRE MOVE 100 TO SQLCODE
DBPRE ELSE
DBPRE MOVE 0 TO SQLCODE
DBPRE END-IF
DBPRE END-IF
DBPRE IF DB-OK
DBPRE CALL 'MySQL_fetch_row' USING SQLCA-RESULT
DBPRE FIELD1
DBPRE FIELD2
DBPRE FIELD3
DBPRE END-CALL
DBPRE IF SQLCA-RESULT = NULL
DBPRE MOVE 100 TO SQLCODE
DBPRE ELSE
DBPRE MOVE 0 TO SQLCODE
DBPRE END-IF
DBPRE END-IF
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN DB-NOT-FOUND
SET DB-OK TO TRUE
MOVE SPACE TO FIELD1
MOVE SPACE TO FIELD2
MOVE SPACE TO FIELD3
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
DISPLAY 'FIELD1=' FIELD1 ' FIELD2=' FIELD2
' FIELD3=' FIELD3
SET DB-OK TO TRUE
PERFORM UNTIL NOT DB-OK
DBPRE MOVE 14 TO SQLCA-SEQUENCE
* EXEC SQL
DBPRE * FETCH RESULT
DBPRE * INTO :FIELD1 :FIELD2 :FIELD3
DBPRE * END-EXEC.
DBPRE CALL 'MySQL_fetch_row' USING SQLCA-RESULT
DBPRE FIELD1
DBPRE FIELD2
DBPRE FIELD3
DBPRE END-CALL
DBPRE IF SQLCA-RESULT = NULL
DBPRE MOVE 100 TO SQLCODE
DBPRE ELSE
DBPRE MOVE 0 TO SQLCODE
DBPRE END-IF
EVALUATE TRUE
WHEN DB-OK
DISPLAY 'FIELD1=' FIELD1 ' FIELD2=' FIELD2
' FIELD3=' FIELD3
WHEN DB-NOT-FOUND
MOVE SPACE TO FIELD1
MOVE SPACE TO FIELD2
MOVE SPACE TO FIELD3
WHEN OTHER
PERFORM DB-ERROR
END-EVALUATE
END-PERFORM
SET DB-OK TO TRUE
DISPLAY '-------------------------------------------'
.
DISPLAY-ALL-RECORDS-EXIT.
EXIT.
Compile it with
cobc -x PCTB001B.cob cobmysqlapi.o -L/usr/lib/mysql
-lmysqlclient
To run it, use this shell script (i am developing using Ubuntu)
cat PCTB001B.sysin | PCTB001B >PCTB001B.log
As you can see, you need a SYSIN file for the input cards the framework reads. This file, in this case PCTB001B.sysin looks like this:
DBHOST=localhost
DBUSER=root
DBPASSWD=YourRootPasswordForMySqlHere
DBNAME=testdb
DBPORT=03306
DBSOCKET=null
Here is the data stored the framework needs to connect to the database (You might have guessed, that you have to replace the DBPASSWD with your own password to connect to MySql, also, if your MySql server is running on another port than 3306, change that too to your needs). And the log file, when you run the program, looks like this:
****************************************************
* *
* P C T B 0 0 1 B *
* *
* Start..: 2012-04-21 01:37:58 *
* *
* Version..: 20120408 1.0 INITIAL RELEASE *
* *
****************************************************
* DBHOST.......: localhost *
* DBUSER.......: root *
* DBPASSWD.....: YouWontGuess *
* DBNAME.......: testdb *
* DBPORT.......: 03306 *
* DBSOCKET.....: null *
****************************************************
In POCTB-ACTION.
-------------------------------------------
FIELD1=UpdatedValue1 FIELD2=Value2 FIELD3=Value3
FIELD1=2Value1 FIELD2=2Value2 FIELD3=2Value3
FIELD1=3Value1 FIELD2=3Value2 FIELD3=3Value3
-------------------------------------------
Delete entire table
Insert new records
-------------------------------------------
FIELD1=Value1 FIELD2=Value2 FIELD3=Value3
FIELD1=2Value1 FIELD2=2Value2 FIELD3=2Value3
FIELD1=3Value1 FIELD2=3Value2 FIELD3=3Value3
-------------------------------------------
Update the first record
-------------------------------------------
FIELD1=UpdatedValue1 FIELD2=Value2 FIELD3=Value3
FIELD1=2Value1 FIELD2=2Value2 FIELD3=2Value3
FIELD1=3Value1 FIELD2=3Value2 FIELD3=3Value3
-------------------------------------------
Ende POCTB-ACTION.
****************************************************
* *
* *
* End....: 2012-04-21 01:37:58 *
* *
* *
****************************************************
Thats it so far, theres still a lot of work to do and known bugs, i have to work on, but the first test program is working after just a few weeks. Not that bad at all, IMO :) So, any comments, suggestions and such? Feel free to post :D |
|
|
| mwilliams |
Posted on: 2012/4/21 3:11 |
Not too shy to talk  Joined: 2011/3/6 From: United States Posts: 39 |
Re: OpenCobol and MySql precompiler Well, at least you are on a great start.  Does your precompiler, ignore other embedded "EXEC ..." languages outside of SQL? Though, just my opinion, I would probably prefer replacing the accept statement with a call to acquire the initial SQLCA information. I suppose, after looking at countless expanded DB2 source, I sort of miss those DB2 initialization paragraghs which get executed with only upon the first executed SQL statement. Coming from a DB2 environment, does MySql have a concept of DBRMs? Have you worked DB2 Express? |
|
|
| the_piper |
Posted on: 2012/4/21 17:36 |
Just popping in Joined: 2009/9/18 From: Posts: 17 |
Re: OpenCobol and MySql precompiler Quote: Does your precompiler, ignore other embedded "EXEC ..." languages outside of SQL? Not right now, it checks, if every EXEC SQL has a matching END-EXEC, so any EXEC CICS or so would confuse the preprocessor. Quote: Though, just my opinion, I would probably prefer replacing the accept statement with a call to acquire the initial SQLCA information. Nice idea, i'm trying to implement that, reading it in the cobmysql api from a different file. Quote: Coming from a DB2 environment, does MySql have a concept of DBRMs? I dont think so, the SQL code is interpreted at runtime, look at my *.cob file, the SQL statement is built using the STRING command and then given to mysql. Quote: Have you worked DB2 Express? Not yet, only with DB2 on mainframes. |
|
|
| vbcoen |
Posted on: 2012/4/22 16:15 |
Not too shy to talk Joined: 2007/2/13 From: Essex, UK Posts: 26 |
Re: OpenCobol and MySql precompiler Hi, Very interested in your dev efforts on this.
I'm attempting to create a DAL (Data Access Layer) module that is written for each flat file in an existing application that I have made Open Source.
This consists of two parts, 1st is a file handler for a specific file that accepts requests to open, close, read (for a key), read next, write, rewrite etc. This in turn if RDB in use will call a DAL to do the same except process a table Row and move to/from a FD record etc.
So far I have one that sort of links to MS SQL 2008 server (using MF Netexpress) and have tried to get a similar one working with DB/2 Express (under Linux) with quite a few problems but there again I cannot compile the DB/2 samples without issues!!
On the Mysql front, I need a useful precompiler as well as an updated cobmysqlapi.005.c that has the rest of the missing ops in working with the normal SQL exec code types as well as work with the later versions of OC, eg, later than the Feb 09. Please keep us up2date on your efforts.
|
|
|
| the_piper |
Posted on: 2012/4/22 23:14 |
Just popping in Joined: 2009/9/18 From: Posts: 17 |
Re: OpenCobol and MySql precompiler Quote: Please keep us up2date on your efforts. Will do, i just started a Blog today, where i will post about the development of my tools and links to the source code, which includes the mysql precompiler: http://pipersopencoboltoolbox.blogspot.de/No need to spam this forum here, i think :) I posted there the modified cobmysqlapi.c i am using right now, if that helps you. I had to do a few changes, since the one i found here in forums was not working. Well, 4 years old, no surprise.. |
|
|
| human |
Posted on: 2012/4/23 4:08 |
Home away from home  Joined: 2007/5/15 From: GERMANY Posts: 1416 |
Re: OpenCobol and MySql precompiler I'm not sure if the version is newer, but according to btiffins OpenCOBOL FAQ the svn repository for cobmysqlapi.c is http://svn.wp0.org/add1/libraries/mysql4Windows4OpenCobol. human |
|
|
| the_piper |
Posted on: 2012/4/26 22:51 |
Just popping in Joined: 2009/9/18 From: Posts: 17 |
First release of the MySql precompiler dbpre V 0.1 The first release of the source code of dbpre, the precompiler for MySql and OpenCobol + additional files + two example programs can be found here. http://pipersopencoboltoolbox.blogspot.de/This was developed and tested using Ubuntu, so no idea, if this will work under different distros or other operating systems. @human Thanks for the link, i will have a look at it later, but right now the cobmysqlapi i found in forums does is's job very well, even with my modifications :) |
|
|
| the_piper |
Posted on: 2012/5/5 0:40 |
Just popping in Joined: 2009/9/18 From: Posts: 17 |
Re: First release of the MySql precompiler dbpre V 0.1 Hmm....
not a single comment about the precompiler since more than a week..
Should i guess that nobody is interested in having/using the precompiler and i should stop working on it?
|
|
|
| btiffin |
Posted on: 2012/5/5 5:20 |
Home away from home Joined: 2008/6/7 From: CANADA Posts: 1196 |
Re: First release of the MySql precompiler dbpre V 0.1 Don't take no replies as a sign the work is not worthwhile. OpenCOBOL grows with every contribution. Leaps and baby steps, lots of steps will make up a much better whole. In my biased fanboy opinion. For every 1000 lines of code I like to tinker with, if 4 end up used by or helping someone, woohoo for the win.  I'll add, from the same fanboy opinion space, as a volunteer you don't really have to finish anything you don't commit to finishing, in writing. Follow your bliss, and the code will thank you back in spades. Cheers and have good the_piper, Brian for the international crowd, where I'm from "in spades" refers to the top rank of the four playing card suits, a good thing, not say, flying gardening implements or anything that would require ducking from... |
|
|
| jgt |
Posted on: 2012/5/5 13:46 |
Just can't stay away  Joined: 2010/1/18 From: 44.21.48N 80.50.15W Posts: 76 |
Re: First release of the MySql precompiler dbpre V 0.1 Post a to do list.
|
|
|
|
OpenCOBOL Forum Index