1------------------------------------------------------------------------------ 2-- XML/Ada - An XML suite for Ada95 -- 3-- -- 4-- Copyright (C) 2001-2017, AdaCore -- 5-- -- 6-- This library is free software; you can redistribute it and/or modify it -- 7-- under terms of the GNU General Public License as published by the Free -- 8-- Software Foundation; either version 3, or (at your option) any later -- 9-- version. This library is distributed in the hope that it will be useful, -- 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 12-- -- 13-- As a special exception under Section 7 of GPL version 3, you are granted -- 14-- additional permissions described in the GCC Runtime Library Exception, -- 15-- version 3.1, as published by the Free Software Foundation. -- 16-- -- 17-- You should have received a copy of the GNU General Public License and -- 18-- a copy of the GCC Runtime Library Exception along with this program; -- 19-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 20-- <http://www.gnu.org/licenses/>. -- 21-- -- 22------------------------------------------------------------------------------ 23 24pragma Ada_05; 25 26with Sax.Attributes; use Sax.Attributes; 27with Sax.Symbols; use Sax.Symbols; 28with Sax.Utils; use Sax.Utils; 29with Unicode; use Unicode; 30with Unicode.CES; use Unicode.CES; 31with DOM.Core.Attrs; use DOM.Core.Attrs; 32with DOM.Core.Nodes; use DOM.Core.Nodes; 33with DOM.Core.Documents; use DOM.Core.Documents; 34with DOM.Core.Elements; use DOM.Core.Elements; 35with DOM.Core.Character_Datas; use DOM.Core.Character_Datas; 36 37package body DOM.Readers is 38 39 -------------------- 40 -- Start_Document -- 41 -------------------- 42 43 procedure Start_Document (Handler : in out Tree_Reader) is 44 Implementation : DOM_Implementation; 45 begin 46 Handler.Tree := Create_Document 47 (Implementation, Symbols => Get_Symbol_Table (Handler)); 48 Handler.Current_Node := Handler.Tree; 49 end Start_Document; 50 51 ------------------- 52 -- Start_Element -- 53 ------------------- 54 55 procedure Start_Element 56 (Handler : in out Tree_Reader; 57 NS : Sax.Utils.XML_NS; 58 Local_Name : Sax.Symbols.Symbol; 59 Atts : Sax_Attribute_List) 60 is 61 Att, Att2 : Attr; 62 pragma Warnings (Off, Local_Name); 63 pragma Warnings (Off, Att2); 64 Name : Qualified_Name; 65 begin 66 Handler.Current_Node := Append_Child 67 (Handler.Current_Node, 68 Create_Element_NS 69 (Handler.Tree, 70 Symbols => Get_Symbol_Table (Handler), 71 Namespace_URI => Get_URI (NS), 72 Prefix => Get_Prefix (NS), 73 Local_Name => Local_Name)); 74 75 -- Insert the attributes in the right order. 76 for J in 1 .. Get_Length (Atts) loop 77 Name := Get_Name (Atts, J); 78 Att := Create_Attribute_NS 79 (Handler.Tree, 80 Symbols => Get_Symbol_Table (Handler), 81 Namespace_URI => Name.NS, 82 Prefix => Get_Prefix (Atts, J), 83 Local_Name => Name.Local); 84 Set_Value (Att, Get_Value (Atts, J)); 85 Att2 := Set_Attribute_Node (Handler.Current_Node, Att); 86 if Get_Type (Atts, J) = Sax.Attributes.Id then 87 Set_Id_Attribute_Node (Handler.Current_Node, Att, Is_Id => True); 88 end if; 89 end loop; 90 end Start_Element; 91 92 ----------------- 93 -- End_Element -- 94 ----------------- 95 96 procedure End_Element 97 (Handler : in out Tree_Reader; 98 NS : Sax.Utils.XML_NS; 99 Local_Name : Sax.Symbols.Symbol) 100 is 101 pragma Warnings (Off, NS); 102 pragma Warnings (Off, Local_Name); 103 begin 104 Handler.Current_Node := Parent_Node (Handler.Current_Node); 105 end End_Element; 106 107 ---------------- 108 -- Characters -- 109 ---------------- 110 111 procedure Characters 112 (Handler : in out Tree_Reader; Ch : Unicode.CES.Byte_Sequence) 113 is 114 pragma Unmodified (Handler); 115 Tmp : Node; 116 pragma Unreferenced (Tmp); 117 begin 118 -- If previous child is already a text node, we should just concatenate 119 -- the two, as required in DOM specifications (in Text node description) 120 if Last_Child (Handler.Current_Node) /= null 121 and then Node_Type (Last_Child (Handler.Current_Node)) = Text_Node 122 then 123 Append_Data (Last_Child (Handler.Current_Node), Ch); 124 else 125 Tmp := Append_Child 126 (Handler.Current_Node, Create_Text_Node (Handler.Tree, Ch)); 127 end if; 128 end Characters; 129 130 ------------- 131 -- Comment -- 132 ------------- 133 134 procedure Comment 135 (Handler : in out Tree_Reader; 136 Comment : Unicode.CES.Byte_Sequence) 137 is 138 pragma Unmodified (Handler); 139 Tmp : Node; 140 pragma Unreferenced (Tmp); 141 begin 142 Tmp := Append_Child 143 (Handler.Current_Node, Create_Comment (Handler.Tree, Comment)); 144 end Comment; 145 146 -------------------------- 147 -- Ignorable_Whitespace -- 148 -------------------------- 149 150 procedure Ignorable_Whitespace 151 (Handler : in out Tree_Reader; Ch : Unicode.CES.Byte_Sequence) 152 is 153 pragma Unmodified (Handler); 154 Tmp : Node; 155 pragma Unreferenced (Tmp); 156 begin 157 -- Ignore these white spaces at the toplevel 158 if Handler.Current_Node /= Handler.Tree then 159 Tmp := Append_Child 160 (Handler.Current_Node, Create_Text_Node (Handler.Tree, Ch)); 161 end if; 162 end Ignorable_Whitespace; 163 164 ---------------------------- 165 -- Processing_Instruction -- 166 ---------------------------- 167 168 procedure Processing_Instruction 169 (Handler : in out Tree_Reader; 170 Target : Unicode.CES.Byte_Sequence; 171 Data : Unicode.CES.Byte_Sequence) 172 is 173 pragma Unmodified (Handler); 174 Tmp : Node; 175 pragma Unreferenced (Tmp); 176 begin 177 if not Handler.In_DTD then 178 Tmp := Append_Child 179 (Handler.Current_Node, 180 Create_Processing_Instruction (Handler.Tree, Target, Data)); 181 end if; 182 end Processing_Instruction; 183 184 -------------- 185 -- Get_Tree -- 186 -------------- 187 188 function Get_Tree (Read : Tree_Reader) return Document is 189 begin 190 return Read.Tree; 191 end Get_Tree; 192 193 --------------- 194 -- Start_DTD -- 195 --------------- 196 197 procedure Start_DTD 198 (Handler : in out Tree_Reader; 199 Name : Unicode.CES.Byte_Sequence; 200 Public_Id : Unicode.CES.Byte_Sequence := ""; 201 System_Id : Unicode.CES.Byte_Sequence := "") 202 is 203 pragma Unreferenced (Name, Public_Id, System_Id); 204 begin 205 Handler.In_DTD := True; 206 end Start_DTD; 207 208 ------------- 209 -- End_DTD -- 210 ------------- 211 212 procedure End_DTD (Handler : in out Tree_Reader) is 213 begin 214 Handler.In_DTD := False; 215 end End_DTD; 216 217 ----------- 218 -- Error -- 219 ----------- 220 221 procedure Error 222 (Handler : in out Tree_Reader; 223 Except : Sax.Exceptions.Sax_Parse_Exception'Class) is 224 begin 225 Fatal_Error (Handler, Except); 226 end Error; 227 228 ------------- 229 -- Warning -- 230 ------------- 231 232 procedure Warning 233 (Handler : in out Tree_Reader; 234 Except : Sax.Exceptions.Sax_Parse_Exception'Class) is 235 begin 236 if Handler.Warnings_As_Error then 237 Fatal_Error (Handler, Except); 238 end if; 239 end Warning; 240 241 ---------- 242 -- Free -- 243 ---------- 244 245 procedure Free (Read : in out Tree_Reader) is 246 begin 247 Free (Read.Tree); 248 Read.Tree := null; 249 end Free; 250 251 ---------------------------- 252 -- Set_Warnings_As_Errors -- 253 ---------------------------- 254 255 procedure Set_Warnings_As_Errors 256 (Read : in out Tree_Reader; Warnings_As_Error : Boolean) is 257 begin 258 Read.Warnings_As_Error := Warnings_As_Error; 259 end Set_Warnings_As_Errors; 260 261 ------------------ 262 -- Current_Node -- 263 ------------------ 264 265 function Current_Node (Read : Tree_Reader) return Node is 266 begin 267 return Read.Current_Node; 268 end Current_Node; 269 270end DOM.Readers; 271