+ fixes from Guenther Sebastian

fcl/xml/dom.pp

@@ -1,9 +1,9 @@
 {
     $Id$
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 (c) 1999 Sebastian Günther ([email protected])
+    Copyright (c) 1999 Sebastian Guenther ([email protected])
 
-    Implementation of DOM document class
+    Implementation of DOM level 1 interfaces
     
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -15,7 +15,7 @@
  **********************************************************************}
 
 {
- more or less DOM conformant class library for FreePascal
+ more or less DOM level 1 conformant class library for FreePascal
 }
 
 {$MODE objfpc}
@@ -302,6 +302,7 @@ type
 
     // Extensions to DOM interface:
     constructor Create; virtual;
+    function CreateEntity(const data: DOMString): TDOMEntity;
     procedure SetDocumentElement(ADocumentElement: TDOMElement);
   end;
 
@@ -940,6 +941,12 @@ begin
   raise EDOMNotSupported.Create('DOMDocument.CreateEntityReference');
 end;
 
+function TDOMDocument.CreateEntity(const data: DOMString): TDOMEntity;
+begin
+  Result := TDOMEntity.Create(Self);
+  Result.FNodeValue := data;
+end;
+
 function TDOMDocument.GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
 var
   i: Integer;
@@ -1155,9 +1162,9 @@ end;
 
 constructor TDOMCDATASection.Create(AOwner: TDOMDocument);
 begin
+  inherited Create(AOwner);
   FNodeType := CDATA_SECTION_NODE;
   FNodeName := '#cdata-section';
-  inherited Create(AOwner);
 end;
 
 
@@ -1221,7 +1228,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  1999-07-09 08:35:09  michael
+  Revision 1.2  1999-07-09 21:05:49  michael
+  + fixes from Guenther Sebastian
+
+  Revision 1.1  1999/07/09 08:35:09  michael
   + Initial implementation by Sebastian Guenther
 
 }

fcl/xml/xmlcfg.pp

@@ -28,6 +28,11 @@ uses DOM, xmlread, xmlwrite;
 
 type
 
+  {"APath" is the path and name of a value: A XML configuration file is
+   hierarchical. "/" is the path delimiter, the part after the last "/"
+   is the name of the value. The path components will be mapped to XML
+   elements, the name will be an element attribute.}
+
   TXMLConfig = class
   protected
     doc: TXMLDocument;
@@ -35,7 +40,7 @@ type
   public
     constructor Create(AFileName: String);
     destructor Destroy; override;
-    procedure Flush;
+    procedure Flush;    // Writes the XML file
     function  GetValue(APath, ADefault: String): String;
     function  GetValue(APath: String; ADefault: Integer): Integer;
     function  GetValue(APath: String; ADefault: Boolean): Boolean;
@@ -45,6 +50,8 @@ type
   end;
 
 
+// =======================================================
+
 implementation
 
 uses sysutils;
@@ -175,7 +182,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  1999-07-09 08:35:09  michael
+  Revision 1.2  1999-07-09 21:05:50  michael
+  + fixes from Guenther Sebastian
+
+  Revision 1.1  1999/07/09 08:35:09  michael
   + Initial implementation by Sebastian Guenther
 
 }

fcl/xml/xmlread.pp

@@ -21,11 +21,18 @@ unit xmlread;
 
 interface
 
-uses DOM;
+uses classes, DOM;
 
+function ReadXMLFile(const AFileName: String): TXMLDocument;
 function ReadXMLFile(var f: File): TXMLDocument;
+function ReadXMLFile(var f: TStream): TXMLDocument;
+
+function ReadDTDFile(const AFileName: String): TXMLDocument;
 function ReadDTDFile(var f: File): TXMLDocument;
+function ReadDTDFile(var f: TStream): TXMLDocument;
+
 
+// =======================================================
 
 implementation
 
@@ -61,17 +68,17 @@ type
     function  ExpectName: String;					// [5]
     procedure ExpectAttValue(attr: TDOMAttr);				// [10]
     function  ExpectPubidLiteral: String;				// [12]
