UNIT PackBuf;

{$i platform.inc}

{ this routine is used to pack a message in a buffer and have a }
{ routine called when the buffer is full.                       }

{## start a new PackBuf_AddLine_WithExtract}

INTERFACE

TYPE PackBufArray = ARRAY[0..65528] OF BYTE;
     PackBufPtr   = ^PackBufArray;

TYPE PackBufFlushProcType = PROCEDURE (VAR Buffer; Count : WORD; APtr : POINTER);

TYPE LineTerminatorTypes = (lttCR,    { FTN }
                            lttLF,    { RFC }
                            lttCRLF); { SMTP }

FUNCTION  PackBuf_Init (FlushProc : PackBufFlushProcType; LineTerminator : LineTerminatorTypes; APtr : POINTER) : BOOLEAN;
FUNCTION  PackBuf_AddLine (VAR Regel : STRING) : BOOLEAN;
PROCEDURE PackBuf_AddRaw (VAR Buffer; Count : WORD);
FUNCTION  PackBuf_GetAndResetCounter : LONGINT;
PROCEDURE PackBuf_ReplaceNul (NewChar : CHAR);
PROCEDURE PackBuf_Done;


IMPLEMENTATION

USES Globals,
     Logs;

{ configuration }
VAR Flusher     : PackBufFlushProcType;
    Terminator  : LineTerminatorTypes;
    SomePtr     : POINTER;
    NewNul      : CHAR;

{ packed buffer }
VAR PackedPtr   : PackBufPtr;
    PackedSize,
    PackedCount : WORD;
    PackedTotal : LONGINT;


{--------------------------------------------------------------------------}
{ PackBuf_Init                                                             }
{                                                                          }
{ This function must be called to initialize for an export. A block of     }
{ memory is allocated to store the packed message in (freed by             }
{ PackBuf_Done) and the Flusher function and Line Terminator are stored.   }
{ After this call, PackBuf_AddLine can be called for each line to export.  }
{                                                                          }
FUNCTION PackBuf_Init (FlushProc : PackBufFlushProcType; LineTerminator : LineTerminatorTypes; APtr : POINTER) : BOOLEAN;
BEGIN
     {LogMessage ('PackBuf_Init');}

     { alloc memory for packed message buffer }
     IF (NOT CalcMaxAllowedMem (PackedSize,2000,10000)) THEN
     BEGIN
          LogMessage (liFatal,'[PackBufInit] Low on memory!');
          PackBuf_Init:=FALSE; { error }
          Exit;
     END;

     GetMem (PackedPtr,PackedSize);
     {$IFDEF LogGetMem} LogGetMem (PackedPtr,PackedSize,'PackBuf'); {$ENDIF}
     PeekMem;

     PackedCount:=0;
     PackedTotal:=0;

     { store configuration parameters }
     Flusher:=FlushProc;
     Terminator:=LineTerminator;
     SomePtr:=APtr;
     NewNul:=#0;

     PackBuf_Init:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ PackBuf_GetAndResetCounter                                               }
{                                                                          }
{ This routine returns the current counter and resets it back to 0.        }
{                                                                          }
FUNCTION PackBuf_GetAndResetCounter : LONGINT;
BEGIN
     PackBuf_GetAndResetCounter:=PackedTotal;
     PackedTotal:=0;
END;


