home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / rexx / library2 / prxutil / prxtest3.cmd < prev    next >
Encoding:
Text File  |  1992-06-28  |  13.0 KB  |  372 lines
  1. /*-- REXX ------------------------------------------------------------*/
  2. /*                                                                    */
  3. /* Module name: PRXTEST3.CMD                                          */
  4. /*                                                                    */
  5. /* Function:    Test program for REXX Macrospace functions.           */
  6. /*                                                                    */
  7. /* Author:      W. David Ashley                                       */
  8. /*                                                                    */
  9. /* (C) Copyright Pedagogic Software 1992.  All rights reserved.       */
  10. /*                                                                    */
  11. /* Modifications:                                                     */
  12. /* --------  ---  --------------------------------------------------- */
  13. /* 06/28/92  WDA  Initial Release                                     */
  14. /*                                                                    */
  15. /*--------------------------------------------------------------------*/
  16.  
  17. /*--------------------------------------------------------------------*/
  18. /*  User note: This is a fully functional program and provides useful */
  19. /*             functions and services.  The test input file provided  */
  20. /*             for this exec is 'TESTIN.TXT'.  To execute this        */
  21. /*             example use the following at the OS/2 cmd prompt:      */
  22. /*                                                                    */
  23. /*                        PRXTEST3 TESTIN.TXT                         */
  24. /*                                                                    */
  25. /*             The files PRXT1.CMD and PRXT2.CMD are assumed to be in */
  26. /*             the current directory when the exec starts.            */
  27. /*--------------------------------------------------------------------*/
  28.  
  29. /* check for correct input arguments */
  30. if arg() <> 1 then call syntax
  31. if length(arg(1)) < 3 then call syntax
  32.  
  33. /* get input arguments */
  34. arg file
  35. file = strip(file)
  36.  
  37. /* add all PRXUTILS functions */
  38. call RxFuncAdd 'PrxLoadFuncs', 'PRXUTILS', 'PRXLOADFUNCS'
  39. call PrxLoadFuncs
  40. say; say 'Functions loaded.'
  41.  
  42. /* read input file */
  43. say 'Reading input file' file'.'
  44. retc = PrxReadToStem(file, 'fline')
  45. if retc <> 0 then do
  46.    select
  47.       when retc = 3 then do
  48.          say 'Error: Cannot open input file' file'.'
  49.          exit 1
  50.          end
  51.       when retc = 1 then do
  52.          say 'Error: Out of memory or memory error.'
  53.          exit 1
  54.          end
  55.       when retc = 2 then do
  56.          say 'Error: Internal REXX variable pool error.'
  57.          exit 1
  58.          end
  59.       otherwise do
  60.          say 'Unknown Error.'
  61.          exit 1
  62.          end
  63.       end
  64.    end
  65. if fline.0 = 0 then do
  66.    say 'Input file is empty.'
  67.    say 'Program ended.'
  68.    exit 0
  69.    end
  70.  
  71. /* save the current Rexx macrospace then clear it */
  72. retc = PrxMacroSave('temp.rxl')
  73. if retc > 0 then do
  74.    temp_saved = 'NO'
  75.    if retc > 2 then do
  76.       say 'Error: Could not save current Macrospace.'
  77.       exit 1
  78.       end
  79.    end
  80. else temp_saved = 'YES'
  81. call PrxMacroErase
  82.  
  83. /* we are now ready to process the input file */
  84. cmd = ''
  85. parm1 = ''
  86. parm2 = ''
  87. parm3 = ''
  88. do i = 1 to fline.0
  89.    /* process a line of the input file */
  90.    say "Executing line" i": '"fline.i"'"
  91.    parse upper value fline.i with cmd parm1 parm2 parm3
  92.    select
  93.       when cmd = 'LOAD' then    call loadfile parm1, parm2, parm3
  94.       when cmd = 'DROP' then    call dropfunc parm1
  95.       when cmd = 'REORDER' then call reorder parm1, parm2
  96.       when cmd = 'SAVE' then    call savefile parm1
  97.       when cmd = 'DIR' then     call dirfile parm1
  98.       when cmd = 'REM' then     nop
  99.       otherwise do
  100.         say 'Error: Invalid command in input file' file'.'
  101.         call Reload
  102.         exit 1
  103.         end
  104.       end
  105.    end
  106.  
  107. /* reset Rexx macrospace to original condition */
  108. call Reload
  109.  
  110. /* exit function */
  111. say 'Program ended.'
  112. exit 0
  113.  
  114. /**********************************************************************/
  115. /*                                                                    */
  116. /*  Function Name:  Loadfile()                                        */
  117. /*                                                                    */
  118. /*  Description:    Load a Rexx Macrospace library into the Macrospace*/
  119. /*                                                                    */
  120. /**********************************************************************/
  121.  
  122. Loadfile: procedure expose i
  123.  
  124.    if arg() = 3 then do
  125.       retc = PrxMacroLoad(arg(1), arg(2), arg(3))
  126.       end
  127.    else if arg() = 1 then do
  128.       retc = PrxMacroLoad(arg(1))
  129.       end
  130.    else do
  131.       say 'Error: Line 'i' of input file.'
  132.       say '  Incorrect number of arguments to function Loadfile().'
  133.       call Reload
  134.       exit 1
  135.       end
  136.    select
  137.       when retc = 0 then do
  138.          if arg() = 3 then,
  139.           say 'Function 'arg(2)' successfully loaded to macrospace.'
  140.          else,
  141.           say 'Library 'arg(1)' successfully loaded to macrospace.'
  142.          end
  143.       when retc = 1 then do
  144.          say 'Error: Line 'i' of input file.'
  145.          say '  No Macro storage space available.'
  146.          call Reload
  147.          exit 1
  148.          end
  149.       when retc = 2 then do
  150.          say 'Warning: Line 'i' of input file.'
  151.          say '  Function not found.'
  152.          end
  153.       when retc = 4 then do
  154.          say 'Warning: Line 'i' of input file.'
  155.          say '  Function(s) already exist in macrospace.'
  156.          say '  Function(s) not loaded to macrospace.'
  157.          end
  158.       when retc = 5 then do
  159.          say 'Error: Line 'i' of input file.'
  160.          say '  Macro file error.'
  161.          call Reload
  162.          exit 1
  163.          end
  164.       when retc = 6 then do
  165.          say 'Error: Line 'i' of input file.'
  166.          say '  Macro library file signature error.'
  167.          call Reload
  168.          exit 1
  169.          end
  170.       when retc = 7 then do
  171.          say 'Error: Line 'i' of input file.'
  172.          say '  Function source not found.'
  173.          call Reload
  174.          exit 1
  175.          end
  176.       when retc = 8 then do
  177.          say 'Error: Line 'i' of input file.'
  178.          say '  Invalid search position.'
  179.          call Reload
  180.          exit 1
  181.          end
  182.       otherwise do
  183.          say 'Error: Line 'i' of input file.'
  184.          say '  Unknown error.'
  185.          call Reload
  186.          exit 1
  187.          end
  188.       end
  189.    return
  190.  
  191. /**********************************************************************/
  192. /*                                                                    */
  193. /*  Function Name:  Savefile()                                        */
  194. /*                                                                    */
  195. /*  Description:    Save a Rexx Macrospace to a file                  */
  196. /*                                                                    */
  197. /**********************************************************************/
  198.  
  199. Savefile: procedure expose i
  200.  
  201.    retc = PrxMacroSave(arg(1))
  202.    select
  203.       when retc = 0 then do
  204.          say 'Macrospace saved to library file' arg(1)'.'
  205.          end
  206.       when retc = 2 then do
  207.          say 'Warning: Line 'i' of input file.'
  208.          say '  Macro function(s) not found.'
  209.          end
  210.       when retc = 3 then do
  211.          say 'Warning: Line 'i' of input file.'
  212.          say '  Extension required on Macro Library filename.'
  213.          say '  Macrospace not saved.'
  214.          end
  215.       when retc = 5 then do
  216.          say 'Error: Line 'i' of input file.'
  217.          say '  Macro file error.'
  218.          call Reload
  219.          exit 1
  220.          end
  221.       otherwise do
  222.          say 'Error: Line 'i' of input file.'
  223.          say '  Unknown error.'
  224.          call Reload
  225.          exit 1
  226.          end
  227.       end
  228.    return
  229.  
  230. /**********************************************************************/
  231. /*                                                                    */
  232. /*  Function Name:  Dropfunc()                                        */
  233. /*                                                                    */
  234. /*  Description:    Drop a function from the Rexx macrospace          */
  235. /*                                                                    */
  236. /**********************************************************************/
  237.  
  238. Dropfunc: procedure expose i
  239.  
  240.    retc = PrxMacroDrop(arg(1))
  241.    select
  242.       when retc = 0 then do
  243.          say 'Function' arg(1) 'successfully dropped.'
  244.          end
  245.       when retc = 2 then do
  246.          say 'Warning: Line 'i' of input file.'
  247.          say '  Macro function(s) not found.'
  248.          end
  249.       otherwise do
  250.          say 'Error: Line 'i' of input file.'
  251.          say '  Unknown error.'
  252.          call Reload
  253.          exit 1
  254.          end
  255.       end
  256.    return
  257.  
  258. /**********************************************************************/
  259. /*                                                                    */
  260. /*  Function Name:  Reorder()                                         */
  261. /*                                                                    */
  262. /*  Description:    Reorder macrospace function                       */
  263. /*                                                                    */
  264. /**********************************************************************/
  265.  
  266. Reorder: procedure expose i
  267.  
  268.    retc = PrxMacroReOrder(arg(1), arg(2))
  269.    select
  270.       when retc = 0 then do
  271.          say 'Function' arg(1) 'successfully reorderd.'
  272.          end
  273.       when retc = 2 then do
  274.          say 'Warning: Line 'i' of input file.'
  275.          say '  Macro function(s) not found.'
  276.          end
  277.       when retc = 8 then do
  278.          say 'Error: Line 'i' of input file.'
  279.          say '  Invalid search position.'
  280.          call Reload
  281.          exit 1
  282.          end
  283.       otherwise do
  284.          say 'Error: Line 'i' of input file.'
  285.          say '  Unknown error.'
  286.          call Reload
  287.          exit 1
  288.          end
  289.       end
  290.    return
  291.  
  292. /**********************************************************************/
  293. /*                                                                    */
  294. /*  Function Name:  Dirfile()                                         */
  295. /*                                                                    */
  296. /*  Description:    Shows the function directory of a REXX macrospace */
  297. /*                  library file.                                     */
  298. /*                                                                    */
  299. /**********************************************************************/
  300.  
  301. Dirfile: procedure expose i
  302.  
  303.    retc = PrxMacroLibDir(arg(1), 'func')
  304.    if retc <> 0 then select
  305.       when retc = 1 then do
  306.          say 'Error: Line 'i' of input file.'
  307.          say '  Out of memory or memory error.'
  308.          call Reload
  309.          exit 1
  310.          end
  311.       when retc = 2 then do
  312.          say 'Error: Line 'i' of input file.'
  313.          say '  REXX variable pool error.'
  314.          call Reload
  315.          exit 1
  316.          end
  317.       when retc = 3 then do
  318.          say 'Error: Line 'i' of input file.'
  319.          say '  File open or read error for file' arg(1)'.'
  320.          call Reload
  321.          exit 1
  322.          end
  323.       otherwise do
  324.          say 'Error: Line 'i' of input file.'
  325.          say '  Unknown error.'
  326.          call Reload
  327.          exit 1
  328.          end
  329.       end
  330.  
  331.    /* Output each function directory entry */
  332.    if func.0 = 0 then say 'No functions found in file' arg(1)'.'
  333.    else do
  334.       say 'Directory of' arg(1)'.'
  335.       say '  Size    Pos     Function Name'
  336.       say '-------- ------ --------------------------------------------'
  337.       do j = 1 to func.0
  338.          say func.j
  339.          end
  340.       end
  341.    return
  342.  
  343. /**********************************************************************/
  344. /*                                                                    */
  345. /*  Function Name:  Reload()                                          */
  346. /*                                                                    */
  347. /*  Description:    Reload macrospace from temporary file.            */
  348. /*                                                                    */
  349. /**********************************************************************/
  350.  
  351. Reload: procedure expose temp_saved
  352.    call PrxMacroErase
  353.    if temp_saved = 'YES' then do
  354.       call PrxMacroLoad 'temp.rxl'
  355.       call PrxDelete 'temp.rxl'
  356.       end
  357.    return
  358.  
  359. /**********************************************************************/
  360. /*                                                                    */
  361. /*  Function Name:  Syntax()                                          */
  362. /*                                                                    */
  363. /*  Description:    Show function syntax and exit.                    */
  364. /*                                                                    */
  365. /**********************************************************************/
  366.  
  367. Syntax: procedure
  368.    say; say 'Error: Incorrect input arguments.'
  369.    say; say 'Function syntax: PRXTEST3 [d:[path]]filename.ext'
  370.    say
  371.    exit 1
  372.