xmlwrite.pp, htmwrite.pp: replaced inheritance by composition. TxxxWriter always writes to a TStream (or its descendant), and for text files we use a simple TStream-compatible wrapper.

git-svn-id: trunk@15755 -
This commit is contained in:
sergei 2010-08-08 22:25:37 +00:00
parent 9365eb48c0
commit 320f67eab2
2 changed files with 48 additions and 84 deletions

View File

@ -44,6 +44,7 @@ type
THTMLWriter = class(TObject)
private
FStream: TStream;
FInsideTextNode: Boolean;
FBuffer: PChar;
FBufPos: PChar;
@ -59,7 +60,6 @@ type
procedure AttrSpecialCharCallback(c: WideChar);
procedure TextNodeSpecialCharCallback(c: WideChar);
protected
procedure Write(const Buffer; Count: Longint); virtual; abstract;
procedure WriteNode(Node: TDOMNode);
procedure VisitDocument(Node: TDOMNode);
procedure VisitElement(Node: TDOMNode);
@ -72,40 +72,30 @@ type
procedure VisitDocumentType(Node: TDOMNode);
procedure VisitPI(Node: TDOMNode);
public
constructor Create;
constructor Create(AStream: TStream);
destructor Destroy; override;
end;
TTextHTMLWriter = Class(THTMLWriter)
TTextStream = class(TStream)
Private
F : ^Text;
Protected
Procedure Write(Const Buffer; Count : Longint);override;
Public
constructor Create(var AFile: Text);
end;
TStreamHTMLWriter = Class(THTMLWriter)
Private
F : TStream;
Protected
Procedure Write(Const Buffer; Count : Longint);override;
Public
constructor Create(AStream: TStream);
function Write(Const Buffer; Count: Longint): Longint; override;
end;
{ ---------------------------------------------------------------------
TTextHTMLWriter
TTextStream
---------------------------------------------------------------------}
constructor TTextHTMLWriter.Create(var AFile: Text);
constructor TTextStream.Create(var AFile: Text);
begin
inherited Create;
f := @AFile;
end;
procedure TTextHTMLWriter.Write(const Buffer; Count: Longint);
function TTextStream.Write(const Buffer; Count: Longint): Longint;
var
s: string;
begin
@ -114,33 +104,17 @@ begin
SetString(s, PChar(@Buffer), Count);
system.Write(f^, s);
end;
Result := Count;
end;
{ ---------------------------------------------------------------------
TStreamHTMLWriter
---------------------------------------------------------------------}
constructor TStreamHTMLWriter.Create(AStream: TStream);
begin
inherited Create;
F := AStream;
end;
procedure TStreamHTMLWriter.Write(const Buffer; Count: Longint);
begin
if Count > 0 then
F.Write(Buffer, Count);
end;
{ ---------------------------------------------------------------------
THTMLWriter
---------------------------------------------------------------------}
constructor THTMLWriter.Create;
constructor THTMLWriter.Create(AStream: TStream);
begin
inherited Create;
FStream := AStream;
// some overhead - always be able to write at least one extra UCS4
FBuffer := AllocMem(512+32);
FBufPos := FBuffer;
@ -153,7 +127,7 @@ end;
destructor THTMLWriter.Destroy;
begin
if FBufPos > FBuffer then
write(FBuffer^, FBufPos-FBuffer);
FStream.write(FBuffer^, FBufPos-FBuffer);
FreeMem(FBuffer);
inherited Destroy;
@ -171,7 +145,7 @@ begin
begin
if pb >= @FBuffer[FCapacity] then
begin
write(FBuffer^, FCapacity);
FStream.write(FBuffer^, FCapacity);
Dec(pb, FCapacity);
if pb > FBuffer then
Move(FBuffer[FCapacity], FBuffer^, pb - FBuffer);
@ -525,18 +499,25 @@ begin
end;
procedure WriteHTMLFile(doc: TXMLDocument; var AFile: Text);
var
s: TStream;
begin
with TTextHTMLWriter.Create(AFile) do
s := TTextStream.Create(AFile);
try
WriteNode(doc);
with THTMLWriter.Create(s) do
try
WriteNode(doc);
finally
Free;
end;
finally
Free;
s.Free;
end;
end;
procedure WriteHTMLFile(doc: TXMLDocument; AStream: TStream);
begin
with TStreamHTMLWriter.Create(AStream) do
with THTMLWriter.Create(AStream) do
try
WriteNode(doc);
finally

