process/bq-processor.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 &Scoped-define DB-AWARE no
  44
  45
  46
  47 /* _UIB-PREPROCESSOR-BLOCK-END */
  48 &ANALYZE-RESUME
  49
  50
  51 /* ************************  Function Prototypes ********************** */
  52
  53 &IF DEFINED(EXCLUDE-continue-processing) = 0 &THEN
  54
  55 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD continue-processing Procedure
  56 FUNCTION continue-processing RETURNS LOGICAL
  57   ( /* parameter-definitions */ )  FORWARD.
  58
  59 /* _UIB-CODE-BLOCK-END */
  60 &ANALYZE-RESUME
  61
  62 &ENDIF
  63
  64 &IF DEFINED(EXCLUDE-find-and-lock-queue-entry) = 0 &THEN
  65
  66 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD find-and-lock-queue-entry Procedure
  67 FUNCTION find-and-lock-queue-entry RETURNS RECID
  68   ( /* parameter-definitions */ )  FORWARD.
  69
  70 /* _UIB-CODE-BLOCK-END */
  71 &ANALYZE-RESUME
  72
  73 &ENDIF
  74
  75 &IF DEFINED(EXCLUDE-post-processing) = 0 &THEN
  76
  77 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD post-processing Procedure
  78 FUNCTION post-processing RETURNS LOGICAL
  79   ( /* parameter-definitions */ )  FORWARD.
  80
  81 /* _UIB-CODE-BLOCK-END */
  82 &ANALYZE-RESUME
  83
  84 &ENDIF
  85
  86 &IF DEFINED(EXCLUDE-setup-processing) = 0 &THEN
  87
  88 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setup-processing Procedure
  89 FUNCTION setup-processing RETURNS LOGICAL
  90   ( /* parameter-definitions */ )  FORWARD.
  91
  92 /* _UIB-CODE-BLOCK-END */
  93 &ANALYZE-RESUME
  94
  95 &ENDIF
  96
  97
  98 /* *********************** Procedure Settings ************************ */
  99
 100 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 101 /* Settings for THIS-PROCEDURE
 102    Type: Procedure
 103    Allow:
 104    Frames: 0
 105    Add Fields to: Neither
 106    Other Settings: CODE-ONLY COMPILE
 107  */
 108 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 109
 110 /* *************************  Create Window  ************************** */
 111
 112 &ANALYZE-SUSPEND _CREATE-WINDOW
 113 /* DESIGN Window definition (used by the UIB)
 114   CREATE WINDOW Procedure ASSIGN
 115          HEIGHT             = 20.35
 116          WIDTH              = 39.72.
 117 /* END WINDOW DEFINITION */
 118                                                                         */
 119 &ANALYZE-RESUME
 120
 121 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 122 /* ************************* Included-Libraries *********************** */
 123
 124 {inc/method/m-txtrep.i}
 125 {inc/method/m-logging.i}
 126
 127 /* _UIB-CODE-BLOCK-END */
 128 &ANALYZE-RESUME
 129
 130
 131
 132
 133
 134 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 135
 136
 137 /* ***************************  Main Block  *************************** */
 138
 139 setup-processing().
 140 RUN clean-queue.
 141
 142 RUN queue-loop.
 143
 144 post-processing().
 145
 146 QUIT.
 147
 148 /* _UIB-CODE-BLOCK-END */
 149 &ANALYZE-RESUME
 150
 151
 152 /* **********************  Internal Procedures  *********************** */
 153
 154 &IF DEFINED(EXCLUDE-apms-queue-manager) = 0 &THEN
 155
 156 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apms-queue-manager Procedure
 157 PROCEDURE apms-queue-manager :
 158 /*------------------------------------------------------------------------------
 159   Purpose:  Identify this program as the APMS queue manager
 160 ------------------------------------------------------------------------------*/
 161
 162 END PROCEDURE.
 163
 164 /* _UIB-CODE-BLOCK-END */
 165 &ANALYZE-RESUME
 166
 167 &ENDIF
 168
 169 &IF DEFINED(EXCLUDE-apms-system-manager) = 0 &THEN
 170
 171 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apms-system-manager Procedure
 172 PROCEDURE apms-system-manager :
 173 /*------------------------------------------------------------------------------
 174   Purpose:  Pretend we are the APMS system manager, so that that functionality
 175             is still available to programs running on the batch queue.
 176 ------------------------------------------------------------------------------*/
 177
 178 END PROCEDURE.
 179
 180 /* _UIB-CODE-BLOCK-END */
 181 &ANALYZE-RESUME
 182
 183 &ENDIF
 184
 185 &IF DEFINED(EXCLUDE-clean-queue) = 0 &THEN
 186
 187 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE clean-queue Procedure
 188 PROCEDURE clean-queue :
 189 /*------------------------------------------------------------------------------
 190   Purpose:
 191 ------------------------------------------------------------------------------*/
 192   FOR EACH BatchQueue WHERE BatchQueue.RunStatus BEGINS "LOCK "
 193                         AND BatchQueue.StartedOn < (TODAY - 1)
 194                         EXCLUSIVE-LOCK:
 195     BatchQueue.RunStatus = "ABRT " + BatchQueue.RunStatus .
 196   END.
 197
 198   FOR EACH BatchQueue WHERE BatchQueue.RunStatus BEGINS "DONE"
 199                         AND BatchQueue.StartedOn < (TODAY - 190) EXCLUSIVE-LOCK:
 200     DELETE BatchQueue.
 201   END.
 202
 203   FOR EACH BatchQueue WHERE BatchQueue.RunStatus BEGINS "ABRT"
 204                         AND BatchQueue.StartedOn < (TODAY - 700) EXCLUSIVE-LOCK:
 205     DELETE BatchQueue.
 206   END.
 207
 208 END PROCEDURE.
 209
 210 /* _UIB-CODE-BLOCK-END */
 211 &ANALYZE-RESUME
 212
 213 &ENDIF
 214
 215 &IF DEFINED(EXCLUDE-get-username) = 0 &THEN
 216
 217 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE get-username Procedure
 218 PROCEDURE get-username :
 219 /*------------------------------------------------------------------------------
 220   Purpose:  Return the current username for the person requesting this job
 221 ------------------------------------------------------------------------------*/
 222 DEF OUTPUT PARAMETER name AS CHAR NO-UNDO.
 223   name = user-name.
 224   /* log( 3, "Running report for " + user-name ). */
 225 END PROCEDURE.
 226
 227 /* _UIB-CODE-BLOCK-END */
 228 &ANALYZE-RESUME
 229
 230 &ENDIF
 231
 232 &IF DEFINED(EXCLUDE-post-process-queue-entry) = 0 &THEN
 233
 234 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE post-process-queue-entry Procedure
 235 PROCEDURE post-process-queue-entry :
 236 /*------------------------------------------------------------------------------
 237   Purpose:
 238 ------------------------------------------------------------------------------*/
 239 DEF INPUT PARAMETER errors AS CHAR NO-UNDO.
 240
 241   DO TRANSACTION:
 242     FIND BatchQueue WHERE RECID(BatchQueue) = bq-recid EXCLUSIVE-LOCK.
 243     BatchQueue.RunDate   = TODAY.
 244     BatchQueue.RunTime   = TIME.
 245     BatchQueue.Elapsed   = ETIME.
 246     BatchQueue.RunStatus = (IF TRIM(errors) = "" THEN "DONE" ELSE "EROR") .
 247     FIND CURRENT BatchQueue NO-LOCK.
 248   END.
 249   log( 6, "Queue entry processed with final status '" + BatchQueue.RunStatus + "'" ).
 250
 251   user-name = queue-name.
 252
 253 END PROCEDURE.
 254
 255 /* _UIB-CODE-BLOCK-END */
 256 &ANALYZE-RESUME
 257
 258 &ENDIF
 259
 260 &IF DEFINED(EXCLUDE-pre-process-queue-entry) = 0 &THEN
 261
 262 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pre-process-queue-entry Procedure
 263 PROCEDURE pre-process-queue-entry :
 264 /*------------------------------------------------------------------------------
 265   Purpose:
 266 ------------------------------------------------------------------------------*/
 267
 268   FIND BatchQueue WHERE RECID(BatchQueue) = bq-recid NO-LOCK.
 269   log( 6, "Processing queue entry").
 270   log( 6, BatchQueue.RunProgram).
 271   log( 6, REPLACE( BatchQueue.RunParameters, "~n", "~~n") ).
 272
 273   DO TRANSACTION:
 274     FIND CURRENT BatchQueue EXCLUSIVE-LOCK.
 275     BatchQueue.StartedOn = TODAY.
 276     BatchQueue.StartedAt = TIME.
 277     FIND CURRENT BatchQueue NO-LOCK.
 278   END.
 279
 280   user-name = BatchQueue.UserName.
 281
 282   ETIME( Yes ).  /* Reset elapsed time counter */
 283
 284 END PROCEDURE.
 285
 286 /* _UIB-CODE-BLOCK-END */
 287 &ANALYZE-RESUME
 288
 289 &ENDIF
 290
 291 &IF DEFINED(EXCLUDE-process-queue-entry) = 0 &THEN
 292
 293 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process-queue-entry Procedure
 294 PROCEDURE process-queue-entry :
 295 /*------------------------------------------------------------------------------
 296   Purpose:
 297 ------------------------------------------------------------------------------*/
 298 DEF VAR error-messages AS CHAR NO-UNDO INITIAL "".
 299 DEF VAR i AS INT NO-UNDO.
 300
 301   RUN pre-process-queue-entry.
 302
 303   OUTPUT TO VALUE(log-filename) KEEP-MESSAGES APPEND.
 304   RUN VALUE( BatchQueue.RunProgram ) ( BatchQueue.RunParameters ) NO-ERROR.
 305   OUTPUT CLOSE.
 306
 307   FIND BatchQueue WHERE RECID(BatchQueue) = bq-recid NO-LOCK NO-ERROR.
 308   IF ERROR-STATUS:ERROR THEN DO:
 309     log( 1, "Errors processing queue entry: ").
 310     log( 1, BatchQueue.RunProgram ).
 311     log( 1, BatchQueue.RunParameters ).
 312     DO i = 1 TO ERROR-STATUS:NUM-MESSAGES:
 313       error-messages = error-messages + "~n"
 314                      + STRING( ERROR-STATUS:GET-NUMBER(i), "->>>>>>9" ) + ": "
 315                      + ERROR-STATUS:GET-MESSAGE(i) .
 316       log( 1, "    " + STRING( ERROR-STATUS:GET-NUMBER(i), "->>>>>>9" ) + ": "
 317                      + ERROR-STATUS:GET-MESSAGE(i) ).
 318     END.
 319   END.
 320
 321   RUN post-process-queue-entry( error-messages ).
 322
 323 END PROCEDURE.
 324
 325 /* _UIB-CODE-BLOCK-END */
 326 &ANALYZE-RESUME
 327
 328 &ENDIF
 329
 330 &IF DEFINED(EXCLUDE-queue-loop) = 0 &THEN
 331
 332 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE queue-loop Procedure
 333 PROCEDURE queue-loop :
 334 /*------------------------------------------------------------------------------
 335   Purpose:  Main loop for processing batch queue entries
 336 ------------------------------------------------------------------------------*/
 337
 338 queue-loop:
 339   DO WHILE TRUE:
 340     IF NOT continue-processing() THEN LEAVE     /* will not be restarted */.
 341     bq-recid = find-and-lock-queue-entry().
 342     FIND BatchQueue WHERE RECID(BatchQueue) = bq-recid NO-LOCK NO-ERROR.
 343     IF AVAILABLE(BatchQueue) THEN
 344       RUN process-queue-entry.
 345     ELSE DO:
 346       RUN update-queue-enabled.
 347       PAUSE 5.
 348       IF last-today <> TODAY THEN QUIT.         /* will be restarted each day */
 349       IF TIME > start-time + 21600 THEN QUIT.   /* will be restarted every six hours */
 350     END.
 351   END.
 352
 353
 354 END PROCEDURE.
 355
 356 /* _UIB-CODE-BLOCK-END */
 357 &ANALYZE-RESUME
 358
 359 &ENDIF
 360
 361 &IF DEFINED(EXCLUDE-update-queue-enabled) = 0 &THEN
 362
 363 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-queue-enabled Procedure
 364 PROCEDURE update-queue-enabled :
 365 /*------------------------------------------------------------------------------
 366   Purpose:
 367 ------------------------------------------------------------------------------*/
 368   DO TRANSACTION:
 369     FIND OfficeSetting OF Office WHERE OfficeSetting.SetName = "Batch-Queue-Enabled"
 370                                 EXCLUSIVE-LOCK NO-ERROR.
 371     IF NOT AVAILABLE(OfficeSetting) THEN DO:
 372       CREATE OfficeSetting.
 373       OfficeSettings.OfficeCode = Office.OfficeCode.
 374       OfficeSettings.SetName    = "Batch-Queue-Enabled".
 375     END.
 376     OfficeSettings.SetValue = STRING(TODAY,"99/99/9999") + " " + STRING(TIME).
 377     FIND CURRENT OfficeSetting NO-LOCK.
 378   END.
 379
 380 END PROCEDURE.
 381
 382 /* _UIB-CODE-BLOCK-END */
 383 &ANALYZE-RESUME
 384
 385 &ENDIF
 386
 387 /* ************************  Function Implementations ***************** */
 388
 389 &IF DEFINED(EXCLUDE-continue-processing) = 0 &THEN
 390
 391 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION continue-processing Procedure
 392 FUNCTION continue-processing RETURNS LOGICAL
 393   ( /* parameter-definitions */ ) :
 394 /*------------------------------------------------------------------------------
 395   Purpose:
 396     Because INPUT FROM doesn't accept a NO-ERROR option, and
 397     INPUT FROM OS-DIR has a memory leak, we have to do some
 398     really obscure stuff here!
 399
 400     First, we output to a log so that we catch the error message
 401     which INPUT FROM generates when the file doesn't exist, then
 402     we check to see if our seek position has changed.  If it has, then we
 403     assume it was because an error was written to the output stream.
 404
 405     Notes:
 406         We have to surround the INPUT FROM with a DO ON ERROR... because
 407         otherwise the function does an effective "RETURN ERROR".
 408
 409         We can't test ERROR-STATUS:ERROR after this because it seems to be
 410         always true(!).
 411
 412
 413 -----------------------------------------------------------------------------*/
 414 DEF VAR file-content AS CHAR NO-UNDO INITIAL ?.
 415 DEF VAR seekpos1 AS INT NO-UNDO.
 416 DEF VAR seekpos2 AS INT NO-UNDO.
 417
 418   OUTPUT TO VALUE(log-filename) KEEP-MESSAGES APPEND.
 419   seekpos1 = SEEK( OUTPUT ).
 420   DO ON ERROR UNDO, LEAVE:
 421     INPUT FROM VALUE( lock-filename ).
 422   END.
 423   seekpos2 = SEEK( OUTPUT ).
 424   OUTPUT CLOSE.
 425
 426   IF seekpos1 = seekpos2 THEN DO:
 427     IMPORT UNFORMATTED file-content NO-ERROR.
 428     INPUT CLOSE.
 429     IF NOT ERROR-STATUS:ERROR AND file-content <> "" AND file-content <> ? THEN RETURN Yes.
 430   END.
 431
 432   log( 1, "Lock file missing - terminating" ).
 433   log( 1, file-content).
 434   log( 1, STRING(seekpos1) + " now " + STRING(seekpos2)).
 435   RETURN No.
 436
 437 END FUNCTION.
 438
 439 /* _UIB-CODE-BLOCK-END */
 440 &ANALYZE-RESUME
 441
 442 &ENDIF
 443
 444 &IF DEFINED(EXCLUDE-find-and-lock-queue-entry) = 0 &THEN
 445
 446 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION find-and-lock-queue-entry Procedure
 447 FUNCTION find-and-lock-queue-entry RETURNS RECID
 448   ( /* parameter-definitions */ ) :
 449 /*------------------------------------------------------------------------------
 450   Purpose:
 451     Notes:
 452 ------------------------------------------------------------------------------*/
 453 DEF VAR bq-recid AS RECID NO-UNDO INITIAL ?.
 454
 455   DO TRANSACTION:
 456     FIND FIRST BatchQueue WHERE BatchQueue.RunStatus = "TODO"
 457                           AND (BatchQueue.RunDate <= TODAY OR BatchQueue.RunDate = ?)
 458                           AND (BatchQueue.RunTime <= TIME  OR BatchQueue.RunTime = ?)
 459                           EXCLUSIVE-LOCK NO-ERROR.
 460     IF AVAILABLE(BatchQueue) THEN DO:
 461       BatchQueue.RunStatus = "LOCK "
 462                         + STRING( TODAY, "99/99/9999") + " "
 463                         + STRING( TIME, "HH:MM:SS") + " "
 464                         + queue-name.
 465       bq-recid = RECID(BatchQueue).
 466       log( 3, BatchQueue.RunStatus ).
 467     END.
 468   END.
 469
 470   RETURN bq-recid.
 471
 472 END FUNCTION.
 473
 474 /* _UIB-CODE-BLOCK-END */
 475 &ANALYZE-RESUME
 476
 477 &ENDIF
 478
 479 &IF DEFINED(EXCLUDE-post-processing) = 0 &THEN
 480
 481 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION post-processing Procedure
 482 FUNCTION post-processing RETURNS LOGICAL
 483   ( /* parameter-definitions */ ) :
 484 /*------------------------------------------------------------------------------
 485   Purpose:
 486     Notes:
 487 ------------------------------------------------------------------------------*/
 488
 489   RETURN FALSE.   /* Function return value. */
 490
 491 END FUNCTION.
 492
 493 /* _UIB-CODE-BLOCK-END */
 494 &ANALYZE-RESUME
 495
 496 &ENDIF
 497
 498 &IF DEFINED(EXCLUDE-setup-processing) = 0 &THEN
 499
 500 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setup-processing Procedure
 501 FUNCTION setup-processing RETURNS LOGICAL
 502   ( /* parameter-definitions */ ) :
 503 /*------------------------------------------------------------------------------
 504   Purpose:
 505     Notes:
 506 ------------------------------------------------------------------------------*/
 507   last-today = TODAY.
 508   log-filename = SESSION:TEMP-DIRECTORY
 509                + STRING( YEAR(TODAY), "9999" ) + "-"
 510                + STRING( MONTH(TODAY), "99" ) + "-"
 511                + STRING( DAY(TODAY), "99" ) + "_"
 512                + user-name + ".LOG".
 513   lock-filename = SESSION:TEMP-DIRECTORY + user-name + ".LCK" .
 514   OUTPUT TO VALUE( lock-filename ) .
 515   PUT UNFORMATTED "Queue processing started at "
 516                     + STRING( TODAY, "99/99/9999") + " "
 517                     + STRING( TIME, "HH:MM:SS") SKIP.
 518   OUTPUT CLOSE.
 519
 520   log( 0, "APMS Queue Manager running" ).
 521
 522   DEF VAR wh AS WIDGET-HANDLE NO-UNDO.
 523   SESSION:CONTEXT-HELP-FILE = STRING(THIS-PROCEDURE).
 524
 525   wh = SESSION:FIRST-CHILD.
 526   IF VALID-HANDLE(wh) THEN DO:
 527     wh:PRIVATE-DATA = "apms-queue-manager," + STRING(THIS-PROCEDURE:HANDLE).
 528
 529     /* Pointless to set the title on Linux since we really do background */
 530     IF OPSYS EQ "UNIX" THEN DO:
 531       UNIX SILENT "apms_bq_handle
 532     END.
 533     ELSE DO:
 534       wh:TITLE = "APMS Queue Manager".
 535     END.
 536   END.
 537
 538
 539 &IF DEFINED(BQ-MGR) &THEN
 540   log( 1, "BQ-MGR is defined" ).
 541   IF VALID-HANDLE(bq-mgr) THEN DO:
 542     DEF VAR xx AS CHAR INITIAL 'no such user'.
 543     RUN get-username IN bq-mgr ( OUTPUT xx ).
 544     log( 3, "Report user is " + xx ).
 545   END.
 546 &ENDIF
 547
 548 &IF DEFINED(SYS-MGR) &THEN
 549   log( 1, "SYS-MGR is defined" ).
 550 &ENDIF
 551
 552   RETURN ERROR-STATUS:ERROR.
 553
 554 END FUNCTION.
 555
 556 /* _UIB-CODE-BLOCK-END */
 557 &ANALYZE-RESUME
 558
 559 &ENDIF
 560