-    function  ParseComment: Boolean;					// [15]
+    function  ParseComment(AOwner: TDOMNode): Boolean;			// [15]
     function  ParsePI: Boolean;						// [16]
     procedure ExpectProlog;			    			// [22]
     function  ParseEq: Boolean;						// [25]
     procedure ExpectEq;
-    procedure ParseMisc;						// [27]
+    procedure ParseMisc(AOwner: TDOMNode);				// [27]
     function  ParseMarkupDecl: Boolean;					// [29]
-    function  ParseElement(owner: TDOMNode): Boolean;			// [39]
-    procedure ExpectElement(owner: TDOMNode);
-    function  ParseReference: Boolean;					// [67]
-    procedure ExpectReference;
+    function  ParseElement(AOwner: TDOMNode): Boolean;			// [39]
+    procedure ExpectElement(AOwner: TDOMNode);
+    function  ParseReference(AOwner: TDOMNode): Boolean;		// [67]
+    procedure ExpectReference(AOwner: TDOMNode);
     function  ParsePEReference: Boolean;				// [69]
     function  ParseExternalID: Boolean;					// [75]
     procedure ExpectExternalID;
@@ -85,7 +92,6 @@ type
 
 procedure TXMLReader.RaiseExc(descr: String);
 begin
-  WriteLn('Throwing exception: ', descr);
   raise Exception.Create('In XML reader: ' + descr);
 end;
 
@@ -123,7 +129,10 @@ end;
 
 function TXMLReader.CheckFor(s: PChar): Boolean;
 begin
-  if buf[0] = #0 then exit(False);
+  if buf[0] = #0 then begin
+    Result := False;
+    exit;
+  end;
   if StrLComp(buf, s, StrLen(s)) = 0 then begin
     Inc(buf, StrLen(s));
     Result := True;
@@ -150,13 +159,15 @@ begin
   ExpectProlog;
   LastNodeBeforeDoc := doc.LastChild;
   ExpectElement(doc);
-  ParseMisc;
+  ParseMisc(doc);
 
+  {
   if buf[0] <> #0 then begin
     WriteLn('=== Unparsed: ===');
     //WriteLn(buf);
     WriteLn(StrLen(buf), ' chars');
   end;
+  }
 
   Result := doc;
 end;
@@ -165,8 +176,10 @@ end;
 function TXMLReader.GetName(var s: String): Boolean;    // [5]
 begin
   s := '';
-  if not (buf[0] in (Letter + ['_', ':'])) then
-    exit(False);
+  if not (buf[0] in (Letter + ['_', ':'])) then begin
+    Result := False;
+    exit;
+  end;
 
   s := buf[0];
   Inc(buf);
@@ -196,7 +209,7 @@ begin
   Inc(buf);
   s := '';
   while not CheckFor(strdel) do
-    if not ParseReference then begin
+    if not ParseReference(attr) then begin
       s := s + buf[0];
       Inc(buf);
     end else begin
@@ -224,11 +237,18 @@ begin
     RaiseExc('Expected quotation marks');
 end;
 
-function TXMLReader.ParseComment: Boolean;    // [15]
+function TXMLReader.ParseComment(AOwner: TDOMNode): Boolean;    // [15]
+var
+  comment: String;
 begin
   if CheckFor('<!--') then begin
