tldm-universe/Ardent/UV/BP/SRVP.MAINT.B
2024-09-09 17:51:08 -04:00

958 lines
38 KiB
Plaintext
Executable File

******************************************************************************
*
* Routine to handle UniVerse SQLCO Server Parameters Management
*
* Module %M% Version %I% Date %H%
*
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
* This is unpublished proprietary source code of Ardent Software Inc.
* The copyright notice above does not evidence any actual or intended
* publication of such source code.
*
*******************************************************************************
*
* Maintenence log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description........................................
* 10/14/98 23801 SAP Change copyrights.
* 10/08/93 12380 CSM comments, cleanup
* 10/05/93 ---- CSM Initial programming
*
*******************************************************************************
$OPTIONS INFORMATION
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
common /sqlcocfg/ GNRC, IDBMS, SRVRS, CDBMS, PARMS, config2
******************************************************************************
* SRVPARS is the combination of GNRC, IDBMS and CDBMS for all servers
* lSRVPARS is the combination of SRVPARS and lSRVRS for the server at srvploc
*
* SRVPARS: Field n, Value 1 contains a user-configured server name
* Value 2 contains the SV params separated by sub-value marks
* Value 3 contains keywords of the SV params with SV marks
* Value 4 contains the MV params separated by sub-value marks
* lSRVPARS: Value 5 contains flags set for user-configured MV params
* lSRVPARS: Value 6 contains flags set for user-configured SV params
******************************************************************************
* Various other variables
******************************************************************************
equ Default to 1
equ Y.N.Start to 17 ; * Starting location of y/n box
******************************************************************************
* Strings representing shell scripts to be executed and files used
******************************************************************************
Blank.Message = @SYS.BELL:UVREADMSG(071004,"")
******************************************************************************
temp=NULL
CALL *ISUSER.B(0,temp)
IF temp=0 THEN
TPRINT UVREADMSG(071000,"")
SLEEP 3
* STOP
END
help.message=CONVERT(@FM," ",UVREADMSG(073644,""))
*****************************************************************************
* go to all initialization routines
*****************************************************************************
GOSUB init.vars ; * initialize local variables
******************************************************************************
* In this section, we draw the first screen, print the menu bar and help
* areas, and put up the first title and form to fill out.
******************************************************************************
CALL *DRAW.SCRN.B(UVREADMSG(073834,""),1)
CALL *HELP.PRINT.B(CONVERT(@FM," ",UVREADMSG(073802,"")),2)
GOSUB init.menu ; * Initialize menu bar items
CALL *MNU.BAR.PR.B(Menu.Bar,1)
GOSUB init.form ; * Initialize forms to be used
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
CALL READ.CONFIG
lSRVRS = SRVRS
GOSUB create.lists
******************************************************************************
* Starting point for routines actual activity. Paint help message and
* continue
******************************************************************************
help.loop:
CALL *HELP.PRINT.B(form<form.line,4>,1)
******************************************************************************
* Starting point for actual data input. Here we position the cursor to the
* place of the secondary prompt and get the input character, which is returned
* in special, if a special character was encountered, or in temp, is data
* was entered.
******************************************************************************
input.loop:
TPRINT form<form.line,2>: ; * position cursor
temp=temp.form<form.line>
CALL *CINPUT.B(SEC.PRMPT,temp,special,form<form.line,6>,form<form.line,7>)
******************************************************************************
* First section handles all the special characters.
******************************************************************************
IF special # 0 THEN ; * if special character encountered
BEGIN CASE
******************************************************************************
* Special character was Function Key F10. FALSE menu bar, get more data
* Unless operation = Maintain, then do menu bar actions...
******************************************************************************
CASE special = F.10 ; * Function key F10 was pressed
action.value = 1
CALL *DO.MNU.BAR.B(Menu.Bar,action.value,form.size,form,temp.form)
BEGIN CASE
CASE action.value = 1 ; * ADD server parameter
temp.form<1>="Add"
modified=0
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
IF temp.form<2>=NULL THEN
CALL *HELP.BOX.B(5,5,50,UVREADMSG(073827,""))
END
GOTO end.f10
CASE action.value = 2 ; * Delete current entry
temp.form<1>="Delete"
modified=0
GOTO end.f10
CASE action.value = 3 ; * List current parameters of server
IF temp.form<2>=NULL THEN
CALL *HELP.BOX.B(5,5,50,UVREADMSG(073827,""))
GOTO end.f10
END
GOSUB prcurprms
GOTO end.f10
CASE action.value = 10 ; * Modify parameter of server
temp.form<1>="Modify"
modified=0
GOTO end.f10
CASE action.value = 5 ; * Refresh screen
flag = TRUE
CALL *HELP.PRINT.B(NULL,3)
CALL *YES.NO.BOX.B(Y.N.Start,UVREADMSG(073061,""),flag)
IF flag=TRUE THEN
form.line=2
temp.form<3>=NULL
server.param=NULL
lSRVRS=SRVRS
END
CASE action.value = 6 ; * Save changes
flag=TRUE
CALL *HELP.PRINT.B(NULL,3)
CALL *YES.NO.BOX.B(Y.N.Start,UVREADMSG(073066,""),flag)
IF flag=TRUE THEN GOSUB Write.Server
form.line=2
CASE action.value = 7 ; * Exit
flag = FALSE
CALL *HELP.PRINT.B(NULL,3)
CALL *YES.NO.BOX.B(Y.N.Start,UVREADMSG(073066,""),flag)
IF flag=TRUE THEN
GOSUB Write.Server
END
STOP @(-1)
CASE action.value = 4 ; * help on Application
message=UVREADMSG(073808,"")
CONVERT @FM TO " " IN message
CALL *HELP.BOX.B(4,10,60,message)
CASE action.value = 8 ; * help on Keys
message=UVREADMSG(076001,"")
CONVERT @FM TO " " IN message
CALL *HELP.BOX.B(3,10,60,message)
CASE action.value = 9 ; * help on version
CALL *HELP.BOX.B(6,4,45,UVREADMSG(076000,""))
END CASE
end.f10:
CALL *PUT.FORM.B(form.size, form, temp.form, PRMPT,1)
GOTO help.loop ; * repaint and get new value
******************************************************************************
* Up arrow was pressed.
******************************************************************************
CASE special = UP.ARROW ; * Up arrow was pressed
TPRINT form<form.line,2>:PRMPT:
IF temp.form<form.line> # NULL THEN
TPRINT temp.form<form.line>:
TPRINT STR(SPACE,form<form.line,6>-LEN(temp.form<form.line>))
END
form.line-=1
IF form.line < 2 THEN
form.line=form.size
END
GOTO help.loop ; * get more input
******************************************************************************
* Down arrow was pressed.
******************************************************************************
CASE special = DOWN.ARROW ; * Down arrow was pressed
TPRINT form<form.line,2>:PRMPT:
IF temp.form<form.line> # NULL THEN
TPRINT temp.form<form.line>:
TPRINT STR(SPACE,form<form.line,6>-LEN(temp.form<form.line>))
END
form.line+=1
IF form.line > form.size THEN
form.line=2
END
GOTO help.loop ; * get more input
******************************************************************************
* Function key F1 was pushed. This key is used to display more involved
* Help messages
******************************************************************************
CASE special = F.1
CALL *HELP.PRINT.B(form<form.line,5>,3)
GOTO input.loop ; * get more input
******************************************************************************
* Escape key pressed. This is the systems signal to return to the calling
* procedure. First clear the screen however
******************************************************************************
CASE special = ESCAPE ; * escape was pressed
STOP @(-1)
CASE special = F.4
temp="*"
GOTO new.enter
CASE Default
GOTO help.loop
END CASE ; * end of case
END ; * end of if statement
******************************************************************************
* If we reach here, we must have had data input, which is returned from
* *NINPUT in the variable temp. Therefore, process it and execute the
* desired operation.
******************************************************************************
ELSE
new.enter:
sel.val=1
CALL *HELP.PRINT.B(NULL,3) ; * Clears help area
jump=0
BEGIN CASE
CASE form.line=2
IF temp="*" THEN
CALL *HELP.PRINT.B(UVREADMSG(073058,""),2)
CALL *HELP.PRINT.B(help.message,2)
GOSUB prlstsrv
CALL *HELP.PRINT.B(NULL,3)
IF sel.val=-1 THEN
temp=NULL
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
ELSE
temp=sel.val
temp.form<form.line>=temp
END
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
END
IF temp=NULL THEN
CALL *HELP.BOX.B(17,5,50,Blank.Message)
GOTO help.loop
END
IF NOT(temp MATCHES "1A0X") THEN
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073814,""))
temp.form<form.line>=NULL
server.name=NULL
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
locname=temp
gosub locatesrvr
IF srvrloc=0 THEN ; * Server does not exist
CALL *HELP.BOX.B(5,5,50,UVREADMSG(073835,temp))
temp.form<form.line>=temp
server.name=temp
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
temp.form<form.line>=temp
server.name=temp
CASE form.line=3 ; * Enter Parameter
IF temp="?" THEN
CALL *HELP.PRINT.B(UVREADMSG(073058,""),2)
CALL *HELP.PRINT.B(help.message,2)
GOSUB prlstprms
CALL *HELP.PRINT.B(NULL,3)
IF sel.val=-1 THEN temp=NULL
ELSE
temp=sel.val:" = "
temp.form<form.line>=temp
END
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
IF modified=1 OR temp.form<1>="Add" AND temp=NULL THEN
CALL *HELP.BOX.B(17,5,50,Blank.Message)
temp.form<3>=NULL
server.param=NULL
modified=0
GOTO help.loop
END
IF temp="*" THEN
CALL *HELP.PRINT.B(UVREADMSG(073058,""),2)
CALL *HELP.PRINT.B(help.message,2)
GOSUB prcurprms
CALL *HELP.PRINT.B(NULL,3)
IF sel.val=-1 THEN temp=NULL
ELSE
temp=sel.val
temp.form<form.line>=temp
server.param = temp
END
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
IF NOT(temp=NULL) AND NOT(temp MATCHES "1A0X") THEN
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073833,""))
temp.form<form.line>=NULL
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
IF NOT(temp=NULL) THEN
param = upcase(field(temp, ' ', 1))
locate param in PARMS<1> by "AL" setting loc else
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073840,param))
temp.form<form.line>=NULL
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
eqpos=index(temp, '=', 2)
IF NOT(eqpos=0) THEN
IF NOT(field(temp,' ',2)='=') OR field(temp,' ',3)=NULL OR NOT(field(temp,' ',4)='=') OR field(temp,' ',5)=NULL OR index(temp,' ',5) THEN
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073852,""))
temp.form<form.line>=temp
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
END
ELSE
IF index(temp,' ',3) THEN
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073841,""))
temp.form<form.line>=temp
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
IF param="MAPERROR" OR param="SQLTYPE" THEN
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073852,""))
temp.form<form.line>=temp
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
END
eqpos=index(temp, ' = ', 1)
IF eqpos=0 OR NOT(field(temp,' ',2)='=') OR field(temp,' ',3)=NULL THEN
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073841,""))
temp.form<form.line>=temp
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
temp[1,eqpos]=upcase(temp[1,eqpos])
END
temp.form<form.line> = temp
server.param = temp
END CASE
END
IF form.line > 2 AND server.name=NULL THEN
CALL *HELP.BOX.B(17,5,50,Blank.Message)
form.line=2
GOTO help.loop
END
locname=server.name
gosub locatesrvr
IF srvrloc=0 THEN
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073835,server.name))
form.line=2
GOTO help.loop
END
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,form<form.line,6>-LEN(temp.form<form.line>)):
IF jump=1 THEN
jump=0
form.line+=1
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
TPRINT STR(SPACE,form<form.line,6>-LEN(temp.form<form.line>)):
END
form.line +=1
IF form.line <= form.size THEN GOTO help.loop
IF temp.form<1>="Delete" THEN GOSUB procdel
IF temp.form<1>="Modify" AND temp.form<3> = NULL THEN
GOSUB procmodify
GOTO help.loop
END
IF temp.form<1>="Add" AND temp.form<3>=NULL THEN
CALL *HELP.BOX.B(17,5,50,Blank.Message)
form.line=3
GOTO help.loop
END
IF temp.form<1>="Add" OR temp.form<1>="Modify" THEN
flag=FALSE
CALL *YES.NO.BOX.B(Y.N.Start,UVREADMSG(073065,""),flag)
IF flag = FALSE THEN GOSUB amparam
END
form.line = 2
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
STOP @(-1)
******************************************************************************
* init.menu -
* Routine that initializes Menu Bar values for Maintain Servers section
* of code.
******************************************************************************
init.menu:
scratch=UVREADMSG(073828,"")
Menu.Bar = NULL
Menu.Bar<1,1> = 3 ; * Number of Items in Menu.Bar
Menu.Bar<1,2> = 2 ; * Line # on which to print the Menu Bar
* First Item
Menu.Bar<2,1,1>=scratch<1> ; * SubMenu Title
Menu.Bar<2,1,2>=3 ; * # of items in SubMenu
* SubMenu #1
Menu.Bar<2,2,1>=scratch<2> ; * SubMenu Item
Menu.Bar<2,2,2>=5 ; * Action Code (Returned to calling process)
Menu.Bar<2,2,3>=scratch<3>
Menu.Bar<2,3,1>=scratch<4>
Menu.Bar<2,3,2>=6
Menu.Bar<2,3,3>=scratch<5>
Menu.Bar<2,4,1>=scratch<6>
Menu.Bar<2,4,2>=7
Menu.Bar<2,4,3>=scratch<7>
* Second Item
Menu.Bar<3,1,1>=scratch<8> ; * SubMenu Title Action
Menu.Bar<3,1,2>=4 ; * # of items in SubMenu
* SubMenu #1
Menu.Bar<3,2,1>=scratch<9> ; * SubMenu Item Add
Menu.Bar<3,2,2>=1 ; * Action Code
Menu.Bar<3,2,3>=scratch<10>
Menu.Bar<3,3,1>=scratch<11> ; * SubMenu Item Delete
Menu.Bar<3,3,2>=2 ; * Action Code
Menu.Bar<3,3,3>=scratch<12>
Menu.Bar<3,4,1>=scratch<13> ; * SubMenu Item List
Menu.Bar<3,4,2>=3 ; * Action Code
Menu.Bar<3,4,3>=scratch<14>
Menu.Bar<3,5,1>=scratch<15> ; * SubMenu Item Modify
Menu.Bar<3,5,2>=10 ; * Action Code
Menu.Bar<3,5,3>=scratch<16>
scratch=UVREADMSG(073089,"")
Menu.Bar<4,1,1>=scratch<1>
Menu.Bar<4,1,2>=3
Menu.Bar<4,2,1>=scratch<2>
Menu.Bar<4,2,2>=4
Menu.Bar<4,2,3>=scratch<3>
Menu.Bar<4,3,1>=scratch<4>
Menu.Bar<4,3,2>=8
Menu.Bar<4,3,3>=scratch<5>
Menu.Bar<4,4,1>=scratch<6>
Menu.Bar<4,4,2>=9
Menu.Bar<4,4,3>=scratch<7>
RETURN
******************************************************************************
* Init.form
* This routine initializes all the positional parameters, help strings,
* text strings, and default values for the form used in this subroutine
******************************************************************************
init.form:
form.size=3
form=NULL
scratch=UVREADMSG(073829,"")
form<1,1>=@(5,5) ; * Start of Field Text
form<1,2>=@(17,5) ; * Start of Field Data
form<1,3>=scratch<1> ; * Message File Field Text
form<1,4>="" ; * Message File Field Help
form<1,5>="" ; * Message File Field long help, if any
form<1,6>=10 ; * Field data length
form<1,7>=1 ; * Field data upper-case
form<2,1>=@(5,7)
form<2,2>=@(17,7)
form<2,3>=scratch<2>
form<2,4>=scratch<3>
form<2,5>=form<2,4>
form<2,6>=31
form<2,7>=1
form<3,1>=@(5,8)
form<3,2>=@(17,8)
form<3,3>=scratch<4>
form<3,4>=scratch<5>
form<3,5>=scratch<6>
form<3,6>=60
form<3,7>=1
temp.form<1>="Add"
RETURN
******************************************************************************
* Write.Server -
* This routine will write out the various lists to the configuration file.
******************************************************************************
Write.Server:
rewrite:
openseq config2 to cfgfile else
retry=0
m1=UVREADMSG(073800,"")
call *ERROR.BOX.B(10,3,0,UVREADMSG(073005,config2),retry,m1)
if retry#0 then stop @(-1)
else goto rewrite
end
line=1
OK=1
m1=UVREADMSG(073818,"")
writeseq "[ODBC DATA SOURCES]" to cfgfile else goto writeerr
for i=1 to dcount(lSRVRS,@FM)
writeseq "<":lSRVRS<i,1>:">" to cfgfile else goto writeerr
writeseq lSRVRS<i,2> to cfgfile else goto writeerr
writeseq lSRVRS<i,3> to cfgfile else goto writeerr
writeseq lSRVRS<i,4> to cfgfile else goto writeerr
writeseq lSRVRS<i,5> to cfgfile else goto writeerr
svpars = dcount(lSRVRS<i,6>,@SVM)
for k=1 to svpars
writeseq lSRVRS<i,6,k> to cfgfile else goto writeerr
next k
mvpars = dcount(lSRVRS<i,7>,@SVM)
for k=1 to mvpars
writeseq lSRVRS<i,7,k> to cfgfile else goto writeerr
next k
next i
for i=1 to dcount(CDBMS,@FM)
writeseq "[":CDBMS<i,1>:"]" to cfgfile else goto writeerr
svpars = dcount(CDBMS<i,2>,@SVM)
for k=1 to svpars
writeseq CDBMS<i,2,k> to cfgfile else goto writeerr
next k
mvpars = dcount(CDBMS<i,3>,@SVM)
for k=1 to mvpars
writeseq CDBMS<i,3,k> to cfgfile else goto writeerr
next k
next i
weofseq cfgfile
closeseq cfgfile
SRVRS = lSRVRS
CALL *HELP.BOX.B(5,5,50,UVREADMSG(073816,""))
goto end.wr.server
writeerr:
m1=UVREADMSG(073818,"")
retry=0
CALL *ERROR.BOX.B(5,9,0,UVREADMSG(073070,config2),retry,m1)
IF retry#0 THEN STOP @(-1)
GOTO rewrite
end.wr.server:
RETURN
******************************************************************************
* Init.vars -
* Routine which initializes various global variables
******************************************************************************
init.vars:
form.line = 2
temp.form = NULL
server.name=NULL
server.param=NULL
modified=0
RETURN
******************************************************************************
* Prlstsrv -
* Routine which prints the list of servers
******************************************************************************
prlstsrv:
heading=""
heading=UVREADMSG(073813,"")
IF lSRVRS=""
THEN srvn=0
ELSE srvn = dcount(lSRVRS, @FM)
print.array=""
print.count=srvn
FOR i = 1 TO srvn
print.array<i> = lSRVRS<i,1>
NEXT i
IF srvn = 0 THEN
print.array<1>=UVREADMSG(073812,"")
print.count=1
END
sel.val=1
CALL *LIST.BOX.B(heading,4,10,print.array,print.count,1,sel.val,0)
IF sel.val=-1 THEN RETURN
IF srvn=0 THEN sel.val=-1
else sel.val=print.array<sel.val>
RETURN
******************************************************************************
* Prlstprms -
* Routine which prints the list of parameters
******************************************************************************
prlstprms:
heading=""
heading=UVREADMSG(073830,"")
print.array = PARMS
print.count = dcount(PARMS, @FM)
IF print.count = 0 THEN
print.array<1>=UVREADMSG(73832,"")
print.count=1
END
sel.val=1
CALL *LIST.BOX.B(heading,4,10,print.array,print.count,1,sel.val,0)
IF sel.val=-1 THEN RETURN
sel.val=print.array<sel.val>
RETURN
******************************************************************************
* Prcurprms -
* Routine which prints the list of currently set parameters
******************************************************************************
prcurprms:
heading=""
heading=UVREADMSG(073831,"")
* Go through List 6 and pick out the relevant parameters for this server
srvploc = 0
if SRVPARS[1, len(server.name)+1] = server.name:@VM then srvploc = 1
else
loc = index(SRVPARS, @FM:server.name:@VM, 1)
if loc then srvploc = dcount(SRVPARS[1,loc], @FM)
end
print.array = ""
IF srvploc = 0 THEN
print.array<1,1>=UVREADMSG(73835,server.name)
print.count=1
END
ELSE
GOSUB combine.lists
svc = dcount(lSRVPARS<srvploc,2>, @SVM)
mvc = dcount(lSRVPARS<srvploc,4>, @SVM)
print.count = svc + mvc
FOR i = 1 TO svc
print.array<i,1> = lSRVPARS<srvploc,2,i>
IF lSRVPARS<srvploc,6,i>="1"
THEN print.array<i,2>="User"
ELSE print.array<i,2>=""
NEXT i
FOR i = 1 TO mvc
print.array<svc+i,1> = lSRVPARS<srvploc,4,i>
IF lSRVPARS<srvploc,5,i>="1"
THEN print.array<svc+i,2>="User"
ELSE print.array<svc+i,2>=""
NEXT i
END
IF print.count = 0 THEN
print.array<1,1>=UVREADMSG(73832,"")
print.count=1
END
sel.val=1
CALL *LIST.BOX.B(heading,4,10,print.array,print.count,2,sel.val,0)
IF srvploc=0 OR svc+mvc=0 THEN sel.val=-1
IF sel.val=-1 THEN RETURN
sel.val=print.array<sel.val,1>
RETURN
******************************************************************************
* locatesrvr -
* Routine which finds the location of locname in the list of servers lSRVRS
******************************************************************************
locatesrvr:
srvrloc = 0
if lSRVRS[1, len(locname)+1] = locname:@VM then srvrloc = 1
else
loc = index(lSRVRS, @FM:locname:@VM, 1)
if loc then srvrloc = dcount(lSRVRS[1,loc], @FM)
end
RETURN
******************************************************************************
* create.lists -
* Routine which creates the lists required for this menu.
******************************************************************************
create.lists:
SRVPARS = ""
TMPL = ""
* Move Generic parameters to TMPL
for i=1 to dcount(GNRC,@FM)
for j=1 to dcount(GNRC,@VM)
for k=1 to dcount(GNRC,@SVM)
if index(GNRC<i,j,k>, ' = ', 2) then
locate GNRC<i,j,k> in TMPL<1,4,1> by "AL" setting loc else
TMPL = insert(TMPL,1,4,loc,GNRC<i,j,k>)
end
end
else
param = field(GNRC<i,j,k>, ' ', 1)
locate param in TMPL<1,3,1> by "AL" setting loc else
TMPL = insert(TMPL,1,2,loc,GNRC<i,j,k>)
TMPL = insert(TMPL,1,3,loc,param)
end
end
next k
next j
next i
for srv=1 to dcount(lSRVRS,@FM)
* For each server copy TMPL to SRVPARS
SRVPARS<srv,1> = lSRVRS<srv,1>
SRVPARS<srv,2> = TMPL<1,2>
SRVPARS<srv,3> = TMPL<1,3>
SRVPARS<srv,4> = TMPL<1,4>
* Copy IDBMS parameters into SRVPARS
dbmsname = trim(field(lSRVRS<srv,2>, "=", 2))
gosub locatedbms
if NOT(dbmsloc=0) then
for k=1 to dcount(IDBMS<dbmsloc,2>,@SVM)
param = field(IDBMS<dbmsloc,2,k>, ' ', 1)
locate param in SRVPARS<srv,3,1> by "AL" setting loc
then SRVPARS<srv,2,loc> = IDBMS<dbmsloc,2,k>
else
SRVPARS = insert(SRVPARS,srv,2,loc,IDBMS<dbmsloc,2,k>)
SRVPARS = insert(SRVPARS,srv,3,loc,param)
end
next k
for k=1 to dcount(IDBMS<dbmsloc,3>,@SVM)
locate IDBMS<dbmsloc,3,k> in SRVPARS<srv,4,1> by "AL" setting loc else
SRVPARS = insert(SRVPARS,srv,4,loc,IDBMS<dbmsloc,3,k>)
end
next k
end
* Copy CDBMS parameters into SRVPARS
gosub loccdbms
if NOT(dbmsloc=0) then
for k=1 to dcount(CDBMS<dbmsloc,2>,@SVM)
param = field(CDBMS<dbmsloc,2,k>, ' ', 1)
locate param in SRVPARS<srv,3,1> by "AL" setting loc
then SRVPARS<srv,2,loc> = CDBMS<dbmsloc,2,k>
else
SRVPARS = insert(SRVPARS,srv,2,loc,CDBMS<dbmsloc,2,k>)
SRVPARS = insert(SRVPARS,srv,3,loc,param)
end
next k
for j=1 to dcount(CDBMS<dbmsloc,3>,@SVM)
param = field(CDBMS<dbmsloc,3,j>, '=', 1)
pval = field(CDBMS<dbmsloc,3,j>, '=', 3)
curparam=""
curpval=""
nummvpars = dcount(SRVPARS<srv,4>,@SVM)
for k=1 to nummvpars
curpval = field(SRVPARS<srv,4,k>, '=', 3)
if NOT(pval=curpval) then continue
curparam = field(SRVPARS<srv,4,k>, '=', 1)
if NOT(param=curparam) then continue
loc = k
k = nummvpars
next k
if param=curparam AND pval=curpval
then SRVPARS<srv,4,loc> = CDBMS<dbmsloc,3,j>
else
locate CDBMS<dbmsloc,3,j> in SRVPARS<srv,4,1> by "AL" setting loc else
SRVPARS = insert(SRVPARS,srv,4,loc,CDBMS<dbmsloc,3,j>)
end
end
next j
end
* Make Field 8 of lSRVRS to be the list of user configured SV parameter names
for k=1 to dcount(lSRVRS<srv,6>,@SVM)
param = field(lSRVRS<srv,6,k>, ' ', 1)
locate param in lSRVRS<srv,8,1> by "AL" setting loc
else lSRVRS = insert(lSRVRS,srv,8,loc,param)
next k
next srv
SRVRS=lSRVRS
TMPL = ""
RETURN
******************************************************************************
* combine.lists -
* Routine which combines the SRVPARS and lSRVRS lists into lSRVPARS.
******************************************************************************
combine.lists:
* Copy SRVRS parameters into lSRVPARS
lSRVPARS = SRVPARS
for k=1 to dcount(lSRVRS<srvploc,6>,@SVM)
param = field(lSRVRS<srvploc,6,k>, ' ', 1)
locate param in lSRVPARS<srvploc,3,1> by "AL" setting loc
then
lSRVPARS<srvploc,2,loc> = lSRVRS<srvploc,6,k>
lSRVPARS<srvploc,6,loc> = "1"
end
else
lSRVPARS = insert(lSRVPARS,srvploc,2,loc,lSRVRS<srvploc,6,k>)
lSRVPARS = insert(lSRVPARS,srvploc,3,loc,param)
lSRVPARS = insert(lSRVPARS,srvploc,6,loc,"1")
end
next k
for j=1 to dcount(lSRVRS<srvploc,7>,@SVM)
param = field(lSRVRS<srvploc,7,j>, '=', 1)
pval = field(lSRVRS<srvploc,7,j>, '=', 3)
curparam=""
curpval=""
nummvpars = dcount(lSRVPARS<srvploc,4>,@SVM)
for k=1 to nummvpars
curpval = field(lSRVPARS<srvploc,4,k>, '=', 3)
if NOT(pval=curpval) then continue
curparam = field(lSRVPARS<srvploc,4,k>, '=', 1)
if NOT(param=curparam) then continue
loc = k
k = nummvpars
next k
if param=curparam AND pval=curpval then
lSRVPARS<srvploc,4,loc> = lSRVRS<srvploc,7,j>
lSRVPARS<srvploc,5,loc> = "1"
end
else
locate lSRVRS<srvploc,7,j> in lSRVPARS<srvploc,4,1> by "AL" setting loc else
lSRVPARS = insert(lSRVPARS,srvploc,4,loc,lSRVRS<srvploc,7,j>)
lSRVPARS = insert(lSRVPARS,srvploc,5,loc,"1")
end
end
next j
RETURN
******************************************************************************
* locatedbms -
* Routine which finds the location of dbmsname in the list IDBMS
******************************************************************************
locatedbms:
dbmsloc = 0
if IDBMS[1, len(dbmsname)+1] = dbmsname:@VM then dbmsloc = 1
else
loc = index(IDBMS, @FM:dbmsname:@VM, 1)
if loc then dbmsloc = dcount(IDBMS[1,loc], @FM)
end
RETURN
******************************************************************************
* loccdbms -
* Routine which finds the location of dbmsname in the list CDBMS
******************************************************************************
loccdbms:
dbmsloc = 0
if CDBMS[1, len(dbmsname)+1] = dbmsname:@VM then dbmsloc = 1
else
loc = index(CDBMS, @FM:dbmsname:@VM, 1)
if loc then dbmsloc = dcount(CDBMS[1,loc], @FM)
end
RETURN
******************************************************************************
* amparam -
* Routine which adds or modifies the chosen parameter
******************************************************************************
amparam:
modified=0
if index(server.param, ' = ', 2) then
param = field(server.param, '=', 1)
pval = field(server.param, '=', 3)
curparam=""
curpval=""
nummvpars = dcount(lSRVRS<srvrloc,7>,@SVM)
for k=1 to nummvpars
curpval = field(lSRVRS<srvrloc,7,k>, '=', 3)
if NOT(pval=curpval) then continue
curparam = field(lSRVRS<srvrloc,7,k>, '=', 1)
if NOT(param=curparam) then continue
loc = k
k = nummvpars
next k
if param=curparam AND pval=curpval then
lSRVRS<srvrloc,7,loc> = server.param
end
else lSRVRS = insert(lSRVRS,srvrloc,7,nummvpars,server.param)
end
else
param = field(server.param, ' ', 1)
locate param in lSRVRS<srvrloc,8,1> by "AL" setting loc
then lSRVRS<srvrloc,6,loc> = server.param
else
lSRVRS = insert(lSRVRS,srvrloc,6,loc,server.param)
lSRVRS = insert(lSRVRS,srvrloc,8,loc,param)
end
end
IF temp.form<1>="Add"
THEN CALL *HELP.PRINT.B(UVREADMSG(073838,server.param),2)
ELSE CALL *HELP.PRINT.B(UVREADMSG(073839,server.param),2)
RETURN
******************************************************************************
* delparam -
* Routine which deletes the chosen parameter
******************************************************************************
delparam:
if index(server.param, ' = ', 2) then
for k=1 to dcount(lSRVRS<srvrloc,7>,@SVM) until server.param = lSRVRS<srvrloc,7,k>
next k
if server.param = lSRVRS<srvrloc,7,k> then
lSRVRS = delete(lSRVRS,srvrloc,7,k)
temp.form<3>=NULL
CALL *HELP.PRINT.B(UVREADMSG(073825,server.name),2)
end
else CALL *HELP.BOX.B(17,5,50,UVREADMSG(073836,""))
end
else
locate server.param in lSRVRS<srvrloc,6,1> by "AL" setting loc then
lSRVRS = delete(lSRVRS,srvrloc,6,loc)
lSRVRS = delete(lSRVRS,srvrloc,8,loc)
temp.form<3>=NULL
CALL *HELP.PRINT.B(UVREADMSG(073825,server.name),2)
end
else CALL *HELP.BOX.B(17,5,50,UVREADMSG(073836,""))
end
RETURN
******************************************************************************
* procdel -
* Routine which processes the delete option.
******************************************************************************
procdel:
flag=FALSE
CALL *HELP.PRINT.B(NULL,3)
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
form.line=3
IF server.param=NULL THEN
GOSUB prcurprms
IF sel.val=-1 THEN temp=NULL
ELSE
temp=sel.val
temp.form<form.line>=temp
server.param=temp
END
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
END
IF server.param = NULL THEN RETURN
CALL *YES.NO.BOX.B(17,UVREADMSG(073837,server.param),flag)
IF flag=TRUE THEN GOSUB delparam
ELSE CALL *HELP.PRINT.B(UVREADMSG(073826,server.name),2)
RETURN
******************************************************************************
* procmodify -
* Routine which processes the modify option.
******************************************************************************
procmodify:
form.line=3
IF server.param=NULL THEN
GOSUB prcurprms
IF sel.val=-1 THEN temp=NULL
ELSE
temp=sel.val
temp.form<form.line>=temp
server.param=temp
END
modified=1
END
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
RETURN
STOP @(-1)
END