home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / netdor2.zip / DISK_10 / IMAGE9.ZIP / REGFUNC.CMD < prev    next >
OS/2 REXX Batch file  |  1993-08-24  |  12KB  |  288 lines
  1. /*****************************************************************************
  2.  *                     Register External REXX Functions                      *
  3.  *                   NetDoor Development (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. trace 'O'
  13. signal on syntax
  14. signal on novalue
  15. parse upper arg Pkg Extra
  16. parse source . How Me
  17. Globals = 'Opt. IUO'
  18. Opt.!Cmd = (How = 'COMMAND')
  19.  
  20. if LoadCouEnv('QUIET') <> 0
  21.   then IUO = 1
  22.   else IUO = (rxCouInfo('VER') = 0)
  23. select
  24.   when Pkg = '' | abbrev(Pkg, '?') | Extra <> '' | arg() > 1
  25.     then call BadInvoke
  26.   when Pkg = 'RXUTILS'
  27.     then XC = LoadRxUtils()
  28.   when Pkg = 'REXXUTIL'
  29.     then XC = LoadRexxUtil()
  30.   when Pkg = 'COUENV'
  31.     then XC = LoadCouEnv()
  32.   when Pkg = 'COUCOPY'
  33.     then XC = LoadCouCopy()
  34.   when Pkg = 'DBOXMGR2' & IUO
  35.     then XC = LoadDBoxMgr2()
  36.   otherwise
  37.     call BadInvoke
  38. end
  39. exit XC
  40.  
  41. /*****************************************************************************
  42.  * LoadRXUTILS                                                               *
  43.  *****************************************************************************/
  44. LoadRxUtils: procedure expose (Globals)
  45. if Opt.!Cmd then say 'Registering RXUTILS functions...'
  46. call rxfuncadd 'RXLOADFUNCS', 'RXUTILS', 'RXLOADFUNCS'
  47. signal on syntax name LoadRxUtils2                                   
  48. call rxLoadFuncs 'QUIET'
  49. signal on syntax name syntax                                             
  50. if Opt.!Cmd then say 'Registered.'
  51. return 0                                                                 
  52.                                                                          
  53. LoadRxUtils2:                                                            
  54. signal on syntax name syntax                                             
  55. select                                                                   
  56.   when rc = 40                                                           
  57.     then call rxLoadFuncs                                                
  58.   when rc = 43                                                           
  59.     then do                                                              
  60.       if Opt.!Cmd then say 'Error:  RXUTILS.DLL not found.'
  61.       return 2
  62.     end                                                                  
  63.   otherwise do                                                           
  64.     if Opt.!Cmd then say 'Error: Error' rc 'registering RXUTILS functions.'               
  65.     return 1000 + rc
  66.   end                                                                    
  67. end                                                                      
  68. if Opt.!Cmd then say 'Registered.'
  69. return 0                                                                 
  70.  
  71. /*****************************************************************************
  72.  * LoadREXXUTIL                                                              *
  73.  *****************************************************************************/
  74. LoadRexxUtil: procedure expose (Globals)
  75. if Opt.!Cmd then say 'Registering REXXUTIL functions...'
  76. call rxfuncadd 'SYSLOADFUNCS', 'REXXUTIL', 'SYSLOADFUNCS'
  77. signal on syntax name LoadRexxUtil2
  78. call sysLoadFuncs
  79. signal on syntax name syntax                                             
  80. if Opt.!Cmd then say 'Registered.'
  81. return 0                                                                 
  82.  
  83. LoadRexxUtil2: 
  84. signal on syntax name syntax                                             
  85. select                                                                   
  86.   when rc = 43                                                           
  87.     then do                                                              
  88.       if Opt.!Cmd then say 'Error:  REXXUTIL.DLL not found.'
  89.       return 2
  90.     end                                                                  
  91.   otherwise do                                                           
  92.     if Opt.!Cmd then say 'Error: Error' rc 'registering REXXXUTIL functions.'
  93.     return 1000 + rc
  94.   end                                                                    
  95. end                                                                      
  96. return 0                                                                 
  97.  
  98. /*****************************************************************************
  99.  * LoadCOUENV                                                                *
  100.  *****************************************************************************/
  101. LoadCouEnv: procedure expose (Globals)
  102. Quiet = (arg(1) = 'QUIET')
  103. if Opt.!Cmd & \Quiet then say 'Registering COUENV functions...'
  104. call rxfuncadd 'RXCOUINFO', 'COUENV', 'RXCOUINFO'
  105. signal on syntax name LoadCouEnv2
  106. call rxCouInfo 'VER'
  107. signal on syntax name syntax
  108. if Opt.!Cmd & \Quiet then say 'Registered.'
  109. return 0
  110.  
  111. LoadCouEnv2:
  112. signal on syntax name syntax                                             
  113. select                                                                   
  114.   when rc = 43                                                           
  115.     then do                                                              
  116.       if Opt.!Cmd & \Quiet then say 'Error:  COUENV.DLL not found.'
  117.       return 2
  118.     end                                                                  
  119.   otherwise do                                                           
  120.     if Opt.!Cmd & \Quiet then say 'Error: Error' rc 'registering COUENV functions.'
  121.     return 1000 + rc
  122.   end                                                                    
  123. end                                                                      
  124. return 0                                                                 
  125.  
  126. /*****************************************************************************
  127.  * LoadCOUCOPY                                                               *
  128.  *****************************************************************************/
  129. LoadCouCopy: procedure expose (Globals)
  130. if Opt.!Cmd then say 'Registering COUCOPY functions...'
  131. call rxfuncadd 'RXCOUCOPY', 'COUCOPY', 'RXCOUCOPY'
  132. signal on syntax name LoadCouCopy2
  133. call rxCouCopy
  134. signal on syntax name syntax
  135. if Opt.!Cmd then say 'Registered.'
  136. return 0
  137.  
  138. LoadCouCopy2:
  139. signal on syntax name syntax                                             
  140. select                                                                   
  141.   when rc = 40
  142.     then do
  143.       call rxfuncadd 'RXCOUDELETE', 'COUCOPY', 'RXCOUDELETE'
  144.       call rxfuncadd 'RXCOUDELETEALL', 'COUCOPY', 'RXCOUDELETEALL'
  145.       call rxfuncadd 'RXCOUASSOCIATEAPPFILE', 'COUCOPY',,
  146.           'RXCOUASSOCIATEAPPFILE'
  147.       call rxfuncadd 'RXCOUREMOVEAPPFILE', 'COUCOPY',,
  148.           'RXCOUREMOVEAPPFILE'
  149.       if Opt.!Cmd then say 'Registered.'
  150.     end
  151.   when rc = 43                                                           
  152.     then do                                                              
  153.       if Opt.!Cmd then say 'Error:  COUCOPY.DLL not found.'
  154.       return 2
  155.     end                                                                  
  156.   otherwise do                                                           
  157.     if Opt.!Cmd then say 'Error: Error' rc 'registering COUCOPY functions.'
  158.     return 1000 + rc
  159.   end                                                                    
  160. end                                                                      
  161. return 0                                                                 
  162.  
  163. /*****************************************************************************
  164.  * LoadDBOXMGR2                                                              *
  165.  *****************************************************************************/
  166. LoadDBoxMgr2: procedure expose (Globals)
  167. if Opt.!Cmd then say 'Registering DBOXMGR2 functions...'
  168. call rxfuncadd 'DBOXMGR2', 'DBOXMGR2', 'DBOXMGR2'
  169. do 1000 until Res <> -1       /* test code - dboxmgr timing problems? */
  170.   signal on syntax name LoadDBoxMgr2
  171.   Res = 'DBoxMgr2'()
  172.   signal on syntax name syntax
  173. end
  174. if Res = -1
  175.   then do
  176.     if Opt.!Cmd then say 'Error: DBOXMGR2.DLL not found.'
  177.     exit 2
  178.   end
  179. if Opt.!Cmd then say 'Registered.'
  180. return 0
  181.  
  182.  
  183. signal on syntax name LoadCouCopy2
  184. call rxCouCopy 'BADARG', 'BADARG'
  185. signal on syntax name syntax
  186. if Opt.!Cmd then say 'Registered.'
  187. return 0
  188.  
  189. LoadDBoxMgr2:
  190. signal on syntax name syntax                                             
  191. select                                                                   
  192.   when rc = 43                                                           
  193.     then do                                                              
  194.       if Opt.!Cmd then say 'Error:  DBOXMGR2.DLL not found.'
  195.       return 2
  196.     end                                                                  
  197.   otherwise do                                                           
  198.     if Opt.!Cmd then say 'Error: Error' rc 'registering DBOXMGR2 functions.'
  199.     return 1000 + rc
  200.   end                                                                    
  201. end                                                                      
  202. return 0                                                                 
  203.  
  204. /*****************************************************************************
  205.  * BadInvoke                                                                 *
  206.  *****************************************************************************/
  207. BadInvoke: procedure expose (Globals)
  208. if Opt.!Cmd then do
  209.   say 'REGFUNC - Register an external REXX function package'
  210.   say
  211.   say 'Syntax: REGFUNC packname'
  212.   say
  213.   say 'packname:  COUCOPY'
  214.   say '           COUENV'
  215. if IUO then
  216.   say '           DBOXMGR2'
  217.   say '           REXXUTIL'
  218.   say '           RXUTILS'
  219.   say
  220.   say 'Return codes:'
  221.   say '   2 - DLL not found'
  222.   say '  40 - Bad invocation'
  223.   say ' 255 - Programming error'
  224.   say '1nnn - Unexpected error nnn'
  225.  
  226. end
  227. exit 40
  228.  
  229. /*****************************************************************************
  230.  *                       DEBUGGING and ERROR RECOVERY                        *
  231.  *****************************************************************************/
  232. DebugInit:
  233. if wordpos('/DEBUG', Args) > 0
  234.   then do
  235.     Parms.!Debug = 1
  236.     Parms.!Wait = 1
  237.     parse var Args ArgA '/DEBUG' DArg '/' ArgB
  238.     Args = strip(ArgA '/'ArgB, 'T', '/')
  239.     call Report '9999W', 'Debug mode activated.'
  240.     call SetMsgClass 'X', 'X'
  241.   end
  242.   else do
  243.     Parms.!Debug = 0
  244.     call SetMsgClass 'I', 'X'
  245.   end
  246. return 0
  247.  
  248. BugInit:
  249. if symbol('GLOBALS') = 'LIT'
  250.   then do
  251.     Globals = 'TrVal'
  252.     TrVal = 'O'
  253.   end
  254. parse upper source . . Me   /* See if we're running from the macrospace */
  255. say
  256. say 'Error from' Me':'
  257. MS = pos('\', Me) = 0       /* since we can't use sourceline if we are */
  258. return MS
  259.  
  260. Syntax:
  261. signal off error; signal off failure; signal off halt
  262. signal off novalue; signal off notready; signal off syntax
  263. Where = sigl
  264. MacroSp = BugInit()
  265. Msg = 'Syntax error' rc '('errortext(rc)') raised in line' Where'.'
  266. signal DebugExit
  267.  
  268. Novalue:
  269. signal off error; signal off failure; signal off halt
  270. signal off novalue; signal off notready; signal off syntax
  271. Where = sigl
  272. MacroSp = BugInit()
  273. Msg = 'Novalue error ('condition('D')') raised in line' Where'.'
  274. signal DebugExit
  275.  
  276. DebugExit:
  277. signal off syntax
  278. if Parms.!Wait = 1
  279.   then if translate(linein('STDIN:')) = '/D'
  280.     then do
  281.       say 'Trace mode started.  TRACE O to exit.'
  282.       say
  283.       trace ?i
  284.       nop
  285.     end
  286. say Msg
  287. exit 255
  288.