midrange.com code scratchpad
Name:
LOCKS
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
09/24/2012 02:33:51 pm
IP:
Logged
Description:
Called module in *srvpgm, TFSORDERS.
*Module created with CRTRPGMOD;
*SRVPGM updated with UPDSRVPGM SRVPGM(mkoester/TFSORDERS)
MODULE(*libl/LOCKS)
EXPORT(*ALL)
Code:
  1. 0001.00       *-------------------------------------------------- 
  2. 0002.00       * Procedure Name: LOCKS (aka ManageLocks)           
  3. 0036.00       *--------------------------------------------------
  4. 0037.00      H NOMAIN                                            
  5. 0038.00      H OPTION(*nounref : *nodebugio : *srcstmt)          
  6. 0039.00                                                          
  7. 0040.00 _____ * Global definitions                                
  8. 0041.00      d Command         s           1024a   varying        
  9. 0042.00      d CouldNotLock    s               n   inz(*OFF)      
  10. 0043.00      d FileClosed      s               n   inz(*OFF)      
  11. 0044.00      d LockReleased    s               n   inz(*OFF)      
  12. 0045.00      d LockSet         s               n   inz(*ON)       
  13. 0046.00      d OrderToLock     s              6a                  
  14. 0047.00                                                           
  15. 0048.00       * mnemonic constants                                
  16. 0049.00      d Close           c                   const('CLOSE') 
  17. 0050.00      d LockIt          c                   const('LOCKIT')
  18. 0051.00      d UnlockIt        c                   const('UNLOCK')
  19. 0052.00 _____                                                     
  20. 0053.00       *-------------------------------------------------- 
  21. 0054.00       * Called program and procedure prototypes           
  22. 0025.00      D ManageLocks...                                             
  23. 0026.00      D                 PR                  Extproc('LOCKS')       
  24. 0027.00      D                                     likeds(SOlocks_ds)     
  25. 0028.00      D Action                         6a   const                  
  26. 0029.00      D Order                          6a   const options(*nopass) 
  27. 0031.00                                                                   
  28. 0032.00       *  Data returned from ManageLocks                           
  29. 0033.00      d SOlocks_ds...                                              
  30. 0034.00      d                 DS                  qualified              
  31. 0035.00      d  Locked                         n                          
  32. 0036.00      d  MessageText                 128a   varying                
  33. 0058.00                                                                   
  34. 0059.00      d QCMDEXC         pr                  Extpgm('QCMDEXC')      
  35. 0060.00      d                             1024    Options(*varsize) Const
  36. 0061.00      d                               15P 5 Const                  
  37. 0062.00      d                                3    Options(*nopass) Const 
  38. 0063.00                                                                           
  39. 0064.00 _____ * Private subprocedures                                             
  40. 0065.00      D*--------------------------------------------------                 
  41. 0066.00      D* Procedure name: SetWaitTime                                       
  42. 0067.00      D* Purpose:        Set Wait time in file overide command             
  43. 0068.00      D* Parameter:      SetOrDelete => Specifies whether to set or delete 
  44. 0069.00      D*                  the override.  Must be 'SET' or 'DELETE'.        
  45. 0070.00      D*--------------------------------------------------                 
  46. 0071.00      D SetWaitTime     PR                                                 
  47. 0072.00      D  SetOrDelete                   6A   CONST                          
  48. 0073.00                                                                           
  49. 0074.00 _____ * Service Program function interface                                
  50. 0075.00      P ManageLocks...                                                     
  51. 0076.00      P                 B                   EXPORT                         
  52. 0077.00                                                                           
  53. 0078.00      fSVLOCK    uf a e           k disk    prefix('IN_DS.') STATIC USROPN 
  54. 0079.00      D ManageLocks...                                                     
  55. 0080.00      D                 PI                                                 
  56. 0081.00      D                                     likeds(SOlocks_ds)             
  57. 0082.00      D Action                         6a   const                          
  58. 0083.00      D Order                          6a   const options(*nopass)         
  59. 0084.00                                                                           
  60. 0085.00      D  Out_ds       e ds                  EXTNAME(SVLOCK : *OUTPUT)      
  61. 0086.00      D  IN_DS          ds                  LIKEREC(LOCK) INZ              
  62. 0087.00       *--------------------------------------------------             
  63. 0088.00       /free                                                           
  64. 0089.00        if %parms > 1;                                                 
  65. 0090.00           OrderToLock = order;                                        
  66. 0091.00        endif;                                                         
  67. 0092.00                                                                       
  68. 0093.00        select;                                                        
  69. 0094.00        when Action <> Close                                           
  70. 0095.00         and %parms < 2;                                               
  71. 0096.00           // Could not access SVLOCK file                             
  72. 0097.00           SOlocks_ds.Locked = CouldNotLock;                           
  73. 0098.00           SOlocks_ds.MessageText = 'Order number must be specified';  
  74. 0099.00                                                                       
  75. 0100.00        when Action = LockIt;                                          
  76. 0101.00           if not %OPEN(SVLOCK);                                       
  77. 0102.00              MONITOR;                                                 
  78. 0103.00                 OPEN SVLOCK;                                          
  79. 0104.00              ON-ERROR;                                                
  80. 0105.00                 // Could not access SVLOCK file                       
  81. 0106.00                 SOlocks_ds.Locked = CouldNotLock;                     
  82. 0107.00                 SOlocks_ds.MessageText = 'Could not open SVLOCK file';
  83. 0108.00                                                                       
  84. 0109.00                 SetWaitTime('DELETE');                                
  85. 0110.00                                                                       
  86. 0111.00                 RETURN SOlocks_ds;                                           
  87. 0112.00              ENDMON;                                                         
  88. 0113.00           endif;                                                             
  89. 0114.00                                                                              
  90. 0115.00           // Set WaitRcd time on SVLOCK to *immed, so we can know fast if an 
  91. 0116.00           // order is locked.                                                
  92. 0117.00           SetWaitTime('SET');                                                
  93. 0118.00                                                                              
  94. 0119.00           // Chain to set the row lock                                       
  95. 0120.00           MONITOR;                                                           
  96. 0121.00              chain OrderToLock SVLOCK IN_DS;                                 
  97. 0122.00           ON-ERROR;                                                          
  98. 0123.00              // Could not set the row lock - assume another job has it locked
  99. 0124.00                                                                              
  100. 0125.00              SOlocks_ds.Locked = CouldNotLock;                               
  101. 0126.00              SOlocks_ds.MessageText = 'Order is in use by another job';      
  102. 0127.00                                                                              
  103. 0128.00              SetWaitTime('DELETE');                                          
  104. 0129.00              RETURN SOlocks_ds;                                              
  105. 0130.00           ENDMON;                                                            
  106. 0132.00                                                                              
  107. 0133.00           if not %found(SVLOCK);                                             
  108. 0134.00              // write a record with the service order #
  109. 0135.00              LOCK# = OrderToLock;                                                
  110. 0136.00              write LOCK Out_ds;                                                  
  111. 0137.00                                                                                  
  112. 0138.00              // and set the row lock;                                            
  113. 0139.00              chain OrderToLock SVLOCK IN_DS;                                     
  114. 0140.00                                                                                  
  115. 0141.00              // Order has been locked for this job.                              
  116. 0142.00              SOlocks_ds.Locked = LockSet;                                        
  117. 0143.00              SOlocks_ds.MessageText = 'Order is now locked to this job';         
  118. 0144.00           endif;                                                                 
  119. 0145.00                                                                                  
  120. 0146.00        when Action = UnlockIt;                                                   
  121. 0147.00 test      MONITOR;                                                               
  122. 0148.00              unlock SVLOCK;                                                      
  123. 0149.00 todo   // test that flow does not go into ON-ERROR above if record not locked... 
  124. 0150.00 test      ON-ERROR;                                                              
  125. 0151.00           SOlocks_ds.Locked = LockReleased;                                      
  126. 0152.00           SOlocks_ds.MessageText = 'Order unlock failed... Is it locked?';       
  127. 0153.00              RETURN SOlocks_ds;                                                  
  128. 0154.00 test      ENDMON;                                                                
  129. 0155.00           SOlocks_ds.Locked = LockReleased;                                      
  130. 0156.00           SOlocks_ds.MessageText = 'Order is now locked to this job';            
  131. 0157.00                                                                                  
  132. 0158.00        when Action = Close;                                                      
  133. 0159.00           // Ensure that the SVLOCK file is closed and get out.          
  134. 0160.00           if %OPEN(SVLOCK);                                              
  135. 0161.00              CLOSE SVLOCK;                                               
  136. 0162.00           endif;                                                         
  137. 0163.00                                                                          
  138. 0164.00           SOlocks_ds.Locked = FileClosed;                                
  139. 0165.00           SOlocks_ds.MessageText = 'SVLOCK file is closed';              
  140. 0166.00           SetWaitTime('DELETE');                                         
  141. 0167.00                                                                          
  142. 0168.00        endsl;                                                            
  143. 0169.00                                                                          
  144. 0170.00        RETURN SOlocks_ds;                                                
  145. 0171.00       /end-free                                                          
  146. 0172.00      P ManageLocks...                                                    
  147. 0173.00      P                 E                                                 
  148. 0174.00                                                                          
  149. 0175.00 _____ * Private subprocedures                                            
  150. 0176.00                                                                          
  151. 0177.00      P*--------------------------------------------------                
  152. 0178.00      P* Procedure name: SetWaitTime                                      
  153. 0179.00      P* Purpose:        Set Wait time in file overide command            
  154. 0180.00      P* Parameter:      SetOrDelete => Specifies whether to set or delete
  155. 0181.00      P*                  the override.  Must be 'SET' or 'DELETE'.       
  156. 0182.00      P*--------------------------------------------------                
  157. 0183.00      P SetWaitTime     B                                                  
  158. 0184.00      D SetWaitTime     PI                                                 
  159. 0185.00      D  SetOrDelete                   6A   CONST                          
  160. 0186.00                                                                           
  161. 0187.00       /free                                                               
  162. 0188.00        select;                                                            
  163. 0189.00        when SetOrDelete = 'SET';                                          
  164. 0190.00           Command  =  'OVRDBF FILE(SVLOCK) WAITRCD(*IMMED) OPNSCOPE(*JOB)'
  165. 0191.00                      + ' OVRSCOPE(*JOB)';                                 
  166. 0192.00        when SetOrDelete = 'DELETE';                                       
  167. 0193.00           Command  =  'DLTOVR FILE(SVLOCK) LVL(*JOB)';                    
  168. 0194.00        endsl;                                                             
  169. 0195.00                                                                           
  170. 0196.00        monitor;                                                           
  171. 0197.00          callP QCMDEXC(%trim(COMMAND) : %len(%trim(COMMAND)));            
  172. 0198.00        on-error;                                                          
  173. 0199.00 test          DSPLY ('Error occurred on SetWaitTime.');                   
  174. 0200.00          // at least the program doesn't halt                             
  175. 0201.00        endmon;                                                            
  176. 0202.00        return;                                                            
  177. 0203.00       /end-free                                                           
  178. 0204.00      P SetWaitTime     E                                                  
  179.                       
  180.  
© 2004-2019 by midrange.com generated in 0.008s valid xhtml & css