home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / getopt.zip / rpr.cmd < prev    next >
OS/2 REXX Batch file  |  1994-04-20  |  11KB  |  405 lines
  1. /*-------------------------------------------------------------------------
  2.  *    rpr - display and format files
  3.  *
  4.  *    Copyright (c) 1994 Lawrence R Buchanan.  ALL RIGHTS RESERVED.
  5.  *
  6.  *    This program is free software; you are free to do whatever you 
  7.  *    want with it.  The only requirement is that if you use these 
  8.  *    subroutines in code that you distribute, that you leave the 
  9.  *    copyright messages that appear in the headers of the GetOpt and 
  10.  *    SetupArg subroutines.
  11.  *    
  12.  *    This program is distributed in the hope that it will be useful, 
  13.  *    but WITHOUT ANY WARRANTY; without even the implied warranty of 
  14.  *    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  15.  *
  16.  *    Usage: rpr [-dFnt] [-h header] [-l lines] [-w width] file ...
  17.  *
  18.  * ------------------- R E V I S I O N   H I S T O R Y -------------------
  19.  *
  20.  *    See end of file.
  21.  *
  22.  -------------------------------------------------------------------------*/
  23.  
  24. /* Check for uninitialized variables. */
  25. signal on NOVALUE name SIG_NoValue
  26.  
  27.  
  28. /*-------------------------------------------------------------------------
  29.     Setup GetOpt. stem variable for GetOpt subroutine.
  30.  
  31.     These two statements MUST appear at the beginning of any program
  32.     that uses GetOpt.
  33.  -------------------------------------------------------------------------*/
  34. parse arg args
  35. call SetupArg args
  36.  
  37.  
  38. /* If no options issue usage message and exit. */
  39. if GetOpt.0 = 0 then do
  40.     call Usage
  41.     exit 1
  42. end
  43.  
  44. /* Setup program defaults. */
  45. length = 66                        /* Page length (in lines). */
  46. width  = 72                        /* Page width (in characters). */
  47. dflg  = 0                        /* 0 = single space, 1 = double space. */
  48. Fflg = 0                        /* 1 = use FF to separate pages. */
  49. hflg  = 0                        /* 1 = print custom header. */
  50. nflg  = 0                        /* 1 = Print line numbers. */
  51. tflg  = 0                        /* 1 = do not print header/trailer. */
  52.  
  53. /* Get the option flags and arguments and set up the program environment. */
  54. call DecodeSwitches
  55.  
  56. /* If no files are given to be printed issue message and exit. */
  57. if GetOpt._optind > GetOpt.0 then do
  58.     say GetOpt._program ': No files to print'
  59.     exit 2
  60. end
  61.  
  62. /* Don't print header/trailer if pagelength <= 10. */
  63. if length <= 10 then
  64.     tflg = 1
  65.  
  66. if tflg then
  67.     lpp = length
  68. else
  69.     lpp = length - 5 - 5        /* Allow for 5-line header/5-line trailer.*/
  70.  
  71. do i = GetOpt._optind to GetOpt.0
  72.     call PrintFile GetOpt.i
  73. end
  74.  
  75. exit
  76. /* End of main program */
  77.  
  78.  
  79.  
  80. /*-------------------------------------------------------------------------
  81.     DecodeSwitches - decodes command-line options
  82.  -------------------------------------------------------------------------*/
  83. DecodeSwitches: procedure expose GetOpt. length width custom_header dflg,
  84.                 Fflg hflg nflg tflg
  85.  
  86.     errflg = 0
  87.     optstr = 'Fdh:l:ntw:'
  88.     c = GetOpt(optstr)
  89.     do while c <> -1
  90.         select
  91.             when c = 'F' then
  92.                 Fflg = 1
  93.             when c = 'd' then
  94.                 dflg = 1
  95.             when c = 'h' then do
  96.                 hflg = 1
  97.                 custom_header = GetOpt._optarg
  98.                 end
  99.             when c = 'l' then
  100.                 if datatype(GetOpt._optarg, 'N') then
  101.                     length = trunc(GetOpt._optarg)
  102.                 else
  103.                     errflg = 1
  104.             when c = 'n' then 
  105.                 nflg = 1
  106.             when c = 't' then 
  107.                 tflg = 1
  108.             when c = 'w' then 
  109.                 if datatype(GetOpt._optarg, 'N') then
  110.                     width = trunc(GetOpt._optarg)
  111.                 else
  112.                     errflg = 1
  113.             otherwise 
  114.                 do
  115.                     call Usage
  116.                     exit 2
  117.                 end
  118.         end                            /* select */
  119.     
  120.         if errflg then do
  121.             say GetOpt._program ': Invalid argument for option' c 
  122.             exit 2
  123.         end
  124.         c = GetOpt(optstr)
  125.     end                                /* while */
  126.     
  127. return
  128. /* End of DecodeSwitches */
  129.  
  130.  
  131.  
  132. /*-------------------------------------------------------------------------
  133.     PrintFile - Print file
  134.  -------------------------------------------------------------------------*/
  135. PrintFile: procedure expose dflg Fflg hflg nflg tflg custom_header,
  136.            length lpp width 
  137.     parse arg file
  138.  
  139.     if stream(file, 'C', 'QUERY EXISTS') = 'NOTREADY:' then
  140.         return
  141.  
  142.     header = MakeHeader(file)
  143.     pagno = 0
  144.     lineno = 0
  145.     prtlines = 0
  146.  
  147.     do while lines(file)
  148.         if \tflg then do
  149.             if prtlines >= lpp then do
  150.                 if Fflg then
  151.                     call charout , '0C'x
  152.                 else
  153.                     do i = prtlines+5 to length-1
  154.                         say
  155.                     end
  156.                 prtlines = 0
  157.             end
  158.  
  159.             if prtlines = 0 then 
  160.                 call PrintHeader header
  161.         end
  162.  
  163.         printline = linein(file)
  164.         if nflg then 
  165.             printline = format(lineno,5,0) printline
  166.  
  167.         say strip(left(printline, width), 'T')
  168.         lineno = lineno + 1
  169.         if dflg then do
  170.             say
  171.             prtlines = prtlines + 2
  172.         end
  173.         else
  174.             prtlines = prtlines + 1
  175.     end
  176.  
  177.     if \tflg & lineno > 0 then
  178.         if Fflg then
  179.             call charout , '0C'x
  180.         else
  181.             do i = prtlines+5 to length-1
  182.                 say
  183.             end
  184.     return
  185.  
  186.  
  187. /*-------------------------------------------------------------------------
  188.     PrintHeader - Print header on report
  189.  -------------------------------------------------------------------------*/
  190. PrintHeader: procedure expose pagno
  191.     parse arg header
  192.  
  193.     pagno = pagno + 1
  194.     say
  195.     say
  196.     say header format(pagno, 4, 0)
  197.     say
  198.     say
  199.  
  200.     return
  201.  
  202.  
  203. /*-------------------------------------------------------------------------
  204.     MakeHeader - Make header to print on reports
  205.  -------------------------------------------------------------------------*/
  206. MakeHeader: Procedure expose hflg custom_header width
  207.     parse arg file
  208.  
  209.     timestamp = stream(file, 'C', 'QUERY DATETIME')
  210.     if \hflg then
  211.         custom_header = file
  212.  
  213.     header = right('Page', width-5)
  214.     custom_header = strip(center(custom_header, width), 'T')
  215.     header = overlay(custom_header, header)
  216.     return overlay(timestamp, header)
  217.  
  218.  
  219. /*-------------------------------------------------------------------------
  220.     Usage - Print usage message.
  221.  -------------------------------------------------------------------------*/
  222. Usage:
  223.     say GetOpt._program 'version 1.0, $Revision:   1.2  $'
  224.     say 'Copyright (c) 1994 Lawrence R Buchanan.'
  225.     say
  226.     say 'Usage:' GetOpt._program '[-dFnt] [-h header] [-l lines] [-w width] file ...'
  227.     return
  228.  
  229.  
  230.  
  231. /*-------------------------------------------------------------------------
  232.     GetOpt - parse options from REXX program command line
  233.  
  234.     Copyright (c) 1994 Lawrence R Buchanan.  ALL RIGHTS RESERVED.
  235.  -------------------------------------------------------------------------*/
  236. GetOpt: procedure expose GetOpt.
  237.     parse arg optstr
  238.  
  239.     i = GetOpt._optind
  240.     if GetOpt._sp = 1 then do
  241.         if GetOpt._optind > GetOpt.0 | ,
  242.            substr(GetOpt.i, 1, 1, '00'x) <> '-' | ,
  243.            substr(GetOpt.i, 2, 1, '00'x) = '00'x then
  244.             return -1
  245.         else 
  246.             if GetOpt.i =  '--' then do
  247.                 GetOpt._optind = GetOpt._optind + 1
  248.                 return -1
  249.             end
  250.     end
  251.  
  252.     c = substr(GetOpt.i, GetOpt._sp+1, 1, '00'x)
  253.     GetOpt._optopt = c
  254.     cp = pos(c, optstr)
  255.  
  256.     if c = ':' | cp = 0 then do
  257.         if GetOpt._opterr = 1 then 
  258.             say GetOpt._program ': illegal option --' c
  259.         GetOpt._sp = GetOpt._sp + 1
  260.         if substr(GetOpt.i, GetOpt._sp+1, 1, '00'x) = '00'x then do
  261.             GetOpt._optind = GetOpt._optind + 1
  262.             GetOpt._sp = 1
  263.         end
  264.         return '?'
  265.     end
  266.  
  267.     cp = cp + 1
  268.     if substr(optstr, cp, 1, '00'x) = ':' then do
  269.         if substr(GetOpt.i, GetOpt._sp+2, 1, '00'x) <> '00'x then do
  270.             GetOpt._optarg = substr(GetOpt.i, GetOpt._sp+2)
  271.             GetOpt._optind = GetOpt._optind + 1
  272.         end
  273.         else do
  274.             GetOpt._optind = GetOpt._optind + 1
  275.             i = GetOpt._optind
  276.             if GetOpt._optind > GetOpt.0 then do
  277.                 if GetOpt._opterr = 1 then 
  278.                     say GetOpt._program ': option requires an argument --' c
  279.                 GetOpt._sp = 1
  280.                 return '?'
  281.             end
  282.             else do
  283.                 GetOpt._optarg = GetOpt.i
  284.                 GetOpt._optind = GetOpt._optind + 1
  285.             end
  286.         end
  287.  
  288.         GetOpt._sp = 1
  289.     end
  290.     else do
  291.         GetOpt._sp = GetOpt._sp + 1
  292.         if substr(GetOpt.i, GetOpt._sp+1, 1, '00'x) = '00'x then do
  293.             GetOpt._sp = 1
  294.             GetOpt._optind = GetOpt._optind + 1
  295.         end
  296.  
  297.         GetOpt._optarg = ''
  298.     end
  299.  
  300. return c
  301. /* End of GetOpt */
  302.  
  303.  
  304. /*-------------------------------------------------------------------------
  305.     SetupArg - Parse command-line arguments and store in stem GetOpt.
  306.  
  307.     Copyright (c) 1994 Lawrence R Buchanan.  ALL RIGHTS RESERVED.
  308.  -------------------------------------------------------------------------*/
  309. SetupArg: procedure expose GetOpt.
  310.     parse arg arglist
  311.  
  312.     /* Initialize variables used in GetOpt subroutine. */
  313.     GetOpt. = ''
  314.     GetOpt._opterr = 1
  315.     GetOpt._optind = 1
  316.     GetOpt._sp   = 1
  317.  
  318.     /* Place program name in GetOpt._program. */
  319.     parse source os . GetOpt._program .
  320.     if os = 'OS/2' then do
  321.         GetOpt._program = filespec('N', GetOpt._program)
  322.         GetOpt._program = delstr(GetOpt._program, lastpos('.', GetOpt._program))
  323.     end
  324.  
  325.     /* Make sure the command-line contains an even number of 
  326.         quotation characters.  If it doesn't, I can't continue. */
  327.     if __SetupArg_CntQuo(arglist) // 2 then do
  328.         say GetOpt._program ': Unbalanced quotation marks in command-line'
  329.         exit 255
  330.     end
  331.  
  332.     i = 0
  333.     /* Load command-line options into GetOpt.1 through GetOpt.n. */    
  334.     do while arglist <> ''
  335.         i = i + 1
  336.         parse var arglist GetOpt.i arglist
  337.  
  338.         /* If quoted argument, make sure we get it all from command-line. */
  339.         if pos('"', GetOpt.i) > 0 then do
  340.             cnt = __SetupArg_CntQuo(GetOpt.i)
  341.             parse var GetOpt.i opt '"' tmparg
  342.             GetOpt.i = opt || strip(tmparg, 'T', '"')
  343.             if cnt = 1 then do
  344.                 parse var arglist remarg '"' arglist
  345.                 GetOpt.i = GetOpt.i remarg
  346.             end
  347.         end
  348.     end
  349.     GetOpt.0 = i
  350.  
  351. return GetOpt.0
  352. /* End of SetupArg */
  353.  
  354.  
  355. /*-------------------------------------------------------------------------
  356.     __SetupArg_CntQuo - Count number of occurrences of '"' in str
  357.  
  358.     Copyright (c) 1994 Lawrence R Buchanan.  ALL RIGHTS RESERVED.
  359.  -------------------------------------------------------------------------*/
  360. __SetupArg_CntQuo: procedure
  361.     parse arg str
  362.     
  363.     cnt = 0
  364.     pos = pos('"', str)
  365.     do while pos > 0
  366.         cnt = cnt + 1
  367.         pos = pos('"', str, pos+1)
  368.     end
  369.  
  370. return cnt
  371. /* End of __SetupArg_CntQuo */
  372.  
  373.  
  374. /*-------------------------------------------------------------------------
  375.     This subroutine, in conjunction with a SIGNAL ON NOVALUE statement, 
  376.     will display an error message (in sort-of Microsoft format) if the 
  377.     program encounters an uninitialized variable.
  378.  -------------------------------------------------------------------------*/
  379. SIG_NoValue:
  380.     parse source . . source_file .
  381.     say argv.0 '(' || sigl || '): Error: Variable' condition('D'),
  382.         'was not initialized prior to use'
  383.  
  384.     exit
  385.  
  386.  
  387.  
  388. /*-------------------- R E V I S I O N   H I S T O R Y --------------------
  389.  *
  390.  * $Log:   D:\u\src\rexx\getopt\vcs\rpr.cmv  $
  391.  * 
  392.  *    Rev 1.2   20 Apr 1994 16:14:30   rodb
  393.  * CHG: Renamed stem names by prepending a '_' (underscore), in an attempt to
  394.  *      protect them from inadvertent use.  (i.e., GetOpt.program is now 
  395.  *      GetOpt._program.)
  396.  * 
  397.  *    Rev 1.1   20 Apr 1994 12:08:54   rodb
  398.  * CHG: Major changes to GetOpt. stem variable.  Done to make code more 
  399.  *      "in tune" with standard REXX stem variable behavior.
  400.  * 
  401.  *    Rev 1.0   16 Mar 1994 09:21:08   rodb
  402.  * Initial revision.
  403.  *
  404.  -------------------------------------------------------------------------*/
  405.