------------------------------------------------------------------------------ -- -- -- Matreshka Project -- -- -- -- XML Processor -- -- -- -- Runtime Library Component -- -- -- ------------------------------------------------------------------------------ -- -- -- Copyright © 2010-2011, Vadim Godunko -- -- All rights reserved. -- -- -- -- Redistribution and use in source and binary forms, with or without -- -- modification, are permitted provided that the following conditions -- -- are met: -- -- -- -- * Redistributions of source code must retain the above copyright -- -- notice, this list of conditions and the following disclaimer. -- -- -- -- * Redistributions in binary form must reproduce the above copyright -- -- notice, this list of conditions and the following disclaimer in the -- -- documentation and/or other materials provided with the distribution. -- -- -- -- * Neither the name of the Vadim Godunko, IE nor the names of its -- -- contributors may be used to endorse or promote products derived from -- -- this software without specific prior written permission. -- -- -- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- -- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- -- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- -- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- -- -- ------------------------------------------------------------------------------ -- $Revision: 2135 $ $Date: 2011-10-09 23:01:29 +0400 (Sun, 09 Oct 2011) $ ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; with League.Strings.Internals; with Matreshka.Internals.Strings.Configuration; package body XML.SAX.Attributes is use League.Strings; use Matreshka.Internals.Strings.Configuration; procedure Free is new Ada.Unchecked_Deallocation (Shared_Attributes, Shared_Attributes_Access); ------------ -- Adjust -- ------------ overriding procedure Adjust (Self : in out SAX_Attributes) is begin Reference (Self.Data); end Adjust; ------------------- -- Can_Be_Reused -- ------------------- function Can_Be_Reused (Self : Shared_Attributes_Access) return Boolean is begin return Matreshka.Atomics.Counters.Is_One (Self.Counter); end Can_Be_Reused; ----------- -- Clear -- ----------- procedure Clear (Self : in out SAX_Attributes'Class) is begin if Can_Be_Reused (Self.Data) then for J in 1 .. Self.Data.Length loop Matreshka.Internals.Strings.Dereference (Self.Data.Values (J).Namespace_URI); Matreshka.Internals.Strings.Dereference (Self.Data.Values (J).Local_Name); Matreshka.Internals.Strings.Dereference (Self.Data.Values (J).Qualified_Name); Matreshka.Internals.Strings.Dereference (Self.Data.Values (J).Value); Matreshka.Internals.Strings.Dereference (Self.Data.Values (J).Value_Type); end loop; Self.Data.Length := 0; else Dereference (Self.Data); Self.Data := new Shared_Attributes (8); end if; end Clear; ----------------- -- Dereference -- ----------------- procedure Dereference (Self : in out Shared_Attributes_Access) is begin if Self /= Shared_Empty'Access then if Matreshka.Atomics.Counters.Decrement (Self.Counter) then for J in 1 .. Self.Length loop Matreshka.Internals.Strings.Dereference (Self.Values (J).Namespace_URI); Matreshka.Internals.Strings.Dereference (Self.Values (J).Local_Name); Matreshka.Internals.Strings.Dereference (Self.Values (J).Qualified_Name); Matreshka.Internals.Strings.Dereference (Self.Values (J).Value); Matreshka.Internals.Strings.Dereference (Self.Values (J).Value_Type); end loop; Free (Self); else Self := null; end if; end if; end Dereference; ------------ -- Detach -- ------------ procedure Detach (Self : in out Shared_Attributes_Access; Size : Natural) is begin -- Reallocate shared object when necessary. if not Can_Be_Reused (Self) -- Object can't be mutated because someone else use it. Allocate -- new shared object and copy data. or else Self.Last < Size -- There are no enought space to store new attribute. Reallocate new -- object and copy data. then declare Aux : constant Shared_Attributes_Access := new Shared_Attributes ((Size + 8) / 8 * 8); begin Aux.Values (1 .. Self.Length) := Self.Values (1 .. Self.Length); Aux.Length := Self.Length; for J in 1 .. Aux.Length loop Matreshka.Internals.Strings.Reference (Aux.Values (J).Namespace_URI); Matreshka.Internals.Strings.Reference (Aux.Values (J).Local_Name); Matreshka.Internals.Strings.Reference (Aux.Values (J).Qualified_Name); Matreshka.Internals.Strings.Reference (Aux.Values (J).Value); Matreshka.Internals.Strings.Reference (Aux.Values (J).Value_Type); end loop; Dereference (Self); Self := Aux; end; end if; end Detach; -------------- -- Finalize -- -------------- overriding procedure Finalize (Self : in out SAX_Attributes) is begin if Self.Data /= null then Dereference (Self.Data); end if; end Finalize; ----------- -- Index -- ----------- function Index (Self : SAX_Attributes'Class; Qualified_Name : League.Strings.Universal_String) return Natural is begin for J in 1 .. Self.Data.Length loop if String_Handler.Is_Equal (Self.Data.Values (J).Qualified_Name, League.Strings.Internals.Internal (Qualified_Name)) then return J; end if; end loop; return 0; end Index; ----------- -- Index -- ----------- function Index (Self : SAX_Attributes'Class; Namespace_URI : League.Strings.Universal_String; Local_Name : League.Strings.Universal_String) return Natural is begin for J in 1 .. Self.Data.Length loop if String_Handler.Is_Equal (Self.Data.Values (J).Namespace_URI, League.Strings.Internals.Internal (Namespace_URI)) and String_Handler.Is_Equal (Self.Data.Values (J).Local_Name, League.Strings.Internals.Internal (Local_Name)) then return J; end if; end loop; return 0; end Index; ----------------- -- Is_Declared -- ----------------- function Is_Declared (Self : SAX_Attributes'Class; Index : Positive) return Boolean is begin if Index > Self.Data.Length then raise Constraint_Error; end if; return Self.Data.Values (Index).Is_Declared; end Is_Declared; ----------------- -- Is_Declared -- ----------------- function Is_Declared (Self : SAX_Attributes'Class; Qualified_Name : League.Strings.Universal_String) return Boolean is begin for J in 1 .. Self.Data.Length loop if String_Handler.Is_Equal (Self.Data.Values (J).Qualified_Name, League.Strings.Internals.Internal (Qualified_Name)) then return Self.Data.Values (J).Is_Declared; end if; end loop; return False; end Is_Declared; ----------------- -- Is_Declared -- ----------------- function Is_Declared (Self : SAX_Attributes'Class; Namespace_URI : League.Strings.Universal_String; Local_Name : League.Strings.Universal_String) return Boolean is begin for J in 1 .. Self.Data.Length loop if String_Handler.Is_Equal (Self.Data.Values (J).Namespace_URI, League.Strings.Internals.Internal (Namespace_URI)) and String_Handler.Is_Equal (Self.Data.Values (J).Local_Name, League.Strings.Internals.Internal (Local_Name)) then return Self.Data.Values (J).Is_Declared; end if; end loop; return False; end Is_Declared; -------------- -- Is_Empty -- -------------- function Is_Empty (Self : SAX_Attributes'Class) return Boolean is begin return Self.Data.Length = 0; end Is_Empty; ------------------ -- Is_Specified -- ------------------ function Is_Specified (Self : SAX_Attributes'Class; Index : Positive) return Boolean is begin if Index > Self.Data.Length then raise Constraint_Error; end if; return Self.Data.Values (Index).Is_Specified; end Is_Specified; ------------------ -- Is_Specified -- ------------------ function Is_Specified (Self : SAX_Attributes'Class; Qualified_Name : League.Strings.Universal_String) return Boolean is begin for J in 1 .. Self.Data.Length loop if String_Handler.Is_Equal (Self.Data.Values (J).Qualified_Name, League.Strings.Internals.Internal (Qualified_Name)) then return Self.Data.Values (J).Is_Specified; end if; end loop; return False; end Is_Specified; ------------------ -- Is_Specified -- ------------------ function Is_Specified (Self : SAX_Attributes'Class; Namespace_URI : League.Strings.Universal_String; Local_Name : League.Strings.Universal_String) return Boolean is begin for J in 1 .. Self.Data.Length loop if String_Handler.Is_Equal (Self.Data.Values (J).Namespace_URI, League.Strings.Internals.Internal (Namespace_URI)) and String_Handler.Is_Equal (Self.Data.Values (J).Local_Name, League.Strings.Internals.Internal (Local_Name)) then return Self.Data.Values (J).Is_Specified; end if; end loop; return False; end Is_Specified; ------------ -- Length -- ------------ function Length (Self : SAX_Attributes'Class) return Natural is begin return Self.Data.Length; end Length; ---------------- -- Local_Name -- ---------------- function Local_Name (Self : SAX_Attributes'Class; Index : Positive) return League.Strings.Universal_String is begin if Index > Self.Data.Length then raise Constraint_Error; end if; return League.Strings.Internals.Create (Self.Data.Values (Index).Local_Name); end Local_Name; ------------------- -- Namespace_URI -- ------------------- function Namespace_URI (Self : SAX_Attributes'Class; Index : Positive) return League.Strings.Universal_String is begin if Index > Self.Data.Length then raise Constraint_Error; end if; return League.Strings.Internals.Create (Self.Data.Values (Index).Namespace_URI); end Namespace_URI; -------------------- -- Qualified_Name -- -------------------- function Qualified_Name (Self : SAX_Attributes'Class; Index : Positive) return League.Strings.Universal_String is begin if Index > Self.Data.Length then raise Constraint_Error; end if; return League.Strings.Internals.Create (Self.Data.Values (Index).Qualified_Name); end Qualified_Name; --------------- -- Reference -- --------------- procedure Reference (Self : Shared_Attributes_Access) is begin if Self /= Shared_Empty'Access then Matreshka.Atomics.Counters.Increment (Self.Counter); end if; end Reference; --------------- -- Set_Value -- --------------- procedure Set_Value (Self : in out SAX_Attributes'Class; Qualified_Name : League.Strings.Universal_String; Value : League.Strings.Universal_String) is use type Matreshka.Internals.Strings.Shared_String_Access; Shared_Value : constant Matreshka.Internals.Strings.Shared_String_Access := League.Strings.Internals.Internal (Value); Index : constant Natural := Self.Index (Qualified_Name); CDATA_Name : constant Universal_String := To_Universal_String ("CDATA"); begin if Index = 0 then Detach (Self.Data, Self.Data.Length + 1); Self.Data.Length := Self.Data.Length + 1; Self.Data.Values (Self.Data.Length) := (Namespace_URI => Matreshka.Internals.Strings.Shared_Empty'Access, Local_Name => Matreshka.Internals.Strings.Shared_Empty'Access, Qualified_Name => League.Strings.Internals.Internal (Qualified_Name), Value => League.Strings.Internals.Internal (Value), Value_Type => League.Strings.Internals.Internal (CDATA_Name), Is_Declared => False, Is_Specified => True); Matreshka.Internals.Strings.Reference (Self.Data.Values (Self.Data.Length).Qualified_Name); Matreshka.Internals.Strings.Reference (Self.Data.Values (Self.Data.Length).Value); Matreshka.Internals.Strings.Reference (Self.Data.Values (Self.Data.Length).Value_Type); else Detach (Self.Data, Self.Data.Length); if Shared_Value /= Self.Data.Values (Index).Value then Matreshka.Internals.Strings.Dereference (Self.Data.Values (Index).Value); Matreshka.Internals.Strings.Reference (Shared_Value); Self.Data.Values (Index).Value := Shared_Value; end if; end if; end Set_Value; --------------- -- Set_Value -- --------------- procedure Set_Value (Self : in out SAX_Attributes'Class; Namespace_URI : League.Strings.Universal_String; Local_Name : League.Strings.Universal_String; Value : League.Strings.Universal_String) is use type Matreshka.Internals.Strings.Shared_String_Access; Shared_Value : constant Matreshka.Internals.Strings.Shared_String_Access := League.Strings.Internals.Internal (Value); Index : constant Natural := Self.Index (Namespace_URI, Local_Name); CDATA_Name : constant Universal_String := To_Universal_String ("CDATA"); begin if Index = 0 then Detach (Self.Data, Self.Data.Length + 1); Self.Data.Length := Self.Data.Length + 1; Self.Data.Values (Self.Data.Length) := (Namespace_URI => League.Strings.Internals.Internal (Namespace_URI), Local_Name => League.Strings.Internals.Internal (Local_Name), Qualified_Name => Matreshka.Internals.Strings.Shared_Empty'Access, Value => League.Strings.Internals.Internal (Value), Value_Type => League.Strings.Internals.Internal (CDATA_Name), Is_Declared => False, Is_Specified => True); Matreshka.Internals.Strings.Reference (Self.Data.Values (Self.Data.Length).Namespace_URI); Matreshka.Internals.Strings.Reference (Self.Data.Values (Self.Data.Length).Local_Name); Matreshka.Internals.Strings.Reference (Self.Data.Values (Self.Data.Length).Value); Matreshka.Internals.Strings.Reference (Self.Data.Values (Self.Data.Length).Value_Type); else Detach (Self.Data, Self.Data.Length); if Shared_Value /= Self.Data.Values (Index).Value then Matreshka.Internals.Strings.Dereference (Self.Data.Values (Index).Value); Matreshka.Internals.Strings.Reference (Shared_Value); Self.Data.Values (Index).Value := Shared_Value; end if; end if; end Set_Value; ----------- -- Value -- ----------- function Value (Self : SAX_Attributes'Class; Index : Positive) return League.Strings.Universal_String is begin if Index > Self.Data.Length then raise Constraint_Error; end if; return League.Strings.Internals.Create (Self.Data.Values (Index).Value); end Value; ----------- -- Value -- ----------- function Value (Self : SAX_Attributes'Class; Qualified_Name : League.Strings.Universal_String) return League.Strings.Universal_String is begin for J in 1 .. Self.Data.Length loop if String_Handler.Is_Equal (Self.Data.Values (J).Qualified_Name, League.Strings.Internals.Internal (Qualified_Name)) then return League.Strings.Internals.Create (Self.Data.Values (J).Value); end if; end loop; return Empty_Universal_String; end Value; ----------- -- Value -- ----------- function Value (Self : SAX_Attributes'Class; Namespace_URI : League.Strings.Universal_String; Local_Name : League.Strings.Universal_String) return League.Strings.Universal_String is begin for J in 1 .. Self.Data.Length loop if String_Handler.Is_Equal (Self.Data.Values (J).Namespace_URI, League.Strings.Internals.Internal (Namespace_URI)) and String_Handler.Is_Equal (Self.Data.Values (J).Local_Name, League.Strings.Internals.Internal (Local_Name)) then return League.Strings.Internals.Create (Self.Data.Values (J).Value); end if; end loop; return Empty_Universal_String; end Value; ---------------- -- Value_Type -- ---------------- function Value_Type (Self : SAX_Attributes'Class; Index : Positive) return League.Strings.Universal_String is begin if Index > Self.Data.Length then raise Constraint_Error; end if; return League.Strings.Internals.Create (Self.Data.Values (Index).Value_Type); end Value_Type; ---------------- -- Value_Type -- ---------------- function Value_Type (Self : SAX_Attributes'Class; Qualified_Name : League.Strings.Universal_String) return League.Strings.Universal_String is begin for J in 1 .. Self.Data.Length loop if String_Handler.Is_Equal (Self.Data.Values (J).Qualified_Name, League.Strings.Internals.Internal (Qualified_Name)) then return League.Strings.Internals.Create (Self.Data.Values (J).Value_Type); end if; end loop; return Empty_Universal_String; end Value_Type; ---------------- -- Value_Type -- ---------------- function Value_Type (Self : SAX_Attributes'Class; Namespace_URI : League.Strings.Universal_String; Local_Name : League.Strings.Universal_String) return League.Strings.Universal_String is begin for J in 1 .. Self.Data.Length loop if String_Handler.Is_Equal (Self.Data.Values (J).Namespace_URI, League.Strings.Internals.Internal (Namespace_URI)) and String_Handler.Is_Equal (Self.Data.Values (J).Local_Name, League.Strings.Internals.Internal (Local_Name)) then return League.Strings.Internals.Create (Self.Data.Values (J).Value_Type); end if; end loop; return Empty_Universal_String; end Value_Type; end XML.SAX.Attributes;