process/bq-linux.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5     File        : process/bq-processor.p
   6     Purpose     : Process queued programs on the system console, rather than
   7                   in front of the user, so they can get on with their work.
   8
   9     Syntax      : no parameters - just run it!
  10
  11     Description : Console process for handling BatchQueue processing
  12
  13     Author(s)   : Andrew McMillan
  14     Created     : 23/6/98
  15     Notes       : A function to handle placing things onto the batch
  16                   queue has also been added to System Manager.
  17   ------------------------------------------------------------------------*/
  18
  19 DEF VAR queue-name AS CHAR NO-UNDO INITIAL "Batch-Queue".
  20 DEF VAR user-name AS CHAR NO-UNDO INITIAL "Batch-Queue".
  21 DEF VAR bq-recid AS RECID NO-UNDO.
  22 DEF VAR last-today AS DATE NO-UNDO.
  23 DEF VAR start-time AS INT NO-UNDO.
  24 start-time = TIME.
  25
  26 DEF VAR lock-filename AS CHAR NO-UNDO.
  27
  28 ON 'ESC':U ANYWHERE DO:
  29   RETURN NO-APPLY.
  30 END.
  31
  32 {inc/ofc-this.i}
  33
  34 /* _UIB-CODE-BLOCK-END */
  35 &ANALYZE-RESUME
  36
  37
  38 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  39
  40 /* ********************  Preprocessor Definitions  ******************** */
  41
  42 &Scoped-define PROCEDURE-TYPE Procedure
  43
  44
  45
  46 /* _UIB-PREPROCESSOR-BLOCK-END */
  47 &ANALYZE-RESUME
  48
  49
  50 /* ************************  Function Prototypes ********************** */
  51
  52 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD continue-processing Procedure
  53 FUNCTION continue-processing RETURNS LOGICAL
  54   ( /* parameter-definitions */ )  FORWARD.
  55
  56 /* _UIB-CODE-BLOCK-END */
  57 &ANALYZE-RESUME
  58
  59 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD find-and-lock-queue-entry Procedure
  60 FUNCTION find-and-lock-queue-entry RETURNS RECID
  61   ( /* parameter-definitions */ )  FORWARD.
  62
  63 /* _UIB-CODE-BLOCK-END */
  64 &ANALYZE-RESUME
  65
  66 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD post-processing Procedure
  67 FUNCTION post-processing RETURNS LOGICAL
  68   ( /* parameter-definitions */ )  FORWARD.
  69
  70 /* _UIB-CODE-BLOCK-END */
  71 &ANALYZE-RESUME
  72
  73 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setup-processing Procedure
  74 FUNCTION setup-processing RETURNS LOGICAL
  75   ( /* parameter-definitions */ )  FORWARD.
  76
  77 /* _UIB-CODE-BLOCK-END */
  78 &ANALYZE-RESUME
  79
  80
  81 /* *********************** Procedure Settings ************************ */
  82
  83 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  84 /* Settings for THIS-PROCEDURE
  85    Type: Procedure
  86    Allow:
  87    Frames: 0
  88    Add Fields to: Neither
  89    Other Settings: CODE-ONLY COMPILE
  90  */
  91 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  92
  93 /* *************************  Create Window  ************************** */
  94
  95 &ANALYZE-SUSPEND _CREATE-WINDOW
  96 /* DESIGN Window definition (used by the UIB)
  97   CREATE WINDOW Procedure ASSIGN
  98          HEIGHT             = .25
  99          WIDTH              = 39.72.
 100 /* END WINDOW DEFINITION */
 101                                                                         */
 102 &ANALYZE-RESUME
 103
 104
 105
 106 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 107 /* ************************* Included-Libraries *********************** */
 108
 109 {inc/method/m-txtrep.i}
 110 {inc/method/m-logging.i}
 111
 112 /* _UIB-CODE-BLOCK-END */
 113 &ANALYZE-RESUME
 114
 115
 116
 117 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 118
 119
 120 /* ***************************  Main Block  *************************** */
 121
 122 setup-processing().
 123 RUN clean-queue.
 124
 125 RUN queue-loop.
 126
 127 post-processing().
 128
 129 QUIT.
 130
 131 /* _UIB-CODE-BLOCK-END */
 132 &ANALYZE-RESUME
 133
 134
 135 /* **********************  Internal Procedures  *********************** */
 136
 137 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apms-queue-manager Procedure
 138 PROCEDURE apms-queue-manager :
 139 /*------------------------------------------------------------------------------
 140   Purpose:  Identify this program as the APMS queue manager
 141 ------------------------------------------------------------------------------*/
 142
 143 END PROCEDURE.
 144
 145 /* _UIB-CODE-BLOCK-END */
 146 &ANALYZE-RESUME
 147
 148
 149 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apms-system-manager Procedure
 150 PROCEDURE apms-system-manager :
 151 /*------------------------------------------------------------------------------
 152   Purpose:  Pretend we are the APMS system manager, so that that functionality
 153             is still available to programs running on the batch queue.
 154 ------------------------------------------------------------------------------*/
 155
 156 END PROCEDURE.
 157
 158 /* _UIB-CODE-BLOCK-END */
 159 &ANALYZE-RESUME
 160
 161
 162 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE clean-queue Procedure
 163 PROCEDURE clean-queue :
 164 /*------------------------------------------------------------------------------
 165   Purpose:
 166 ------------------------------------------------------------------------------*/
 167   FOR EACH BatchQueue WHERE BatchQueue.RunStatus BEGINS "LOCK "
 168                         AND BatchQueue.StartedOn < (TODAY - 1)
 169                         EXCLUSIVE-LOCK:
 170     BatchQueue.RunStatus = "ABRT " + BatchQueue.RunStatus .
 171   END.
 172
 173   FOR EACH BatchQueue WHERE BatchQueue.RunStatus BEGINS "DONE"
 174                         AND BatchQueue.StartedOn < (TODAY - 190) EXCLUSIVE-LOCK:
 175     DELETE BatchQueue.
 176   END.
 177
 178   FOR EACH BatchQueue WHERE BatchQueue.RunStatus BEGINS "ABRT"
 179                         AND BatchQueue.StartedOn < (TODAY - 700) EXCLUSIVE-LOCK:
 180     DELETE BatchQueue.
 181   END.
 182
 183 END PROCEDURE.
 184
 185 /* _UIB-CODE-BLOCK-END */
 186 &ANALYZE-RESUME
 187
 188
 189 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-username Procedure
 190 PROCEDURE get-username :
 191 /*------------------------------------------------------------------------------
 192   Purpose:  Return the current username for the person requesting this job
 193 ------------------------------------------------------------------------------*/
 194 DEF OUTPUT PARAMETER name AS CHAR NO-UNDO.
 195   name = user-name.
 196 END PROCEDURE.
 197
 198 /* _UIB-CODE-BLOCK-END */
 199 &ANALYZE-RESUME
 200
 201
 202 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE post-process-queue-entry Procedure
 203 PROCEDURE post-process-queue-entry :
 204 /*------------------------------------------------------------------------------
 205   Purpose:
 206 ------------------------------------------------------------------------------*/
 207 DEF INPUT PARAMETER errors AS CHAR NO-UNDO.
 208
 209   DO TRANSACTION:
 210     FIND BatchQueue WHERE RECID(BatchQueue) = bq-recid EXCLUSIVE-LOCK.
 211     BatchQueue.RunDate   = TODAY.
 212     BatchQueue.RunTime   = TIME.
 213     BatchQueue.Elapsed   = ETIME.
 214     BatchQueue.RunStatus = (IF TRIM(errors) = "" THEN "DONE" ELSE "EROR") .
 215     FIND CURRENT BatchQueue NO-LOCK.
 216   END.
 217   log( 6, "Queue entry processed with final status '" + BatchQueue.RunStatus + "'" ).
 218
 219   user-name = queue-name.
 220
 221 END PROCEDURE.
 222
 223 /* _UIB-CODE-BLOCK-END */
 224 &ANALYZE-RESUME
 225
 226
 227 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pre-process-queue-entry Procedure
 228 PROCEDURE pre-process-queue-entry :
 229 /*------------------------------------------------------------------------------
 230   Purpose:
 231 ------------------------------------------------------------------------------*/
 232
 233   FIND BatchQueue WHERE RECID(BatchQueue) = bq-recid NO-LOCK.
 234   log( 6, "Processing queue entry").
 235   log( 6, BatchQueue.RunProgram).
 236   log( 6, REPLACE( BatchQueue.RunParameters, "~n", "~~n") ).
 237
 238   DO TRANSACTION:
 239     FIND CURRENT BatchQueue EXCLUSIVE-LOCK.
 240     BatchQueue.StartedOn = TODAY.
 241     BatchQueue.StartedAt = TIME.
 242     FIND CURRENT BatchQueue NO-LOCK.
 243   END.
 244
 245   user-name = BatchQueue.UserName.
 246
 247   ETIME( Yes ).  /* Reset elapsed time counter */
 248
 249 END PROCEDURE.
 250
 251 /* _UIB-CODE-BLOCK-END */
 252 &ANALYZE-RESUME
 253
 254
 255 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process-queue-entry Procedure
 256 PROCEDURE process-queue-entry :
 257 /*------------------------------------------------------------------------------
 258   Purpose:
 259 ------------------------------------------------------------------------------*/
 260 DEF VAR error-messages AS CHAR NO-UNDO INITIAL "".
 261 DEF VAR i AS INT NO-UNDO.
 262
 263   RUN pre-process-queue-entry.
 264
 265   OUTPUT TO VALUE(log-filename) KEEP-MESSAGES APPEND.
 266   RUN VALUE( BatchQueue.RunProgram ) ( BatchQueue.RunParameters ) NO-ERROR.
 267   OUTPUT CLOSE.
 268
 269   FIND BatchQueue WHERE RECID(BatchQueue) = bq-recid NO-LOCK NO-ERROR.
 270   IF ERROR-STATUS:ERROR THEN DO:
 271     log( 1, "Errors processing queue entry: ").
 272     log( 1, BatchQueue.RunProgram ).
 273     log( 1, BatchQueue.RunParameters ).
 274     DO i = 1 TO ERROR-STATUS:NUM-MESSAGES:
 275       error-messages = error-messages + "~n"
 276                      + STRING( ERROR-STATUS:GET-NUMBER(i), "->>>>>>9" ) + ": "
 277                      + ERROR-STATUS:GET-MESSAGE(i) .
 278       log( 1, "    " + STRING( ERROR-STATUS:GET-NUMBER(i), "->>>>>>9" ) + ": "
 279                      + ERROR-STATUS:GET-MESSAGE(i) ).
 280     END.
 281   END.
 282
 283   RUN post-process-queue-entry( error-messages ).
 284
 285 END PROCEDURE.
 286
 287 /* _UIB-CODE-BLOCK-END */
 288 &ANALYZE-RESUME
 289
 290
 291 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE queue-loop Procedure
 292 PROCEDURE queue-loop :
 293 /*------------------------------------------------------------------------------
 294   Purpose:  Main loop for processing batch queue entries
 295 ------------------------------------------------------------------------------*/
 296
 297 queue-loop:
 298   DO WHILE TRUE:
 299     IF NOT continue-processing() THEN LEAVE     /* will not be restarted */.
 300     bq-recid = find-and-lock-queue-entry().
 301     FIND BatchQueue WHERE RECID(BatchQueue) = bq-recid NO-LOCK NO-ERROR.
 302     IF AVAILABLE(BatchQueue) THEN
 303       RUN process-queue-entry.
 304     ELSE DO:
 305       RUN update-queue-enabled.
 306       PAUSE 5.
 307       IF last-today <> TODAY THEN QUIT.         /* will be restarted each day */
 308       IF TIME > start-time + 21600 THEN QUIT.   /* will be restarted every six hours */
 309     END.
 310   END.
 311
 312
 313 END PROCEDURE.
 314
 315 /* _UIB-CODE-BLOCK-END */
 316 &ANALYZE-RESUME
 317
 318
 319 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-queue-enabled Procedure
 320 PROCEDURE update-queue-enabled :
 321 /*------------------------------------------------------------------------------
 322   Purpose:
 323 ------------------------------------------------------------------------------*/
 324   DO TRANSACTION:
 325     FIND OfficeSetting OF Office WHERE OfficeSetting.SetName = "Batch-Queue-Enabled"
 326                                 EXCLUSIVE-LOCK NO-ERROR.
 327     IF NOT AVAILABLE(OfficeSetting) THEN DO:
 328       CREATE OfficeSetting.
 329       OfficeSettings.OfficeCode = Office.OfficeCode.
 330       OfficeSettings.SetName    = "Batch-Queue-Enabled".
 331     END.
 332     OfficeSettings.SetValue = STRING(TODAY,"99/99/9999") + " " + STRING(TIME).
 333     FIND CURRENT OfficeSetting NO-LOCK.
 334   END.
 335
 336 END PROCEDURE.
 337
 338 /* _UIB-CODE-BLOCK-END */
 339 &ANALYZE-RESUME
 340
 341
 342 /* ************************  Function Implementations ***************** */
 343
 344 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION continue-processing Procedure
 345 FUNCTION continue-processing RETURNS LOGICAL
 346   ( /* parameter-definitions */ ) :
 347 /*------------------------------------------------------------------------------
 348   Purpose:
 349     Because INPUT FROM doesn't accept a NO-ERROR option, and
 350     INPUT FROM OS-DIR has a memory leak, we have to do some
 351     really obscure stuff here!
 352
 353     First, we output to a log so that we catch the error message
 354     which INPUT FROM generates when the file doesn't exist, then
 355     we check to see if our seek position has changed.  If it has, then we
 356     assume it was because an error was written to the output stream.
 357
 358     Notes:
 359         We have to surround the INPUT FROM with a DO ON ERROR... because
 360         otherwise the function does an effective "RETURN ERROR".
 361
 362         We can't test ERROR-STATUS:ERROR after this because it seems to be
 363         always true(!).
 364
 365
 366 -----------------------------------------------------------------------------*/
 367 DEF VAR file-content AS CHAR NO-UNDO INITIAL ?.
 368 DEF VAR seekpos1 AS INT NO-UNDO.
 369 DEF VAR seekpos2 AS INT NO-UNDO.
 370
 371   OUTPUT TO VALUE(log-filename) KEEP-MESSAGES APPEND.
 372   seekpos1 = SEEK( OUTPUT ).
 373   DO ON ERROR UNDO, LEAVE:
 374     INPUT FROM VALUE( lock-filename ).
 375   END.
 376   seekpos2 = SEEK( OUTPUT ).
 377   OUTPUT CLOSE.
 378
 379   IF seekpos1 = seekpos2 THEN DO:
 380     IMPORT UNFORMATTED file-content NO-ERROR.
 381     INPUT CLOSE.
 382     IF NOT ERROR-STATUS:ERROR AND file-content <> "" AND file-content <> ? THEN RETURN Yes.
 383   END.
 384
 385   log( 1, "Lock file missing - terminating" ).
 386   log( 1, file-content).
 387   log( 1, STRING(seekpos1) + " now " + STRING(seekpos2)).
 388   RETURN No.
 389
 390 END FUNCTION.
 391
 392 /* _UIB-CODE-BLOCK-END */
 393 &ANALYZE-RESUME
 394
 395
 396 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION find-and-lock-queue-entry Procedure
 397 FUNCTION find-and-lock-queue-entry RETURNS RECID
 398   ( /* parameter-definitions */ ) :
 399 /*------------------------------------------------------------------------------
 400   Purpose:
 401     Notes:
 402 ------------------------------------------------------------------------------*/
 403 DEF VAR bq-recid AS RECID NO-UNDO INITIAL ?.
 404
 405   DO TRANSACTION:
 406     FIND FIRST BatchQueue WHERE BatchQueue.RunStatus = "TODO"
 407                           AND (BatchQueue.RunDate <= TODAY OR BatchQueue.RunDate = ?)
 408                           AND (BatchQueue.RunTime <= TIME  OR BatchQueue.RunTime = ?)
 409                           EXCLUSIVE-LOCK NO-ERROR.
 410     IF AVAILABLE(BatchQueue) THEN DO:
 411       BatchQueue.RunStatus = "LOCK "
 412                         + STRING( TODAY, "99/99/9999") + " "
 413                         + STRING( TIME, "HH:MM:SS") + " "
 414                         + queue-name.
 415       bq-recid = RECID(BatchQueue).
 416       log( 3, BatchQueue.RunStatus ).
 417     END.
 418   END.
 419
 420   RETURN bq-recid.
 421
 422 END FUNCTION.
 423
 424 /* _UIB-CODE-BLOCK-END */
 425 &ANALYZE-RESUME
 426
 427
 428 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION post-processing Procedure
 429 FUNCTION post-processing RETURNS LOGICAL
 430   ( /* parameter-definitions */ ) :
 431 /*------------------------------------------------------------------------------
 432   Purpose:
 433     Notes:
 434 ------------------------------------------------------------------------------*/
 435
 436   RETURN FALSE.   /* Function return value. */
 437
 438 END FUNCTION.
 439
 440 /* _UIB-CODE-BLOCK-END */
 441 &ANALYZE-RESUME
 442
 443
 444 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setup-processing Procedure
 445 FUNCTION setup-processing RETURNS LOGICAL
 446   ( /* parameter-definitions */ ) :
 447 /*------------------------------------------------------------------------------
 448   Purpose:
 449     Notes:
 450 ------------------------------------------------------------------------------*/
 451   last-today = TODAY.
 452   log-filename = SESSION:TEMP-DIRECTORY
 453                + STRING( YEAR(TODAY), "9999" ) + "-"
 454                + STRING( MONTH(TODAY), "99" ) + "-"
 455                + STRING( DAY(TODAY), "99" ) + "_"
 456                + user-name + ".LOG".
 457   lock-filename = SESSION:TEMP-DIRECTORY + user-name + ".LCK" .
 458   OUTPUT TO VALUE( lock-filename ) .
 459   PUT UNFORMATTED "Queue processing started at "
 460                     + STRING( TODAY, "99/99/9999") + " "
 461                     + STRING( TIME, "HH:MM:SS") SKIP.
 462   OUTPUT CLOSE.
 463
 464   log( 0, "APMS Queue Manager running" ).
 465
 466 DEF VAR wh AS WIDGET-HANDLE NO-UNDO.
 467   wh = SESSION:FIRST-CHILD.
 468   wh:PRIVATE-DATA = "apms-queue-manager," + STRING(THIS-PROCEDURE:HANDLE).
 469   wh:TITLE = "APMS Queue Manager".
 470
 471   RETURN ERROR-STATUS:ERROR.
 472
 473 END FUNCTION.
 474
 475 /* _UIB-CODE-BLOCK-END */
 476 &ANALYZE-RESUME
 477
 478