phares3757/open-insight
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added LSL2 stored procedures

Browse Source
This commit is contained in:
Infineon\StieberD
2024-03-25 14:46:21 -07:00
parent 09f1a66046
commit c667dd56eb
1655 changed files with 527967 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

933
LSL2/STPROC/TAPPBACKUP_SUB.txt Normal file
View File

@ -0,0 +1,933 @@
subroutine tappbackup_sub(dummy)
* Changes and modification
* ??/??/?? ??? Original programmer.
* 01/30/96 DMG Change to add Notes sources, Datasets and Reporistory Reports.
* 02/22/96 CS Fixed the table copy process to remove relational indexes
* Inserts.
$insert DB_MGMT_EQUATES
$insert fserrors_hdr
$insert fserrors_100
$insert fserrors_400
$insert msg_equates
$insert repository_equates
$insert sysrepos_col_equates
$insert systable_names
* Equates.
EQU FALSE$ TO 0
EQU TRUE$ TO 1
EQU NULL$ TO ''
EQU CRLF$ TO \0D0A\
EQU APPNAME$ TO "Application Backup"
EQU WINID$ TO "APPBACKUP"
EQU OPBACKUP$ TO "Backup"
EQU OPRESTORE$ TO "Restore"
EQU BACKUP$ TO "_BACKUP"
EQU TYPEIDS$ TO "APPNOTE,APPROW,DATASOURCE,DBCOMPONENT,DBCOMPONENTEXE,DBCOLUMN,DBTABLE,DLL,DOC,IMAGE,MSG,OIEVENT,OIEVENTDBG,OIEVENTEXE,OIREPORT,OIWIN,OIWINEXE,OSFILE,POPUP,STPROC,STPROCDBG,STPROCEXE,STPROCINS,WINEXE"
EQU TARGETS$ TO "LH,,LH,LH,LH,COLUMN,TABLE,OS,OS,OS,LH,LH,LH,LH,LH,LH,LH,OS,LH,LH,LH,LH,LH,OS"
* 1/18/96 - DMG - Added in the new datatypes.
* DMG 1/18/96 - the concation operator within this string is to get around that a string can only have 255 chars
EQU DESTLIST$ TO "SYSREPOSAPPNOTES,,SYSREPOSDATASOURCES,SYSREPOSDBCOMPONENTS,SYSREPOSDBCOMPONENTEXES,,,DLL,DOC,IMAGE,SYSREPOSMESSAGES,SYSREPOSEVENTS,SYSREPOSEVENTEXES,SYSREPOSEVENTEXES,SYSREPOSREPORTS,SYSREPOSWINS,SYSREPOSWINEXES,OSFILE,SYSREPOSPOPUPS,SYSPROCS,SYSOBJ,":"SYSOBJ,SYSPROCS,WINEXE"
EQU SETSTAT_OK$ TO 0
EQU SETSTAT_ERR$ TO 1
EQU SETSTAT_APPEND$ TO -1
EQU V119_DELETE$ TO 'D'
EQU V119_EXTRACT$ TO 'E'
EQU V119_INIT$ TO 'I'
EQU V119_MERGE$ TO 'M'
EQU V119_SORT$ TO 'S'
EQU V119_VALUES$ TO 'V'
EQU V119_WRITE$ TO 'W'
EQU MAX_LEN$ TO 32000 ;* Threshold for creating temporary file.
EQU MAX_SEND_SIZE$ TO 32000 ;* Target size for sending data back.
EQU EXTRACT_SIZE$ TO 32000 ;* Size of blocks that v119 sends back.
* Subroutine / function declarations.
declare subroutine repos_checkformat, attach_table, mkdir, create_table, v119
declare subroutine create_table, copy_table, detach_volume, update_index
declare subroutine define_database, initrnd, set_property, set_fserror
declare subroutine utility, msg, set_status, send_event, get_status
declare function msg, get_property, repository, getappid
declare function get_repos_entities, resolve_path, msg
* PROGRAM TOP *
utility( "CURSOR", 'H') ;* Put up hourglass.
* Initialization...
winId = WINID$
msgRow = ''
tableList = ''
errorSummary = "Code - Detail" : @FM
bErrors = FALSE$
bProcessErr = FALSE$
bCopyHdr = FALSE$
bLongList = FALSE$
errStat = FALSE$
SSPLIST = ''
@file.error = ''
bMerged = FALSE$ ;* The sort file only needs to merged once.
* Create a temporary sortfile name (8 characters in length).
if len( @STATION) then
sortfile = @STATION[ -8, 8]
end else
initrnd timedate()
sortfile = rnd( 90000000) + 10000000
end
sortfile := ".SFX"
* Extract the parameters.
controls = winId:".OPERATION_OPT" : @RM : winId:".LOCATION_EDIT"
controls := @RM : winId:".COPYDATA_CHK"
properties = "VALUE" : @RM : "TEXT" : @RM : "CHECK"
retval = get_property( controls, properties)
operation = field( retval, @RM, 1, 1)
location = field( retval, @RM, 2, 1)
bCopyData = field( retval, @RM, 3, 1)
if location else
msgRow<MTEXT$> = "A location is required!"
msgRow<MTYPE$> = "BOk"
msgRow<MCAPTION$> = APPNAME$
msgRow<MICON$> = '!'
msg( winId, msgRow)
return
end
if location[ -1, 1] = '\' then
location[ -1, 1] = ''
end
appid = getappid()<1>
/* Copy Table now removes relational indexes so there is no need to stop
unless the users wants to CS*/
if operation = OPBACKUP$ then
gosub analyze
if errorList then
convert @FM to CRLF$ in errorList
msgRow = "Relational Indexes will not be copied from the following tables:"
msgRow := CRLF$ : CRLF$ : errorList : CRLF$
msgRow := "Press Ok to continue"
msgRow< MICON$ > = '!'
msgRow< MTYPE$ > = "BOC"
response = msg( WINID$, msgRow)
If response = Char(27) Then return ; *Check to see if the user wants to abort
end
end
* Validate the location. If no backup files exist, create them.
tempSysRepos = SYSREPOS_FILE$ : BACKUP$
attach_table( location, tempSysRepos, GLOBAL$, '', status)
if get_status(errcode) then
* Table doesn't exist. Create it.
if errcode<1,1> = "FS":FS_INVALID_MAP_QUALIFIER$ then
set_status( SETSTAT_OK$, TRUE$)
end
begin case
case operation = OPBACKUP$
* Prompt for creation of backup location.
msgRow<MTEXT$> = "Backup files do not exist on ": location: ".": CRLF$: "Create?"
msgRow<MTYPE$> = "BNYC"
msgRow<MICON$> = '?'
msgRow<MCAPTION$> = APPNAME$
bCreate = msg( WINID$, msgRow)
if bCreate = 1 else return ;* Chose No or Cancel.
* Make sure the directory exists.
mkdir( location:char(0), status)
* Create the sysrepos-backup table.
create_table( location, tempSysRepos, 0, GLOBAL$, '', '')
if get_status() then
return
end
utility( "CURSOR", 'H')
case operation = OPRESTORE$
* No backup data here!
msgRow<MTEXT$> = "There is no data on " : location
msgRow<MTYPE$> = "BOk"
msgRow<MICON$> = '!'
msgRow<MCAPTION$> = APPNAME$ : "- Error"
msg( WINID$, msgRow)
return
case 1
end case
end else
if operation = OPBACKUP$ then
* If backing up, prompt for overwriting.
msgRow = "Backup files already exist on ": location: "."
msgRow := " If this application has been backed up at this"
msgRow := " location previously, the existing data will be lost."
msgRow := CRLF$: "Continue?"
msgRow< MTYPE$> = "BNYC"
msgRow< MDEFBTN$> = 2
msgRow< MICON$> = '!'
bOverwrite = msg( WINID$, msgRow)
if bOverwrite = 1 else return
gosub clearData
end
end
* Open required tables.
if operation = OPBACKUP$ then
sysreposSrc = SYSREPOS_FILE$
sysreposDst = SYSREPOS_FILE$:BACKUP$
end else
sysreposSrc = SYSREPOS_FILE$:BACKUP$
sysreposDst = SYSREPOS_FILE$
end
open sysreposSrc to fhSysReposSrc else
set_fserror()
return
end
open sysreposDst to fhSysReposDst else
set_fserror()
return
end
open SYSTABLES_FILE$ to fhSysTables else
set_fserror()
return
end
moreInfo = TRUE$ ;* We can handle over 64k.
loop
* Get list of entities for this application.
set_property( winID:".STATUS_TEXT", "TEXT", "Selecting...")
if operation = OPBACKUP$ then
* Backup logic. Get list of entities, making multiple calls if
* there is over 64K worth of names.
* Arguments are APPID, TYPEID, CLASSID, ReturnFlags, ExpandNames, RemoteRepository, fMoreInfo (>64k).
entList = get_repos_entities( appid, '', '', FALSE$, TRUE$, FALSE$, moreInfo)
if len( moreInfo) then
* List is > 64K...we'll need to make multiple calls.
bLongList = TRUE$
end
end else
* Operation is "RESTORE" (OPRESTORE$).
if bLongList then
* 2nd - nth time through this loop. This occurs only if the
* list to restore is greater than 64K.
gosub ExtractSort
end else
* First time through...select SYSREPOS_BACKUP table and retrieve
* the list of entities.
select fhSysReposSrc ;* 1st time...create list of entities.
done = FALSE$
entList = ''
loop
readnext entid else done = TRUE$
until done
* Only restore objects from this application.
if entid[ 1, '*'] = appid then
entList := entid : @FM
if (len( entList) > MAX_LEN$) then
* List has reached threshold...use temp sort-file.
if bLongList else
* Need to create sort-file.
gosub InitSort
if errStat then
return
end
bLongList = TRUE$
end
* Sort and store what we have. Refresh list.
gosub DoSort
entList = ''
end
end
repeat
if bLongList else
* List is under threshold...no temp-file was necessary.
moreInfo = NULL$
end
if len( entList) then
* Sort & process current entity-list.
gosub DoSort
if entList[ -1, 1] = @FM then entList[ -1, 1] = ''
end
if bLongList then
* Merge lists and extract first block.
entList = ''
gosub MergeSort
gosub ExtractSort
end
end
end
if get_status() then return
* Count the number of entities we currently have.
numEntities = count( entList, @fm) + (entList # NULL$)
* Initialize the status & progress bars.
set_property( winID:".STATUS_TEXT", "TEXT", '')
gosub InitProgressBar
* Process entities...bail out if error flag is set in process loop.
bProcessErr = FALSE$
gosub ProcessEntities
if bProcessErr then goto Exit
* If there are more entities...get them!
while len( moreInfo)
repeat
if (operation = OPRESTORE$) and bLongList then
* Temporary sort-file was used...delete it.
gosub deleteSort
end
* Detach the backup location.
detach_volume( location, status)
* If DBTABLEs were restored...save the database definition.
if operation = OPRESTORE$ then
if tableList then
set_property( winID:".STATUS_TEXT", "TEXT", "Updating...")
define_database( @dbid, 1, '', 0)
end
end
* Clear status & progress controls.
controls = winID:".STATUS_TEXT" : @RM : winID:".PROGRESS_BAR"
controls := @RM : winID:".ENTITYID"
properties = "TEXT" : @RM : "SIZE" : @RM : "TEXT"
values = '' : @RM : minBar : @RM : ''
set_property( controls, properties, values)
* We're done!
msgRow = "The " : operation : " of " : appid : " is complete."
exit:
if bErrors then
errorsID = appid:"*ERRORS"
msgRow = "Error detail has been written"
msgRow := " to data row":CRLF$:"'":errorsID:"'":CRLF$:"in the 'SYSLISTS'"
msgRow := " table and can be viewed using the system editor."
end
msgRow< MICON$> = '!'
msgRow< MCAPTION$> = "Application Backup"
msg( WINID$, msgRow)
if bErrors then
open SYSLISTS_FILE$ to fhSysLists then
write errorSummary to fhSysLists, errorsID else
set_fserror()
end
end else
set_fserror()
end
end
send_event( WINID$, "CLOSE")
RETURN
/* ----------------------------------------------------------------------- */
analyze:
* Tables with relational indexing cannot be copied.
errorList = ''
if bCopyData then
set_property( winId:".STATUS_TEXT", "TEXT", "Analyzing...")
dbTables = get_repos_entities( appid, "DBTABLE", '')
numTables = count( dbTables, @FM) + ( dbTables ne '')
for tableCntr = 1 to numTables
dbName = field( dbTables< tableCntr>, KEYSEP$, 4, 1)
if dbName[ 1, 1] = '!' then
open dbName to fhBang then
read bangRow from fhBang, dbName then
indexPos = 4
loop
tempInfo = bangRow< 1, 1, indexPos>
while tempInfo
convert @TM:'*' to @FM:@VM in tempInfo
indexType = tempInfo<3>
if indexType = 3 or indexType = 5 then
errorList<-1> = dbName
end
indexPos += 1
repeat
end
end
end
next tableCntr
set_property( winId:".STATUS_TEXT", "TEXT", '')
end
return
/* ----------------------------------------------------------------------- */
clearData:
* Clear previous backup data.
set_property( winID:".STATUS_TEXT", "TEXT", "Clearing...")
sysreposDst = SYSREPOS_FILE$:BACKUP$
open sysreposDst to fhTemp then
select fhTemp
done = FALSE$
loop
readnext tempId else done = TRUE$
until done
tempAppid = field( tempId, KEYSEP$, APPID$, 1)
if tempAppid = appid then
delete fhTemp, tempId else NULL
end
repeat
end
set_property( winID:".STATUS_TEXT", "TEXT", '')
return
/* ----------------------------------------------------------------------- */
InitProgressBar:
* Initialize progress bar.
maxBar = get_property( winID:".PROGRESS_BACK", "SIZE")
maxWidth = maxBar<3>
minBar = fieldstore( maxBar, @fm, 3, 1, 0)
currBar = minBar
backColor = 255
controls = winID:".PROGRESS_BAR" : @RM : winID:".PROGRESS_BAR"
controls := @RM : winID:".ENTITY_LABEL"
properties = "SIZE" : @RM : "BACKCOLOR" : @RM : "ENABLED"
values = currBar : @RM : backColor : @RM : TRUE$
set_property( controls, properties, values)
return
/* ----------------------------------------------------------------------- */
ProcessEntities:
* Process the entities.
doneList = '' ;* Keep track of types already processed (for initialization).
currType = ''
for entCounter = 1 to numEntities
entid = entList< entCounter>
appid = field( entid, KEYSEP$, APPID$, 1)
typeid = field( entid, KEYSEP$, TYPEID$, 1)
classid = field( entid, KEYSEP$, CLASSID$, 1)
entityid = field( entid, KEYSEP$, ENTITYID$, 1)
locate typeid in TYPEIDS$ using ',' setting typePos then
backupType = field( TARGETS$, ',', typePos, 1)
bodySpec = field( DESTLIST$, ',', typePos, 1)
bCopyHdr = TRUE$
bCopyBody = TRUE$
set_property( winId:".ENTITYID", "TEXT", entid)
end else
backupType = ''
end
begin case
case backupType = "LH"
if operation = OPBACKUP$ then
sourceTable = bodySpec
destTable = bodySpec:BACKUP$
end else
sourceTable = bodySpec:BACKUP$
destTable = bodySpec
end
* Prepare the destination for the backup. This is done once for each type.
locate typeid in doneList using @fm setting donePos else
if operation = OPBACKUP$ then
create_table( location, destTable, 0, GLOBAL$, '', 0)
if get_status(errcode) then
if errcode<1,1> = 'FS':FS_FILE_ALREADY_EXISTS$ then
set_status( SETSTAT_OK$, TRUE$)
end else
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
end
attach_table( location, destTable, GLOBAL$, '',status)
if get_status() then
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
doneList<-1> = typeid
* Retrieve list of system procs.
open SYSENV_FILE$ to fhSysEnv then
read SSPList from fhSysEnv, "SYSPROCNAMES" else SSPList = ''
end else
SSPList = ''
end
end else
attach_table( location, sourceTable, GLOBAL$, '',status)
if get_status() then
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
end
end
* Open the table and transfer the body.
if currType = typeid else
open sourceTable to fhSrc else ;* Open source table.
set_fserror()
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
open destTable to fhDest else ;* Open Destination table.
set_fserror()
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
end
if typeid[ 1, 6] = "STPROC" then
* Don't backup system procedures.
if appid = "SYSPROG" and typeid = "STPROCEXE" then
locate entityid in SSPList using @FM setting nothing then
bCopyBody = FALSE$
bCopyHdr = FALSE$
end
end
begin case
case typeid = "STPROCDBG"
procid = '@':entityid
case typeid = "STPROCEXE"
procid = '$':entityid
case 1
procid = entityid
end case
bodyID = if appid = "SYSPROG" then procid else procid:KEYSEP$:appid
end else
bodyID = appid : KEYSEP$ : classid : KEYSEP$ : entityid
end
if bCopyBody then
read entBody from fhSrc, bodyID else entBody = ''
write entBody to fhDest, bodyID else
set_fserror()
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
end
case backupType = "OS"
if operation = OPBACKUP$ then
srcSpec = repository( "GETSUBKEY" , entid)
destDir = location : '\' : bodySpec
dosfile = srcSpec[ -1, "B\"]
dstSpec = destDir : '\' : dosfile
* Create the directory (done only once).
locate typeid in doneList using @fm setting nothing else
mkdir( destDir:char(0), status)
end
end else
read entHdr from fhSysReposSrc, entid then
dstSpec = entHdr< SYSREP_SUB_KEY$>
dosfile = dstSpec[ -1, "B\"]
destDir = dstSpec[ 1, (col1() - 1)]
srcSpec = location : '\' : bodySpec : '\' : dosfile
mkdir( destDir:char(0), status)
end else
@file.error< FSMSG$> = entid
set_fserror()
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
end
* Transfer the file.
osopen srcSpec to hSrc else
@file.error = FS_READ_FILE_DNE$
@file.error< FSMSG$> = srcSpec
set_fserror()
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
osopen dstSpec to hDst else
oswrite '' to dstSpec
osopen dstSpec to hDst else
@file.error = FS_READ_FILE_DNE$
@file.error< FSMSG$> = dstSpec
set_fserror()
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
end
offset = 0
loop
osbread osData from hSrc at offset length 16384
doserr = status()
while osData and not(doserr)
osbwrite osData to hDst at offset
doserr = status()
until doserr
offset += len( osData)
repeat
if doserr then
set_fserror()
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
osclose hSrc
osclose hDst
case backupType = "COLUMN"
if operation = OPBACKUP$ then
* Don't copy system-table headers.
if entityid[ 1, 3] = "SYS" or entityid[ 1, '.'] = "ACCESSIBLE_COLUMNS" then
bCopyHdr = FALSE$
end
* Post-beta 1 fix...don't copy DBCOLUMNs that are duped in SYSPROG.
if appid = "CARPARTS" then
sysprogEnt = "SYSPROG": KEYSEP$: typeid: KEYSEP$: classid: KEYSEP$: entityid
read sysprogHdr from fhSysReposSrc, sysprogEnt then
bCopyHdr = FALSE$
end
end
end
case backupType = "TABLE"
if operation = OPBACKUP$ then
srcName = entityid
destName = entityid:BACKUP$
destLocation = location
subkey = repository( "GETSUBKEY", entid)
bfs = subkey< 1, 2>
dbid = subkey< 1, 3>
end else
srcName = entityid:BACKUP$
destName = entityid
read entHdr from fhSysReposSrc, entid then
subkey = entHdr< SYSREP_SUB_KEY$>
destLocation = subkey< 1, 1>
bfs = subkey< 1, 2>
dbid = subkey< 1, 3>
end else
@file.error< FSMSG$> = entid
set_fserror()
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
if bCopyData then
attach_table( location, srcName, dbid, '', status)
if get_status() then
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
end
end
* Copy the entire table (skip '!' & 'DICT.').
if bCopyData then
if entityid[1,1] = '!' or entityid[1,5] = "DICT." or entityid[1,3] = "SYS" or entityid = "ACCESSIBLE_COLUMNS" else
if bfs = "RTP57" then
read systablesRow from fhSysTables, srcName then
copy_table( srcName, destLocation, dbid, destName, '', '', TRUE$, '', status, TRUE$ )
if get_status(errcode) then
if errcode<1,1> = "FS267" or errcode<1,1> = "FS259" then
msgRow = "Table ":errcode<1,2>:" has relational indexing on it and"
msgRow := " cannot be copied until the indexes are removed."
msgRow< MICON$> = '!'
msg( WINID$, msgRow)
end
if errcode<1,1> = "FS100" or errcode<1,1> = "FS109" then
set_status( SETSTAT_OK$, TRUE$)
end else
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
end
if operation = OPRESTORE$ then
attach_table( destLocation, destName, dbid, '',status)
if get_status() else
tableList<-1> = destName
end
end
end
end
end
end
if operation = OPBACKUP$ then
* Don't backup system tables.
if entityid[1,3] = "SYS" or entityid[1,8] = "DICT.SYS" or entityid[1,4] = "!SYS" or entityid = "ACCESSIBLE_COLUMNS" then
bCopyHdr = FALSE$
end
* Post-beta 1 fix...don't copy DBTABLEs that are duped in SYSPROG.
if appid = "CARPARTS" then
sysprogEnt = "SYSPROG": KEYSEP$: typeid: KEYSEP$: classid: KEYSEP$: entityid
read sysprogHdr from fhSysReposSrc, sysprogEnt then
bCopyHdr = FALSE$
end
end
end
case 1
end case
currType = typeid
* Copy the entity header.
if bCopyHdr then
read entHdr from fhSysReposSrc, entid then
write entHdr to fhSysReposDst, entid else
set_fserror()
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
end else
set_fserror()
gosub promptErr
if bContinue then
goto nextEntity
end else
bProcessErr = TRUE$
return
end
end
end
* Update progress bar.
* Cannot update if > 64k because it's an unresolved list.
if bLongList then
set_property( winID:".STATUS_TEXT", "TEXT", "Processing...")
end else
if not( mod(entCounter,10)) or (entCounter = numEntities) then
pctText = (int( entCounter/numEntities * 100)) : '%'
pctText = fmt( pctText, "C#15")
newWidth = int( (entCounter/numEntities) * maxWidth)
currBar = fieldstore( currBar, @fm, 3, 1, newWidth)
controls = winID:".STATUS_TEXT" : @RM : winID:".PROGRESS_BAR"
properties = "TEXT" : @RM : "SIZE"
values = pctText : @RM : currBar
set_property( controls, properties, values)
end
end
nextEntity:
next entCounter
return
/* ----------------------------------------------------------------------- */
PromptErr:
* Display error info & prompt for continuing.
bErrors = TRUE$
get_status( errcode)
set_status( SETSTAT_OK$, '')
msgRow = "An error was encountered." : CRLF$
msgRow := "Error code: ": errcode<1,1> : CRLF$
msgRow := "Detail: ": errcode<1,2> : CRLF$ : CRLF$
msgRow := "Continue?"
msgRow< MICON$> = '!'
msgRow< MTYPE$> = "BNY"
msgRow< MTEXTWIDTH$> = "300"
msgRow< MCAPTION$> = "Application Backup Error"
answer = msg( winID, msgRow)
if answer = 1 then
bContinue = TRUE$
end else
bContinue = FALSE$
end
swap @VM with " - " in errcode
errorSummary<-1> = errcode
return
/* ----------------------------------------------------------------------- */
InitSort:
* Initialize the sort file.
osdelete sortFile
v119( V119_INIT$, sortFile, '', '', '', sortStat)
if sortStat else
@FILE.ERROR<FSCODE$> = FS_SYS_SORT_INIT_ERR$
set_fserror()
errStat = TRUE$
end
return
/* ----------------------------------------------------------------------- */
DeleteSort:
* Delete the sort file.
v119( V119_DELETE$, sortFile, '', '', '', sortStat)
return
/* ----------------------------------------------------------------------- */
DoSort:
* Sort the data. If long sort, write to temp file.
convert \FEFD\ to \FFFE\ in entList
if entList[ -1, 1] <> @RM then
entList := @RM
end
v119( V119_SORT$, '', 'A', 'L', entList, '')
if bLongList then
v119( V119_WRITE$, sortFile, '', '', entList, sortStat)
if sortStat else
@FILE.ERROR<FSCODE$> = FS_SYS_SORT_WRITE_ERR$
set_fserror()
errStat = TRUE$
end
end
convert \FFFE\ to \FEFD\ in entList
return
/* ----------------------------------------------------------------------- */
MergeSort:
* Merge the data in the temp file.
v119( V119_MERGE$, sortFile , 'A', 'L', '', sortStat)
bMerged = TRUE$
if sortStat else
@FILE.ERROR<FSCODE$> = FS_SYS_SORT_MERGE_ERR$
set_fserror()
errStat = TRUE$
end
return
/* ----------------------------------------------------------------------- */
ExtractSort:
* Determine the extract operation (long or short) and do it.
if bLongList then
if bMerged else
gosub mergeSort
if errStat then return
end
entList = ''
v119( 'V', sortFile, 'A', 'L', entList, sortStat)
if sortStat else
@FILE.ERROR<FSCODE$> = FS_SYS_SORT_EXTRACT_ERR$
errStat = TRUE$
return
end
end
* If less than max size, there's no more in temp file.
if len( entList) < EXTRACT_SIZE$ then
moreInfo = ''
end else
moreInfo = TRUE$
end
if bLongList then
convert \FFFE\ to \FEFD\ in entList
end
entList[ -1, 1] = ''
return