mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 16:19:21 +02:00
* Patch from Sergei Gorelkin to improve DOM compliance:
dom.pp: * Document.OwnerDocument returns nil. * Document.TextContent returns empty string and setting it does nothing. * Fixed EntityReference, it now gets its children upon creation and is correctly imported between documents. + Node.IsSupported() * DOM feature name comparison is done case-insensitive. * Reworked Node.AppendChild/Node.InsertBefore. Duplicate functionality removed. Resolves remaining issues with hierarchy/ownership checks (except for Document nodes which is a different story altogether). The same code is now executed for nodes attached to a Fragment as well as for regular nodes. + Text.SplitText checks for valid ParentNode. xmlread.pp: + Implemented TDOMParser.ParseWithContext (except the case of replacing the whole document) * Fixed AV when calling ParseXXX methods with input source that could not be resolved. * Completely ignore comments in external DTD subset, it fixes a couple of DOM tests and has no effect on XML testsuite. git-svn-id: trunk@11217 -
This commit is contained in:
parent
22d8bfeeff
commit
fa1b9a1878
@ -211,6 +211,7 @@ type
|
||||
function GetNamespaceURI: DOMString; virtual;
|
||||
function GetPrefix: DOMString; virtual;
|
||||
procedure SetPrefix(const Value: DOMString); virtual;
|
||||
function GetOwnerDocument: TDOMDocument; virtual;
|
||||
public
|
||||
constructor Create(AOwner: TDOMDocument);
|
||||
destructor Destroy; override;
|
||||
@ -228,21 +229,18 @@ type
|
||||
property PreviousSibling: TDOMNode read FPreviousSibling;
|
||||
property NextSibling: TDOMNode read FNextSibling;
|
||||
property Attributes: TDOMNamedNodeMap read GetAttributes;
|
||||
// DOM 2: is now nil for documents and unused DocTypes
|
||||
property OwnerDocument: TDOMDocument read FOwnerDocument;
|
||||
property OwnerDocument: TDOMDocument read GetOwnerDocument;
|
||||
|
||||
function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; virtual;
|
||||
function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; virtual;
|
||||
function DetachChild(OldChild: TDOMNode): TDOMNode; virtual;
|
||||
function RemoveChild(OldChild: TDOMNode): TDOMNode;
|
||||
function AppendChild(NewChild: TDOMNode): TDOMNode; virtual;
|
||||
function AppendChild(NewChild: TDOMNode): TDOMNode;
|
||||
function HasChildNodes: Boolean; virtual;
|
||||
function CloneNode(deep: Boolean): TDOMNode; overload;
|
||||
|
||||
// DOM level 2
|
||||
(*
|
||||
function Supports(const Feature, Version: DOMString): Boolean;
|
||||
*)
|
||||
function IsSupported(const Feature, Version: DOMString): Boolean;
|
||||
function HasAttributes: Boolean; virtual;
|
||||
procedure Normalize; virtual;
|
||||
|
||||
@ -279,7 +277,6 @@ type
|
||||
function InsertBefore(NewChild, RefChild: TDOMNode): TDOMNode; override;
|
||||
function ReplaceChild(NewChild, OldChild: TDOMNode): TDOMNode; override;
|
||||
function DetachChild(OldChild: TDOMNode): TDOMNode; override;
|
||||
function AppendChild(NewChild: TDOMNode): TDOMNode; override;
|
||||
function HasChildNodes: Boolean; override;
|
||||
function FindNode(const ANodeName: DOMString): TDOMNode; override;
|
||||
end;
|
||||
@ -302,6 +299,7 @@ type
|
||||
destructor Destroy; override;
|
||||
property Item[index: LongWord]: TDOMNode read GetItem; default;
|
||||
property Count: LongWord read GetCount;
|
||||
property Length: LongWord read GetCount;
|
||||
end;
|
||||
|
||||
{ an extension to DOM interface, used to build recursive lists of elements }
|
||||
@ -416,6 +414,9 @@ type
|
||||
function GetDocType: TDOMDocumentType;
|
||||
function GetNodeType: Integer; override;
|
||||
function GetNodeName: DOMString; override;
|
||||
function GetTextContent: DOMString; override;
|
||||
function GetOwnerDocument: TDOMDocument; override;
|
||||
procedure SetTextContent(const value: DOMString); override;
|
||||
function IndexOfNS(const nsURI: DOMString): Integer;
|
||||
function FindID(const aID: DOMString; out Index: LongWord): Boolean;
|
||||
procedure ClearIDList;
|
||||
@ -877,8 +878,7 @@ end;
|
||||
|
||||
function TDOMNode.AppendChild(NewChild: TDOMNode): TDOMNode;
|
||||
begin
|
||||
raise EDOMHierarchyRequest.Create('Node.AppendChild');
|
||||
Result:=nil;
|
||||
Result := InsertBefore(NewChild, nil);
|
||||
end;
|
||||
|
||||
function TDOMNode.HasChildNodes: Boolean;
|
||||
@ -909,6 +909,11 @@ begin
|
||||
Result := FOwnerDocument.FRevision;
|
||||
end;
|
||||
|
||||
function TDOMNode.IsSupported(const Feature, Version: DOMString): Boolean;
|
||||
begin
|
||||
Result := FOwnerDocument.Impl.HasFeature(Feature, Version);
|
||||
end;
|
||||
|
||||
function TDOMNode.HasAttributes: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
@ -983,6 +988,11 @@ begin
|
||||
// do nothing, override for Elements and Attributes
|
||||
end;
|
||||
|
||||
function TDOMNode.GetOwnerDocument: TDOMDocument;
|
||||
begin
|
||||
Result := FOwnerDocument;
|
||||
end;
|
||||
|
||||
function CompareDOMStrings(const s1, s2: DOMPChar; l1, l2: integer): integer;
|
||||
var i: integer;
|
||||
begin
|
||||
@ -1063,20 +1073,19 @@ var
|
||||
NewChildType: Integer;
|
||||
begin
|
||||
Result := NewChild;
|
||||
|
||||
if not Assigned(RefChild) then
|
||||
begin
|
||||
AppendChild(NewChild);
|
||||
exit;
|
||||
end;
|
||||
NewChildType := NewChild.NodeType;
|
||||
|
||||
if NewChild.FOwnerDocument <> FOwnerDocument then
|
||||
begin
|
||||
if (NewChildType <> DOCUMENT_TYPE_NODE) or
|
||||
(NewChild.FOwnerDocument <> nil) then
|
||||
raise EDOMWrongDocument.Create('NodeWC.InsertBefore');
|
||||
end;
|
||||
|
||||
if RefChild.ParentNode <> Self then
|
||||
if Assigned(RefChild) and (RefChild.ParentNode <> Self) then
|
||||
raise EDOMNotFound.Create('NodeWC.InsertBefore');
|
||||
|
||||
NewChildType := NewChild.NodeType;
|
||||
// TODO: skip checking Fragments as well? (Fragment itself cannot be in the tree)
|
||||
if not (NewChildType in [TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE, PROCESSING_INSTRUCTION_NODE]) and (NewChild.FirstChild <> nil) then
|
||||
begin
|
||||
Tmp := Self;
|
||||
@ -1087,45 +1096,26 @@ begin
|
||||
Tmp := Tmp.ParentNode;
|
||||
end;
|
||||
end;
|
||||
if NewChild = RefChild then // inserting node before itself is a no-op
|
||||
Exit;
|
||||
|
||||
Inc(FOwnerDocument.FRevision); // invalidate nodelists
|
||||
|
||||
// DONE: Implemented InsertBefore for DocumentFragments (except ChildNodeTree)
|
||||
if NewChildType = DOCUMENT_FRAGMENT_NODE then
|
||||
begin
|
||||
// Is fragment empty?
|
||||
Tmp := NewChild.FirstChild;
|
||||
if not Assigned(Tmp) then
|
||||
Exit;
|
||||
// reparent nodes
|
||||
if Assigned(Tmp) then
|
||||
begin
|
||||
while Assigned(Tmp) do
|
||||
begin
|
||||
Tmp.FParentNode := Self;
|
||||
if not (Tmp.NodeType in ValidChildren[NodeType]) then
|
||||
raise EDOMHierarchyRequest.Create('NodeWC.InsertBefore');
|
||||
Tmp := Tmp.NextSibling;
|
||||
end;
|
||||
|
||||
// won't get here if RefChild = nil...
|
||||
if (RefChild = nil) or (RefChild.FPreviousSibling = nil) then
|
||||
begin // insert at the beginning <- AppendChild ??? ->
|
||||
// no, AppendChild will insert after RefChild and we need it before
|
||||
if Assigned(FFirstChild) then
|
||||
FFirstChild.FPreviousSibling := NewChild.LastChild;
|
||||
NewChild.LastChild.FNextSibling := FirstChild;
|
||||
if not Assigned(FLastChild) then
|
||||
FLastChild := NewChild.LastChild;
|
||||
FFirstChild := NewChild.FirstChild;
|
||||
end
|
||||
else // insert to the middle
|
||||
begin
|
||||
NewChild.LastChild.FNextSibling := RefChild;
|
||||
NewChild.FirstChild.FPreviousSibling := RefChild.FPreviousSibling;
|
||||
RefChild.FPreviousSibling.FNextSibling := NewChild.FirstChild;
|
||||
RefChild.FPreviousSibling := NewChild.LastChild;
|
||||
while Assigned(TDOMDocumentFragment(NewChild).FFirstChild) do
|
||||
InsertBefore(TDOMDocumentFragment(NewChild).FFirstChild, RefChild);
|
||||
end;
|
||||
// finally, detach nodes from the fragment
|
||||
TDOMDocumentFragment(NewChild).FFirstChild := nil;
|
||||
TDOMDocumentFragment(NewChild).FLastChild := nil;
|
||||
// TODO: ChildNodeTree...
|
||||
Exit;
|
||||
end;
|
||||
|
||||
@ -1136,6 +1126,18 @@ begin
|
||||
NewChild.FParentNode.DetachChild(NewChild);
|
||||
|
||||
NewChild.FNextSibling := RefChild;
|
||||
if RefChild = nil then // append to the end
|
||||
begin
|
||||
if Assigned(FFirstChild) then
|
||||
begin
|
||||
FLastChild.FNextSibling := NewChild;
|
||||
NewChild.FPreviousSibling := FLastChild;
|
||||
end else
|
||||
FFirstChild := NewChild;
|
||||
FLastChild := NewChild;
|
||||
end
|
||||
else // insert before RefChild
|
||||
begin
|
||||
if RefChild = FFirstChild then
|
||||
FFirstChild := NewChild
|
||||
else
|
||||
@ -1143,8 +1145,8 @@ begin
|
||||
RefChild.FPreviousSibling.FNextSibling := NewChild;
|
||||
NewChild.FPreviousSibling := RefChild.FPreviousSibling;
|
||||
end;
|
||||
|
||||
RefChild.FPreviousSibling := NewChild;
|
||||
end;
|
||||
NewChild.FParentNode := Self;
|
||||
AddToChildNodeTree(NewChild);
|
||||
end;
|
||||
@ -1185,76 +1187,6 @@ begin
|
||||
Result := OldChild;
|
||||
end;
|
||||
|
||||
function TDOMNode_WithChildren.AppendChild(NewChild: TDOMNode): TDOMNode;
|
||||
var
|
||||
Tmp: TDOMNode;
|
||||
NewChildType: Integer;
|
||||
begin
|
||||
if NewChild.FOwnerDocument <> FOwnerDocument then
|
||||
raise EDOMWrongDocument.Create('NodeWC.AppendChild');
|
||||
|
||||
// Don't walk the tree if NewChild apriori cannot be our parent.
|
||||
// This saves a lot of CPU cache misses.
|
||||
NewChildType := NewChild.NodeType;
|
||||
if not (NewChildType in [TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE, PROCESSING_INSTRUCTION_NODE]) and (NewChild.FirstChild <> nil) then
|
||||
begin
|
||||
Tmp := Self;
|
||||
while Assigned(Tmp) do
|
||||
begin
|
||||
if Tmp = NewChild then
|
||||
raise EDOMHierarchyRequest.Create('NodeWC.AppendChild (cycle in tree)');
|
||||
Tmp := Tmp.ParentNode;
|
||||
end;
|
||||
end;
|
||||
Inc(FOwnerDocument.FRevision); // invalidate nodelists
|
||||
|
||||
// DONE: supported AppendChild for DocumentFragments (except ChildNodeTree)
|
||||
if NewChildType = DOCUMENT_FRAGMENT_NODE then
|
||||
begin
|
||||
Tmp := NewChild.FirstChild;
|
||||
// Is fragment empty?
|
||||
if Assigned(Tmp) then
|
||||
begin
|
||||
// reparent nodes
|
||||
while Assigned(Tmp) do
|
||||
begin
|
||||
Tmp.FParentNode := Self;
|
||||
Tmp := Tmp.NextSibling;
|
||||
end;
|
||||
|
||||
if Assigned(FLastChild) then
|
||||
FLastChild.FNextSibling := NewChild.FirstChild;
|
||||
NewChild.FirstChild.FPreviousSibling := LastChild;
|
||||
if not Assigned(FFirstChild) then
|
||||
FFirstChild := NewChild.FirstChild;
|
||||
FLastChild := NewChild.LastChild;
|
||||
// detach nodes from fragment
|
||||
TDOMDocumentFragment(NewChild).FFirstChild := nil;
|
||||
TDOMDocumentFragment(NewChild).FLastChild := nil;
|
||||
// TODO: ChildNodeTree...
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if not (NewChildType in ValidChildren[NodeType]) then
|
||||
raise EDOMHierarchyRequest.Create('NodeWC.AppendChild');
|
||||
|
||||
if Assigned(NewChild.FParentNode) then
|
||||
NewChild.FParentNode.DetachChild(NewChild);
|
||||
|
||||
if Assigned(FFirstChild) then
|
||||
begin
|
||||
FLastChild.FNextSibling := NewChild;
|
||||
NewChild.FPreviousSibling := FLastChild;
|
||||
end else
|
||||
FFirstChild := NewChild;
|
||||
FLastChild := NewChild;
|
||||
NewChild.FParentNode := Self;
|
||||
AddToChildNodeTree(NewChild);
|
||||
end;
|
||||
Result := NewChild;
|
||||
end;
|
||||
|
||||
function TDOMNode_WithChildren.HasChildNodes: Boolean;
|
||||
begin
|
||||
Result := Assigned(FFirstChild);
|
||||
@ -1625,7 +1557,7 @@ end;
|
||||
|
||||
function TDOMCharacterData.SubstringData(offset, count: LongWord): DOMString;
|
||||
begin
|
||||
if (offset > Length) then
|
||||
if offset > Length then
|
||||
raise EDOMIndexSize.Create('CharacterData.SubstringData');
|
||||
Result := Copy(FNodeValue, offset + 1, count);
|
||||
end;
|
||||
@ -1637,20 +1569,16 @@ end;
|
||||
|
||||
procedure TDOMCharacterData.InsertData(offset: LongWord; const arg: DOMString);
|
||||
begin
|
||||
if (offset > Length) then
|
||||
if offset > Length then
|
||||
raise EDOMIndexSize.Create('CharacterData.InsertData');
|
||||
// TODO: use System.Insert?
|
||||
FNodeValue := Copy(FNodeValue, 1, offset) + arg +
|
||||
Copy(FNodeValue, offset + 1, Length);
|
||||
Insert(arg, FNodeValue, offset+1);
|
||||
end;
|
||||
|
||||
procedure TDOMCharacterData.DeleteData(offset, count: LongWord);
|
||||
begin
|
||||
if (offset > Length) then
|
||||
if offset > Length then
|
||||
raise EDOMIndexSize.Create('CharacterData.DeleteData');
|
||||
// TODO: use System.Delete?
|
||||
FNodeValue := Copy(FNodeValue, 1, offset) +
|
||||
Copy(FNodeValue, offset + count + 1, Length);
|
||||
Delete(FNodeValue, offset+1, count);
|
||||
end;
|
||||
|
||||
procedure TDOMCharacterData.ReplaceData(offset, count: LongWord; const arg: DOMString);
|
||||
@ -1687,17 +1615,11 @@ end;
|
||||
|
||||
function TDOMImplementation.HasFeature(const feature, version: DOMString):
|
||||
Boolean;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
// very basic
|
||||
if (feature = 'XML') then
|
||||
begin
|
||||
if (version = '') or (version = '1.0') then
|
||||
Result := True
|
||||
else
|
||||
Result := False;
|
||||
end
|
||||
else
|
||||
Result := False;
|
||||
s := feature; // force Ansi, features do not contain non-ASCII chars
|
||||
Result := SameText(s, 'XML') and ((version = '') or (version = '1.0'));
|
||||
end;
|
||||
|
||||
function TDOMImplementation.CreateDocumentType(const QualifiedName, PublicID,
|
||||
@ -1707,13 +1629,10 @@ begin
|
||||
Result := TDOMDocumentType.Create(nil);
|
||||
Result.FName := QualifiedName;
|
||||
|
||||
// cannot have PublicID without SystemID
|
||||
if SystemID <> '' then
|
||||
begin
|
||||
// DOM does not restrict PublicID without SystemID (unlike XML spec)
|
||||
Result.FPublicID := PublicID;
|
||||
Result.FSystemID := SystemID;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDOMImplementation.CreateDocument(const NamespaceURI,
|
||||
QualifiedName: DOMString; doctype: TDOMDocumentType): TDOMDocument;
|
||||
@ -1845,6 +1764,21 @@ begin
|
||||
Result := '#document';
|
||||
end;
|
||||
|
||||
function TDOMDocument.GetTextContent: DOMString;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
procedure TDOMDocument.SetTextContent(const value: DOMString);
|
||||
begin
|
||||
// Document ignores setting TextContent
|
||||
end;
|
||||
|
||||
function TDOMDocument.GetOwnerDocument: TDOMDocument;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDOMDocument.GetDocumentElement: TDOMElement;
|
||||
var
|
||||
node: TDOMNode;
|
||||
@ -2015,12 +1949,21 @@ end;
|
||||
|
||||
function TXMLDocument.CreateEntityReference(const name: DOMString):
|
||||
TDOMEntityReference;
|
||||
var
|
||||
dType: TDOMDocumentType;
|
||||
ent: TDOMEntity;
|
||||
begin
|
||||
if not IsXmlName(name, FXML11) then
|
||||
raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateEntityReference');
|
||||
Result := TDOMEntityReference.Create(Self);
|
||||
Result.FName := name;
|
||||
// TODO: if entity is known, its child list must be cloned or so.
|
||||
dType := DocType;
|
||||
if Assigned(dType) then
|
||||
begin
|
||||
TDOMNode(ent) := dType.Entities.GetNamedItem(name);
|
||||
if Assigned(ent) then
|
||||
ent.CloneChildren(Result, Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TXMLDocument.SetXMLVersion(const aValue: DOMString);
|
||||
@ -2311,6 +2254,7 @@ begin
|
||||
Result.FNodeValue := Copy(FNodeValue, offset + 1, Length);
|
||||
Result.FMayBeIgnorable := FMayBeIgnorable;
|
||||
FNodeValue := Copy(FNodeValue, 1, offset);
|
||||
if Assigned(FParentNode) then
|
||||
FParentNode.InsertBefore(Result, FNextSibling);
|
||||
end;
|
||||
|
||||
@ -2443,6 +2387,8 @@ begin
|
||||
TDOMEntity(Result).FSystemID := FSystemID;
|
||||
TDOMEntity(Result).FPublicID := FPublicID;
|
||||
TDOMEntity(Result).FNotationName := FNotationName;
|
||||
if deep then
|
||||
CloneChildren(Result, aCloneOwner);
|
||||
end;
|
||||
|
||||
// -------------------------------------------------------
|
||||
@ -2462,8 +2408,6 @@ end;
|
||||
function TDOMEntityReference.CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode;
|
||||
begin
|
||||
Result := ACloneOwner.CreateEntityReference(FName);
|
||||
// TODO -cConformance: this is done in CreateEntityReference?
|
||||
CloneChildren(Result, ACloneOwner);
|
||||
end;
|
||||
|
||||
// -------------------------------------------------------
|
||||
|
@ -73,8 +73,12 @@ type
|
||||
end;
|
||||
|
||||
// NOTE: DOM 3 LS ACTION_TYPE enumeration starts at 1
|
||||
TXMLContextAction = (xaAppendAsChildren, xaReplaceChildren, xaInsertBefore,
|
||||
xaInsertAfter, xaReplace);
|
||||
TXMLContextAction = (
|
||||
xaAppendAsChildren = 1,
|
||||
xaReplaceChildren,
|
||||
xaInsertBefore,
|
||||
xaInsertAfter,
|
||||
xaReplace);
|
||||
|
||||
TXMLErrorEvent = procedure(Error: EXMLReadError) of object;
|
||||
|
||||
@ -395,6 +399,7 @@ type
|
||||
procedure ValidationError(const Msg: string; const args: array of const; LineOffs: Integer = -1);
|
||||
procedure DoAttrText(ch: PWideChar; Count: Integer);
|
||||
procedure DTDReloadHook;
|
||||
procedure ConvertSource(SrcIn: TXMLInputSource; out SrcOut: TXMLCharSource);
|
||||
// Some SAX-alike stuff (at a very early stage)
|
||||
procedure DoText(ch: PWideChar; Count: Integer; Whitespace: Boolean=False);
|
||||
procedure DoComment(ch: PWideChar; Count: Integer);
|
||||
@ -433,6 +438,8 @@ type
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
const
|
||||
NullLocation: TLocation = (Line: 0; LinePos: 0);
|
||||
|
||||
function Decode_UCS2(Src: TXMLDecodingSource): WideChar;
|
||||
begin
|
||||
@ -606,20 +613,8 @@ var
|
||||
begin
|
||||
with TXMLReader.Create(Self) do
|
||||
try
|
||||
InputSrc := nil;
|
||||
if Assigned(Src) then
|
||||
begin
|
||||
if Assigned(Src.FStream) then
|
||||
InputSrc := TXMLStreamInputSource.Create(Src.FStream, False)
|
||||
else if Src.FStringData <> '' then
|
||||
InputSrc := TXMLStreamInputSource.Create(TStringStream.Create(Src.FStringData), True)
|
||||
else if (Src.SystemID <> '') then
|
||||
ResolveEntity(Src.SystemID, Src.PublicID, InputSrc);
|
||||
end;
|
||||
if Assigned(InputSrc) then
|
||||
ConvertSource(Src, InputSrc); // handles 'no-input-specified' case
|
||||
ProcessXML(InputSrc)
|
||||
else
|
||||
FatalError('No input source specified');
|
||||
finally
|
||||
ADoc := TXMLDocument(doc);
|
||||
Free;
|
||||
@ -643,9 +638,46 @@ end;
|
||||
|
||||
function TDOMParser.ParseWithContext(Src: TXMLInputSource;
|
||||
Context: TDOMNode; Action: TXMLContextAction): TDOMNode;
|
||||
var
|
||||
InputSrc: TXMLCharSource;
|
||||
Frag: TDOMDocumentFragment;
|
||||
node: TDOMNode;
|
||||
begin
|
||||
// TODO: implement
|
||||
Result := nil;
|
||||
if Action in [xaInsertBefore, xaInsertAfter, xaReplace] then
|
||||
node := Context.ParentNode
|
||||
else
|
||||
node := Context;
|
||||
// TODO: replacing document isn't yet supported
|
||||
if (Action = xaReplaceChildren) and (node.NodeType = DOCUMENT_NODE) then
|
||||
raise EDOMNotSupported.Create('DOMParser.ParseWithContext');
|
||||
|
||||
if not (node.NodeType in [ELEMENT_NODE, DOCUMENT_FRAGMENT_NODE]) then
|
||||
raise EDOMHierarchyRequest.Create('DOMParser.ParseWithContext');
|
||||
|
||||
with TXMLReader.Create(Self) do
|
||||
try
|
||||
ConvertSource(Src, InputSrc); // handles 'no-input-specified' case
|
||||
Frag := Context.OwnerDocument.CreateDocumentFragment;
|
||||
try
|
||||
ProcessFragment(InputSrc, Frag);
|
||||
Result := Frag.FirstChild;
|
||||
case Action of
|
||||
xaAppendAsChildren: Context.AppendChild(Frag);
|
||||
|
||||
xaReplaceChildren: begin
|
||||
Context.TextContent := ''; // removes children
|
||||
Context.ReplaceChild(Frag, Context.FirstChild);
|
||||
end;
|
||||
xaInsertBefore: node.InsertBefore(Frag, Context);
|
||||
xaInsertAfter: node.InsertBefore(Frag, Context.NextSibling);
|
||||
xaReplace: node.ReplaceChild(Frag, Context);
|
||||
end;
|
||||
finally
|
||||
Frag.Free;
|
||||
end;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
// TODO: These classes still cannot be considered as the final solution...
|
||||
@ -931,8 +963,37 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ helper that closes handle upon destruction }
|
||||
type
|
||||
THandleOwnerStream = class(THandleStream)
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
destructor THandleOwnerStream.Destroy;
|
||||
begin
|
||||
if Handle >= 0 then FileClose(Handle);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TXMLReader }
|
||||
|
||||
procedure TXMLReader.ConvertSource(SrcIn: TXMLInputSource; out SrcOut: TXMLCharSource);
|
||||
begin
|
||||
SrcOut := nil;
|
||||
if Assigned(SrcIn) then
|
||||
begin
|
||||
if Assigned(SrcIn.FStream) then
|
||||
SrcOut := TXMLStreamInputSource.Create(SrcIn.FStream, False)
|
||||
else if SrcIn.FStringData <> '' then
|
||||
SrcOut := TXMLStreamInputSource.Create(TStringStream.Create(SrcIn.FStringData), True)
|
||||
else if (SrcIn.SystemID <> '') then
|
||||
ResolveEntity(SrcIn.SystemID, SrcIn.PublicID, SrcOut);
|
||||
end;
|
||||
if (SrcOut = nil) and (FSource = nil) then
|
||||
DoErrorPos(esFatal, 'No input source specified', NullLocation);
|
||||
end;
|
||||
|
||||
procedure TXMLReader.StoreLocation(out Loc: TLocation);
|
||||
begin
|
||||
Loc.Line := FSource.FLocation.Line;
|
||||
@ -944,32 +1005,34 @@ var
|
||||
AbsSysID: WideString;
|
||||
Filename: string;
|
||||
Stream: TStream;
|
||||
begin
|
||||
Result := True;
|
||||
if Assigned(FSource) then
|
||||
Result := ResolveRelativeURI(FSource.SystemID, SystemID, AbsSysID)
|
||||
else
|
||||
AbsSysID := SystemID;
|
||||
|
||||
if Result then
|
||||
fd: THandle;
|
||||
begin
|
||||
Source := nil;
|
||||
Result := False;
|
||||
// TODO: alternative resolvers
|
||||
if not Assigned(FSource) then
|
||||
AbsSysID := SystemID
|
||||
else
|
||||
if not ResolveRelativeURI(FSource.SystemID, SystemID, AbsSysID) then
|
||||
Exit;
|
||||
{ TODO: alternative resolvers
|
||||
These may be 'internal' resolvers or a handler set by application.
|
||||
Internal resolvers should probably produce a TStream
|
||||
( so that internal classes need not be exported ).
|
||||
External resolver will produce TXMLInputSource that should be converted.
|
||||
External resolver must NOT be called for root entity.
|
||||
External resolver can return nil, in which case we do the default }
|
||||
if URIToFilename(AbsSysID, Filename) then
|
||||
begin
|
||||
try
|
||||
Stream := TFileStream.Create(Filename, fmOpenRead + fmShareDenyWrite);
|
||||
fd := FileOpen(Filename, fmOpenRead + fmShareDenyWrite);
|
||||
if fd <> THandle(-1) then
|
||||
begin
|
||||
Stream := THandleOwnerStream.Create(fd);
|
||||
Source := TXMLStreamInputSource.Create(Stream, True);
|
||||
Source.SystemID := AbsSysID;
|
||||
Source.SystemID := AbsSysID; // <- Revisit: Really need absolute sysID?
|
||||
Source.PublicID := PublicID;
|
||||
Result := True;
|
||||
except
|
||||
on E: Exception do
|
||||
ValidationError('%s', [E.Message]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result := Assigned(Source);
|
||||
end;
|
||||
|
||||
procedure TXMLReader.Initialize(ASource: TXMLCharSource);
|
||||
@ -1034,13 +1097,17 @@ procedure TXMLReader.DoErrorPos(Severity: TErrorSeverity; const descr: string; c
|
||||
var
|
||||
E: EXMLReadError;
|
||||
begin
|
||||
E := EXMLReadError.CreateFmt('In ''%s'' (line %d pos %d): %s', [FSource.SystemID, ErrPos.Line, ErrPos.LinePos, descr]);
|
||||
if Assigned(FSource) then
|
||||
E := EXMLReadError.CreateFmt('In ''%s'' (line %d pos %d): %s', [FSource.SystemID, ErrPos.Line, ErrPos.LinePos, descr])
|
||||
else
|
||||
E := EXMLReadError.Create(descr);
|
||||
E.FSeverity := Severity;
|
||||
E.FErrorMessage := descr;
|
||||
E.FLine := ErrPos.Line;
|
||||
E.FLinePos := ErrPos.LinePos;
|
||||
CallErrorHandler(E);
|
||||
// No 'finally'! If user handler raises exception, control should not get here
|
||||
// and the exception will be freed in CallErrorHandler (below)
|
||||
E.Free;
|
||||
end;
|
||||
|
||||
@ -1175,6 +1242,7 @@ destructor TXMLReader.Destroy;
|
||||
begin
|
||||
FreeMem(FName.Buffer);
|
||||
FreeMem(FValue.Buffer);
|
||||
if Assigned(FSource) then
|
||||
while ContextPop do; // clean input stack
|
||||
FSource.Free;
|
||||
FPEMap.Free;
|
||||
@ -1406,7 +1474,11 @@ begin
|
||||
begin
|
||||
Result := ResolveEntity(AEntity.SystemID, AEntity.PublicID, Src);
|
||||
if not Result then
|
||||
begin
|
||||
// TODO: a detailed message like SysErrorMessage(GetLastError) would be great here
|
||||
ValidationError('Unable to resolve external entity ''%s''', [AEntity.NodeName]);
|
||||
Exit;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -1450,7 +1522,7 @@ procedure TXMLReader.IncludeEntity(InAttr: Boolean);
|
||||
var
|
||||
AEntity: TDOMEntityEx;
|
||||
RefName: WideString;
|
||||
Node, Child: TDOMNode;
|
||||
Child: TDOMNode;
|
||||
begin
|
||||
AEntity := nil;
|
||||
SetString(RefName, FName.Buffer, FName.Length);
|
||||
@ -1495,17 +1567,17 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Node := FCursor;
|
||||
if (not FExpandEntities) or (not AEntity.FResolved) then
|
||||
begin
|
||||
Node := doc.CreateEntityReference(RefName);
|
||||
FCursor.AppendChild(Node);
|
||||
// This will clone Entity children
|
||||
FCursor.AppendChild(doc.CreateEntityReference(RefName));
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Child := AEntity.FirstChild; // clone the entity node tree
|
||||
while Assigned(Child) do
|
||||
begin
|
||||
Node.AppendChild(Child.CloneNode(True));
|
||||
FCursor.AppendChild(Child.CloneNode(True));
|
||||
Child := Child.NextSibling;
|
||||
end;
|
||||
end;
|
||||
@ -1839,7 +1911,9 @@ begin
|
||||
end;
|
||||
ExpectChar('>');
|
||||
|
||||
if (FDocType.SystemID <> '') and ResolveEntity(FDocType.SystemID, FDocType.PublicID, Src) then
|
||||
if (FDocType.SystemID <> '') then
|
||||
begin
|
||||
if ResolveEntity(FDocType.SystemID, FDocType.PublicID, Src) then
|
||||
begin
|
||||
ContextPush(Src);
|
||||
try
|
||||
@ -1849,6 +1923,9 @@ begin
|
||||
Src.DTDSubsetType := dsNone;
|
||||
ContextPop;
|
||||
end;
|
||||
end
|
||||
else
|
||||
ValidationError('Unable to resolve external DTD subset', []);
|
||||
end;
|
||||
FCursor := Doc;
|
||||
ValidateDTD;
|
||||
@ -2847,13 +2924,10 @@ begin
|
||||
ValidationError('Comments are not allowed within EMPTY elements', []);
|
||||
|
||||
// DOM builder part
|
||||
if (not FIgnoreComments) then
|
||||
if (not FIgnoreComments) and Assigned(FCursor) then
|
||||
begin
|
||||
Node := Doc.CreateCommentBuf(ch, Count);
|
||||
if Assigned(FCursor) then
|
||||
FCursor.AppendChild(Node)
|
||||
else
|
||||
Doc.InsertBefore(Node, FDocType);
|
||||
FCursor.AppendChild(Node);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user