+ fcl-xml, implemented TDOMNode.BaseURI property.

* Moved element loading procedure from xmlread.pp to dom.pp, speeds things up a bit.

git-svn-id: trunk@20558 -

packages/fcl-xml/src/dom.pp

@@ -695,6 +695,7 @@ type
   TDOMNotation = class(TDOMNode)
   protected
     FDecl: TNotationDecl;
+    FBaseURI: DOMString;
     function GetNodeType: Integer; override;
     function GetNodeName: DOMString; override;
     function GetPublicID: DOMString;
@@ -713,6 +714,7 @@ type
   TDOMEntity = class(TDOMNode_TopLevel)
   protected
     FDecl: TEntityDecl;
+    FBaseURI: DOMString;
     function GetNodeType: Integer; override;
     function GetNodeName: DOMString; override;
     function GetPublicID: DOMString;
@@ -785,13 +787,16 @@ type
   end;
 
 // temporary until things are settled
-function LoadAttribute(doc: TDOMDocument; src: PNodeData): TDOMAttr;
+function LoadElement(doc: TDOMDocument; src: PNodeData; attrCount: Integer): TDOMElement;
 
 // =======================================================
 // =======================================================
 
 implementation
 
+uses
+  UriParser;
+
 { a namespace-enabled NamedNodeMap }
 type
   TAttributeMap = class(TDOMNamedNodeMap)
@@ -1241,17 +1246,71 @@ begin
   result := GetAncestorElement(Self).IsDefaultNamespace(nsURI);
 end;
 
+function GetParentURI(n: TDOMNode): DOMString;
+var
+  entity, parent: TDOMNode;
+begin
+  parent := n.ParentNode;
+  if Assigned(parent) then
+  begin
+    entity := nil;
+    case parent.nodeType of
+      ENTITY_NODE:
+        entity := parent;
+      ENTITY_REFERENCE_NODE:
+        if Assigned(n.OwnerDocument.DocType) then
+          entity := n.OwnerDocument.DocType.Entities.GetNamedItem(parent.NodeName);
+    end;
+    if entity = nil then
+      result := parent.BaseURI
+    else
+    { TODO: this will need fix when resource resolving is implemented;
+      it should return the URI of actually fetched entity. }
+      ResolveRelativeURI(TDOMEntity(entity).FDecl.FURI, TDOMEntity(entity).SystemID, result) then
+  end
+  else
+    result := n.OwnerDocument.DocumentURI;
+end;
+
 function TDOMNode.GetBaseURI: DOMString;
+var
+  base: DOMString;
+  dtype: TDOMDocumentType;
+  ent: TDOMEntity;
 begin
   case NodeType of
-  // !! Incomplete !!
+    ELEMENT_NODE:
+      begin
+        result := GetParentURI(Self);
+        { 'xml' prefix is restricted to xml namespace, so this will work
+          regardless of namespace processing enabled }
+        base := TDOMElement(Self).GetAttribute('xml:base');
+        if base <> '' then
+        begin
+          ResolveRelativeUri(result, base, result);
+        end;
+      end;
     DOCUMENT_NODE:
       result := TDOMDocument(Self).FURI;
     PROCESSING_INSTRUCTION_NODE:
-      if Assigned(ParentNode) then
-        result := ParentNode.GetBaseURI
-      else
-        result := OwnerDocument.DocumentURI;
+      result := GetParentURI(Self);
+    { BaseUri of entities and notations is the URI where they're defined;
+      cloning should cause this property to get lost. }
+    ENTITY_NODE:
+      result := TDOMEntity(Self).FBaseURI;
+    NOTATION_NODE:
+      result := TDOMNotation(Self).FBaseURI;
+    ENTITY_REFERENCE_NODE:
+      begin
+        result := '';
+        dtype := OwnerDocument.DocType;
+        if Assigned(dtype) then
+        begin
+          ent := TDOMEntity(dtype.Entities.GetNamedItem(NodeName));
+          if Assigned(ent) then
+            result := ent.FDecl.FURI;
+        end;
+      end
   else
     result := '';
   end;
