process/linkimpt.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5     File        : linkimpt.p
   6     Purpose     : Import a system update
   7     Description :
   8
   9     Author(s)   : Andrew McMillan
  10   ------------------------------------------------------------------------*/
  11 DEF INPUT PARAMETER process-options AS CHAR NO-UNDO.
  12
  13 DEF VAR preview AS LOGI NO-UNDO INITIAL No.
  14 DEF VAR restart AS LOGI NO-UNDO INITIAL No.
  15 DEF VAR update-zip AS LOGI NO-UNDO INITIAL No.
  16 DEF VAR update-file-name AS CHAR NO-UNDO INITIAL "../update.zip".
  17 DEF VAR update-menus AS LOGI NO-UNDO INITIAL No.
  18 DEF VAR compile-type AS CHAR NO-UNDO INITIAL "".
  19 DEF VAR program-list AS CHAR NO-UNDO INITIAL "".
  20
  21 DEF VAR out-basename AS CHAR NO-UNDO.
  22 DEF VAR out-filename AS CHAR NO-UNDO.
  23 DEF VAR database-update AS LOGICAL NO-UNDO      INITIAL No.
  24 DEF VAR conversions AS CHAR NO-UNDO             INITIAL "".
  25 DEF VAR delta-filename AS CHAR NO-UNDO          INITIAL "".
  26 RUN parse-parameters.
  27
  28 IF restart THEN DO:
  29   INPUT FROM update-in-progress.LCK.
  30   IMPORT UNFORMATTED out-basename.
  31   IMPORT UNFORMATTED process-options.
  32   INPUT CLOSE.
  33   process-options = "Restart~n" + process-options.
  34   RUN parse-parameters.
  35 END.
  36
  37 &GLOB LINK-DIR lnk
  38
  39
  40 DEF VAR user-name AS CHAR NO-UNDO.
  41 {inc/username.i "user-name"}
  42 DEF VAR replication-on AS LOGICAL NO-UNDO INITIAL No.
  43 IF CAN-FIND( FIRST _File-Trig WHERE _File-Trig._Event BEGINS "REPLICATION") THEN
  44   replication-on = Yes.
  45
  46 DEF VAR w1 AS WIDGET-HANDLE NO-UNDO.
  47 DEF VAR prev-window AS WIDGET-HANDLE NO-UNDO.
  48 DEF VAR pw-handle AS HANDLE NO-UNDO.
  49 DEF VAR pw-amount AS INTEGER NO-UNDO.
  50 DEF VAR disk-limit AS INTEGER NO-UNDO INITIAL 10000000.
  51 DEF VAR log-depth AS INTEGER NO-UNDO INITIAL 99.
  52 DEF VAR log-file AS CHAR NO-UNDO.
  53
  54 /* DEF VAR program-list AS CHAR NO-UNDO. */
  55 DEF VAR no-programs AS INTEGER NO-UNDO.
  56
  57 DEF VAR current-dir AS CHAR NO-UNDO.
  58
  59 DEFINE WORK-TABLE LN NO-UNDO LIKE LinkNode.
  60 DEFINE WORK-TABLE PL NO-UNDO LIKE ProgramLink.
  61 DEFINE WORK-TABLE UGRP NO-UNDO LIKE UsrGroup.
  62 DEFINE WORK-TABLE UGMN NO-UNDO LIKE UsrGroupMenu.
  63 DEFINE TEMP-TABLE UGMI NO-UNDO LIKE UsrGroupMenuItem.
  64 DEFINE WORK-TABLE UGRT NO-UNDO LIKE UsrGroupRights.
  65
  66 DEF VAR compile-errors AS INTEGER INITIAL 0 NO-UNDO.
  67
  68 DEF TEMP-TABLE ProgramList NO-UNDO
  69     FIELD ProgramName AS CHAR
  70     INDEX XPKProgramList IS UNIQUE PRIMARY ProgramName.
  71
  72 /* _UIB-CODE-BLOCK-END */
  73 &ANALYZE-RESUME
  74
  75
  76 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  77
  78 /* ********************  Preprocessor Definitions  ******************** */
  79
  80 &Scoped-define PROCEDURE-TYPE Procedure
  81 &Scoped-define DB-AWARE no
  82
  83
  84
  85 /* _UIB-PREPROCESSOR-BLOCK-END */
  86 &ANALYZE-RESUME
  87
  88
  89 /* ************************  Function Prototypes ********************** */
  90
  91 &IF DEFINED(EXCLUDE-disk-remaining) = 0 &THEN
  92
  93 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD disk-remaining Procedure
  94 FUNCTION disk-remaining RETURNS INTEGER
  95   ( /* no parameter-definitions */ )  FORWARD.
  96
  97 /* _UIB-CODE-BLOCK-END */
  98 &ANALYZE-RESUME
  99
 100 &ENDIF
 101
 102 &IF DEFINED(EXCLUDE-get-cwd) = 0 &THEN
 103
 104 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD get-cwd Procedure
 105 FUNCTION get-cwd RETURNS CHARACTER
 106   ( /* parameter-definitions */ )  FORWARD.
 107
 108 /* _UIB-CODE-BLOCK-END */
 109 &ANALYZE-RESUME
 110
 111 &ENDIF
 112
 113
 114 /* *********************** Procedure Settings ************************ */
 115
 116 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
 117 /* Settings for THIS-PROCEDURE
 118    Type: Procedure
 119    Allow:
 120    Frames: 0
 121    Add Fields to: Neither
 122    Other Settings: CODE-ONLY COMPILE
 123  */
 124 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
 125
 126 /* *************************  Create Window  ************************** */
 127
 128 &ANALYZE-SUSPEND _CREATE-WINDOW
 129 /* DESIGN Window definition (used by the UIB)
 130   CREATE WINDOW Procedure ASSIGN
 131          HEIGHT             = 20.95
 132          WIDTH              = 37.14.
 133 /* END WINDOW DEFINITION */
 134                                                                         */
 135 &ANALYZE-RESUME
 136
 137 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
 138 /* ************************* Included-Libraries *********************** */
 139
 140 {inc/method/m-txtrep.i}
 141
 142 /* _UIB-CODE-BLOCK-END */
 143 &ANALYZE-RESUME
 144
 145
 146
 147
 148
 149 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
 150
 151
 152 /* ***************************  Main Block  *************************** */
 153 RUN initialize.
 154 RUN apply-all-updates.
 155
 156 RUN log-current-settings.
 157
 158 IF preview THEN DO:
 159   IF compile-errors > 0 OR update-menus THEN DO:
 160     RUN view-output-file ( Yes ).
 161     OUTPUT TO "CLIPBOARD" KEEP-MESSAGES.
 162     WAIT-FOR WINDOW-CLOSE OF CURRENT-WINDOW .
 163     OUTPUT CLOSE.
 164   END.
 165   ELSE DO:
 166     MESSAGE "System Update Processing Complete" VIEW-AS ALERT-BOX INFORMATION.
 167   END.
 168 END.
 169 ELSE DO:
 170   IF compile-errors > 0 THEN
 171     MESSAGE compile-errors "errors occurred during compilation!" SKIP(2)
 172               "Please e-mail the following file to capital-helpdesk@catalyst.net.nz" SKIP
 173               "     '/" + "UPD" + out-basename + ".LOG'" SKIP(2)
 174               "Thanks"
 175               VIEW-AS ALERT-BOX ERROR TITLE "Errors In Update".
 176
 177   MESSAGE "System Components Updated" VIEW-AS ALERT-BOX INFORMATION.
 178 END.
 179
 180 IF update-menus THEN
 181   QUIT.  /* stop seems flakey under 8.2 */
 182 ELSE IF database-update THEN
 183   QUIT.
 184
 185 /* _UIB-CODE-BLOCK-END */
 186 &ANALYZE-RESUME
 187
 188
 189 /* **********************  Internal Procedures  *********************** */
 190
 191 &IF DEFINED(EXCLUDE-apply-all-updates) = 0 &THEN
 192
 193 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apply-all-updates Procedure
 194 PROCEDURE apply-all-updates :
 195 /*------------------------------------------------------------------------------
 196   Purpose:
 197 ------------------------------------------------------------------------------*/
 198 DEF VAR i AS INT NO-UNDO.
 199
 200   /* unpack the update zipfile */
 201   IF update-zip THEN RUN load-update.
 202
 203   /* lock the system, saving appropriate options for anyone else */
 204   OUTPUT TO update-in-progress.LCK .
 205   PUT UNFORMATTED out-basename SKIP.
 206   PUT UNFORMATTED process-options SKIP.
 207   OUTPUT CLOSE.
 208
 209   /* won't return from apply-delta, except through restart after the update */
 210   IF database-update AND NOT restart THEN RUN apply-delta.
 211
 212   /* compile programs where necessary */
 213   IF compile-type <> "" THEN RUN compile-programs.
 214
 215   /* run any conversion programs included in the update */
 216   IF conversions <> "" THEN DO:
 217     DO i = 1 TO NUM-ENTRIES( conversions ):
 218       OUTPUT TO VALUE(out-filename) KEEP-MESSAGES APPEND.
 219       RUN VALUE( ENTRY( i, conversions ) ) NO-ERROR.
 220       OUTPUT CLOSE.
 221     END.
 222   END.
 223
 224   /* unlock the system */
 225   OS-DELETE update-in-progress.LCK .
 226
 227   /* Update the menus */
 228   IF update-menus THEN RUN update-menus.
 229
 230 END PROCEDURE.
 231
 232 /* _UIB-CODE-BLOCK-END */
 233 &ANALYZE-RESUME
 234
 235 &ENDIF
 236
 237 &IF DEFINED(EXCLUDE-apply-delta) = 0 &THEN
 238
 239 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE apply-delta Procedure
 240 PROCEDURE apply-delta :
 241 /*------------------------------------------------------------------------------
 242   Purpose:  Apply the delta.df file
 243 ------------------------------------------------------------------------------*/
 244 DEF VAR i AS INT NO-UNDO.
 245 DEF VAR n AS INT NO-UNDO.
 246
 247   RUN progress-begin( "Preparing to apply database changes." ).
 248
 249   RUN progress-update( "Building program list.", 9 ).
 250   RUN process-dir( ".", "*").
 251
 252   RUN progress-update( "Removing r-code for all programs.", 9 ).
 253   RUN remove-r-code.
 254
 255   n = NUM-ENTRIES( delta-filename, "|" ) - 1.
 256   DO i = 1 TO n:
 257     RUN progress-update( "Applying database differences from " + ENTRY(i,delta-filename,"|"), 9).
 258     OUTPUT TO VALUE( out-filename ) KEEP-MESSAGES APPEND.
 259     DO:
 260       RUN prodict/load_df.r( ENTRY(i,delta-filename,"|") ).
 261     END.
 262     OUTPUT CLOSE.
 263   END.
 264
 265   RUN progress-update( "Cleaning up and restarting.", 9 ).
 266   OS-DELETE delta.df .
 267
 268   RUN progress-end.
 269   STOP.     /* should restart things */
 270
 271 END PROCEDURE.
 272
 273 /* _UIB-CODE-BLOCK-END */
 274 &ANALYZE-RESUME
 275
 276 &ENDIF
 277
 278 &IF DEFINED(EXCLUDE-clear-program-list) = 0 &THEN
 279
 280 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE clear-program-list Procedure
 281 PROCEDURE clear-program-list :
 282 /*------------------------------------------------------------------------------
 283   Purpose:
 284 ------------------------------------------------------------------------------*/
 285   FOR EACH ProgramList:     DELETE ProgramList.     END.
 286   no-programs = 0.
 287 END PROCEDURE.
 288
 289 /* _UIB-CODE-BLOCK-END */
 290 &ANALYZE-RESUME
 291
 292 &ENDIF
 293
 294 &IF DEFINED(EXCLUDE-compile-programs) = 0 &THEN
 295
 296 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE compile-programs Procedure
 297 PROCEDURE compile-programs :
 298 /*------------------------------------------------------------------------------
 299   Purpose:  Compile programs which arrived in the update.
 300 ------------------------------------------------------------------------------*/
 301 DEF VAR i AS INT NO-UNDO.
 302 DEF VAR prog-name AS CHAR NO-UNDO.
 303 DEF VAR r-name AS CHAR NO-UNDO.
 304 DEF VAR x-name AS CHAR NO-UNDO.
 305 DEF VAR last-pause AS INT NO-UNDO.
 306
 307   IF compile-type = "rest" OR compile-type = "all" THEN RUN process-dir( ".", "*" ).
 308
 309   RUN progress-begin( "Compiling " + STRING( no-programs ) + " Programs" ).
 310   IF NOT(compile-type = "rest" OR restart) THEN RUN remove-r-code.
 311
 312   last-pause = ETIME.
 313   i = 0.
 314   FOR EACH ProgramList:
 315     /* ASSIGN dr = disk-remaining() NO-ERROR.
 316     MESSAGE dr VIEW-AS ALERT-BOX;
 317     IF ((i MOD 5) = 0) AND dr < disk-limit THEN DO:
 318       OUTPUT TO VALUE( out-filename ) KEEP-MESSAGES APPEND.
 319       MESSAGE "Less than" disk-limit "temporary disk space remaining!" SKIP
 320               "Program will exit - please restart manually to continue." SKIP
 321               "compiling programs. (this works around a Progress bug)."
 322               VIEW-AS ALERT-BOX WARNING.
 323       OUTPUT CLOSE.
 324       QUIT.
 325     END.
 326     */
 327   DO TRANSACTION:
 328     i = i + 1.
 329     IF (ETIME - last-pause) > 10000 THEN DO:
 330       PAUSE 1 NO-MESSAGE.
 331       last-pause = ETIME.
 332     END.
 333     prog-name = ProgramList.ProgramName.
 334     r-name = SUBSTRING( prog-name, 1, LENGTH(prog-name) - 1) + "R".
 335     x-name = SUBSTRING( prog-name, 1, LENGTH(prog-name) - 1) + "X".
 336
 337     IF SEARCH( r-name ) = ? AND SEARCH( x-name ) = ? THEN DO:
 338       pw-amount = 5 + INTEGER( (i * 95) / no-programs ).
 339       RUN progress-update( prog-name, - pw-amount ).
 340
 341       IF preview THEN DO:
 342         OUTPUT TO VALUE( x-name ).
 343         OUTPUT CLOSE.
 344         OUTPUT TO VALUE( out-filename ) KEEP-MESSAGES APPEND.
 345         COMPILE VALUE( prog-name ) SAVE.
 346         IF COMPILER:ERROR OR COMPILER:WARNING THEN DO:
 347           compile-errors = compile-errors + 1.
 348           PUT SKIP(2).
 349         END.
 350         OUTPUT CLOSE.
 351         IF NOT(COMPILER:ERROR) THEN OS-DELETE VALUE( x-name ).
 352       END.
 353       ELSE DO:
 354         OUTPUT TO VALUE( x-name ).
 355         COMPILE VALUE( prog-name ) SAVE NO-ERROR.
 356         OUTPUT CLOSE.
 357         IF COMPILER:ERROR THEN DO:
 358           compile-errors = compile-errors + 1.
 359           RUN log( 6, "Error compiling " + prog-name + " - "
 360                 + COMPILER:FILENAME + " at line " + STRING( COMPILER:ERROR-ROW )
 361                 + " column " + STRING( COMPILER:ERROR-COL )).
 362           IF COMPILER:STOPPED THEN RUN log( 4, "Compilation stopped").
 363           OUTPUT TO VALUE( out-filename ) KEEP-MESSAGES APPEND.
 364           COMPILE VALUE( prog-name ) SAVE.
 365           PUT SKIP(2).
 366           OUTPUT CLOSE.
 367         END.
 368         ELSE IF COMPILER:WARNING THEN DO:
 369           OS-DELETE VALUE( x-name ).
 370           RUN log( 9, "Warning during compilation of " + prog-name + " - "
 371                         + COMPILER:FILENAME + " at line " + STRING( COMPILER:ERROR-ROW )
 372                         + " column " + STRING( COMPILER:ERROR-COL )).
 373           OUTPUT TO VALUE( out-filename ) KEEP-MESSAGES APPEND.
 374           COMPILE VALUE( prog-name ) SAVE.
 375           PUT SKIP(2).
 376           OUTPUT CLOSE.
 377         END.
 378         ELSE
 379           OS-DELETE VALUE( x-name ).
 380       END.
 381     END.
 382   END.  /* End the transaction */
 383   END.
 384   RUN progress-end.
 385
 386   IF compile-errors > 0 THEN
 387     RUN log( 1, TRIM(STRING( compile-errors )) + " programs failed to compile.").
 388
 389 END PROCEDURE.
 390
 391 /* _UIB-CODE-BLOCK-END */
 392 &ANALYZE-RESUME
 393
 394 &ENDIF
 395
 396 &IF DEFINED(EXCLUDE-initialize) = 0 &THEN
 397
 398 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initialize Procedure
 399 PROCEDURE initialize :
 400 /*------------------------------------------------------------------------------
 401   Purpose:
 402 ------------------------------------------------------------------------------*/
 403 DEF VAR i AS INT NO-UNDO.
 404 DEF VAR n AS INT NO-UNDO.
 405
 406   current-dir = get-cwd().
 407
 408   IF NOT(restart) THEN DO:
 409     out-basename = "-" + STRING(YEAR(TODAY)) + STRING(MONTH(TODAY), "99") + STRING(DAY(TODAY), "99")
 410                  + "-" + REPLACE( STRING( TIME, "HH:MM:SS"), ":", "") .
 411   END.
 412   out-filename = "../UPD" + out-basename + ".LOG" .
 413
 414   FIND UsrGroupMember WHERE UsrGroupMember.UserName = user-name
 415                         AND UsrGroupMember.GroupName = "Programmer"
 416                         NO-LOCK NO-ERROR.
 417   IF preview OR AVAILABLE(UsrGroupMember) THEN ASSIGN
 418     preview = Yes
 419     txtrep-print-file = out-filename.
 420
 421   IF compile-type = "List" THEN DO:
 422     n = NUM-ENTRIES( program-list, "~n").
 423     DO i = 1 TO n:
 424       RUN make-program-list( ENTRY( i, program-list, "~n") ).
 425     END.
 426   END.
 427
 428 END PROCEDURE.
 429
 430 /* _UIB-CODE-BLOCK-END */
 431 &ANALYZE-RESUME
 432
 433 &ENDIF
 434
 435 &IF DEFINED(EXCLUDE-load-update) = 0 &THEN
 436
 437 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE load-update Procedure
 438 PROCEDURE load-update :
 439 /*------------------------------------------------------------------------------
 440   Purpose:  Unzip the update file (in the root directory).
 441 ------------------------------------------------------------------------------*/
 442 DEF VAR import-line AS CHAR NO-UNDO.
 443 DEF VAR action AS CHAR NO-UNDO.
 444 DEF VAR file-name AS CHAR NO-UNDO.
 445 DEF VAR file-type AS CHAR NO-UNDO.
 446 DEF VAR full-path AS CHAR NO-UNDO.
 447 DEF VAR top-dir AS CHAR NO-UNDO.
 448 DEF VAR top-dir-len AS INT NO-UNDO.
 449 DEF VAR dot-pos AS INT NO-UNDO.
 450
 451   top-dir = REPLACE( current-dir, "~\", "/").
 452   top-dir = SUBSTRING( top-dir, R-INDEX(top-dir,"/") + 1).
 453   top-dir-len = LENGTH(top-dir).
 454
 455   IF update-zip THEN DO:
 456     OUTPUT TO update.bat KEEP-MESSAGES.
 457     PUT 'cd ..' SKIP.
 458     PUT 'REM pkunzip -do update >zip-out.txt' SKIP.
 459     PUT UNFORMATTED 'unzip -o ' update-file-name ' >zip-out.txt' SKIP.
 460     OUTPUT CLOSE.
 461
 462     OS-COMMAND SILENT update.bat .
 463 /*    OS-DELETE update.bat . */
 464   END.
 465
 466   INPUT FROM ../zip-out.txt .
 467   REPEAT TRANSACTION:
 468     IMPORT UNFORMATTED import-line.
 469     import-line = TRIM(import-line).
 470     RUN log( 4, "unzipping: " + import-line ).
 471     file-name = ENTRY( 2, import-line, ' ').
 472     full-path = SUBSTRING( file-name, top-dir-len + 2).
 473     dot-pos = R-INDEX( file-name, ".").
 474     file-type = (IF dot-pos > 0 THEN SUBSTRING( file-name, dot-pos ) ELSE "UNKNOWN").
 475     IF SUBSTRING( file-name, 1, top-dir-len) = top-dir
 476                      AND (file-type = ".p" OR file-type = ".w") THEN DO:
 477       FIND ProgramList WHERE ProgramList.ProgramName = full-path NO-ERROR.
 478       RUN log( 9, "Program to be compiled.").
 479       IF NOT AVAILABLE(ProgramList) THEN DO:
 480         CREATE ProgramList.
 481         ProgramList.ProgramName = full-path.
 482         no-programs = no-programs + 1.
 483       END.
 484       IF INDEX( full-path, "runme" ) > 0 THEN
 485         conversions = conversions + full-path + ",".
 486     END.
 487     ELSE IF SUBSTRING( file-name, 1, top-dir-len + 4) = top-dir + "/lnk" AND file-type = ".d" THEN DO:
 488       update-menus = yes.
 489       RUN log( 9, "Menu update: " + full-path ).
 490     END.
 491     ELSE IF SUBSTRING( file-name, 1, top-dir-len) = top-dir AND file-type = ".df" THEN DO:
 492       database-update = yes.
 493       delta-filename = delta-filename + full-path + "|".
 494       RUN log( 9, "Database update: " + delta-filename).
 495     END.
 496     ELSE
 497       RUN log( 15, "Line not relevant").
 498
 499   END.  /* REPEAT */
 500   INPUT CLOSE.
 501
 502   OS-DELETE ../zip-out.txt.
 503   OS-RENAME ../update.zip VALUE( "../upd" + out-basename + ".zip" ).
 504
 505   IF CAN-FIND( FIRST ProgramList ) THEN compile-type = "list".
 506
 507
 508 END PROCEDURE.
 509
 510 /* _UIB-CODE-BLOCK-END */
 511 &ANALYZE-RESUME
 512
 513 &ENDIF
 514
 515 &IF DEFINED(EXCLUDE-log) = 0 &THEN
 516
 517 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE log Procedure
 518 PROCEDURE log :
 519 /*------------------------------------------------------------------------------
 520   Purpose:  write output formatted as a log entry
 521 ------------------------------------------------------------------------------*/
 522 DEF INPUT PARAMETER depth AS INT NO-UNDO.
 523 DEF INPUT PARAMETER entry-text AS CHAR NO-UNDO.
 524
 525   IF depth > log-depth THEN RETURN.
 526   OUTPUT TO VALUE(out-filename) KEEP-MESSAGES APPEND.
 527   PUT UNFORMATTED STRING( YEAR(TODAY), "9999") + "-" + STRING( MONTH(TODAY), "99") + "-" + STRING( DAY(TODAY), "99")
 528                   + " " + STRING( TIME, "HH:MM:SS")
 529                   + " " + STRING( depth, ">>9")
 530                   + " " entry-text
 531                   SKIP.
 532   OUTPUT CLOSE.
 533
 534 END PROCEDURE.
 535
 536 /* _UIB-CODE-BLOCK-END */
 537 &ANALYZE-RESUME
 538
 539 &ENDIF
 540
 541 &IF DEFINED(EXCLUDE-log-current-settings) = 0 &THEN
 542
 543 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE log-current-settings Procedure
 544 PROCEDURE log-current-settings :
 545 /*------------------------------------------------------------------------------
 546   Purpose:
 547 ------------------------------------------------------------------------------*/
 548 DO TRANSACTION:
 549   FIND Office WHERE Office.ThisOffice NO-LOCK NO-ERROR.
 550   IF NOT AVAILABLE(Office) THEN DO:
 551     RUN log( 0, "No current office set!!!" ).
 552     RETURN.
 553   END.
 554   RUN log( 1, "Office: " + Office.OfficeCode + " - " + Office.Name ).
 555   RUN log( 2, "OfficeGST: " + STRING(Office.GST) + " - " + STRING( Office.GSTNo) ).
 556   RUN log( 2, "Address: " + REPLACE( REPLACE( Office.StreetAddress, "~r", "~~r"), "~n", "~~n") ).
 557
 558   RUN log( 9, "Office Control Accounts:" ).
 559   FOR EACH OfficeControlAccount OF Office NO-LOCK:
 560     RUN log( 9, "Name: " + STRING(OfficeControlAccount.Name, "X(14)")
 561                 + (IF OfficeControlAccount.EntityType <> ? THEN OfficeControlAccount.EntityType ELSE "?")
 562                 + "-" + (IF OfficeControlAccount.EntityCode <> ? THEN STRING( OfficeControlAccount.EntityCode, "99999") ELSE "?????")
 563                 + "-" + (IF OfficeControlAccount.AccountCode <> ? THEN STRING( OfficeControlAccount.AccountCode, "9999.99") ELSE "????.??")
 564                 + " " + OfficeControlAccount.Description ).
 565   END.
 566
 567   RUN log( 9, "Office Settings:" ).
 568   FOR EACH OfficeSetting OF Office NO-LOCK:
 569     RUN log( 9, "Setting: >>" + OfficeSetting.SetName + "<<" ).
 570     RUN log( 9, ">>" + OfficeSetting.SetValue + "<<" ).
 571   END.
 572 END.
 573 END PROCEDURE.
 574
 575 /* _UIB-CODE-BLOCK-END */
 576 &ANALYZE-RESUME
 577
 578 &ENDIF
 579
 580 &IF DEFINED(EXCLUDE-make-program-list) = 0 &THEN
 581
 582 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE make-program-list Procedure
 583 PROCEDURE make-program-list :
 584 /*------------------------------------------------------------------------------
 585   Purpose:
 586 ------------------------------------------------------------------------------*/
 587 DEF INPUT PARAMETER wild-spec AS CHAR NO-UNDO.
 588
 589 DEF VAR first-bit AS CHAR NO-UNDO.
 590 DEF VAR path-bit AS CHAR NO-UNDO.
 591 DEF VAR wild-bit AS CHAR NO-UNDO.
 592
 593 DEF VAR splitter AS CHAR NO-UNDO INITIAL "~\".
 594 IF OPSYS = "UNIX" THEN splitter = "/".
 595
 596 DEF VAR wild-spot   AS INT NO-UNDO.
 597 DEF VAR first-split AS INT NO-UNDO.
 598 DEF VAR last-split  AS INT NO-UNDO.
 599
 600 DEF VAR end-of-list AS INT NO-UNDO.
 601
 602   IF TRIM( wild-spec ) = "" THEN RETURN.
 603   IF INDEX( wild-spec, splitter ) = 0 THEN
 604     wild-spec = REPLACE( wild-spec, "/", splitter).
 605
 606   first-split = INDEX( wild-spec, splitter).
 607   last-split  = R-INDEX( wild-spec, splitter).
 608   wild-spot   = MAXIMUM( INDEX( wild-spec, "*", MAXIMUM(last-split, 1)),
 609                          INDEX( wild-spec, "?", MAXIMUM(last-split, 1)),
 610                          INDEX( wild-spec, ".", MAXIMUM(last-split, 1)) ).
 611
 612   IF wild-spot <> 0 AND first-split <> 0 THEN ASSIGN
 613     path-bit = SUBSTR( wild-spec, 1, last-split - 1)
 614     wild-bit = SUBSTR( wild-spec, last-split + 1).
 615   ELSE IF first-split <> 0 THEN ASSIGN
 616     path-bit = wild-spec
 617     wild-bit = "*" .
 618   ELSE IF wild-spot <> 0 THEN ASSIGN
 619     path-bit = ""
 620     wild-bit = wild-spec.
 621
 622   first-bit = SUBSTR( path-bit, 1, 1).
 623   IF first-bit = splitter THEN path-bit = "." + path-bit.
 624   ELSE IF first-bit <> "." THEN path-bit = "." + splitter + path-bit.
 625   IF path-bit = ("." + splitter) THEN path-bit = ".".
 626
 627   wild-bit = REPLACE( wild-bit, ".", "~~.").
 628   wild-bit = REPLACE( wild-bit, "?", ".").
 629
 630   RUN log( 12, "Parsed >>" + wild-spec + "<< into >>" + path-bit + "<< and >>" + wild-bit + "<<" ).
 631   RUN process-dir( path-bit, wild-bit ).
 632   RUN log( 12, STRING(no-programs) + " programs to compile").
 633
 634 END PROCEDURE.
 635
 636 /* _UIB-CODE-BLOCK-END */
 637 &ANALYZE-RESUME
 638
 639 &ENDIF
 640
 641 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
 642
 643 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 644 PROCEDURE parse-parameters :
 645 /*------------------------------------------------------------------------------
 646   Purpose:
 647 ------------------------------------------------------------------------------*/
 648 DEF VAR token AS CHAR NO-UNDO.
 649 DEF VAR i AS INT NO-UNDO.
 650 DEF VAR n AS INT NO-UNDO.
 651 DEF VAR use-program-list AS LOGI NO-UNDO INITIAL No.
 652
 653 {inc/showopts.i "process-options"}
 654
 655   n =  NUM-ENTRIES( process-options, "~n" ).
 656   DO i = 1 TO n:
 657     token = ENTRY( i, process-options, "~n" ).
 658     IF use-program-list THEN
 659       program-list = program-list + token + "~n".
 660     ELSE DO:
 661       CASE ENTRY( 1, token ):
 662         WHEN "Preview" THEN               preview = Yes.
 663         WHEN "UpdateMenus" THEN           update-menus = Yes.
 664         WHEN "Compile" THEN               compile-type = ENTRY(2,token).
 665         WHEN "Restart" THEN               restart = Yes.
 666         WHEN "ProgramList" THEN           use-program-list = Yes.
 667
 668         WHEN "UpdateFile" THEN ASSIGN
 669           update-zip = Yes
 670           update-file-name = SUBSTRING( token, INDEX(token,",") + 1).
 671
 672       END CASE.
 673     END.
 674
 675   END.
 676
 677 END PROCEDURE.
 678
 679 /* _UIB-CODE-BLOCK-END */
 680 &ANALYZE-RESUME
 681
 682 &ENDIF
 683
 684 &IF DEFINED(EXCLUDE-process-dir) = 0 &THEN
 685
 686 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process-dir Procedure
 687 PROCEDURE process-dir :
 688 /*------------------------------------------------------------------------------
 689   Purpose:  Create ProgramList records for programs in a directory
 690 ------------------------------------------------------------------------------*/
 691 DEF INPUT PARAMETER path AS CHAR FORMAT "X(30)" NO-UNDO.
 692 DEF INPUT PARAMETER spec AS CHAR NO-UNDO.
 693
 694 DEF VAR r-name AS CHAR NO-UNDO.
 695 DEF VAR file-name AS CHAR NO-UNDO.
 696 DEF VAR full-path AS CHAR NO-UNDO.
 697 DEF VAR file-type AS CHAR NO-UNDO.
 698
 699 DEF VAR dir-list AS CHAR INITIAL "" NO-UNDO.
 700 DEF VAR no-dirs AS INT NO-UNDO.
 701 DEF VAR i AS INT NO-UNDO.
 702
 703 DEF VAR keep-at-it AS LOGICAL INITIAL yes NO-UNDO.
 704
 705   INPUT FROM OS-DIR( path ) .
 706   REPEAT:
 707     IMPORT file-name full-path file-type.
 708     file-type = SUBSTRING( file-type, 1, 1).
 709     IF SUBSTRING( file-name, 1, 1) = "." THEN NEXT. /* skip ., .., ... etc. */
 710     IF replication-on = No AND file-name MATCHES "*rplctn*" THEN NEXT.
 711     CASE file-type:
 712       WHEN "D" THEN DO:
 713         dir-list = dir-list + (IF dir-list = "" THEN "" ELSE ",") + path + "/" + file-name.
 714       END.
 715       WHEN "F" THEN DO:
 716         full-path = SUBSTRING( file-name, MAX(1, LENGTH(file-name) - 1), 2).
 717         IF file-name MATCHES spec AND (full-path = ".P" OR full-path = ".W") THEN DO:
 718           full-path = path + '/' + file-name.
 719           FIND ProgramList WHERE ProgramList.ProgramName = full-path NO-ERROR.
 720           IF NOT AVAILABLE(ProgramList) THEN DO:
 721             r-name = SUBSTRING( full-path, 1, LENGTH(full-path) - 1) + "R".
 722             IF compile-type <> "rest" OR SEARCH( r-name ) = ? THEN DO TRANSACTION:
 723               CREATE ProgramList.
 724               ProgramList.ProgramName = full-path.
 725               no-programs = no-programs + 1.
 726             END.
 727           END.
 728         END.
 729         ELSE IF full-path = ".X" THEN DO:
 730           OS-DELETE VALUE( path + '/' + file-name ).
 731         END.
 732       END.
 733     END CASE.
 734   END.
 735
 736   INPUT CLOSE.
 737
 738   no-dirs = NUM-ENTRIES( dir-list ).
 739   DO i = 1 TO no-dirs:
 740     full-path = ENTRY( i, dir-list).
 741     RUN process-dir( full-path, spec ).
 742   END.
 743
 744 END PROCEDURE.
 745
 746 /* _UIB-CODE-BLOCK-END */
 747 &ANALYZE-RESUME
 748
 749 &ENDIF
 750
 751 &IF DEFINED(EXCLUDE-progress-begin) = 0 &THEN
 752
 753 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE progress-begin Procedure
 754 PROCEDURE progress-begin :
 755 /*------------------------------------------------------------------------------
 756   Purpose:
 757 ------------------------------------------------------------------------------*/
 758 DEF INPUT PARAMETER title-text AS CHAR NO-UNDO.
 759
 760   CREATE WINDOW w1
 761     ASSIGN  TITLE = title-text
 762             WIDTH-CHARS = 80
 763             HEIGHT-CHARS = 11
 764             STATUS-AREA = no
 765             MESSAGE-AREA = no.
 766
 767   prev-window = CURRENT-WINDOW.
 768   CURRENT-WINDOW = w1.
 769
 770   RUN win/w-prgmsg.w PERSISTENT SET pw-handle.
 771   RUN dispatch IN pw-handle ( 'initialize':U ).
 772   RUN set-title IN pw-handle ( title-text ).
 773   pw-amount = 0.
 774
 775   RUN log( 5, title-text ).
 776
 777 END PROCEDURE.
 778
 779 /* _UIB-CODE-BLOCK-END */
 780 &ANALYZE-RESUME
 781
 782 &ENDIF
 783
 784 &IF DEFINED(EXCLUDE-progress-end) = 0 &THEN
 785
 786 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE progress-end Procedure
 787 PROCEDURE progress-end :
 788 /*------------------------------------------------------------------------------
 789   Purpose:
 790 ------------------------------------------------------------------------------*/
 791   RUN log( 3, w1:TITLE + " - Processing Complete").
 792   RUN dispatch IN pw-handle ( 'destroy':U ).
 793   CURRENT-WINDOW = prev-window.
 794   DELETE WIDGET w1.
 795
 796 END PROCEDURE.
 797
 798 /* _UIB-CODE-BLOCK-END */
 799 &ANALYZE-RESUME
 800
 801 &ENDIF
 802
 803 &IF DEFINED(EXCLUDE-progress-update) = 0 &THEN
 804
 805 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE progress-update Procedure
 806 PROCEDURE progress-update :
 807 /*------------------------------------------------------------------------------
 808   Purpose:
 809 ------------------------------------------------------------------------------*/
 810 DEF INPUT PARAMETER description AS CHAR NO-UNDO.
 811 DEF INPUT PARAMETER increment AS INT NO-UNDO.
 812
 813   IF increment < 0 THEN pw-amount = - increment. ELSE pw-amount = pw-amount + increment.
 814   RUN update-details IN pw-handle( description, pw-amount ).
 815   RUN log( 5, description ).
 816
 817 END PROCEDURE.
 818
 819 /* _UIB-CODE-BLOCK-END */
 820 &ANALYZE-RESUME
 821
 822 &ENDIF
 823
 824 &IF DEFINED(EXCLUDE-remove-r-code) = 0 &THEN
 825
 826 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE remove-r-code Procedure
 827 PROCEDURE remove-r-code :
 828 /*------------------------------------------------------------------------------
 829   Purpose:
 830   Parameters:  <none>
 831   Notes:
 832 ------------------------------------------------------------------------------*/
 833 DEF VAR last-amount AS INT NO-UNDO INITIAL -9999.
 834 DEF VAR pw-amount AS INT NO-UNDO.
 835 DEF VAR i AS INT NO-UNDO.
 836 DEF VAR r-name AS CHAR NO-UNDO.
 837 DEF VAR prog-name AS CHAR NO-UNDO.
 838
 839   /* remove existing r-code */
 840   i = 0.
 841   FOR EACH ProgramList:
 842   DO TRANSACTION:
 843     i = i + 1.
 844     pw-amount = INTEGER( (i * 5) / no-programs ).
 845     IF pw-amount <> last-amount THEN DO:
 846       RUN progress-update( "Removing existing r-code", 1 ).
 847       last-amount = pw-amount.
 848     END.
 849
 850     prog-name = ProgramList.ProgramName.
 851     r-name = SUBSTRING( prog-name, 1, LENGTH(prog-name) - 1) + "R".
 852     OS-DELETE VALUE( r-name ).
 853   END.
 854   END.
 855
 856 END PROCEDURE.
 857
 858 /* _UIB-CODE-BLOCK-END */
 859 &ANALYZE-RESUME
 860
 861 &ENDIF
 862
 863 &IF DEFINED(EXCLUDE-update-group-items) = 0 &THEN
 864
 865 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-group-items Procedure
 866 PROCEDURE update-group-items :
 867 /*------------------------------------------------------------------------------
 868   Purpose:
 869 ------------------------------------------------------------------------------*/
 870 DEF VAR i AS INT NO-UNDO.
 871 DEF VAR cmp-result AS LOGICAL NO-UNDO.
 872
 873   DO TRANSACTION:
 874     RUN progress-update( "Loading User Group Menu Items", 1 ).
 875     INPUT FROM {&LINK-DIR}/UsrGrpMi.d.
 876     i = 0.
 877     REPEAT:       i = i + 1.      CREATE UGMI.    IMPORT UGMI.    END.
 878     INPUT CLOSE.
 879     DELETE UGMI.    /* table is NO-UNDO. */
 880     RUN log( 35, STRING( i ) + " records loaded." ).
 881   END.
 882
 883   RUN progress-update( "Reconstructing User Group Menu Items", 6).
 884   FOR EACH UsrGroupMenuItem BY UsrGroupMenuItem.LinkCode TRANSACTION:
 885     FIND FIRST UGMI WHERE UGMI.LinkCode = UsrGroupMenuItem.LinkCode
 886                     AND UGMI.MenuName = UsrGroupMenuItem.MenuName
 887                     AND UGMI.GroupName = UsrGroupMenuItem.GroupName NO-ERROR.
 888     IF AVAILABLE(UGMI) THEN DO:
 889       BUFFER-COMPARE UsrGroupMenuItem TO UGMI SAVE cmp-result.
 890       IF NOT(cmp-result) THEN DO:
 891         BUFFER-COPY UGMI TO UsrGroupMenuItem.
 892         RUN log( 25, "Changing user group menu " + STRING( UsrGroupMenuItem.LinkCode ) + " - "
 893                     + UsrGroupMenuItem.GroupName + ", "
 894                     + UsrGroupMenuItem.MenuName + ", "
 895                     + UsrGroupMenuItem.ButtonLabel ).
 896       END.
 897       DELETE UGMI.
 898     END.
 899     ELSE DO:
 900       RUN log( 25, "Deleting user group menu " + STRING( UsrGroupMenuItem.LinkCode ) + " - "
 901                     + UsrGroupMenuItem.GroupName + ", "
 902                     + UsrGroupMenuItem.MenuName + ", "
 903                     + UsrGroupMenuItem.ButtonLabel ).
 904       DELETE UsrGroupMenuItem.
 905     END.
 906   END.
 907
 908   RUN progress-update("Creating new User Group Menu Items", 17).
 909   FOR EACH UGMI TRANSACTION:
 910     CREATE UsrGroupMenuItem.
 911     BUFFER-COPY UGMI TO UsrGroupMenuItem.
 912     RUN log( 25, "Creating user group menu " + STRING( UsrGroupMenuItem.LinkCode ) + " - "
 913                     + UsrGroupMenuItem.GroupName + ", "
 914                     + UsrGroupMenuItem.MenuName + ", "
 915                     + UsrGroupMenuItem.ButtonLabel ).
 916   END.
 917
 918   RUN progress-update( "User/Group Menu Items update complete", 4).
 919
 920 END PROCEDURE.
 921
 922 /* _UIB-CODE-BLOCK-END */
 923 &ANALYZE-RESUME
 924
 925 &ENDIF
 926
 927 &IF DEFINED(EXCLUDE-update-group-menus) = 0 &THEN
 928
 929 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-group-menus Procedure
 930 PROCEDURE update-group-menus :
 931 /*------------------------------------------------------------------------------
 932   Purpose:
 933 ------------------------------------------------------------------------------*/
 934 DEF VAR i AS INT NO-UNDO.
 935 DEF VAR cmp-result AS LOGICAL NO-UNDO.
 936
 937   DO TRANSACTION:
 938     RUN progress-update( "Loading User Group Menus", 1 ).
 939     INPUT FROM {&LINK-DIR}/UsrGrpMn.d.
 940     i = 0.
 941     REPEAT:       i = i + 1.      CREATE UGMN.    IMPORT UGMN.    END.
 942     INPUT CLOSE.
 943     DELETE UGMN.    /* table is NO-UNDO. */
 944     RUN log( 35, STRING( i ) + " records loaded." ).
 945   END.
 946
 947   RUN progress-update( "Reconstructing User Group Menus", 2).
 948   FOR EACH UsrGroupMenu TRANSACTION:
 949     FIND FIRST UGMN WHERE UGMN.NodeCode = UsrGroupMenu.NodeCode
 950                     AND UGMN.MenuName = UsrGroupMenu.MenuName
 951                     AND UGMN.GroupName = UsrGroupMenu.GroupName NO-ERROR.
 952     IF AVAILABLE(UGMN) THEN DO:
 953       BUFFER-COMPARE UsrGroupMenu TO UGMN SAVE cmp-result.
 954       IF NOT(cmp-result) THEN DO:
 955         BUFFER-COPY UGMN TO UsrGroupMenu.
 956         RUN log( 25, "Changing user group menu " + STRING( UsrGroupMenu.NodeCode ) + " - "
 957                     + UsrGroupMenu.GroupName + ", " + UsrGroupMenu.MenuName ).
 958       END.
 959       DELETE UGMN.
 960     END.
 961     ELSE DO:
 962       RUN log( 25, "Deleting user group menu " + STRING( UsrGroupMenu.NodeCode ) + " - "
 963                     + UsrGroupMenu.GroupName + ", " + UsrGroupMenu.MenuName ).
 964       DELETE UsrGroupMenu.
 965     END.
 966   END.
 967
 968   RUN progress-update("Creating new User Group Menus", 9).
 969   FOR EACH UGMN TRANSACTION:
 970     CREATE UsrGroupMenu.
 971     BUFFER-COPY UGMN TO UsrGroupMenu.
 972     RUN log( 25, "Creating user group menu " + STRING( UsrGroupMenu.NodeCode ) + " - "
 973                     + UsrGroupMenu.GroupName + ", " + UsrGroupMenu.MenuName ).
 974   END.
 975
 976   RUN progress-update( "User/Group Menus update complete", 3).
 977
 978 END PROCEDURE.
 979
 980 /* _UIB-CODE-BLOCK-END */
 981 &ANALYZE-RESUME
 982
 983 &ENDIF
 984
 985 &IF DEFINED(EXCLUDE-update-group-rights) = 0 &THEN
 986
 987 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-group-rights Procedure
 988 PROCEDURE update-group-rights :
 989 /*------------------------------------------------------------------------------
 990   Purpose:
 991 ------------------------------------------------------------------------------*/
 992 DEF VAR i AS INT NO-UNDO.
 993 DEF VAR cmp-result AS LOGICAL NO-UNDO.
 994
 995   DO TRANSACTION:
 996     RUN progress-update( "Loading User Group Rights", 1 ).
 997     INPUT FROM {&LINK-DIR}/UGRights.d.
 998     i = 0.
 999     REPEAT:       i = i + 1.      CREATE UGRT.    IMPORT UGRT.    END.
1000     INPUT CLOSE.
1001     DELETE UGRT.    /* table is NO-UNDO. */
1002     RUN log( 35, STRING( i ) + " records loaded." ).
1003   END.
1004
1005   RUN progress-update( "Reconstructing User Group Rights", 2).
1006   FOR EACH UsrGroupRights TRANSACTION:
1007     FIND FIRST UGRT WHERE UGRT.GroupName = UsrGroupRights.GroupName
1008                     AND UGRT.ApplicationCode = UsrGroupRights.ApplicationCode
1009                     AND UGRT.Action = UsrGroupRights.Action NO-ERROR.
1010     IF AVAILABLE(UGRT) THEN DO:
1011       BUFFER-COMPARE UsrGroupRights TO UGRT SAVE cmp-result.
1012       IF NOT(cmp-result) THEN DO:
1013         BUFFER-COPY UGRT TO UsrGroupRights.
1014         RUN log( 15, "Changing user group right " + STRING( UsrGroupRights.GroupName ) + " - "
1015                     + UsrGroupRights.ApplicationCode + ", " + UsrGroupRights.Action
1016                     + ": " + STRING( UsrGroupRights.Rights )).
1017       END.
1018       DELETE UGRT.
1019     END.
1020     ELSE DO:
1021       RUN log( 15, "Deleting user group right " + STRING( UsrGroupRights.GroupName ) + " - "
1022                     + UsrGroupRights.ApplicationCode + ", " + UsrGroupRights.Action
1023                     + ": " + STRING( UsrGroupRights.Rights )).
1024       DELETE UsrGroupRights.
1025     END.
1026   END.
1027
1028   RUN progress-update("Creating new User Group Rights", 6).
1029   FOR EACH UGRT TRANSACTION:
1030     CREATE UsrGroupRights.
1031     BUFFER-COPY UGRT TO UsrGroupRights.
1032     RUN log( 15, "Creating user group right " + STRING( UsrGroupRights.GroupName ) + " - "
1033                     + UsrGroupRights.ApplicationCode + ", " + UsrGroupRights.Action
1034                     + ": " + STRING( UsrGroupRights.Rights )).
1035   END.
1036
1037   RUN progress-update( "User Group Rights update complete", 4).
1038
1039 END PROCEDURE.
1040
1041 /* _UIB-CODE-BLOCK-END */
1042 &ANALYZE-RESUME
1043
1044 &ENDIF
1045
1046 &IF DEFINED(EXCLUDE-update-groups) = 0 &THEN
1047
1048 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-groups Procedure
1049 PROCEDURE update-groups :
1050 /*------------------------------------------------------------------------------
1051   Purpose:
1052 ------------------------------------------------------------------------------*/
1053 DEF VAR i AS INT NO-UNDO.
1054 DEF VAR cmp-result AS LOGICAL NO-UNDO.
1055
1056   DO TRANSACTION:
1057     RUN progress-update( "Loading User Groups", 1 ).
1058     INPUT FROM {&LINK-DIR}/UsrGroup.d.
1059     i = 0.
1060     REPEAT:       i = i + 1.      CREATE UGRP.    IMPORT UGRP.    END.
1061     INPUT CLOSE.
1062     DELETE UGRP.    /* table is NO-UNDO. */
1063     RUN log( 35, STRING( i ) + " records loaded." ).
1064   END.
1065
1066   RUN progress-update( "Reconstructing User Groups", 2).
1067   FOR EACH UsrGroup TRANSACTION:
1068     FIND FIRST UGRP WHERE UGRP.GroupName = UsrGroup.GroupName NO-ERROR.
1069     IF AVAILABLE(UGRP) THEN DO:
1070       BUFFER-COMPARE UsrGroup TO UGRP SAVE cmp-result.
1071       IF NOT(cmp-result) THEN DO:
1072         RUN log( 15, "Changing user group " + STRING( UsrGroup.GroupName ) + " - "
1073                     + UsrGroup.Description + ", " + STRING(UsrGroup.Sequence) ).
1074         BUFFER-COPY UGRP TO UsrGroup.
1075         RUN log( 15, "Changed to: " + STRING( UsrGroup.GroupName ) + " - "
1076                     + UsrGroup.Description + ", " + STRING(UsrGroup.Sequence) ).
1077       END.
1078       DELETE UGRP.
1079     END.
1080     ELSE DO:
1081       RUN log( 15, "Deleting user group " + STRING( UsrGroup.GroupName ) + " - "
1082                     + UsrGroup.Description + ", " + STRING(UsrGroup.Sequence) ).
1083       DELETE UsrGroup.
1084     END.
1085   END.
1086
1087   RUN progress-update("Creating new User Groups", 3).
1088   FOR EACH UGRP TRANSACTION:
1089     CREATE UsrGroup.
1090     BUFFER-COPY UGRP TO UsrGroup.
1091     RUN log( 15, "Creating user group " + STRING( UsrGroup.GroupName ) + " - "
1092                     + UsrGroup.Description + ", " + STRING(UsrGroup.Sequence) ).
1093   END.
1094
1095   RUN progress-update( "User Groups update complete", 2).
1096
1097 END PROCEDURE.
1098
1099 /* _UIB-CODE-BLOCK-END */
1100 &ANALYZE-RESUME
1101
1102 &ENDIF
1103
1104 &IF DEFINED(EXCLUDE-update-link-tables) = 0 &THEN
1105
1106 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-link-tables Procedure
1107 PROCEDURE update-link-tables :
1108 /*------------------------------------------------------------------------------
1109   Purpose:
1110 ------------------------------------------------------------------------------*/
1111 DEF VAR i AS INT NO-UNDO.
1112 DEF VAR cmp-result AS LOGICAL NO-UNDO.
1113
1114   DO TRANSACTION:
1115     RUN progress-update( "Loading Link Nodes", 1 ).
1116     INPUT FROM {&LINK-DIR}/linknode.d.
1117     i = 0.
1118     REPEAT:       i = i + 1.      CREATE LN.      IMPORT LN.      END.
1119     INPUT CLOSE.
1120     DELETE LN.    /* table is NO-UNDO. */
1121     RUN log( 35, STRING( i ) + " records loaded." ).
1122   END.
1123
1124   RUN progress-update( "Applying Link Node changes", 3 ).
1125   FOR EACH LinkNode TRANSACTION:
1126     FIND FIRST LN WHERE LN.NodeCode = LinkNode.NodeCode NO-ERROR.
1127     IF AVAILABLE(LN) THEN DO:
1128       BUFFER-COMPARE LinkNode TO LN SAVE cmp-result.
1129       IF NOT(cmp-result) THEN DO:
1130         BUFFER-COPY LN TO LinkNode.
1131         RUN log( 25, "Changing LinkNode " + STRING( LinkNode.NodeCode ) + ": "
1132                     + LinkNode.NodeType + ", " + LinkNode.Description ).
1133       END.
1134       DELETE LN.
1135     END.
1136     ELSE DO:
1137       RUN log( 25, "Deleting node " + STRING( LinkNode.NodeCode ) + ": "
1138                     + LinkNode.NodeType + ", " + LinkNode.Description ).
1139       DELETE LinkNode.
1140     END.
1141   END.
1142
1143   RUN progress-update( "Creating new link nodes", 7 ).
1144   FOR EACH LN:
1145     CREATE LinkNode.
1146     BUFFER-COPY LN TO LinkNode.
1147     RUN log( 25, "Creating LinkNode " + STRING( LinkNode.NodeCode ) + ": "
1148                     + LinkNode.NodeType + ", " + LinkNode.Description ).
1149   END.
1150
1151
1152   RUN progress-update( "Loading Program Links", 2 ).
1153   INPUT FROM {&LINK-DIR}/ProgramL.d.
1154   i = 0.
1155   REPEAT:       i = i + 1.      CREATE PL.      IMPORT PL.      END.
1156   INPUT CLOSE.
1157   DELETE PL.    /* table is NO-UNDO. */
1158   RUN log( 35, STRING( i ) + " records loaded." ).
1159
1160   RUN progress-update( "Applying Program Link changes", 4 ).
1161   FOR EACH ProgramLink:
1162     FIND FIRST PL WHERE PL.LinkCode = ProgramLink.LinkCode NO-ERROR.
1163     IF AVAILABLE(PL) THEN DO:
1164       BUFFER-COMPARE ProgramLink TO PL SAVE cmp-result.
1165       IF NOT(cmp-result) THEN DO:
1166         BUFFER-COPY PL TO ProgramLink.
1167         RUN log( 25, "Changing node " + STRING( ProgramLink.LinkCode ) + ": "
1168                     + ProgramLink.LinkType + ", "
1169                     + ProgramLink.ButtonLabel + ", "
1170                     + ProgramLink.Description ).
1171       END.
1172       DELETE PL.
1173     END.
1174     ELSE DO:
1175       RUN log( 25, "Deleting node " + STRING( ProgramLink.LinkCode ) + ": "
1176                     + ProgramLink.LinkType + ", "
1177                     + ProgramLink.ButtonLabel + ", "
1178                     + ProgramLink.Description ).
1179       DELETE ProgramLink.
1180     END.
1181   END.
1182
1183   RUN progress-update( "Creating new Program Links", 15 ).
1184   FOR EACH PL:
1185     CREATE ProgramLink.
1186     BUFFER-COPY PL TO ProgramLink.
1187     RUN log( 25, "Creating programlink " + STRING( ProgramLink.LinkCode ) + ": "
1188                     + ProgramLink.LinkType + ", "
1189                     + ProgramLink.ButtonLabel + ", "
1190                     + ProgramLink.Description ).
1191   END.
1192   RUN progress-update( "Link Tables Update Complete", 3 ).
1193
1194 END PROCEDURE.
1195
1196 /* _UIB-CODE-BLOCK-END */
1197 &ANALYZE-RESUME
1198
1199 &ENDIF
1200
1201 &IF DEFINED(EXCLUDE-update-menus) = 0 &THEN
1202
1203 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE update-menus Procedure
1204 PROCEDURE update-menus :
1205 /*------------------------------------------------------------------------------
1206   Purpose:  Update the menu details
1207 ------------------------------------------------------------------------------*/
1208   RUN progress-begin( "Rebuilding Menus" ).
1209
1210   RUN update-link-tables.
1211   RUN update-groups.
1212   RUN update-group-rights.
1213   RUN update-group-menus.
1214   RUN update-group-items.
1215
1216   PAUSE 1 NO-MESSAGE.
1217   RUN progress-end.
1218
1219 END PROCEDURE.
1220
1221 /* _UIB-CODE-BLOCK-END */
1222 &ANALYZE-RESUME
1223
1224 &ENDIF
1225
1226 /* ************************  Function Implementations ***************** */
1227
1228 &IF DEFINED(EXCLUDE-disk-remaining) = 0 &THEN
1229
1230 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION disk-remaining Procedure
1231 FUNCTION disk-remaining RETURNS INTEGER
1232   ( /* no parameter-definitions */ ) :
1233 /*------------------------------------------------------------------------------
1234   Purpose:  Return the amount of free disk on the temp drive
1235     Notes:
1236 ------------------------------------------------------------------------------*/
1237 DEF VAR in-line AS CHAR NO-UNDO.
1238 DEF VAR result AS INT NO-UNDO.
1239 DEF VAR pos AS INT NO-UNDO.
1240
1241   OS-COMMAND SILENT VALUE('DIR "' + SESSION:TEMP-DIRECTORY + '" >"' + SESSION:TEMP-DIRECTORY + '/DSKRMN.TXT"').
1242
1243   INPUT FROM VALUE(SESSION:TEMP-DIRECTORY + '/DSKRMN.TXT').
1244   REPEAT:
1245     IMPORT UNFORMATTED in-line.
1246     pos = INDEX( in-line, "bytes free").
1247     IF pos > 0 THEN DO:
1248       in-line = TRIM( SUBSTRING(in-line, 1, pos - 1)).
1249       in-line = ENTRY( NUM-ENTRIES(in-line," "), in-line, " ").
1250       in-line = REPLACE(in-line, ",", "").
1251       INPUT CLOSE.
1252       RETURN INT(in-line).
1253     END.
1254   END.
1255
1256   INPUT CLOSE.
1257
1258   RETURN ?.
1259
1260 END FUNCTION.
1261
1262 /* _UIB-CODE-BLOCK-END */
1263 &ANALYZE-RESUME
1264
1265 &ENDIF
1266
1267 &IF DEFINED(EXCLUDE-get-cwd) = 0 &THEN
1268
1269 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION get-cwd Procedure
1270 FUNCTION get-cwd RETURNS CHARACTER
1271   ( /* parameter-definitions */ ) :
1272 /*------------------------------------------------------------------------------
1273   Purpose:
1274     Notes:
1275 ------------------------------------------------------------------------------*/
1276 DEF VAR temp-batfile AS CHAR NO-UNDO.
1277 DEF VAR current-dir AS CHAR NO-UNDO.
1278
1279   temp-batfile = "getcwd.bat".
1280   OUTPUT TO VALUE(temp-batfile) KEEP-MESSAGES.
1281   PUT UNFORMATTED 'cd >' + 'this-dir.txt' SKIP.
1282   OUTPUT CLOSE.
1283
1284   OS-COMMAND SILENT VALUE(temp-batfile).
1285
1286   INPUT FROM this-dir.txt.
1287   IMPORT UNFORMATTED current-dir.
1288   INPUT CLOSE.
1289
1290   OS-DELETE this-dir.txt.
1291   OS-DELETE VALUE(temp-batfile).
1292
1293   RETURN current-dir.
1294
1295 END FUNCTION.
1296
1297 /* _UIB-CODE-BLOCK-END */
1298 &ANALYZE-RESUME
1299
1300 &ENDIF
1301