tldm-universe/Ardent/UV/APP.PROGS/CONVERT.BP.B

539 lines
16 KiB
Plaintext
Raw Normal View History

2024-09-09 21:51:08 +00:00
******************************************************************************
*
* CONVERT.BP.B - Convert basic source to utilize OPEN$UV$FILE,
* CLOSE$UV$FILE, and RELEASE$UV$FILE
*
* 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/12/92 10327 WLC Initial Release.
*******************************************************************************
*
* Replace all OPEN's with CALL *OPEN$UV$FILE
* Replace all CLOSE's with CALL *CLOSE$UV$FILE
* If there aren't GOSUB statements and OPEN statements exist,
* replace RETURNs with CALL *RELEASE$UV$FILE; RETURN.
*
* This program will examine source code in a file and
* change all:
*
* OPEN {dict,} filename {TO filevar} {THEN/ELSE}
*
* that are on SEPARATE lines, to:
*
* CALL *OPEN$UV$FILE(dict,filename,filevar,var.stamp)
*
* var.stamp is a string which is generated using variable name and
* a unique number for each source module. This is used
* to locate the file variable when it comes time to close
* a file.
*
* To ensure the program logic, when a THEN or ELSE clause
* is found, one (or both) of the following may happen:
*
* A THEN clause ONLY: a newly inserted line will be
* added after the call to emulate the
* logic of this clause, thus
*
* IF @user.return.code THEN
*
* An ELSE clause ONLY: a newly inserted line will be
* added after the call to emulate the
* logic of this clause, thus
*
* IF NOT(@user.return.code) THEN
*
* Both clauses: since the THEN clause must preceed the
* ELSE clause, only the THEN 'IF' code must
* be inserted. (see above)
*
*
* The internal variable @user.return.code is set within the
* called subroutine and is returned with one of the following
* values:
*
* 0 - File could not be opened
* 1 - File was opened successfully
* 2 - File was previously opened
*
* If there is no DICT keyword specified, either null ("", '')
* or non-existant, then a null ("") will be placed in the
* parameter string.
*
* Furthermore, there may be the string DATA where one
* would normally expect to find the string DICT. If DATA is
* found, this will get filtered by the subroutine.
*
* If there is no FILENAME keyword specified, an ERROR message
* will be displayed and the source code exited.
*
* If there is no FILEVAR, it is assumed that the desired option
* is to open to the default file variable. For this, the
* UniVerse internal 'at' variable @STDFIL will be substituted
* as the FILEVAR in the parameter list.
*
*
$OPTIONS PICK
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
*
* Set EQUATES
*
equ TRUE to 1
equ FALSE to 0
*
* Define Upcase VARIABLES
*
ACTIVE.LIST=""
COMMAND.LINE=""
SOURCE.FILE=""
THIS.PROGRAM=""
*
* Define Downcase VARIABLES
*
a.N.line=""
a.S.line=""
disable.auto.paging=@(0,0)
eol=FALSE
items.selected=0
look.for.a.clause=FALSE
S.mark=0
prompt ""
N.record="" ;* new record being built and eventually written
S.record="" ;* source record from file
record.attempts=FALSE
change.count=0
save.S.line=""
write.this.record=FALSE
use.else=FALSE ; use.then=FALSE
*
* Get & Parse command line
*
COMMAND.LINE=@sentence
convert " " to @fm in COMMAND.LINE
if COMMAND.LINE<1> = "RUN" then
del COMMAND.LINE<1> ;* get rid of 'RUN'
del COMMAND.LINE<1> ;* get rid of 'FILE'
end
THIS.PROGRAM=COMMAND.LINE<1>
del COMMAND.LINE<1> ;* get rid of 'PROGRAM'
*
* Get Name of source code file to look at
*
if COMMAND.LINE<1> # "" then
SOURCE.FILE=COMMAND.LINE<1>
del COMMAND.LINE<1>
end else
crt 'Enter Filename: ':
input SOURCE.FILE
end
*
* Attempt open of file to default file
*
open SOURCE.FILE else
crt "Unable to open file '":SOURCE.FILE:"'. Program '":THIS.PROGRAM:"' halted."
abort
end
*
* Select the file or get active list
*
GET.RECORDS:
if COMMAND.LINE<1>="*" or COMMAND.LINE<1>="ALL" then
echo off
execute "SSELECT ":SOURCE.FILE rtnlist ACTIVE.LIST
items.selected=@selected
echo on
end else
if not(system(11)) or record.attempts=TRUE then
items.selected=dcount(COMMAND.LINE,@fm)
select COMMAND.LINE to ACTIVE.LIST
end else
items.selected=@selected
selecte to ACTIVE.LIST
end
end
*
* Check to see if anything was selected
*
if not(items.selected) then
if not(record.attempts) then
record.attempts=TRUE
record.id=""; COMMAND.LINE=""
loop
crt "Record: ":
input record.id
until record.id="" do
COMMAND.LINE<-1>=record.id
repeat
goto GET.RECORDS:
end else
crt "Unable to retrieve any record keys. Program '":THIS.PROGRAM:"' halted."
abort
end
end
*
* Display number selected
*
crt
crt "'":items.selected:"' selected for processing."
crt
*
* Read one item off of list at a time
*
loop
readnext record.id from ACTIVE.LIST else eol=TRUE
until eol=TRUE do ;* beginning of major loop
write.this.record=FALSE ;* reset WRITE flag
opens.exist=FALSE
change.count=0
gosubs.found=FALSE
*
* Read and lock record
*
readu S.record from record.id then
N.record="" ;* NULL out new record
GOSUB FIND.UNIQUE.ID
GOSUB FIND.GOSUBS
*
* Look at each line for OPEN/CLOSE/RETURN statements
*
loop ;* beginning of loop A
a.S.line=remove(S.record,S.mark)
until a.S.line="" and S.mark=0 do
*
* Find first non-blank in line.
*
orig.line=a.S.line
blanks = 0
blank=1
loop
while (blanks = 0 and blank < LEN(a.S.line))
if a.S.line[blank,1] # " " and a.S.line[blank,1] # char(9) then
blanks = blank-1
end
blank += 1
repeat
if blanks = 0 then whitespace="" else whitespace=orig.line
a.S.line=trimf(a.S.line)
open.ix=index(upcase(a.S.line), "OPEN", 1)
close.ix=index(upcase(a.S.line), "CLOSE", 1)
return.ix=index(upcase(a.S.line), "RETURN", 1)
begin case
case open.ix # 0
if open.ix > 1 and a.S.line[open.ix-1,1] # " " then
string=""
end else string=upcase(a.S.line[open.ix,5])
case close.ix # 0
if close.ix > 1 and a.S.line[close.ix-1,1] # " " then
string=""
end else string=upcase(a.S.line[close.ix,6])
case return.ix # 0
if return.ix > 1 and a.S.line[return.ix-1,1] # " " then
string=""
end else string=upcase(a.S.line[return.ix,7])
case 1
string=""
end case
begin case
case string="OPEN " or string="OPEN'" or string='OPEN"'
gosub PARSE.OPEN
if not(look.for.a.clause) then
N.record<-1>= a.N.line
end
case look.for.a.clause = TRUE and a.S.line#""
if upcase(a.S.line) MATCHES "'ELSE'0X" then
a.N.line:="*":a.S.line
a.N.line:=@fm:whitespace[1,blanks]:"IF NOT(@user.return.code) THEN ":a.S.line[5,999999]
N.record<-1>= a.N.line
change.count+=1
end else
if upcase(a.S.line) MATCHES "'THEN'0X" then
a.N.line:="*":a.S.line
a.N.line:=@fm:whitespace[1,blanks]:"IF @user.return.code ":a.S.line
N.record<-1>= a.N.line
change.count+=1
end else
N.record<-1>= whitespace[1,blanks]:save.S.line
N.record<-1>= whitespace[1,blanks]:a.S.line
end
end
look.for.a.clause=FALSE
case string[1,5]="CLOSE"
gosub PARSE.CLOSE
N.record<-1>=a.N.line
case string[1,6]="RETURN"
gosub PARSE.RETURN
N.record<-1>=a.N.line
case 1
N.record<-1>=orig.line ;* no match - just add to new record
end case
repeat ;* end of loop A
end else
crt "Unable to read record '":record.id:"'."
end
*
* Write out record if changes made
*
if write.this.record and opens.exist then
crt change.count:" changes made to ",record.id
write N.record on record.id
end
*
* If gosubs exist in source, we cannot replace RETURNs properly, warn them...
*
if gosubs.found and write.this.record and opens.exist then
crt
crt "************************************************************"
crt "Warning: program ":record.id:" from ":SOURCE.FILE:" contains"
crt " gosub statements. Therefore, the open tools"
crt " cannot determine which RETURN statments"
crt " to replace with:"
crt " 'CALL *RELEASE$UV$FILE(":'"':unique.id:'"':"); RETURN'"
crt " Please examine source and put the above statements"
crt " wherever the non-gosub RETURNs are. "
crt " This is only necessary if locks have been set and "
crt " need to be released at the end of this routine."
crt "************************************************************"
end
*
* Unlock the record
*
release record.id
*
* Go process next record.id
*
repeat ;* end of major loop
*
* This program is all done
*
STOP
*
* BEGINNING OF SUBROUTINE AREA
*
FIND.UNIQUE.ID:
curr.account=@who
record.key = curr.account:"*":SOURCE.FILE:"*":record.id
openpath UV.ROOT:"/OPEN.UNIQUE" to UNIQUE.FV else
crt "*** Error opening the OPEN.UNIQUE file in ":UV.ROOT
crt "*** Please RUN APP.PROGS OPEN.INIT.B as root "
crt "*** from the ":UV.ROOT:" account and try again."
stop
end
read curr.entry from UNIQUE.FV,record.key then
unique.id = curr.entry
return
end
tries = 0
try.again:
readu unique.id from UNIQUE.FV,"NEXT.VALUE" locked
tries += 1
if tries > 20 then
crt "*** The NEXT.VALUE record in the OPEN.UNIQUE file in "
crt "*** the ":UV.ROOT:" account is currently locked by "
crt "*** another user. Please try again later."
stop
end
sleep 10
goto try.again
end else
crt "*** Error reading NEXT.VALUE from OPEN.UNIQUE file in "
crt "*** ":UV.ROOT:". Please RUN APP.PROGS OPEN.INIT.B as root "
crt "*** from the ":UV.ROOT:" account and try again."
end
write unique.id+1 on UNIQUE.FV,"NEXT.VALUE"
write unique.id on UNIQUE.FV,record.key
return
FIND.GOSUBS:
temp.mark=0
T.record=S.record
loop
a.T.line=remove(T.record,temp.mark)
until a.T.line="" and temp.mark=0 do
a.T.line=upcase(trimf(a.T.line))
gosub.ix = INDEX(a.T.line,"GOSUB ",1)
pc = a.T.line[gosub.ix-1,1]
if gosub.ix and a.T.line[1,1] # "*" and (pc = " " or pc = char(9)) then
gosubs.found=TRUE
end
repeat
return
PARSE.OPEN:
use.then=FALSE ; use.else=FALSE
DICT.VALUE=""; DATA.VALUE=""; FILE.VALUE=""
*
* Assign TEMP variable
*
TEMP.LINE=convert(" ",@fm,trim(a.S.line))
*
* Put space between OPEN & DICT/DATA name
*
if TEMP.LINE<1>[5,1]="'" or TEMP.LINE<1>[5,1]='"' then
Lhalf=TEMP.LINE<1>[1,4]
Rhalf=TEMP.LINE<1>[5,999999]
TEMP.LINE<1>=Lhalf:@fm:Rhalf
end
*
* Check to see if there aren't any spaces between comma
*
* if index(TEMP.LINE<2>,',',1) then
* TEMP.LINE<2>=field(TEMP.LINE<2>,",",1,1):",":@fm:field(TEMP.LINE<2>,",",2,9999)
* end
*
* Setup
*
a.N.line=whitespace[1,blanks]
a.N.line:="CALL *OPEN$UV$FILE(" ;* start making call
word.cnt=dcount(TEMP.LINE,@fm)
if upcase(TEMP.LINE<1>)="OPEN" then
*
* Look for dict
*
findstr "," in TEMP.LINE,1 setting FMC then
DICT.VALUE=field(TEMP.LINE<FMC>,",",1)
DATA.VALUE=field(TEMP.LINE<FMC>,",",2)
end else
DICT.VALUE='""' ;* no dict specified
FMC=1
end
*
* Update
*
a.N.line:=DICT.VALUE:","
*
* Get filename (var)
*
if DATA.VALUE="" then
FMC+=1
DATA.VALUE=TEMP.LINE<FMC>
end
*
* Update
*
a.N.line:=DATA.VALUE:","
*
* See if there is a 'TO' keyword
*
FMC+=1
if upcase(TEMP.LINE<FMC>) = 'TO' then
FMC+=1
FILE.VALUE=TEMP.LINE<FMC>
end else
*
* There is no file variable, so use default
*
FILE.VALUE='@STDFIL'
FMC-=1
end
*
* Update
*
a.N.line:=FILE.VALUE:',"':FILE.VALUE:"_":unique.id:'")'
*
* Now look for THEN or ELSE.
*
FMC+=1
if upcase(TEMP.LINE<FMC>)='THEN' then use.then=TRUE
if upcase(TEMP.LINE<FMC>)='ELSE' then use.else=TRUE ; FMC+=1
line.remainder=""
for a=FMC to word.cnt
line.remainder:=TEMP.LINE<a>:" "
next a
*
* Assemble new
*
a.N.line="* ":a.S.line:@fm:a.N.line:@fm
if use.then then
a.N.line:=whitespace[1,blanks]:"IF @user.return.code ":line.remainder
write.this.record=TRUE
opens.exist=TRUE
change.count+=1
end
if use.else then
a.N.line:=whitespace[1,blanks]:"IF NOT(@user.return.code) THEN ":line.remainder
write.this.record=TRUE
opens.exist=TRUE
change.count+=1
end
if not(use.else) and not(use.then) then
look.for.a.clause=TRUE
save.S.line=a.S.line
end
end else
* oops! no change - bad line
a.N.line=orig.line
end
EXIT.PARSE.OPEN:
return
PARSE.CLOSE:
DICT.VALUE=""; DATA.VALUE=""; FILE.VALUE=""
*
TEMP.LINE=convert(" ",@fm,trim(a.S.line))
*
* Make sure the CLOSE was not part of variable or label name
nc = string[6,1]
if (nc # '' and nc # ";" and nc # " " and nc # char(9)) or (trim(a.S.line)[1,1] = "*") then
a.N.line=whitespace[1,blanks]
a.N.line:=a.S.line
return
end
locate "CLOSE" in TEMP.LINE setting loc else loc=0
FILE.VALUE=TEMP.LINE<loc+1>
if FILE.VALUE="" or FILE.VALUE=";" then FILE.VALUE='@STDFIL'; fv.len=0
else fv.len=len(FILE.VALUE)
a.N.line=whitespace[1,blanks]
a.N.line:=a.S.line[1,close.ix-1]:"CALL *CLOSE$UV$FILE("
a.N.line:=FILE.VALUE:',"':FILE.VALUE:"_":unique.id:'")'
next.item=close.ix+6+fv.len
a.N.line:=a.S.line[next.item,99]
a.N.line="* ":a.S.line:@fm:a.N.line:@fm
write.this.record=TRUE
change.count+=1
return
PARSE.RETURN:
* Make sure RETURN is not part of variable, label, comment or gosubs exist
nc = string[7,1]
if (nc # '' and nc # ";" and nc # " " and nc # char(9)) or gosubs.found or trim(a.S.line)[1,1] = "*" then
a.N.line=orig.line
return
end
a.N.line=whitespace[1,blanks]
a.N.line:=a.S.line[1,return.ix-1]
a.N.line:='CALL *RELEASE$UV$FILE("':unique.id:'"); RETURN'
a.N.line:=a.S.line[return.ix+6,99]
a.N.line="* ":a.S.line:@fm:a.N.line:@fm
write.this.record=TRUE
change.count+=1
return
*
* End of code
*
END