@@ -2891,6 +2950,25 @@ begin
     result.InternalAppend(doc.CreateTextNode(src^.FValueStr));
 end;
 
+function LoadElement(doc: TDOMDocument; src: PNodeData; attrCount: Integer): TDOMElement;
+var
+  i: Integer;
+begin
+  TDOMNode(result) := doc.Alloc(TDOMElement);
+  result.Create(doc);
+  result.FNSI.QName := src^.FQName;
+  if Assigned(src^.FNsUri) then
+    result.SetNSI(src^.FNsUri^.Key, src^.FColonPos+1);
+  for i := 0 to attrCount-1 do
+  begin
+    Inc(src);
+    result.SetAttributeNode(LoadAttribute(doc, src));
+    // Attach element to ID map entry if necessary
+    if Assigned(src^.FIDEntry) then
+      src^.FIDEntry^.Data := Result;
+  end;
+end;
+
 procedure TDOMElement.RestoreDefaultAttr(AttrDef: TAttributeDef);
 var
   Attr: TDOMAttr;
@@ -3234,6 +3312,7 @@ var
 begin
   node := TDOMEntity.Create(this.ownerDocument);
   node.FDecl := TEntityDecl(Entry^.Data);
+  node.FBaseURI := node.FDecl.FURI;
   node.SetReadOnly(True);
   this.Entities.SetNamedItem(node);
   Result := True;
@@ -3246,6 +3325,7 @@ var
 begin
   node := TDOMNotation.Create(this.ownerDocument);
   node.FDecl := TNotationDecl(Entry^.Data);
+  node.FBaseURI := node.FDecl.FURI;
   node.SetReadOnly(True);
   this.Notations.SetNamedItem(node);
   Result := True;

packages/fcl-xml/src/dtdmodel.pp

@@ -141,6 +141,7 @@ type
     FName: XMLString;
     FPublicID: XMLString;
     FSystemID: XMLString;
+    FURI: XMLString;
   end;
 
   TDTDModel = class

packages/fcl-xml/src/xmlread.pp

@@ -454,7 +454,6 @@ type
     procedure ValidationErrorWithName(const Msg: string; LineOffs: Integer = -1);
     procedure DTDReloadHook;
     procedure ConvertSource(SrcIn: TXMLInputSource; out SrcOut: TXMLCharSource);
-    procedure DoNotationDecl(const aName, aPubID, aSysID: XMLString);
     procedure SetOptions(AParser: TDOMParser);
   public
     { Entity loading still needs to reference the document, at least as an opaque pointer }
@@ -471,7 +470,6 @@ type
   TLoader = object
     doc: TDOMDocument;
     reader: TXMLTextReader;
-    function DoStartElement: TDOMElement;
     function DoCDSect(ch: PWideChar; Count: Integer): TDOMNode;
     function CreatePINode: TDOMNode;
     procedure ParseContent(cursor: TDOMNode_WithChildren);
@@ -1520,7 +1518,7 @@ begin
 
       ntElement:
         begin
-          element := DoStartElement;
+          element := LoadElement(doc, FCurrNode, reader.FAttrCount);
           cursor.InternalAppend(element);
           cursor := element;
         end;
@@ -1538,28 +1536,6 @@ begin
   until not Read;
 end;
 
-function TLoader.DoStartElement: TDOMElement;
-var
-  Attr: TDOMAttr;
-  i: Integer;
-begin
-  with reader.FCurrNode^ do
-  begin
-    Result := doc.CreateElementBuf(PWideChar(FQName^.Key), Length(FQName^.Key));
-    if Assigned(FNsUri) then
-      Result.SetNSI(FNsUri^.Key, FColonPos+1);
-  end;
-
-  for i := 1 to reader.FAttrCount do
-  begin
-    Attr := LoadAttribute(doc, @reader.FNodeStack[reader.FNesting+i]);
-    Result.SetAttributeNode(Attr);
-    // Attach element to ID map entry if necessary
-    if Assigned(reader.FNodeStack[reader.FNesting+i].FIDEntry) then
-      reader.FNodeStack[reader.FNesting+i].FIDEntry^.Data := Result;
-  end;
-end;
-
 function TLoader.CreatePINode: TDOMNode;
 var
   NameStr, ValueStr: DOMString;
