Pipers Open Cobol ToolBox

2014-06-03T02:34:00.000+02:00

dbpre has moved to sourceforge.net, so this blog will be more or less inactive in the future.

You can find new stuff about dbpre at sourceforge, here:

https://sourceforge.net/projects/dbpre/

Download the latest release from the "Code" section (Download Snapshot).

Post comments, bugs, ideas and so on in the "Discussion" section there.

Every constructive post, which helps the development of dbpre, is welcome there :)

dbpre - version with CURSORS

2012-07-25T00:53:00.003+02:00

Ok, after being distracted with other stuff, here is now the source code + example program of dbpre, which can handle cursors.

At least one cursor open at the same time was tested.

The source code can be downloaded from here:

www.the-green-leaf.de/dbpre_v0.2_2012-07-24.zip

More to come, and more stable and tested stuff, when summer and vacations are over :D

A short update

2012-06-01T01:08:00.001+02:00

since i have been quite busy lately.

A single cursor is working now, DECLARE, OPEN, FETCH until NO-DATA, CLOSE.

Will do more tests, with more than just one cursor and post the results and the source of the precompiler and test programs later.

But right now the weather is quite fine over here, so i might spend more time outside than working on the precompiler.

Or on the HTTP-Server, at which i had a short look on this evening, which should be able to process dialogues using HTML-pages and OpenCobol using MySql (and the precompiler) in the future.

More to come soon hopefully ^^

Let there be cursors!

2012-05-12T01:32:00.000+02:00

I am working on implementing cursors right now.

The new test program, PCTB003B, looks like this (The cursor stuff can be found in the DISPLAY-ALL-RECORDS SECTION):

----+-*--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.                 PCTB003B.
        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 '20120426 1.0 INITIAL RELEASE'.
      *
        01 FIELD1.
          05 FIELD1-NUM                      PIC 9(08).
          05 FILLER                          PIC X(12) VALUE SPACE.
        01 FIELD2                           PIC X(16).
        01 FIELD3                           PIC X(32).
      *
        01 T                                PIC S9(9) COMP.
      *
      * 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 'PCTB003B'.
           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-STATUS
           END-EVALUATE
      *
           DISPLAY 'Insert new records'
      *
           PERFORM VARYING T FROM 1 BY 1 UNTIL T > 1000
              MOVE T                   TO FIELD1-NUM
              EXEC SQL
                 INSERT
                 INTO example_table
                     (
                        FIELD1,
                        FIELD2,
                        FIELD3
                     )
                     VALUES
                     (
                         :FIELD1 ,
                         'Value2' ,
                         'Value3'

                  )
              END-EXEC.
              EVALUATE TRUE
                WHEN DB-OK
                   CONTINUE
                WHEN OTHER
                   PERFORM DB-STATUS
              END-EVALUATE
           END-PERFORM
      *
           PERFORM DISPLAY-ALL-RECORDS
      *
           DISPLAY 'Update the first record'
      *

           EXEC SQL
              UPDATE example_table
              SET FIELD1 = 'UpdatedValue1'
              WHERE FIELD1 = '00000001'
           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-STATUS
           END-EVALUATE
      *
           PERFORM DISPLAY-ALL-RECORDS
      *
           DISPLAY 'Ende POCTB-ACTION.'
      *
           .
        POCTB-ACTION-EXIT.
           EXIT.
      /
      **************************************************************************
        DISPLAY-ALL-RECORDS SECTION.
      *
            DISPLAY '-------------------------------------------'
      * Attention !! Table name is CaSe sensitive!!!!!!!!!!!!!
            EXEC SQL
               DECLARE ALLROWS CURSOR FOR
               SELECT FIELD1, FIELD2, FIELD3
               INTO :FIELD1 :FIELD2 :FIELD3
               FROM example_table
            END-EXEC.
            EVALUATE TRUE
            WHEN DB-OK
               CONTINUE
            WHEN OTHER
               PERFORM DB-STATUS
            END-EVALUATE
      *
            EXEC SQL
               OPEN ALLROWS
            END-EXEC.
            EVALUATE TRUE
            WHEN DB-OK
               CONTINUE
            WHEN DB-NOT-FOUND
               CONTINUE
            WHEN OTHER
               PERFORM DB-STATUS
            END-EVALUATE

            DISPLAY 'FIELD1=' FIELD1 ' FIELD2=' FIELD2
                     ' FIELD3=' FIELD3

            PERFORM UNTIL NOT DB-OK
               EXEC SQL
                  FETCH ALLROWS
                  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-STATUS
               END-EVALUATE
            END-PERFORM
            SET DB-OK                      TO TRUE
            DISPLAY '-------------------------------------------'
      *
            EXEC SQL
               CLOSE ALLROWS
            END-EXEC.
            EVALUATE TRUE
            WHEN DB-OK
               CONTINUE
            WHEN OTHER
               PERFORM DB-STATUS
            END-EVALUATE
           .
        DISPLAY-ALL-RECORDS-EXIT.
           EXIT.

