OpenVMS Source Code Demos
mysql_demo16
1000 declare string constant k_program = "MYSQL_DEMO16"
!==============================================================================================================
! title : mysql_demo16.bas (derived demo14 and demo13)
! author : Neil Rieck ( https://neilrieck.net MAILTO:n.rieck@bell.net )
! : Waterloo, Ontario, Canada.
! created: 2017-11-21
! os : OpenVMS-8.4 on Itanium2 (should work as-is on Alpha)
! purpose: Directly call mysql/mariadb client software from VMS-BASIC (the database could be local to OpenVMS
! or remote on any platform you wish)
! note-1 : When doing RMS-based file i/o from within VMS-BASIC we use statements like: open, find, get, put,
! update, and close. The original iteration of BASIC-Plus-2 also employed "MOVE_TO" and "MOVE_FROM" to
! transfer between RMS and BASIC. I will attempt to do something simialar here.
! note-2 : Calling DEC-C from VMS-BASIC is a fairly straight-forward programming task. However, the RMS-based
! code I intend to replace may have 2-3-4-5 files open at any one time. I may want to do something
! similar here because I want some of the business rules in the BASIC program rather than in DB stored
! procedures. For example, one of my BASIC-RMS applications will perform business checks like this:
! A) slide along business orders stopping on each one (get #21). Then...
! B) check all related labour charges for each order like so (get #25)
! C) check all related material charges for each order like so (get #27)
! D) compute requisite taxes for the sub-totals; validate account data, etc.
! E) based upon what I do (or do not) detect, write transactional charges (put #99)
! F) mark the order as billed (update #21)
! G) write order history (put #23)
! H) move to the next business order (iterate from step-a)
! Obviously maintaining multiple buffers can get pretty hairy which is why this program and API appear
! much more complicated than they should
! note-3 : This demo has "max_arrays = 3" which you can increase or decrease as desired. I doubt you would ever
! increase this value larger than 9 but if you do then you must also increase array sizes IN THE
! COMMON structure (both BASIC and C) which are currently hardcoded to 9.
! note-4 : In this demo I am forcing charset to be latin1. This is necessary because some of our French data is
! stored as UTF-8 but this program needs to write single bytes (eg. Windows-1252) to RMS. Switching to
! "latin1" will cause MariaDB to convert the UTF-8 data for me.
! who when what
! --- ------ --------------------------------------------------------------------------------------------------
! NSR 171121 1. original effort (derived from demo14 and demo13)
! 2. now force charset to be latin1. See note-4 just above
!==============================================================================================================
option type=explicit !
set no prompt !
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$spawn
declare long constant max_arrays = 3 ! A$(), B$(), C$()
!
! these functions are defined in file: MYSQL_API_DEMO15.C
!
external long function NSR_CLOSE(long by value) !
external long function NSR_CHARSET(string,long by value) !
external long function NSR_CONNECT(long by value) !
external long function NSR_CONNECT_PARAMS(string,string,string,string,string,long by value)
external long function NSR_FETCH(long by value,long by value) !
external long function NSR_QUERY(string,long by value,long by value) !
!
declare long rc ,&
result ,&
x ,&
y ,&
i,j,k ,&
handler_error ,&
line_count ,&
db_param_bits ,&
verbose ,&
dim_size ,&
choice ,&
junk ,&
buf_num ,&
string db_username ,&
db_password ,&
db_database ,&
db_host ,&
db_charset ,&
session_charset ,&
junk$ ,&
temp$ ,&
cmd$
!
! communicating with "C" through a COMMON may be more efficient when multiple buffers are concerned
! Note: if you start an SQL operation on channel 3 then look to CMN_STAT(3) for the response code
!
common (CMN) long CMN_SANITY , ! &
long CMN_ADDR(9) , ! 10 (0-9) items (array addresses) &
long CMN_SIZE(9) , ! 10 (0-9) items (array maximum sizes) &
long CMN_STAT(9) , ! 10 (0-9) items (mysql status code) &
long CMN_ROWS(9) , ! 10 (0-9) items (actual number of rows) &
long CMN_COLS(9) , ! 10 (0-9) items (actual number of columns) &
long CMN_MORE(9) , ! 10 (0-9) items (more data available?) &
long CMN_STATUS , ! response status &
long CMN_MSG_LEN , ! response text length &
string CMN_MSG_TXT=256 , ! response text &
long CMN_LAST !
!=======================================================================
! initialize
!=======================================================================
2000 initialize: !
CMN_SANITY = loc(CMN_LAST) - loc(CMN_SANITY) + 4 ! measure the size of our common
gosub zap_all_arrays !
gosub init_all_arrays !
goto main !
!=======================================================================
! init all arrays
! note: unless specified otherwise, declared arrays always begin
! with subscript zero
!=======================================================================
2100 init_all_arrays: !
!
choice = 1 !
dim_size = 1999 ! I want a$() to be larger
gosub init_array !
!
for choice = 2 to 3 !
dim_size = 199 ! I want b$() and c$() to be smaller
gosub init_array !
next choice !
return !
!=======================================================================
! init array
! entry: choice = array to set
! dim_size = highest subscript
!=======================================================================
2200 init_array: !
when error in !
select choice !
case 1 ! A$() is on channel #1
dim string a$(dim_size) !
junk = loc(a$(0)) !
case 2 ! B$() is on channel #2
dim string b$(dim_size) !
junk = loc(b$(0)) !
case 3 ! C$() is on channel #3
dim string c$(dim_size) !
junk = loc(c$(0)) !
case else !
junk = 0 !
print "-e-error, the programmer forgot to code storage for choice:",choice
end select !
CMN_ADDR(choice) = junk ! store address of selected array
CMN_SIZE(choice) = dim_size ! store max subscript of selected array
CMN_ROWS(choice) = 0 ! various init(s)
CMN_COLS(choice) = 0 !
CMN_MORE(choice) = 0 !
CMN_STATUS = 0 !
CMN_MSG_LEN = 0 !
CMN_MSG_TXT = "" !
use !
print "-e-error:",err," when sizing array with choice:",choice !
end when !
return !
!=======================================================================
! zap all arrays
!=======================================================================
2300 zap_all_arrays: !
for choice = 1 to max_arrays !
dim_size = 0 !
gosub init_array !
next choice !
return !
!=======================================================================
! main
!=======================================================================
3000 main:
print "-i-program: "; k_program !
buf_num = 1 ! only using A$()
session_charset = "latin1" !
!
input "verbose? (Y/n) ";junk$ !
select edit$(junk$,32+2) !
case "N" !
verbose = 0 !
case else !
verbose = 1 !
end select !
!
print "select a connect method" !
print " 1) determine db connect params in C" !
print " 2) determine db connect params in BASIC" !
input "method? (1/2, default=1) ",junk$ !
select junk$ !
case "2" !
gosub get_connect_params !
if (db_param_bits and 3%) <> 3% then !
print "-e-insufficient number of parameters to continue:";db_param_bits
goto fini !
end if !
result = NSR_CONNECT_PARAMS(db_username,db_password,db_host,db_database,db_charset,verbose)
print result !
case else !
result = NSR_CONNECT(verbose) !
end select !
print "-i-connect result:";result !
!
! our French data contains multibyte characters (UTF-8) but this program requires single-byte characters
! changing to 'latin1' will instruct maria-db to convert the data for us
!
if session_charset <> "" then
result = NSR_CHARSET(session_charset, verbose) !
print "-i-charset result:";result !
end if
!
! this next step is superfluous because I specified the database in the select statement
!
!~~~ result = NSR_QUERY("use material", verbose, buf_num) x
!~~~ print "-i-query result:";result x
!
! Here is the SQL statement I want to execute. Not that Quebec product codes are prefixed
! with BC and MC while Ontario product codes are prefixed are prefixed with BA and MA.
!
! select u.id, u.description, u.usocclass, p.cost
! from material.usoc as u
! inner join material.usoc_parms as p
! where (u.usocclass='USOCP')
! and (u.id=p.id)
! and ((u.id like 'BC%') or (u.id like 'MC%'))
! and (p.begin <= CURDATE()) and (CURDATE() <= p.end);
!
cmd$ = "select u.id, u.description, u.usocclass, p.cost" +&
" from material.usoc as u" +&
" inner join material.usoc_parms as p" +&
" where (u.usocclass='USOCP')" +&
" and (u.id=p.id)" +&
" and ((u.id like 'BC%') or (u.id like 'MC%'))" +&
" and (p.begin <= CURDATE()) and (CURDATE() <= p.end);"
!
result = NSR_QUERY(cmd$, verbose, 1) !
print "-i-result 3:";result !
if result=0 then !
result = NSR_FETCH(0, buf_num) !
print "-i-col count: ";CMN_COLS(buf_num) !
print "-i-row count: ";CMN_ROWS(buf_num) !
print "-i-displaying array elements in BASIC:"
declare long e,c,r !
for r = 0 to (CMN_ROWS(buf_num)-1) !
for c=0 to (CMN_COLS(buf_num)-1) !
e = (r * CMN_COLS(buf_num)) + c ! compute the subscript
print using "row ### |";r; if c=0 ! if first one
print a$(e); "|"; !
next c !
print ! end of row
next r !
end if !
!
result = NSR_CLOSE(verbose) !
print "-i-result 4:";result !
!
goto fini
!=======================================================================
! get connect params
!=======================================================================
get_connect_params:
!
! method #1: parameter file
!
print "-i-attempting parameter load from file"
when error in
db_param_bits = 0 ! inits
db_database = "" !
db_username = "" !
db_password = "" !
db_host = "" !
db_charset = "" !
line_count = 0 !
!
!# example template for mysql_demo.ini
!# HOST and DATABASE are optional
!USERNAME=neil
!PASSWORD=yadayadayada
!HOST=kawc4m.on.bell.ca
!DATABASE=
!CHARSET=
!#-----------------------
!
open "mysql_demo.ini" for input as #9 &
,organization sequential &
,access read &
,allow modify !
while 1 !
linput #9, junk$ !
line_count = line_count + 1 !
select left$(junk$,1) !
case "!","#" ! if comment line
iterate ! then skip
end select !
i = pos(junk$,"=",1) ! get the position of equal sign
if i = 0 then ! oops
print "-w-no-equal-sign; skipping parameter line:",line_count
iterate !
end if !
temp$ = left$(junk$,i) ! get the parameter name
select edit$(temp$,32) ! upcase test
case "USERNAME=" !
db_username = right$(junk$,i+1) !
db_param_bits = db_param_bits or 1% !
case "PASSWORD=" !
db_password = right$(junk$,i+1) !
db_param_bits = db_param_bits or 2% !
case "HOST=" !
db_host = right$(junk$,i+1) !
db_param_bits = db_param_bits or 4% !
case "DATABASE=" !
db_database = right$(junk$,i+1) !
db_param_bits = db_param_bits or 8% !
case "CHARSET=" !
db_charset = right$(junk$,i+1) !
db_param_bits = db_param_bits or 16% !
case else !
print "-w-unsupported-parameter; skipping parameter line:",line_count
end select !
next !
use !
handler_error = err !
end when !
!
if (db_param_bits and 3%) = 3% then ! if at least username + password then exit
goto exit_get_connect_params !
end if !
!
! method #2: logical names
!
print "-i-attempting parameter load from logical names"
db_param_bits = 0 ! inits
db_username = "" !
db_password = "" !
db_host = "" !
db_database = "" !
rc = lib$get_logical("MARIA_USER" ,db_username,,"LNM$SYSTEM_TABLE")
db_param_bits = db_param_bits or 1% if (rc and 1%) = 1%
rc = lib$get_logical("MARIA_PASSWORD" ,db_password,,"LNM$SYSTEM_TABLE")
db_param_bits = db_param_bits or 2% if (rc and 1%) = 1%
rc = lib$get_logical("MARIA_SERVER" ,db_host ,,"LNM$SYSTEM_TABLE")
db_param_bits = db_param_bits or 4% if (rc and 1%) = 1%
rc = lib$get_logical("MARIA_DATABASE" ,db_database,,"LNM$SYSTEM_TABLE")
db_param_bits = db_param_bits or 8% if (rc and 1%) = 1%
rc = lib$get_logical("MARIA_CHARSET" ,db_charset ,,"LNM$SYSTEM_TABLE")
db_param_bits = db_param_bits or 16% if (rc and 1%) = 1%
!
exit_get_connect_params: !
return !
!
! That's all folks
!
32000 fini: !
print "-i-exiting" !
end !
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.