@@ -2459,7 +2435,11 @@ end;
 procedure TXMLTextReader.ParseNotationDecl;        // [82]
 var
   NameStr, SysID, PubID: XMLString;
+  Notation: TNotationDecl;
+  Entry: PHashItem;
+  Src: TXMLCharSource;
 begin
+  Src := FSource;
   ExpectWhitespace;
   CheckName;
   CheckNCName;
@@ -2468,7 +2448,20 @@ begin
   if not ParseExternalID(SysID, PubID, True) then
     FatalError('Expected external or public ID');
   if FDTDProcessed then
-    DoNotationDecl(NameStr, PubID, SysID);
+  begin
+    Entry := FDocType.Notations.FindOrAdd(NameStr);
+    if Entry^.Data = nil then
+    begin
+      Notation := TNotationDecl.Create;
+      Notation.FName := NameStr;
+      Notation.FPublicID := PubID;
+      Notation.FSystemID := SysID;
+      Notation.FURI := Src.SystemID;
+      Entry^.Data := Notation;
+    end
+    else
+      ValidationError('Duplicate notation declaration: ''%s''', [NameStr]);
+  end;
 end;
 
 const
@@ -2624,7 +2617,9 @@ var
   Entity: TEntityDecl;
   Map: THashTable;
   Item: PHashItem;
+  Src: TXMLCharSource;
 begin
+  Src := FSource;
   if not SkipWhitespace(True) then
     FatalError('Expected whitespace');
   IsPE := CheckForChar('%');
@@ -2647,8 +2642,9 @@ begin
     Item := Map.FindOrAdd(FName.Buffer, FName.Length, Exists);
     ExpectWhitespace;
 
-    // remember where the entity is declared
-    Entity.FURI := FSource.SystemID;
+    // remember where the entity is declared, use URI from the point where declaration
+    // was starting.
+    Entity.FURI := Src.SystemID;
 
     if FEntityValue.Buffer = nil then
       BufAllocate(FEntityValue, 256);
@@ -4105,24 +4101,6 @@ begin
   end;
 end;
 
-procedure TXMLTextReader.DoNotationDecl(const aName, aPubID, aSysID: XMLString);
-var
-  Notation: TNotationDecl;
-  Entry: PHashItem;
-begin
-  Entry := FDocType.Notations.FindOrAdd(aName);
-  if Entry^.Data = nil then
-  begin
-    Notation := TNotationDecl.Create;
-    Notation.FName := aName;
-    Notation.FPublicID := aPubID;
-    Notation.FSystemID := aSysID;
-    Entry^.Data := Notation;
-  end
-  else
-    ValidationError('Duplicate notation declaration: ''%s''', [aName]);
-end;
-
 function TXMLTextReader.AddId(aNodeData: PNodeData): Boolean;
 var
   e: PHashItem;

packages/fcl-xml/tests/api.xml

@@ -261,8 +261,8 @@
 -->
 <item id="isId"/>
 <item id="documentURI" type="prop"/>
-<!--
 <item id="baseURI"/>
+<!--
 // assertNotEquals
 // assertLowerSeverity
 

packages/fcl-xml/tests/xmlts.pp

@@ -79,6 +79,7 @@ type
     destructor Destroy; override;
   end;
 
+{ obsolete, now TDOMNode.BaseURI does the job }
 function GetBaseURI(Element: TDOMNode; const DocumentURI: string): string;
 var
   Ent: TDOMNode;
@@ -370,7 +371,7 @@ begin
     Exit;
   end;
 
-  root := GetBaseURI(Element, FRootUri);
+  root := Element.BaseURI;
   ResolveRelativeURI(root, UTF8Encode(Element['URI']), s);
 
   table := nil;