 Main Menu 
Download Documentation Development Who's Online 12 user(s) are online ( 5 user(s) are browsing Forum) Members: 0 Guests: 12 more...
Powered by |
| Poster |
Thread |
| marcellom |
Posted on: 2011/5/30 10:22 |
Quite a regular   Joined: 2006/1/4 From: Italy Posts: 62 |
opencobol-mysql connection (WORK IN PROGRESS). Hallo, I need some help to get rid of "Attempt to reference unallocated memory (Signal SIGSEGV)" Connection to mysql is ok
inizializzadb section.
inzdb0.
call "mysql_init"
using sql-cid
end-call
if return-code not = 0
move 9 to mf-omega
perform db-error
end-if.
inzdb1-ex.
exit.
Connection to db is ok
connettiadb section.
connadb0.
string
mf-hostaddr delimited spaces
x"00" delimited size
into myhostaddr
end-string
string
mf-utente delimited spaces
x"00" delimited size
into myuser
end-string
string
mf-password delimited spaces
x"00" delimited size
into mypassword
end-string
string
mf-azienda delimited spaces
x"00" delimited size
into mydbase
end-string
string
mf-porta delimited spaces
x"00" delimited size
into myporta
end-string
string
mf-socket delimited spaces
x"00" delimited size
into mysocket
end-string
call "mysql_real_connect"
using myhostaddr myuser mypassword
mydbase myporta mysocket
end-call
if return-code not = 0
move 9 to mf-omega
perform db-error
end-if.
connadb1-ex.
exit.
Db selection is ok
selezionadb section.
slzdb0.
string
mf-azienda delimited spaces
x"00" delimited size
into mydbase
end-string
call "mysql_selectdb" using mydbase
end-call
if return-code not = 0
perform db-error
end-if.
slzdb1-ex.
exit.
Fetch record gives SIGSEGV
getuterec section.
gtuterec0.
move spaces to sql-catalog-name
sql-schema-name
sql-default-character-set-name
sql-default-collation-name
sql-sql-path
string
"sqlute_key" delimited spaces
x"00" delimited size
into sql-catalog-name
end-string
string
"utenti" delimited size
x"00" delimited size
into sql-schema-name
end-string
string
"utf8" delimited size
x"00" delimited size
into sql-schema-name
end-string
string
"utf8.bin" delimited size
x"00" delimited size
into sql-schema-name
end-string.
*
* should be
* SELECT sqlute_key FROM utenti
*
gtuterec1.
perform
until sql-eod not = sql-eod
call "mysql_fetch_record"
using sql-result
sql-catalog-name
sql-schema-name
sql-default-character-set-name
sql-default-collation-name
sql-sql-path
end-call
if return-code = -1
display "Nessun altro record disponibile"
end-display
exit perform
end-if
if return-code = -9
display "Errato numero di parametri in fetch"
end-display
exit perform
end-if
move spaces to sql-buffer
string
"[" function trim (sql-catalog-name) "] "
"[" function trim (sql-schema-name) "] "
"[" function trim (sql-default-character-set-name) "] "
"[" function trim (sql-default-character-set-name) "] "
"[" function trim (sql-sql-path) "] "
into sql-buffer
end-string
display function trim (sql-buffer)
end-display
end-perform.
gtuterec1-ex.
exit.
working is as followes
*
* sqlparam
* parametri interconnessione motore mysql
*
01 sql-cid usage pointer.
01 sql-result usage pointer.
01 sql-errno pic x(04).
01 sql-msg pic x(80).
01 sql-eod pic x(01).
01 sql-len pic s9(9) comp.
01 sql-buffer pic x(4096).
01 sql-buffer-pointer pic s9(4) comp.
01 sql-sch-buffer.
02 sql-catalog-name pic x(512).
02 sql-schema-name pic x(64).
02 sql-default-character-set-name pic x(32).
02 sql-default-collation-name pic x(32).
02 sql-sql-path pic x(512).
01 w-inspect usage binary-long.
01 w-syscall pic x(80).
01 dirlogin pic x(50).
01 dirstartpar pic x(50).
01 myhostaddr pic x(80).
01 myhostname pic x(80).
01 myuser pic x(80).
01 mypassword pic x(80).
01 mydbase pic x(80).
01 myutenti pic x(80).
01 myporta pic x(80).
01 mysocket pic x(80).
01 env-path pic x(1024).
01 vari-tus.
02 lgn-tus.
03 lgn-tus1 pic x.
03 lgn-tus2 pic x.
02 lgn-tus9 redefines lgn-tus pic 9(4) comp.
02 spr-tus.
03 spr-tus1 pic x.
03 spr-tus2 pic x.
02 spr-tus9 redefines spr-tus pic 9(4) comp.
*----------------------------------------------------------------*
01 mf-area.
02 mf-system pic 9(01).
* se 0: linux
* se 2: cygwin
* se 3: windows
* se 9: valore indeterminato: errore
02 mf-hostaddr pic x(40).
02 mf-hostname pic x(40).
02 mf-utente pic x(40).
02 mf-password pic x(40).
02 mf-porta pic x(40).
02 mf-socket pic x(40).
02 mf-okko pic x(02).
02 mf-terminale pic 9(02).
connector is
/* cob-mysql Version 3.0 23/mar/2011 */
/* 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
**********************************************************************/
/* compilare con gcc -I/usr/include/mysql -c mysqlapi.c */
#include <stdio.h>
#include <string.h>
#include <stdarg.h>
#include <mysql.h>
#include <libcob.h>
#include <stdlib.h>
#include <syslog.h>
#define min(a,b) ((a) < (b) ? (a) : (b))
//function pointer prototype should not include paramater names
//static int (*func)(char *errno, const char *errmsg);
static int (*func)(char *, const char *);
MYSQL sql, *mysql=&sql;
static int errout;
static const cob_field_attr MYSQL_FIELD_ATTRIBUTES = {33, 0, 0, 0, NULL};
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, ...)
{
MYSQL_ROW res;
int rc, j, maxcols;
res = mysql_fetch_row(*result);
if(res != NULL)
{
// cob_call_params contains the number of parameters passed. we subtract 1 to
// account for the WS-MYSQL-RESULT.
//maxcols = min(cob_call_params, mysql_num_fields(*result));
maxcols = min(cob_call_params - 1, mysql_num_fields(*result));
for(j=0; j<maxcols; j++)
{
cob_field *cf_from_cobol = cob_current_module->cob_procedure_parameters[j+1];
if(res[j] == NULL)
{
//memset(cf_from_cobol->data, (char)NULL, strlen(cf_from_cobol->data));
memset(cf_from_cobol->data, 0, cf_from_cobol->size);
}
else
{
cob_field cf_from_mysql = { strlen( res[j] ),
(unsigned char *) res[j],
&MYSQL_FIELD_ATTRIBUTES
};
cob_move( &cf_from_mysql, cf_from_cobol );
}
}
rc = 0;
}
else
{
mysql_free_result(*result);
rc = -1;
}
return rc;
}
int MySQL_fetch_record(MYSQL_RES **result, ...)
{
MYSQL_ROW res;
int rc, j, maxcols;
char strError[255];
res = mysql_fetch_row(*result);
if(res != NULL)
{
// cob_call_params contains the number of parameters passed. we subtract 1 to
// account for the WS-MYSQL-RESULT.
if(cob_call_params - 1 != mysql_num_fields(*result))
{
mysql_free_result(*result);
openlog(NULL, LOG_PERROR | LOG_PID | LOG_NDELAY, LOG_DAEMON);
sprintf(strError, "MySQL_fetch_record: fields mismatch. Given %i, expected %i",
cob_call_params - 1, mysql_num_fields(*result));
syslog(1, strError);
closelog();
exit(0);
}
maxcols = mysql_num_fields(*result);
for(j=0; j<maxcols; j++)
{
cob_field *cf_from_cobol = cob_current_module->cob_procedure_parameters[j+1];
if(res[j] == NULL)
{
memset(cf_from_cobol->data, 0, cf_from_cobol->size);
}
else
{
cob_field cf_from_mysql = { strlen( res[j] ),
(unsigned char *) res[j],
&MYSQL_FIELD_ATTRIBUTES
};
cob_move( &cf_from_mysql, cf_from_cobol );
}
}
rc = 0;
}
else
{
mysql_free_result(*result);
rc = -1;
}
return rc;
}
void MySQL_field_count(int *count)
{
*count = mysql_field_count(mysql);
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;
rc = mysql_query(mysql, query);
err_exit(rc);
return rc;
}
int MySQL_real_connect(char *host, char *user, char *passwd, char *db, unsigned int port, char *unix_socket)
{
int rc;
MYSQL *tmp;
tmp = mysql_real_connect(&sql, host, user, passwd, db, port, unix_socket, 0);
rc = tmp != NULL ? 0 : 1;
err_exit(rc);
return rc;
}
int MySQL_selectdb(char *dbname)
{
int rc;
rc = mysql_select_db(mysql, dbname);
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;
}
someone can help me? Thanks Marcello |
|
|
| jcurrey |
Posted on: 2011/5/30 15:40 |
Home away from home  Joined: 2009/3/19 From: Texas Posts: 181 |
Re: opencobol-mysql connection. @Marcello
I am in the mountains and have very poor internet access.
I did not see a SELECT before your FETCH. If I missed it I apologize.
jimc
|
|
|
| marcellom |
Posted on: 2011/5/30 15:52 |
Quite a regular Joined: 2006/1/4 From: Italy Posts: 62 |
Re: opencobol-mysql connection. Hallo jimc, here it is
selutenti section.
selute0.
* string
* mf-azienda delimited spaces
* "." delimited size
* "utenti" delimited size
* x"00" delimited size
* into myutenti
* end-string
move spaces to sql-buffer
string
"select * from " delimited size
"utenti" delimited size
* x"00" delimited size
";" delimited size
X"00" delimited size
into sql-buffer
end-string
call "mysql_query" using sql-buffer
end-call
if return-code not = 0
move 9 to mf-omega
perform db-error
end-if.
selute1-ex.
exit.
*----------------------------------------------------------------*
stordbres section.
strdbr0.
call "mysql_store_result" using sql-result
end-call
if sql-result = NULL
perform db-error
end-if.
strdbr1-ex.
exit.
Thanks, Marcello |
|
|
| jcurrey |
Posted on: 2011/5/30 16:23 |
Home away from home Joined: 2009/3/19 From: Texas Posts: 181 |
Re: opencobol-mysql connection. Once again, sorry for the brief reply. I do not have access to any of my resources and it takes quite some time for each screen to come up.
Does it fail on the first FETCH?
Could you use breadcrumbs (display statements showing progress and data results)?
|
|
|
| marcellom |
Posted on: 2011/5/30 17:05 |
Quite a regular Joined: 2006/1/4 From: Italy Posts: 62 |
Re: opencobol-mysql connection. Hallo jcurrey.
It's failing on first SELECT column-name FROM table-name.
The real problem is that selecting from forum a cbl sample (commented) and a wrapper.c is quite impossible.
Someone suggests libdbi (with additional software to install and maintain);
Others (mysqlapi.c ocmysqlapi.c, etc, etc) show source from first writing and patches are here and there.
Could you suggest me e real and operating wrapper whith correspondig cbl to analyze?
I've never used breadcrumbs. Should I get and install it?
Thanks,
Marcello
|
|
|
| marcellom |
Posted on: 2011/5/31 7:35 |
Quite a regular Joined: 2006/1/4 From: Italy Posts: 62 |
Re: opencobol-mysql connection (WORK IN PROGRESS). May be someone (an SQL beginner like me) might be interested. The first thing to underline is wrapper choice. After tests, I found the following one works well.
/* cob-mysql Version 3.0 23/mar/2011 */
/* 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
**********************************************************************/
/* salvare il wrapper con nome cobmysql.c
compilare con gcc -I/usr/include/mysql -c cobmysql.c */
#include <stdio.h>
#include <string.h>
#include <stdarg.h>
#include <mysql.h>
#include <libcob.h>
#include <stdlib.h>
#include <syslog.h>
#define min(a,b) ((a) < (b) ? (a) : (b))
//function pointer prototype should not include paramater names
//static int (*func)(char *errno, const char *errmsg);
static int (*func)(char *, const char *);
MYSQL sql, *mysql=&sql;
static int errout;
static const cob_field_attr MYSQL_FIELD_ATTRIBUTES = {33, 0, 0, 0, NULL};
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, ...)
{
MYSQL_ROW res;
int rc, j, maxcols;
res = mysql_fetch_row(*result);
if(res != NULL)
{
// cob_call_params contains the number of parameters passed. we subtract 1 to
// account for the WS-MYSQL-RESULT.
//maxcols = min(cob_call_params, mysql_num_fields(*result));
maxcols = min(cob_call_params - 1, mysql_num_fields(*result));
for(j=0; j<maxcols; j++)
{
cob_field *cf_from_cobol = cob_current_module->cob_procedure_parameters[j+1];
if(res[j] == NULL)
{
//memset(cf_from_cobol->data, (char)NULL, strlen(cf_from_cobol->data));
memset(cf_from_cobol->data, 0, cf_from_cobol->size);
}
else
{
cob_field cf_from_mysql = { strlen( res[j] ),
(unsigned char *) res[j],
&MYSQL_FIELD_ATTRIBUTES
};
cob_move( &cf_from_mysql, cf_from_cobol );
}
}
rc = 0;
}
else
{
mysql_free_result(*result);
rc = -1;
}
return rc;
}
int MySQL_fetch_record(MYSQL_RES **result, ...)
{
MYSQL_ROW res;
int rc, j, maxcols;
char strError[255];
res = mysql_fetch_row(*result);
if(res != NULL)
{
// cob_call_params contains the number of parameters passed. we subtract 1 to
// account for the WS-MYSQL-RESULT.
if(cob_call_params - 1 != mysql_num_fields(*result))
{
mysql_free_result(*result);
openlog(NULL, LOG_PERROR | LOG_PID | LOG_NDELAY, LOG_DAEMON);
sprintf(strError, "MySQL_fetch_record: fields mismatch. Given %i, expected %i",
cob_call_params - 1, mysql_num_fields(*result));
syslog(1, strError);
closelog();
exit(0);
}
maxcols = mysql_num_fields(*result);
for(j=0; j<maxcols; j++)
{
cob_field *cf_from_cobol = cob_current_module->cob_procedure_parameters[j+1];
if(res[j] == NULL)
{
memset(cf_from_cobol->data, 0, cf_from_cobol->size);
}
else
{
cob_field cf_from_mysql = { strlen( res[j] ),
(unsigned char *) res[j],
&MYSQL_FIELD_ATTRIBUTES
};
cob_move( &cf_from_mysql, cf_from_cobol );
}
}
rc = 0;
}
else
{
mysql_free_result(*result);
rc = -1;
}
return rc;
}
void MySQL_field_count(int *count)
{
*count = mysql_field_count(mysql);
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;
rc = mysql_query(mysql, query);
err_exit(rc);
return rc;
}
int MySQL_real_connect(char *host, char *user, char *passwd, char *db, unsigned int port, char *unix_socket)
{
int rc;
MYSQL *tmp;
tmp = mysql_real_connect(&sql, host, user, passwd, db, port, unix_socket, 0);
rc = tmp != NULL ? 0 : 1;
err_exit(rc);
return rc;
}
int MySQL_selectdb(char *dbname)
{
int rc;
rc = mysql_select_db(mysql, dbname);
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;
}
Call to wrapper subroutines are not case insensitive. Is not the same as Program is compiled even with "mysql_fetch_row" but at execution time IT ENDS WITH A SIGSEGV !!! If some needs a track, here it is
procedure division.
in0.
...........
move "<host-name>" to mf-hostaddr
move "<dbase-name>" to mf-azienda
move "<user-name>" to mf-utente
move "<user-password>" to mf-password
move "3306" to mf-porta
move "<socket-path>" to mf-socket
*
* <host-name> il probably localhost
* <dbase-name> is the real name of database you work on
* <user-name> and user-password are your login entries for specific host
* <socket-path> is (for my opensuse system) /var/run/mysql/mysql.sock
*
...........
in1.
move zeroes to mf-omega
perform inizializzadb
if mf-omega not = zero
go to in99
end-if
move zeroes to mf-omega
perform connettiadb
if mf-omega not = zero
go to in99
end-if
perform selezionadb
if mf-omega not = zero
go to in99
end-if
perform selutenti
if mf-omega not = zero
go to in99
end-if
perform getuterec
if mf-omega not = zero
go to in99
end-if.
in99.
perform chiudidb.
in1-ex.
stop run.
This is working-storage.
01 ute-rec.
02 ute-key pic x(0008) .
02 ute-passwd pic x(0010) .
02 ute-group occurs 10 pic x(0008) .
02 ute-menu pic x(0008) .
02 ute-dbname pic x(0008) .
02 ute-jsys pic x(0001) .
01 w-inspect usage binary-long.
01 w-syscall pic x(80).
01 dirlogin pic x(50).
01 dirstartpar pic x(50).
01 myhostaddr pic x(80).
01 myhostname pic x(80).
01 myuser pic x(80).
01 mypassword pic x(80).
01 mydbase pic x(80).
01 myutenti pic x(80).
01 myporta pic x(80).
01 mysocket pic x(80).
01 env-path pic x(1024).
*----------------------------------------------------------------*
01 mf-area.
02 mf-system pic 9(01).
* se 0: linux
* se 2: cygwin
* se 3: windows
* se 9: valore indeterminato: errore
02 mf-hostaddr pic x(40).
02 mf-hostname pic x(40).
02 mf-utente pic x(40).
02 mf-password pic x(40).
02 mf-porta pic x(40).
02 mf-socket pic x(40).
02 mf-okko pic x(02).
02 mf-dbname pic x(08).
02 mf-azix.
03 mf-azibase pic x(03).
03 mf-azisecolo pic 9(02).
03 mf-azianno pic 9(02).
03 mf-aziresto pic x(03).
02 mf-azienda redefines mf-azix pic x(10).
02 mf-omega pic 9(02).
And cobol subroutines interfacing wrapper are
inizializzadb section.
inzdb0.
call "MySQL_init"
using sql-cid
end-call
if return-code not = 0
move 9 to mf-omega
perform db-error
end-if.
inzdb1-ex.
exit.
*----------------------------------------------------------------*
connettiadb section.
connadb0.
string
mf-hostaddr delimited spaces
x"00" delimited size
into myhostaddr
end-string
string
mf-utente delimited spaces
x"00" delimited size
into myuser
end-string
string
mf-password delimited spaces
x"00" delimited size
into mypassword
end-string
string
mf-azienda delimited spaces
x"00" delimited size
into mydbase
end-string
string
mf-porta delimited spaces
x"00" delimited size
into myporta
end-string
string
mf-socket delimited spaces
x"00" delimited size
into mysocket
end-string
call "MySQL_real_connect"
using myhostaddr myuser mypassword
mydbase myporta mysocket
end-call
if return-code not = 0
move 9 to mf-omega
perform db-error
end-if.
connadb1-ex.
exit.
*----------------------------------------------------------------*
selezionadb section.
slzdb0.
call "MySQL_selectdb" using mydbase
end-call
if return-code not = 0
perform db-error
end-if.
slzdb1-ex.
exit.
*----------------------------------------------------------------*
getchsdbinfo section.
gtchsdbinf0.
call "MySQL_get_character_set_info" using sql-buffer
end-call.
gtchsdbinf1-ex.
exit.
*----------------------------------------------------------------*
selutenti section.
selute0.
call "MySQL_query" using "select * from utenti"
end-call
if return-code not = 0
move 9 to mf-omega
perform db-error
end-if
call "MySQL_use_result" using sql-result
end-call
if sql-result = NULL then
perform db-error
end-if.
selute1-ex.
exit.
*----------------------------------------------------------------*
stordbres section.
strdbr0.
call "MySQL_store_result" using sql-result
end-call
if sql-result = NULL
perform db-error
end-if.
strdbr1-ex.
exit.
*----------------------------------------------------------------*
getutenr section.
getutenr0.
call "MySQL_num_rows" using sql-result
end-call
if sql-result = NULL
move 9 to mf-omega
perform db-error
end-if.
getutenr1-ex.
exit.
*----------------------------------------------------------------*
getuterec section.
gtuterec0.
call "MySQL_fetch_fields" using sql-result
ute-key
ute-passwd
ute-group (01)
ute-group (02)
ute-group (03)
ute-group (04)
ute-group (05)
ute-group (06)
ute-group (07)
ute-group (08)
ute-group (09)
ute-group (10)
ute-menu
ute-dbname
ute-jsys
end-call
if sql-result = NULL then
perform db-error
end-if
perform until sql-eod not = sql-eod
call "MySQL_fetch_row" using sql-result
ute-key
ute-passwd
ute-group (01)
ute-group (02)
ute-group (03)
ute-group (04)
ute-group (05)
ute-group (06)
ute-group (07)
ute-group (08)
ute-group (09)
ute-group (10)
ute-menu
ute-dbname
ute-jsys
end-call
if return-code = -1 then
exit perform
end-if
display
ute-key
ute-passwd
ute-group (01)
ute-group (02)
ute-group (03)
ute-group (04)
ute-group (05)
ute-group (06)
ute-group (07)
ute-group (08)
ute-group (09)
ute-group (10)
ute-menu
ute-dbname
ute-jsys
end-display
end-perform.
gtuterec1-ex.
exit.
*----------------------------------------------------------------*
chiudidb section.
chdb0.
call "MySQL_close"
end-call.
chdb1-ex.
exit.
*----------------------------------------------------------------*
db-error section.
db-err0.
call "MySQL_errno" using sql-errno
end-call
call "MySQL_error" using sql-msg
end-call
display
function trim (sql-errno) ":" function trim (sql-msg)
end-display.
db-err1-ex.
exit.
|
|
|
| jcurrey |
Posted on: 2011/5/31 11:11 |
Home away from home Joined: 2009/3/19 From: Texas Posts: 181 |
Re: opencobol-mysql connection (SOLVED). Congratulations!
I apologize for the reference to "bread crumbs". It comes from the fairy tale of Hansel and Gretel.
jimc
|
|
|
| marcellom |
Posted on: 2011/7/7 17:36 |
Quite a regular Joined: 2006/1/4 From: Italy Posts: 62 |
Re: opencobol-mysql connection (WORK IN PROGRESS). Hallo, I'm converting from MicroFocus to open-cobol. Up to most recent released version, split-keys are not allowed in Oc (which, instead, I use a lot in my MF programs). Unable to decide between Berckeley db, C-ISAM, V-ISAM, VB-ISAM, etc., etc. I decided to see what happens and what has to be done for MySQL interaction. In previous post, I showed the partial result I obtained. The connector is Marc Rodriguez, Jim Currey and Pete McThompson. Now, some more work has been done (Jim Currey helped me a lot with suggestions and code by private e-mails) I think that what followes might be useful to someone in Forum and could a base to start from, if other peoples wish to work on the same matter. Most of the work (fd --> sql field conversion, subroutines for interaction, etc.) is automatically done by my own tools. If someone is interested, I will share them. But, be aware, they are multi_purpose tools I have been modifying and re-modifying for ages and have become a lot "spaghetti".
identification division.
program-id. pagapetst.
* date-compiled. .
* security. programma interfaccia MySQL pagape
*
environment division.
configuration section.
source-computer. studiok.
object-computer. studiok.
special-names.
decimal-point is comma
cursor is crsr
console is crt
crt status is crt-tus.
input-output section.
*----------------------------------------------------------------*
file-control.
*----------------------------------------------------------------*
copy "/fms/550/sel/msgerr.sed".
copy "/fms/550/sel/wfarea.sed".
data division.
*----------------------------------------------------------------*
file section.
*----------------------------------------------------------------*
fd msgerr.
01 msg-rec pic x(250).
copy "/fms/550/fd/wfarea.fd".
*----------------------------------------------------------------*
working-storage section.
*----------------------------------------------------------------*
copy "/fms/550/cbl/working.cbl".
copy "/fms/550/cbl/working1.cbl".
copy "/fms/550/sel/msgerr.sew".
copy "/fms/550/sel/wfarea.sew".
copy "/fms/550/fd/pagape.fdv"
replacing ==(pp)== by ==pp== .
copy "/fms/550/fd/pagape.ws1".
01 w-valore pic z(04)9,9(04)-.
01 env-path pic x(1024).
01 w-accept pic x(01).
01 w-retry pic 9(04).
01 w-righe pic 9(04).
01 w-inspect usage binary-long.
01 filinfo.
03 file-size pic 9(18) comp.
03 file-dd pic 9(02) comp.
03 file-mo pic 9(02) comp.
03 file-yy pic 9(04) comp.
03 file-hh pic 9(02) comp.
03 file-mm pic 9(02) comp.
03 file-ss pic 9(02) comp.
03 filler pic 9(02) comp.
01 vari-tus.
02 lgn-tus.
03 lgn-tus1 pic x.
03 lgn-tus2 pic x.
02 lgn-tus9 redefines lgn-tus pic 9(4) comp.
02 spr-tus.
03 spr-tus1 pic x.
03 spr-tus2 pic x.
02 spr-tus9 redefines spr-tus pic 9(4) comp.
02 avv-tus.
03 avv-tus1 pic x.
03 avv-tus2 pic x.
02 avv-tus9 redefines avv-tus pic 9(4) comp.
copy "/fms/550/tus/msgerr.tus".
copy "/fms/550/tus/wfarea.tus".
copy "/fms/550/lnk/mf-area.lnk".
*copy "/fms/550/cbl/sqlparam.wrk".
*----------------------------------------------------------------*
* sqlparam.wrk *
* parametri interconnessione motore mysql *
*----------------------------------------------------------------*-
01 sqcid usage pointer.
01 sqresult usage pointer.
01 sqhostaddr pic x(80).
01 sqhostname pic x(80).
01 sqdbase pic x(80).
01 squser pic x(80).
01 sqpassword pic x(80).
01 sqporta pic x(80).
01 sqsocket pic x(80).
01 sqerrno pic x(04).
01 sqmsg pic x(80).
01 sqrighe pic 9(04).
01 sqomega pic 9(04).
01 sqeod pic x(01).
01 sqlav pic x(01).
01 sqlen pic s9(9) comp-5.
01 sqrows pic s9(9) comp-5.
01 sqcomando pic x(3072).
* 01 sqcomando-hold pic x(3072).
* 01 sqcomando-data-buffer pic x(4096).
* 01 sqbuffer pic x(4096).
* 01 sqbuffer-pointer pic s9(4) comp.
* 01 sqsch-buffer.
* 02 sqcatalog-name pic x(512).
* 02 sqschema-name pic x(64).
* 02 sqdefault-character-set-name pic x(32).
* 02 sqdefault-collation-name pic x(32).
* 02 sqpath pic x(512).
01 myhostaddr pic x(80).
01 myhostname pic x(80).
01 myuser pic x(80).
01 mypassword pic x(80).
01 mydbase pic x(80).
01 myutenti pic x(80).
01 myporta pic x(80).
01 mysocket pic x(80).
*----------------------------------------------------------------*
procedure division.
inizio section.
in0.
move 9 to mf-system
perform prelos
if mf-system = 9
display
"Non posso determinare il sistema opera operativo"
end-display
go to in1-ex
end-if
move spaces to dirmsgerr
move zeroes to mf-omega
sqomega
move 1 to w-scount
if mf-system = zero
move "/fms/dati/msgerr.sdb" to dirmsgerr
move "/fms/dati/wfarea" to dirwfarea
go to in1
end-if
move "c:\fms\dati\msgerr.sdb" to dirmsgerr
move "c:\fms\dati\wfarea" to dirwfarea.
in1.
move "localhost" to mf-hostaddr
move "3306" to mf-porta
move "/var/run/mysql/mysql.sock" to mf-socket
move "mon2011" to mf-azienda
move "<your_user_name>" to mf-utente
move "<your_user_password>" to mf-password
move zeroes to sqomega
perform inizializzadb
if sqomega not = zero
move spaces to w-stringa
move 1 to w-scount
string
"Inizializzazione database non riuscita"
delimited size
into lnk-erro
with pointer w-scount
end-string
perform errore
go to in99
end-if
move zeroes to sqomega
perform connettiadb
if sqomega not = zero
move spaces to w-stringa
move 1 to w-scount
string
"Connessione a database non riuscita"
delimited size
into lnk-erro
with pointer w-scount
end-string
perform errore
go to in99
end-if
move zeroes to sqomega
perform selezionadb
if sqomega not = zero
move spaces to w-stringa
move 1 to w-scount
string
"Selezione database non riuscita"
delimited size
into lnk-erro
with pointer w-scount
end-string
perform errore
go to in99
end-if
move 2011 to pp-esercizio
move 123456 to pp-numero
*
*START: this is a read by primary key
perform pagapesel4read
perform pagapegetnrows
* should return 1 (status 00)
* if zero status 23
*END : this is a read by primary key
*
*START: this is a start/read next
move zeroes to sqomega
move spaces to sqcomando
move 1 to w-scount
string
"SELECT *" delimited size
" FROM pagape WHERE " delimited size
"sqlpp_esercizio" delimited size
" = '" delimited size
pp-esercizio delimited size
"'" delimited size
" AND " delimited size
"sqlpp_numero" delimited size
" LIKE '" delimited size
"123%" delimited size
"'" delimited size
x"00" delimited size
into sqcomando
with pointer w-scount
end-string
perform pagapegetnrows
* number of rows satisfying request
* repeat SELECT to start getting rows
move zeroes to sqomega
move spaces to sqcomando
move 1 to w-scount
string
"SELECT *" delimited size
" FROM pagape WHERE " delimited size
"sqlpp_esercizio" delimited size
" = '" delimited size
pp-esercizio delimited size
"'" delimited size
" AND " delimited size
"sqlpp_numero" delimited size
" LIKE '" delimited size
"123%" delimited size
"'" delimited size
x"00" delimited size
into sqcomando
with pointer w-scount
end-string
perform pagapegetrec
* first record handling
move 1 to xind.
in2.
add 1 to xind
if xind > pagapenrw
go to in50
end-if
perform pagapegetnextrec
* further records handling
go to in2.
*END : this is a start/read next
in50.
move 2011 to pp-esercizio
move 123456 to pp-numero
move "pippo" to pp-numdoc
perform pagaperewrite
move 2011 to pp-esercizio
move 123456 to pp-numero
perform pagapedelete.
in80.
move 2011 to pp-esercizio
move 54321 to pp-numero
move 1 to pp-tipdoc
move "pappolo" to pp-numdoc
move zeroes to pp-datdoc
pp-codclf
pp-codpag
pp-impornet
pp-importo
move spaces to pp-passato
perform pagapeinsert.
in99.
perform chiudidb.
in1-ex.
stop run.
*------------------- subroutines di copia ---------------------*
errore section.
copy "/fms/550/cbl/errore.cbl".
copy "/fms/550/cbl/prelos.sbr".
copy "/fms/550/cbl/prpobjpt.cbl".
*copy "/fms/550/cbl/dbasesbr.sbr".
*----------------------------------------------------------------*
* dbasesbr.sbr *
*----------------------------------------------------------------*
inizializzadb section.
inzdb0.
call "MySQL_init"
using sqcid
end-call
if return-code not = 0
move 9 to sqomega
perform db-error
end-if.
inzdb1-ex.
exit.
*----------------------------------------------------------------*
connettiadb section.
connadb0.
string
mf-hostaddr delimited spaces
x"00" delimited size
into myhostaddr
end-string
string
mf-utente delimited spaces
x"00" delimited size
into myuser
end-string
string
mf-password delimited spaces
x"00" delimited size
into mypassword
end-string
string
mf-azienda delimited spaces
x"00" delimited size
into mydbase
end-string
string
mf-porta delimited spaces
x"00" delimited size
into myporta
end-string
string
mf-socket delimited spaces
x"00" delimited size
into mysocket
end-string
call "MySQL_real_connect"
using myhostaddr myuser mypassword
mydbase myporta mysocket
end-call
if return-code not = 0
move 9 to sqomega
perform db-error
end-if.
connadb1-ex.
exit.
*----------------------------------------------------------------*
selezionadb section.
slzdb0.
call "MySQL_selectdb" using mydbase
end-call
if return-code not = 0
move 9 to sqomega
perform db-error
end-if.
slzdb1-ex.
exit.
*----------------------------------------------------------------*
chiudidb section.
chdb0.
call "MySQL_close"
end-call.
chdb1-ex.
exit.
*----------------------------------------------------------------*
db-error section.
db-err0.
call "MySQL_errno" using sqerrno
end-call
call "MySQL_error" using sqmsg
end-call
display
function trim (sqerrno) ":" function trim (sqmsg)
end-display.
db-err1-ex.
exit.
*----------------------------------------------------------------*
*copy "/fms/550/cbl/pagape.sbr".
*----------------------------------------------------------------*
* pagape.sbr
*----------------------------------------------------------------*
pagapesel4read section.
pagapesel4read0.
move zeroes to sqomega
move spaces to sqcomando
move 1 to w-scount
string
"SELECT * FROM " delimited size
"pagape" delimited size
" WHERE " delimited size
"sqlpp_esercizio" delimited size
" = '" delimited size
pp-esercizio delimited size
"'" delimited size
" AND " delimited size
"sqlpp_numero" delimited size
" = '" delimited size
pp-numero delimited size
"'" delimited size
X"00" delimited size
into sqcomando
with pointer w-scount
end-string.
pagapesel4read1-ex.
exit.
*----------------------------------------------------------------*
pagapesel4rewdel section.
pagapesel4rewdel0.
move zeroes to sqomega
move spaces to sqcomando
move 1 to w-scount
string
"SELECT * FROM " delimited size
"pagape" delimited size
" WHERE " delimited size
"sqlpp_esercizio" delimited size
" = '" delimited size
pp-esercizio delimited size
"'" delimited size
" AND " delimited size
"sqlpp_numero" delimited size
" = '" delimited size
pp-numero delimited size
"'" delimited size
" FOR UPDATE"
X"00" delimited size
into sqcomando
with pointer w-scount
end-string.
pagapesel4rewdel1-ex.
exit.
*----------------------------------------------------------------*
pagapegetnrows section.
pagapegetnrows0.
call "MySQL_query" using sqcomando
end-call
if return-code not = 0
move 9 to sqomega
move "Errore in query pagape "
to lnk-erro
perform errore
move zeroes to lnk-err
go to pagapegetnrows1-ex
end-if
call "MySQL_store_result" using pagaperes
end-call
if pagaperes = NULL
move 9 to sqomega
move "Errore in store result pagape "
to lnk-erro
perform errore
move zeroes to lnk-err
go to pagapegetnrows1-ex
end-if
call "MySQL_num_rows" using pagaperes
sqrows
end-call
move sqrows to pagapenrw
perform pagapefreeres.
pagapegetnrows1-ex.
exit.
*----------------------------------------------------------------*
pagapegetrec section.
pagapegetrec0.
call "MySQL_query" using sqcomando
end-call
if return-code not = 0
move 9 to sqomega
move "Errore in query pagape "
to lnk-erro
perform errore
move zeroes to lnk-err
go to pagapegetrec1-ex
end-if
call "MySQL_store_result" using pagaperes
end-call
if pagaperes = NULL
move 9 to sqomega
move "Errore in store result pagape "
to lnk-erro
perform errore
move zeroes to lnk-err
go to pagapegetrec1-ex
end-if
call "MySQL_fetch_row" using pagaperes
pp_key
app_esercizio
app_numero
pp_tipdoc
pp_numdoc
app_datdoc
app_codclf
app_codpag
app_impornet
app_importo
pp_passato
end-call
if return-code = -1
move 9 to sqomega
move "Errore in fetch row pagape "
to lnk-erro
perform errore
move zeroes to lnk-err
go to pagapegetrec1-ex
end-if
* in Europe we need conversion US -> EU numbers
inspect app-esercizio replacying all " " by "0"
move npp-esercizio to pp-esercizio
inspect app-numero replacying all " " by "0"
move npp-numero to pp-numero
inspect app-datdoc replacying all " " by "0"
move npp-datdoc to pp-datdoc
inspect app-codclf replacying all " " by "0"
move npp-codclf to pp-codclf
inspect app-codpag replacying all " " by "0"
move npp-codpag to pp-codpag
inspect app-impornet replacying all " " by "0"
inspect app-impornet replacying all "." by ","
inspect app-impornet replacying all "-" by "0"
move "-" to app-impornetl (01)
move npp-impornet to pp-impornet
inspect app-importo replacying all " " by "0"
inspect app-importo replacying all "." by ","
inspect app-importo replacying all "-" by "0"
move "-" to app-importol (01)
move npp-importo to pp-importo
continue.
pagapegetrec1-ex.
exit.
*----------------------------------------------------------------*
pagapegetnextrec section.
pagapegetnextrec0.
call "MySQL_fetch_row" using pagaperes
pp_key
app_esercizio
app_numero
pp_tipdoc
pp_numdoc
app_datdoc
app_codclf
app_codpag
app_impornet
app_importo
pp_passato
end-call
if return-code = -1
move 9 to sqomega
move "Errore in fetch row pagape "
to lnk-erro
perform errore
move zeroes to lnk-err
go to pagapegetnextrec1-ex
end-if
* in Europe we need conversion US -> EU numbers
inspect app-esercizio replacying all " " by "0"
move npp-esercizio to pp-esercizio
inspect app-numero replacying all " " by "0"
move npp-numero to pp-numero
inspect app-datdoc replacying all " " by "0"
move npp-datdoc to pp-datdoc
inspect app-codclf replacying all " " by "0"
move npp-codclf to pp-codclf
inspect app-codpag replacying all " " by "0"
move npp-codpag to pp-codpag
inspect app-impornet replacying all " " by "0"
inspect app-impornet replacying all "-" by "0"
move "-" to pp-impornetl (01)
move npp-impornet to pp-impornet
inspect app-importo replacying all " " by "0"
inspect app-importo replacying all "-" by "0"
move "-" to pp-importol (01)
move npp-importo to pp-importo
continue.
pagapegetnextrec1-ex.
exit.
*----------------------------------------------------------------*
pagapeinsert section.
pagapeinsert0.
* in Europe we need conversion EU-> US numbers
move pp-esercizio to npp_esercizio
move pp-numero to npp_numero
move pp-datdoc to npp_datdoc
move pp-codclf to npp_codclf
move pp-codpag to npp_codpag
move pp-impornet to npp_impornet
inspect app-impornet replacying all "," by "."
move pp-importo to npp_importo
inspect app-importo replacying all "," by "."
move spaces to sqcomando
move 1 to w-scount
string
"INSERT INTO " delimited size
"pagape" delimited size
" (" delimited size
"sqlpp_key" delimited size
", " delimited size
"sqlpp_esercizio" delimited size
", " delimited size
"sqlpp_numero" delimited size
", " delimited size
"sqlpp_tipdoc" delimited size
", " delimited size
"sqlpp_numdoc" delimited size
", " delimited size
"sqlpp_datdoc" delimited size
", " delimited size
"sqlpp_codclf" delimited size
", " delimited size
"sqlpp_codpag" delimited size
", " delimited size
"sqlpp_impornet" delimited size
", " delimited size
"sqlpp_importo" delimited size
", " delimited size
"sqlpp_passato" delimited size
")" delimited size
" VALUES " delimited size
"('" delimited size
pp-key delimited size
"', '" delimited size
app-esercizio delimited size
"', '" delimited size
app-numero delimited size
"', '" delimited size
pp-tipdoc delimited size
"', '" delimited size
pp-numdoc delimited size
"', '" delimited size
app-datdoc delimited size
"', '" delimited size
app-codclf delimited size
"', '" delimited size
app-codpag delimited size
"', '" delimited size
app-impornet delimited size
"', '" delimited size
app-importo delimited size
"', '" delimited size
pp-passato delimited size
"')" delimited size
X"00" delimited size
into sqcomando
with pointer w-scount
end-string
call "MySQL_query" using sqcomando
end-call
if return-code not = 0
move 9 to sqomega
move "Errore in insert pagape "
to lnk-erro
perform errore
move zeroes to lnk-err
go to pagapeinsert1-ex
end-if.
pagapeinsert1-ex.
exit.
*----------------------------------------------------------------*
pagaperewrite section.
pagaperewrite0.
* in Europe we need conversion EU-> US numbers
move pp-esercizio to npp_esercizio
move pp-numero to npp_numero
move pp-datdoc to npp_datdoc
move pp-codclf to npp_codclf
move pp-codpag to npp_codpag
move pp-impornet to npp_impornet
inspect app-impornet replacying all "," by "."
move pp-importo to npp_importo
inspect app-importo replacying all "," by "."
move spaces to sqcomando
move 1 to w-scount
string
"UPDATE " delimited size
"pagape" delimited size
" set " delimited size
"sqlpp_key" delimited size
" = '" delimited size
pp-key delimited size
"', " delimited size
"sqlpp_esercizio" delimited size
" = '" delimited size
app-esercizio delimited size
"', " delimited size
"sqlpp_numero" delimited size
" = '" delimited size
app-numero delimited size
"', " delimited size
"sqlpp_tipdoc" delimited size
" = '" delimited size
pp-tipdoc delimited size
"', " delimited size
"sqlpp_numdoc" delimited size
" = '" delimited size
pp-numdoc delimited size
"', " delimited size
"sqlpp_datdoc" delimited size
" = '" delimited size
app-datdoc delimited size
"', " delimited size
"sqlpp_codclf" delimited size
" = '" delimited size
app-codclf delimited size
"', " delimited size
"sqlpp_codpag" delimited size
" = '" delimited size
app-codpag delimited size
"', " delimited size
"sqlpp_impornet" delimited size
" = '" delimited size
app-impornet delimited size
"', " delimited size
"sqlpp_importo" delimited size
" = '" delimited size
app-importo delimited size
"', " delimited size
"sqlpp_passato" delimited size
" = '" delimited size
pp-passato delimited size
"'" delimited size
" WHERE " delimited size
"sqlpp_esercizio" delimited size
" = '" delimited size
pp-esercizio delimited size
"'"
" AND "
"sqlpp_numero" delimited size
" = '" delimited size
pp-numero delimited size
"'"
X"00" delimited size
into sqcomando
with pointer w-scount
end-string
call "MySQL_query" using sqcomando
end-call
if return-code not = 0
move 9 to sqomega
move "Errore in rewrite pagape "
to lnk-erro
perform errore
move zeroes to lnk-err
go to pagaperewrite1-ex
end-if.
pagaperewrite1-ex.
exit.
*----------------------------------------------------------------*
pagapedelete section.
pagapedelete0.
move zeroes to sqomega
move spaces to sqcomando
move 1 to w-scount
string
"DELETE FROM " delimited size
"pagape" delimited size
" WHERE " delimited size
"sqlpp_esercizio" delimited size
" = '" delimited size
pp-esercizio delimited size
"'" delimited size
" AND " delimited size
"sqlpp_numero" delimited size
" = '" delimited size
pp-numero delimited size
"'" delimited size
X"00" delimited size
into sqcomando
with pointer w-scount
end-string
call "MySQL_query" using sqcomando
end-call
if return-code not = 0
move 9 to sqomega
move "Errore in delete pagape "
to lnk-erro
perform errore
move zeroes to lnk-err
go to pagapedelete1-ex
end-if.
pagapedelete1-ex.
exit.
*----------------------------------------------------------------*
pagapefreeres section.
pagapefreeres0.
if pagaperes not = NULL
call "MySQL_free_result" using pagaperes
end-call
end-if.
pagapefreeres1-ex.
exit.
*----------------------------------------------------------------*
end program pagapetst .
Marcellom |
|
|
|
OpenCOBOL Forum Index