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:[email protected] ) ! : 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.