{--------------------------------------------------------------------------}
{ PackBuf_AddLine                                                          }
{                                                                          }
{ This routine is called by MsgsForEach for each line in a block. This     }
{ line is added to the packed buffer and the #13 at the end of internal    }
{ lines is replaced with the set terminator for the current type.          }
{ If the buffer is full, then the configured Flusher function is called to }
{ write the data out. The buffer is then emptied and ready for the next    }
{ line to be added.                                                        }
{ This routine always returns FALSE (=continue).                           }
{                                                                          }
FUNCTION PackBuf_AddLine (VAR Regel : STRING) : BOOLEAN;

VAR L : BYTE;
{$IFDEF Pre}
    P : BYTE;
{$ENDIF}

BEGIN
     PackBuf_AddLine:=FALSE; { continue processing }

     L:=Length (Regel);

     IF (L > (PackedSize-PackedCount-1)) THEN
     BEGIN
          Flusher (PackedPtr^,PackedCount,SomePtr);
          PackedCount:=0;
     END;

     {$IFDEF Pre}
     P:=Pos (#13,Regel);
     IF (P > 0) AND (P < L) THEN
     BEGIN
          LogMessage (liReport,'[PackBuf] Eol case!');
          LogExtraMessage ('In: "'+Regel+'"');
     END;
     {$ENDIF}

     { replace all NULs in the body }
     IF (NewNul <> #0) THEN
        WHILE (Pos (#0,Regel) > 0) DO
        BEGIN
             {$IFDEF Pre}
             LogMessage (liReport,'Replaced NUL in body!');
             {$ENDIF}
             Regel[Pos (#0,Regel)]:=NewNul;
        END;

     IF (Regel[L] = #13) THEN
     BEGIN
          Dec (L);
          Move (Regel[1],PackedPtr^[PackedCount],L);
          Inc (PackedCount,L);
          Inc (PackedTotal,L);

          IF (Terminator IN [lttCR,lttCRLF]) THEN
          BEGIN
               PackedPtr^[PackedCount]:=13; { CR }
               Inc (PackedCount);
               Inc (PackedTotal);
          END;

          IF (Terminator IN [lttLF,lttCRLF]) THEN
          BEGIN
               PackedPtr^[PackedCount]:=10; { LF }
               Inc (PackedCount);
               Inc (PackedTotal);
          END;
     END ELSE
     BEGIN
          Move (Regel[1],PackedPtr^[PackedCount],L);
          Inc (PackedCount,L);
          Inc (PackedTotal,L);
     END;
END;


{--------------------------------------------------------------------------}
{ PackBuf_AddRaw                                                           }
{                                                                          }
{ This routine can be used to directly add an series of bytes to the       }
{ PackBuf intermediate buffer. It does not perform any CR/LF pair          }
{ replacing.                                                               }
{                                                                          }
PROCEDURE PackBuf_AddRaw (VAR Buffer; Count : WORD);

TYPE A = ARRAY[1..16000] OF BYTE;

BEGIN
     IF (Count > (PackedSize-PackedCount-1)) THEN
     BEGIN
          Flusher (PackedPtr^,PackedCount,SomePtr);
          PackedCount:=0;
     END;

     Move (A(Buffer)[1],PackedPtr^[PackedCount],Count);
     Inc (PackedCount,Count);
     Inc (PackedTotal,Count);
END;


{--------------------------------------------------------------------------}
{ PackBuf_ReplaceNul                                                       }
{                                                                          }
{ This routine can be called to set a replacement character for the NUL.   }
{ This is used to prevent the NUL from showing up in PKT and *.MSG bodies  }
{ because it means "end of body". When not set to #0, all characters that  }
{ are added to PackBuf with PackBuf_AddLine are tested to #0 and           }
{ occurances are replaced with the character given here.                   }
{                                                                          }
PROCEDURE PackBuf_ReplaceNul (NewChar : CHAR);
BEGIN
     NewNul:=NewChar;
END;


{--------------------------------------------------------------------------}
{ PackBuf_Done                                                             }
{                                                                          }
{ This routine must be called when all the of lines have been added to the }
{ buffer. This routine calls the flush function if any bytes are left in   }
{ the buffer and then frees the memory occupied by the buffer.             }
{                                                                          }
PROCEDURE PackBuf_Done;
BEGIN
     {LogMessage ('PackBuf_Done');}

     IF (PackedCount > 0) THEN
        Flusher (PackedPtr^,PackedCount,SomePtr);

     {$IFDEF LogGetMem} LogGetMem (PackedPtr,PackedSize,'free PackBuf'); {$ENDIF}
     FreeMem (PackedPtr,PackedSize);

     PackedPtr:=NIL;
     PackedSize:=0;

     Flusher:=NIL;
END;


{--------------------------------------------------------------------------}
{ Unit Initialization                                                      }
{                                                                          }
BEGIN
     PackedPtr:=NIL;
     PackedSize:=0;
END.
