adxchrflt.pas

Async Professional 4.04

{*********************************************************}
{*                  ADXCHRFLT.PAS 4.04                   *}
{*         Copyright (C) TurboPower Software 2002        *}
{*                 All rights reserved.                  *}
{*********************************************************}
{*          Character streams, input and output          *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

unit AdXChrFlt;

interface

uses
  SysUtils,
  Classes,
  OOMisc,
  AdXBase,
  AdExcept;

const
  ApxEndOfStream = #1;
  ApxEndOfReplaceText = #2;
  ApxNullChar = #3;

type
  TApdStreamFormat = {character formats of stream...}
     (sfUTF8,       {..UTF8 -- the default}
      sfUTF16LE,    {..UTF16, little endian (eg, Intel)}
      sfUTF16BE,    {..UTF16, big endian}
      sfISO88591);  {..ISO-8859-1, or Latin 1}

  TApdBaseCharFilter = class(TObject)
    protected
      FBufSize : Longint;
      FBuffer  : PAnsiChar;
      FBufPos  : Longint;
      FFormat  : TApdStreamFormat; {The format of the incoming stream}
      FFreeStream : Boolean;
      FStream  : TStream;
      FStreamPos : Longint;
      FStreamSize : Longint;
    protected
      function csGetSize : Longint; virtual;
      procedure csSetFormat(const aValue : TApdStreamFormat); virtual; abstract;
    public
      constructor Create(aStream : TStream; const aBufSize : Longint); virtual;
      destructor Destroy; override;

      property BufSize : Longint
         read FBufSize;

      property FreeStream : Boolean
         read FFreeStream write FFreeStream;

      property Stream : TStream
         read FStream;

    end;

  TApdInCharFilter = class(TApdBaseCharFilter)
    private
      FBufEnd    : Longint;
      FUCS4Char  : TApdUcs4Char;
      FLine      : Longint;
      FLinePos   : Longint;
      FLastChar  : DOMChar;
      FEOF       : Boolean;
      FBufDMZ    : Longint;
      FInTryRead : Boolean;
    protected
      procedure csAdvanceLine;
      procedure csAdvanceLinePos;
      procedure csGetCharPrim(var aCh : TApdUcs4Char;
                              var aIsLiteral : Boolean);
      function csGetNextBuffer : Boolean;
      function csGetTwoAnsiChars(var Buffer) : Boolean;
      function csGetUtf8Char : TApdUcs4Char;
      procedure csIdentifyFormat;
      procedure csPushCharPrim(aCh : TApdUcs4Char);
      procedure csSetFormat(const aValue : TApdStreamFormat); override;

      procedure csGetChar(var aCh : TApdUcs4Char;
                          var aIsLiteral : Boolean);

    public
      constructor Create(aStream : TStream; const aBufSize : Longint); override;

      property Format : TApdStreamFormat
         read FFormat
         write csSetFormat;
      property EOF : Boolean
         read FEOF;
    public
      procedure SkipChar;
      function TryRead(const S : array of Longint) : Boolean;
      function ReadChar : DOMChar;
      function ReadAndSkipChar : DOMChar;
      property Line : LongInt
         read FLine;
      property LinePos : LongInt
         read FLinePos;
  end;

  TApdOutCharFilter = class(TApdBaseCharFilter)
    protected
      FFormat : TApdStreamFormat;
      FSetUTF8Sig : Boolean;
    protected
      function csGetSize : LongInt; override;
      procedure csPutUtf8Char(const aCh : TApdUcs4Char);
      procedure csSetFormat(const aValue : TApdStreamFormat); override;
      procedure csWriteBuffer;
    public
      constructor Create(aStream : TStream; const aBufSize : Longint); override;
      destructor Destroy; override;

      procedure PutUCS4Char(aCh : TApdUcs4Char);
      function  PutChar(aCh1, aCh2 : DOMChar;
                    var aBothUsed  : Boolean) : Boolean;
      function  PutString(const aText : DOMString) : Boolean;
      function Position : integer;

      property Format : TApdStreamFormat
         read FFormat
         write csSetFormat;
      property WriteUTF8Signature : Boolean
         read FSetUTF8Sig
         write FSetUTF8Sig;
      property Size : LongInt
         read csGetSize;

  end;


implementation

const
  CR      = 13; {Carriage return}
  LF      = 10; {Line feed}

{====================================================================}
constructor TApdBaseCharFilter.Create(aStream  : TStream;
                               const aBufSize : Longint);
begin
  inherited Create;
  Assert(Assigned(aStream));
  FBufSize := aBufSize;
  FBufPos := 0;
  FFormat := sfUTF8;
  FFreeStream := False;
  FStream := aStream;
  FStreamPos := aStream.Position;
  FStreamSize := aStream.Size;
  GetMem(FBuffer, FBufSize);
end;
{--------}
destructor TApdBaseCharFilter.Destroy;
begin
  if Assigned(FBuffer) then begin
    FreeMem(FBuffer, FBufSize);
    FBuffer := nil;
  end;

  if FFreeStream then
    FStream.Free;

  inherited Destroy;
end;
{--------}
function TApdBaseCharFilter.csGetSize : LongInt;
begin
  Result := FStreamSize;
end;
{====================================================================}
constructor TApdInCharFilter.Create(aStream  : TStream;
                             const aBufSize : Longint);
begin
  inherited Create(aStream, aBufSize);
  if FStreamSize <= aBufSize then
    FBufDMZ := 0
  else
    FBufDMZ := 64;
  FBufEnd := 0;
  FLine := 1;
  FLinePos := 1;
  csIdentifyFormat;
  if aStream.Size > 0 then
    FEOF := False
  else
    FEOF := True;
  FUCS4Char := TApdUCS4Char(ApxNullChar);
  FInTryRead := False;
end;
{--------}
procedure TApdInCharFilter.csAdvanceLine;
begin
  Inc(FLine);
  FLinePos := 1;
end;
{--------}
procedure TApdInCharFilter.csAdvanceLinePos;
begin
  Inc(FLinePos);
end;
{--------}
procedure TApdInCharFilter.csGetCharPrim(var aCh : TApdUcs4Char;
                                        var aIsLiteral : Boolean);
begin
  {Note: as described in the XML spec (2.11) all end-of-lines are
         passed as LF characters no matter what the original document
         had. This routine converts a CR/LF pair to a single LF, a
         single CR to an LF, and passes LFs as they are.}

  {get the first (test) character}
  {first check the UCS4Char buffer to see if we have a character there;
   if so get it}
 if (FUCS4Char <> TApdUCS4Char(ApxNullChar)) then begin
    aCh := FUCS4Char;
    FUCS4Char := TApdUCS4Char(ApxNullChar);
  end
  {otherwise get a character from the buffer; this depends on the
   format of the stream of course}
  else begin
    case Format of
      sfUTF8     : aCh := csGetUtf8Char;
    else
      {it is next to impossible that this else clause is reached; if
       it is we're in deep doggy doo-doo, so pretending that it's the
       end of the stream is the least of our worries}
      aCh := TApdUCS4Char(ApxEndOfStream);
    end;
  end;

  {if we got a CR, then we need to see what the next character is; if
   it is an LF, return LF; otherwise put the second character  back
   and still return an LF}
  if (aCh = CR) then begin
    if (FUCS4Char <> TApdUCS4Char(ApxNullChar)) then begin
      aCh := FUCS4Char;
      FUCS4Char := TApdUCS4Char(ApxNullChar);
    end
    else begin
      case Format of
        sfUTF8     : aCh := csGetUtf8Char;
      else
        aCh := TApdUCS4Char(ApxEndOfStream);
      end;
    end;
    if (aCh <> LF) then
      csPushCharPrim(aCh);
    aCh := LF;
  end;

  {check to see that the character is valid according to XML}
  if (aCh <> TApdUCS4Char(ApxEndOfStream)) and (not ApxIsChar(aCh)) then
    raise EAdFilterError.CreateError(FStream.Position,
                                     Line,
                                     LinePos,
                                     sInvalidXMLChar);
end;
{--------}
function TApdInCharFilter.csGetNextBuffer : Boolean;
begin
  if FStream.Position > FBufDMZ then
    {Account for necessary buffer overlap}
    FStream.Position := FStream.Position - (FBufEnd - FBufPos);
  FBufEnd := FStream.Read(FBuffer^, FBufSize);
  FStreamPos := FStream.Position;
  FBufPos := 0;
  Result := FBufEnd <> 0;
end;
{--------}
function TApdInCharFilter.csGetTwoAnsiChars(var Buffer) : Boolean;
type
  TTwoChars = array [0..1] of AnsiChar;
var
  i : integer;
begin
  {get two byte characters from the stream}
  for i := 0 to 1 do begin
    {if the buffer is empty, fill it}
    if (FBufPos >= FBufEnd - FBufDMZ) and
       (not FInTryRead) then begin
      {if we exhaust the stream, we couldn't satisfy the request}
      if not csGetNextBuffer then begin
        Result := false;
        Exit;
      end;
    end;
    {get the first byte character from the buffer}
    TTwoChars(Buffer)[i] := FBuffer[FBufPos];
    inc(FBufPos);
  end;
  Result := true;
end;
{--------}
function TApdInCharFilter.csGetUtf8Char : TApdUcs4Char;
var
  Utf8Char : TApdUtf8Char;
  {Ch       : AnsiChar;}
  Len      : Integer;
  i        : Integer;
begin
  {if the buffer is empty, fill it}
  if (not FInTryRead) and
     (FBufPos >= FBufEnd - FBufDMZ) then begin
    {if we exhaust the stream, there are no more characters}
    if not csGetNextBuffer then begin
      Result := TApdUCS4Char(ApxEndOfStream);
      Exit;
    end;
  end;