/*****************************************************************************
 *                   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