When i am done with it, interesting will be testing the whole stuff with subroutines, i will release a new version of the source code of the preprocessor.

First release of the MySql preprocessor dbpre V 0.1

2012-04-27T00:41:00.001+02:00

This is the first release of the pre-alpha version of dbpre, the preprocessor for OpenCobol and MySql.

www.the-green-leaf.de/dbpre_v0.1_2012-04-28.zip

Please read the README.TXT in that zip file for further informations, how to use this release and try the example programs.

The version number is 0.1, so expect, what you will get.

This release was developed and tested only under Ubuntu, so if you want to try it under other operating systems, you might have to do some extra work to get it running.

One special thing, which is different from DB2, Oracle or others, dbpre does not (yet) know cursors.

A SELECT statement delivers a result or DB-NOT-FOUND.

Right now you have to find out, if the result has more than one row by FETCH'ing the next row.

The difference between SELECT/CURSOR in DB2 and dbpre is: SELECT returns DB-OK, if even more than one row is found.

Please keep that in mind while testing dbpre :)

Please post comments, suggestions, ideas, bugs, whatever here or send me an email to the_piper@web.de.

poctbsh - a simple GUI to make a programmers life easier

2012-04-24T02:06:00.000+02:00

Today i was working on poctbsh (Pipers Open Cobol Tool Box SHell), a simple GUI which should help programmers to manage their source codes and copy books, compile them, run the programs, view the output and so on.

This GUI is something you can, but must not use, the precompiler itself works fine without the GUI, so you will be able to use it in any way you want.

But the GUI IMO makes life easier, thats the reason why i am working on it ;)

Okay, a few screenies:

The main screen, right now you have only 2 options, Program Development and to quit the GUI.

More to come soon.

The screen for Program Development.

Here you choose the "current program", the one you want to work on.

Then you can edit the *.scb source code, the input for the MySql precompiler, edit the shellscript to run the program, compile the program with the precompiler and the OpenCobol compiler.

So you can simply type "p ENTER-key", "1 ENTER-key" to set the current program, "3 ENTER-key" to edit the current program, the *.scb file with the editor of your choice, defined in the poctbsh.cfg file, "5 ENTER-key" to compile it, "6 ENTER-key" to run the corresponding shell script and so on.

This evening i was already able to edit and compile an example program. And to do that, the precompiler got a new option now, -I, to specify the folder, where the copybooks are stored.

poctbsh expects a given folder structure in your $HOME directory.

It is stored in poctbsh.dat and looks like this

bin/ <== binary files like the precompiler itself + your compilled programs
copybooks/ <== you guess it
output/ <== output of compiles, shell scripts
poctbsh.cfg <== this is the config file for poctbsh, which you can edit to your needs
sh/ <== shell scripts to run your COBOL programs
source/ <== where the COBOL *.scb source is stored
system/ <== system stuff
templates/ <== templates for compiling programs and such
tmp/<== temporary stuff

As i said, it is not mandatory that you are using this GUI, but it would make your job as a programmer easier.

You can still use the precompiler without this GUI.

cobmysqlapi.c

2012-04-23T00:55:00.003+02:00

This is the (modified) cobmysqlapi.c i am using right now for the preprocesser.

The credits for this work goes to the people listed at the beginning of the comments there, i just did a few modifications.

/* cob-mysql Version 3.1                            18/Apr/2012 */
/* Copyright (C) sanpontze. All Rights Reserved                     */
/**********************************************************************
*   Version 003--Changed to correctly map to COBOL data types.
*                05/07/2009--Marc Rodriguez
*   Version 004--Changed to correctly place NULLs into numeric types.
*                1225978--Sandy Doss
*                07/01/2009--Marc Rodriguez
*   Version 005--Added new MySQL call to fetch entire row selected
*                using "select *". Also fixed potential bug in
*                MySQL_fetch_row that compares number of passed
*                parameters (inclusive of WS-MYSQL-RESULT) against
*                number of fields returning from MySQL select.
*                1331073--Jim Currey
*                12/16/2009--Pete McThompson
*   Version 006--Changes to work together with the precompiler
*                Added commit() and rollback() functions
*                04/18/2012--The_Piper
**********************************************************************/

