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