1----------------------------------------------------------------------- 2-- util-serialize-io-xml -- XML Serialization Driver 3-- Copyright (C) 2011, 2012 Stephane Carrez 4-- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5-- 6-- Licensed under the Apache License, Version 2.0 (the "License"); 7-- you may not use this file except in compliance with the License. 8-- You may obtain a copy of the License at 9-- 10-- http://www.apache.org/licenses/LICENSE-2.0 11-- 12-- Unless required by applicable law or agreed to in writing, software 13-- distributed under the License is distributed on an "AS IS" BASIS, 14-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15-- See the License for the specific language governing permissions and 16-- limitations under the License. 17----------------------------------------------------------------------- 18 19with Sax.Exceptions; 20with Sax.Locators; 21with Sax.Readers; 22with Sax.Attributes; 23with Unicode.CES; 24with Input_Sources; 25 26with Ada.Strings.Unbounded; 27with Util.Streams.Buffered; 28with Util.Streams.Texts; 29package Util.Serialize.IO.XML is 30 31 Parse_Error : exception; 32 33 type Parser is new Serialize.IO.Parser with private; 34 35 -- Parse the stream using the JSON parser. 36 procedure Parse (Handler : in out Parser; 37 Stream : in out Util.Streams.Buffered.Buffered_Stream'Class); 38 39 -- Set the XHTML reader to ignore or not the white spaces. 40 -- When set to True, the ignorable white spaces will not be kept. 41 procedure Set_Ignore_White_Spaces (Reader : in out Parser; 42 Value : in Boolean); 43 44 -- Set the XHTML reader to ignore empty lines. 45 procedure Set_Ignore_Empty_Lines (Reader : in out Parser; 46 Value : in Boolean); 47 48 -- Get the current location (file and line) to report an error message. 49 function Get_Location (Handler : in Parser) return String; 50 51 type Xhtml_Reader is new Sax.Readers.Reader with private; 52 53 54 -- ------------------------------ 55 -- XML Output Stream 56 -- ------------------------------ 57 -- The <b>Output_Stream</b> provides methods for creating an XML output stream. 58 -- The stream object takes care of the XML escape rules. 59 type Output_Stream is 60 new Util.Streams.Texts.Print_Stream and Util.Serialize.IO.Output_Stream with private; 61 62 -- Write the value as a XML string. Special characters are escaped using the XML 63 -- escape rules. 64 procedure Write_String (Stream : in out Output_Stream; 65 Value : in String); 66 67 -- Write the value as a XML string. Special characters are escaped using the XML 68 -- escape rules. 69 procedure Write_String (Stream : in out Output_Stream; 70 Value : in Util.Beans.Objects.Object); 71 72 -- Start a new XML object. 73 procedure Start_Entity (Stream : in out Output_Stream; 74 Name : in String); 75 76 -- Terminates the current XML object. 77 procedure End_Entity (Stream : in out Output_Stream; 78 Name : in String); 79 80 -- Write a XML name/value attribute. 81 procedure Write_Attribute (Stream : in out Output_Stream; 82 Name : in String; 83 Value : in Util.Beans.Objects.Object); 84 85 -- Write a XML name/value entity (see Write_Attribute). 86 procedure Write_Entity (Stream : in out Output_Stream; 87 Name : in String; 88 Value : in Util.Beans.Objects.Object); 89 90 -- Starts a XML array. 91 procedure Start_Array (Stream : in out Output_Stream; 92 Length : in Ada.Containers.Count_Type); 93 94 -- Terminates a XML array. 95 procedure End_Array (Stream : in out Output_Stream); 96 97 -- Return the location where the exception was raised. 98 function Get_Location (Except : Sax.Exceptions.Sax_Parse_Exception'Class) 99 return String; 100 101private 102 103 overriding 104 procedure Warning (Handler : in out Xhtml_Reader; 105 Except : in Sax.Exceptions.Sax_Parse_Exception'Class); 106 107 overriding 108 procedure Error (Handler : in out Xhtml_Reader; 109 Except : in Sax.Exceptions.Sax_Parse_Exception'Class); 110 111 overriding 112 procedure Fatal_Error (Handler : in out Xhtml_Reader; 113 Except : in Sax.Exceptions.Sax_Parse_Exception'Class); 114 115 overriding 116 procedure Set_Document_Locator (Handler : in out Xhtml_Reader; 117 Loc : in out Sax.Locators.Locator); 118 119 overriding 120 procedure Start_Document (Handler : in out Xhtml_Reader); 121 122 overriding 123 procedure End_Document (Handler : in out Xhtml_Reader); 124 125 overriding 126 procedure Start_Prefix_Mapping (Handler : in out Xhtml_Reader; 127 Prefix : in Unicode.CES.Byte_Sequence; 128 URI : in Unicode.CES.Byte_Sequence); 129 130 overriding 131 procedure End_Prefix_Mapping (Handler : in out Xhtml_Reader; 132 Prefix : in Unicode.CES.Byte_Sequence); 133 134 overriding 135 procedure Start_Element (Handler : in out Xhtml_Reader; 136 Namespace_URI : in Unicode.CES.Byte_Sequence := ""; 137 Local_Name : in Unicode.CES.Byte_Sequence := ""; 138 Qname : in Unicode.CES.Byte_Sequence := ""; 139 Atts : in Sax.Attributes.Attributes'Class); 140 141 overriding 142 procedure End_Element (Handler : in out Xhtml_Reader; 143 Namespace_URI : in Unicode.CES.Byte_Sequence := ""; 144 Local_Name : in Unicode.CES.Byte_Sequence := ""; 145 Qname : in Unicode.CES.Byte_Sequence := ""); 146 147 overriding 148 procedure Characters (Handler : in out Xhtml_Reader; 149 Ch : in Unicode.CES.Byte_Sequence); 150 151 overriding 152 procedure Ignorable_Whitespace (Handler : in out Xhtml_Reader; 153 Ch : in Unicode.CES.Byte_Sequence); 154 155 overriding 156 procedure Processing_Instruction (Handler : in out Xhtml_Reader; 157 Target : in Unicode.CES.Byte_Sequence; 158 Data : in Unicode.CES.Byte_Sequence); 159 160 overriding 161 procedure Skipped_Entity (Handler : in out Xhtml_Reader; 162 Name : in Unicode.CES.Byte_Sequence); 163 164 overriding 165 procedure Start_Cdata (Handler : in out Xhtml_Reader); 166 167 overriding 168 procedure End_Cdata (Handler : in out Xhtml_Reader); 169 170 overriding 171 function Resolve_Entity (Handler : Xhtml_Reader; 172 Public_Id : Unicode.CES.Byte_Sequence; 173 System_Id : Unicode.CES.Byte_Sequence) 174 return Input_Sources.Input_Source_Access; 175 176 overriding 177 procedure Start_DTD (Handler : in out Xhtml_Reader; 178 Name : Unicode.CES.Byte_Sequence; 179 Public_Id : Unicode.CES.Byte_Sequence := ""; 180 System_Id : Unicode.CES.Byte_Sequence := ""); 181 182 procedure Collect_Text (Handler : in out Xhtml_Reader; 183 Content : Unicode.CES.Byte_Sequence); 184 185 type Xhtml_Reader is new Sax.Readers.Reader with record 186 Stack_Pos : Natural := 0; 187 Handler : access Parser'Class; 188 189 Text : Ada.Strings.Unbounded.Unbounded_String; 190 191 -- Whether white spaces can be ignored. 192 Ignore_White_Spaces : Boolean := True; 193 194 -- Whether empty lines should be ignored (when white spaces are kept). 195 Ignore_Empty_Lines : Boolean := True; 196 end record; 197 198 type Parser is new Util.Serialize.IO.Parser with record 199 -- The SAX locator to find the current file and line number. 200 Locator : Sax.Locators.Locator; 201 Has_Pending_Char : Boolean := False; 202 Pending_Char : Character; 203 204 -- Whether white spaces can be ignored. 205 Ignore_White_Spaces : Boolean := True; 206 207 -- Whether empty lines should be ignored (when white spaces are kept). 208 Ignore_Empty_Lines : Boolean := True; 209 end record; 210 211 type Output_Stream is 212 new Util.Streams.Texts.Print_Stream and Util.Serialize.IO.Output_Stream with record 213 Close_Start : Boolean := False; 214 end record; 215 216end Util.Serialize.IO.XML; 217