#include        <stdio.h>
#include        <string.h>
#include        <stdarg.h>
#include        <mysql.h>
#include        <libcob.h>
#include        <stdlib.h>                                                             //121609
#include        <syslog.h>                                                             //121609

#define min(a,b) ((a) < (b) ? (a) : (b))

//function pointer prototype should not include paramater names                        //121609
//static int (*func)(char *errno, const char *errmsg);                                 //121609
static int (*func)(char *, const char *);                                              //121609

MYSQL            sql, *mysql=&sql;
static int       errout;

static const cob_field_attr MYSQL_FIELD_ATTRIBUTES = {33, 0, 0, 0, NULL};
/******************************************************************************/
void cobapi_trim(char *s)
{
   int l;

   l=strlen(s)-1;
   for(;;){
      if(l<1) break;
         if(s[l]!=' ' && s[l]!='\t') break;
         s[l]=0;
      l--;
   }
   if(l==0) return;
   for(;;){
      if(s[0]==0) break;
      if(s[0]!=' ' && s[0]!='\t') break;
      memmove(s, s+1, strlen(s));
   }
}
/******************************************************************************/
void err_exit(int rc)
{

    char errno[10];

    if( !rc ) return;

    switch(errout){
        case 1:
             fprintf(stderr,"%d\n", mysql_errno(mysql));
             fprintf(stderr,"%s\n", mysql_error(mysql));
             return;
        case 2:
             break;
        case 3:
             sprintf(errno,"%d", mysql_errno(mysql));
             func(errno, mysql_error(mysql));
    }
    return;
}

void move_to_cob(char *cob_dat, const char *dat)
{
    int len = strlen(cob_dat);                      // data length in cob
    if(dat == NULL)
    {
      memset(cob_dat, 0, len);                      // clear with NULL
    }
    else
    {
      memset(cob_dat, ' ', len);                      // clear with spaces
      memcpy(cob_dat, dat, min(len, strlen(dat)));    // data copy
    }
    return;
}

void MySQL_affected_rows(int *no)
{
    *no = mysql_affected_rows(mysql);
    return;
}

int MySQL_change_user(const char *user, const char *passwd, const char *db)
{
    int rc;
    rc = mysql_change_user(mysql, user, passwd, db);
    err_exit(rc);
    return rc;
}

void MySQL_close(void)
{
    mysql_close(mysql);
    return;
}

void MySQL_errno(char *errno)
{
    char buf[10];
    sprintf(buf,"%d", mysql_errno(mysql));
    move_to_cob(errno, buf);
    return;
}

void MySQL_error(char *errmsg)
{
    move_to_cob(errmsg, mysql_error(mysql));
    return;
}

void MySQL_fetch_field(MYSQL_RES **result, int *pos, char *field)
{

    MYSQL_FIELD *fields;

    fields = mysql_fetch_fields(*result);
    move_to_cob(field, fields[ *pos - 1 ].name);
    return;
}

void MySQL_fetch_fields(MYSQL_RES **result, ...)
{
    int rc, j, colms;
    va_list args;
    MYSQL_FIELD *fields;

    va_start(args, result);
    colms = min(cob_call_params, mysql_num_fields(*result));
    fields = mysql_fetch_fields(*result);

    for(j=0; j<colms; j++){
       move_to_cob(va_arg(args, char *), fields[j].name);
    }
    va_end(args);
    return;
}

