home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / netdor3.zip / TOOLS / NAMEFIND.CMD < prev    next >
OS/2 REXX Batch file  |  1996-04-04  |  14KB  |  388 lines
  1. /*****************************************************************************
  2.  *                   NAMEFIND - Names File Search Utility                    *
  3.  *                       T. Bridgman (CORE at WATSON)                        *
  4.  *****************************************************************************
  5.  *                    Licensed Materials-Property of IBM                     *
  6.  *               5604-472 (c) Copyright IBM Corporation, 1993                *
  7.  *                           All rights reserved.                            *
  8.  *                  US Government Users Restricted Rights -                  *
  9.  *                 Use, duplication or disclosure restricted                 *
  10.  *                by GSA ADP Schedule Contract with IBM Corp.                *
  11.  *****************************************************************************
  12.  * 27 Aug 91 - version 1.0                                                   *
  13.  * 10 Oct 91 - version 1.1                                                   *
  14.  * - Somewhat host compatible, more intuitive engine.                        *
  15.  * 26 Nov 91 - version 1.2                                                   *
  16.  * - Handles multiple tags on a line.                                        *
  17.  * - Speed improvements:                                                     *
  18.  *   - RxGrep used rather than RxStemGrep (thanks to Rocky Bernstein for     *
  19.  *     noting the 4 to 1 performance difference)                             *
  20.  *   - Use a binary search on the canidates list to decrease search time.    *
  21.  * - Some CMS-like support, enabled if invoked with CMS type syntax.         *
  22.  * 6 Jan 92 - teb                                                            *
  23.  * - bug: Null value returned instead of "ERROR:3" when called as function.  *
  24.  * 9 Sep 92 - teb                                                            *
  25.  * - If invoked with our (non-VM) syntax, accept caret (^) or backslash (\)  *
  26.  *   to escape a forward slash (/) in an argument.  The forward slash is     *
  27.  *   otherwise taken as an options seperator.                                *
  28.  * - bug: Colons could not be used in data.                                  *
  29.  * - bug: Abbreviations of nicknames could match nicknames.                  *
  30.  * - If called with VM syntax, tags and values are separated by spaces       *
  31.  *   rather than by periods.                                                 *
  32.  * 4 Jan 93 - teb                                                            *
  33.  * - bug: Comments were being searched in NameFindInit.                      *
  34.  * 20 Jan 93 - teb                                                           *
  35.  * - bug: Comments were also being searched in Canidates.                    *
  36.  * 3 Jun 93 - teb                                                            *
  37.  * - bug: Erroneous matches could occur in certain cases.                    *
  38.  *                                                                           *
  39.  * Known bugs/limitations:                                                   *
  40.  * - If a :NICK value is not specified, execution time is long as multiple   *
  41.  *   runs must be made through the file.                                     *            *
  42.  * - Does not yet support all VM style options, including returning values   *
  43.  *   found on the stack.                                                     *
  44.  *****************************************************************************/
  45. trace 'O'
  46. call time 'R'
  47. signal on halt                         /* Enable error traps */
  48. signal on novalue
  49. signal on syntax
  50. parse source . How .
  51. CmdMode = (How = 'COMMAND')
  52. if arg() = 0 | abbrev(strip(arg(1)), '?')
  53.   then signal Tell
  54. VmMode = abbrev(arg(1), ':')
  55. if VmMode
  56.   then parse arg SArgs '(' Opts
  57.   else do
  58.     parse arg Opts.!NamesFile SArgs
  59.     Opts = ''
  60.     SP = pos('/', SArgs)
  61.     do while SP > 0
  62.       if pos(substr(SArgs, SP-1, 1), '\^') > 0
  63.         then SArgs = delstr(SArgs, SP-1, 1)
  64.         else do
  65.           Opts = substr(SArgs, SP+1)
  66.           SArgs = left(SArgs, SP-1)
  67.         end
  68.       SP = pos('/', SArgs, SP+1)
  69.     end
  70.   end
  71.  
  72. Globals = 'NFResult Sep TSep Err. CmdMode NickMap Opts. NamesData VmMode'
  73. Err.0Other         = 'ERROR:99'
  74. call LoadRxUtils
  75. call ParseOpts
  76.  
  77. Limits.0 = 0                           /* Set control parameters */
  78. LimitReq = 0
  79. Returns. = 0
  80. ReturnReq = 0
  81. NickLimit = ''
  82. parse upper var SArgs Bogus ':' SArgs
  83. parse var SArgs STag SVal ' :' SArgs
  84. STag = ':'STag
  85. SVal = strip(Sval)
  86. do while SArgs <> ''
  87.   parse var SArgs XTag XVal ' :' SArgs
  88.   XTag = ':'XTag
  89.   if XVal = ''
  90.     then do
  91.       Returns.XTag = 1
  92.       ReturnReq = 1
  93.     end
  94.     else do
  95.       XVal = strip(XVal)
  96.       call rxStemInsert 'LIMITS.', Limits.0 + 1, XTag XVal
  97.     end
  98. end
  99. if \ReturnReq
  100.   then Returns. = 1                    /* Look for STAG/SVAL combination */
  101.  
  102. call NameFindInit Opts.!NamesFile, NickLimit
  103.  
  104. Canidates = Canidates(STag SVal, NickMap)
  105. do I = 1 to Limits.0
  106.   Canidates = Canidates(Limits.I, Canidates)
  107. end
  108. if Canidates = ''
  109.   then call Error Err.0EntryNotFound, 'No entries were found that matched',
  110.         'your search criteria.'
  111. FilePtr = 1
  112. do I = 1 to Opts.!RetNum while Canidates <> ''
  113.   parse var Canidates Start Stop Canidates
  114.   do FilePtr = FilePtr to Stop while lines(Opts.!NamesFile) > 0
  115.     if FilePtr < Start
  116.       then do
  117.         call linein Opts.!NamesFile
  118.         iterate
  119.       end
  120.     NFLine = linein(Opts.!NamesFile)
  121.     if abbrev(NFLine, '*') | abbrev(NFLine, '.*')
  122.       then iterate
  123.     do while NFLine <> ''
  124.       parse var NFLine ':' -0 FTag '.' FVal ' :' -0 NFLine
  125.       FTag = translate(FTag)
  126.       if FTag = ':NICK'
  127.         then if FilePtr > Start
  128.           then leave I
  129.       if Returns.FTag
  130.         then if CmdMode
  131.           then say FTag||TSep||FVal
  132.           else NFResult = NFResult||FTag||TSep||FVal||Sep
  133.     end
  134.   end
  135. end
  136. call stream Opts.!NamesFile, 'C', 'CLOSE'
  137. if CmdMode
  138.   then exit 0
  139.   else return NFResult
  140.  
  141. /*****************************************************************************
  142.  * LOADRXUTILS                                                               *
  143.  *****************************************************************************/
  144. LoadRxUtils: procedure expose (Globals)
  145. if \rxfuncadd('RXLOADFUNCS', 'RXUTILS', 'RXLOADFUNCS')
  146.   then do
  147.     signal on syntax name LoadRxUtils2
  148.     call rxLoadFuncs 'QUIET'
  149.   end
  150. return 0
  151.  
  152. LoadRxUtils2:
  153. signal on syntax name syntax
  154. select
  155.   when rc = 40
  156.     then call rxLoadFuncs 
  157.   when rc = 43
  158.     then call Error Err.0Other, 'RXUTILS.DLL not found.'
  159.   otherwise
  160.     call Error Err.0Other, 'Error' rc 'registering RXUTILS functions.'
  161. end
  162. return 0
  163.  
  164. /*****************************************************************************
  165.  * GETLINE                                                                   *
  166.  *****************************************************************************/
  167. GetLine: procedure expose (Globals)
  168. CrLf = '0D0A'x
  169. parse var NamesData Line '0D0A'x NamesData
  170. return Line
  171.  
  172. /*****************************************************************************
  173.  * CANIDATES                                                                 *
  174.  *****************************************************************************/
  175. Canidates: procedure expose (Globals)
  176. parse upper arg Tag Value, InList
  177. Canidates = ''
  178. Tag = Tag'.'
  179. call rxGrep Tag||Value, Opts.!NamesFile, 'HITS.', 'N'
  180. do I = 1 to Hits.0
  181.   parse upper var Hits.I LN Prefix (Tag) FoundVal ' :'
  182.   if abbrev(Prefix, '*') | abbrev(Prefix, '.*')
  183.     then iterate
  184.   if Value = '' | FoundVal = Value
  185.     then Canidates = Canidates Contains(LN, InList)
  186. end
  187. return Canidates
  188.  
  189. /*****************************************************************************
  190.  * ERROR                                                                     *
  191.  *****************************************************************************/
  192. Error:
  193. parse arg ECode, EMsg
  194. if CmdMode | ECode = Err.0Other
  195.   then say EMsg
  196. exit ECode
  197.  
  198. /*****************************************************************************
  199.  * CONTAINS                                                                  *
  200.  * Returns the pair of numbers from the passed list that bracket the         *
  201.  * passed target, or null if no such pair is found.                          *
  202.  *****************************************************************************/
  203. Contains: procedure
  204. parse arg Target, List
  205. if words(List) // 2 <> 0
  206.   then call Error Err.0Other, 'CONTAINS:  Bad list.'
  207. do until words(List) <= 2
  208.   Half = trunc(words(List)/4 + .5) * 2
  209.   if Target > word(List, Half)
  210.     then List = subword(List, Half+1)
  211.     else List = subword(List, 1, Half)
  212. end
  213. if List <> ''
  214.   then if Target < word(List, 1) | Target > word(List, 2)
  215.     then List = ''
  216. return List
  217.  
  218. /*****************************************************************************
  219.  * INSIDE                                                                    *
  220.  * Returns 1 if a given number is inside a pair of numbers in the passed     *
  221.  * list.                                                                     *
  222.  *****************************************************************************/
  223. Inside: procedure
  224. parse arg Target, List
  225. if words(List) // 2 <> 0
  226.   then call Error Err.0Other, 'INSIDE:  Bad list.'
  227. do I = 1 to words(List) by 2 until (OutC | word(List, I) > Target)
  228.   OutC = word(List, I) <= Target & Target <= word(List, I+1)
  229. end
  230. return OutC
  231.  
  232. /*****************************************************************************
  233.  * PARSEOPTS                                                                 *
  234.  *****************************************************************************/
  235. ParseOpts: procedure expose (Globals) Opts
  236. trace 'O'
  237. Opts.!RetNum = 1
  238. Opts.!Output = 'TYPE'
  239. if VmMode
  240.   then do
  241.     TSep = ' '
  242.     Err.0FileNotFound  = 28
  243.     Err.0EntryNotFound = 32
  244.     Err.0BadArgs       = 4
  245.     Err.0Other         = 99
  246.     parse value rxUserInfo() with Opts.!NamesFile .
  247.     if Opts.!NamesFile = '.'
  248.       then Opts.!NamesFile = 'USER.NAM'
  249.     do while Opts <> ''
  250.       parse upper var Opts Opt Opts
  251.       select
  252.         when abbrev('FILE', Opt, 3)
  253.           then parse var Opts Opts.!NamesFile Opts
  254. /**
  255.         when Opt = 'STACK' | Opt = 'FIFO'
  256.         when Opt = 'LIFO' | Opt = 'TYPE' | Opt = 'FIFO' | Opt = 'STACK'
  257.           then do
  258.             if Opt = 'STACK'
  259.               then Opt = 'FIFO'
  260.             Opts.!Output = Opt
  261.           end
  262. **/
  263.         otherwise call Error Err.0BadArgs, 'Unrecognized option:' Opt
  264.       end
  265.     end
  266.   end
  267.   else do
  268.     TSep = '.'
  269.     Err.0FileNotFound  = 'ERROR:2'
  270.     Err.0EntryNotFound = 'ERROR:3'
  271.     Err.0BadArgs       = 'ERROR:4'
  272.     Err.0Other         = 'ERROR:99'
  273.     do while Opts <> ''
  274.       parse upper var Opts Opt '/' Opts
  275.       parse var Opt Opt OptArg
  276.       select
  277.         when Opt = 'RETURN'
  278.           then if OptArg = '*'
  279.             then Opts.!RetNum = 999999
  280.             else parse value OptArg '1' with Opts.!RetNum .
  281.         otherwise
  282.           call Error Err.0BadArgs, 'Unrecognized option:' Opt'.'
  283.       end
  284.     end
  285.   end
  286. if Opts.!NamesFile = ''
  287.   then call Error Err.0BadArgs, 'No names file specified.'
  288. return 0
  289.  
  290. /*****************************************************************************
  291.  * NAMEFINDINIT namefile                                                     *
  292.  * Verify that names file exists, and read into NNF. stem.                   *
  293.  *****************************************************************************/
  294. NameFindInit: procedure expose (Globals)
  295. trace 'O'
  296. parse arg Opts.!NamesFile, NickLimit
  297. Sep = d2c(26)
  298. NFResult = ''
  299. if \rxFileExist(Opts.!NamesFile) &,
  300.     lastpos('.', Opts.!NamesFile) <= lastpos('\', Opts.!NamesFile)
  301.   then Opts.!NamesFile = Opts.!NamesFile'.NAM'
  302.  
  303. if rxFileExist(Opts.!NamesFile)
  304.   then do
  305.     call rxGrep ':NICK.'NickLimit, Opts.!NamesFile, 'INDEX.', 'N'
  306.     NickMap = ''
  307.     NotFirst = 0
  308.     do I = 1 to Index.0
  309.       parse var Index.I Line Index.I
  310.       if abbrev(Index.I, '*') | abbrev(Index.I, '.*')  /* Ignore comments */
  311.         then iterate
  312.       parse upper value ' 'Index.I with ' :NICK.' NVal ' :'
  313.       if NickLimit <> '' & NVal <> NickLimit
  314.         then iterate
  315.       if NotFirst
  316.         then NickMap = NickMap Line-1 Line
  317.         else do
  318.           NickMap = NickMap Line
  319.           NotFirst = 1
  320.         end
  321.     end
  322.     if NickMap > ''
  323.       then NickMap = NickMap '9999999999'
  324.     return 0
  325.   end
  326.   else call Error Err.0FileNotFound, 'File' Opts.!NamesFile 'not found.'
  327.  
  328. Tell:
  329. if CmdMode
  330.   then do
  331.     say 'NAMEFIND - Search a Names file'
  332.     say
  333.     say 'NAMEFIND namesfile :tag value [:tag [value] [...]]'
  334.     say
  335.     say 'Return codes:'
  336.     say 'ERROR:2 - Specified names file not found'
  337.     say 'ERROR:3 - Entry not found'
  338.     say 'ERROR:4 - Bad arguments'
  339.     exit 0
  340.   end
  341.   else call Error Err.0BadArgs
  342.  
  343. /*****************************************************************************
  344.  *                       DEBUGGING and ERROR RECOVERY                        *
  345.  *****************************************************************************/
  346. SignalOff:
  347. signal off error
  348. signal off failure
  349. signal off halt
  350. signal off novalue
  351. signal off notready
  352. signal off syntax
  353. return
  354.  
  355. Halt:
  356. Where = SigL
  357. say 'Execution halted by user at line' Where
  358. exit 255
  359. return
  360.  
  361. Syntax:
  362. Where = SigL
  363. call SignalOff
  364. say '>> Syntax error' rc '('errortext(rc)') raised in line' Where
  365. signal DebugExit
  366.  
  367. Novalue:
  368. Where = SigL
  369. call SignalOff
  370. say '>> Novalue error ('condition('D')') raised in line' Where
  371. signal DebugExit
  372.  
  373. DebugExit:
  374. parse upper arg SkipQues .
  375. if SkipQues <> '<SKIP>'
  376.   then do
  377. /*
  378.     say 'Line reads: "'sourceline(Where)'"'
  379. */
  380.     say
  381.     say 'Please notify the CORE Developers!  Press <Enter> to exit.'
  382.     if translate(linein('STDIN:')) <> '/D'
  383.       then exit
  384.   end
  385. trace ?i
  386. nop
  387. exit
  388.