home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / getopt.zip / getopt.cmd < prev    next >
OS/2 REXX Batch file  |  1994-04-20  |  6KB  |  206 lines
  1. /*-------------------------------------------------------------------------
  2.  *    REXX program skeleton that uses the GetOpt option parser
  3.  *
  4.  *    To use, make a copy of this file, and put your code between
  5.  *    the Begin main program/End main program comments.
  6.  *
  7.  *    Copyright (c) 1994 Lawrence R Buchanan.  ALL RIGHTS RESERVED.
  8.  *
  9.  *    This program is free software; you are free to do whatever you 
  10.  *    want with it.  The only requirement is that if you use these 
  11.  *    subroutines in code that you distribute, that you leave the 
  12.  *    copyright messages that appear in the headers of the GetOpt and 
  13.  *    SetupArg subroutines.
  14.  *    
  15.  *    This program is distributed in the hope that it will be useful, 
  16.  *    but WITHOUT ANY WARRANTY; without even the implied warranty of 
  17.  *    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  18.  *
  19.  * ------------------- R E V I S I O N   H I S T O R Y -------------------
  20.  *
  21.  *    See end of file.
  22.  *
  23.  -------------------------------------------------------------------------*/
  24.  
  25.  
  26. /*-------------------------------------------------------------------------
  27.     Setup GetOpt. stem variable for GetOpt subroutine.
  28.  
  29.     These two statements MUST appear at the beginning of any program
  30.     that uses GetOpt.
  31.  -------------------------------------------------------------------------*/
  32. parse arg args
  33. call SetupArg args
  34.  
  35.  
  36. /* Begin Main program */
  37.  
  38.  
  39.  
  40. exit
  41. /* End of Main */
  42.  
  43.  
  44.  
  45. /*-------------------------------------------------------------------------
  46.     GetOpt - parse options from REXX program command line
  47.  
  48.     Copyright (c) 1994 Lawrence R Buchanan.  ALL RIGHTS RESERVED.
  49.  -------------------------------------------------------------------------*/
  50. GetOpt: procedure expose GetOpt.
  51.     parse arg optstr
  52.  
  53.     i = GetOpt._optind
  54.     if GetOpt._sp = 1 then do
  55.         if GetOpt._optind > GetOpt.0 | ,
  56.            substr(GetOpt.i, 1, 1, '00'x) <> '-' | ,
  57.            substr(GetOpt.i, 2, 1, '00'x) = '00'x then
  58.             return -1
  59.         else 
  60.             if GetOpt.i =  '--' then do
  61.                 GetOpt._optind = GetOpt._optind + 1
  62.                 return -1
  63.             end
  64.     end
  65.  
  66.     c = substr(GetOpt.i, GetOpt._sp+1, 1, '00'x)
  67.     GetOpt._optopt = c
  68.     cp = pos(c, optstr)
  69.  
  70.     if c = ':' | cp = 0 then do
  71.         if GetOpt._opterr = 1 then 
  72.             say GetOpt._program ': illegal option --' c
  73.         GetOpt._sp = GetOpt._sp + 1
  74.         if substr(GetOpt.i, GetOpt._sp+1, 1, '00'x) = '00'x then do
  75.             GetOpt._optind = GetOpt._optind + 1
  76.             GetOpt._sp = 1
  77.         end
  78.         return '?'
  79.     end
  80.  
  81.     cp = cp + 1
  82.     if substr(optstr, cp, 1, '00'x) = ':' then do
  83.         if substr(GetOpt.i, GetOpt._sp+2, 1, '00'x) <> '00'x then do
  84.             GetOpt._optarg = substr(GetOpt.i, GetOpt._sp+2)
  85.             GetOpt._optind = GetOpt._optind + 1
  86.         end
  87.         else do
  88.             GetOpt._optind = GetOpt._optind + 1
  89.             i = GetOpt._optind
  90.             if GetOpt._optind > GetOpt.0 then do
  91.                 if GetOpt._opterr = 1 then 
  92.                     say GetOpt._program ': option requires an argument --' c
  93.                 GetOpt._sp = 1
  94.                 return '?'
  95.             end
  96.             else do
  97.                 GetOpt._optarg = GetOpt.i
  98.                 GetOpt._optind = GetOpt._optind + 1
  99.             end
  100.         end
  101.  
  102.         GetOpt._sp = 1
  103.     end
  104.     else do
  105.         GetOpt._sp = GetOpt._sp + 1
  106.         if substr(GetOpt.i, GetOpt._sp+1, 1, '00'x) = '00'x then do
  107.             GetOpt._sp = 1
  108.             GetOpt._optind = GetOpt._optind + 1
  109.         end
  110.  
  111.         GetOpt._optarg = ''
  112.     end
  113.  
  114. return c
  115. /* End of GetOpt */
  116.  
  117.  
  118. /*-------------------------------------------------------------------------
  119.     SetupArg - Parse command-line arguments and store in stem GetOpt.
  120.  
  121.     Copyright (c) 1994 Lawrence R Buchanan.  ALL RIGHTS RESERVED.
  122.  -------------------------------------------------------------------------*/
  123. SetupArg: procedure expose GetOpt.
  124.     parse arg arglist
  125.  
  126.     /* Initialize variables used in GetOpt subroutine. */
  127.     GetOpt. = ''
  128.     GetOpt._opterr = 1
  129.     GetOpt._optind = 1
  130.     GetOpt._sp   = 1
  131.  
  132.     /* Place program name in GetOpt._program. */
  133.     parse source os . GetOpt._program .
  134.     if os = 'OS/2' then do
  135.         GetOpt._program = filespec('N', GetOpt._program)
  136.         GetOpt._program = delstr(GetOpt._program, lastpos('.', GetOpt._program))
  137.     end
  138.  
  139.     /* Make sure the command-line contains an even number of 
  140.         quotation characters.  If it doesn't, I can't continue. */
  141.     if __SetupArg_CntQuo(arglist) // 2 then do
  142.         say GetOpt._program ': Unbalanced quotation marks in command-line'
  143.         exit 255
  144.     end
  145.  
  146.     i = 0
  147.     /* Load command-line options into GetOpt.1 through GetOpt.n. */    
  148.     do while arglist <> ''
  149.         i = i + 1
  150.         parse var arglist GetOpt.i arglist
  151.  
  152.         /* If quoted argument, make sure we get it all from command-line. */
  153.         if pos('"', GetOpt.i) > 0 then do
  154.             cnt = __SetupArg_CntQuo(GetOpt.i)
  155.             parse var GetOpt.i opt '"' tmparg
  156.             GetOpt.i = opt || strip(tmparg, 'T', '"')
  157.             if cnt = 1 then do
  158.                 parse var arglist remarg '"' arglist
  159.                 GetOpt.i = GetOpt.i remarg
  160.             end
  161.         end
  162.     end
  163.     GetOpt.0 = i
  164.  
  165. return GetOpt.0
  166. /* End of SetupArg */
  167.  
  168.  
  169. /*-------------------------------------------------------------------------
  170.     __SetupArg_CntQuo - Count number of occurrences of '"' in str
  171.  
  172.     Copyright (c) 1994 Lawrence R Buchanan.  ALL RIGHTS RESERVED.
  173.  -------------------------------------------------------------------------*/
  174. __SetupArg_CntQuo: procedure
  175.     parse arg str
  176.     
  177.     cnt = 0
  178.     pos = pos('"', str)
  179.     do while pos > 0
  180.         cnt = cnt + 1
  181.         pos = pos('"', str, pos+1)
  182.     end
  183.  
  184. return cnt
  185. /* End of __SetupArg_CntQuo */
  186.  
  187.  
  188.  
  189. /*-------------------- R E V I S I O N   H I S T O R Y --------------------
  190.  *
  191.  * $Log:   D:\u\src\rexx\getopt\vcs\getopt.cmv  $
  192.  * 
  193.  *    Rev 1.2   20 Apr 1994 16:14:28   rodb
  194.  * CHG: Renamed stem names by prepending a '_' (underscore), in an attempt to
  195.  *      protect them from inadvertent use.  (i.e., GetOpt.program is now 
  196.  *      GetOpt._program.)
  197.  * 
  198.  *    Rev 1.1   20 Apr 1994 12:08:52   rodb
  199.  * CHG: Major changes to GetOpt. stem variable.  Done to make code more 
  200.  *      "in tune" with standard REXX stem variable behavior.
  201.  * 
  202.  *    Rev 1.0   16 Mar 1994 09:21:06   rodb
  203.  * Initial revision.
  204.  *
  205.  -------------------------------------------------------------------------*/
  206.