int MySQL_fetch_row(MYSQL_RES **result, ...)                                           //050709
{                                                                                      //050709
MYSQL_ROW res;                                                                       //050709
int rc, j, maxcols;                                                                  //050709
res = mysql_fetch_row(*result);                                                      //050709
                                                                                       //050709
if(res != NULL)                                                                      //050709
{                                                                                    //050709
    // cob_call_params contains the number of parameters passed. we subtract 1 to     //121609
    // account for the WS-MYSQL-RESULT.                                                //121609
    //maxcols = min(cob_call_params, mysql_num_fields(*result));                       //121609
    maxcols = min(cob_call_params - 1, mysql_num_fields(*result));                     //121609
    for(j=0; j<maxcols; j++)                                                           //050709
    {                                                                                  //050709
      cob_field *cf_from_cobol = cob_current_module->cob_procedure_parameters[j+1];    //050709
      if(res[j] == NULL)                                                               //050709
      {                                                                                //050709
      //memset(cf_from_cobol->data, (char)NULL, strlen(cf_from_cobol->data));          //070109
        memset(cf_from_cobol->data, 0, cf_from_cobol->size);                           //070109
      }                                                                                //050709
      else                                                                             //050709
      {                                                                                //050709
        cob_field cf_from_mysql = { strlen( res[j] ),                                  //050709
                                    (unsigned char *) res[j],                          //050709
                                    &MYSQL_FIELD_ATTRIBUTES                            //050709
                                  };                                                   //050709
        cob_move( &cf_from_mysql, cf_from_cobol );                                     //050709
      }                                                                                //050709
    }                                                                                  //050709
    rc = 0;                                                                            //050709
}                                                                                    //050709
else                                                                                 //050709
{                                                                                    //050709
    if(*result!=NULL){ // no double free!!
        mysql_free_result(*result);                                                      //050709
         *result=NULL;
    }
    rc = -1;                                                                           //050709
}                                                                                    //050709
return rc;                                                                           //050709
}                                                                                      //050709

int MySQL_fetch_record(MYSQL_RES **result, ...)                                        //121609
{                                                                                      //121609
MYSQL_ROW res;                                                                       //121609
int rc, j, maxcols;                                                                  //121609
char strError[255];                                                                  //121609
res = mysql_fetch_row(*result);                                                      //121609
                                                                                       //121609
                                                                                       //121609
if(res != NULL)                                                                      //121609
{                                                                                    //121609
    // cob_call_params contains the number of parameters passed. we subtract 1 to     //121609
    // account for the WS-MYSQL-RESULT.                                                //121609
    if(cob_call_params - 1 != mysql_num_fields(*result))                               //121609
    {                                                                                  //121609
      mysql_free_result(*result);                                                      //121609
      openlog(NULL, LOG_PERROR | LOG_PID | LOG_NDELAY, LOG_DAEMON);                    //121609
      sprintf(strError, "MySQL_fetch_record: fields mismatch. Given %i, expected %i", //121609
              cob_call_params - 1, mysql_num_fields(*result));                         //121609
      syslog(1, strError);                                                             //121609
      closelog();                                                                      //121609
      exit(0);                                                                         //121609
    }                                                                                  //121609
    maxcols = mysql_num_fields(*result);                                               //121609
    for(j=0; j<maxcols; j++)                                                           //121609
    {                                                                                  //121609
      cob_field *cf_from_cobol = cob_current_module->cob_procedure_parameters[j+1];    //121609
      if(res[j] == NULL)                                                               //121609
      {                                                                                //121609
        memset(cf_from_cobol->data, 0, cf_from_cobol->size);                           //121609
      }                                                                                //121609
      else                                                                             //121609
      {                                                                                //121609
        cob_field cf_from_mysql = { strlen( res[j] ),                                  //121609
                                    (unsigned char *) res[j],                          //121609
                                    &MYSQL_FIELD_ATTRIBUTES                            //121609
                                  };                                                   //121609
        cob_move( &cf_from_mysql, cf_from_cobol );                                     //121609
      }                                                                                //121609
    }                                                                                  //121609
    rc = 0;                                                                            //121609
}                                                                                    //121609
else                                                                                 //121609
{                                                                                    //121609
    mysql_free_result(*result);                                                        //121609
    rc = -1;                                                                           //121609
}                                                                                    //121609
return rc;                                                                           //121609
}                                                                                      //121609

void MySQL_field_count(char count[9])
{
    int cnt;
   cnt = mysql_field_count(mysql);
    sprintf(count, "%08d", cnt);
    printf("cnt=%d count=>%s<\n", cnt, count);
   return;
}

void MySQL_free_result(MYSQL_RES **result)
{
    mysql_free_result(*result);
    return;
}

void MySQL_get_character_set_info(char *csname)
{
    MY_CHARSET_INFO cs;
    mysql_get_character_set_info(mysql, &cs);
    move_to_cob(csname, cs.name);
    return;
}

