File : src/aws-containers-tables-set.adb


------------------------------------------------------------------------------
--                              Ada Web Server                              --
--                                                                          --
--                         Copyright (C) 2000-2001                          --
--                                ACT-Europe                                --
--                                                                          --
--  Authors: Dmitriy Anisimkov - Pascal Obry                                --
--                                                                          --
--  This library is free software; you can redistribute it and/or modify    --
--  it under the terms of the GNU General Public License as published by    --
--  the Free Software Foundation; either version 2 of the License, or (at   --
--  your option) any later version.                                         --
--                                                                          --
--  This library is distributed in the hope that it will be useful, but     --
--  WITHOUT ANY WARRANTY; without even the implied warranty of              --
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
--  General Public License for more details.                                --
--                                                                          --
--  You should have received a copy of the GNU General Public License       --
--  along with this library; if not, write to the Free Software Foundation, --
--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --
--                                                                          --
--  As a special exception, if other files instantiate generics from this   --
--  unit, or you link this unit with other files to produce an executable,  --
--  this  unit  does not  by itself cause  the resulting executable to be   --
--  covered by the GNU General Public License. This exception does not      --
--  however invalidate any other reasons why the executable file  might be  --
--  covered by the  GNU Public License.                                     --
------------------------------------------------------------------------------

--  $RCSfile: aws-containers-tables-set.adb,v $
--  $Revision: 1.11 $ $Date: 2003/08/29 16:49:04 $ $Author: anisimko $

with Ada.Unchecked_Deallocation;

