1------------------------------------------------------------------------------ 2-- -- 3-- Matreshka Project -- 4-- -- 5-- XML Processor -- 6-- -- 7-- Runtime Library Component -- 8-- -- 9------------------------------------------------------------------------------ 10-- -- 11-- Copyright © 2010-2012, Vadim Godunko <vgodunko@gmail.com> -- 12-- All rights reserved. -- 13-- -- 14-- Redistribution and use in source and binary forms, with or without -- 15-- modification, are permitted provided that the following conditions -- 16-- are met: -- 17-- -- 18-- * Redistributions of source code must retain the above copyright -- 19-- notice, this list of conditions and the following disclaimer. -- 20-- -- 21-- * Redistributions in binary form must reproduce the above copyright -- 22-- notice, this list of conditions and the following disclaimer in the -- 23-- documentation and/or other materials provided with the distribution. -- 24-- -- 25-- * Neither the name of the Vadim Godunko, IE nor the names of its -- 26-- contributors may be used to endorse or promote products derived from -- 27-- this software without specific prior written permission. -- 28-- -- 29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- 35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- 36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- 37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- 38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- 39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 40-- -- 41------------------------------------------------------------------------------ 42-- $Revision: 3071 $ $Date: 2012-08-17 11:56:20 +0400 (Fri, 17 Aug 2012) $ 43------------------------------------------------------------------------------ 44-- This package provides the SAX_Attributes type provides XML attributes. 45------------------------------------------------------------------------------ 46pragma Ada_2012; 47 48private with Ada.Finalization; 49 50with League.Strings; 51private with Matreshka.Atomics.Counters; 52private with Matreshka.Internals.Strings; 53 54package XML.SAX.Attributes is 55 56 pragma Preelaborate; 57 58 type SAX_Attributes is tagged private 59 with Iterator_Element => League.Strings.Universal_String, 60 Constant_Indexing => Value; 61 pragma Preelaborable_Initialization (SAX_Attributes); 62 63 Empty_SAX_Attributes : constant SAX_Attributes; 64 65 function Length (Self : SAX_Attributes'Class) return Natural; 66 -- Returns the number of attributes in the list. 67 68 procedure Clear (Self : in out SAX_Attributes'Class); 69 -- Removes all attributes from the set. 70 71 function Index 72 (Self : SAX_Attributes'Class; 73 Qualified_Name : League.Strings.Universal_String) 74 return Natural; 75 -- Looks up the index of an attribute by the qualified name. Returns the 76 -- index of the attribute of zero if it wasn't found. 77 78 function Index 79 (Self : SAX_Attributes'Class; 80 Namespace_URI : League.Strings.Universal_String; 81 Local_Name : League.Strings.Universal_String) 82 return Natural; 83 -- Looks up the index of an attribute by a namespace name. Namespace_URI 84 -- specifies the namespace URI, or an empty string if the name has no 85 -- namespace URI. Local_Name specifies the attribute's local name. 86 -- Returns the index of the attribute, or zero if it wasn't found. 87 88 function Is_Declared 89 (Self : SAX_Attributes'Class; 90 Index : Positive) return Boolean; 91 -- Returns True if the attribute at the specified position was declared in 92 -- the DTD, False otherwise. The index must be valid position, otherwise 93 -- Constraint_Error is raised. 94 95 function Is_Declared 96 (Self : SAX_Attributes'Class; 97 Qualified_Name : League.Strings.Universal_String) 98 return Boolean; 99 -- Looks up whether an attribute was declared in the DTD for the qualified 100 -- name and returns True. 101 102 function Is_Declared 103 (Self : SAX_Attributes'Class; 104 Namespace_URI : League.Strings.Universal_String; 105 Local_Name : League.Strings.Universal_String) 106 return Boolean; 107 -- Looks up whether an attribute was declared in the DTD by namespace name. 108 -- Namespace_URI specifies the namespace URI, or an empty string if the 109 -- name has no namespace URI, Local_Name specifies the attribute's local 110 -- name. 111 112 function Is_Empty (Self : SAX_Attributes'Class) return Boolean; 113 -- Returns True when there are no attributes available. 114 115 function Is_Specified 116 (Self : SAX_Attributes'Class; 117 Index : Positive) return Boolean; 118 -- Returns True if the attribute's value at the specified position was 119 -- found in the XML text, False if the value was provided by the DTD 120 -- defaulting. The index must be valid position, otherwise Constraint_Error 121 -- is raised. 122 123 function Is_Specified 124 (Self : SAX_Attributes'Class; 125 Qualified_Name : League.Strings.Universal_String) 126 return Boolean; 127 -- Looks up whether an attribute's value was found in the XML text for the 128 -- qualified name, False if the value was provided by the DTD defaulting. 129 130 function Is_Specified 131 (Self : SAX_Attributes'Class; 132 Namespace_URI : League.Strings.Universal_String; 133 Local_Name : League.Strings.Universal_String) 134 return Boolean; 135 -- Looks up whether an attribute's value was found in the XML text for the 136 -- namespace name, False if the value was provided by the DTD defaulting. 137 -- Namespace_URI specifies the namespace URI, or an empty string if the 138 -- name has no namespace URI, Local_Name specifies the attribute's local 139 -- name. 140 141 function Local_Name 142 (Self : SAX_Attributes'Class; 143 Index : Positive) return League.Strings.Universal_String; 144 -- Returns an attribute's local name for the attribute at the specified 145 -- position. If no namespace processing is done, the local name is an empty 146 -- string. The index must be valid position, otherwise Constraint_Error is 147 -- raised. 148 149 function Namespace_URI 150 (Self : SAX_Attributes'Class; 151 Index : Positive) return League.Strings.Universal_String; 152 -- Returns an attribute's namespace URI for the attribute at the specified 153 -- position. If no namespace processing is done or if the attribute has no 154 -- namespace, the namespace URI is an empty string. The index must be valid 155 -- position, otherwise Constraint_Error is raised. 156 157 function Qualified_Name 158 (Self : SAX_Attributes'Class; 159 Index : Positive) return League.Strings.Universal_String; 160 -- Returns an attribute's qualified name for the attribute at the specified 161 -- position. The index must be valid position, otherwise Constraint_Error 162 -- is raised. 163 164 function Value 165 (Self : SAX_Attributes'Class; 166 Index : Positive) return League.Strings.Universal_String; 167 -- Returns an attribute's value for the attribute at the specified 168 -- position. The index must be valid position, otherwise Constraint_Error 169 -- is raised. 170 -- 171 -- If the attribute value is a list of tokens (IDREFS, ENTITIES, or 172 -- NMTOKENS), the tokens will be concatenated into a single string with 173 -- each token separated by a single space. 174 175 function Value 176 (Self : SAX_Attributes'Class; 177 Qualified_Name : League.Strings.Universal_String) 178 return League.Strings.Universal_String; 179 -- Looks up an attribute's value for the qualified name, or an empty 180 -- string if no attribute exists for the name given. 181 -- 182 -- If the attribute value is a list of tokens (IDREFS, ENTITIES, or 183 -- NMTOKENS), the tokens will be concatenated into a single string with 184 -- each token separated by a single space. 185 186 function Value 187 (Self : SAX_Attributes'Class; 188 Namespace_URI : League.Strings.Universal_String; 189 Local_Name : League.Strings.Universal_String) 190 return League.Strings.Universal_String; 191 -- Looks up an attribute's value by namespace name. Namespace_URI specifies 192 -- the namespace URI, or an empty string if the name has no namespace URI, 193 -- Local_Name specifies the attribute's local name. 194 -- 195 -- If the attribute value is a list of tokens (IDREFS, ENTITIES, or 196 -- NMTOKENS), the tokens will be concatenated into a single string with 197 -- each token separated by a single space. 198 199 function Value_Type 200 (Self : SAX_Attributes'Class; 201 Index : Positive) return League.Strings.Universal_String; 202 -- Looks up an attribute's type for the attribute at position Index. 203 -- 204 -- The attribute type is one of the strings "CDATA", "ID", "IDREF", 205 -- "IDREFS", "NMTOKEN", "NMTOKENS", "ENTITY", "ENTITIES", or "NOTATION" 206 -- (always in upper case). 207 -- 208 -- If the parser has not read a declaration for the attribute, or if the 209 -- parser does not report attribute types, then it must return the value 210 -- "CDATA" as stated in the XML 1.0 Recommendation (clause 3.3.3, 211 -- "Attribute-Value Normalization"). 212 -- 213 -- For an enumerated attribute that is not a notation, the parser will 214 -- report the type as "NMTOKEN". 215 216 function Value_Type 217 (Self : SAX_Attributes'Class; 218 Qualified_Name : League.Strings.Universal_String) 219 return League.Strings.Universal_String; 220 -- Looks up an attribute's type for the qualified name Qualified_Name. 221 -- 222 -- The attribute type is one of the strings "CDATA", "ID", "IDREF", 223 -- "IDREFS", "NMTOKEN", "NMTOKENS", "ENTITY", "ENTITIES", or "NOTATION" 224 -- (always in upper case). 225 -- 226 -- If the parser has not read a declaration for the attribute, or if the 227 -- parser does not report attribute types, then it must return the value 228 -- "CDATA" as stated in the XML 1.0 Recommendation (clause 3.3.3, 229 -- "Attribute-Value Normalization"). 230 -- 231 -- For an enumerated attribute that is not a notation, the parser will 232 -- report the type as "NMTOKEN". 233 234 function Value_Type 235 (Self : SAX_Attributes'Class; 236 Namespace_URI : League.Strings.Universal_String; 237 Local_Name : League.Strings.Universal_String) 238 return League.Strings.Universal_String; 239 -- Looks up an attribute's type by namespace name. 240 -- 241 -- Namespace_URI specifies the namespace URI and Local_Name specifies the 242 -- local name. If the name has no namespace URI, use an empty string for 243 -- Namespace_URI. 244 -- 245 -- The attribute type is one of the strings "CDATA", "ID", "IDREF", 246 -- "IDREFS", "NMTOKEN", "NMTOKENS", "ENTITY", "ENTITIES", or "NOTATION" 247 -- (always in upper case). 248 -- 249 -- If the parser has not read a declaration for the attribute, or if the 250 -- parser does not report attribute types, then it must return the value 251 -- "CDATA" as stated in the XML 1.0 Recommendation (clause 3.3.3, 252 -- "Attribute-Value Normalization"). 253 -- 254 -- For an enumerated attribute that is not a notation, the parser will 255 -- report the type as "NMTOKEN". 256 257 procedure Set_Value 258 (Self : in out SAX_Attributes'Class; 259 Qualified_Name : League.Strings.Universal_String; 260 Value : League.Strings.Universal_String); 261 -- Sets value of attribute specified by its qualified name Qualified_Name. 262 -- 263 -- If attribute is present in the set its value is changed, otherwise 264 -- new attribute is added to the set. 265 266 procedure Set_Value 267 (Self : in out SAX_Attributes'Class; 268 Namespace_URI : League.Strings.Universal_String; 269 Local_Name : League.Strings.Universal_String; 270 Value : League.Strings.Universal_String); 271 -- Sets value of attribute specified by the namespace name. 272 -- 273 -- Namespace_URI specifies the namespace URI and Local_Name specifies the 274 -- local name. If the name has no namespace URI, use an empty string for 275 -- Namespace_URI. 276 -- 277 -- If attribute is present in the set its value is changed, otherwise 278 -- new attribute is added to the set. 279 280private 281 282 -- Representation of one attribute and its value. 283 284 type Attribute is record 285 Namespace_URI : Matreshka.Internals.Strings.Shared_String_Access 286 := Matreshka.Internals.Strings.Shared_Empty'Access; 287 Local_Name : Matreshka.Internals.Strings.Shared_String_Access 288 := Matreshka.Internals.Strings.Shared_Empty'Access; 289 Qualified_Name : Matreshka.Internals.Strings.Shared_String_Access 290 := Matreshka.Internals.Strings.Shared_Empty'Access; 291 Value : Matreshka.Internals.Strings.Shared_String_Access 292 := Matreshka.Internals.Strings.Shared_Empty'Access; 293 Value_Type : Matreshka.Internals.Strings.Shared_String_Access 294 := Matreshka.Internals.Strings.Shared_Empty'Access; 295 Is_Declared : Boolean; 296 Is_Specified : Boolean; 297 end record; 298 299 -- Set attributes and its values shared between SAX_Attributes instances. 300 301 type Attribute_Array is array (Positive range <>) of Attribute; 302 303 type Shared_Attributes (Last : Natural) is record 304 Counter : Matreshka.Atomics.Counters.Counter; 305 Values : Attribute_Array (1 .. Last); 306 Length : Natural := 0; 307 end record; 308 309 type Shared_Attributes_Access is access all Shared_Attributes; 310 311 procedure Reference (Self : Shared_Attributes_Access); 312 pragma Inline (Reference); 313 -- Increments reference counter. 314 315 procedure Dereference (Self : in out Shared_Attributes_Access); 316 -- Decrements reference counter and release resources when it reach zero. 317 318 function Can_Be_Reused (Self : Shared_Attributes_Access) return Boolean; 319 -- Returns True when the counter is equal to one, thus there are no other 320 -- reference to this shared object and it can be mutated instead of 321 -- allocation of new shared object. 322 323 procedure Detach (Self : in out Shared_Attributes_Access; Size : Natural); 324 -- Checks whether specified set of attributes can be reused to store data 325 -- of the specified size and prepare it to be changed; otherwise allocates 326 -- new set of attributes and copy data. 327 328 Shared_Empty : aliased Shared_Attributes (0); 329 -- Globals shared object. It is used to represent empty set of attributes 330 -- to avoid unnecessary memory allocation/deallocation and number of 331 -- atomic increment/decrement operations. 332 333 -------------------- 334 -- SAX_Attributes -- 335 -------------------- 336 337 type SAX_Attributes is new Ada.Finalization.Controlled with record 338 Data : Shared_Attributes_Access := Shared_Empty'Access; 339 end record; 340 341 overriding procedure Adjust (Self : in out SAX_Attributes); 342 343 overriding procedure Finalize (Self : in out SAX_Attributes); 344 345 Empty_SAX_Attributes : constant SAX_Attributes 346 := (Ada.Finalization.Controlled with Data => Shared_Empty'Access); 347 348 pragma Inline (Is_Empty); 349 pragma Inline (Length); 350 351end XML.SAX.Attributes; 352