int MySQL_init(MYSQL **cid, ...)
{

    int rc,n;
    char *fname;
    va_list args;

    *cid = mysql;

    rc = mysql_init(&sql) != NULL ? 0 : 1;
    va_start(args, cid);

    if(cob_call_params > 1){
       fname = va_arg(args, char *);
    }
    else {
       fname = "";
    }
    va_end(args);

    if( !strcmp(fname, "stderr") ){
        errout = 1;                               // stderr
    }
    else if( !strcmp(fname,"" ) ){
             errout = 2;                          // default
    }
    else {
       cob_init(0, NULL);
       func = cob_resolve(fname);
       if(func == NULL){
          fprintf(stderr, "%s\n", cob_resolve_error());
          return 1;
       }
       errout = 3;                                 // user function
    }

    err_exit(rc);
    return rc;
}

int MySQL_list_tables( MYSQL_RES **res)
{
    int rc;
    *res = mysql_list_tables(mysql, NULL);
    rc = *res != NULL ? 0 : 1;
    err_exit(rc);
    return rc;
}

void MySQL_num_fields(MYSQL_RES **result, int *cols)
{
    *cols = mysql_num_fields(*result);
    return;
}

void MySQL_num_rows(MYSQL_RES **result, int *rows)
{
    *rows = mysql_num_rows(*result);
    return;
}

int MySQL_query(char *query)
{
    int rc;
    cobapi_trim(query);
    //printf("mysql_query=>%s<\n", query);
    rc = mysql_query(mysql, query);
    err_exit(rc);
    return rc;
}

int MySQL_real_connect(char *host, char *user, char *passwd, char *db, char *xport, char *unix_socket)
{
    int      rc;
    int      port;
    MYSQL    *tmp;
    char *socket;

    cobapi_trim(host);
    cobapi_trim(user);
    cobapi_trim(passwd);
    cobapi_trim(db);
    port=atoi(xport);
    cobapi_trim(unix_socket);
    if(unix_socket==NULL){
        socket=NULL;
    }
    else{
        if(strcmp(unix_socket, "0")==0 ||
           strcmp(unix_socket, "null")==0 ||
            strcmp(unix_socket, "NULL")==0){
            socket=NULL;
        }
        else{
            socket=unix_socket;
        }
    }
    //printf("try to connect host=>%s< user=>%s< passwd=>%s< db=>%s< port=%d socket=>%s<\n", host, user, passwd, db, port, socket);
    tmp = mysql_real_connect(&sql, host, user, passwd, db, port, socket, 0);
    rc = tmp != NULL ? 0 : 1;
    err_exit(rc);
    return rc;
}

int MySQL_selectdb(char *dbname)
{
    int rc;
    cobapi_trim(dbname);
    //printf("selectdb(%s)\n", dbname);
    rc = mysql_select_db(mysql, dbname);
    err_exit(rc);
    return rc;
}

int MySQL_commit(void)
{
    int rc;
    rc = mysql_commit(mysql);
    err_exit(rc);
    return rc;
}

int MySQL_rollback(void)
{
    int rc;
    rc = mysql_rollback(mysql);
    err_exit(rc);
    return rc;
}

int MySQL_set_character_set(char *charset)
{
    int rc;
    rc = mysql_set_character_set(mysql, charset);
    err_exit(rc);
    return rc;
}

int MySQL_store_result(MYSQL_RES **result)
{
    int rc;
    *result = mysql_store_result(mysql);
    rc = result != NULL ? 0 : 1;
    err_exit(rc);
    return rc;
}

int MySQL_use_result(MYSQL_RES **result)
{
    int rc;
    *result = mysql_use_result(mysql);
    rc = result != NULL ? 0 : 1;
    err_exit(rc);
    return rc;
}

POCTB

2012-04-22T23:37:00.001+02:00

POCTB - Pipers Open Cobol ToolBox is/will be a set of tools i am going to make for OpenCobol, a free COBOL compiler.

Right now i am working on a preprocessor for MySql and a simple, TSO-linke GUI, which is supposed to make it easier to compile and run programs, manage program sources and copybooks, view output and such.

The preprocessor will interpret sql commands between the keywords EXEC SQL and END-EXEC and translate them into COBOL calls to a simple API for MySql (cobmysqlapi.c), which was posted in the forum of OpenCobol earlier.

I will post more, when i have more working stuff, right now one test program, which reads all records of a table, deletes them, insert new ones and reads them again, is working.