package body AWS.Containers.Tables.Set is

   procedure Reset (Table : in out Index_Table_Type);
   --  Free all elements and destroy his entries.

   procedure Free is new Ada.Unchecked_Deallocation
     (Element, Element_Access);

   procedure Free_Elements (Data : in out Data_Table.Instance);
   --  Free all dynamically allocated strings in the data table.

   ---------
   -- Add --
   ---------

   procedure Add
     (Table       : in out Table_Type;
      Name, Value : in     String)
   is
      L_Key : constant String
        :=  Normalize_Name (Name, not Table.Case_Sensitive);

      Found : Boolean;

      procedure Add_Value
        (Key   : in     String;
         Value : in out Name_Index_Table);
      --  Append value to the current key's values

      ---------------
      -- Add_Value --
      ---------------

      procedure Add_Value
        (Key   : in     String;
         Value : in out Name_Index_Table)
      is
         pragma Unreferenced (Key);
      begin
         Name_Indexes.Append (Value, Data_Table.Last (Table.Data));
      end Add_Value;

      procedure Update is new Index_Table.Update_Value_Or_Status_G (Add_Value);

   begin
      --  Add name/value pair into the Data table

      Data_Table.Append
        (Table.Data,
         new Element'
           (Name_Length  => Name'Length,
            Value_Length => Value'Length,
            Name         => Name,
            Value        => Value));

      --  ???

      Update
        (Table => Index_Table.Table_Type (Table.Index.all),
         Key   => L_Key,
         Found => Found);

      --  ???

      if not Found then
         declare
            Value : Name_Index_Table;
         begin
            Name_Indexes.Init (Value);
            Name_Indexes.Append (Value, Data_Table.Last (Table.Data));
            Insert (Table.Index.all, L_Key, Value);
         end;
      end if;
   end Add;

   --------------------
   -- Case_Sensitive --
   --------------------

   procedure Case_Sensitive
     (Table : in out Table_Type;
      Mode  : in     Boolean) is
   begin
      Table.Case_Sensitive := Mode;
   end Case_Sensitive;

   ----------
   -- Free --
   ----------

   procedure Free (Table : in out Table_Type) is

      procedure Free is
         new Ada.Unchecked_Deallocation (Index_Table_Type, Index_Access);

   begin
      if Table.Index /= null then
         Reset (Table.Index.all);
         Free (Table.Index);

         Free_Elements (Table.Data);
         Data_Table.Free (Table.Data);
      end if;
   end Free;

   -------------------
   -- Free_Elements --
   -------------------

   procedure Free_Elements (Data : in out Data_Table.Instance) is
   begin
      for I in Data_Table.First .. Data_Table.Last (Data) loop
         Free (Data.Table (I));
      end loop;
   end Free_Elements;

   -----------
   -- Reset --
   -----------

   procedure Reset (Table : in out Index_Table_Type) is

      procedure Release_Value
        (Key          : in     String;
         Value        : in out Name_Index_Table;
         Order_Number : in     Positive;
         Continue     : in out Boolean);
      --  Release memory associted with the value

      -------------------
      -- Release_Value --
      -------------------

      procedure Release_Value
        (Key          : in     String;
         Value        : in out Name_Index_Table;
         Order_Number : in     Positive;
         Continue     : in out Boolean)
      is
         pragma Unreferenced (Key);
         pragma Unreferenced (Order_Number);
         pragma Unreferenced (Continue);
      begin
         Name_Indexes.Free (Value);
      end Release_Value;

      procedure Release_Values is new
        Index_Table.Disorder_Traverse_And_Update_Value_G (Release_Value);

   begin
      Release_Values (Index_Table.Table_Type (Table));
      Destroy (Table);
   end Reset;

   procedure Reset (Table : in out Table_Type) is
   begin
      if Table.Index = null then
         Table.Index := new Index_Table_Type;

      else
         Reset (Table.Index.all);
         Free_Elements (Table.Data);
      end if;

      Data_Table.Init (Table.Data);
   end Reset;

   ------------
   -- Update --
   ------------

   procedure Update
     (Table : in out Table_Type;
      Name  : in     String;
      Value : in     String;
      N     : in     Positive := 1)
   is

      L_Key : constant String
        :=  Normalize_Name (Name, not Table.Case_Sensitive);

      Found : Boolean;

      procedure Update_Value
        (Key    : in     String;
         Values : in out Name_Index_Table);
      --  Append value to the current key's values

      ------------------
      -- Update_Value --
      ------------------

      procedure Update_Value
        (Key    : in     String;
         Values : in out Name_Index_Table)
      is
         pragma Unreferenced (Key);
      begin
         if Key_Positive (N) <= Name_Indexes.Last (Values) then

            declare
               Index : Positive := Values.Table (Key_Positive (N));
            begin
               Free (Table.Data.Table (Index));
               Table.Data.Table (Index) :=
                  new Element'
                       (Name_Length  => Name'Length,
                        Value_Length => Value'Length,
                        Name         => Name,
                        Value        => Value);
            end;

         elsif Key_Positive (N) = Name_Indexes.Last (Values) + 1 then
            Data_Table.Append
              (Table.Data,
               new Element'
                 (Name_Length  => Name'Length,
                  Value_Length => Value'Length,
                  Name         => Name,
                  Value        => Value));

            Name_Indexes.Append (Values, Data_Table.Last (Table.Data));
         else
            raise Constraint_Error;
         end if;
      end Update_Value;

      procedure Update is
         new Index_Table.Update_Value_Or_Status_G (Update_Value);

   begin
      Update
        (Table => Index_Table.Table_Type (Table.Index.all),
         Key   => L_Key,
         Found => Found);

      if not Found then

         if N /= 1 then
            raise Constraint_Error;
         end if;

         declare
            Values : Name_Index_Table;
         begin
            Name_Indexes.Init (Values);

            Data_Table.Append
              (Table.Data,
               new Element'
                 (Name_Length  => Name'Length,
                  Value_Length => Value'Length,
                  Name         => Name,
                  Value        => Value));

            Name_Indexes.Append (Values, Data_Table.Last (Table.Data));
            Insert (Table.Index.all, L_Key, Values);
         end;
      end if;
   end Update;

end AWS.Containers.Tables.Set;