process/loadusrs.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5     File        : process/loadusrs.p
   6     Purpose     : Reload local user files after a copy from another site
   7   ------------------------------------------------------------------------*/
   8
   9 DEF VAR file-list AS CHAR NO-UNDO.
  10 file-list = "usr.d,usrgrpmm.d".
  11
  12 DEF VAR this-office  AS CHAR NO-UNDO     INITIAL "".
  13 DEF VAR prefix       AS CHAR NO-UNDO     INITIAL "".
  14 DEF VAR cur-printer  AS CHAR NO-UNDO     INITIAL "".
  15 DEF VAR cur-port     AS CHAR NO-UNDO     INITIAL "".
  16 DEF VAR collision-detect AS LOGI NO-UNDO INITIAL No.
  17 DEF VAR override-rules AS LOGI NO-UNDO   INITIAL No.
  18 DEF VAR batch-mode AS LOGICAL NO-UNDO.
  19 DEF VAR debug-mode AS LOGICAL NO-UNDO INITIAL Yes.
  20
  21 {inc/ofc-this.i}
  22 DEF VAR old-office-code AS CHAR NO-UNDO.
  23 old-office-code = Office.OfficeCode.
  24
  25 RUN parse-parameters.
  26
  27 DEFINE STREAM debug-stream.
  28
  29 /* _UIB-CODE-BLOCK-END */
  30 &ANALYZE-RESUME
  31
  32
  33 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  34
  35 /* ********************  Preprocessor Definitions  ******************** */
  36
  37 &Scoped-define PROCEDURE-TYPE Procedure
  38 &Scoped-define DB-AWARE no
  39
  40
  41
  42 /* _UIB-PREPROCESSOR-BLOCK-END */
  43 &ANALYZE-RESUME
  44
  45
  46 /* ************************  Function Prototypes ********************** */
  47
  48 &IF DEFINED(EXCLUDE-debug-event) = 0 &THEN
  49
  50 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD debug-event Procedure
  51 FUNCTION debug-event RETURNS CHARACTER
  52   ( INPUT event-text AS CHAR )  FORWARD.
  53
  54 /* _UIB-CODE-BLOCK-END */
  55 &ANALYZE-RESUME
  56
  57 &ENDIF
  58
  59
  60 /* *********************** Procedure Settings ************************ */
  61
  62 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  63 /* Settings for THIS-PROCEDURE
  64    Type: Procedure
  65    Allow:
  66    Frames: 0
  67    Add Fields to: Neither
  68    Other Settings: CODE-ONLY COMPILE
  69  */
  70 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  71
  72 /* *************************  Create Window  ************************** */
  73
  74 &ANALYZE-SUSPEND _CREATE-WINDOW
  75 /* DESIGN Window definition (used by the UIB)
  76   CREATE WINDOW Procedure ASSIGN
  77          HEIGHT             = 25.05
  78          WIDTH              = 40.
  79 /* END WINDOW DEFINITION */
  80                                                                         */
  81 &ANALYZE-RESUME
  82
  83
  84
  85
  86 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  87
  88
  89 /* ***************************  Main Block  *************************** */
  90
  91 debug-event("Starting").
  92
  93 RUN load-local-users.
  94 RUN copy-office.
  95 RUN reset-printers.
  96 RUN set-replication.
  97
  98 debug-event("Finished").
  99
 100 /* _UIB-CODE-BLOCK-END */
 101 &ANALYZE-RESUME
 102
 103
 104 /* **********************  Internal Procedures  *********************** */
 105
 106 &IF DEFINED(EXCLUDE-copy-office) = 0 &THEN
 107
 108 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE copy-office Procedure
 109 PROCEDURE copy-office :
 110 /*------------------------------------------------------------------------------
 111   Purpose:
 112 ------------------------------------------------------------------------------*/
 113   IF this-office = "" THEN RETURN.
 114
 115 DEF BUFFER old-office FOR Office.
 116 DEF BUFFER old-setting FOR OfficeSetting.
 117 DEF BUFFER old-control FOR OfficeControlAccount.
 118
 119   FIND old-office WHERE old-office.OfficeCode = old-office-code NO-LOCK NO-ERROR.
 120   FIND Office WHERE Office.OfficeCode = this-office NO-ERROR.
 121   IF NOT AVAILABLE(Office) THEN DO:
 122     CREATE Office.
 123     BUFFER-COPY old-office EXCEPT old-office.ThisOffice TO Office
 124                 ASSIGN Office.OfficeCode = this-office.
 125   END.
 126
 127   FOR EACH old-setting OF old-office NO-LOCK:
 128     FIND OfficeSetting OF Office WHERE OfficeSetting.SetName = old-setting.SetName NO-ERROR.
 129     IF NOT AVAILABLE(OfficeSetting) THEN DO:
 130       CREATE OfficeSetting.
 131       OfficeSetting.OfficeCode = this-office.
 132       OfficeSetting.SetName = old-setting.SetName.
 133     END.
 134     BUFFER-COPY old-setting EXCEPT old-setting.OfficeCode TO OfficeSetting.
 135   END.
 136
 137   FOR EACH old-control OF old-office NO-LOCK:
 138     FIND OfficeControlAccount OF Office WHERE OfficeControlAccount.Name = old-control.Name NO-ERROR.
 139     IF NOT AVAILABLE(OfficeControlAccount) THEN DO:
 140       CREATE OfficeControlAccount.
 141       OfficeControlAccount.OfficeCode = this-office.
 142       OfficeControlAccount.Name = old-control.Name.
 143     END.
 144     BUFFER-COPY old-control EXCEPT old-control.OfficeCode TO OfficeControlAccount.
 145   END.
 146
 147   Office.ThisOffice = Yes.
 148   debug-event( "Office settings copied").
 149
 150   FIND OfficeSetting OF Office WHERE OfficeSetting.SetName = "WindowTitlePrefix" NO-ERROR.
 151   IF NOT AVAILABLE(OfficeSetting) THEN DO:
 152     CREATE OfficeSetting.
 153     OfficeSetting.OfficeCode = this-office.
 154     OfficeSetting.SetName = "WindowTitlePrefix".
 155   END.
 156   OfficeSetting.SetValue = prefix.
 157   debug-event( 'Prefix set to "' + prefix + '"' ).
 158
 159 END PROCEDURE.
 160
 161 /* _UIB-CODE-BLOCK-END */
 162 &ANALYZE-RESUME
 163
 164 &ENDIF
 165
 166 &IF DEFINED(EXCLUDE-delete-current-users) = 0 &THEN
 167
 168 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE delete-current-users Procedure
 169 PROCEDURE delete-current-users :
 170 /*------------------------------------------------------------------------------
 171   Purpose:
 172 ------------------------------------------------------------------------------*/
 173
 174   debug-event( 'Deleting existing user records.' ).
 175   ON DELETE OF Usr OVERRIDE DO: END.
 176   FOR EACH Usr EXCLUSIVE-LOCK TRANSACTION:
 177     DELETE Usr.
 178   END.
 179
 180   debug-event( 'Deleting existing usergroup membership records.' ).
 181   ON DELETE OF UsrGroupMember OVERRIDE DO: END.
 182   FOR EACH UsrGroupMember TRANSACTION:
 183     DELETE UsrGroupMember.
 184   END.
 185
 186   debug-event( 'Existing user records deleted.' ).
 187
 188 END PROCEDURE.
 189
 190 /* _UIB-CODE-BLOCK-END */
 191 &ANALYZE-RESUME
 192
 193 &ENDIF
 194
 195 &IF DEFINED(EXCLUDE-load-local-users) = 0 &THEN
 196
 197 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE load-local-users Procedure
 198 PROCEDURE load-local-users :
 199 /*------------------------------------------------------------------------------
 200   Purpose:     Reload users local to the current site from the 'lnk' directory
 201 ------------------------------------------------------------------------------*/
 202
 203   IF NOT batch-mode THEN DO:
 204     MESSAGE "Are you sure you want to load the users in?" SKIP
 205             "All current user information will be lost!"
 206             VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO
 207             TITLE "Confirm Reload" UPDATE reload-it AS LOGI.
 208
 209     IF NOT reload-it THEN RETURN.
 210   END.
 211
 212   RUN verify-files.
 213   IF RETURN-VALUE = "FAIL" THEN RETURN.
 214
 215   RUN delete-current-users.
 216
 217   DEF VAR i AS INT NO-UNDO.
 218
 219   ON WRITE OF Usr OVERRIDE DO: END.
 220   INPUT FROM usr.d .
 221   REPEAT TRANSACTION:
 222     CREATE Usr.
 223     IMPORT Usr.
 224     debug-event("Added user '" + Usr.UserName + "'" ).
 225   END.
 226   INPUT CLOSE.
 227
 228
 229   /* There's a bit of mucking around here because when a usr record is created
 230    * some memberships may also be created automatically
 231    */
 232   ON WRITE OF UsrGroupMember OVERRIDE DO: END.
 233   INPUT FROM usrgrpmm.d .
 234   REPEAT ON ERROR UNDO,NEXT TRANSACTION:
 235     CREATE UsrGroupMember.
 236     IMPORT UsrGroupMember.
 237     debug-event("Added user group member '" + UsrGroupMember.UserName + "' of '" + UsrGroupMember.GroupName + "'" ).
 238   END.
 239   INPUT CLOSE.
 240
 241   debug-event( 'Local users loaded' ).
 242
 243 END PROCEDURE.
 244
 245 /* _UIB-CODE-BLOCK-END */
 246 &ANALYZE-RESUME
 247
 248 &ENDIF
 249
 250 &IF DEFINED(EXCLUDE-parse-parameters) = 0 &THEN
 251
 252 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-parameters Procedure
 253 PROCEDURE parse-parameters :
 254 /*------------------------------------------------------------------------------
 255   Purpose:
 256   Parameters:  <none>
 257   Notes:
 258 ------------------------------------------------------------------------------*/
 259 DEF VAR token AS CHAR NO-UNDO.
 260 DEF VAR i AS INT NO-UNDO.
 261 DEF VAR process-options AS CHAR NO-UNDO.
 262
 263   process-options = SESSION:PARAMETER .
 264   DO i = 1 TO NUM-ENTRIES( process-options, "|" ):
 265     token = ENTRY( i, process-options, "|" ).
 266     debug-event("Found token: " + token ).
 267
 268     CASE ENTRY( 1, token ):
 269       WHEN "Office"  THEN this-office = ENTRY(2,token).
 270       WHEN "FromOffice"  THEN old-office-code = ENTRY(2,token).
 271       WHEN "Prefix"  THEN prefix = ENTRY(2,token).
 272       WHEN "Printer" THEN ASSIGN
 273         cur-printer = ENTRY(2,token)
 274         cur-port    = ENTRY(3,token).
 275       WHEN "CollisionDetect" THEN collision-detect = Yes.
 276       WHEN "OverrideRules" THEN override-rules = Yes.
 277     END CASE.
 278
 279   END.
 280
 281   IF prefix = "" AND this-office <> "" THEN prefix = TRIM(this-office) + ":".
 282   batch-mode = SESSION:BATCH-MODE .
 283   debug-mode = batch-mode OR debug-mode.
 284
 285 END PROCEDURE.
 286
 287 /* _UIB-CODE-BLOCK-END */
 288 &ANALYZE-RESUME
 289
 290 &ENDIF
 291
 292 &IF DEFINED(EXCLUDE-reset-printers) = 0 &THEN
 293
 294 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE reset-printers Procedure
 295 PROCEDURE reset-printers :
 296 /*------------------------------------------------------------------------------
 297   Purpose:
 298 ------------------------------------------------------------------------------*/
 299
 300   IF cur-printer = "" THEN RETURN.
 301   FOR EACH RP WHERE RP.ReportID = "Current Printer":
 302     RP.Char1 = cur-printer.
 303     RP.Char2 = cur-port.
 304   END.
 305
 306 END PROCEDURE.
 307
 308 /* _UIB-CODE-BLOCK-END */
 309 &ANALYZE-RESUME
 310
 311 &ENDIF
 312
 313 &IF DEFINED(EXCLUDE-set-replication) = 0 &THEN
 314
 315 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE set-replication Procedure
 316 PROCEDURE set-replication :
 317 /*------------------------------------------------------------------------------
 318   Purpose:
 319 ------------------------------------------------------------------------------*/
 320 DEF VAR no-delete-tables AS CHAR NO-UNDO INITIAL "" /*"NewAcctTrans,NewBatch,NewDocument" */.
 321 DEF VAR activity AS CHAR NO-UNDO.
 322
 323   IF this-office = "" THEN RETURN.
 324
 325   FOR EACH ReplTrigger NO-LOCK TRANSACTION:
 326     FIND ReplLoadRule WHERE ReplLoadRule.SourceSystem = old-office-code
 327                         AND ReplLoadRule.TableToLoad = ReplTrigger.TableToRepl
 328                         EXCLUSIVE-LOCK NO-ERROR.
 329
 330     activity = ReplTrigger.Activity.
 331     IF LOOKUP(ReplTrigger.TableToRepl, no-delete-tables) > 0 THEN
 332       activity = REPLACE( activity, "D", "").
 333
 334     IF NOT AVAILABLE(ReplLoadRule) THEN DO:
 335       CREATE ReplLoadRule.
 336       ASSIGN    ReplLoadRule.TableToLoad = ReplTrigger.TableToRepl
 337                 ReplLoadRule.Activity = activity
 338                 ReplLoadRule.SourceSystem = old-office-code
 339                 ReplLoadRule.CollisionDetect = collision-detect.
 340     END.
 341     ELSE IF override-rules THEN DO:
 342       ASSIGN    ReplLoadRule.TableToLoad = ReplTrigger.TableToRepl
 343                 ReplLoadRule.SourceSystem = old-office-code
 344                 ReplLoadRule.Activity = activity
 345                 ReplLoadRule.CollisionDetect = collision-detect.
 346     END.
 347   END.
 348   debug-event( 'Replication rules set.' ).
 349
 350   FOR EACH ReplLog TRANSACTION:
 351     DELETE ReplLog.
 352   END.
 353
 354   debug-event( 'Replication log cleared.' ).
 355
 356 DO TRANSACTION:
 357   FIND RP WHERE RP.UserName = "Replication-" + old-office-code
 358                 AND RP.ReportID = "Last Replication File" EXCLUSIVE-LOCK NO-ERROR.
 359   IF AVAILABLE(RP) THEN DELETE RP.
 360 END.
 361   debug-event( 'Last successful replication record deleted' ).
 362
 363 END PROCEDURE.
 364
 365 /* _UIB-CODE-BLOCK-END */
 366 &ANALYZE-RESUME
 367
 368 &ENDIF
 369
 370 &IF DEFINED(EXCLUDE-verify-files) = 0 &THEN
 371
 372 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE verify-files Procedure
 373 PROCEDURE verify-files :
 374 /*------------------------------------------------------------------------------
 375   Purpose:
 376 ------------------------------------------------------------------------------*/
 377 DEF VAR all-found AS LOGI NO-UNDO INIT Yes.
 378 DEF VAR i         AS INT  NO-UNDO.
 379
 380   debug-event("Verifying existence of usr files").
 381   DO i = 1 TO NUM-ENTRIES( file-list ):
 382     all-found = all-found AND SEARCH( ENTRY( i, file-list ) ) <> ?.
 383   END.
 384
 385   IF NOT all-found THEN DO:
 386     debug-event("Files are missing").
 387     MESSAGE "At least one of the following files could not be found:" SKIP(1)
 388             file-list
 389             VIEW-AS ALERT-BOX ERROR
 390             TITLE "Import files missing".
 391     RETURN "FAIL".
 392   END.
 393
 394 END PROCEDURE.
 395
 396 /* _UIB-CODE-BLOCK-END */
 397 &ANALYZE-RESUME
 398
 399 &ENDIF
 400
 401 /* ************************  Function Implementations ***************** */
 402
 403 &IF DEFINED(EXCLUDE-debug-event) = 0 &THEN
 404
 405 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION debug-event Procedure
 406 FUNCTION debug-event RETURNS CHARACTER
 407   ( INPUT event-text AS CHAR ) :
 408 /*------------------------------------------------------------------------------
 409   Purpose:
 410     Notes:
 411 ------------------------------------------------------------------------------*/
 412 IF NOT debug-mode THEN RETURN event-text.
 413
 414 DEF VAR time-text AS CHAR NO-UNDO.
 415
 416   time-text = STRING( TODAY, "99/99/9999") + " " + STRING( TIME, "HH:MM:SS") + ": ".
 417
 418   OUTPUT STREAM debug-stream TO loadusrs.log PAGE-SIZE 0 KEEP-MESSAGES APPEND.
 419   PUT STREAM debug-stream UNFORMATTED time-text event-text SKIP.
 420   OUTPUT STREAM debug-stream CLOSE.
 421
 422   RETURN time-text + event-text.
 423
 424 END FUNCTION.
 425
 426 /* _UIB-CODE-BLOCK-END */
 427 &ANALYZE-RESUME
 428
 429 &ENDIF
 430