539 lines
16 KiB
Plaintext
Executable File
539 lines
16 KiB
Plaintext
Executable File
******************************************************************************
|
|
*
|
|
* 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
|