home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
netdor3.zip
/
TOOLS
/
NAMEFIND.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1996-04-04
|
14KB
|
388 lines
/*****************************************************************************
* NAMEFIND - Names File Search Utility *
* T. Bridgman (CORE at WATSON) *
*****************************************************************************
* Licensed Materials-Property of IBM *
* 5604-472 (c) Copyright IBM Corporation, 1993 *
* All rights reserved. *
* US Government Users Restricted Rights - *
* Use, duplication or disclosure restricted *
* by GSA ADP Schedule Contract with IBM Corp. *
*****************************************************************************
* 27 Aug 91 - version 1.0 *
* 10 Oct 91 - version 1.1 *
* - Somewhat host compatible, more intuitive engine. *
* 26 Nov 91 - version 1.2 *
* - Handles multiple tags on a line. *
* - Speed improvements: *
* - RxGrep used rather than RxStemGrep (thanks to Rocky Bernstein for *
* noting the 4 to 1 performance difference) *
* - Use a binary search on the canidates list to decrease search time. *
* - Some CMS-like support, enabled if invoked with CMS type syntax. *
* 6 Jan 92 - teb *
* - bug: Null value returned instead of "ERROR:3" when called as function. *
* 9 Sep 92 - teb *
* - If invoked with our (non-VM) syntax, accept caret (^) or backslash (\) *
* to escape a forward slash (/) in an argument. The forward slash is *
* otherwise taken as an options seperator. *
* - bug: Colons could not be used in data. *
* - bug: Abbreviations of nicknames could match nicknames. *
* - If called with VM syntax, tags and values are separated by spaces *
* rather than by periods. *
* 4 Jan 93 - teb *
* - bug: Comments were being searched in NameFindInit. *
* 20 Jan 93 - teb *
* - bug: Comments were also being searched in Canidates. *
* 3 Jun 93 - teb *
* - bug: Erroneous matches could occur in certain cases. *
* *
* Known bugs/limitations: *
* - If a :NICK value is not specified, execution time is long as multiple *
* runs must be made through the file. * *
* - Does not yet support all VM style options, including returning values *
* found on the stack. *
*****************************************************************************/
trace 'O'
call time 'R'
signal on halt /* Enable error traps */
signal on novalue
signal on syntax
parse source . How .
CmdMode = (How = 'COMMAND')
if arg() = 0 | abbrev(strip(arg(1)), '?')
then signal Tell
VmMode = abbrev(arg(1), ':')
if VmMode
then parse arg SArgs '(' Opts
else do
parse arg Opts.!NamesFile SArgs
Opts = ''
SP = pos('/', SArgs)
do while SP > 0
if pos(substr(SArgs, SP-1, 1), '\^') > 0
then SArgs = delstr(SArgs, SP-1, 1)
else do
Opts = substr(SArgs, SP+1)
SArgs = left(SArgs, SP-1)
end
SP = pos('/', SArgs, SP+1)
end
end
Globals = 'NFResult Sep TSep Err. CmdMode NickMap Opts. NamesData VmMode'
Err.0Other = 'ERROR:99'
call LoadRxUtils
call ParseOpts
Limits.0 = 0 /* Set control parameters */
LimitReq = 0
Returns. = 0
ReturnReq = 0
NickLimit = ''
parse upper var SArgs Bogus ':' SArgs
parse var SArgs STag SVal ' :' SArgs
STag = ':'STag
SVal = strip(Sval)
do while SArgs <> ''
parse var SArgs XTag XVal ' :' SArgs
XTag = ':'XTag
if XVal = ''
then do
Returns.XTag = 1
ReturnReq = 1
end
else do
XVal = strip(XVal)
call rxStemInsert 'LIMITS.', Limits.0 + 1, XTag XVal
end
end
if \ReturnReq
then Returns. = 1 /* Look for STAG/SVAL combination */
call NameFindInit Opts.!NamesFile, NickLimit
Canidates = Canidates(STag SVal, NickMap)
do I = 1 to Limits.0
Canidates = Canidates(Limits.I, Canidates)
end
if Canidates = ''
then call Error Err.0EntryNotFound, 'No entries were found that matched',
'your search criteria.'
FilePtr = 1
do I = 1 to Opts.!RetNum while Canidates <> ''
parse var Canidates Start Stop Canidates
do FilePtr = FilePtr to Stop while lines(Opts.!NamesFile) > 0
if FilePtr < Start
then do
call linein Opts.!NamesFile
iterate
end
NFLine = linein(Opts.!NamesFile)
if abbrev(NFLine, '*') | abbrev(NFLine, '.*')
then iterate
do while NFLine <> ''
parse var NFLine ':' -0 FTag '.' FVal ' :' -0 NFLine
FTag = translate(FTag)
if FTag = ':NICK'
then if FilePtr > Start
then leave I
if Returns.FTag
then if CmdMode
then say FTag||TSep||FVal
else NFResult = NFResult||FTag||TSep||FVal||Sep
end
end
end
call stream Opts.!NamesFile, 'C', 'CLOSE'
if CmdMode
then exit 0
else return NFResult
/*****************************************************************************
* LOADRXUTILS *
*****************************************************************************/
LoadRxUtils: procedure expose (Globals)
if \rxfuncadd('RXLOADFUNCS', 'RXUTILS', 'RXLOADFUNCS')
then do
signal on syntax name LoadRxUtils2
call rxLoadFuncs 'QUIET'
end
return 0
LoadRxUtils2:
signal on syntax name syntax
select
when rc = 40
then call rxLoadFuncs
when rc = 43
then call Error Err.0Other, 'RXUTILS.DLL not found.'
otherwise
call Error Err.0Other, 'Error' rc 'registering RXUTILS functions.'
end
return 0
/*****************************************************************************
* GETLINE *
*****************************************************************************/
GetLine: procedure expose (Globals)
CrLf = '0D0A'x
parse var NamesData Line '0D0A'x NamesData
return Line
/*****************************************************************************
* CANIDATES *
*****************************************************************************/
Canidates: procedure expose (Globals)
parse upper arg Tag Value, InList
Canidates = ''
Tag = Tag'.'
call rxGrep Tag||Value, Opts.!NamesFile, 'HITS.', 'N'
do I = 1 to Hits.0
parse upper var Hits.I LN Prefix (Tag) FoundVal ' :'
if abbrev(Prefix, '*') | abbrev(Prefix, '.*')
then iterate
if Value = '' | FoundVal = Value
then Canidates = Canidates Contains(LN, InList)
end
return Canidates
/*****************************************************************************
* ERROR *
*****************************************************************************/
Error:
parse arg ECode, EMsg
if CmdMode | ECode = Err.0Other
then say EMsg
exit ECode
/*****************************************************************************
* CONTAINS *
* Returns the pair of numbers from the passed list that bracket the *
* passed target, or null if no such pair is found. *
*****************************************************************************/
Contains: procedure
parse arg Target, List
if words(List) // 2 <> 0
then call Error Err.0Other, 'CONTAINS: Bad list.'
do until words(List) <= 2
Half = trunc(words(List)/4 + .5) * 2
if Target > word(List, Half)
then List = subword(List, Half+1)
else List = subword(List, 1, Half)
end
if List <> ''
then if Target < word(List, 1) | Target > word(List, 2)
then List = ''
return List
/*****************************************************************************
* INSIDE *
* Returns 1 if a given number is inside a pair of numbers in the passed *
* list. *
*****************************************************************************/
Inside: procedure
parse arg Target, List
if words(List) // 2 <> 0
then call Error Err.0Other, 'INSIDE: Bad list.'
do I = 1 to words(List) by 2 until (OutC | word(List, I) > Target)
OutC = word(List, I) <= Target & Target <= word(List, I+1)
end
return OutC
/*****************************************************************************
* PARSEOPTS *
*****************************************************************************/
ParseOpts: procedure expose (Globals) Opts
trace 'O'
Opts.!RetNum = 1
Opts.!Output = 'TYPE'
if VmMode
then do
TSep = ' '
Err.0FileNotFound = 28
Err.0EntryNotFound = 32
Err.0BadArgs = 4
Err.0Other = 99
parse value rxUserInfo() with Opts.!NamesFile .
if Opts.!NamesFile = '.'
then Opts.!NamesFile = 'USER.NAM'
do while Opts <> ''
parse upper var Opts Opt Opts
select
when abbrev('FILE', Opt, 3)
then parse var Opts Opts.!NamesFile Opts
/**
when Opt = 'STACK' | Opt = 'FIFO'
when Opt = 'LIFO' | Opt = 'TYPE' | Opt = 'FIFO' | Opt = 'STACK'
then do
if Opt = 'STACK'
then Opt = 'FIFO'
Opts.!Output = Opt
end
**/
otherwise call Error Err.0BadArgs, 'Unrecognized option:' Opt
end
end
end
else do
TSep = '.'
Err.0FileNotFound = 'ERROR:2'
Err.0EntryNotFound = 'ERROR:3'
Err.0BadArgs = 'ERROR:4'
Err.0Other = 'ERROR:99'
do while Opts <> ''
parse upper var Opts Opt '/' Opts
parse var Opt Opt OptArg
select
when Opt = 'RETURN'
then if OptArg = '*'
then Opts.!RetNum = 999999
else parse value OptArg '1' with Opts.!RetNum .
otherwise
call Error Err.0BadArgs, 'Unrecognized option:' Opt'.'
end
end
end
if Opts.!NamesFile = ''
then call Error Err.0BadArgs, 'No names file specified.'
return 0
/*****************************************************************************
* NAMEFINDINIT namefile *
* Verify that names file exists, and read into NNF. stem. *
*****************************************************************************/
NameFindInit: procedure expose (Globals)
trace 'O'
parse arg Opts.!NamesFile, NickLimit
Sep = d2c(26)
NFResult = ''
if \rxFileExist(Opts.!NamesFile) &,
lastpos('.', Opts.!NamesFile) <= lastpos('\', Opts.!NamesFile)
then Opts.!NamesFile = Opts.!NamesFile'.NAM'
if rxFileExist(Opts.!NamesFile)
then do
call rxGrep ':NICK.'NickLimit, Opts.!NamesFile, 'INDEX.', 'N'
NickMap = ''
NotFirst = 0
do I = 1 to Index.0
parse var Index.I Line Index.I
if abbrev(Index.I, '*') | abbrev(Index.I, '.*') /* Ignore comments */
then iterate
parse upper value ' 'Index.I with ' :NICK.' NVal ' :'
if NickLimit <> '' & NVal <> NickLimit
then iterate
if NotFirst
then NickMap = NickMap Line-1 Line
else do
NickMap = NickMap Line
NotFirst = 1
end
end
if NickMap > ''
then NickMap = NickMap '9999999999'
return 0
end
else call Error Err.0FileNotFound, 'File' Opts.!NamesFile 'not found.'
Tell:
if CmdMode
then do
say 'NAMEFIND - Search a Names file'
say
say 'NAMEFIND namesfile :tag value [:tag [value] [...]]'
say
say 'Return codes:'
say 'ERROR:2 - Specified names file not found'
say 'ERROR:3 - Entry not found'
say 'ERROR:4 - Bad arguments'
exit 0
end
else call Error Err.0BadArgs
/*****************************************************************************
* DEBUGGING and ERROR RECOVERY *
*****************************************************************************/
SignalOff:
signal off error
signal off failure
signal off halt
signal off novalue
signal off notready
signal off syntax
return
Halt:
Where = SigL
say 'Execution halted by user at line' Where
exit 255
return
Syntax:
Where = SigL
call SignalOff
say '>> Syntax error' rc '('errortext(rc)') raised in line' Where
signal DebugExit
Novalue:
Where = SigL
call SignalOff
say '>> Novalue error ('condition('D')') raised in line' Where
signal DebugExit
DebugExit:
parse upper arg SkipQues .
if SkipQues <> '<SKIP>'
then do
/*
say 'Line reads: "'sourceline(Where)'"'
*/
say
say 'Please notify the CORE Developers! Press <Enter> to exit.'
if translate(linein('STDIN:')) <> '/D'
then exit
end
trace ?i
nop
exit