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									!

home Back to Home
Neil Rieck
Waterloo, Ontario, Canada.