rplctn/repldump.p

   1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
   2 &ANALYZE-RESUME
   3 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
   4 /*--------------------------------------------------------------------------
   5     File        : rplctn/repldump.p
   6     Purpose     : Dump un-dumped replication log entries to a replication file
   7
   8     Description :
   9
  10     Author(s)   :
  11     Created     :
  12     Notes       :
  13   ------------------------------------------------------------------------*/
  14
  15 {inc/ofc-this.i}
  16 {inc/ofc-set.i "Replication-MaxLogAge" "c-max-log-age"}
  17 {inc/ofc-set.i "Replication-MaxFileSize" "c-max-file-size"}
  18
  19 DEF VAR max-log-age AS INT NO-UNDO.
  20 DEF VAR max-file-size AS INT NO-UNDO.
  21 ASSIGN max-log-age = INT(c-max-log-age) NO-ERROR.
  22 ASSIGN max-file-size = INT(c-max-file-size) NO-ERROR.
  23
  24 IF max-log-age > -1 THEN .      ELSE max-log-age = 14.             /* 14 days */
  25 IF max-file-size > 16 THEN .    ELSE max-file-size = 10 * 1024.    /* 10MB */
  26 max-file-size = max-file-size * 1024.
  27
  28 /* _UIB-CODE-BLOCK-END */
  29 &ANALYZE-RESUME
  30
  31
  32 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  33
  34 /* ********************  Preprocessor Definitions  ******************** */
  35
  36 &Scoped-define PROCEDURE-TYPE Procedure
  37
  38
  39
  40 /* _UIB-PREPROCESSOR-BLOCK-END */
  41 &ANALYZE-RESUME
  42
  43
  44
  45 /* *********************** Procedure Settings ************************ */
  46
  47 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  48 /* Settings for THIS-PROCEDURE
  49    Type: Procedure
  50    Allow:
  51    Frames: 0
  52    Add Fields to: Neither
  53    Other Settings: CODE-ONLY COMPILE
  54  */
  55 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  56
  57 /* *************************  Create Window  ************************** */
  58
  59 &ANALYZE-SUSPEND _CREATE-WINDOW
  60 /* DESIGN Window definition (used by the UIB)
  61   CREATE WINDOW Procedure ASSIGN
  62          HEIGHT             = .1
  63          WIDTH              = 40.
  64 /* END WINDOW DEFINITION */
  65                                                                         */
  66 &ANALYZE-RESUME
  67
  68
  69
  70
  71 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  72
  73
  74 /* ***************************  Main Block  *************************** */
  75
  76 DO WHILE CAN-FIND( FIRST ReplLog WHERE ReplLog.DumpFile = ""):
  77   RUN dump-log-entries.
  78 END.
  79
  80 RUN delete-old-log-entries.
  81
  82 /* _UIB-CODE-BLOCK-END */
  83 &ANALYZE-RESUME
  84
  85
  86 /* **********************  Internal Procedures  *********************** */
  87
  88 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE delete-old-log-entries Procedure
  89 PROCEDURE delete-old-log-entries :
  90 /*------------------------------------------------------------------------------
  91   Purpose:  Delete log entries that are more than max-log-age days old.
  92 ------------------------------------------------------------------------------*/
  93 DEF VAR up-to AS DATE NO-UNDO.
  94
  95   up-to = TODAY - max-log-age.
  96
  97   FOR EACH ReplLog WHERE ReplLog.ReplDate < up-to EXCLUSIVE-LOCK:
  98     DELETE ReplLog.
  99   END.
 100
 101 END PROCEDURE.
 102
 103 /* _UIB-CODE-BLOCK-END */
 104 &ANALYZE-RESUME
 105
 106
 107 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE dump-log-entries Procedure
 108 PROCEDURE dump-log-entries :
 109 /*------------------------------------------------------------------------------
 110   Purpose:  Dump un-dumped log entries
 111 ------------------------------------------------------------------------------*/
 112 DEF VAR dump-file AS CHAR NO-UNDO.
 113 DEF VAR last-trans LIKE ReplLog.TransActID NO-UNDO INITIAL ?.
 114
 115   FIND FIRST ReplLog WHERE ReplLog.DumpFile = "" NO-LOCK NO-ERROR.
 116   IF NOT AVAILABLE ReplLog THEN RETURN.
 117
 118   OS-CREATE-DIR "rplctn/dump".
 119   OS-CREATE-DIR "rplctn/dump/tosend".
 120   OS-CREATE-DIR "rplctn/dump/toload".
 121   OS-CREATE-DIR "rplctn/dump/sent".
 122   OS-CREATE-DIR "rplctn/dump/loaded".
 123
 124   dump-file = "rplctn/dump/tosend/" + CAPS( STRING( Office.OfficeCode, "X(4)" ) ) +
 125     STRING( YEAR( TODAY ), "9999" ) +
 126     STRING( MONTH( TODAY ), "99" ) +
 127     STRING( DAY( TODAY ), "99" ) + REPLACE( STRING( TIME, "HH:MM:SS" ), ":", "" ) +
 128     ".rpl".
 129
 130   OUTPUT TO VALUE( dump-file ) KEEP-MESSAGES.
 131   FIND RP WHERE RP.UserName = "Replicate-" + Office.OfficeCode
 132                 AND RP.ReportID = "LastFileSent" NO-LOCK NO-ERROR.
 133   IF AVAILABLE(RP) THEN DO:
 134     PUT UNFORMATTED ">>>Previous="
 135             + SUBSTRING( RP.Char1, R-INDEX( RP.Char1, "/") + 1)
 136             SKIP.
 137   END.
 138
 139 tp-loop:
 140   FOR EACH ReplLog WHERE ReplLog.DumpFile  = "" EXCLUSIVE-LOCK:
 141     IF last-trans <> ReplLog.TransActID THEN DO:
 142       IF SEEK( OUTPUT ) > max-file-size THEN LEAVE tp-loop.
 143       last-trans = ReplLog.TransActID.
 144     END.
 145
 146     EXPORT ReplLog.
 147     ASSIGN ReplLog.DumpFile = dump-file.
 148   END.
 149
 150   OUTPUT CLOSE.
 151
 152   DO TRANSACTION:
 153     FIND RP WHERE RP.UserName = "Replicate-" + Office.OfficeCode
 154                   AND RP.ReportID = "LastFileSent" EXCLUSIVE-LOCK NO-ERROR.
 155     IF NOT AVAILABLE(RP) THEN DO:
 156       CREATE RP.
 157       RP.UserName = "Replicate-" + Office.OfficeCode.
 158       RP.ReportID = "LastFileSent" .
 159     END.
 160     RP.Char1 = dump-file.
 161   END.
 162
 163 END PROCEDURE.
 164
 165 /* _UIB-CODE-BLOCK-END */
 166 &ANALYZE-RESUME
 167
 168