View File

@ -52,6 +52,7 @@ type
TXMLWriter = class(TObject)
private
FStream: TStream;
FInsideTextNode: Boolean;
FCanonical: Boolean;
FIndent: WideString;
@ -76,7 +77,6 @@ type
procedure WriteNSDef(B: TBinding);
procedure NamespaceFixup(Element: TDOMElement);
protected
procedure Write(const Buffer; Count: Longint); virtual; abstract;
procedure WriteNode(Node: TDOMNode);
procedure VisitDocument(Node: TDOMNode);
procedure VisitDocument_Canonical(Node: TDOMNode);
@ -90,40 +90,30 @@ type
procedure VisitDocumentType(Node: TDOMNode);
procedure VisitPI(Node: TDOMNode);
public
constructor Create;
constructor Create(AStream: TStream);
destructor Destroy; override;
end;
TTextXMLWriter = Class(TXMLWriter)
TTextStream = class(TStream)
Private
F : ^Text;
Protected
Procedure Write(Const Buffer; Count : Longint);override;
Public
constructor Create(var AFile: Text);
end;
TStreamXMLWriter = Class(TXMLWriter)
Private
F : TStream;
Protected
Procedure Write(Const Buffer; Count : Longint);override;
Public
constructor Create(AStream: TStream);
function Write(Const Buffer; Count: Longint): Longint; override;
end;
{ ---------------------------------------------------------------------
TTextXMLWriter
TTextStream
---------------------------------------------------------------------}
constructor TTextXMLWriter.Create(var AFile: Text);
constructor TTextStream.Create(var AFile: Text);
begin
inherited Create;
f := @AFile;
end;
procedure TTextXMLWriter.Write(const Buffer; Count: Longint);
function TTextStream.Write(const Buffer; Count: Longint): Longint;
var
s: string;
begin
@ -132,26 +122,9 @@ begin
SetString(s, PChar(@Buffer), Count);
system.Write(f^, s);
end;
Result := Count;
end;
{ ---------------------------------------------------------------------
TStreamXMLWriter
---------------------------------------------------------------------}
constructor TStreamXMLWriter.Create(AStream: TStream);
begin
inherited Create;
F := AStream;
end;
procedure TStreamXMLWriter.Write(const Buffer; Count: Longint);
begin
if Count > 0 then
F.Write(Buffer, Count);
end;
{ ---------------------------------------------------------------------
TXMLWriter
---------------------------------------------------------------------}
@ -166,11 +139,12 @@ const
ltStr = '<';
gtStr = '>';
constructor TXMLWriter.Create;
constructor TXMLWriter.Create(AStream: TStream);
var
I: Integer;
begin
inherited Create;
FStream := AStream;
// some overhead - always be able to write at least one extra UCS4
FBuffer := AllocMem(512+32);
FBufPos := FBuffer;
@ -208,7 +182,7 @@ begin
FScratch.Free;
FNSHelper.Free;
if FBufPos > FBuffer then
write(FBuffer^, FBufPos-FBuffer);
FStream.write(FBuffer^, FBufPos-FBuffer);
FreeMem(FBuffer);
inherited Destroy;
@ -226,7 +200,7 @@ begin
begin
if pb >= @FBuffer[FCapacity] then
begin
write(FBuffer^, FCapacity);
FStream.write(FBuffer^, FCapacity);
Dec(pb, FCapacity);
if pb > FBuffer then
Move(FBuffer[FCapacity], FBuffer^, pb - FBuffer);
@ -612,6 +586,8 @@ begin
wrtChars('/>', 2)
else
begin
// TODO: presence of zero-length textnodes triggers the indenting logic,
// while they should be ignored altogeter.
SavedInsideTextNode := FInsideTextNode;
wrtChr('>');
FInsideTextNode := FCanonical or (Child.NodeType in [TEXT_NODE, CDATA_SECTION_NODE]);
@ -837,18 +813,25 @@ begin
end;
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
var
s: TStream;
begin
with TTextXMLWriter.Create(AFile) do
s := TTextStream.Create(AFile);
try
WriteNode(doc);
with TXMLWriter.Create(s) do
try
WriteNode(doc);
finally
Free;
end;
finally
Free;
s.Free;
end;
end;
procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream);
begin
with TStreamXMLWriter.Create(AStream) do
with TXMLWriter.Create(AStream) do
try
WriteNode(doc);
finally