process/one-off/findcrap.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5   ------------------------------------------------------------------------*/
   6
   7 DEF INPUT PARAMETER process-options AS CHAR NO-UNDO.
   8
   9 DEF VAR preview AS LOGICAL NO-UNDO          INITIAL No.
  10 DEF VAR archive AS CHAR NO-UNDO             INITIAL "Yes".
  11 DEF VAR log-depth AS INT NO-UNDO            INITIAL 10.
  12 RUN parse-options.
  13 IF RETURN-VALUE = 'FAIL' THEN RETURN.
  14
  15 DEF VAR program-list AS CHAR NO-UNDO        INITIAL "".
  16 DEF VAR no-programs  AS INT  NO-UNDO        INITIAL 0.
  17 DEF VAR found-list   AS CHAR NO-UNDO        INITIAL "".
  18 DEF VAR include-list AS CHAR NO-UNDO        INITIAL "".
  19 DEF VAR checked-incs AS CHAR NO-UNDO        INITIAL "".
  20
  21 DEF VAR k AS INT NO-UNDO.
  22
  23 DEF VAR log-name AS CHAR NO-UNDO            INITIAL '{&FILE-NAME}.log'.
  24
  25 OS-DELETE ss-fix.bat .
  26
  27 /* _UIB-CODE-BLOCK-END */
  28 &ANALYZE-RESUME
  29
  30
  31 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  32
  33 /* ********************  Preprocessor Definitions  ******************** */
  34
  35 &Scoped-define PROCEDURE-TYPE Procedure
  36
  37
  38
  39 /* _UIB-PREPROCESSOR-BLOCK-END */
  40 &ANALYZE-RESUME
  41
  42
  43
  44 /* *********************** Procedure Settings ************************ */
  45
  46 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  47 /* Settings for THIS-PROCEDURE
  48    Type: Procedure
  49    Allow:
  50    Frames: 0
  51    Add Fields to: Neither
  52    Other Settings: CODE-ONLY COMPILE
  53  */
  54 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  55
  56 /* *************************  Create Window  ************************** */
  57
  58 &ANALYZE-SUSPEND _CREATE-WINDOW
  59 /* DESIGN Window definition (used by the UIB)
  60   CREATE WINDOW Procedure ASSIGN
  61          HEIGHT             = .08
  62          WIDTH              = 40.14.
  63 /* END WINDOW DEFINITION */
  64                                                                         */
  65 &ANALYZE-RESUME
  66
  67
  68
  69 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB Procedure
  70 /* ************************* Included-Libraries *********************** */
  71
  72 {inc/method/m-txtrep.i}
  73
  74 /* _UIB-CODE-BLOCK-END */
  75 &ANALYZE-RESUME
  76
  77
  78
  79 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  80
  81
  82 /* ***************************  Main Block  *************************** */
  83 RUN log( 1, "*********************************************************************").
  84 RUN log( 1, "Looking for Crapola!").
  85
  86 /* Check for programs that aren't referenced */
  87 RUN process-dir( ".",     "*", ".P,.W" ).
  88 RUN known-problems.
  89 RUN check-triggers.
  90 RUN check-linknodes.
  91 RUN check-programlinks.
  92 RUN check-programs.
  93 RUN archive-programs.
  94
  95 /* check for .R code where there is no source */
  96 RUN check-orphan-rcode.
  97 RUN archive-programs.
  98
  99
 100 /* Check for include files that weren't referenced */
 101 IF RETURN-VALUE <> 'FAIL' THEN DO:
 102   program-list = "".
 103   no-programs = 0.
 104   RUN process-dir ( ".\inc", "*", ".I").
 105   RUN check-includes.
 106   RUN archive-programs.
 107 END.
 108
 109 /* while we're at it... */
 110 IF RETURN-VALUE <> 'FAIL' THEN RUN check-menus.
 111
 112 IF RETURN-VALUE = 'FAIL' THEN
 113   RUN log( 1, 'Crapola search aborted').
 114 ELSE
 115   RUN log( 1, 'Crapola search complete').
 116
 117 IF preview THEN DO:
 118   txtrep-print-file = log-name.
 119   RUN view-output-file( preview ).
 120 END.
 121
 122 /* _UIB-CODE-BLOCK-END */
 123 &ANALYZE-RESUME
 124
 125
 126 /* **********************  Internal Procedures  *********************** */
 127
 128 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE archive-programs Procedure
 129 PROCEDURE archive-programs :
 130 /*------------------------------------------------------------------------------
 131   Purpose:
 132 ------------------------------------------------------------------------------*/
 133 DEF VAR file-name AS CHAR NO-UNDO.
 134 DEF VAR i AS INT NO-UNDO.
 135 DEF VAR do-it AS LOGICAL NO-UNDO.
 136
 137   IF archive = 'Yes' THEN
 138     RUN log( 3, "Moving remaining " + STRING( no-programs ) + " files to archive." ).
 139   ELSE IF archive = 'Prompt' THEN
 140     RUN log( 3, "Prompt for remaining " + STRING( no-programs ) + " files to archive." ).
 141   ELSE IF archive = 'Prompt' THEN
 142     RUN log( 3, "Not moving remaining " + STRING( no-programs ) + " files to archive." ).
 143   RUN log( 22, program-list ).
 144
 145   OS-CREATE-DIR ..\archive .
 146   OS-CREATE-DIR ..\archive\vwr .        /* directory has sub-dirs, but no content */
 147   DO i = 1 TO no-programs:
 148     file-name = ENTRY( i, program-list ).
 149
 150     do-it = Yes.
 151     IF archive = 'Prompt' THEN DO:
 152       MESSAGE "Move '" + file-name + "' to archive?" VIEW-AS ALERT-BOX QUESTION
 153                 BUTTONS YES-NO-CANCEL
 154                 TITLE "Archive this program?"
 155                 UPDATE do-it.
 156       IF do-it = ? THEN RETURN 'FAIL'.
 157     END.
 158     ELSE if archive <> 'Yes' THEN
 159       do-it = No.
 160
 161     IF do-it THEN DO:
 162       RUN log( 4, STRING( i, '>>9') + ': ' + file-name ).
 163       file-name = SUBSTRING( file-name, 3).
 164       OS-CREATE-DIR VALUE( "..\archive\"
 165                   + SUBSTRING( file-name, 1, R-INDEX( file-name, "\") - 1)).
 166       OS-DELETE VALUE( "..\archive\" + file-name ).
 167       OS-RENAME VALUE(file-name) VALUE( "..\archive\" + file-name ).
 168
 169       IF SUBSTRING( file-name, LENGTH(file-name) - 1) <> ".R" THEN DO:
 170         OUTPUT TO ss-fix.bat APPEND.
 171         PUT UNFORMATTED "x-x-x-x\SS Delete $/"
 172                        + REPLACE( file-name, "\", "/")
 173                        + " -S -I-Y -YAndrew" SKIP.
 174         OUTPUT CLOSE.
 175       END.
 176     END.
 177     ELSE
 178       RUN log( 4, STRING( i, '>>9') + ': ' + file-name + " - not moved to archive." ).
 179
 180   END.
 181
 182 END PROCEDURE.
 183
 184 /* _UIB-CODE-BLOCK-END */
 185 &ANALYZE-RESUME
 186
 187
 188 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-file Procedure
 189 PROCEDURE check-file :
 190 /*------------------------------------------------------------------------------
 191   Purpose:  Check an individual file
 192 ------------------------------------------------------------------------------*/
 193 DEF INPUT PARAMETER file-name AS CHAR NO-UNDO.
 194
 195 DEF VAR ln AS CHAR NO-UNDO.
 196 DEF VAR i AS INT NO-UNDO.
 197 DEF VAR l-no AS INT NO-UNDO INITIAL 0.
 198 DEF VAR save-include-list AS CHAR NO-UNDO.
 199
 200   i = R-INDEX( file-name, ".R").
 201   IF i > 0 THEN file-name = SUBSTRING( file-name, 1, i - 1).
 202
 203   IF SEARCH( file-name ) <> ? THEN .
 204   ELSE IF SEARCH( file-name + ".W" ) <> ? THEN file-name = file-name + ".W".
 205   ELSE IF SEARCH( file-name + ".P" ) <> ? THEN file-name = file-name + ".P".
 206   ELSE IF SEARCH( file-name + ".I" ) <> ? THEN file-name = file-name + ".I".
 207
 208   save-include-list = include-list.
 209   include-list = ''.
 210   RUN log( 15, "Checking '" + file-name + "' for recursive calls.").
 211   INPUT FROM VALUE( file-name ).
 212   REPEAT:
 213     IMPORT UNFORMATTED ln.
 214     l-no = l-no + 1.
 215     i = INDEX( ln, "~{i" + "nc" ) .  /* hide search string so we don't generate errors parsing ourselves! */
 216     IF i > 0 THEN RUN check-ln-inc( ln, i ).
 217     i = INDEX( ln, "RUN").
 218     IF i > 0 THEN DO:
 219       RUN check-ln-run( file-name, INPUT-OUTPUT l-no, ln, i ).
 220     END.
 221   END.
 222   INPUT CLOSE.
 223
 224   IF include-list <> "" THEN RUN check-inside-includes.
 225   include-list = save-include-list.
 226
 227 END PROCEDURE.
 228
 229 /* _UIB-CODE-BLOCK-END */
 230 &ANALYZE-RESUME
 231
 232
 233 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-includes Procedure
 234 PROCEDURE check-includes :
 235 /*------------------------------------------------------------------------------
 236   Purpose:
 237 ------------------------------------------------------------------------------*/
 238 DEF VAR i AS INT NO-UNDO.
 239 DEF VAR no-incs AS INT NO-UNDO.
 240
 241   RUN log( 3, "Processing " + STRING( no-programs ) + " include files.").
 242   RUN log( 5, "Marking previously checked includes as found.").
 243   no-incs = NUM-ENTRIES( checked-incs ) - 1.
 244   DO i = 1 TO no-incs:
 245     RUN program-found( ENTRY( i, checked-incs ) ).
 246   END.
 247
 248 END PROCEDURE.
 249
 250 /* _UIB-CODE-BLOCK-END */
 251 &ANALYZE-RESUME
 252
 253
 254 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-inside-includes Procedure
 255 PROCEDURE check-inside-includes :
 256 /*------------------------------------------------------------------------------
 257   Purpose:  Read each include we've found and look for RUN ... or { inc ...}
 258 ------------------------------------------------------------------------------*/
 259 DEF VAR i AS INT NO-UNDO.
 260
 261 DEF VAR inc-name AS CHAR NO-UNDO.
 262
 263   RUN log( 33, "Checking includes found so far for further calls.").
 264   DO i = 1 TO NUM-ENTRIES( include-list ) - 1:
 265     inc-name = ENTRY( i, include-list ).
 266     IF LOOKUP( inc-name, checked-incs ) > 0 THEN NEXT.
 267
 268     checked-incs = checked-incs + inc-name + ",".
 269     RUN check-file( ENTRY( i, include-list) ).
 270   END.
 271   RUN log( 33, "Checking of includes completed.").
 272
 273 END PROCEDURE.
 274
 275 /* _UIB-CODE-BLOCK-END */
 276 &ANALYZE-RESUME
 277
 278
 279 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-linknodes Procedure
 280 PROCEDURE check-linknodes :
 281 /*------------------------------------------------------------------------------
 282   Purpose:
 283 ------------------------------------------------------------------------------*/
 284 DEF VAR i AS INT NO-UNDO.
 285 DEF VAR base-file AS CHAR NO-UNDO.
 286 DEF VAR prog-file AS CHAR NO-UNDO.
 287 DEF VAR pb AS INT NO-UNDO.
 288
 289   RUN log( 3, "Removing known linknode targets from list of " + STRING(no-programs) + " programs.").
 290
 291   FOR EACH LinkNode:
 292     IF LinkNode.NodeType = "MV" THEN DO:
 293       IF NOT CAN-FIND( FIRST ProgramLink WHERE ProgramLink.Viewer = LinkNode.File ) THEN
 294         RUN log( 7, "MV Linknode '" + LinkNode.Description
 295                 + "' - no ProgramLink found for viewer '" + LinkNode.File + "'").
 296       NEXT.
 297     END.
 298 /*     LinkNode.Path = REPLACE( LinkNode.Path, "\", "/"). */
 299 /*     IF LinkNode.Path = "win/sel" OR LinkNode.Path = "win/mnt" THEN LinkNode.Path = "win". */
 300 /*     IF LinkNode.Path = "win/lnk" OR LinkNode.Path = "vwr/lnk" THEN LinkNode.Path = "lnk". */
 301
 302     base-file = REPLACE( LinkNode.Path + '\'
 303                          + (IF LinkNode.RunFile <> "" THEN
 304                               LinkNode.RunFile
 305                             ELSE
 306                               LinkNode.File), '/', '\').
 307
 308     IF LOOKUP( base-file, found-list) > 0 THEN NEXT.
 309     IF INDEX( found-list, base-file) > 0 THEN NEXT.
 310 /*    IF INDEX( found-list, (IF LinkNode.RunFile <> "" THEN LinkNode.RunFile ELSE LinkNode.File)) > 0 THEN NEXT. */
 311
 312     IF SUBSTRING( base-file, 1, 2) <> ".\" THEN prog-file = ".\" + base-file.
 313     i = LOOKUP( prog-file + ".W", program-list ).
 314     IF i = 0 THEN DO:
 315       i = LOOKUP( prog-file + ".P", program-list ).
 316       IF i = 0 THEN
 317         i = LOOKUP( prog-file, program-list ).
 318       ELSE
 319         prog-file = prog-file + ".P".
 320     END.
 321     ELSE
 322       prog-file = prog-file + ".W".
 323
 324     IF i = 0 THEN DO:
 325       RUN log( 9, "Linknode '" + LinkNode.Description + "' - '"
 326                   + LinkNode.Path + " - " + LinkNode.RunFile + "' not found.").
 327       i = INDEX( program-list, (IF LinkNode.RunFile = "" THEN LinkNode.File ELSE LinkNode.RunFile) ).
 328       IF i > 0 THEN DO:
 329         pb = R-INDEX( program-list, ",", i) + 1.
 330         LinkNode.Path = REPLACE( SUBSTRING( program-list, pb + 2, i - pb - 3), "\", "/").
 331         RUN log( 1, "Linknode changed to: '"
 332                    + LinkNode.Path + "' for the path. ("
 333                    + STRING(pb) + "," + STRING(i) + ")" ).
 334       END.
 335     END.
 336     ELSE IF i > 0 THEN
 337       RUN program-found( prog-file ).
 338   END.
 339
 340   RUN log( 99, "Program list: " + program-list ).
 341
 342 END PROCEDURE.
 343
 344 /* _UIB-CODE-BLOCK-END */
 345 &ANALYZE-RESUME
 346
 347
 348 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-ln-inc Procedure
 349 PROCEDURE check-ln-inc :
 350 /*------------------------------------------------------------------------------
 351   Purpose:
 352 ------------------------------------------------------------------------------*/
 353 DEF INPUT PARAMETER ln AS CHAR NO-UNDO.
 354 DEF INPUT PARAMETER i AS INT NO-UNDO.
 355
 356   ln = REPLACE( ENTRY( 1, SUBSTRING( ln, i + 1), " "), "/", "\").
 357   ln = TRIM( ln, "~{} ").
 358   IF SUBSTRING( ln, 1, 2) <> ".\" THEN ln = ".\" + ln.
 359   IF LOOKUP( ln, checked-incs ) > 0 THEN RETURN.
 360
 361   RUN log( 47, "Found include: '" + ln + "'").
 362   include-list = include-list + ln + ",".
 363
 364 END PROCEDURE.
 365
 366 /* _UIB-CODE-BLOCK-END */
 367 &ANALYZE-RESUME
 368
 369
 370 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-ln-run Procedure
 371 PROCEDURE check-ln-run :
 372 /*------------------------------------------------------------------------------
 373   Purpose:
 374 ------------------------------------------------------------------------------*/
 375 DEF INPUT PARAMETER file-name AS CHAR NO-UNDO.
 376 DEF INPUT-OUTPUT PARAMETER l-no AS INT NO-UNDO.
 377 DEF INPUT PARAMETER whole-ln AS CHAR NO-UNDO.
 378 DEF INPUT PARAMETER i AS INT NO-UNDO.
 379
 380 DEF VAR ln AS CHAR NO-UNDO.
 381
 382   ln = TRIM( SUBSTRING( whole-ln, i + 4) ).
 383   ln = RIGHT-TRIM( ln, ".").
 384   IF SUBSTRING( ln, 1, 11) = "init-object" THEN DO:
 385     ln = REPLACE( ln, '"', "'").
 386     IF INDEX( ln, "'") > 0 THEN
 387       ln = TRIM( ENTRY( 2, ln, "'") ).
 388     ELSE DO:
 389       /* Probably UIB code to init windows - next line should have program name */
 390       l-no = l-no + 1.
 391       IMPORT UNFORMATTED ln.
 392       ln = REPLACE( ln, '"', "'").
 393       IF INDEX( ln, "'") = 0 THEN RETURN "".           /* it gets too hard... */
 394       ln = ENTRY( 2, ln, "'").
 395     END.
 396     RUN log( 21, file-name + ' ' + STRING(l-no) + ": Parsed 'init-object' line to get '" + ln + "'").
 397   END.
 398   IF SUBSTRING( ln, 1, 5) = "VALUE" THEN RETURN "".    /* can't cope! */
 399   IF SUBSTRING( ln, 1, 3) = "ade" THEN RETURN "".      /* not our problem */
 400   IF SUBSTRING( ln, 1, 3) = "adm" THEN RETURN "".      /* not our problem */
 401   IF SUBSTRING( ln, 1, 7) = "prodict" THEN RETURN "".  /* not our problem */
 402
 403   i = INDEX( ln, "(" ).
 404   IF i > 0 THEN ln = SUBSTRING( ln, 1, i - 1).      /* trim to start of parameter list */
 405   ln = REPLACE( ENTRY( 1, ln, " "), "/", "\").      /* trim to first space */
 406   IF INDEX( ln, "\") = 0 THEN RETURN "".            /* all R-U-Ns should use explicit path */
 407
 408   i = R-INDEX( ln, ".R").
 409   IF i > 0 THEN ln = SUBSTRING( ln, 1, i - 1).
 410
 411 DEF VAR prog-file AS CHAR NO-UNDO.
 412 DEF VAR pb AS INT NO-UNDO.
 413   prog-file = ln.
 414   IF SUBSTRING( prog-file, 1, 2) <> ".\" THEN prog-file = ".\" + prog-file.
 415   i = LOOKUP( prog-file, program-list ).
 416   IF i = 0 THEN DO:
 417     i = LOOKUP( prog-file + ".W", program-list ).
 418     IF i > 0 THEN prog-file = prog-file + ".W".
 419     ELSE DO:
 420       i = LOOKUP( prog-file + ".P", program-list ).
 421       IF i > 0 THEN prog-file = prog-file + ".P".
 422     END.
 423   END.
 424
 425   IF i > 0 THEN DO:
 426     RUN log( 31, "RUN '" + ln + "'  encountered").
 427     RUN program-found( prog-file ).
 428     RETURN "".
 429   END.
 430
 431   IF INDEX( found-list, ln ) > 0 THEN RETURN "".
 432
 433   RUN log( 9, "Problem parsing line " + STRING(l-no) + " of " + file-name).
 434   RUN log( 9, "  -->" + whole-ln + "<--").
 435   RUN log( 9, "Run program '" + ln + "' not found.  (prog-file=" + prog-file + ")").
 436   RETURN "FAIL".
 437
 438 END PROCEDURE.
 439
 440 /* _UIB-CODE-BLOCK-END */
 441 &ANALYZE-RESUME
 442
 443
 444 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-menus Procedure
 445 PROCEDURE check-menus :
 446 /*------------------------------------------------------------------------------
 447   Purpose:
 448 ------------------------------------------------------------------------------*/
 449 DEF BUFFER OtherLink FOR LinkNode.
 450
 451   FOR EACH LinkNode NO-LOCK:
 452     FIND FIRST UsrGroupMenu WHERE UsrGroupMenu.NodeCode = LinkNode.NodeCode NO-LOCK NO-ERROR.
 453     IF NOT AVAILABLE(UsrGroupMenu) THEN DO:
 454       IF CAN-FIND( FIRST ProgramLink WHERE ProgramLink.Source = LinkNode.NodeCode AND ProgramLink.LinkType <> "SEL" ) THEN
 455         RUN log( 7, "No menu for Linknode '" + LinkNode.Description + "'.").
 456     END.
 457
 458     IF LinkNode.NodeType = "MV" THEN DO:
 459       FIND FIRST ProgramLink NO-LOCK WHERE ProgramLink.Source = LinkNode.NodeCode
 460                             AND ProgramLink.LinkType = 'SEL' NO-ERROR.
 461       IF AVAILABLE(ProgramLink) THEN NEXT.
 462       RUN log( 7, "LinkNode is Maintain Viewer without selection links '" + LinkNode.Description + "'.").
 463     END.
 464
 465     FIND FIRST ProgramLink NO-LOCK WHERE ProgramLink.Source = LinkNode.NodeCode NO-ERROR.
 466     IF AVAILABLE(ProgramLink) THEN NEXT.
 467
 468     FIND FIRST ProgramLink NO-LOCK WHERE ProgramLink.Target = LinkNode.NodeCode NO-ERROR.
 469     IF AVAILABLE(ProgramLink) THEN NEXT.
 470
 471     RUN log( 6, "No reference to Linknode '" + LinkNode.Description + "'.").
 472   END.
 473
 474   FOR EACH ProgramLink NO-LOCK:
 475     FIND FIRST LinkNode WHERE LinkNode.NodeCode = ProgramLink.Source NO-LOCK NO-ERROR.
 476     IF NOT AVAILABLE(LinkNode) THEN
 477       RUN log( 6, "Invalid source for ProgramLink '" + ProgramLink.Description + "'.").
 478
 479     FIND FIRST LinkNode WHERE LinkNode.NodeCode = ProgramLink.Target NO-LOCK NO-ERROR.
 480     IF NOT AVAILABLE(LinkNode) THEN
 481       RUN log( 6, "Invalid target for ProgramLink '" + ProgramLink.Description + "'.").
 482
 483     IF ProgramLink.LinkType = "SEL" THEN NEXT.
 484
 485     IF CAN-FIND( FIRST UsrGroupMenuItem WHERE UsrGroupMenuItem.LinkCode = ProgramLink.LinkCode) THEN DO:
 486       FOR EACH UsrGroupMenuItem NO-LOCK WHERE UsrGroupMenuItem.LinkCode = ProgramLink.LinkCode
 487                             AND NOT CAN-FIND( UsrGroup OF UsrGroupMenuItem):
 488         RUN log( 8, "Group '" + UsrGroupMenuItem.GroupName + "' not defined for programlink '" + ProgramLink.Description + "'.").
 489       END.
 490     END.
 491     ELSE
 492       RUN log( 10, "No menu item links ProgramLink '" + ProgramLink.Description + "'.").
 493   END.
 494
 495 END PROCEDURE.
 496
 497 /* _UIB-CODE-BLOCK-END */
 498 &ANALYZE-RESUME
 499
 500
 501 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-orphan-rcode Procedure
 502 PROCEDURE check-orphan-rcode :
 503 /*------------------------------------------------------------------------------
 504   Purpose:
 505 ------------------------------------------------------------------------------*/
 506 DEF VAR i AS INT NO-UNDO.
 507 DEF VAR source-list AS CHAR NO-UNDO.
 508 DEF VAR no-sources AS INT NO-UNDO.
 509 DEF VAR prog-name AS CHAR NO-UNDO.
 510
 511   RUN log( 3, "Searching for orphan r-code.").
 512   program-list = "".
 513   no-programs = 0.
 514   RUN process-dir( ".",     "*", ".P,.W" ).
 515   source-list = program-list.
 516   no-sources = no-programs.
 517
 518   program-list = "".
 519   no-programs = 0.
 520   RUN process-dir ( ".", "*", ".R").
 521
 522   DO i = 1 TO no-sources:
 523     prog-name = ENTRY( i, source-list).
 524     prog-name = SUBSTRING( prog-name, 1, LENGTH(prog-name) - 1 ) + "R".
 525     RUN program-found( prog-name ).
 526   END.
 527   RUN log( 9, "Found " + STRING( no-programs ) + " orphans.").
 528
 529 END PROCEDURE.
 530
 531 /* _UIB-CODE-BLOCK-END */
 532 &ANALYZE-RESUME
 533
 534
 535 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-programlinks Procedure
 536 PROCEDURE check-programlinks :
 537 /*------------------------------------------------------------------------------
 538   Purpose:
 539 ------------------------------------------------------------------------------*/
 540 DEF VAR i AS INT NO-UNDO.
 541 DEF VAR prog-file AS CHAR NO-UNDO.
 542 DEF VAR pb AS INT NO-UNDO.
 543
 544   RUN log( 3, "Removing known program link viewers from list of " + STRING(no-programs) + " programs.").
 545
 546   FOR EACH ProgramLink:
 547     IF NOT ProgramLink.CreateViewer THEN NEXT.
 548     IF ProgramLink.Viewer = 'Default' THEN ProgramLink.Viewer = ''.
 549     IF ProgramLink.Viewer = '' THEN NEXT.
 550     prog-file = ProgramLink.Viewer.
 551     i = INDEX( program-list, prog-file ).
 552     IF i > 0 THEN DO:
 553       pb = R-INDEX( program-list, ",", i) + 1.
 554 /*      ProgramLink.FillName = REPLACE( SUBSTRING( program-list, pb + 2, i - pb - 3), "\", "/"). */
 555
 556       i = INDEX( program-list, ",", pb).
 557       IF i > pb THEN
 558         prog-file = SUBSTRING( program-list, pb, i - pb).
 559       ELSE
 560         prog-file = SUBSTRING( program-list, pb).
 561     END.
 562
 563     i = LOOKUP( prog-file, program-list ).
 564     IF i > 0 THEN RUN program-found( prog-file ).
 565
 566   END.
 567
 568   RUN log( 99, "Program list: " + program-list ).
 569
 570 END PROCEDURE.
 571
 572 /* _UIB-CODE-BLOCK-END */
 573 &ANALYZE-RESUME
 574
 575
 576 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-programs Procedure
 577 PROCEDURE check-programs :
 578 /*------------------------------------------------------------------------------
 579   Purpose:  Read each program we've found and look for RUN ... or { inc... }
 580 ------------------------------------------------------------------------------*/
 581 DEF VAR i AS INT NO-UNDO.
 582
 583   RUN log( 3, "Removing calls from inside found programs from list of " + STRING(no-programs) + " programs.").
 584
 585   DO i = 1 TO NUM-ENTRIES( found-list ) - 1:
 586     RUN check-file( ENTRY( i, found-list) ).
 587   END.
 588   RUN log( 99, "Program list: " + program-list ).
 589
 590 END PROCEDURE.
 591
 592 /* _UIB-CODE-BLOCK-END */
 593 &ANALYZE-RESUME
 594
 595
 596 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE check-triggers Procedure
 597 PROCEDURE check-triggers :
 598 /*------------------------------------------------------------------------------
 599   Purpose:
 600 ------------------------------------------------------------------------------*/
 601 DEF VAR i AS INT NO-UNDO.
 602 DEF VAR trig-file AS CHAR NO-UNDO.
 603 DEF VAR pb AS INT NO-UNDO.
 604
 605   RUN log( 3, "Removing known triggers from list of " + STRING(no-programs) + " programs.").
 606   REPEAT i = 1 TO NUM-ALIASES:
 607     RUN log( 23, "Alias " + STRING(i, "99 ") + ALIAS(i) + " = " + LDBNAME(ALIAS(i)) + "   ==> " + PDBNAME(ALIAS(i))) .
 608   END.
 609
 610   FOR EACH dictdb._File-Trig NO-LOCK:
 611     trig-file = REPLACE( dictdb._File-Trig._Proc-Name, '/', '\').
 612     IF SUBSTRING( trig-file, 1, 8) <> "TRIGGER\" THEN trig-file = "TRIGGER\" + trig-file.
 613     trig-file = ".\" + trig-file.
 614
 615     i = LOOKUP( trig-file, program-list ).
 616     IF i > 0 THEN
 617       RUN program-found( trig-file ).
 618     ELSE
 619       RUN log(5, "Trigger '" + trig-file + "' not found.").
 620   END.
 621
 622   FOR EACH dictdb._Field-Trig NO-LOCK:
 623     trig-file = REPLACE( dictdb._Field-Trig._Proc-Name, '/', '\').
 624     IF SUBSTRING( trig-file, 1, 8) <> "TRIGGER\" THEN trig-file = "TRIGGER\" + trig-file.
 625     trig-file = ".\" + trig-file.
 626
 627     i = LOOKUP( trig-file, program-list ).
 628     IF i > 0 THEN
 629       RUN program-found( trig-file ).
 630     ELSE
 631       RUN log(5, "Trigger '" + trig-file + "' not found.").
 632   END.
 633
 634   RUN log( 99, "Program list: " + program-list ).
 635
 636 END PROCEDURE.
 637
 638 /* _UIB-CODE-BLOCK-END */
 639 &ANALYZE-RESUME
 640
 641
 642 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE known-problems Procedure
 643 PROCEDURE known-problems :
 644 /*------------------------------------------------------------------------------
 645   Purpose:  Mark known problems as 'found'
 646 ------------------------------------------------------------------------------*/
 647 DEF VAR p1 AS INT NO-UNDO.
 648 DEF VAR p2 AS INT NO-UNDO.
 649
 650   RUN log( 3, "Marking known problems as 'found'").
 651
 652   RUN log( 12, "Marking all in .\process\one-off as found. No-programs = " + STRING(no-programs)).
 653   p1 = INDEX( program-list, ".\process\one-off\" ).
 654   IF p1 > 0 THEN DO:
 655     p2 = R-INDEX( program-list, ".\process\one-off\" ).
 656     p2 = INDEX( program-list, ",", p2).
 657     RUN log( 24, "p1 = " + STRING(p1) + ", p2 = " + STRING(p2)
 658                + ",  substring( list, p1, 30) = " + SUBSTRING( program-list, p1, 30)
 659                + ",  substring( list, p2-10, 30) = " + SUBSTRING( program-list, p2 - 10, 30)).
 660
 661     IF p2 > 0 THEN
 662       found-list = found-list + SUBSTRING( program-list, p1, p2 - p1 + 1).
 663     ELSE
 664       found-list = found-list + SUBSTRING( program-list, p1) + ",".
 665
 666     program-list = SUBSTRING( program-list, 1, p1 - 1 )
 667                  + (IF p2 > 0 THEN SUBSTRING( program-list, p2 + 1) ELSE "").
 668   END.
 669   no-programs = NUM-ENTRIES( program-list ).
 670   RUN log( 12, "Done marking .\process\one-off as found. No-programs = " + STRING(no-programs)).
 671
 672 /*****************************************************************************
 673 Inside this comment go the subsidiary calls, which means that they will be
 674         found when we process findcrap.p (which is in the process\one-off
 675         directory and so will be found).  They're not meant to compile(!) so
 676         the trailing period is missing from each line.
 677 ******************************************************************************
 678 RUN win\sysmgr.w
 679 RUN process\daily.p
 680 RUN process\loadusrs.p
 681 RUN process\dumpall.p
 682 RUN process\dumpmost.p
 683 RUN process\report\report.p
 684 RUN process\report\schdakld.p
 685 RUN process\report\schdsdny.p
 686 RUN process\report\schdglen.p
 687 RUN process\report\cntrtlst.p
 688 RUN process\report\lglnam.p
 689 RUN process\report\tntaddr.p
 690 RUN process\report\wofexpry.p
 691 RUN process\report\menulist.p
 692 RUN process\report\vcntspce.p
 693 RUN process\report\rntlarea.p
 694 ******************************************************** That's all folks... */
 695
 696   RUN log( 3, "Finished marking known problems.").
 697
 698 END PROCEDURE.
 699
 700 /* _UIB-CODE-BLOCK-END */
 701 &ANALYZE-RESUME
 702
 703
 704 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE log Procedure
 705 PROCEDURE log :
 706 /*------------------------------------------------------------------------------
 707   Purpose:  write output formatted as a log entry
 708 ------------------------------------------------------------------------------*/
 709 DEF INPUT PARAMETER depth AS INT NO-UNDO.
 710 DEF INPUT PARAMETER entry-text AS CHAR NO-UNDO.
 711
 712   IF depth > log-depth THEN RETURN.
 713   OUTPUT TO VALUE(log-name) KEEP-MESSAGES APPEND.
 714   PUT UNFORMATTED STRING( YEAR(TODAY), "9999") + "-" + STRING( MONTH(TODAY), "99") + "-" + STRING( DAY(TODAY), "99")
 715                   + " " + STRING( TIME, "HH:MM:SS")
 716                   + " " + STRING( depth, ">>9")
 717                   + " " + entry-text
 718                   SKIP.
 719   OUTPUT CLOSE.
 720 END PROCEDURE.
 721
 722 /* _UIB-CODE-BLOCK-END */
 723 &ANALYZE-RESUME
 724
 725
 726 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE parse-options Procedure
 727 PROCEDURE parse-options :
 728 /*------------------------------------------------------------------------------
 729   Purpose:
 730 ------------------------------------------------------------------------------*/
 731 DEF VAR i AS INT NO-UNDO.
 732 DEF VAR token AS CHAR NO-UNDO.
 733
 734   DO i = 1 TO NUM-ENTRIES( process-options, "~n" ):
 735     token = ENTRY( i, process-options, "~n" ).
 736     CASE ENTRY( 1, token ):
 737       WHEN "Log-Depth" THEN log-depth = INTEGER( TRIM(ENTRY( 2, token ))).
 738       WHEN "Preview" THEN preview = (ENTRY( 2, token ) = "Yes").
 739       WHEN "Archive" THEN archive = ENTRY( 2, token ).
 740       OTHERWISE DO:
 741         MESSAGE "Unknown option '" + token + "' ignored."
 742                 VIEW-AS ALERT-BOX WARNING
 743                 TITLE "Unknown option".
 744         RETURN 'FAIL'.
 745       END.
 746     END CASE.
 747
 748   END.
 749
 750 END PROCEDURE.
 751
 752 /* _UIB-CODE-BLOCK-END */
 753 &ANALYZE-RESUME
 754
 755
 756 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE process-dir Procedure
 757 PROCEDURE process-dir :
 758 /*------------------------------------------------------------------------------
 759   Purpose:  Add programs in a directory onto program-list
 760 ------------------------------------------------------------------------------*/
 761 DEF INPUT PARAMETER path AS CHAR NO-UNDO.
 762 DEF INPUT PARAMETER spec AS CHAR NO-UNDO.
 763 DEF INPUT PARAMETER extensions AS CHAR NO-UNDO.
 764
 765 DEF VAR file-name AS CHAR NO-UNDO.
 766 DEF VAR full-path AS CHAR NO-UNDO.
 767 DEF VAR file-type AS CHAR NO-UNDO.
 768 DEF VAR extension AS CHAR NO-UNDO.
 769
 770 DEF VAR dir-list AS CHAR INITIAL "" NO-UNDO.
 771 DEF VAR no-dirs AS INT   INITIAL 0  NO-UNDO.
 772 DEF VAR i AS INT NO-UNDO.
 773
 774   INPUT FROM OS-DIR( path ) .
 775   directory-entry-loop:
 776   REPEAT:
 777
 778     IMPORT file-name full-path file-type.
 779     file-type = SUBSTRING( file-type, 1, 1).
 780
 781     /* skip ., .., ... etc. */
 782     IF SUBSTRING( file-name, 1, 1) = "." THEN NEXT directory-entry-loop.
 783
 784     CASE file-type:
 785       WHEN "D" THEN DO:
 786         dir-list = dir-list + (IF dir-list = "" THEN "" ELSE ",") + path + "\" + file-name.
 787       END.
 788
 789       WHEN "F" THEN DO:
 790         ASSIGN extension = SUBSTRING( file-name, R-INDEX( file-name, '.') ) NO-ERROR.
 791         IF file-name MATCHES spec AND LOOKUP( extension, extensions) > 0 THEN DO:
 792           full-path = path + '\' + file-name.
 793           IF LOOKUP( full-path, program-list ) = 0 THEN ASSIGN
 794               program-list = program-list
 795                                + (IF no-programs = 0 THEN "" ELSE ",")
 796                                + full-path
 797               no-programs  = no-programs + 1.
 798         END.
 799       END.
 800     END CASE.
 801
 802   END.
 803
 804   INPUT CLOSE.
 805
 806   no-dirs = NUM-ENTRIES( dir-list ).
 807   DO i = 1 TO no-dirs:
 808     full-path = ENTRY( i, dir-list).
 809     RUN log( 35, "Recursing into '" + full-path + "'").
 810     RUN process-dir( full-path, spec, extensions ).
 811   END.
 812
 813 END PROCEDURE.
 814
 815 /* _UIB-CODE-BLOCK-END */
 816 &ANALYZE-RESUME
 817
 818
 819 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE program-found Procedure
 820 PROCEDURE program-found :
 821 /*------------------------------------------------------------------------------
 822   Purpose:
 823   Parameters:  <none>
 824   Notes:
 825 ------------------------------------------------------------------------------*/
 826 DEF INPUT PARAMETER prog-file AS CHAR NO-UNDO.
 827
 828 DEF VAR i AS INT NO-UNDO.
 829
 830   RUN log(29, "Program '" + prog-file + "' found - " + STRING(no-programs) + " remain.").
 831
 832   i = INDEX( program-list, prog-file).
 833   IF i > 0 THEN ASSIGN
 834     program-list = SUBSTRING( program-list, 1, i - 1)
 835                  + SUBSTRING( program-list, i + LENGTH(prog-file) + 1)
 836     found-list = found-list + prog-file + ","
 837     no-programs = no-programs - 1.
 838   ELSE
 839     RUN log( 5, "Program '" + prog-file + "' found, but not located in program-list!").
 840
 841 END PROCEDURE.
 842
 843 /* _UIB-CODE-BLOCK-END */
 844 &ANALYZE-RESUME
 845
 846