paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-22 19:09:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added procedures to process XML fragments only (e.g. for merging them

Browse Source 
into an existing DOM document)
This commit is contained in:
sg 2002-09-21 19:22:38 +00:00
parent d580d60f81
commit 1f71f198e6
1 changed files with 164 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

171
fcl/xml/xmlread.pp
View File

@ -3,7 +3,7 @@
This file is part of the Free Component Library This file is part of the Free Component Library
XML reading routines. XML reading routines.
Copyright (c) 1999-2000 by Sebastian Guenther, sg@freepascal.org Copyright (c) 1999-2002 by Sebastian Guenther, sg@freepascal.org
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -34,6 +34,12 @@ procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream);
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream; procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream;
const AFilename: String); const AFilename: String);
procedure ReadXMLFragment(AParentNode: TDOMNode; const AFilename: String);
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: File);
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream);
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream;
const AFilename: String);
procedure ReadDTDFile(var ADoc: TXMLDocument; const AFilename: String); procedure ReadDTDFile(var ADoc: TXMLDocument; const AFilename: String);
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: File); procedure ReadDTDFile(var ADoc: TXMLDocument; var f: File);
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream); procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream);
@ -95,6 +101,8 @@ type
procedure ExpectEq; procedure ExpectEq;
procedure ParseMisc(AOwner: TDOMNode); // [27] procedure ParseMisc(AOwner: TDOMNode); // [27]
function ParseMarkupDecl: Boolean; // [29] function ParseMarkupDecl: Boolean; // [29]
function ParseCharData(AOwner: TDOMNode): Boolean; // [14]
function ParseCDSect(AOwner: TDOMNode): Boolean; // [18]
function ParseElement(AOwner: TDOMNode): Boolean; // [39] function ParseElement(AOwner: TDOMNode): Boolean; // [39]
procedure ExpectElement(AOwner: TDOMNode); procedure ExpectElement(AOwner: TDOMNode);
function ParseReference(AOwner: TDOMNode): Boolean; // [67] function ParseReference(AOwner: TDOMNode): Boolean; // [67]
@ -106,8 +114,9 @@ type
procedure ResolveEntities(RootNode: TDOMNode); procedure ResolveEntities(RootNode: TDOMNode);
public public
doc: TXMLReaderDocument; doc: TDOMDocument;
procedure ProcessXML(ABuf: PChar; AFilename: String); // [1] procedure ProcessXML(ABuf: PChar; AFilename: String); // [1]
procedure ProcessFragment(AOwner: TDOMNode; ABuf: PChar; AFilename: String);
procedure ProcessDTD(ABuf: PChar; AFilename: String); // ([29]) procedure ProcessDTD(ABuf: PChar; AFilename: String); // ([29])
end; end;
@ -229,6 +238,20 @@ begin
} }
end; end;
procedure TXMLReader.ProcessFragment(AOwner: TDOMNode; ABuf: PChar;
AFilename: String);
begin
buf := ABuf;
BufStart := ABuf;
Filename := AFilename;
SkipWhitespace;
while ParseCharData(AOwner) or ParseCDSect(AOwner) or ParsePI or
ParseComment(AOwner) or ParseElement(AOwner) or
ParseReference(AOwner) do
SkipWhitespace;
end;
function TXMLReader.GetName(var s: String): Boolean; // [5] function TXMLReader.GetName(var s: String): Boolean; // [5]
begin begin
@ -343,7 +366,8 @@ procedure TXMLReader.ExpectProlog; // [22]
procedure ParseVersionNum; procedure ParseVersionNum;
begin begin
doc.XMLVersion := if doc.InheritsFrom(TXMLDocument) then
TXMLDocument(doc).XMLVersion :=
GetString(['a'..'z', 'A'..'Z', '0'..'9', '_', '.', ':', '-']); GetString(['a'..'z', 'A'..'Z', '0'..'9', '_', '.', ':', '-']);
end; end;
@ -412,8 +436,9 @@ begin
// Check for "(doctypedecl Misc*)?" [28] // Check for "(doctypedecl Misc*)?" [28]
if CheckFor('<!DOCTYPE') then if CheckFor('<!DOCTYPE') then
begin begin
DocType := TXMLReaderDocumentType.Create(doc); DocType := TXMLReaderDocumentType.Create(doc as TXMLReaderDocument);
doc.SetDocType(DocType); if doc.InheritsFrom(TXMLReaderDocument) then
TXMLReaderDocument(doc).SetDocType(DocType);
SkipWhitespace; SkipWhitespace;
DocType.Name := ExpectName; DocType.Name := ExpectName;
SkipWhitespace; SkipWhitespace;
@ -714,11 +739,7 @@ begin
} }
end; end;
function TXMLReader.ParseElement(AOwner: TDOMNode): Boolean; // [39] [40] [44] function TXMLReader.ParseCharData(AOwner: TDOMNode): Boolean; // [14]
var
NewElem: TDOMElement;
function ParseCharData: Boolean; // [14]
var var
s: String; s: String;
i: Integer; i: Integer;
@ -736,13 +757,13 @@ var
while (i > 0) and (s[i] in WhitespaceChars) do while (i > 0) and (s[i] in WhitespaceChars) do
Dec(i); Dec(i);
if i > 0 then if i > 0 then
NewElem.AppendChild(doc.CreateTextNode(s)); AOwner.AppendChild(doc.CreateTextNode(s));
Result := True; Result := True;
end else end else
Result := False; Result := False;
end; end;
function ParseCDSect: Boolean; // [18] function TXMLReader.ParseCDSect(AOwner: TDOMNode): Boolean; // [18]
var var
cdata: String; cdata: String;
begin begin
@ -754,14 +775,15 @@ var
cdata := cdata + buf[0]; cdata := cdata + buf[0];
Inc(buf); Inc(buf);
end; end;
NewElem.AppendChild(doc.CreateCDATASection(cdata)); AOwner.AppendChild(doc.CreateCDATASection(cdata));
Result := True; Result := True;
end else end else
Result := False; Result := False;
end; end;
function TXMLReader.ParseElement(AOwner: TDOMNode): Boolean; // [39] [40] [44]
var
NewElem: TDOMElement;
var var
IsEmpty: Boolean; IsEmpty: Boolean;
name: String; name: String;
@ -807,7 +829,7 @@ begin
begin begin
// Get content // Get content
SkipWhitespace; SkipWhitespace;
while ParseCharData or ParseCDSect or ParsePI or while ParseCharData(NewElem) or ParseCDSect(NewElem) or ParsePI or
ParseComment(NewElem) or ParseElement(NewElem) or ParseComment(NewElem) or ParseElement(NewElem) or
ParseReference(NewElem) do; ParseReference(NewElem) do;
@ -998,41 +1020,43 @@ end;
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: File); procedure ReadXMLFile(var ADoc: TXMLDocument; var f: File);
var var
reader: TXMLReader; Reader: TXMLReader;
buf: PChar; buf: PChar;
BufSize: LongInt; BufSize: LongInt;
begin begin
ADoc := nil; ADoc := nil;
BufSize := FileSize(f) + 1; BufSize := FileSize(f) + 1;
if BufSize <= 1 then exit; if BufSize <= 1 then
exit;
GetMem(buf, BufSize); GetMem(buf, BufSize);
BlockRead(f, buf^, BufSize - 1); BlockRead(f, buf^, BufSize - 1);
buf[BufSize - 1] := #0; buf[BufSize - 1] := #0;
reader := TXMLReader.Create; Reader := TXMLReader.Create;
reader.ProcessXML(buf, Filerec(f).name); Reader.ProcessXML(buf, Filerec(f).name);
FreeMem(buf, BufSize); FreeMem(buf, BufSize);
ADoc := reader.doc; ADoc := TXMLDocument(Reader.doc);
reader.Free; Reader.Free;
end; end;
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream; procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream;
const AFilename: String); const AFilename: String);
var var
reader: TXMLReader; Reader: TXMLReader;
buf: PChar; buf: PChar;
begin begin
ADoc := nil; ADoc := nil;
if f.Size = 0 then exit; if f.Size = 0 then
exit;
GetMem(buf, f.Size + 1); GetMem(buf, f.Size + 1);
f.Read(buf^, f.Size); f.Read(buf^, f.Size);
buf[f.Size] := #0; buf[f.Size] := #0;
reader := TXMLReader.Create; Reader := TXMLReader.Create;
reader.ProcessXML(buf, AFilename); Reader.ProcessXML(buf, AFilename);
FreeMem(buf, f.Size + 1); FreeMem(buf, f.Size + 1);
ADoc := reader.doc; ADoc := TXMLDocument(Reader.doc);
reader.Free; Reader.Free;
end; end;
procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream); procedure ReadXMLFile(var ADoc: TXMLDocument; var f: TStream);
@ -1042,21 +1066,78 @@ end;
procedure ReadXMLFile(var ADoc: TXMLDocument; const AFilename: String); procedure ReadXMLFile(var ADoc: TXMLDocument; const AFilename: String);
var var
stream: TFileStream; Stream: TFileStream;
begin begin
ADoc := nil; ADoc := nil;
stream := TFileStream.Create(AFilename, fmOpenRead); Stream := TFileStream.Create(AFilename, fmOpenRead);
try try
ReadXMLFile(ADoc, stream, AFilename); ReadXMLFile(ADoc, Stream, AFilename);
finally finally
stream.Free; Stream.Free;
end;
end;
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: File);
var
Reader: TXMLReader;
buf: PChar;
BufSize: LongInt;
begin
BufSize := FileSize(f) + 1;
if BufSize <= 1 then
exit;
GetMem(buf, BufSize);
BlockRead(f, buf^, BufSize - 1);
buf[BufSize - 1] := #0;
Reader := TXMLReader.Create;
Reader.Doc := AParentNode.OwnerDocument;
Reader.ProcessFragment(AParentNode, buf, Filerec(f).name);
FreeMem(buf, BufSize);
Reader.Free;
end;
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream;
const AFilename: String);
var
Reader: TXMLReader;
buf: PChar;
begin
if f.Size = 0 then
exit;
GetMem(buf, f.Size + 1);
f.Read(buf^, f.Size);
buf[f.Size] := #0;
Reader := TXMLReader.Create;
Reader.Doc := AParentNode.OwnerDocument;
Reader.ProcessFragment(AParentNode, buf, AFilename);
FreeMem(buf, f.Size + 1);
Reader.Free;
end;
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream);
begin
ReadXMLFragment(AParentNode, f, '<Stream>');
end;
procedure ReadXMLFragment(AParentNode: TDOMNode; const AFilename: String);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(AFilename, fmOpenRead);
try
ReadXMLFragment(AParentNode, Stream, AFilename);
finally
Stream.Free;
end; end;
end; end;
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: File); procedure ReadDTDFile(var ADoc: TXMLDocument; var f: File);
var var
reader: TXMLReader; Reader: TXMLReader;
buf: PChar; buf: PChar;
BufSize: LongInt; BufSize: LongInt;
begin begin
@ -1067,17 +1148,17 @@ begin
GetMem(buf, BufSize + 1); GetMem(buf, BufSize + 1);
BlockRead(f, buf^, BufSize - 1); BlockRead(f, buf^, BufSize - 1);
buf[BufSize - 1] := #0; buf[BufSize - 1] := #0;
reader := TXMLReader.Create; Reader := TXMLReader.Create;
reader.ProcessDTD(buf, Filerec(f).name); Reader.ProcessDTD(buf, Filerec(f).name);
FreeMem(buf, BufSize); FreeMem(buf, BufSize);
ADoc := reader.doc; ADoc := TXMLDocument(Reader.doc);
reader.Free; Reader.Free;
end; end;
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream; procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream;
const AFilename: String); const AFilename: String);
var var
reader: TXMLReader; Reader: TXMLReader;
buf: PChar; buf: PChar;
begin begin
ADoc := nil; ADoc := nil;
@ -1086,11 +1167,11 @@ begin
GetMem(buf, f.Size + 1); GetMem(buf, f.Size + 1);
f.Read(buf^, f.Size); f.Read(buf^, f.Size);
buf[f.Size] := #0; buf[f.Size] := #0;
reader := TXMLReader.Create; Reader := TXMLReader.Create;
reader.ProcessDTD(buf, AFilename); Reader.ProcessDTD(buf, AFilename);
FreeMem(buf, f.Size + 1); FreeMem(buf, f.Size + 1);
ADoc := reader.doc; ADoc := TXMLDocument(Reader.doc);
reader.Free; Reader.Free;
end; end;
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream); procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream);
@ -1117,7 +1198,11 @@ end.
{ {
$Log$ $Log$
Revision 1.6 2002-09-07 15:15:29 peter Revision 1.7 2002-09-21 19:22:38 sg
* Added procedures to process XML fragments only (e.g. for merging them
into an existing DOM document)
Revision 1.6 2002/09/07 15:15:29 peter
* old logs removed and tabs fixed * old logs removed and tabs fixed
} }