+    comment := '';
     while (buf[0] <> #0) and (buf[1] <> #0) and
-      ((buf[0] <> '-') or (buf[1] <> '-')) do Inc(buf);
+      ((buf[0] <> '-') or (buf[1] <> '-')) do begin
+      comment := comment + buf[0];
+      Inc(buf);
+    end;
+    AOwner.AppendChild(doc.CreateComment(comment));
     ExpectString('-->');
     Result := True;
   end else
@@ -302,7 +322,7 @@ begin
   end;
 
   // Check for "Misc*"
-  ParseMisc;
+  ParseMisc(doc);
 
   // Check for "(doctypedecl Misc*)?"
   if CheckFor('<!DOCTYPE') then begin
@@ -318,7 +338,7 @@ begin
       ExpectString(']');
       SkipWhitespace;
     end;
-    ParseMisc;
+    ParseMisc(doc);
   end;
 
 end;
@@ -349,11 +369,11 @@ end;
 // Parse "Misc*": 
 //   Misc ::= Comment | PI | S
 
-procedure TXMLReader.ParseMisc;    // [27]
+procedure TXMLReader.ParseMisc(AOwner: TDOMNode);    // [27]
 begin
   repeat
     SkipWhitespace;
-  until not (ParseComment or ParsePI);
+  until not (ParseComment(AOwner) or ParsePI);
 end;
 
 function TXMLReader.ParseMarkupDecl: Boolean;    // [29]
@@ -397,7 +417,7 @@ function TXMLReader.ParseMarkupDecl: Boolean;    // [29]
   begin
     if CheckFor('<!ELEMENT') then begin
       ExpectWhitespace;
-      WriteLn('Element decl: ', ExpectName);
+      ExpectName;
       ExpectWhitespace;
 
       // Get contentspec [46]
@@ -500,20 +520,25 @@ function TXMLReader.ParseMarkupDecl: Boolean;    // [29]
   end;
 
   function ParseEntityDecl: Boolean;    // [70]
+  var
+    NewEntity: TDOMEntity;
 
     function ParseEntityValue: Boolean;    // [9]
     var
       strdel: array[0..1] of Char;
     begin
-      if (buf[0] <> '''') and (buf[0] <> '"') then exit(False);
+      if (buf[0] <> '''') and (buf[0] <> '"') then begin
+        Result := False;
+        exit;
+      end;
       strdel[0] := buf[0];
       strdel[1] := #0;
       Inc(buf);
       while not CheckFor(strdel) do
         if ParsePEReference then
-	else if ParseReference then
+	else if ParseReference(NewEntity) then
 	else
-	  RaiseExc('Expected reference or PE reference');
+	  RaiseExc('Expected entity or PE reference');
       Result := True;
     end;
 
@@ -522,7 +547,7 @@ function TXMLReader.ParseMarkupDecl: Boolean;    // [29]
       ExpectWhitespace;
       if CheckFor('%') then begin    // [72]
         ExpectWhitespace;
-	ExpectName;
+	NewEntity := doc.CreateEntity(ExpectName);
 	ExpectWhitespace;
 	// Get PEDef [74]
 	if ParseEntityValue then
@@ -572,7 +597,8 @@ function TXMLReader.ParseMarkupDecl: Boolean;    // [29]
 begin
   Result := False;
   while ParseElementDecl or ParseAttlistDecl or ParseEntityDecl or
-    ParseNotationDecl or ParsePI or ParseComment or SkipWhitespace do Result := True;
+    ParseNotationDecl or ParsePI or ParseComment(doc) or SkipWhitespace do
+    Result := True;
 end;
 
 function TXMLReader.ProcessDTD(ABuf: PChar): TXMLDocument;    // [1]
@@ -582,16 +608,18 @@ begin
   doc := TXMLDocument.Create;
   ParseMarkupDecl;
 
+  {
   if buf[0] <> #0 then begin
     WriteLn('=== Unparsed: ===');
     //WriteLn(buf);
     WriteLn(StrLen(buf), ' chars');
   end;
+  }
 
   Result := doc;
 end;
 
-function TXMLReader.ParseElement(owner: TDOMNode): Boolean;    // [39] [40] [44]
+function TXMLReader.ParseElement(AOwner: TDOMNode): Boolean;    // [39] [40] [44]
 var
   NewElem: TDOMElement;
 
@@ -616,9 +644,16 @@ var
   end;
 
   function ParseCDSect: Boolean;    // [18]
+  var
+    cdata: String;
   begin
     if CheckFor('<![CDATA[') then begin
-      while not CheckFor(']]>') do Inc(buf);
+      cdata := '';
+      while not CheckFor(']]>') do begin
+        cdata := cdata + buf[0];
+        Inc(buf);
+      end;
+      NewElem.AppendChild(doc.CreateCDATASection(cdata));
       Result := True;
     end else
       Result := False;
@@ -635,11 +670,12 @@ begin
   if CheckFor('<') then begin
     if not GetName(name) then begin
       buf := oldpos;
-      exit(False);
+      Result := False;
+      exit;
     end;
 
     NewElem := doc.CreateElement(name);
-    owner.AppendChild(NewElem);
+    AOwner.AppendChild(NewElem);
 
     SkipWhitespace;
     IsEmpty := False;
@@ -662,7 +698,8 @@ begin
     if not IsEmpty then begin
       // Get content
       while SkipWhitespace or ParseCharData or ParseCDSect or ParsePI or
-        ParseComment or ParseElement(NewElem) or ParseReference do;
+        ParseComment(NewElem) or ParseElement(NewElem) or
+	ParseReference(NewElem) do;
 
       // Get ETag [42]
       ExpectString('</');
@@ -676,9 +713,9 @@ begin
     Result := False;
 end;
 
-procedure TXMLReader.ExpectElement(owner: TDOMNode);
+procedure TXMLReader.ExpectElement(AOwner: TDOMNode);
 begin
-  if not ParseElement(owner) then
+  if not ParseElement(AOwner) then
     RaiseExc('Expected element');
 end;
 
@@ -692,18 +729,20 @@ begin
     Result := False;
 end;
 
-function TXMLReader.ParseReference: Boolean;    // [67] [68] [69]
+function TXMLReader.ParseReference(AOwner: TDOMNode): Boolean;    // [67] [68]
 begin
-  if (buf[0] <> '&') and (buf[0] <> '%') then exit(False);
-  Inc(buf);
-  ExpectName;
+  if not CheckFor('&') then begin
+    Result := False;
+    exit;
+  end;
+  AOwner.AppendChild(doc.CreateEntityReference(ExpectName));
   ExpectString(';');
   Result := True;
 end;
 
-procedure TXMLReader.ExpectReference;
+procedure TXMLReader.ExpectReference(AOwner: TDOMNode);
 begin
-  if not ParseReference then
+  if not ParseReference(AOwner) then
     RaiseExc('Expected reference ("&Name;" or "%Name;")');
 end;
 
@@ -788,17 +827,49 @@ var
   BufSize: LongInt;
 begin
   BufSize := FileSize(f) + 1;
-  if BufSize <= 1 then exit(nil);
+  if BufSize <= 1 then begin
+    Result := nil;
+    exit;
+  end;
 
-  reader := TXMLReader.Create;
   GetMem(buf, BufSize);
   BlockRead(f, buf^, BufSize - 1);
   buf[BufSize - 1] := #0;
+  reader := TXMLReader.Create;
   Result := reader.ProcessXML(buf);
   FreeMem(buf, BufSize);
   reader.Free;
 end;
 
+function ReadXMLFile(var f: TStream): TXMLDocument;
+var
+  reader: TXMLReader;
+  buf: PChar;
+begin
+  if f.Size = 0 then begin
+    Result := nil;
+    exit;
+  end;
+
+  GetMem(buf, f.Size + 1);
+  f.Read(buf^, f.Size);
+  buf[f.Size] := #0;
+  reader := TXMLReader.Create;
+  Result := reader.ProcessXML(buf);
+  FreeMem(buf, f.Size + 1);
+  reader.Free;
+end;
+
+function ReadXMLFile(const AFileName: String): TXMLDocument;
+var
+  stream: TFileStream;
+begin
+  stream := TFileStream.Create(AFileName, fmOpenRead);
+  Result := ReadXMLFile(stream);
+  stream.Free;
+end;
+
+
 function ReadDTDFile(var f: File): TXMLDocument;
 var
   reader: TXMLReader;
@@ -806,24 +877,57 @@ var
   BufSize: LongInt;
 begin
   BufSize := FileSize(f) + 1;
-  if BufSize <= 1 then exit(nil);
+  if BufSize <= 1 then begin
+    Result := nil;
+  end;
 
-  reader := TXMLReader.Create;
   GetMem(buf, BufSize + 1);
   BlockRead(f, buf^, BufSize - 1);
   buf[BufSize - 1] := #0;
+  reader := TXMLReader.Create;
   Result := reader.ProcessDTD(buf);
   FreeMem(buf, BufSize);
   reader.Free;
 end;
 
+function ReadDTDFile(var f: TStream): TXMLDocument;
+var
+  reader: TXMLReader;
+  buf: PChar;
+begin
+  if f.Size = 0 then begin
+    Result := nil;
+    exit;
+  end;
+
+  GetMem(buf, f.Size + 1);
+  f.Read(buf^, f.Size);
+  buf[f.Size] := #0;
+  reader := TXMLReader.Create;
+  Result := reader.ProcessDTD(buf);
+  FreeMem(buf, f.Size + 1);
+  reader.Free;
+end;
+
+function ReadDTDFile(const AFileName: String): TXMLDocument;
+var
+  stream: TFileStream;
+begin
+  stream := TFileStream.Create(AFileName, fmOpenRead);
+  Result := ReadDTDFile(stream);
+  stream.Free;
+end;
+
 
 end.
 
 
 {
   $Log$
-  Revision 1.2  1999-07-09 10:42:50  michael
+  Revision 1.3  1999-07-09 21:05:51  michael
+  + fixes from Guenther Sebastian
+
+  Revision 1.2  1999/07/09 10:42:50  michael
   * Removed debug statements
 
   Revision 1.1  1999/07/09 08:35:09  michael

fcl/xml/xmlwrite.pp

@@ -15,18 +15,28 @@
  **********************************************************************}
 
 {$MODE objfpc}
+{$H+}
 
 unit xmlwrite;
 
 interface
 
-uses DOM;
+uses classes, DOM;
 
+procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
 procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
+procedure WriteXMLFile(doc: TXMLDocument; var AStream: TStream);
 
 
+// =======================================================
+
 implementation
 
+
+// -------------------------------------------------------
+//   Writers for the different node types
+// -------------------------------------------------------
+
 procedure WriteElement(node: TDOMNode); forward;
 procedure WriteAttribute(node: TDOMNode); forward;
 procedure WriteText(node: TDOMNode); forward;
@@ -42,9 +52,9 @@ procedure WriteNotation(node: TDOMNode); forward;
 
 
 type
-  TWriteProc = procedure(node: TDOMNode);
+  TWriteNodeProc = procedure(node: TDOMNode);
 const
-  WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteProc =
+  WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteNodeProc =
     (WriteElement, WriteAttribute, WriteText, WriteCDATA, WriteEntityRef,
      WriteEntity, WritePI, WriteComment, WriteDocument, WriteDocumentType,
      WriteDocumentFragment, WriteNotation);
@@ -55,8 +65,46 @@ begin
 end;
 
 
+// -------------------------------------------------------
+//   Text file and TStream support
+// -------------------------------------------------------
+
+type
+  TOutputProc = procedure(s: String);
+
 var
   f: ^Text;
+  stream: TStream;
+  wrt, wrtln: TOutputProc;
+
+
+procedure Text_Write(s: String);
+begin
+  Write(f^, s);
+end;
+
+procedure Text_WriteLn(s: String);
+begin
+  WriteLn(f^, s);
+end;
+
+procedure Stream_Write(s: String);
+begin
+  stream.WriteAnsiString(s);
+end;
+
+procedure Stream_WriteLn(s: String);
+begin
+  stream.WriteAnsiString(s + #10);
+end;
+
+
+// -------------------------------------------------------
+//   Indent handling
+// -------------------------------------------------------
+
+var
+
   indent: String;
 
 
@@ -70,28 +118,34 @@ begin
   indent := Copy(indent, 1, Length(indent) - 2);
 end;
 
+
+// -------------------------------------------------------
+//   Node writers implementations
+// -------------------------------------------------------
+
+
 procedure WriteElement(node: TDOMNode);
 var
   i: Integer;
   attr, child: TDOMNode;
 begin
-  Write(f^, Indent, '<', node.NodeName);
+  wrt(Indent + '<' + node.NodeName);
   for i := 0 to node.Attributes.Length - 1 do begin
     attr := node.Attributes.Item[i];
-    Write(f^, ' ', attr.NodeName, '="', attr.NodeValue, '"');
+    wrt(' ' + attr.NodeName + '="' + attr.NodeValue + '"');
   end;
   child := node.FirstChild;
   if child = nil then
-    WriteLn(f^, '/>')
+    wrtln('/>')
   else begin
-    WriteLn(f^, '>');
+    wrtln('>');
     IncIndent;
     repeat
       WriteNode(child);
       child := child.NextSibling;
     until child = nil;
     DecIndent;
-    WriteLn(f^, Indent, '</', node.NodeName, '>');
+    wrtln(Indent + '</' + node.NodeName + '>');
   end;
 end;
 
@@ -102,17 +156,17 @@ end;
 
 procedure WriteText(node: TDOMNode);
 begin
-  WriteLn('WriteText');
+  wrt(node.NodeValue);
 end;
 
 procedure WriteCDATA(node: TDOMNode);
 begin
-  WriteLn('WriteCDATA');
+  wrtln('<![CDATA[' + node.NodeValue + ']]>');
 end;
 
 procedure WriteEntityRef(node: TDOMNode);
 begin
-  WriteLn('WriteEntityRef');
+  wrt('&' + node.NodeValue + ';');
 end;
 
 procedure WriteEntity(node: TDOMNode);
@@ -127,7 +181,7 @@ end;
 
 procedure WriteComment(node: TDOMNode);
 begin
-  WriteLn('WriteComment');
+  Write('<!--', node.NodeValue, '-->');
 end;
 
 procedure WriteDocument(node: TDOMNode);
@@ -151,17 +205,16 @@ begin
 end;
 
 
-procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
+procedure RootWriter(doc: TXMLDocument);
 var
   child: TDOMNode;
 begin
-  f := @AFile;
-  Write(f^, '<?xml version="');
-  if doc.XMLVersion <> '' then Write(f^, doc.XMLVersion)
-  else Write(f^, '1.0');
-  Write(f^, '"');
-  if doc.Encoding <> '' then Write(f^, ' encoding="', doc.Encoding, '"');
-  WriteLn(f^, '?>');
+  wrt('<?xml version="');
+  if doc.XMLVersion <> '' then wrt(doc.XMLVersion)
+  else wrt('1.0');
+  wrt('"');
+  if doc.Encoding <> '' then wrt(' encoding="' + doc.Encoding + '"');
+  wrtln('?>');
 
   indent := '';
 
@@ -173,12 +226,45 @@ begin
 end;
 
 
+// -------------------------------------------------------
+//   Interface implementation
+// -------------------------------------------------------
+
+procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
+begin
+  f := @AFile;
+  wrt := @Text_Write;
+  wrtln := @Text_WriteLn;
+  RootWriter(doc);
+end;
+
+procedure WriteXMLFile(doc: TXMLDocument; var AStream: TStream);
+begin
+  stream := AStream;
+  wrt := @Stream_Write;
+  wrtln := @Stream_WriteLn;
+  RootWriter(doc);
+end;
+
+procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
+var
+  stream: TFileStream;
+begin
+  stream := TFileStream.Create(AFileName, fmCreate);
+  WriteXMLFile(doc, stream);
+  stream.Free;
+end;
+
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  1999-07-09 08:35:09  michael
+  Revision 1.2  1999-07-09 21:05:53  michael
+  + fixes from Guenther Sebastian
+
+  Revision 1.1  1999/07/09 08:35:09  michael
   + Initial implementation by Sebastian Guenther
 
 }