Created
July 9, 2012 08:04
-
-
Save ThomasLocke/3074948 to your computer and use it in GitHub Desktop.
Alice v0.38 -> v0.39 changes.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| diff --git a/alice.gpr b/alice.gpr | |
| index 632389e..1e7613d 100644 | |
| --- a/alice.gpr | |
| +++ b/alice.gpr | |
| @@ -28,7 +28,7 @@ project Alice is | |
| type Build_Type is ("Debug", "Production"); | |
| Build : Build_Type := External ("BUILDTYPE", "Production"); | |
| - Source_Options := ("src"); | |
| + Source_Options := ("src", "src/handlers"); | |
| for Source_Dirs use Source_Options; | |
| for Main use ("alice.adb"); | |
| @@ -54,7 +54,7 @@ project Alice is | |
| "-gnaty3abcdefhiklmnoprstux", | |
| "-Wall", | |
| "-O2", | |
| - "-gnat05"); | |
| + "-gnat2012"); | |
| when "Debug" => | |
| for Default_Switches ("Ada") | |
| use ("-gnatwa", | |
| @@ -63,7 +63,7 @@ project Alice is | |
| "-gnaty3abcdefhiklmnoprstux", | |
| "-Wall", | |
| "-O1", | |
| - "-gnat05", | |
| + "-gnat2012", | |
| "-g"); | |
| end case; | |
| diff --git a/exe/configuration/alice_config.ini.dist b/exe/configuration/alice_config.ini.dist | |
| index 1ae830d..2fdf1ae 100644 | |
| --- a/exe/configuration/alice_config.ini.dist | |
| +++ b/exe/configuration/alice_config.ini.dist | |
| @@ -59,32 +59,6 @@ Cache_Size_Organization 1_000 | |
| # will be wasting a lot of CPU on the automatic cleanup functionality. On the | |
| # other hand setting it too high will waste a lot of memory. | |
| -JSON_Size_Large 100_000 | |
| -# Positive. | |
| -# Default: 100_000 | |
| -# | |
| -# The maximum size of large JSON strings. This is basically a safety feature | |
| -# to guard against massive JSON strings. If a JSON string exceeds this value, | |
| -# then an exception is raised. | |
| -# | |
| -# NOTE: | |
| -# JSON_Size_Large is used by Alice to set the size of a Bounded_String package | |
| -# that is used for collections of contact entities, contact attributes and | |
| -# other similar kinds of data. | |
| - | |
| -JSON_Size_Small 10_000 | |
| -# Positive. | |
| -# Default: 10_000 | |
| -# | |
| -# The maximum size of small JSON strings. This is basically a safety feature | |
| -# to guard against massive JSON strings. If a JSON string exceeds this value, | |
| -# then an exception is raised. | |
| -# | |
| -# NOTE: | |
| -# JSON_Size_Small is used by Alice to set the size of a Bounded_String package | |
| -# that is used for individual contact entities, contact attributes and other | |
| -# typically single kinds of data. | |
| - | |
| ################################## | |
| # Database # | |
| ################################## | |
| @@ -180,23 +154,24 @@ Handler_Get_Contact_Full /get/contact_full | |
| # | |
| # The regular expression to match the /get/contact_full resource. | |
| -Handler_Get_Org_Contacts /get/org_contacts | |
| +Handler_Get_Organization_Contacts /get/organization_contacts | |
| # String. | |
| -# Default: /get/org_contacts | |
| +# Default: /get/organization_contacts | |
| # | |
| -# The regular expression to match the /get/org_contacts resource. | |
| +# The regular expression to match the /get/organization_contacts resource. | |
| -Handler_Get_Org_Contacts_Attributes /get/org_contacts_attributes | |
| +Handler_Get_Organization_Contacts_Attributes /get/organization_contacts_attributes | |
| # String. | |
| -# Default: /get/org_contacts_attributes | |
| +# Default: /get/organization_contacts_attributes | |
| # | |
| -# The regular expression to match the /get/org_contact_attributes resource. | |
| +# The regular expression to match the /get/organization_contact_attributes | |
| +# resource. | |
| -Handler_Get_Org_Contacts_Full /get/org_contacts_full | |
| +Handler_Get_Organization_Contacts_Full /get/organization_contacts_full | |
| # String. | |
| -# Default: /get/org_contacts_full | |
| +# Default: /get/organization_contacts_full | |
| # | |
| -# The regular expression to match the /get/org_contacts_full resource. | |
| +# The regular expression to match the /get/organization_contacts_full resource. | |
| Handler_Get_Organization /get/organization | |
| # String. | |
| diff --git a/src/alice.adb b/src/alice.adb | |
| index 71105e9..fe67e24 100644 | |
| --- a/src/alice.adb | |
| +++ b/src/alice.adb | |
| @@ -44,7 +44,7 @@ procedure Alice is | |
| use Yolk.Process_Owner; | |
| use Yolk.Utilities; | |
| - Alice_Version : constant String := "0.38"; | |
| + Alice_Version : constant String := "0.39"; | |
| Resource_Handlers : AWS.Services.Dispatchers.URI.Handler; | |
| Web_Server : AWS.Server.HTTP; | |
| diff --git a/src/cache.ads b/src/cache.ads | |
| deleted file mode 100644 | |
| index 420fee4..0000000 | |
| --- a/src/cache.ads | |
| +++ /dev/null | |
| @@ -1,93 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- Cache -- | |
| --- -- | |
| --- SPEC -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -with Common; | |
| -with My_Configuration; | |
| -with Yolk.Cache.String_Keys; | |
| - | |
| -package Cache is | |
| - | |
| - package My renames My_Configuration; | |
| - | |
| - package Contact_Cache is new Yolk.Cache.String_Keys | |
| - (Element_Type => Common.JSON_Small.Bounded_String, | |
| - Cleanup_Size => My.Config.Get (My.Cache_Size_Contact) + 1, | |
| - Cleanup_On_Write => True, | |
| - Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| - Reserved_Capacity => My.Config.Get (My.Cache_Size_Contact)); | |
| - -- Cache for individual contact JSON objects. | |
| - | |
| - package Contact_Full_Cache is new Yolk.Cache.String_Keys | |
| - (Element_Type => Common.JSON_Small.Bounded_String, | |
| - Cleanup_Size => My.Config.Get (My.Cache_Size_Contact) + 1, | |
| - Cleanup_On_Write => True, | |
| - Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| - Reserved_Capacity => My.Config.Get (My.Cache_Size_Contact)); | |
| - -- Cache for individual contact JSON objects. The contact JSON document | |
| - -- SHOULD be complete with attributes. | |
| - | |
| - package Contact_Attributes_Cache is new Yolk.Cache.String_Keys | |
| - (Element_Type => Common.JSON_Small.Bounded_String, | |
| - Cleanup_Size => My.Config.Get (My.Cache_Size_Contact) + 1, | |
| - Cleanup_On_Write => True, | |
| - Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| - Reserved_Capacity => My.Config.Get (My.Cache_Size_Contact)); | |
| - -- Cache for individual contact attributes JSON objects. | |
| - | |
| - package Org_Contacts_Cache is new Yolk.Cache.String_Keys | |
| - (Element_Type => Common.JSON_Large.Bounded_String, | |
| - Cleanup_Size => My.Config.Get (My.Cache_Size_Organization) + 1, | |
| - Cleanup_On_Write => True, | |
| - Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| - Reserved_Capacity => My.Config.Get (My.Cache_Size_Organization)); | |
| - -- Cache for groups of contact JSON objects. The groups SHOULD be based on | |
| - -- the organization the contacts belong to. | |
| - | |
| - package Org_Contacts_Full_Cache is new Yolk.Cache.String_Keys | |
| - (Element_Type => Common.JSON_Large.Bounded_String, | |
| - Cleanup_Size => My.Config.Get (My.Cache_Size_Organization) + 1, | |
| - Cleanup_On_Write => True, | |
| - Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| - Reserved_Capacity => My.Config.Get (My.Cache_Size_Organization)); | |
| - -- Cache for groups of contact JSON objects. The groups SHOULD be based on | |
| - -- the organization the contacts belong to and the contact JSON document | |
| - -- SHOULD be complete with attributes. | |
| - | |
| - package Org_Contacts_Attributes_Cache is new Yolk.Cache.String_Keys | |
| - (Element_Type => Common.JSON_Large.Bounded_String, | |
| - Cleanup_Size => My.Config.Get (My.Cache_Size_Organization) + 1, | |
| - Cleanup_On_Write => True, | |
| - Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| - Reserved_Capacity => My.Config.Get (My.Cache_Size_Organization)); | |
| - -- Cache for groups of contact attributes JSON objects. The groups SHOULD | |
| - -- be based on the organization the contacts belong to. | |
| - | |
| - package Organization_Cache is new Yolk.Cache.String_Keys | |
| - (Element_Type => Common.JSON_Small.Bounded_String, | |
| - Cleanup_Size => My.Config.Get (My.Cache_Size_Organization) + 1, | |
| - Cleanup_On_Write => True, | |
| - Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| - Reserved_Capacity => My.Config.Get (My.Cache_Size_Organization)); | |
| - -- Cache for individual organization JSON objects. | |
| - | |
| -end Cache; | |
| diff --git a/src/call_queue.adb b/src/call_queue.adb | |
| deleted file mode 100644 | |
| index 2be405d..0000000 | |
| --- a/src/call_queue.adb | |
| +++ /dev/null | |
| @@ -1,549 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- Call_Queue -- | |
| --- -- | |
| --- BODY -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -with Ada.Calendar.Conversions; | |
| -with Ada.Calendar.Formatting; | |
| -with Ada.Containers.Ordered_Maps; | |
| -with Ada.Numerics.Discrete_Random; | |
| -with Ada.Strings.Fixed; | |
| -with Ada.Strings.Unbounded; | |
| -with AWS.Utils; | |
| -with Interfaces.C; | |
| -with GNATCOLL.JSON; | |
| -with Task_Controller; | |
| -with Yolk.Utilities; | |
| - | |
| -package body Call_Queue is | |
| - | |
| - package Util renames Yolk.Utilities; | |
| - | |
| - type Priority_Level is (Low, Normal, High); | |
| - | |
| - package Random_Priority is new | |
| - Ada.Numerics.Discrete_Random (Priority_Level); | |
| - -- HERE FOR TESTING PURPOSES. | |
| - -- This is used by the PBX_Queue_Monitor task to generate random calls. | |
| - | |
| - subtype Org_Id is Natural range 1 .. 5; | |
| - package Random_Organization is new Ada.Numerics.Discrete_Random (Org_Id); | |
| - -- HERE FOR TESTING PURPOSES. | |
| - -- This is just to be able to randomnly grab an organization so it can be | |
| - -- added as the callee in a Call record. | |
| - | |
| - subtype Call_Id is String (1 .. 10); | |
| - -- Unique identifier for each call in the queue. This type will | |
| - -- obviously depend heavily on the kind of ID used internally by the PBX. | |
| - | |
| - type Call is | |
| - record | |
| - Id : Call_Id; | |
| - Callee : Org_Id; | |
| - Caller : String (1 .. 8); | |
| - Priority : Priority_Level; | |
| - Timestamp_UTC : Ada.Calendar.Time; | |
| - -- Note that the time is recorded in UTC. No timezone is given. | |
| - end record; | |
| - | |
| - function Equal_Elements | |
| - (Left, Right : in Call) | |
| - return Boolean; | |
| - -- Return True if two Call elements are equal. | |
| - | |
| - function Sort_Elements | |
| - (Left, Right : in Ada.Calendar.Time) | |
| - return Boolean; | |
| - -- Return True if Left is < the Right. This sorts the calls in the ordered | |
| - -- queue maps according to the Call.Timestamp_UTC component. | |
| - | |
| - package Ordered_Call_Queue_Map is new Ada.Containers.Ordered_Maps | |
| - (Key_Type => Ada.Calendar.Time, | |
| - Element_Type => Call, | |
| - "<" => Sort_Elements, | |
| - "=" => Equal_Elements); | |
| - -- All call queues are kept in a Ordered_Call_Queue_Map, with sorting being | |
| - -- done according to the Call.Timestamp_UTC component. | |
| - | |
| - type Queue_Maps_Array is array (Priority_Level) of | |
| - Ordered_Call_Queue_Map.Map; | |
| - | |
| - type Queue_JSON_Array is array (Priority_Level) of GNATCOLL.JSON.JSON_Array; | |
| - | |
| - protected Queue is | |
| - procedure Add | |
| - (Id : in Call_Id; | |
| - Callee : in Org_Id; | |
| - Caller : in String; | |
| - Priority : in Priority_Level; | |
| - Start : in Ada.Calendar.Time); | |
| - -- Add a call to the queue designated by Priority. | |
| - | |
| - procedure Build_JSON; | |
| - -- Build the queue JSON based on the Call records in the queues. | |
| - | |
| - procedure Clear; | |
| - -- Delete all calls from the queues. | |
| - | |
| - function Get | |
| - return String; | |
| - -- Return the queue JSON string. | |
| - | |
| - function Length | |
| - return Natural; | |
| - -- Return the amount of Call records currently in the queues. | |
| - | |
| - procedure Remove | |
| - (Id : in Call_Id); | |
| - -- Remove a call from the queue. | |
| - | |
| - procedure Remove | |
| - (Id : in Call_Id; | |
| - Org_Id : out Natural; | |
| - Success : out Boolean); | |
| - -- Remove a call from the queue. | |
| - | |
| - procedure Remove_First | |
| - (Removed_Call_Id : out Call_Id; | |
| - Removed_Org_Id : out Natural); | |
| - -- Remove the first call in the queue. Removed_Call_Id contains the Id | |
| - -- of the removed call and Removed_Org_Id is the Id of the callee. | |
| - -- If there are no calls to remove, an empty string and a 0 is returned. | |
| - private | |
| - Rebuild_JSON : Boolean := True; | |
| - -- This is set to False whenever a Call is added or removed from the | |
| - -- queues. | |
| - | |
| - JSON : GNATCOLL.JSON.JSON_Value := GNATCOLL.JSON.JSON_Null; | |
| - -- This holds the current JSON_Value object from which the | |
| - -- JSON_String is constructed. | |
| - | |
| - JSON_String : Ada.Strings.Unbounded.Unbounded_String := | |
| - Util.TUS ("{}"); | |
| - -- The JSON returned in call to Get. | |
| - | |
| - JSON_Arrays : Queue_JSON_Array := | |
| - (others => GNATCOLL.JSON.Empty_Array); | |
| - -- The JSON arrays containing the calls in the queue according to | |
| - -- their priority. | |
| - | |
| - Queue_Maps : Queue_Maps_Array; | |
| - -- The queue maps. | |
| - end Queue; | |
| - | |
| - task PBX_Queue_Monitor; | |
| - -- This is supposed to monitor one or more PBX's. Currently it just | |
| - -- generates dummy calls. | |
| - | |
| - task body PBX_Queue_Monitor | |
| - is | |
| - use Ada.Calendar; | |
| - use Task_Controller; | |
| - | |
| - type Foo is mod 30; | |
| - | |
| - Id_Array : array (Foo) of Call_Id := (others => " "); | |
| - -- Simulate up to a total of 30 calls in the queues. | |
| - | |
| - C : Foo := 0; | |
| - -- Basic counter variable. | |
| - | |
| - G : Random_Priority.Generator; | |
| - Org_G : Random_Organization.Generator; | |
| - OID : Org_Id; | |
| - P : Priority_Level; | |
| - -- Random priority levels on the generated calls. | |
| - begin | |
| - Random_Priority.Reset (G); | |
| - Random_Organization.Reset (Org_G, 42); | |
| - | |
| - loop | |
| - exit when Task_State = Down; | |
| - | |
| - P := Random_Priority.Random (G); | |
| - OID := Random_Organization.Random (Org_G); | |
| - | |
| - Id_Array (C) := AWS.Utils.Random_String (10); | |
| - | |
| - Queue.Add (Id => Id_Array (C), | |
| - Callee => OID, | |
| - Caller => AWS.Utils.Random_String (8), | |
| - Priority => P, | |
| - Start => Clock); | |
| - | |
| - if Id_Array (C + 1) /= " " then | |
| - Queue.Remove (Id_Array (C + 1)); | |
| - end if; | |
| - | |
| - C := C + 1; | |
| - | |
| - delay 15.0; | |
| - end loop; | |
| - | |
| - Queue.Clear; | |
| - end PBX_Queue_Monitor; | |
| - | |
| - task Generate_JSON; | |
| - -- Rebuild the queue JSON. Once every ½ second we check if a call has | |
| - -- been either added or removed from the queue, and if that is the case, | |
| - -- then we re-build the queue JSON. | |
| - | |
| - task body Generate_JSON | |
| - is | |
| - use Task_Controller; | |
| - begin | |
| - loop | |
| - exit when Task_State = Down; | |
| - | |
| - Queue.Build_JSON; | |
| - | |
| - delay 0.5; | |
| - end loop; | |
| - end Generate_JSON; | |
| - | |
| - ---------------------- | |
| - -- Equal_Elements -- | |
| - ---------------------- | |
| - | |
| - function Equal_Elements | |
| - (Left, Right : in Call) | |
| - return Boolean | |
| - is | |
| - begin | |
| - return Left = Right; | |
| - end Equal_Elements; | |
| - | |
| - ----------- | |
| - -- Get -- | |
| - ----------- | |
| - | |
| - function Get | |
| - return String | |
| - is | |
| - begin | |
| - return Queue.Get; | |
| - end Get; | |
| - | |
| - ---------------- | |
| - -- Get_Call -- | |
| - ---------------- | |
| - | |
| - function Get_Call | |
| - (Id : in String) | |
| - return String | |
| - is | |
| - use GNATCOLL.JSON; | |
| - | |
| - JSON : constant JSON_Value := Create_Object; | |
| - Org_Id : Natural := 0; | |
| - Success : Boolean; | |
| - begin | |
| - if Id'Length > 0 then | |
| - Queue.Remove (Id, Org_Id, Success); | |
| - | |
| - if Success then | |
| - JSON.Set_Field ("id", Id); | |
| - JSON.Set_Field ("org_id", Org_Id); | |
| - end if; | |
| - else | |
| - declare | |
| - CI : Call_Id; | |
| - Org_Id : Natural; | |
| - begin | |
| - Queue.Remove_First (Removed_Call_Id => CI, | |
| - Removed_Org_Id => Org_Id); | |
| - | |
| - if Org_Id > 0 then | |
| - JSON.Set_Field ("id", CI); | |
| - JSON.Set_Field ("org_id", Org_Id); | |
| - end if; | |
| - end; | |
| - end if; | |
| - | |
| - return JSON.Write; | |
| - end Get_Call; | |
| - | |
| - -------------- | |
| - -- Length -- | |
| - -------------- | |
| - | |
| - function Length | |
| - return String | |
| - is | |
| - use GNATCOLL.JSON; | |
| - | |
| - JSON : constant JSON_Value := Create_Object; | |
| - begin | |
| - JSON.Set_Field ("length", Queue.Length); | |
| - | |
| - return JSON.Write; | |
| - end Length; | |
| - | |
| - ------------- | |
| - -- Queue -- | |
| - ------------- | |
| - | |
| - protected body Queue is | |
| - | |
| - ----------- | |
| - -- Add -- | |
| - ----------- | |
| - | |
| - procedure Add | |
| - (Id : in Call_Id; | |
| - Callee : in Org_Id; | |
| - Caller : in String; | |
| - Priority : in Priority_Level; | |
| - Start : in Ada.Calendar.Time) | |
| - is | |
| - begin | |
| - Queue_Maps (Priority).Insert (Key => Start, | |
| - New_Item => (Id => Id, | |
| - Callee => Callee, | |
| - Caller => Caller, | |
| - Priority => Priority, | |
| - Timestamp_UTC => Start)); | |
| - | |
| - Rebuild_JSON := True; | |
| - end Add; | |
| - | |
| - ------------------ | |
| - -- Build_JSON -- | |
| - ------------------ | |
| - | |
| - procedure Build_JSON | |
| - is | |
| - use Ada.Calendar; | |
| - use Ada.Calendar.Conversions; | |
| - use Ada.Calendar.Formatting; | |
| - use Ada.Strings.Fixed; | |
| - use GNATCOLL.JSON; | |
| - use Yolk.Utilities; | |
| - | |
| - procedure Go | |
| - (Position : in Ordered_Call_Queue_Map.Cursor); | |
| - -- JSON'ify each Call in the queue. | |
| - | |
| - function Unix_Timestamp | |
| - (Date : in Time) | |
| - return String; | |
| - -- Convert and trim an Ada.Calendar.Time type to a Unix timestamp | |
| - -- String. | |
| - | |
| - --------- | |
| - -- Go -- | |
| - --------- | |
| - | |
| - procedure Go | |
| - (Position : in Ordered_Call_Queue_Map.Cursor) | |
| - is | |
| - | |
| - A_Call : Call; | |
| - Value : constant JSON_Value := Create_Object; | |
| - begin | |
| - A_Call := Ordered_Call_Queue_Map.Element (Position); | |
| - | |
| - Value.Set_Field ("id", A_Call.Id); | |
| - Value.Set_Field ("callee", A_Call.Callee); | |
| - Value.Set_Field ("caller", A_Call.Caller); | |
| - Value.Set_Field ("UTC_start_date", Image (A_Call.Timestamp_UTC)); | |
| - Value.Set_Field | |
| - ("unix_timestamp", Unix_Timestamp (A_Call.Timestamp_UTC)); | |
| - | |
| - Append (JSON_Arrays (A_Call.Priority), Value); | |
| - end Go; | |
| - | |
| - ---------------------- | |
| - -- Unix_Timestamp -- | |
| - ---------------------- | |
| - | |
| - function Unix_Timestamp | |
| - (Date : in Time) | |
| - return String | |
| - is | |
| - use Ada.Strings; | |
| - use Interfaces.C; | |
| - begin | |
| - return Fixed.Trim | |
| - (Source => long'Image (To_Unix_Time (Date)), | |
| - Side => Left); | |
| - end Unix_Timestamp; | |
| - begin | |
| - if Rebuild_JSON then | |
| - JSON := Create_Object; | |
| - | |
| - JSON.Set_Field ("length", Queue.Length); | |
| - | |
| - JSON_Arrays := (others => Empty_Array); | |
| - | |
| - for P in Queue_Maps'Range loop | |
| - Queue_Maps (P).Iterate (Go'Access); | |
| - end loop; | |
| - | |
| - JSON.Set_Field ("low", JSON_Arrays (Low)); | |
| - JSON.Set_Field ("normal", JSON_Arrays (Normal)); | |
| - JSON.Set_Field ("high", JSON_Arrays (High)); | |
| - | |
| - JSON_String := TUS (JSON.Write); | |
| - end if; | |
| - end Build_JSON; | |
| - | |
| - ------------- | |
| - -- Clear -- | |
| - ------------- | |
| - | |
| - procedure Clear | |
| - is | |
| - use Yolk.Utilities; | |
| - begin | |
| - for P in Queue_Maps'Range loop | |
| - Queue_Maps (P).Clear; | |
| - end loop; | |
| - | |
| - JSON_String := TUS ("{}"); | |
| - Rebuild_JSON := True; | |
| - end Clear; | |
| - | |
| - ----------- | |
| - -- Get -- | |
| - ----------- | |
| - | |
| - function Get | |
| - return String | |
| - is | |
| - use Yolk.Utilities; | |
| - begin | |
| - return TS (JSON_String); | |
| - end Get; | |
| - | |
| - -------------- | |
| - -- Length -- | |
| - -------------- | |
| - | |
| - function Length | |
| - return Natural | |
| - is | |
| - C : Natural := 0; | |
| - begin | |
| - for P in Queue_Maps'Range loop | |
| - C := C + Natural (Queue_Maps (P).Length); | |
| - end loop; | |
| - | |
| - return C; | |
| - end Length; | |
| - | |
| - -------------- | |
| - -- Remove -- | |
| - -------------- | |
| - | |
| - procedure Remove | |
| - (Id : in Call_Id) | |
| - is | |
| - Success : Boolean; | |
| - Org_Id : Natural; | |
| - | |
| - pragma Unreferenced (Success); | |
| - pragma Unreferenced (Org_Id); | |
| - begin | |
| - Remove (Id, Org_Id, Success); | |
| - end Remove; | |
| - | |
| - -------------- | |
| - -- Remove -- | |
| - -------------- | |
| - | |
| - procedure Remove | |
| - (Id : in Call_Id; | |
| - Org_Id : out Natural; | |
| - Success : out Boolean) | |
| - is | |
| - C : Ordered_Call_Queue_Map.Cursor; | |
| - Elem : Call; | |
| - begin | |
| - Org_Id := 0; | |
| - Success := False; | |
| - | |
| - Queue_Maps_Loop : | |
| - for P in Queue_Maps'Range loop | |
| - C := Queue_Maps (P).First; | |
| - | |
| - Remove_Loop : | |
| - for K in 1 .. Queue_Maps (P).Length loop | |
| - Elem := Ordered_Call_Queue_Map.Element (C); | |
| - | |
| - if Elem.Id = Id then | |
| - Org_Id := Elem.Callee; | |
| - Success := True; | |
| - Rebuild_JSON := True; | |
| - | |
| - Queue_Maps (P).Delete (C); | |
| - | |
| - exit Queue_Maps_Loop; | |
| - end if; | |
| - | |
| - Ordered_Call_Queue_Map.Next (C); | |
| - end loop Remove_Loop; | |
| - end loop Queue_Maps_Loop; | |
| - end Remove; | |
| - | |
| - -------------------- | |
| - -- Remove_First -- | |
| - -------------------- | |
| - | |
| - procedure Remove_First | |
| - (Removed_Call_Id : out Call_Id; | |
| - Removed_Org_Id : out Natural) | |
| - is | |
| - use Ada.Containers; | |
| - begin | |
| - if Queue_Maps (High).Length > 0 then | |
| - Removed_Call_Id := Queue_Maps (High).First_Element.Id; | |
| - Removed_Org_Id := Queue_Maps (High).First_Element.Callee; | |
| - Queue_Maps (High).Delete_First; | |
| - elsif Queue_Maps (Normal).Length > 0 then | |
| - Removed_Call_Id := Queue_Maps (Normal).First_Element.Id; | |
| - Removed_Org_Id := Queue_Maps (Normal).First_Element.Callee; | |
| - Queue_Maps (Normal).Delete_First; | |
| - elsif Queue_Maps (Low).Length > 0 then | |
| - Removed_Call_Id := Queue_Maps (Low).First_Element.Id; | |
| - Removed_Org_Id := Queue_Maps (Low).First_Element.Callee; | |
| - Queue_Maps (Low).Delete_First; | |
| - else | |
| - Removed_Call_Id := " "; | |
| - Removed_Org_Id := 0; | |
| - end if; | |
| - end Remove_First; | |
| - end Queue; | |
| - | |
| - --------------------- | |
| - -- Sort_Elements -- | |
| - --------------------- | |
| - | |
| - function Sort_Elements | |
| - (Left, Right : in Ada.Calendar.Time) | |
| - return Boolean | |
| - is | |
| - use Ada.Calendar; | |
| - begin | |
| - return Left < Right; | |
| - end Sort_Elements; | |
| - | |
| -end Call_Queue; | |
| diff --git a/src/call_queue.ads b/src/call_queue.ads | |
| deleted file mode 100644 | |
| index 5f8df13..0000000 | |
| --- a/src/call_queue.ads | |
| +++ /dev/null | |
| @@ -1,44 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- Call_Queue -- | |
| --- -- | |
| --- SPEC -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -package Call_Queue is | |
| - | |
| - function Get | |
| - return String; | |
| - -- Return a JSON String containing the length of the queue and all the | |
| - -- calls waiting in the queue. | |
| - | |
| - function Get_Call | |
| - (Id : in String) | |
| - return String; | |
| - -- Return a JSON String containing the data for the longest waiting call, | |
| - -- if there is a call in the queue, else return an empty JSON string. | |
| - -- If Id is non-empty, try and return the call with Id. If no call is found | |
| - -- return an empty JSON string. | |
| - -- If a call is returned it is also deleted from the queue. | |
| - | |
| - function Length | |
| - return String; | |
| - -- Return a JSON String containing simply the length of the queue. | |
| - | |
| -end Call_Queue; | |
| diff --git a/src/common.ads b/src/common.ads | |
| index 4d5d684..2828d5f 100644 | |
| --- a/src/common.ads | |
| +++ b/src/common.ads | |
| @@ -21,21 +21,18 @@ | |
| -- -- | |
| ------------------------------------------------------------------------------- | |
| -with Ada.Strings.Bounded; | |
| +with Ada.Strings.Unbounded; | |
| with My_Configuration; | |
| package Common is | |
| package My renames My_Configuration; | |
| - package JSON_Large is new Ada.Strings.Bounded.Generic_Bounded_Length | |
| - (My.Config.Get (My.JSON_Size_Large)); | |
| - -- Used to hold JSON strings which are considered "large", ie. collections | |
| - -- of contacts, attributes or similar. | |
| + type JSON_String is new Ada.Strings.Unbounded.Unbounded_String; | |
| - package JSON_Small is new Ada.Strings.Bounded.Generic_Bounded_Length | |
| - (My.Config.Get (My.JSON_Size_Small)); | |
| - -- Used to hold JSON strings which are considered "small", ie. a single | |
| - -- contact, organization or similar. | |
| + function To_JSON_String | |
| + (Source : in String) | |
| + return JSON_String | |
| + renames To_Unbounded_String; | |
| end Common; | |
| diff --git a/src/errors.adb b/src/errors.adb | |
| index af025af..17ea626 100644 | |
| --- a/src/errors.adb | |
| +++ b/src/errors.adb | |
| @@ -49,10 +49,11 @@ package body Errors is | |
| function Exception_Handler | |
| (Event : in Ada.Exceptions.Exception_Occurrence; | |
| Message : in String) | |
| - return String | |
| + return Common.JSON_String | |
| is | |
| use Ada.Exceptions; | |
| use Ada.Task_Identification; | |
| + use Common; | |
| use GNATCOLL.JSON; | |
| use Yolk.Log; | |
| @@ -70,7 +71,7 @@ package body Errors is | |
| Field => E_Msg); | |
| JSON.Set_Field (Field_Name => "message", | |
| Field => Message); | |
| - return JSON.Write; | |
| + return To_JSON_String (JSON.Write); | |
| end Exception_Handler; | |
| end Errors; | |
| diff --git a/src/errors.ads b/src/errors.ads | |
| index 58780ce..c8189e7 100644 | |
| --- a/src/errors.ads | |
| +++ b/src/errors.ads | |
| @@ -22,6 +22,7 @@ | |
| ------------------------------------------------------------------------------- | |
| with Ada.Exceptions; | |
| +with Common; | |
| package Errors is | |
| @@ -39,7 +40,7 @@ package Errors is | |
| function Exception_Handler | |
| (Event : in Ada.Exceptions.Exception_Occurrence; | |
| Message : in String) | |
| - return String; | |
| + return Common.JSON_String; | |
| -- Log exception messages to the Error trace and returns a JSON String | |
| -- containing the exception. | |
| diff --git a/src/handlers/call_queue.adb b/src/handlers/call_queue.adb | |
| new file mode 100644 | |
| index 0000000..ca9f65b | |
| --- /dev/null | |
| +++ b/src/handlers/call_queue.adb | |
| @@ -0,0 +1,650 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Call_Queue -- | |
| +-- -- | |
| +-- BODY -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Ada.Calendar.Conversions; | |
| +with Ada.Calendar.Formatting; | |
| +with Ada.Containers.Ordered_Maps; | |
| +with Ada.Numerics.Discrete_Random; | |
| +with Ada.Strings.Fixed; | |
| +with AWS.Messages; | |
| +with AWS.URL; | |
| +with AWS.Utils; | |
| +with Common; | |
| +with Errors; | |
| +with HTTP_Codes; | |
| +with Interfaces.C; | |
| +with GNATCOLL.JSON; | |
| +with Response; | |
| +with Task_Controller; | |
| + | |
| +package body Call_Queue is | |
| + | |
| + type Priority_Level is (Low, Normal, High); | |
| + | |
| + package Random_Priority is new | |
| + Ada.Numerics.Discrete_Random (Priority_Level); | |
| + -- HERE FOR TESTING PURPOSES. | |
| + -- This is used by the PBX_Queue_Monitor task to generate random calls. | |
| + | |
| + subtype Org_Id is Natural range 1 .. 5; | |
| + package Random_Organization is new Ada.Numerics.Discrete_Random (Org_Id); | |
| + -- HERE FOR TESTING PURPOSES. | |
| + -- This is just to be able to randomnly grab an organization so it can be | |
| + -- added as the callee in a Call record. | |
| + | |
| + subtype Call_Id is String (1 .. 10); | |
| + -- Unique identifier for each call in the queue. This type will | |
| + -- obviously depend heavily on the kind of ID used internally by the PBX. | |
| + | |
| + type Call is | |
| + record | |
| + Id : Call_Id; | |
| + Callee : Org_Id; | |
| + Caller : String (1 .. 8); | |
| + Priority : Priority_Level; | |
| + Timestamp_UTC : Ada.Calendar.Time; | |
| + -- Note that the time is recorded in UTC. No timezone is given. | |
| + end record; | |
| + | |
| + procedure Build_Call_JSON | |
| + (Id : in String; | |
| + Status : out AWS.Messages.Status_Code; | |
| + Value : out Common.JSON_String) | |
| + with inline; | |
| + -- If Id exists, Value contains the data for the call with Id and | |
| + -- Status is 200. | |
| + -- If Id does not exist, Value is an empty JSON string {} and Status is | |
| + -- 404. | |
| + -- If Id is empty and there are calls in the queue, Value contains the | |
| + -- data for the oldest call and Status is 200. | |
| + -- If Id is empty and the queue is empty, Value contains an empty JSON | |
| + -- String {} and Status is 404. | |
| + -- When a call is found and returned, it is also deleted from the queue. | |
| + | |
| + function Build_Length_JSON | |
| + return Common.JSON_String | |
| + with inline; | |
| + -- Return a JSON String containing simply the length of the queue. | |
| + | |
| + function Build_Queue_JSON | |
| + return Common.JSON_String | |
| + with inline; | |
| + -- Return a JSON String containing the length of the queue and all the | |
| + -- calls waiting in the queue. | |
| + | |
| + function Equal_Elements | |
| + (Left, Right : in Call) | |
| + return Boolean; | |
| + -- Return True if two Call elements are equal. | |
| + | |
| + function Sort_Elements | |
| + (Left, Right : in Ada.Calendar.Time) | |
| + return Boolean; | |
| + -- Return True if Left is < the Right. This sorts the calls in the ordered | |
| + -- queue maps according to the Call.Timestamp_UTC component. | |
| + | |
| + package Ordered_Call_Queue_Map is new Ada.Containers.Ordered_Maps | |
| + (Key_Type => Ada.Calendar.Time, | |
| + Element_Type => Call, | |
| + "<" => Sort_Elements, | |
| + "=" => Equal_Elements); | |
| + -- All call queues are kept in a Ordered_Call_Queue_Map, with sorting being | |
| + -- done according to the Call.Timestamp_UTC component. | |
| + | |
| + type Queue_Maps_Array is array (Priority_Level) of | |
| + Ordered_Call_Queue_Map.Map; | |
| + | |
| + type Queue_JSON_Array is array (Priority_Level) of GNATCOLL.JSON.JSON_Array; | |
| + | |
| + protected Queue is | |
| + procedure Add | |
| + (Id : in Call_Id; | |
| + Callee : in Org_Id; | |
| + Caller : in String; | |
| + Priority : in Priority_Level; | |
| + Start : in Ada.Calendar.Time); | |
| + -- Add a call to the queue designated by Priority. | |
| + | |
| + procedure Build_JSON; | |
| + -- Build the queue JSON based on the Call records in the queues. | |
| + | |
| + procedure Clear; | |
| + -- Delete all calls from the queues. | |
| + | |
| + function Get return Common.JSON_String; | |
| + -- Return the queue JSON string. | |
| + | |
| + function Length | |
| + return Natural; | |
| + -- Return the amount of Call records currently in the queues. | |
| + | |
| + procedure Remove | |
| + (Id : in Call_Id); | |
| + -- Remove a call from the queue. | |
| + | |
| + procedure Remove | |
| + (Id : in Call_Id; | |
| + Org_Id : out Natural; | |
| + Success : out Boolean); | |
| + -- Remove a call from the queue. | |
| + | |
| + procedure Remove_First | |
| + (Removed_Call_Id : out Call_Id; | |
| + Removed_Org_Id : out Natural); | |
| + -- Remove the first call in the queue. Removed_Call_Id contains the Id | |
| + -- of the removed call and Removed_Org_Id is the Id of the callee. | |
| + -- If there are no calls to remove, an empty string and a 0 is returned. | |
| + private | |
| + Rebuild_JSON : Boolean := True; | |
| + -- This is set to False whenever a Call is added or removed from the | |
| + -- queues. | |
| + | |
| + JSON : GNATCOLL.JSON.JSON_Value := GNATCOLL.JSON.JSON_Null; | |
| + -- This holds the current JSON_Value object from which the | |
| + -- JSON_String is constructed. | |
| + | |
| + JSON_String : Common.JSON_String := Common.To_JSON_String ("{}"); | |
| + -- The JSON returned in call to Get. | |
| + | |
| + JSON_Arrays : Queue_JSON_Array := | |
| + (others => GNATCOLL.JSON.Empty_Array); | |
| + -- The JSON arrays containing the calls in the queue according to | |
| + -- their priority. | |
| + | |
| + Queue_Maps : Queue_Maps_Array; | |
| + -- The queue maps. | |
| + end Queue; | |
| + | |
| + task PBX_Queue_Monitor; | |
| + -- This is supposed to monitor one or more PBX's. Currently it just | |
| + -- generates dummy calls. | |
| + | |
| + task body PBX_Queue_Monitor | |
| + is | |
| + use Ada.Calendar; | |
| + use Task_Controller; | |
| + | |
| + type Foo is mod 30; | |
| + | |
| + Id_Array : array (Foo) of Call_Id := (others => " "); | |
| + -- Simulate up to a total of 30 calls in the queues. | |
| + | |
| + C : Foo := 0; | |
| + -- Basic counter variable. | |
| + | |
| + G : Random_Priority.Generator; | |
| + Org_G : Random_Organization.Generator; | |
| + OID : Org_Id; | |
| + P : Priority_Level; | |
| + -- Random priority levels on the generated calls. | |
| + begin | |
| + Random_Priority.Reset (G); | |
| + Random_Organization.Reset (Org_G, 42); | |
| + | |
| + loop | |
| + exit when Task_State = Down; | |
| + | |
| + P := Random_Priority.Random (G); | |
| + OID := Random_Organization.Random (Org_G); | |
| + | |
| + Id_Array (C) := AWS.Utils.Random_String (10); | |
| + | |
| + Queue.Add (Id => Id_Array (C), | |
| + Callee => OID, | |
| + Caller => AWS.Utils.Random_String (8), | |
| + Priority => P, | |
| + Start => Clock); | |
| + | |
| + if Id_Array (C + 1) /= " " then | |
| + Queue.Remove (Id_Array (C + 1)); | |
| + end if; | |
| + | |
| + C := C + 1; | |
| + | |
| + delay 15.0; | |
| + end loop; | |
| + | |
| + Queue.Clear; | |
| + end PBX_Queue_Monitor; | |
| + | |
| + task Generate_JSON; | |
| + -- Rebuild the queue JSON. Once every ½ second we check if a call has | |
| + -- been either added or removed from the queue, and if that is the case, | |
| + -- then we re-build the queue JSON. | |
| + | |
| + task body Generate_JSON | |
| + is | |
| + use Task_Controller; | |
| + begin | |
| + loop | |
| + exit when Task_State = Down; | |
| + | |
| + Queue.Build_JSON; | |
| + | |
| + delay 0.5; | |
| + end loop; | |
| + end Generate_JSON; | |
| + | |
| + ----------------------- | |
| + -- Build_Call_JSON -- | |
| + ----------------------- | |
| + | |
| + procedure Build_Call_JSON | |
| + (Id : in String; | |
| + Status : out AWS.Messages.Status_Code; | |
| + Value : out Common.JSON_String) | |
| + is | |
| + use Common; | |
| + use GNATCOLL.JSON; | |
| + use HTTP_Codes; | |
| + | |
| + JSON : constant JSON_Value := Create_Object; | |
| + Org_Id : Natural := 0; | |
| + Success : Boolean; | |
| + begin | |
| + Status := Server_Error; | |
| + | |
| + if Id'Length > 0 then | |
| + Queue.Remove (Id, Org_Id, Success); | |
| + | |
| + if Success then | |
| + JSON.Set_Field ("id", Id); | |
| + JSON.Set_Field ("org_id", Org_Id); | |
| + | |
| + Status := OK; | |
| + else | |
| + Status := Not_Found; | |
| + end if; | |
| + else | |
| + declare | |
| + CI : Call_Id; | |
| + Org_Id : Natural; | |
| + begin | |
| + Queue.Remove_First (Removed_Call_Id => CI, | |
| + Removed_Org_Id => Org_Id); | |
| + | |
| + if Org_Id > 0 then | |
| + JSON.Set_Field ("id", CI); | |
| + JSON.Set_Field ("org_id", Org_Id); | |
| + | |
| + Status := OK; | |
| + else | |
| + Status := Not_Found; | |
| + end if; | |
| + end; | |
| + end if; | |
| + | |
| + Value := To_JSON_String (JSON.Write); | |
| + end Build_Call_JSON; | |
| + | |
| + ------------------------- | |
| + -- Build_Length_JSON -- | |
| + ------------------------- | |
| + | |
| + function Build_Length_JSON return Common.JSON_String | |
| + is | |
| + use Common; | |
| + use GNATCOLL.JSON; | |
| + | |
| + JSON : constant JSON_Value := Create_Object; | |
| + begin | |
| + JSON.Set_Field ("length", Queue.Length); | |
| + | |
| + return To_JSON_String (JSON.Write); | |
| + end Build_Length_JSON; | |
| + | |
| + ------------------------ | |
| + -- Build_Queue_JSON -- | |
| + ------------------------ | |
| + | |
| + function Build_Queue_JSON | |
| + return Common.JSON_String | |
| + is | |
| + begin | |
| + return Queue.Get; | |
| + end Build_Queue_JSON; | |
| + | |
| + ---------------------- | |
| + -- Equal_Elements -- | |
| + ---------------------- | |
| + | |
| + function Equal_Elements | |
| + (Left, Right : in Call) | |
| + return Boolean | |
| + is | |
| + begin | |
| + return Left = Right; | |
| + end Equal_Elements; | |
| + | |
| + ----------- | |
| + -- Get -- | |
| + ----------- | |
| + | |
| + function Get | |
| + (Request : in AWS.Status.Data) | |
| + return AWS.Response.Data | |
| + is | |
| + use HTTP_Codes; | |
| + use Response; | |
| + begin | |
| + return Build_JSON_Response | |
| + (Request => Request, | |
| + Content => Build_Queue_JSON, | |
| + Status => OK); | |
| + end Get; | |
| + | |
| + ---------------- | |
| + -- Get_Call -- | |
| + ---------------- | |
| + | |
| + function Get_Call | |
| + (Request : in AWS.Status.Data) | |
| + return AWS.Response.Data | |
| + is | |
| + use AWS.Status; | |
| + use AWS.URL; | |
| + use Common; | |
| + use Errors; | |
| + use HTTP_Codes; | |
| + use Response; | |
| + | |
| + Id : constant String := Parameters (Request).Get ("id"); | |
| + Status_Code : AWS.Messages.Status_Code; | |
| + Value : JSON_String; | |
| + begin | |
| + Build_Call_JSON (Id, Status_Code, Value); | |
| + | |
| + return Build_JSON_Response | |
| + (Request => Request, | |
| + Content => Value, | |
| + Status => Status_Code); | |
| + | |
| + exception | |
| + when Event : others => | |
| + return Build_JSON_Response | |
| + (Request => Request, | |
| + Content => Exception_Handler | |
| + (Event => Event, | |
| + Message => "Requested resource: " & URL (URI (Request))), | |
| + Status => Server_Error); | |
| + end Get_Call; | |
| + | |
| + ------------------------ | |
| + -- Get_Queue_Length -- | |
| + ------------------------ | |
| + | |
| + function Get_Queue_Length | |
| + (Request : in AWS.Status.Data) | |
| + return AWS.Response.Data | |
| + is | |
| + use HTTP_Codes; | |
| + use Response; | |
| + begin | |
| + return Build_JSON_Response | |
| + (Request => Request, | |
| + Content => Build_Length_JSON, | |
| + Status => OK); | |
| + end Get_Queue_Length; | |
| + | |
| + ------------- | |
| + -- Queue -- | |
| + ------------- | |
| + | |
| + protected body Queue is | |
| + | |
| + ----------- | |
| + -- Add -- | |
| + ----------- | |
| + | |
| + procedure Add | |
| + (Id : in Call_Id; | |
| + Callee : in Org_Id; | |
| + Caller : in String; | |
| + Priority : in Priority_Level; | |
| + Start : in Ada.Calendar.Time) | |
| + is | |
| + begin | |
| + Queue_Maps (Priority).Insert (Key => Start, | |
| + New_Item => (Id => Id, | |
| + Callee => Callee, | |
| + Caller => Caller, | |
| + Priority => Priority, | |
| + Timestamp_UTC => Start)); | |
| + | |
| + Rebuild_JSON := True; | |
| + end Add; | |
| + | |
| + ------------------ | |
| + -- Build_JSON -- | |
| + ------------------ | |
| + | |
| + procedure Build_JSON | |
| + is | |
| + use Ada.Calendar; | |
| + use Ada.Calendar.Conversions; | |
| + use Ada.Calendar.Formatting; | |
| + use Common; | |
| + use GNATCOLL.JSON; | |
| + | |
| + procedure Go | |
| + (Position : in Ordered_Call_Queue_Map.Cursor); | |
| + -- JSON'ify each Call in the queue. | |
| + | |
| + function Unix_Timestamp | |
| + (Date : in Time) | |
| + return String; | |
| + -- Convert and trim an Ada.Calendar.Time type to a Unix timestamp | |
| + -- String. | |
| + | |
| + --------- | |
| + -- Go -- | |
| + --------- | |
| + | |
| + procedure Go | |
| + (Position : in Ordered_Call_Queue_Map.Cursor) | |
| + is | |
| + | |
| + A_Call : Call; | |
| + Value : constant JSON_Value := Create_Object; | |
| + begin | |
| + A_Call := Ordered_Call_Queue_Map.Element (Position); | |
| + | |
| + Value.Set_Field ("id", A_Call.Id); | |
| + Value.Set_Field ("callee", A_Call.Callee); | |
| + Value.Set_Field ("caller", A_Call.Caller); | |
| + Value.Set_Field ("UTC_start_date", Image (A_Call.Timestamp_UTC)); | |
| + Value.Set_Field | |
| + ("unix_timestamp", Unix_Timestamp (A_Call.Timestamp_UTC)); | |
| + | |
| + Append (JSON_Arrays (A_Call.Priority), Value); | |
| + end Go; | |
| + | |
| + ---------------------- | |
| + -- Unix_Timestamp -- | |
| + ---------------------- | |
| + | |
| + function Unix_Timestamp | |
| + (Date : in Time) | |
| + return String | |
| + is | |
| + use Ada.Strings; | |
| + use Interfaces.C; | |
| + begin | |
| + return Fixed.Trim | |
| + (Source => long'Image (To_Unix_Time (Date)), | |
| + Side => Left); | |
| + end Unix_Timestamp; | |
| + begin | |
| + if Rebuild_JSON then | |
| + JSON := Create_Object; | |
| + | |
| + JSON.Set_Field ("length", Queue.Length); | |
| + | |
| + JSON_Arrays := (others => Empty_Array); | |
| + | |
| + for P in Queue_Maps'Range loop | |
| + Queue_Maps (P).Iterate (Go'Access); | |
| + end loop; | |
| + | |
| + JSON.Set_Field ("low", JSON_Arrays (Low)); | |
| + JSON.Set_Field ("normal", JSON_Arrays (Normal)); | |
| + JSON.Set_Field ("high", JSON_Arrays (High)); | |
| + | |
| + JSON_String := To_JSON_String (JSON.Write); | |
| + end if; | |
| + end Build_JSON; | |
| + | |
| + ------------- | |
| + -- Clear -- | |
| + ------------- | |
| + | |
| + procedure Clear | |
| + is | |
| + use Common; | |
| + begin | |
| + for P in Queue_Maps'Range loop | |
| + Queue_Maps (P).Clear; | |
| + end loop; | |
| + | |
| + JSON_String := To_JSON_String ("{}"); | |
| + Rebuild_JSON := True; | |
| + end Clear; | |
| + | |
| + ----------- | |
| + -- Get -- | |
| + ----------- | |
| + | |
| + function Get | |
| + return Common.JSON_String | |
| + is | |
| + begin | |
| + return JSON_String; | |
| + end Get; | |
| + | |
| + -------------- | |
| + -- Length -- | |
| + -------------- | |
| + | |
| + function Length | |
| + return Natural | |
| + is | |
| + C : Natural := 0; | |
| + begin | |
| + for P in Queue_Maps'Range loop | |
| + C := C + Natural (Queue_Maps (P).Length); | |
| + end loop; | |
| + | |
| + return C; | |
| + end Length; | |
| + | |
| + -------------- | |
| + -- Remove -- | |
| + -------------- | |
| + | |
| + procedure Remove | |
| + (Id : in Call_Id) | |
| + is | |
| + Success : Boolean; | |
| + Org_Id : Natural; | |
| + | |
| + pragma Unreferenced (Success); | |
| + pragma Unreferenced (Org_Id); | |
| + begin | |
| + Remove (Id, Org_Id, Success); | |
| + end Remove; | |
| + | |
| + -------------- | |
| + -- Remove -- | |
| + -------------- | |
| + | |
| + procedure Remove | |
| + (Id : in Call_Id; | |
| + Org_Id : out Natural; | |
| + Success : out Boolean) | |
| + is | |
| + Elem : Call; | |
| + begin | |
| + Org_Id := 0; | |
| + Success := False; | |
| + | |
| + for Queue of Queue_Maps loop | |
| + for C in Queue.Iterate loop | |
| + Elem := Ordered_Call_Queue_Map.Element (C); | |
| + | |
| + if Elem.Id = Id then | |
| + Org_Id := Elem.Callee; | |
| + Success := True; | |
| + Rebuild_JSON := True; | |
| + | |
| + Queue.Delete (C); | |
| + | |
| + end if; | |
| + end loop; | |
| + | |
| + exit when Success; | |
| + end loop; | |
| + end Remove; | |
| + | |
| + -------------------- | |
| + -- Remove_First -- | |
| + -------------------- | |
| + | |
| + procedure Remove_First | |
| + (Removed_Call_Id : out Call_Id; | |
| + Removed_Org_Id : out Natural) | |
| + is | |
| + use Ada.Containers; | |
| + begin | |
| + if Queue_Maps (High).Length > 0 then | |
| + Removed_Call_Id := Queue_Maps (High).First_Element.Id; | |
| + Removed_Org_Id := Queue_Maps (High).First_Element.Callee; | |
| + Queue_Maps (High).Delete_First; | |
| + elsif Queue_Maps (Normal).Length > 0 then | |
| + Removed_Call_Id := Queue_Maps (Normal).First_Element.Id; | |
| + Removed_Org_Id := Queue_Maps (Normal).First_Element.Callee; | |
| + Queue_Maps (Normal).Delete_First; | |
| + elsif Queue_Maps (Low).Length > 0 then | |
| + Removed_Call_Id := Queue_Maps (Low).First_Element.Id; | |
| + Removed_Org_Id := Queue_Maps (Low).First_Element.Callee; | |
| + Queue_Maps (Low).Delete_First; | |
| + else | |
| + Removed_Call_Id := " "; | |
| + Removed_Org_Id := 0; | |
| + end if; | |
| + end Remove_First; | |
| + end Queue; | |
| + | |
| + --------------------- | |
| + -- Sort_Elements -- | |
| + --------------------- | |
| + | |
| + function Sort_Elements | |
| + (Left, Right : in Ada.Calendar.Time) | |
| + return Boolean | |
| + is | |
| + use Ada.Calendar; | |
| + begin | |
| + return Left < Right; | |
| + end Sort_Elements; | |
| + | |
| +end Call_Queue; | |
| diff --git a/src/handlers/call_queue.ads b/src/handlers/call_queue.ads | |
| new file mode 100644 | |
| index 0000000..7131108 | |
| --- /dev/null | |
| +++ b/src/handlers/call_queue.ads | |
| @@ -0,0 +1,47 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Call_Queue -- | |
| +-- -- | |
| +-- SPEC -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with AWS.Status; | |
| +with AWS.Response; | |
| + | |
| +package Call_Queue is | |
| + | |
| + function Get | |
| + (Request : in AWS.Status.Data) | |
| + return AWS.Response.Data; | |
| + -- Return a response containing the call queue JSON, complete with all | |
| + -- waiting calls and the length of the queue. | |
| + | |
| + function Get_Call | |
| + (Request : in AWS.Status.Data) | |
| + return AWS.Response.Data; | |
| + -- Return a response containing a JSON with either the oldest call in the | |
| + -- queue or the call identified by the optional id request parameter. | |
| + | |
| + function Get_Queue_Length | |
| + (Request : in AWS.Status.Data) | |
| + return AWS.Response.Data; | |
| + -- Return a response containing a JSON with just the length of the current | |
| + -- queue. | |
| + | |
| +end Call_Queue; | |
| diff --git a/src/handlers/contact.adb b/src/handlers/contact.adb | |
| new file mode 100644 | |
| index 0000000..52b7e1f | |
| --- /dev/null | |
| +++ b/src/handlers/contact.adb | |
| @@ -0,0 +1,146 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Contact -- | |
| +-- -- | |
| +-- BODY -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Database; | |
| +with GNATCOLL.JSON; | |
| +with Yolk.Utilities; | |
| + | |
| +package body Contact is | |
| + | |
| + ---------------- | |
| + -- Callback -- | |
| + ---------------- | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler | |
| + is | |
| + begin | |
| + return AWS.Dispatchers.Callback.Create (JSON_Response.Generate'Access); | |
| + end Callback; | |
| + | |
| + ------------------- | |
| + -- Create_JSON -- | |
| + ------------------- | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + is | |
| + use Common; | |
| + use GNATCOLL.JSON; | |
| + use Yolk.Utilities; | |
| + | |
| + DB_Columns : JSON_Value; | |
| + J : JSON_Value := Create_Object; | |
| + begin | |
| + if C.Has_Row then | |
| + DB_Columns := Create_Object; | |
| + | |
| + J := GNATCOLL.JSON.Read (To_String (C.Element.JSON), | |
| + "contact_json.error"); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Ce_Id_Column_Name), | |
| + C.Element.Ce_Id); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Ce_Name_Column_Name), | |
| + C.Element.Ce_Name); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Is_Human_Column_Name), | |
| + C.Element.Is_Human); | |
| + | |
| + if C.Element.Is_Human then | |
| + J.Set_Field ("type", "human"); | |
| + else | |
| + J.Set_Field ("type", "function"); | |
| + end if; | |
| + | |
| + J.Set_Field ("db_columns", DB_Columns); | |
| + end if; | |
| + | |
| + Value := To_JSON_String (J.Write); | |
| + end Create_JSON; | |
| + | |
| + --------------- | |
| + -- Element -- | |
| + --------------- | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row | |
| + is | |
| + use Common; | |
| + use Yolk.Utilities; | |
| + begin | |
| + return Row'(JSON => To_JSON_String (C.Value (0)), | |
| + Ce_Id => C.Integer_Value (1, Default => 0), | |
| + Ce_Id_Column_Name => TUS (C.Field_Name (1)), | |
| + Ce_Name => TUS (C.Field_Name (2)), | |
| + Ce_Name_Column_Name => TUS (C.Value (2)), | |
| + Is_Human => C.Boolean_Value (3), | |
| + Is_Human_Column_Name => TUS (C.Field_Name (3))); | |
| + end Element; | |
| + | |
| + ---------------------- | |
| + -- Prepared_Query -- | |
| + ---------------------- | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + is | |
| + package DB renames Database; | |
| + | |
| + use GNATCOLL.SQL; | |
| + use GNATCOLL.SQL.Exec; | |
| + | |
| + Get_Contact : constant SQL_Query | |
| + := SQL_Select (Fields => | |
| + DB.Contactentity.Json & -- 0 | |
| + DB.Contactentity.Ce_Id & -- 1 | |
| + DB.Contactentity.Ce_Name & -- 2 | |
| + DB.Contactentity.Is_Human, -- 3 | |
| + Where => | |
| + DB.Contactentity.Ce_Id = Integer_Param (1)); | |
| + | |
| + Prepared_Get_Contact : constant Prepared_Statement | |
| + := Prepare (Query => Get_Contact, | |
| + Auto_Complete => True, | |
| + On_Server => True, | |
| + Name => "get_contact"); | |
| + begin | |
| + return Prepared_Get_Contact; | |
| + end Prepared_Query; | |
| + | |
| + ------------------------ | |
| + -- Query_Parameters -- | |
| + ------------------------ | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + is | |
| + use GNATCOLL.SQL.Exec; | |
| + begin | |
| + return (1 => +Natural'Value (Response.Get_Ce_Id_Key (Request))); | |
| + end Query_Parameters; | |
| + | |
| +end Contact; | |
| diff --git a/src/handlers/contact.ads b/src/handlers/contact.ads | |
| new file mode 100644 | |
| index 0000000..6755388 | |
| --- /dev/null | |
| +++ b/src/handlers/contact.ads | |
| @@ -0,0 +1,109 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Contact -- | |
| +-- -- | |
| +-- SPEC -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Ada.Strings.Unbounded; | |
| +with AWS.Dispatchers.Callback; | |
| +with AWS.Status; | |
| +with Common; | |
| +with GNATCOLL.SQL.Exec; | |
| +with My_Configuration; | |
| +with Response; | |
| +with Storage; | |
| +with Yolk.Cache.String_Keys; | |
| + | |
| +package Contact is | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler; | |
| + -- Return a callback for the "contact" interface. | |
| + | |
| +private | |
| + | |
| + use Ada.Strings.Unbounded; | |
| + package My renames My_Configuration; | |
| + | |
| + type Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with null record; | |
| + | |
| + type Row is | |
| + record | |
| + JSON : Common.JSON_String; | |
| + Ce_Id : Natural; | |
| + Ce_Id_Column_Name : Unbounded_String; | |
| + Ce_Name : Unbounded_String; | |
| + Ce_Name_Column_Name : Unbounded_String; | |
| + Is_Human : Boolean; | |
| + Is_Human_Column_Name : Unbounded_String; | |
| + end record; | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row; | |
| + -- Transforms the low level index based Cursor into the more readable Row | |
| + -- record. | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + with inline; | |
| + -- Return an SQL query as a prepared statement. We keep the query in a | |
| + -- function of its own to protect against using sub-queries by accident and | |
| + -- to make it more readable due to local use clauses. | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + with inline; | |
| + -- Generate the SQL parameters from given request parameters. | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + with inline; | |
| + -- Generate a JSON_String from the Row record(s) found in C and place it in | |
| + -- Value. | |
| + -- If C is empty, then Value is an empty JSON_String, ie. {}. | |
| + | |
| + package Cache is new Yolk.Cache.String_Keys | |
| + (Element_Type => Common.JSON_String, | |
| + Cleanup_Size => My.Config.Get (My.Cache_Size_Contact) + 1, | |
| + Cleanup_On_Write => True, | |
| + Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| + Reserved_Capacity => My.Config.Get (My.Cache_Size_Contact)); | |
| + -- Cache for the JSON_String generated by Create_JSON. | |
| + | |
| + package Query_To_JSON is new Storage.Generic_Query_To_JSON | |
| + (Cursor => Cursor, | |
| + Query => Prepared_Query, | |
| + JSONIFY => Create_JSON, | |
| + Write_To_Cache => Cache.Write, | |
| + Query_Parameters => Query_Parameters); | |
| + -- Turn the data found by Query and Query_Parameters into a JSON string and | |
| + -- if the JSON_String object is not empty then write it to cache. | |
| + | |
| + package JSON_Response is new Response.Generic_Response | |
| + (Check_Request_Parameters => Response.Check_Ce_Id_Parameter, | |
| + Get_Cache_Key => Response.Get_Ce_Id_Key, | |
| + Read_From_Cache => Cache.Read, | |
| + Query_To_JSON => Query_To_JSON); | |
| + -- Generate the AWS.Response.Data that ultimately is delivered to the user. | |
| + | |
| +end Contact; | |
| diff --git a/src/handlers/contact_attributes.adb b/src/handlers/contact_attributes.adb | |
| new file mode 100644 | |
| index 0000000..9e62dbc | |
| --- /dev/null | |
| +++ b/src/handlers/contact_attributes.adb | |
| @@ -0,0 +1,144 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Contact_Attributes -- | |
| +-- -- | |
| +-- BODY -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Database; | |
| +with GNATCOLL.JSON; | |
| +with Yolk.Utilities; | |
| + | |
| +package body Contact_Attributes is | |
| + | |
| + ---------------- | |
| + -- Callback -- | |
| + ---------------- | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler | |
| + is | |
| + begin | |
| + return AWS.Dispatchers.Callback.Create (JSON_Response.Generate'Access); | |
| + end Callback; | |
| + | |
| + ------------------- | |
| + -- Create_JSON -- | |
| + ------------------- | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + is | |
| + use Common; | |
| + use GNATCOLL.JSON; | |
| + use Yolk.Utilities; | |
| + | |
| + Attr_Array : JSON_Array; | |
| + DB_Columns : JSON_Value; | |
| + DB_JSON : JSON_Value; | |
| + J : constant JSON_Value := Create_Object; | |
| + begin | |
| + while C.Has_Row loop | |
| + DB_Columns := Create_Object; | |
| + DB_JSON := Create_Object; | |
| + | |
| + DB_JSON := GNATCOLL.JSON.Read (To_String (C.Element.JSON), | |
| + "contact_attributes.json.error"); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Ce_Id_Column_Name), | |
| + C.Element.Ce_Id); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Org_Id_Column_Name), | |
| + C.Element.Org_Id); | |
| + | |
| + DB_JSON.Set_Field ("db_columns", DB_Columns); | |
| + | |
| + Append (Attr_Array, DB_JSON); | |
| + | |
| + C.Next; | |
| + end loop; | |
| + | |
| + J.Set_Field ("attributes", Attr_Array); | |
| + | |
| + Value := To_JSON_String (J.Write); | |
| + end Create_JSON; | |
| + | |
| + --------------- | |
| + -- Element -- | |
| + --------------- | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row | |
| + is | |
| + use Common; | |
| + use Yolk.Utilities; | |
| + begin | |
| + return Row'(JSON => To_JSON_String (C.Value (0)), | |
| + Ce_Id => C.Integer_Value (1, Default => 0), | |
| + Ce_Id_Column_Name => TUS (C.Field_Name (1)), | |
| + Org_Id => C.Integer_Value (2, Default => 0), | |
| + Org_Id_Column_Name => TUS (C.Value (2))); | |
| + end Element; | |
| + | |
| + ---------------------- | |
| + -- Prepared_Query -- | |
| + ---------------------- | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + is | |
| + package DB renames Database; | |
| + | |
| + use GNATCOLL.SQL; | |
| + use GNATCOLL.SQL.Exec; | |
| + | |
| + Get_Contact_Attributes : constant SQL_Query | |
| + := SQL_Select (Fields => | |
| + DB.Contactentity_Attributes.Json & -- 0 | |
| + DB.Contactentity_Attributes.Ce_Id & -- 1 | |
| + DB.Contactentity_Attributes.Org_Id, -- 2 | |
| + Where => | |
| + DB.Contactentity_Attributes.Ce_Id = | |
| + (Integer_Param (1))); | |
| + | |
| + Prepared_Get_Contact_Attributes : constant Prepared_Statement | |
| + := Prepare (Query => Get_Contact_Attributes, | |
| + Auto_Complete => True, | |
| + On_Server => True, | |
| + Name => "get_contact_attributes"); | |
| + begin | |
| + return Prepared_Get_Contact_Attributes; | |
| + end Prepared_Query; | |
| + | |
| + ------------------------ | |
| + -- Query_Parameters -- | |
| + ------------------------ | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + is | |
| + use GNATCOLL.SQL.Exec; | |
| + begin | |
| + return (1 => +Natural'Value (Response.Get_Ce_Id_Key (Request))); | |
| + end Query_Parameters; | |
| + | |
| +end Contact_Attributes; | |
| diff --git a/src/handlers/contact_attributes.ads b/src/handlers/contact_attributes.ads | |
| new file mode 100644 | |
| index 0000000..48e180e | |
| --- /dev/null | |
| +++ b/src/handlers/contact_attributes.ads | |
| @@ -0,0 +1,107 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Contact_Attributes -- | |
| +-- -- | |
| +-- SPEC -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Ada.Strings.Unbounded; | |
| +with AWS.Dispatchers.Callback; | |
| +with AWS.Status; | |
| +with Common; | |
| +with GNATCOLL.SQL.Exec; | |
| +with My_Configuration; | |
| +with Response; | |
| +with Storage; | |
| +with Yolk.Cache.String_Keys; | |
| + | |
| +package Contact_Attributes is | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler; | |
| + -- Return a callback for the "contact_attributes" interface. | |
| + | |
| +private | |
| + | |
| + use Ada.Strings.Unbounded; | |
| + package My renames My_Configuration; | |
| + | |
| + type Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with null record; | |
| + | |
| + type Row is | |
| + record | |
| + JSON : Common.JSON_String; | |
| + Ce_Id : Natural; | |
| + Ce_Id_Column_Name : Unbounded_String; | |
| + Org_Id : Natural; | |
| + Org_Id_Column_Name : Unbounded_String; | |
| + end record; | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row; | |
| + -- Transforms the low level index based Cursor into the more readable Row | |
| + -- record. | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + with inline; | |
| + -- Return an SQL query as a prepared statement. We keep the query in a | |
| + -- function of its own to protect against using sub-queries by accident and | |
| + -- to make it more readable due to local use clauses. | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + with inline; | |
| + -- Generate the SQL parameters from given request parameters. | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + with inline; | |
| + -- Generate a JSON_String from the Row record(s) found in C and place it in | |
| + -- Value. | |
| + -- If C is empty, then Value is an empty JSON_String, ie. {}. | |
| + | |
| + package Cache is new Yolk.Cache.String_Keys | |
| + (Element_Type => Common.JSON_String, | |
| + Cleanup_Size => My.Config.Get (My.Cache_Size_Contact) + 1, | |
| + Cleanup_On_Write => True, | |
| + Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| + Reserved_Capacity => My.Config.Get (My.Cache_Size_Contact)); | |
| + -- Cache for the JSON_String generated by Create_JSON. | |
| + | |
| + package Query_To_JSON is new Storage.Generic_Query_To_JSON | |
| + (Cursor => Cursor, | |
| + Query => Prepared_Query, | |
| + JSONIFY => Create_JSON, | |
| + Write_To_Cache => Cache.Write, | |
| + Query_Parameters => Query_Parameters); | |
| + -- Turn the data found by Query and Query_Parameters into a JSON string and | |
| + -- if the JSON_String object is not empty then write it to cache. | |
| + | |
| + package JSON_Response is new Response.Generic_Response | |
| + (Check_Request_Parameters => Response.Check_Ce_Id_Parameter, | |
| + Get_Cache_Key => Response.Get_Ce_Id_Key, | |
| + Read_From_Cache => Cache.Read, | |
| + Query_To_JSON => Query_To_JSON); | |
| + -- Generate the AWS.Response.Data that ultimately is delivered to the user. | |
| + | |
| +end Contact_Attributes; | |
| diff --git a/src/handlers/contact_full.adb b/src/handlers/contact_full.adb | |
| new file mode 100644 | |
| index 0000000..9266c36 | |
| --- /dev/null | |
| +++ b/src/handlers/contact_full.adb | |
| @@ -0,0 +1,193 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Contact -- | |
| +-- -- | |
| +-- BODY -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Database; | |
| +with GNATCOLL.JSON; | |
| +with Yolk.Utilities; | |
| + | |
| +package body Contact_Full is | |
| + | |
| + ---------------- | |
| + -- Callback -- | |
| + ---------------- | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler | |
| + is | |
| + begin | |
| + return AWS.Dispatchers.Callback.Create (JSON_Response.Generate'Access); | |
| + end Callback; | |
| + | |
| + ------------------- | |
| + -- Create_JSON -- | |
| + ------------------- | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + is | |
| + use Common; | |
| + use GNATCOLL.JSON; | |
| + use Yolk.Utilities; | |
| + | |
| + Attr_Array : JSON_Array; | |
| + Attr_DB_Columns : JSON_Value; | |
| + Attr_JSON : JSON_Value; | |
| + DB_Columns : JSON_Value; | |
| + J : JSON_Value := Create_Object; | |
| + begin | |
| + if C.Has_Row then | |
| + -- Cursor can contain more than one row, so we start by building the | |
| + -- main JSON object from the first row, so we don't repeat the JSON | |
| + -- building code for the same data over and over. | |
| + DB_Columns := Create_Object; | |
| + | |
| + J := GNATCOLL.JSON.Read (To_String (C.Element.JSON), "json.error"); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Ce_Id_Column_Name), | |
| + C.Element.Ce_Id); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Ce_Name_Column_Name), | |
| + C.Element.Ce_Name); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Is_Human_Column_Name), | |
| + C.Element.Is_Human); | |
| + | |
| + if C.Element.Is_Human then | |
| + J.Set_Field ("type", "human"); | |
| + else | |
| + J.Set_Field ("type", "function"); | |
| + end if; | |
| + | |
| + J.Set_Field ("db_columns", DB_Columns); | |
| + | |
| + while C.Has_Row loop | |
| + if To_String (C.Element.Attr_JSON) /= "" then | |
| + Attr_JSON := Create_Object; | |
| + Attr_DB_Columns := Create_Object; | |
| + | |
| + Attr_JSON := GNATCOLL.JSON.Read | |
| + (To_String (C.Element.Attr_JSON), | |
| + "attr.json.error"); | |
| + | |
| + Attr_DB_Columns.Set_Field | |
| + (TS (C.Element.Attr_Org_Id_Column_Name), | |
| + C.Element.Attr_Org_Id); | |
| + | |
| + Attr_DB_Columns.Set_Field | |
| + (TS (C.Element.Attr_Ce_Id_Column_Name), | |
| + C.Element.Attr_Ce_Id); | |
| + | |
| + Attr_JSON.Set_Field ("db_columns", Attr_DB_Columns); | |
| + | |
| + Append (Attr_Array, Attr_JSON); | |
| + end if; | |
| + | |
| + C.Next; | |
| + end loop; | |
| + | |
| + J.Set_Field ("attributes", Attr_Array); | |
| + end if; | |
| + | |
| + Value := To_JSON_String (J.Write); | |
| + end Create_JSON; | |
| + | |
| + --------------- | |
| + -- Element -- | |
| + --------------- | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row | |
| + is | |
| + use Common; | |
| + use Yolk.Utilities; | |
| + begin | |
| + return Row'(JSON => To_JSON_String (C.Value (0)), | |
| + Ce_Id => C.Integer_Value (1, Default => 0), | |
| + Ce_Id_Column_Name => TUS (C.Field_Name (1)), | |
| + Ce_Name => TUS (C.Value (2)), | |
| + Ce_Name_Column_Name => TUS (C.Field_Name (2)), | |
| + Is_Human => C.Boolean_Value (3), | |
| + Is_Human_Column_Name => TUS (C.Field_Name (3)), | |
| + Attr_JSON => To_JSON_String (C.Value (4)), | |
| + Attr_Org_Id => C.Integer_Value (5, Default => 0), | |
| + Attr_Org_Id_Column_Name => TUS (C.Field_Name (5)), | |
| + Attr_Ce_Id => C.Integer_Value (6, Default => 0), | |
| + Attr_Ce_Id_Column_Name => TUS (C.Field_Name (6))); | |
| + end Element; | |
| + | |
| + ---------------------- | |
| + -- Prepared_Query -- | |
| + ---------------------- | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + is | |
| + package DB renames Database; | |
| + | |
| + use GNATCOLL.SQL; | |
| + use GNATCOLL.SQL.Exec; | |
| + | |
| + Get_Contact_Full_Left_Join : constant SQL_Left_Join_Table | |
| + := Left_Join (Full => DB.Contactentity, | |
| + Partial => DB.Contactentity_Attributes, | |
| + On => | |
| + DB.Contactentity.Ce_Id = | |
| + DB.Contactentity_Attributes.Ce_Id); | |
| + | |
| + Get_Contact_Full : constant SQL_Query | |
| + := SQL_Select (Fields => | |
| + DB.Contactentity.Json & -- 0 | |
| + DB.Contactentity.Ce_Id & -- 1 | |
| + DB.Contactentity.Ce_Name & -- 2 | |
| + DB.Contactentity.Is_Human & -- 3 | |
| + DB.Contactentity_Attributes.Json & -- 4 | |
| + DB.Contactentity_Attributes.Org_Id & -- 5 | |
| + DB.Contactentity_Attributes.Ce_Id, -- 6 | |
| + From => Get_Contact_Full_Left_Join, | |
| + Where => DB.Contactentity.Ce_Id = Integer_Param (1)); | |
| + | |
| + Prepared_Get_Contact_Full : constant Prepared_Statement | |
| + := Prepare (Query => Get_Contact_Full, | |
| + Auto_Complete => True, | |
| + On_Server => True, | |
| + Name => "get_contact_full"); | |
| + begin | |
| + return Prepared_Get_Contact_Full; | |
| + end Prepared_Query; | |
| + | |
| + ------------------------ | |
| + -- Query_Parameters -- | |
| + ------------------------ | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + is | |
| + use GNATCOLL.SQL.Exec; | |
| + begin | |
| + return (1 => +Natural'Value (Response.Get_Ce_Id_Key (Request))); | |
| + end Query_Parameters; | |
| + | |
| +end Contact_Full; | |
| diff --git a/src/handlers/contact_full.ads b/src/handlers/contact_full.ads | |
| new file mode 100644 | |
| index 0000000..339c7b7 | |
| --- /dev/null | |
| +++ b/src/handlers/contact_full.ads | |
| @@ -0,0 +1,114 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Contact -- | |
| +-- -- | |
| +-- SPEC -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Ada.Strings.Unbounded; | |
| +with AWS.Dispatchers.Callback; | |
| +with AWS.Status; | |
| +with Common; | |
| +with GNATCOLL.SQL.Exec; | |
| +with My_Configuration; | |
| +with Response; | |
| +with Storage; | |
| +with Yolk.Cache.String_Keys; | |
| + | |
| +package Contact_Full is | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler; | |
| + -- Return a callback for the "contact_full" interface. | |
| + | |
| +private | |
| + | |
| + use Ada.Strings.Unbounded; | |
| + package My renames My_Configuration; | |
| + | |
| + type Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with null record; | |
| + | |
| + type Row is | |
| + record | |
| + JSON : Common.JSON_String; | |
| + Ce_Id : Natural; | |
| + Ce_Id_Column_Name : Unbounded_String; | |
| + Ce_Name : Unbounded_String; | |
| + Ce_Name_Column_Name : Unbounded_String; | |
| + Is_Human : Boolean; | |
| + Is_Human_Column_Name : Unbounded_String; | |
| + Attr_JSON : Common.JSON_String; | |
| + Attr_Org_Id : Natural; | |
| + Attr_Org_Id_Column_Name : Unbounded_String; | |
| + Attr_Ce_Id : Natural; | |
| + Attr_Ce_Id_Column_Name : Unbounded_String; | |
| + end record; | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row; | |
| + -- Transforms the low level index based Cursor into the more readable Row | |
| + -- record. | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + with inline; | |
| + -- Return an SQL query as a prepared statement. We keep the query in a | |
| + -- function of its own to protect against using sub-queries by accident and | |
| + -- to make it more readable due to local use clauses. | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + with inline; | |
| + -- Generate the SQL parameters from given request parameters. | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + with inline; | |
| + -- Generate a JSON_String from the Row record(s) found in C and place it in | |
| + -- Value. | |
| + -- If C is empty, then Value is an empty JSON_String, ie. {}. | |
| + | |
| + package Cache is new Yolk.Cache.String_Keys | |
| + (Element_Type => Common.JSON_String, | |
| + Cleanup_Size => My.Config.Get (My.Cache_Size_Contact) + 1, | |
| + Cleanup_On_Write => True, | |
| + Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| + Reserved_Capacity => My.Config.Get (My.Cache_Size_Contact)); | |
| + -- Cache for the JSON_String generated by Create_JSON. | |
| + | |
| + package Query_To_JSON is new Storage.Generic_Query_To_JSON | |
| + (Cursor => Cursor, | |
| + Query => Prepared_Query, | |
| + JSONIFY => Create_JSON, | |
| + Write_To_Cache => Cache.Write, | |
| + Query_Parameters => Query_Parameters); | |
| + -- Turn the data found by Query and Query_Parameters into a JSON string and | |
| + -- if the JSON_String object is not empty then write it to cache. | |
| + | |
| + package JSON_Response is new Response.Generic_Response | |
| + (Check_Request_Parameters => Response.Check_Ce_Id_Parameter, | |
| + Get_Cache_Key => Response.Get_Ce_Id_Key, | |
| + Read_From_Cache => Cache.Read, | |
| + Query_To_JSON => Query_To_JSON); | |
| + -- Generate the AWS.Response.Data that ultimately is delivered to the user. | |
| + | |
| +end Contact_Full; | |
| diff --git a/src/handlers/organization.adb b/src/handlers/organization.adb | |
| new file mode 100644 | |
| index 0000000..bb3a96c | |
| --- /dev/null | |
| +++ b/src/handlers/organization.adb | |
| @@ -0,0 +1,139 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Organization -- | |
| +-- -- | |
| +-- BODY -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Database; | |
| +with GNATCOLL.JSON; | |
| +with Yolk.Utilities; | |
| + | |
| +package body Organization is | |
| + | |
| + ---------------- | |
| + -- Callback -- | |
| + ---------------- | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler | |
| + is | |
| + begin | |
| + return AWS.Dispatchers.Callback.Create (JSON_Response.Generate'Access); | |
| + end Callback; | |
| + | |
| + ------------------- | |
| + -- Create_JSON -- | |
| + ------------------- | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + is | |
| + use Common; | |
| + use GNATCOLL.JSON; | |
| + use Yolk.Utilities; | |
| + | |
| + DB_Columns : JSON_Value; | |
| + J : JSON_Value := Create_Object; | |
| + begin | |
| + if C.Has_Row then | |
| + DB_Columns := Create_Object; | |
| + | |
| + J := GNATCOLL.JSON.Read (To_String (C.Element.JSON), | |
| + "organization_json.error"); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Org_Id_Column_Name), | |
| + C.Element.Org_Id); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Org_Name_Column_Name), | |
| + TS (C.Element.Org_Name)); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Identifier_Column_Name), | |
| + TS (C.Element.Identifier)); | |
| + | |
| + J.Set_Field ("db_columns", DB_Columns); | |
| + end if; | |
| + | |
| + Value := To_JSON_String (J.Write); | |
| + end Create_JSON; | |
| + | |
| + --------------- | |
| + -- Element -- | |
| + --------------- | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row | |
| + is | |
| + use Common; | |
| + use Yolk.Utilities; | |
| + begin | |
| + return Row'(JSON => To_JSON_String (C.Value (0)), | |
| + Org_Id => C.Integer_Value (1, Default => 0), | |
| + Org_Id_Column_Name => TUS (C.Field_Name (1)), | |
| + Org_Name => TUS (C.Value (2)), | |
| + Org_Name_Column_Name => TUS (C.Field_Name (2)), | |
| + Identifier => TUS (C.Value (3)), | |
| + Identifier_Column_Name => TUS (C.Field_Name (3))); | |
| + end Element; | |
| + | |
| + ---------------------- | |
| + -- Prepared_Query -- | |
| + ---------------------- | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + is | |
| + package DB renames Database; | |
| + | |
| + use GNATCOLL.SQL; | |
| + use GNATCOLL.SQL.Exec; | |
| + | |
| + Get_Organization : constant SQL_Query | |
| + := SQL_Select (Fields => | |
| + DB.Organization.Json & -- 0 | |
| + DB.Organization.Org_Id & -- 1 | |
| + DB.Organization.Org_Name & -- 2 | |
| + DB.Organization.Identifier, -- 3 | |
| + Where => DB.Organization.Org_Id = Integer_Param (1)); | |
| + | |
| + Prepared_Get_Organization : constant Prepared_Statement | |
| + := Prepare (Query => Get_Organization, | |
| + Auto_Complete => True, | |
| + On_Server => True, | |
| + Name => "get_organization"); | |
| + begin | |
| + return Prepared_Get_Organization; | |
| + end Prepared_Query; | |
| + | |
| + ------------------------ | |
| + -- Query_Parameters -- | |
| + ------------------------ | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + is | |
| + use GNATCOLL.SQL.Exec; | |
| + begin | |
| + return (1 => +Natural'Value (Response.Get_Org_Id_Key (Request))); | |
| + end Query_Parameters; | |
| + | |
| +end Organization; | |
| diff --git a/src/handlers/organization.ads b/src/handlers/organization.ads | |
| new file mode 100644 | |
| index 0000000..01af5f8 | |
| --- /dev/null | |
| +++ b/src/handlers/organization.ads | |
| @@ -0,0 +1,109 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Organization -- | |
| +-- -- | |
| +-- SPEC -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Ada.Strings.Unbounded; | |
| +with AWS.Dispatchers.Callback; | |
| +with AWS.Status; | |
| +with Common; | |
| +with GNATCOLL.SQL.Exec; | |
| +with My_Configuration; | |
| +with Response; | |
| +with Storage; | |
| +with Yolk.Cache.String_Keys; | |
| + | |
| +package Organization is | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler; | |
| + -- Return a callback for the "organization" interface. | |
| + | |
| +private | |
| + | |
| + use Ada.Strings.Unbounded; | |
| + package My renames My_Configuration; | |
| + | |
| + type Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with null record; | |
| + | |
| + type Row is | |
| + record | |
| + JSON : Common.JSON_String; | |
| + Org_Id : Natural; | |
| + Org_Id_Column_Name : Unbounded_String; | |
| + Org_Name : Unbounded_String; | |
| + Org_Name_Column_Name : Unbounded_String; | |
| + Identifier : Unbounded_String; | |
| + Identifier_Column_Name : Unbounded_String; | |
| + end record; | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row; | |
| + -- Transforms the low level index based Cursor into the more readable Row | |
| + -- record. | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + with inline; | |
| + -- Return an SQL query as a prepared statement. We keep the query in a | |
| + -- function of its own to protect against using sub-queries by accident and | |
| + -- to make it more readable due to local use clauses. | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + with inline; | |
| + -- Generate the SQL parameters from given request parameters. | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + with inline; | |
| + -- Generate a JSON_String from the Row record(s) found in C and place it in | |
| + -- Value. | |
| + -- If C is empty, then Value is an empty JSON_String, ie. {}. | |
| + | |
| + package Cache is new Yolk.Cache.String_Keys | |
| + (Element_Type => Common.JSON_String, | |
| + Cleanup_Size => My.Config.Get (My.Cache_Size_Organization) + 1, | |
| + Cleanup_On_Write => True, | |
| + Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| + Reserved_Capacity => My.Config.Get (My.Cache_Size_Organization)); | |
| + -- Cache for the JSON_String generated by Create_JSON. | |
| + | |
| + package Query_To_JSON is new Storage.Generic_Query_To_JSON | |
| + (Cursor => Cursor, | |
| + Query => Prepared_Query, | |
| + JSONIFY => Create_JSON, | |
| + Write_To_Cache => Cache.Write, | |
| + Query_Parameters => Query_Parameters); | |
| + -- Turn the data found by Query and Query_Parameters into a JSON string and | |
| + -- if the JSON_String object is not empty then write it to cache. | |
| + | |
| + package JSON_Response is new Response.Generic_Response | |
| + (Check_Request_Parameters => Response.Check_Org_Id_Parameter, | |
| + Get_Cache_Key => Response.Get_Org_Id_Key, | |
| + Read_From_Cache => Cache.Read, | |
| + Query_To_JSON => Query_To_JSON); | |
| + -- Generate the AWS.Response.Data that ultimately is delivered to the user. | |
| + | |
| +end Organization; | |
| diff --git a/src/handlers/organization_contacts.adb b/src/handlers/organization_contacts.adb | |
| new file mode 100644 | |
| index 0000000..bd675bd | |
| --- /dev/null | |
| +++ b/src/handlers/organization_contacts.adb | |
| @@ -0,0 +1,164 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Organization_Contacts -- | |
| +-- -- | |
| +-- BODY -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Database; | |
| +with GNATCOLL.JSON; | |
| +with Yolk.Utilities; | |
| + | |
| +package body Organization_Contacts is | |
| + | |
| + ---------------- | |
| + -- Callback -- | |
| + ---------------- | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler | |
| + is | |
| + begin | |
| + return AWS.Dispatchers.Callback.Create (JSON_Response.Generate'Access); | |
| + end Callback; | |
| + | |
| + ------------------- | |
| + -- Create_JSON -- | |
| + ------------------- | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + is | |
| + use Common; | |
| + use GNATCOLL.JSON; | |
| + use Yolk.Utilities; | |
| + | |
| + Contact_Array : JSON_Array; | |
| + DB_Columns : JSON_Value; | |
| + DB_JSON : JSON_Value; | |
| + J : constant JSON_Value := Create_Object; | |
| + begin | |
| + while C.Has_Row loop | |
| + DB_Columns := Create_Object; | |
| + DB_JSON := Create_Object; | |
| + | |
| + DB_JSON := GNATCOLL.JSON.Read (To_String (C.Element.JSON), | |
| + "organization_contacts.json.error"); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Ce_Id_Column_Name), | |
| + C.Element.Ce_Id); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Ce_Name_Column_Name), | |
| + C.Element.Ce_Name); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Is_Human_Column_Name), | |
| + C.Element.Is_Human); | |
| + | |
| + if C.Element.Is_Human then | |
| + DB_JSON.Set_Field ("type", "human"); | |
| + else | |
| + DB_JSON.Set_Field ("type", "function"); | |
| + end if; | |
| + | |
| + DB_JSON.Set_Field ("db_columns", DB_Columns); | |
| + | |
| + Append (Contact_Array, DB_JSON); | |
| + | |
| + C.Next; | |
| + end loop; | |
| + | |
| + J.Set_Field ("contacts", Contact_Array); | |
| + | |
| + Value := To_JSON_String (J.Write); | |
| + end Create_JSON; | |
| + | |
| + --------------- | |
| + -- Element -- | |
| + --------------- | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row | |
| + is | |
| + use Common; | |
| + use Yolk.Utilities; | |
| + begin | |
| + return Row'(JSON => To_JSON_String (C.Value (0)), | |
| + Ce_Id => C.Integer_Value (1, Default => 0), | |
| + Ce_Id_Column_Name => TUS (C.Field_Name (1)), | |
| + Ce_Name => TUS (C.Value (2)), | |
| + Ce_Name_Column_Name => TUS (C.Field_Name (2)), | |
| + Is_Human => C.Boolean_Value (3), | |
| + Is_Human_Column_Name => TUS (C.Field_Name (3))); | |
| + end Element; | |
| + | |
| + ---------------------- | |
| + -- Prepared_Query -- | |
| + ---------------------- | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + is | |
| + package DB renames Database; | |
| + | |
| + use GNATCOLL.SQL; | |
| + use GNATCOLL.SQL.Exec; | |
| + | |
| + Get_Org_Contacts_Join : constant SQL_Left_Join_Table | |
| + := Join (Table1 => DB.Contactentity, | |
| + Table2 => DB.Organization_Contactentities, | |
| + On => | |
| + DB.Contactentity.Ce_Id = | |
| + DB.Organization_Contactentities.Ce_Id); | |
| + | |
| + Get_Org_Contacts : constant SQL_Query | |
| + := SQL_Select (Fields => | |
| + DB.Contactentity.Json & -- 0 | |
| + DB.Contactentity.Ce_Id & -- 1 | |
| + DB.Contactentity.Ce_Name & -- 2 | |
| + DB.Contactentity.Is_Human, -- 3 | |
| + From => Get_Org_Contacts_Join, | |
| + Where => | |
| + DB.Organization_Contactentities.Org_Id = | |
| + Integer_Param (1)); | |
| + | |
| + Prepared_Get_Org_Contacts : constant Prepared_Statement | |
| + := Prepare (Query => Get_Org_Contacts, | |
| + Auto_Complete => True, | |
| + On_Server => True, | |
| + Name => "get_org_contacts"); | |
| + begin | |
| + return Prepared_Get_Org_Contacts; | |
| + end Prepared_Query; | |
| + | |
| + ------------------------ | |
| + -- Query_Parameters -- | |
| + ------------------------ | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + is | |
| + use GNATCOLL.SQL.Exec; | |
| + begin | |
| + return (1 => +Natural'Value (Response.Get_Org_Id_Key (Request))); | |
| + end Query_Parameters; | |
| + | |
| +end Organization_Contacts; | |
| diff --git a/src/handlers/organization_contacts.ads b/src/handlers/organization_contacts.ads | |
| new file mode 100644 | |
| index 0000000..fa2b581 | |
| --- /dev/null | |
| +++ b/src/handlers/organization_contacts.ads | |
| @@ -0,0 +1,109 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Organization_Contacts -- | |
| +-- -- | |
| +-- SPEC -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Ada.Strings.Unbounded; | |
| +with AWS.Dispatchers.Callback; | |
| +with AWS.Status; | |
| +with Common; | |
| +with GNATCOLL.SQL.Exec; | |
| +with My_Configuration; | |
| +with Response; | |
| +with Storage; | |
| +with Yolk.Cache.String_Keys; | |
| + | |
| +package Organization_Contacts is | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler; | |
| + -- Return a callback for the "organization_contacts" interface. | |
| + | |
| +private | |
| + | |
| + use Ada.Strings.Unbounded; | |
| + package My renames My_Configuration; | |
| + | |
| + type Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with null record; | |
| + | |
| + type Row is | |
| + record | |
| + JSON : Common.JSON_String; | |
| + Ce_Id : Natural; | |
| + Ce_Id_Column_Name : Unbounded_String; | |
| + Ce_Name : Unbounded_String; | |
| + Ce_Name_Column_Name : Unbounded_String; | |
| + Is_Human : Boolean; | |
| + Is_Human_Column_Name : Unbounded_String; | |
| + end record; | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row; | |
| + -- Transforms the low level index based Cursor into the more readable Row | |
| + -- record. | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + with inline; | |
| + -- Return an SQL query as a prepared statement. We keep the query in a | |
| + -- function of its own to protect against using sub-queries by accident and | |
| + -- to make it more readable due to local use clauses. | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + with inline; | |
| + -- Generate the SQL parameters from given request parameters. | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + with inline; | |
| + -- Generate a JSON_String from the Row record(s) found in C and place it in | |
| + -- Value. | |
| + -- If C is empty, then Value is an empty JSON_String, ie. {}. | |
| + | |
| + package Cache is new Yolk.Cache.String_Keys | |
| + (Element_Type => Common.JSON_String, | |
| + Cleanup_Size => My.Config.Get (My.Cache_Size_Organization) + 1, | |
| + Cleanup_On_Write => True, | |
| + Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| + Reserved_Capacity => My.Config.Get (My.Cache_Size_Organization)); | |
| + -- Cache for the JSON_String generated by Create_JSON. | |
| + | |
| + package Query_To_JSON is new Storage.Generic_Query_To_JSON | |
| + (Cursor => Cursor, | |
| + Query => Prepared_Query, | |
| + JSONIFY => Create_JSON, | |
| + Write_To_Cache => Cache.Write, | |
| + Query_Parameters => Query_Parameters); | |
| + -- Turn the data found by Query and Query_Parameters into a JSON string and | |
| + -- if the JSON_String object is not empty then write it to cache. | |
| + | |
| + package JSON_Response is new Response.Generic_Response | |
| + (Check_Request_Parameters => Response.Check_Org_Id_Parameter, | |
| + Get_Cache_Key => Response.Get_Org_Id_Key, | |
| + Read_From_Cache => Cache.Read, | |
| + Query_To_JSON => Query_To_JSON); | |
| + -- Generate the AWS.Response.Data that ultimately is delivered to the user. | |
| + | |
| +end Organization_Contacts; | |
| diff --git a/src/handlers/organization_contacts_attributes.adb b/src/handlers/organization_contacts_attributes.adb | |
| new file mode 100644 | |
| index 0000000..41ec1a6 | |
| --- /dev/null | |
| +++ b/src/handlers/organization_contacts_attributes.adb | |
| @@ -0,0 +1,145 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Organization_Contacts_Attributes -- | |
| +-- -- | |
| +-- BODY -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Database; | |
| +with GNATCOLL.JSON; | |
| +with Yolk.Utilities; | |
| + | |
| +package body Organization_Contacts_Attributes is | |
| + | |
| + ---------------- | |
| + -- Callback -- | |
| + ---------------- | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler | |
| + is | |
| + begin | |
| + return AWS.Dispatchers.Callback.Create (JSON_Response.Generate'Access); | |
| + end Callback; | |
| + | |
| + ------------------- | |
| + -- Create_JSON -- | |
| + ------------------- | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + is | |
| + use Common; | |
| + use GNATCOLL.JSON; | |
| + use Yolk.Utilities; | |
| + | |
| + Attr_Array : JSON_Array; | |
| + DB_Columns : JSON_Value; | |
| + DB_JSON : JSON_Value; | |
| + J : constant JSON_Value := Create_Object; | |
| + begin | |
| + while C.Has_Row loop | |
| + DB_Columns := Create_Object; | |
| + DB_JSON := Create_Object; | |
| + | |
| + DB_JSON := GNATCOLL.JSON.Read | |
| + (To_String (C.Element.JSON), | |
| + "organization_contacts_attributes.json.error"); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Ce_Id_Column_Name), | |
| + C.Element.Ce_Id); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Org_Id_Column_Name), | |
| + C.Element.Org_Id); | |
| + | |
| + DB_JSON.Set_Field ("db_columns", DB_Columns); | |
| + | |
| + Append (Attr_Array, DB_JSON); | |
| + | |
| + C.Next; | |
| + end loop; | |
| + | |
| + J.Set_Field ("attributes", Attr_Array); | |
| + | |
| + Value := To_JSON_String (J.Write); | |
| + end Create_JSON; | |
| + | |
| + --------------- | |
| + -- Element -- | |
| + --------------- | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row | |
| + is | |
| + use Common; | |
| + use Yolk.Utilities; | |
| + begin | |
| + return Row'(JSON => To_JSON_String (C.Value (0)), | |
| + Ce_Id => C.Integer_Value (1, Default => 0), | |
| + Ce_Id_Column_Name => TUS (C.Field_Name (1)), | |
| + Org_Id => C.Integer_Value (2, Default => 0), | |
| + Org_Id_Column_Name => TUS (C.Field_Name (2))); | |
| + end Element; | |
| + | |
| + ---------------------- | |
| + -- Prepared_Query -- | |
| + ---------------------- | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + is | |
| + package DB renames Database; | |
| + | |
| + use GNATCOLL.SQL; | |
| + use GNATCOLL.SQL.Exec; | |
| + | |
| + Get_Org_Contacts_Attributes : constant SQL_Query | |
| + := SQL_Select (Fields => | |
| + DB.Contactentity_Attributes.Json & -- 0 | |
| + DB.Contactentity_Attributes.Org_Id & -- 1 | |
| + DB.Contactentity_Attributes.Ce_Id, -- 2 | |
| + Where => | |
| + DB.Contactentity_Attributes.Org_Id = | |
| + Integer_Param (1)); | |
| + | |
| + Prepared_Get_Org_Contacts_Attributes : constant Prepared_Statement | |
| + := Prepare (Query => Get_Org_Contacts_Attributes, | |
| + Auto_Complete => True, | |
| + On_Server => True, | |
| + Name => "get_org_contacts_attributes"); | |
| + begin | |
| + return Prepared_Get_Org_Contacts_Attributes; | |
| + end Prepared_Query; | |
| + | |
| + ------------------------ | |
| + -- Query_Parameters -- | |
| + ------------------------ | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + is | |
| + use GNATCOLL.SQL.Exec; | |
| + begin | |
| + return (1 => +Natural'Value (Response.Get_Org_Id_Key (Request))); | |
| + end Query_Parameters; | |
| + | |
| +end Organization_Contacts_Attributes; | |
| diff --git a/src/handlers/organization_contacts_attributes.ads b/src/handlers/organization_contacts_attributes.ads | |
| new file mode 100644 | |
| index 0000000..96d3d00 | |
| --- /dev/null | |
| +++ b/src/handlers/organization_contacts_attributes.ads | |
| @@ -0,0 +1,107 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Organization_Contacts_attributes -- | |
| +-- -- | |
| +-- SPEC -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Ada.Strings.Unbounded; | |
| +with AWS.Dispatchers.Callback; | |
| +with AWS.Status; | |
| +with Common; | |
| +with GNATCOLL.SQL.Exec; | |
| +with My_Configuration; | |
| +with Response; | |
| +with Storage; | |
| +with Yolk.Cache.String_Keys; | |
| + | |
| +package Organization_Contacts_Attributes is | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler; | |
| + -- Return a callback for the "organization_contacts" interface. | |
| + | |
| +private | |
| + | |
| + use Ada.Strings.Unbounded; | |
| + package My renames My_Configuration; | |
| + | |
| + type Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with null record; | |
| + | |
| + type Row is | |
| + record | |
| + JSON : Common.JSON_String; | |
| + Ce_Id : Natural; | |
| + Ce_Id_Column_Name : Unbounded_String; | |
| + Org_Id : Natural; | |
| + Org_Id_Column_Name : Unbounded_String; | |
| + end record; | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row; | |
| + -- Transforms the low level index based Cursor into the more readable Row | |
| + -- record. | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + with inline; | |
| + -- Return an SQL query as a prepared statement. We keep the query in a | |
| + -- function of its own to protect against using sub-queries by accident and | |
| + -- to make it more readable due to local use clauses. | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + with inline; | |
| + -- Generate the SQL parameters from given request parameters. | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + with inline; | |
| + -- Generate a JSON_String from the Row record(s) found in C and place it in | |
| + -- Value. | |
| + -- If C is empty, then Value is an empty JSON_String, ie. {}. | |
| + | |
| + package Cache is new Yolk.Cache.String_Keys | |
| + (Element_Type => Common.JSON_String, | |
| + Cleanup_Size => My.Config.Get (My.Cache_Size_Organization) + 1, | |
| + Cleanup_On_Write => True, | |
| + Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| + Reserved_Capacity => My.Config.Get (My.Cache_Size_Organization)); | |
| + -- Cache for the JSON_String generated by Create_JSON. | |
| + | |
| + package Query_To_JSON is new Storage.Generic_Query_To_JSON | |
| + (Cursor => Cursor, | |
| + Query => Prepared_Query, | |
| + JSONIFY => Create_JSON, | |
| + Write_To_Cache => Cache.Write, | |
| + Query_Parameters => Query_Parameters); | |
| + -- Turn the data found by Query and Query_Parameters into a JSON string and | |
| + -- if the JSON_String object is not empty then write it to cache. | |
| + | |
| + package JSON_Response is new Response.Generic_Response | |
| + (Check_Request_Parameters => Response.Check_Org_Id_Parameter, | |
| + Get_Cache_Key => Response.Get_Org_Id_Key, | |
| + Read_From_Cache => Cache.Read, | |
| + Query_To_JSON => Query_To_JSON); | |
| + -- Generate the AWS.Response.Data that ultimately is delivered to the user. | |
| + | |
| +end Organization_Contacts_Attributes; | |
| diff --git a/src/handlers/organization_contacts_full.adb b/src/handlers/organization_contacts_full.adb | |
| new file mode 100644 | |
| index 0000000..b62f055 | |
| --- /dev/null | |
| +++ b/src/handlers/organization_contacts_full.adb | |
| @@ -0,0 +1,207 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Organization_Contacts_Full -- | |
| +-- -- | |
| +-- BODY -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Database; | |
| +with GNATCOLL.JSON; | |
| +with Yolk.Utilities; | |
| + | |
| +package body Organization_Contacts_Full is | |
| + | |
| + ---------------- | |
| + -- Callback -- | |
| + ---------------- | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler | |
| + is | |
| + begin | |
| + return AWS.Dispatchers.Callback.Create (JSON_Response.Generate'Access); | |
| + end Callback; | |
| + | |
| + ------------------- | |
| + -- Create_JSON -- | |
| + ------------------- | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + is | |
| + use Common; | |
| + use GNATCOLL.JSON; | |
| + use Yolk.Utilities; | |
| + | |
| + Attr_DB_Columns : JSON_Value; | |
| + Attr_JSON : JSON_Value; | |
| + Contact_Array : JSON_Array; | |
| + Contact_JSON : JSON_Value; | |
| + DB_Columns : JSON_Value; | |
| + J : constant JSON_Value := Create_Object; | |
| + begin | |
| + while C.Has_Row loop | |
| + Contact_JSON := Create_Object; | |
| + DB_Columns := Create_Object; | |
| + | |
| + Contact_JSON := GNATCOLL.JSON.Read | |
| + (To_String (C.Element.JSON), | |
| + "organization_contacts_full.json.error"); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Ce_Id_Column_Name), | |
| + C.Element.Ce_Id); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Ce_Name_Column_Name), | |
| + TS (C.Element.Ce_Name)); | |
| + | |
| + DB_Columns.Set_Field (TS (C.Element.Is_Human_Column_Name), | |
| + C.Element.Is_Human); | |
| + | |
| + if C.Element.Is_Human then | |
| + Contact_JSON.Set_Field ("type", "human"); | |
| + else | |
| + Contact_JSON.Set_Field ("type", "function"); | |
| + end if; | |
| + | |
| + Contact_JSON.Set_Field ("db_columns", DB_Columns); | |
| + | |
| + Attr_JSON := Create_Object; | |
| + Attr_DB_Columns := Create_Object; | |
| + | |
| + if To_String (C.Element.Attr_JSON) /= "" then | |
| + Attr_JSON := GNATCOLL.JSON.Read | |
| + (To_String (C.Element.Attr_JSON), | |
| + "organization_contacts_full_attributes.json.error"); | |
| + | |
| + Attr_DB_Columns.Set_Field (TS (C.Element.Attr_Org_Id_Column_Name), | |
| + C.Element.Attr_Org_Id); | |
| + | |
| + Attr_DB_Columns.Set_Field (TS (C.Element.Attr_Ce_Id_Column_Name), | |
| + C.Element.Attr_Ce_Id); | |
| + | |
| + Attr_JSON.Set_Field ("db_columns", Attr_DB_Columns); | |
| + end if; | |
| + | |
| + Contact_JSON.Set_Field ("attributes", Attr_JSON); | |
| + | |
| + Append (Contact_Array, Contact_JSON); | |
| + | |
| + C.Next; | |
| + end loop; | |
| + | |
| + J.Set_Field ("contacts", Contact_Array); | |
| + | |
| + Value := To_JSON_String (J.Write); | |
| + end Create_JSON; | |
| + | |
| + --------------- | |
| + -- Element -- | |
| + --------------- | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row | |
| + is | |
| + use Common; | |
| + use Yolk.Utilities; | |
| + begin | |
| + return Row' | |
| + (JSON => To_JSON_String (C.Value (0)), | |
| + Ce_Id => C.Integer_Value (1, Default => 0), | |
| + Ce_Id_Column_Name => TUS (C.Field_Name (1)), | |
| + Ce_Name => TUS (C.Value (2)), | |
| + Ce_Name_Column_Name => TUS (C.Field_Name (2)), | |
| + Is_Human => C.Boolean_Value (3), | |
| + Is_Human_Column_Name => TUS (C.Field_Name (3)), | |
| + Attr_JSON => To_JSON_String (C.Value (4)), | |
| + Attr_Org_Id => C.Integer_Value (5, Default => 0), | |
| + Attr_Org_Id_Column_Name => TUS (C.Field_Name (5)), | |
| + Attr_Ce_Id => C.Integer_Value (6, Default => 0), | |
| + Attr_Ce_Id_Column_Name => TUS (C.Field_Name (6))); | |
| + end Element; | |
| + | |
| + ---------------------- | |
| + -- Prepared_Query -- | |
| + ---------------------- | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + is | |
| + package DB renames Database; | |
| + | |
| + use GNATCOLL.SQL; | |
| + use GNATCOLL.SQL.Exec; | |
| + | |
| + Get_Org_Contacts_Full_Join : constant SQL_Left_Join_Table | |
| + := Join (Table1 => DB.Contactentity, | |
| + Table2 => DB.Organization_Contactentities, | |
| + On => | |
| + DB.Contactentity.Ce_Id = | |
| + DB.Organization_Contactentities.Ce_Id); | |
| + | |
| + Get_Org_Contacts_Full_Left_Join : constant SQL_Left_Join_Table | |
| + := Left_Join (Full => Get_Org_Contacts_Full_Join, | |
| + Partial => DB.Contactentity_Attributes, | |
| + On => | |
| + DB.Contactentity.Ce_Id = | |
| + DB.Contactentity_Attributes.Ce_Id); | |
| + | |
| + Get_Org_Contacts_Full : constant SQL_Query | |
| + := SQL_Select (Fields => | |
| + DB.Contactentity.Json & -- 0 | |
| + DB.Contactentity.Ce_Id & -- 1 | |
| + DB.Contactentity.Ce_Name & -- 2 | |
| + DB.Contactentity.Is_Human & -- 3 | |
| + DB.Contactentity_Attributes.Json & -- 4 | |
| + DB.Contactentity_Attributes.Org_Id & -- 5 | |
| + DB.Contactentity_Attributes.Ce_Id, -- 6 | |
| + From => Get_Org_Contacts_Full_Left_Join, | |
| + Where => | |
| + DB.Organization_Contactentities.Org_Id = | |
| + Integer_Param (1) | |
| + and | |
| + (DB.Contactentity_Attributes.Org_Id = | |
| + Integer_Param (1) | |
| + or | |
| + Is_Null (DB.Contactentity_Attributes.Org_Id))); | |
| + | |
| + Prepared_Get_Org_Contacts_Full : constant Prepared_Statement | |
| + := Prepare (Query => Get_Org_Contacts_Full, | |
| + Auto_Complete => True, | |
| + On_Server => True, | |
| + Name => "get_org_contacts_full"); | |
| + begin | |
| + return Prepared_Get_Org_Contacts_Full; | |
| + end Prepared_Query; | |
| + | |
| + ------------------------ | |
| + -- Query_Parameters -- | |
| + ------------------------ | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + is | |
| + use GNATCOLL.SQL.Exec; | |
| + begin | |
| + return (1 => +Natural'Value (Response.Get_Org_Id_Key (Request))); | |
| + end Query_Parameters; | |
| + | |
| +end Organization_Contacts_Full; | |
| diff --git a/src/handlers/organization_contacts_full.ads b/src/handlers/organization_contacts_full.ads | |
| new file mode 100644 | |
| index 0000000..c779fc9 | |
| --- /dev/null | |
| +++ b/src/handlers/organization_contacts_full.ads | |
| @@ -0,0 +1,114 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Organization_Contacts_Full -- | |
| +-- -- | |
| +-- SPEC -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Ada.Strings.Unbounded; | |
| +with AWS.Dispatchers.Callback; | |
| +with AWS.Status; | |
| +with Common; | |
| +with GNATCOLL.SQL.Exec; | |
| +with My_Configuration; | |
| +with Response; | |
| +with Storage; | |
| +with Yolk.Cache.String_Keys; | |
| + | |
| +package Organization_Contacts_Full is | |
| + | |
| + function Callback | |
| + return AWS.Dispatchers.Callback.Handler; | |
| + -- Return a callback for the "organization" interface. | |
| + | |
| +private | |
| + | |
| + use Ada.Strings.Unbounded; | |
| + package My renames My_Configuration; | |
| + | |
| + type Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with null record; | |
| + | |
| + type Row is | |
| + record | |
| + JSON : Common.JSON_String; | |
| + Ce_Id : Natural; | |
| + Ce_Id_Column_Name : Unbounded_String; | |
| + Ce_Name : Unbounded_String; | |
| + Ce_Name_Column_Name : Unbounded_String; | |
| + Is_Human : Boolean; | |
| + Is_Human_Column_Name : Unbounded_String; | |
| + Attr_JSON : Common.JSON_String; | |
| + Attr_Org_Id : Natural; | |
| + Attr_Org_Id_Column_Name : Unbounded_String; | |
| + Attr_Ce_Id : Natural; | |
| + Attr_Ce_Id_Column_Name : Unbounded_String; | |
| + end record; | |
| + | |
| + function Element | |
| + (C : in Cursor) | |
| + return Row; | |
| + -- Transforms the low level index based Cursor into the more readable Row | |
| + -- record. | |
| + | |
| + function Prepared_Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement | |
| + with inline; | |
| + -- Return an SQL query as a prepared statement. We keep the query in a | |
| + -- function of its own to protect against using sub-queries by accident and | |
| + -- to make it more readable due to local use clauses. | |
| + | |
| + function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters | |
| + with inline; | |
| + -- Generate the SQL parameters from given request parameters. | |
| + | |
| + procedure Create_JSON | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String) | |
| + with inline; | |
| + -- Generate a JSON_String from the Row record(s) found in C and place it in | |
| + -- Value. | |
| + -- If C is empty, then Value is an empty JSON_String, ie. {}. | |
| + | |
| + package Cache is new Yolk.Cache.String_Keys | |
| + (Element_Type => Common.JSON_String, | |
| + Cleanup_Size => My.Config.Get (My.Cache_Size_Organization) + 1, | |
| + Cleanup_On_Write => True, | |
| + Max_Element_Age => My.Config.Get (My.Cache_Max_Element_Age), | |
| + Reserved_Capacity => My.Config.Get (My.Cache_Size_Organization)); | |
| + -- Cache for the JSON_String generated by Create_JSON. | |
| + | |
| + package Query_To_JSON is new Storage.Generic_Query_To_JSON | |
| + (Cursor => Cursor, | |
| + Query => Prepared_Query, | |
| + JSONIFY => Create_JSON, | |
| + Write_To_Cache => Cache.Write, | |
| + Query_Parameters => Query_Parameters); | |
| + -- Turn the data found by Query and Query_Parameters into a JSON string and | |
| + -- if the JSON_String object is not empty then write it to cache. | |
| + | |
| + package JSON_Response is new Response.Generic_Response | |
| + (Check_Request_Parameters => Response.Check_Org_Id_Parameter, | |
| + Get_Cache_Key => Response.Get_Org_Id_Key, | |
| + Read_From_Cache => Cache.Read, | |
| + Query_To_JSON => Query_To_JSON); | |
| + -- Generate the AWS.Response.Data that ultimately is delivered to the user. | |
| + | |
| +end Organization_Contacts_Full; | |
| diff --git a/src/http_codes.ads b/src/http_codes.ads | |
| new file mode 100644 | |
| index 0000000..5b92c6f | |
| --- /dev/null | |
| +++ b/src/http_codes.ads | |
| @@ -0,0 +1,39 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- HTTP_Codes -- | |
| +-- -- | |
| +-- SPEC -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with AWS.Messages; | |
| + | |
| +package HTTP_Codes is | |
| + | |
| + OK : constant AWS.Messages.Status_Code := AWS.Messages.S200; | |
| + | |
| + Bad_Request : constant AWS.Messages.Status_Code := AWS.Messages.S400; | |
| + Unauthorized : constant AWS.Messages.Status_Code := AWS.Messages.S401; | |
| + Forbidden : constant AWS.Messages.Status_Code := AWS.Messages.S403; | |
| + Not_Found : constant AWS.Messages.Status_Code := AWS.Messages.S404; | |
| + | |
| + Internal_Server_Error : constant AWS.Messages.Status_Code | |
| + := AWS.Messages.S500; | |
| + Server_Error : constant AWS.Messages.Status_Code := Internal_Server_Error; | |
| + | |
| +end HTTP_Codes; | |
| diff --git a/src/jsonify.adb b/src/jsonify.adb | |
| deleted file mode 100644 | |
| index 4a227c9..0000000 | |
| --- a/src/jsonify.adb | |
| +++ /dev/null | |
| @@ -1,382 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- JSONIFY -- | |
| --- -- | |
| --- BODY -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -with GNATCOLL.JSON; | |
| -with Yolk.Utilities; | |
| - | |
| -package body JSONIFY is | |
| - | |
| - --------------- | |
| - -- Contact -- | |
| - --------------- | |
| - | |
| - procedure Contact | |
| - (C : in Storage.Queries.Contact_Cursor; | |
| - Value : in out Common.JSON_Small.Bounded_String) | |
| - is | |
| - use Common; | |
| - use GNATCOLL.JSON; | |
| - use Yolk.Utilities; | |
| - | |
| - DB_Columns : JSON_Value; | |
| - J : JSON_Value := Create_Object; | |
| - begin | |
| - if C.Has_Row then | |
| - DB_Columns := Create_Object; | |
| - | |
| - J := GNATCOLL.JSON.Read (TS (C.Element.JSON), "json.error"); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Ce_Id.Name), | |
| - C.Element.Ce_Id.Value); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Ce_Name.Name), | |
| - C.Element.Ce_Name.Value); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Is_Human.Name), | |
| - C.Element.Is_Human.Value); | |
| - | |
| - if C.Element.Is_Human.Value then | |
| - J.Set_Field ("type", "human"); | |
| - else | |
| - J.Set_Field ("type", "function"); | |
| - end if; | |
| - | |
| - J.Set_Field ("db_columns", DB_Columns); | |
| - end if; | |
| - | |
| - Value := JSON_Small.To_Bounded_String (J.Write); | |
| - end Contact; | |
| - | |
| - -------------------------- | |
| - -- Contact_Attributes -- | |
| - -------------------------- | |
| - | |
| - procedure Contact_Attributes | |
| - (C : in out Storage.Queries.Contact_Attributes_Cursor; | |
| - Value : in out Common.JSON_Small.Bounded_String) | |
| - is | |
| - use Common; | |
| - use GNATCOLL.JSON; | |
| - use Yolk.Utilities; | |
| - | |
| - Attr_Array : JSON_Array; | |
| - DB_Columns : JSON_Value; | |
| - DB_JSON : JSON_Value; | |
| - J : constant JSON_Value := Create_Object; | |
| - begin | |
| - while C.Has_Row loop | |
| - DB_Columns := Create_Object; | |
| - DB_JSON := Create_Object; | |
| - | |
| - DB_JSON := GNATCOLL.JSON.Read (TS (C.Element.JSON), | |
| - "db_json.json.error"); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Ce_Id.Name), | |
| - C.Element.Ce_Id.Value); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Org_Id.Name), | |
| - C.Element.Org_Id.Value); | |
| - | |
| - DB_JSON.Set_Field ("db_columns", DB_Columns); | |
| - | |
| - Append (Attr_Array, DB_JSON); | |
| - | |
| - C.Next; | |
| - end loop; | |
| - | |
| - J.Set_Field ("attributes", Attr_Array); | |
| - | |
| - Value := JSON_Small.To_Bounded_String (J.Write); | |
| - end Contact_Attributes; | |
| - | |
| - -------------------- | |
| - -- Contact_Full -- | |
| - -------------------- | |
| - | |
| - procedure Contact_Full | |
| - (C : in out Storage.Queries.Contact_Full_Cursor; | |
| - Value : in out Common.JSON_Small.Bounded_String) | |
| - is | |
| - use Common; | |
| - use GNATCOLL.JSON; | |
| - use Yolk.Utilities; | |
| - | |
| - Attr_Array : JSON_Array; | |
| - Attr_DB_Columns : JSON_Value; | |
| - Attr_JSON : JSON_Value; | |
| - DB_Columns : JSON_Value; | |
| - J : JSON_Value := Create_Object; | |
| - begin | |
| - if C.Has_Row then | |
| - -- Cursor can contain more than one row, so we start by building the | |
| - -- main JSON object from the first row, so we don't repeat the JSON | |
| - -- building code for the same data over and over. | |
| - DB_Columns := Create_Object; | |
| - | |
| - J := GNATCOLL.JSON.Read (TS (C.Element.JSON), "json.error"); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Ce_Id.Name), | |
| - C.Element.Ce_Id.Value); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Ce_Name.Name), | |
| - C.Element.Ce_Name.Value); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Is_Human.Name), | |
| - C.Element.Is_Human.Value); | |
| - | |
| - if C.Element.Is_Human.Value then | |
| - J.Set_Field ("type", "human"); | |
| - else | |
| - J.Set_Field ("type", "function"); | |
| - end if; | |
| - | |
| - J.Set_Field ("db_columns", DB_Columns); | |
| - | |
| - while C.Has_Row loop | |
| - if TS (C.Element.Attr_JSON) /= "" then | |
| - Attr_JSON := Create_Object; | |
| - Attr_DB_Columns := Create_Object; | |
| - | |
| - Attr_JSON := GNATCOLL.JSON.Read (TS (C.Element.Attr_JSON), | |
| - "attr.json.error"); | |
| - | |
| - Attr_DB_Columns.Set_Field (TS (C.Element.Attr_Org_Id.Name), | |
| - C.Element.Attr_Org_Id.Value); | |
| - | |
| - Attr_DB_Columns.Set_Field (TS (C.Element.Attr_Ce_Id.Name), | |
| - C.Element.Attr_Ce_Id.Value); | |
| - | |
| - Attr_JSON.Set_Field ("db_columns", Attr_DB_Columns); | |
| - | |
| - Append (Attr_Array, Attr_JSON); | |
| - end if; | |
| - | |
| - C.Next; | |
| - end loop; | |
| - | |
| - J.Set_Field ("attributes", Attr_Array); | |
| - end if; | |
| - | |
| - Value := JSON_Small.To_Bounded_String (J.Write); | |
| - end Contact_Full; | |
| - | |
| - -------------------- | |
| - -- Org_Contacts -- | |
| - -------------------- | |
| - | |
| - procedure Org_Contacts | |
| - (C : in out Storage.Queries.Org_Contacts_Cursor; | |
| - Value : in out Common.JSON_Large.Bounded_String) | |
| - is | |
| - use Common; | |
| - use GNATCOLL.JSON; | |
| - use Yolk.Utilities; | |
| - | |
| - Contact_Array : JSON_Array; | |
| - DB_Columns : JSON_Value; | |
| - DB_JSON : JSON_Value; | |
| - J : constant JSON_Value := Create_Object; | |
| - begin | |
| - while C.Has_Row loop | |
| - DB_Columns := Create_Object; | |
| - DB_JSON := Create_Object; | |
| - | |
| - DB_JSON := GNATCOLL.JSON.Read (TS (C.Element.JSON), | |
| - "db_json.json.error"); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Ce_Id.Name), | |
| - C.Element.Ce_Id.Value); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Ce_Name.Name), | |
| - C.Element.Ce_Name.Value); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Is_Human.Name), | |
| - C.Element.Is_Human.Value); | |
| - | |
| - if C.Element.Is_Human.Value then | |
| - DB_JSON.Set_Field ("type", "human"); | |
| - else | |
| - DB_JSON.Set_Field ("type", "function"); | |
| - end if; | |
| - | |
| - DB_JSON.Set_Field ("db_columns", DB_Columns); | |
| - | |
| - Append (Contact_Array, DB_JSON); | |
| - | |
| - C.Next; | |
| - end loop; | |
| - | |
| - J.Set_Field ("contacts", Contact_Array); | |
| - | |
| - Value := JSON_Large.To_Bounded_String (J.Write); | |
| - end Org_Contacts; | |
| - | |
| - ------------------------------- | |
| - -- Org_Contacts_Attributes -- | |
| - ------------------------------- | |
| - | |
| - procedure Org_Contacts_Attributes | |
| - (C : in out Storage.Queries.Org_Contacts_Attributes_Cursor; | |
| - Value : in out Common.JSON_Large.Bounded_String) | |
| - is | |
| - use Common; | |
| - use GNATCOLL.JSON; | |
| - use Yolk.Utilities; | |
| - | |
| - Attr_Array : JSON_Array; | |
| - DB_Columns : JSON_Value; | |
| - DB_JSON : JSON_Value; | |
| - J : constant JSON_Value := Create_Object; | |
| - begin | |
| - while C.Has_Row loop | |
| - DB_Columns := Create_Object; | |
| - DB_JSON := Create_Object; | |
| - | |
| - DB_JSON := GNATCOLL.JSON.Read (TS (C.Element.JSON), | |
| - "db_json.json.error"); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Ce_Id.Name), | |
| - C.Element.Ce_Id.Value); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Org_Id.Name), | |
| - C.Element.Org_Id.Value); | |
| - | |
| - DB_JSON.Set_Field ("db_columns", DB_Columns); | |
| - | |
| - Append (Attr_Array, DB_JSON); | |
| - | |
| - C.Next; | |
| - end loop; | |
| - | |
| - J.Set_Field ("attributes", Attr_Array); | |
| - | |
| - Value := JSON_Large.To_Bounded_String (J.Write); | |
| - end Org_Contacts_Attributes; | |
| - | |
| - ------------------------- | |
| - -- Org_Contacts_Full -- | |
| - ------------------------- | |
| - | |
| - procedure Org_Contacts_Full | |
| - (C : in out Storage.Queries.Org_Contacts_Full_Cursor; | |
| - Value : in out Common.JSON_Large.Bounded_String) | |
| - is | |
| - use Common; | |
| - use GNATCOLL.JSON; | |
| - use Yolk.Utilities; | |
| - | |
| - Attr_DB_Columns : JSON_Value; | |
| - Attr_JSON : JSON_Value; | |
| - Contact_Array : JSON_Array; | |
| - Contact_JSON : JSON_Value; | |
| - DB_Columns : JSON_Value; | |
| - J : constant JSON_Value := Create_Object; | |
| - begin | |
| - while C.Has_Row loop | |
| - Contact_JSON := Create_Object; | |
| - DB_Columns := Create_Object; | |
| - | |
| - Contact_JSON := GNATCOLL.JSON.Read (TS (C.Element.JSON), | |
| - "contact_json.json.error"); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Ce_Id.Name), | |
| - C.Element.Ce_Id.Value); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Ce_Name.Name), | |
| - TS (C.Element.Ce_Name.Value)); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Is_Human.Name), | |
| - C.Element.Is_Human.Value); | |
| - | |
| - if C.Element.Is_Human.Value then | |
| - Contact_JSON.Set_Field ("type", "human"); | |
| - else | |
| - Contact_JSON.Set_Field ("type", "function"); | |
| - end if; | |
| - | |
| - Contact_JSON.Set_Field ("db_columns", DB_Columns); | |
| - | |
| - Attr_JSON := Create_Object; | |
| - Attr_DB_Columns := Create_Object; | |
| - | |
| - if TS (C.Element.Attr_JSON) /= "" then | |
| - Attr_JSON := GNATCOLL.JSON.Read (TS (C.Element.Attr_JSON), | |
| - "attr.json.error"); | |
| - | |
| - Attr_DB_Columns.Set_Field (TS (C.Element.Attr_Org_Id.Name), | |
| - C.Element.Attr_Org_Id.Value); | |
| - | |
| - Attr_DB_Columns.Set_Field (TS (C.Element.Attr_Ce_Id.Name), | |
| - C.Element.Attr_Ce_Id.Value); | |
| - | |
| - Attr_JSON.Set_Field ("db_columns", Attr_DB_Columns); | |
| - end if; | |
| - | |
| - Contact_JSON.Set_Field ("attributes", Attr_JSON); | |
| - | |
| - Append (Contact_Array, Contact_JSON); | |
| - | |
| - C.Next; | |
| - end loop; | |
| - | |
| - J.Set_Field ("contacts", Contact_Array); | |
| - | |
| - Value := JSON_Large.To_Bounded_String (J.Write); | |
| - end Org_Contacts_Full; | |
| - | |
| - -------------------- | |
| - -- Organization -- | |
| - -------------------- | |
| - | |
| - procedure Organization | |
| - (C : in Storage.Queries.Organization_Cursor; | |
| - Value : in out Common.JSON_Small.Bounded_String) | |
| - is | |
| - use Common; | |
| - use GNATCOLL.JSON; | |
| - use Yolk.Utilities; | |
| - | |
| - DB_Columns : JSON_Value; | |
| - J : JSON_Value := Create_Object; | |
| - begin | |
| - if C.Has_Row then | |
| - DB_Columns := Create_Object; | |
| - | |
| - J := GNATCOLL.JSON.Read (TS (C.Element.JSON), "json.error"); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Org_Id.Name), | |
| - C.Element.Org_Id.Value); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Org_Name.Name), | |
| - TS (C.Element.Org_Name.Value)); | |
| - | |
| - DB_Columns.Set_Field (TS (C.Element.Identifier.Name), | |
| - TS (C.Element.Identifier.Value)); | |
| - | |
| - J.Set_Field ("db_columns", DB_Columns); | |
| - end if; | |
| - | |
| - Value := JSON_Small.To_Bounded_String (J.Write); | |
| - end Organization; | |
| - | |
| -end JSONIFY; | |
| diff --git a/src/jsonify.ads b/src/jsonify.ads | |
| deleted file mode 100644 | |
| index c4a62e0..0000000 | |
| --- a/src/jsonify.ads | |
| +++ /dev/null | |
| @@ -1,64 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- JSONIFY -- | |
| --- -- | |
| --- SPEC -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -with Common; | |
| -with Storage.Queries; | |
| - | |
| -package JSONIFY is | |
| - | |
| - procedure Contact | |
| - (C : in Storage.Queries.Contact_Cursor; | |
| - Value : in out Common.JSON_Small.Bounded_String); | |
| - -- TODO: Write comment | |
| - | |
| - procedure Contact_Attributes | |
| - (C : in out Storage.Queries.Contact_Attributes_Cursor; | |
| - Value : in out Common.JSON_Small.Bounded_String); | |
| - -- TODO: Write comment | |
| - | |
| - procedure Contact_Full | |
| - (C : in out Storage.Queries.Contact_Full_Cursor; | |
| - Value : in out Common.JSON_Small.Bounded_String); | |
| - -- TODO: Write comment | |
| - | |
| - procedure Org_Contacts | |
| - (C : in out Storage.Queries.Org_Contacts_Cursor; | |
| - Value : in out Common.JSON_Large.Bounded_String); | |
| - -- TODO: Write comment | |
| - | |
| - procedure Org_Contacts_Attributes | |
| - (C : in out Storage.Queries.Org_Contacts_Attributes_Cursor; | |
| - Value : in out Common.JSON_Large.Bounded_String); | |
| - -- TODO: Write comment | |
| - | |
| - procedure Org_Contacts_Full | |
| - (C : in out Storage.Queries.Org_Contacts_Full_Cursor; | |
| - Value : in out Common.JSON_Large.Bounded_String); | |
| - -- TODO: Write comment | |
| - | |
| - procedure Organization | |
| - (C : in Storage.Queries.Organization_Cursor; | |
| - Value : in out Common.JSON_Small.Bounded_String); | |
| - -- TODO: Write comment | |
| - | |
| -end JSONIFY; | |
| diff --git a/src/my_configuration.ads b/src/my_configuration.ads | |
| index 8f6318c..a8c0279 100644 | |
| --- a/src/my_configuration.ads | |
| +++ b/src/my_configuration.ads | |
| @@ -46,14 +46,12 @@ package My_Configuration is | |
| Handler_Get_Contact, | |
| Handler_Get_Contact_Attributes, | |
| Handler_Get_Contact_Full, | |
| - Handler_Get_Org_Contacts, | |
| - Handler_Get_Org_Contacts_Attributes, | |
| - Handler_Get_Org_Contacts_Full, | |
| + Handler_Get_Organization_Contacts, | |
| + Handler_Get_Organization_Contacts_Attributes, | |
| + Handler_Get_Organization_Contacts_Full, | |
| Handler_Get_Organization, | |
| Handler_Get_Queue, | |
| - Handler_Get_Queue_Length, | |
| - JSON_Size_Large, | |
| - JSON_Size_Small); | |
| + Handler_Get_Queue_Length); | |
| type Defaults_Array is array (Keys) of | |
| Ada.Strings.Unbounded.Unbounded_String; | |
| @@ -93,22 +91,18 @@ package My_Configuration is | |
| => Util.TUS ("/get/contact_attributes"), | |
| Handler_Get_Contact_Full | |
| => Util.TUS ("/get/contact_full"), | |
| - Handler_Get_Org_Contacts | |
| - => Util.TUS ("/get/org_contacts"), | |
| - Handler_Get_Org_Contacts_Attributes | |
| - => Util.TUS ("/get/org_contacts_attributes"), | |
| - Handler_Get_Org_Contacts_Full | |
| - => Util.TUS ("/get/org_contacts_full"), | |
| + Handler_Get_Organization_Contacts | |
| + => Util.TUS ("/get/organization_contacts"), | |
| + Handler_Get_Organization_Contacts_Attributes | |
| + => Util.TUS ("/get/organization_contacts_attributes"), | |
| + Handler_Get_Organization_Contacts_Full | |
| + => Util.TUS ("/get/organization_contacts_full"), | |
| Handler_Get_Organization | |
| => Util.TUS ("/get/organization"), | |
| Handler_Get_Queue | |
| => Util.TUS ("/get/queue"), | |
| Handler_Get_Queue_Length | |
| - => Util.TUS ("/get/queue_length"), | |
| - JSON_Size_Large | |
| - => Util.TUS ("100_000"), | |
| - JSON_Size_Small | |
| - => Util.TUS ("10_000")); | |
| + => Util.TUS ("/get/queue_length")); | |
| package Config is new Yolk.Config_File_Parser | |
| (Key_Type => Keys, | |
| diff --git a/src/my_handlers.adb b/src/my_handlers.adb | |
| index 738f25c..b987469 100644 | |
| --- a/src/my_handlers.adb | |
| +++ b/src/my_handlers.adb | |
| @@ -22,8 +22,15 @@ | |
| ------------------------------------------------------------------------------- | |
| with AWS.Dispatchers.Callback; | |
| +with Call_Queue; | |
| +with Contact; | |
| +with Contact_Attributes; | |
| +with Contact_Full; | |
| with My_Configuration; | |
| -with Request; | |
| +with Organization; | |
| +with Organization_Contacts; | |
| +with Organization_Contacts_Attributes; | |
| +with Organization_Contacts_Full; | |
| with Yolk.Not_Found; | |
| package body My_Handlers is | |
| @@ -36,7 +43,6 @@ package body My_Handlers is | |
| (RH : out AWS.Services.Dispatchers.URI.Handler) | |
| is | |
| use AWS.Dispatchers.Callback; | |
| - -- use Yolk; | |
| package My renames My_Configuration; | |
| begin | |
| @@ -64,61 +70,56 @@ package body My_Handlers is | |
| (Dispatcher => RH, | |
| URI => My.Config.Get (My.Handler_Get_Call), | |
| Action => Create | |
| - (Callback => Request.Call'Access)); | |
| + (Callback => Call_Queue.Get_Call'Access)); | |
| AWS.Services.Dispatchers.URI.Register | |
| (Dispatcher => RH, | |
| URI => My.Config.Get (My.Handler_Get_Contact), | |
| - Action => Create | |
| - (Callback => Request.Contact'Access)); | |
| + Action => Contact.Callback); | |
| AWS.Services.Dispatchers.URI.Register | |
| (Dispatcher => RH, | |
| URI => My.Config.Get (My.Handler_Get_Contact_Attributes), | |
| - Action => Create | |
| - (Callback => Request.Contact_Attributes'Access)); | |
| + Action => Contact_Attributes.Callback); | |
| AWS.Services.Dispatchers.URI.Register | |
| (Dispatcher => RH, | |
| URI => My.Config.Get (My.Handler_Get_Contact_Full), | |
| - Action => Create | |
| - (Callback => Request.Contact_Full'Access)); | |
| + Action => Contact_Full.Callback); | |
| AWS.Services.Dispatchers.URI.Register | |
| (Dispatcher => RH, | |
| - URI => My.Config.Get (My.Handler_Get_Org_Contacts), | |
| - Action => Create | |
| - (Callback => Request.Org_Contacts'Access)); | |
| + URI => My.Config.Get (My.Handler_Get_Organization_Contacts), | |
| + Action => Organization_Contacts.Callback); | |
| AWS.Services.Dispatchers.URI.Register | |
| (Dispatcher => RH, | |
| - URI => My.Config.Get (My.Handler_Get_Org_Contacts_Attributes), | |
| - Action => Create | |
| - (Callback => Request.Org_Contacts_Attributes'Access)); | |
| + URI => My.Config.Get | |
| + (My.Handler_Get_Organization_Contacts_Attributes), | |
| + Action => Organization_Contacts_Attributes.Callback); | |
| AWS.Services.Dispatchers.URI.Register | |
| (Dispatcher => RH, | |
| - URI => My.Config.Get (My.Handler_Get_Org_Contacts_Full), | |
| - Action => Create | |
| - (Callback => Request.Org_Contacts_Full'Access)); | |
| + URI => My.Config.Get | |
| + (My.Handler_Get_Organization_Contacts_Full), | |
| + Action => Organization_Contacts_Full.Callback); | |
| AWS.Services.Dispatchers.URI.Register | |
| (Dispatcher => RH, | |
| URI => My.Config.Get (My.Handler_Get_Organization), | |
| - Action => Create | |
| - (Callback => Request.Organization'Access)); | |
| + Action => Organization.Callback); | |
| AWS.Services.Dispatchers.URI.Register | |
| (Dispatcher => RH, | |
| URI => My.Config.Get (My.Handler_Get_Queue), | |
| Action => Create | |
| - (Callback => Request.Queue'Access)); | |
| + (Callback => Call_Queue.Get'Access)); | |
| AWS.Services.Dispatchers.URI.Register | |
| (Dispatcher => RH, | |
| URI => My.Config.Get (My.Handler_Get_Queue_Length), | |
| Action => Create | |
| - (Callback => Request.Queue_Length'Access)); | |
| + (Callback => Call_Queue.Get_Queue_Length'Access)); | |
| end Set; | |
| end My_Handlers; | |
| diff --git a/src/request.adb b/src/request.adb | |
| deleted file mode 100644 | |
| index 97c24e6..0000000 | |
| --- a/src/request.adb | |
| +++ /dev/null | |
| @@ -1,527 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- Request -- | |
| --- -- | |
| --- BODY -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -with Ada.Strings.Fixed; | |
| -with AWS.Messages; | |
| -with AWS.Parameters; | |
| -with AWS.Response.Set; | |
| -with AWS.URL; | |
| -with AWS.Utils; | |
| -with Cache; | |
| -with Call_Queue; | |
| -with Common; | |
| -with Errors; | |
| -with Storage.Read; | |
| - | |
| -package body Request is | |
| - | |
| - JSON_MIME_Type : constant String := "application/json; charset=utf-8"; | |
| - | |
| - function Build_JSON_Response | |
| - (Request : in AWS.Status.Data; | |
| - Content : in String) | |
| - return AWS.Response.Data; | |
| - -- Build the response and compress it if the client supports it. Also wraps | |
| - -- JSON string in foo(JSON string) if the | |
| - -- ?jsoncallback=foo | |
| - -- GET parameter is present. | |
| - | |
| - procedure Add_CORS_Headers | |
| - (Request : in AWS.Status.Data; | |
| - Response : in out AWS.Response.Data); | |
| - -- If the client sends the Origin: header, add these two CORS headers: | |
| - -- Access-Control-Allow-Origin | |
| - -- Access-Control-Allow-Credentials | |
| - -- where the first one should contain the value of the given Origin: header | |
| - -- and the second a Boolean True. This should be enough to enable very | |
| - -- simple CORS support in Alice. | |
| - | |
| - function Add_JSONP_Callback | |
| - (Content : in String; | |
| - Request : in AWS.Status.Data) | |
| - return String; | |
| - -- Wrap Content in jsoncallback(Content) if the jsoncallback parameter | |
| - -- is given in the Request. jsonpcallback is replaced with the actual value | |
| - -- of the jsoncallback parameter. | |
| - -- NOTE: | |
| - -- We do not support the callback parameter. It is too generic. | |
| - | |
| - ------------------------ | |
| - -- Add_CORS_Headers -- | |
| - ------------------------ | |
| - | |
| - procedure Add_CORS_Headers | |
| - (Request : in AWS.Status.Data; | |
| - Response : in out AWS.Response.Data) | |
| - is | |
| - use AWS.Messages; | |
| - use AWS.Response; | |
| - use AWS.Status; | |
| - | |
| - Origin_Host : constant String := Origin (Request); | |
| - begin | |
| - if Origin_Host'Length > 0 then | |
| - Set.Add_Header (D => Response, | |
| - Name => Access_Control_Allow_Origin_Token, | |
| - Value => Origin_Host); | |
| - | |
| - Set.Add_Header (D => Response, | |
| - Name => Access_Control_Allow_Credentials_Token, | |
| - Value => "true"); | |
| - end if; | |
| - end Add_CORS_Headers; | |
| - | |
| - -------------------------- | |
| - -- Add_JSONP_Callback -- | |
| - -------------------------- | |
| - | |
| - function Add_JSONP_Callback | |
| - (Content : in String; | |
| - Request : in AWS.Status.Data) | |
| - return String | |
| - is | |
| - use Ada.Strings; | |
| - use AWS.Status; | |
| - | |
| - P : constant AWS.Parameters.List := Parameters (Request); | |
| - JSON_Callback : constant String := | |
| - Fixed.Trim (P.Get ("jsoncallback"), Both); | |
| - begin | |
| - if JSON_Callback'Length > 0 then | |
| - return JSON_Callback & "(" & Content & ")"; | |
| - end if; | |
| - | |
| - return Content; | |
| - end Add_JSONP_Callback; | |
| - | |
| - --------------------------- | |
| - -- Build_JSON_Response -- | |
| - --------------------------- | |
| - | |
| - function Build_JSON_Response | |
| - (Request : in AWS.Status.Data; | |
| - Content : in String) | |
| - return AWS.Response.Data | |
| - is | |
| - use AWS.Messages; | |
| - use AWS.Response; | |
| - use AWS.Status; | |
| - | |
| - D : AWS.Response.Data; | |
| - Encoding : constant Content_Encoding := Preferred_Coding (Request); | |
| - begin | |
| - D := Build (Content_Type => JSON_MIME_Type, | |
| - Message_Body => Add_JSONP_Callback (Content, Request), | |
| - Encoding => Encoding, | |
| - Cache_Control => No_Cache); | |
| - | |
| - Add_CORS_Headers (Request, D); | |
| - | |
| - return D; | |
| - end Build_JSON_Response; | |
| - | |
| - ------------ | |
| - -- Call -- | |
| - ------------ | |
| - | |
| - function Call | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data | |
| - is | |
| - use AWS.Status; | |
| - use AWS.URL; | |
| - use Errors; | |
| - | |
| - P : constant AWS.Parameters.List := Parameters (Request); | |
| - Id : constant String := P.Get ("id"); | |
| - begin | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => Call_Queue.Get_Call (Id)); | |
| - | |
| - exception | |
| - when Event : others => | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => Exception_Handler | |
| - (Event => Event, | |
| - Message => "Requested resource: " & URL (URI (Request)))); | |
| - end Call; | |
| - | |
| - --------------- | |
| - -- Contact -- | |
| - --------------- | |
| - | |
| - function Contact | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data | |
| - is | |
| - use AWS.Status; | |
| - use AWS.URL; | |
| - use AWS.Utils; | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - | |
| - P : constant AWS.Parameters.List := Parameters (Request); | |
| - Ce_Id : constant String := P.Get ("ce_id"); | |
| - | |
| - Valid : Boolean := False; | |
| - Value : JSON_Small.Bounded_String; | |
| - begin | |
| - Contact_Cache.Read (Key => Ce_Id, | |
| - Is_Valid => Valid, | |
| - Value => Value); | |
| - | |
| - if not Valid then | |
| - if not Is_Number (Ce_Id) then | |
| - raise GET_Parameter_Error with | |
| - "ce_id must be a valid natural integer"; | |
| - end if; | |
| - | |
| - Value := Storage.Read.Get_Contact (Ce_Id); | |
| - end if; | |
| - | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => JSON_Small.To_String (Value)); | |
| - | |
| - exception | |
| - when Event : others => | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => Exception_Handler | |
| - (Event => Event, | |
| - Message => "Requested resource: " & URL (URI (Request)))); | |
| - end Contact; | |
| - | |
| - -------------------------- | |
| - -- Contact_Attributes -- | |
| - -------------------------- | |
| - | |
| - function Contact_Attributes | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data | |
| - is | |
| - use AWS.Status; | |
| - use AWS.URL; | |
| - use AWS.Utils; | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - | |
| - P : constant AWS.Parameters.List := Parameters (Request); | |
| - Ce_Id : constant String := P.Get ("ce_id"); | |
| - | |
| - Valid : Boolean := False; | |
| - Value : JSON_Small.Bounded_String; | |
| - begin | |
| - Contact_Attributes_Cache.Read (Key => Ce_Id, | |
| - Is_Valid => Valid, | |
| - Value => Value); | |
| - | |
| - if not Valid then | |
| - if not Is_Number (Ce_Id) then | |
| - raise GET_Parameter_Error with | |
| - "ce_id must be a valid natural integer"; | |
| - end if; | |
| - | |
| - Value := Storage.Read.Get_Contact_Attributes (Ce_Id); | |
| - end if; | |
| - | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => JSON_Small.To_String (Value)); | |
| - | |
| - exception | |
| - when Event : others => | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => Exception_Handler | |
| - (Event => Event, | |
| - Message => "Requested resource: " & URL (URI (Request)))); | |
| - end Contact_Attributes; | |
| - | |
| - -------------------- | |
| - -- Contact_Full -- | |
| - -------------------- | |
| - | |
| - function Contact_Full | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data | |
| - is | |
| - use AWS.Status; | |
| - use AWS.URL; | |
| - use AWS.Utils; | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - | |
| - P : constant AWS.Parameters.List := Parameters (Request); | |
| - Ce_Id : constant String := P.Get ("ce_id"); | |
| - | |
| - Valid : Boolean := False; | |
| - Value : JSON_Small.Bounded_String; | |
| - begin | |
| - Contact_Full_Cache.Read (Key => Ce_Id, | |
| - Is_Valid => Valid, | |
| - Value => Value); | |
| - | |
| - if not Valid then | |
| - if not Is_Number (Ce_Id) then | |
| - raise GET_Parameter_Error with | |
| - "ce_id must be a valid natural integer"; | |
| - end if; | |
| - | |
| - Value := Storage.Read.Get_Contact_Full (Ce_Id); | |
| - end if; | |
| - | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => JSON_Small.To_String (Value)); | |
| - | |
| - exception | |
| - when Event : others => | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => Exception_Handler | |
| - (Event => Event, | |
| - Message => "Requested resource: " & URL (URI (Request)))); | |
| - end Contact_Full; | |
| - | |
| - -------------------- | |
| - -- Org_Contacts -- | |
| - -------------------- | |
| - | |
| - function Org_Contacts | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data | |
| - is | |
| - use AWS.Status; | |
| - use AWS.URL; | |
| - use AWS.Utils; | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - | |
| - P : constant AWS.Parameters.List := Parameters (Request); | |
| - Org_Id : constant String := P.Get ("org_id"); | |
| - | |
| - Valid : Boolean := False; | |
| - Value : JSON_Large.Bounded_String; | |
| - begin | |
| - Org_Contacts_Cache.Read (Key => Org_Id, | |
| - Is_Valid => Valid, | |
| - Value => Value); | |
| - | |
| - if not Valid then | |
| - if not Is_Number (Org_Id) then | |
| - raise GET_Parameter_Error with | |
| - "org_id must be a valid natural integer"; | |
| - end if; | |
| - | |
| - Value := Storage.Read.Get_Org_Contacts (Org_Id); | |
| - end if; | |
| - | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => JSON_Large.To_String (Value)); | |
| - | |
| - exception | |
| - when Event : others => | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => Exception_Handler | |
| - (Event => Event, | |
| - Message => "Requested resource: " & URL (URI (Request)))); | |
| - end Org_Contacts; | |
| - | |
| - ------------------------------- | |
| - -- Org_Contacts_Attributes -- | |
| - ------------------------------- | |
| - | |
| - function Org_Contacts_Attributes | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data | |
| - is | |
| - use AWS.Status; | |
| - use AWS.URL; | |
| - use AWS.Utils; | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - | |
| - P : constant AWS.Parameters.List := Parameters (Request); | |
| - Org_Id : constant String := P.Get ("org_id"); | |
| - | |
| - Valid : Boolean := False; | |
| - Value : JSON_Large.Bounded_String; | |
| - begin | |
| - Org_Contacts_Attributes_Cache.Read (Key => Org_Id, | |
| - Is_Valid => Valid, | |
| - Value => Value); | |
| - | |
| - if not Valid then | |
| - if not Is_Number (Org_Id) then | |
| - raise GET_Parameter_Error with | |
| - "org_id must be a valid natural integer"; | |
| - end if; | |
| - | |
| - Value := Storage.Read.Get_Org_Contacts_Attributes (Org_Id); | |
| - end if; | |
| - | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => JSON_Large.To_String (Value)); | |
| - | |
| - exception | |
| - when Event : others => | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => Exception_Handler | |
| - (Event => Event, | |
| - Message => "Requested resource: " & URL (URI (Request)))); | |
| - end Org_Contacts_Attributes; | |
| - | |
| - ------------------------- | |
| - -- Org_Contacts_Full -- | |
| - ------------------------- | |
| - | |
| - function Org_Contacts_Full | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data | |
| - is | |
| - use AWS.Status; | |
| - use AWS.URL; | |
| - use AWS.Utils; | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - | |
| - P : constant AWS.Parameters.List := Parameters (Request); | |
| - Org_Id : constant String := P.Get ("org_id"); | |
| - | |
| - Valid : Boolean := False; | |
| - Value : JSON_Large.Bounded_String; | |
| - begin | |
| - Org_Contacts_Full_Cache.Read (Key => Org_Id, | |
| - Is_Valid => Valid, | |
| - Value => Value); | |
| - | |
| - if not Valid then | |
| - if not Is_Number (Org_Id) then | |
| - raise GET_Parameter_Error with | |
| - "org_id must be a valid natural integer"; | |
| - end if; | |
| - | |
| - Value := Storage.Read.Get_Org_Contacts_Full (Org_Id); | |
| - end if; | |
| - | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => JSON_Large.To_String (Value)); | |
| - | |
| - exception | |
| - when Event : others => | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => Exception_Handler | |
| - (Event => Event, | |
| - Message => "Requested resource: " & URL (URI (Request)))); | |
| - end Org_Contacts_Full; | |
| - | |
| - -------------------- | |
| - -- Organization -- | |
| - -------------------- | |
| - | |
| - function Organization | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data | |
| - is | |
| - use AWS.Status; | |
| - use AWS.URL; | |
| - use AWS.Utils; | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - | |
| - P : constant AWS.Parameters.List := Parameters (Request); | |
| - Org_Id : constant String := P.Get ("org_id"); | |
| - | |
| - Valid : Boolean := False; | |
| - Value : JSON_Small.Bounded_String; | |
| - begin | |
| - Organization_Cache.Read (Key => Org_Id, | |
| - Is_Valid => Valid, | |
| - Value => Value); | |
| - | |
| - if not Valid then | |
| - if not Is_Number (Org_Id) then | |
| - raise GET_Parameter_Error with | |
| - "org_id must be a valid natural integer"; | |
| - end if; | |
| - | |
| - Value := Storage.Read.Get_Organization (Org_Id); | |
| - end if; | |
| - | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => JSON_Small.To_String (Value)); | |
| - | |
| - exception | |
| - when Event : others => | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => Exception_Handler | |
| - (Event => Event, | |
| - Message => "Requested resource: " & URL (URI (Request)))); | |
| - end Organization; | |
| - | |
| - ------------- | |
| - -- Queue -- | |
| - ------------- | |
| - | |
| - function Queue | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data | |
| - is | |
| - begin | |
| - return Build_JSON_Response | |
| - (Request => Request, | |
| - Content => Call_Queue.Get); | |
| - end Queue; | |
| - | |
| - -------------------- | |
| - -- Queue_Length -- | |
| - -------------------- | |
| - | |
| - function Queue_Length | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data | |
| - is | |
| - begin | |
| - return Build_JSON_Response (Request => Request, | |
| - Content => Call_Queue.Length); | |
| - end Queue_Length; | |
| - | |
| -end Request; | |
| diff --git a/src/request.ads b/src/request.ads | |
| deleted file mode 100644 | |
| index ea075ea..0000000 | |
| --- a/src/request.ads | |
| +++ /dev/null | |
| @@ -1,79 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- Request -- | |
| --- -- | |
| --- SPEC -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -with AWS.Status; | |
| -with AWS.Response; | |
| - | |
| -package Request is | |
| - | |
| - function Call | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data; | |
| - -- Get a call JSON for the longest waiting call in the queue. | |
| - | |
| - function Contact | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data; | |
| - -- Get a Contact JSON. | |
| - | |
| - function Contact_Attributes | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data; | |
| - -- Get a Contact_Attributes JSON. | |
| - | |
| - function Contact_Full | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data; | |
| - -- Get a Contact JSON with Attributes. | |
| - | |
| - function Org_Contacts | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data; | |
| - -- Get the Contacts JSON. | |
| - | |
| - function Org_Contacts_Attributes | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data; | |
| - -- Get the Contacts_Attributes JSON. | |
| - | |
| - function Org_Contacts_Full | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data; | |
| - -- Get the Contacts JSON with Attributes. | |
| - | |
| - function Organization | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data; | |
| - -- Get the Organization JSON. | |
| - | |
| - function Queue | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data; | |
| - -- Get the call queue JSON. | |
| - | |
| - function Queue_Length | |
| - (Request : in AWS.Status.Data) | |
| - return AWS.Response.Data; | |
| - -- Get the call queue length JSON. | |
| - | |
| -end Request; | |
| diff --git a/src/response.adb b/src/response.adb | |
| new file mode 100644 | |
| index 0000000..4e1a18d | |
| --- /dev/null | |
| +++ b/src/response.adb | |
| @@ -0,0 +1,260 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Response -- | |
| +-- -- | |
| +-- BODY -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with Ada.Strings.Fixed; | |
| +with AWS.Response.Set; | |
| +with AWS.URL; | |
| +with AWS.Utils; | |
| +with Errors; | |
| +with HTTP_Codes; | |
| + | |
| +package body Response is | |
| + | |
| + JSON_MIME_Type : constant String := "application/json; charset=utf-8"; | |
| + | |
| + procedure Add_CORS_Headers | |
| + (Request : in AWS.Status.Data; | |
| + Response : in out AWS.Response.Data) | |
| + with inline; | |
| + -- If the client sends the Origin: header, add these two CORS headers: | |
| + -- Access-Control-Allow-Origin | |
| + -- Access-Control-Allow-Credentials | |
| + -- where the first one should contain the value of the given | |
| + -- Origin : header and the second a Boolean True. This should be enough | |
| + -- to enable very simple CORS support in Alice. | |
| + | |
| + function Add_JSONP_Callback | |
| + (Content : in Common.JSON_String; | |
| + Request : in AWS.Status.Data) | |
| + return Common.JSON_String | |
| + with inline; | |
| + -- Wrap Content in jsoncallback(Content) if the jsoncallback parameter | |
| + -- is given in the Request. jsonpcallback is replaced with the actual | |
| + -- value of the jsoncallback parameter. | |
| + -- NOTE: | |
| + -- We do not support the callback parameter. It is too generic. | |
| + | |
| + ------------------------ | |
| + -- Add_CORS_Headers -- | |
| + ------------------------ | |
| + | |
| + procedure Add_CORS_Headers | |
| + (Request : in AWS.Status.Data; | |
| + Response : in out AWS.Response.Data) | |
| + is | |
| + use AWS.Messages; | |
| + use AWS.Response; | |
| + use AWS.Status; | |
| + | |
| + Origin_Host : constant String := Origin (Request); | |
| + begin | |
| + if Origin_Host'Length > 0 then | |
| + Set.Add_Header (D => Response, | |
| + Name => Access_Control_Allow_Origin_Token, | |
| + Value => Origin_Host); | |
| + | |
| + Set.Add_Header (D => Response, | |
| + Name => Access_Control_Allow_Credentials_Token, | |
| + Value => "true"); | |
| + end if; | |
| + end Add_CORS_Headers; | |
| + | |
| + -------------------------- | |
| + -- Add_JSONP_Callback -- | |
| + -------------------------- | |
| + | |
| + function Add_JSONP_Callback | |
| + (Content : in Common.JSON_String; | |
| + Request : in AWS.Status.Data) | |
| + return Common.JSON_String | |
| + is | |
| + use Ada.Strings; | |
| + use AWS.Status; | |
| + use Common; | |
| + | |
| + JSON_Callback : constant String := Fixed.Trim | |
| + (Parameters (Request).Get ("jsoncallback"), Both); | |
| + begin | |
| + if JSON_Callback'Length > 0 then | |
| + return To_JSON_String (JSON_Callback) | |
| + & To_JSON_String ("(") | |
| + & Content | |
| + & To_JSON_String (")"); | |
| + end if; | |
| + | |
| + return Content; | |
| + end Add_JSONP_Callback; | |
| + | |
| + --------------------------- | |
| + -- Build_JSON_Response -- | |
| + --------------------------- | |
| + | |
| + function Build_JSON_Response | |
| + (Request : in AWS.Status.Data; | |
| + Content : in Common.JSON_String; | |
| + Status : in AWS.Messages.Status_Code) | |
| + return AWS.Response.Data | |
| + is | |
| + use AWS.Messages; | |
| + use AWS.Response; | |
| + use AWS.Status; | |
| + use Common; | |
| + | |
| + D : AWS.Response.Data; | |
| + Encoding : constant Content_Encoding := Preferred_Coding (Request); | |
| + begin | |
| + D := Build (Content_Type => JSON_MIME_Type, | |
| + Message_Body => | |
| + To_String (Add_JSONP_Callback (Content, Request)), | |
| + Status_Code => Status, | |
| + Encoding => Encoding, | |
| + Cache_Control => No_Cache); | |
| + | |
| + Add_CORS_Headers (Request, D); | |
| + | |
| + return D; | |
| + end Build_JSON_Response; | |
| + | |
| + ------------------------------- | |
| + -- Check_Ce_Id_Parameter -- | |
| + ------------------------------- | |
| + | |
| + procedure Check_Ce_Id_Parameter | |
| + (Request : in AWS.Status.Data) | |
| + is | |
| + use AWS.Utils; | |
| + use Errors; | |
| + | |
| + P : constant String := Get_Ce_Id_Key (Request); | |
| + begin | |
| + if not Is_Number (P) then | |
| + raise GET_Parameter_Error with | |
| + "ce_id must be a valid natural integer"; | |
| + end if; | |
| + end Check_Ce_Id_Parameter; | |
| + | |
| + ------------------------------ | |
| + -- Check_Org_Id_Parameter -- | |
| + ------------------------------ | |
| + | |
| + procedure Check_Org_Id_Parameter | |
| + (Request : in AWS.Status.Data) | |
| + is | |
| + use AWS.Utils; | |
| + use Errors; | |
| + | |
| + P : constant String := Get_Org_Id_Key (Request); | |
| + begin | |
| + if not Is_Number (P) then | |
| + raise GET_Parameter_Error with | |
| + "org_id must be a valid natural integer"; | |
| + end if; | |
| + end Check_Org_Id_Parameter; | |
| + | |
| + -------------------- | |
| + -- Generic_Read -- | |
| + -------------------- | |
| + | |
| + package body Generic_Response is | |
| + | |
| + ---------------- | |
| + -- Generate -- | |
| + ---------------- | |
| + | |
| + function Generate | |
| + (Request : in AWS.Status.Data) | |
| + return AWS.Response.Data | |
| + is | |
| + use AWS.Status; | |
| + use AWS.URL; | |
| + use Common; | |
| + use Errors; | |
| + use HTTP_Codes; | |
| + | |
| + Key : constant String := Get_Cache_Key (Request); | |
| + Status : AWS.Messages.Status_Code; | |
| + Valid : Boolean; | |
| + Value : JSON_String; | |
| + begin | |
| + Read_From_Cache (Key => Key, | |
| + Is_Valid => Valid, | |
| + Value => Value); | |
| + | |
| + if Valid then | |
| + Status := OK; | |
| + else | |
| + Check_Request_Parameters (Request); | |
| + Query_To_JSON.Generate (Key, Request, Status, Value); | |
| + end if; | |
| + | |
| + return Build_JSON_Response | |
| + (Request => Request, | |
| + Content => Value, | |
| + Status => Status); | |
| + | |
| + exception | |
| + when Event : Database_Error => | |
| + return Build_JSON_Response | |
| + (Request => Request, | |
| + Content => Exception_Handler | |
| + (Event => Event, | |
| + Message => "Requested resource: " & URL (URI (Request))), | |
| + Status => Server_Error); | |
| + when Event : others => | |
| + return Build_JSON_Response | |
| + (Request => Request, | |
| + Content => Exception_Handler | |
| + (Event => Event, | |
| + Message => "Requested resource: " & URL (URI (Request))), | |
| + Status => Bad_Request); | |
| + end Generate; | |
| + | |
| + end Generic_Response; | |
| + | |
| + --------------------- | |
| + -- Get_Ce_Id_Key -- | |
| + --------------------- | |
| + | |
| + function Get_Ce_Id_Key | |
| + (Request : in AWS.Status.Data) | |
| + return String | |
| + is | |
| + use AWS.Status; | |
| + begin | |
| + return Parameters (Request).Get ("ce_id"); | |
| + end Get_Ce_Id_Key; | |
| + | |
| + ---------------------- | |
| + -- Get_Org_Id_Key -- | |
| + ---------------------- | |
| + | |
| + function Get_Org_Id_Key | |
| + (Request : in AWS.Status.Data) | |
| + return String | |
| + is | |
| + use AWS.Status; | |
| + begin | |
| + return Parameters (Request).Get ("org_id"); | |
| + end Get_Org_Id_Key; | |
| + | |
| +end Response; | |
| diff --git a/src/response.ads b/src/response.ads | |
| new file mode 100644 | |
| index 0000000..3768dc1 | |
| --- /dev/null | |
| +++ b/src/response.ads | |
| @@ -0,0 +1,98 @@ | |
| +------------------------------------------------------------------------------- | |
| +-- -- | |
| +-- Alice -- | |
| +-- -- | |
| +-- Response -- | |
| +-- -- | |
| +-- SPEC -- | |
| +-- -- | |
| +-- Copyright (C) 2012-, AdaHeads K/S -- | |
| +-- -- | |
| +-- This is free software; you can redistribute it and/or modify it -- | |
| +-- under terms of the GNU General Public License as published by the -- | |
| +-- Free Software Foundation; either version 3, 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. -- | |
| +-- You should have received a copy of the GNU General Public License and -- | |
| +-- a copy of the GCC Runtime Library Exception along with this program; -- | |
| +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| +-- <http://www.gnu.org/licenses/>. -- | |
| +-- -- | |
| +------------------------------------------------------------------------------- | |
| + | |
| +with AWS.Messages; | |
| +with AWS.Response; | |
| +with AWS.Status; | |
| +with Common; | |
| +with Storage; | |
| + | |
| +package Response is | |
| + | |
| + function Build_JSON_Response | |
| + (Request : in AWS.Status.Data; | |
| + Content : in Common.JSON_String; | |
| + Status : in AWS.Messages.Status_Code) | |
| + return AWS.Response.Data | |
| + with inline; | |
| + -- Build the response and compress it if the client supports it. Also | |
| + -- wraps JSON string in foo(JSON string) if the | |
| + -- ?jsoncallback=foo | |
| + -- GET parameter is present. | |
| + | |
| + procedure Check_Ce_Id_Parameter | |
| + (Request : in AWS.Status.Data) | |
| + with inline; | |
| + -- Check if the request parameter ce_id is numeric. Raise | |
| + -- GET_Parameter_Error if not. | |
| + | |
| + function Get_Ce_Id_Key | |
| + (Request : in AWS.Status.Data) | |
| + return String | |
| + with inline; | |
| + -- Return the value of the ce_id request parameter. | |
| + | |
| + procedure Check_Org_Id_Parameter | |
| + (Request : in AWS.Status.Data) | |
| + with inline; | |
| + -- Check if the request parameter org_id is numeric. Raise | |
| + -- GET_Parameter_Error if not. | |
| + | |
| + function Get_Org_Id_Key | |
| + (Request : in AWS.Status.Data) | |
| + return String | |
| + with inline; | |
| + -- Return the value of the org_id request parameter. | |
| + | |
| + generic | |
| + | |
| + with procedure Check_Request_Parameters | |
| + (Request : in AWS.Status.Data); | |
| + -- Check the validity of all required request parameters. | |
| + -- Must raise the Errors.GET_Parameter_Error exception if one or more | |
| + -- the request parameters aren't valid. | |
| + | |
| + with function Get_Cache_Key | |
| + (Request : in AWS.Status.Data) | |
| + return String; | |
| + -- Return the key used to identify an object in a cache. | |
| + | |
| + with procedure Read_From_Cache | |
| + (Key : in String; | |
| + Is_Valid : out Boolean; | |
| + Value : out Common.JSON_String); | |
| + -- Find Key in a cache. | |
| + | |
| + with package Query_To_JSON is new Storage.Generic_Query_To_JSON (<>); | |
| + -- This package enables reading data from persistent storage. | |
| + | |
| + package Generic_Response is | |
| + | |
| + function Generate | |
| + (Request : in AWS.Status.Data) | |
| + return AWS.Response.Data; | |
| + -- TODO: Write comment | |
| + | |
| + end Generic_Response; | |
| + | |
| +end Response; | |
| diff --git a/src/storage-queries.adb b/src/storage-queries.adb | |
| deleted file mode 100644 | |
| index 06b7b6d..0000000 | |
| --- a/src/storage-queries.adb | |
| +++ /dev/null | |
| @@ -1,436 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- Storage.Queries -- | |
| --- -- | |
| --- BODY -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -with Database; | |
| -with Yolk.Utilities; | |
| - | |
| -package body Storage.Queries is | |
| - | |
| - -------------------------------- | |
| - -- Contact_Attributes_Query -- | |
| - -------------------------------- | |
| - | |
| - function Contact_Attributes_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement | |
| - is | |
| - use Database; | |
| - use GNATCOLL.SQL; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Get_Contact_Attributes : constant SQL_Query | |
| - := SQL_Select (Fields => | |
| - Contactentity_Attributes.Json & -- 0 | |
| - Contactentity_Attributes.Ce_Id & -- 1 | |
| - Contactentity_Attributes.Org_Id, -- 2 | |
| - Where => | |
| - Contactentity_Attributes.Ce_Id = (Integer_Param (1))); | |
| - | |
| - Prepared_Get_Contact_Attributes : constant Prepared_Statement | |
| - := Prepare (Query => Get_Contact_Attributes, | |
| - Auto_Complete => True, | |
| - On_Server => True, | |
| - Name => "get_contact_attributes"); | |
| - begin | |
| - return Prepared_Get_Contact_Attributes; | |
| - end Contact_Attributes_Query; | |
| - | |
| - -------------------------- | |
| - -- Contact_Full_Query -- | |
| - -------------------------- | |
| - | |
| - function Contact_Full_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement | |
| - is | |
| - use Database; | |
| - use GNATCOLL.SQL; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Get_Contact_Full_Left_Join : constant SQL_Left_Join_Table | |
| - := Left_Join (Full => Contactentity, | |
| - Partial => Contactentity_Attributes, | |
| - On => | |
| - Contactentity.Ce_Id = Contactentity_Attributes.Ce_Id); | |
| - | |
| - Get_Contact_Full : constant SQL_Query | |
| - := SQL_Select (Fields => | |
| - Contactentity.Json & -- 0 | |
| - Contactentity.Ce_Id & -- 1 | |
| - Contactentity.Ce_Name & -- 2 | |
| - Contactentity.Is_Human & -- 3 | |
| - Contactentity_Attributes.Json & -- 4 | |
| - Contactentity_Attributes.Org_Id & -- 5 | |
| - Contactentity_Attributes.Ce_Id, -- 6 | |
| - From => Get_Contact_Full_Left_Join, | |
| - Where => Contactentity.Ce_Id = Integer_Param (1)); | |
| - | |
| - Prepared_Get_Contact_Full : constant Prepared_Statement | |
| - := Prepare (Query => Get_Contact_Full, | |
| - Auto_Complete => True, | |
| - On_Server => True, | |
| - Name => "get_contact_full"); | |
| - begin | |
| - return Prepared_Get_Contact_Full; | |
| - end Contact_Full_Query; | |
| - | |
| - --------------------- | |
| - -- Contact_Query -- | |
| - --------------------- | |
| - | |
| - function Contact_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement | |
| - is | |
| - use Database; | |
| - use GNATCOLL.SQL; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Get_Contact : constant SQL_Query | |
| - := SQL_Select (Fields => | |
| - Contactentity.Json & -- 0 | |
| - Contactentity.Ce_Id & -- 1 | |
| - Contactentity.Ce_Name & -- 2 | |
| - Contactentity.Is_Human, -- 3 | |
| - Where => | |
| - Contactentity.Ce_Id = Integer_Param (1)); | |
| - | |
| - Prepared_Get_Contact : constant Prepared_Statement | |
| - := Prepare (Query => Get_Contact, | |
| - Auto_Complete => True, | |
| - On_Server => True, | |
| - Name => "get_contact"); | |
| - begin | |
| - return Prepared_Get_Contact; | |
| - end Contact_Query; | |
| - | |
| - --------------- | |
| - -- Element -- | |
| - --------------- | |
| - | |
| - function Element | |
| - (C : in Contact_Cursor) | |
| - return Contact_Row | |
| - is | |
| - use Yolk.Utilities; | |
| - begin | |
| - return Contact_Row' | |
| - (JSON => TUS (C.Value (0)), | |
| - Ce_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (1)), | |
| - Value => C.Integer_Value (1, Default => 0)), | |
| - Ce_Name => | |
| - Pair_String'(Name => TUS (C.Field_Name (2)), | |
| - Value => TUS (C.Value (2))), | |
| - Is_Human => | |
| - Pair_Boolean'(Name => TUS (C.Field_Name (3)), | |
| - Value => C.Boolean_Value (3))); | |
| - end Element; | |
| - | |
| - --------------- | |
| - -- Element -- | |
| - --------------- | |
| - | |
| - function Element | |
| - (C : in Contact_Attributes_Cursor) | |
| - return Contact_Attributes_Row | |
| - is | |
| - use Yolk.Utilities; | |
| - begin | |
| - return Contact_Attributes_Row' | |
| - (JSON => TUS (C.Value (0)), | |
| - Ce_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (1)), | |
| - Value => C.Integer_Value (1, Default => 0)), | |
| - Org_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (2)), | |
| - Value => C.Integer_Value (2, Default => 0))); | |
| - end Element; | |
| - | |
| - --------------- | |
| - -- Element -- | |
| - --------------- | |
| - | |
| - function Element | |
| - (C : in Contact_Full_Cursor) | |
| - return Contact_Full_Row | |
| - is | |
| - use Yolk.Utilities; | |
| - begin | |
| - return Contact_Full_Row' | |
| - (JSON => TUS (C.Value (0)), | |
| - Ce_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (1)), | |
| - Value => C.Integer_Value (1, Default => 0)), | |
| - Ce_Name => | |
| - Pair_String'(Name => TUS (C.Field_Name (2)), | |
| - Value => TUS (C.Value (2))), | |
| - Is_Human => | |
| - Pair_Boolean'(Name => TUS (C.Field_Name (3)), | |
| - Value => C.Boolean_Value (3)), | |
| - Attr_JSON => TUS (C.Value (4)), | |
| - Attr_Org_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (5)), | |
| - Value => C.Integer_Value (5, Default => 0)), | |
| - Attr_Ce_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (6)), | |
| - Value => C.Integer_Value (6, Default => 0))); | |
| - end Element; | |
| - | |
| - --------------- | |
| - -- Element -- | |
| - --------------- | |
| - | |
| - function Element | |
| - (C : in Organization_Cursor) | |
| - return Organization_Row | |
| - is | |
| - use Yolk.Utilities; | |
| - begin | |
| - return Organization_Row' | |
| - (JSON => TUS (C.Value (0)), | |
| - Org_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (1)), | |
| - Value => C.Integer_Value (1, Default => 0)), | |
| - Org_Name => | |
| - Pair_String'(Name => TUS (C.Field_Name (2)), | |
| - Value => TUS (C.Value (2))), | |
| - Identifier => | |
| - Pair_String'(Name => TUS (C.Field_Name (3)), | |
| - Value => TUS (C.Value (3)))); | |
| - end Element; | |
| - | |
| - --------------- | |
| - -- Element -- | |
| - --------------- | |
| - | |
| - function Element | |
| - (C : in Org_Contacts_Cursor) | |
| - return Org_Contacts_Row | |
| - is | |
| - use Yolk.Utilities; | |
| - begin | |
| - return Org_Contacts_Row' | |
| - (JSON => TUS (C.Value (0)), | |
| - Ce_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (1)), | |
| - Value => C.Integer_Value (1, Default => 0)), | |
| - Ce_Name => | |
| - Pair_String'(Name => TUS (C.Field_Name (2)), | |
| - Value => TUS (C.Value (2))), | |
| - Is_Human => | |
| - Pair_Boolean'(Name => TUS (C.Field_Name (3)), | |
| - Value => C.Boolean_Value (3))); | |
| - end Element; | |
| - | |
| - --------------- | |
| - -- Element -- | |
| - --------------- | |
| - | |
| - function Element | |
| - (C : in Org_Contacts_Attributes_Cursor) | |
| - return Org_Contacts_Attributes_Row | |
| - is | |
| - use Yolk.Utilities; | |
| - begin | |
| - return Org_Contacts_Attributes_Row' | |
| - (JSON => TUS (C.Value (0)), | |
| - Ce_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (1)), | |
| - Value => C.Integer_Value (1, Default => 0)), | |
| - Org_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (2)), | |
| - Value => C.Integer_Value (2, Default => 0))); | |
| - end Element; | |
| - | |
| - --------------- | |
| - -- Element -- | |
| - --------------- | |
| - | |
| - function Element | |
| - (C : in Org_Contacts_Full_Cursor) | |
| - return Org_Contacts_Full_Row | |
| - is | |
| - use Yolk.Utilities; | |
| - begin | |
| - return Org_Contacts_Full_Row' | |
| - (JSON => TUS (C.Value (0)), | |
| - Ce_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (1)), | |
| - Value => C.Integer_Value (1, Default => 0)), | |
| - Ce_Name => | |
| - Pair_String'(Name => TUS (C.Field_Name (2)), | |
| - Value => TUS (C.Value (2))), | |
| - Is_Human => | |
| - Pair_Boolean'(Name => TUS (C.Field_Name (3)), | |
| - Value => C.Boolean_Value (3)), | |
| - Attr_JSON => TUS (C.Value (4)), | |
| - Attr_Org_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (5)), | |
| - Value => C.Integer_Value (5, Default => 0)), | |
| - Attr_Ce_Id => | |
| - Pair_Natural'(Name => TUS (C.Field_Name (6)), | |
| - Value => C.Integer_Value (6, Default => 0))); | |
| - end Element; | |
| - | |
| - ------------------------------------- | |
| - -- Org_Contacts_Attributes_Query -- | |
| - ------------------------------------- | |
| - | |
| - function Org_Contacts_Attributes_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement | |
| - is | |
| - use Database; | |
| - use GNATCOLL.SQL; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Get_Org_Contacts_Attributes : constant SQL_Query | |
| - := SQL_Select (Fields => | |
| - Contactentity_Attributes.Json & -- 0 | |
| - Contactentity_Attributes.Org_Id & -- 1 | |
| - Contactentity_Attributes.Ce_Id, -- 2 | |
| - Where => | |
| - Contactentity_Attributes.Org_Id = Integer_Param (1)); | |
| - | |
| - Prepared_Get_Org_Contacts_Attributes : constant Prepared_Statement | |
| - := Prepare (Query => Get_Org_Contacts_Attributes, | |
| - Auto_Complete => True, | |
| - On_Server => True, | |
| - Name => "get_org_contacts_attributes"); | |
| - begin | |
| - return Prepared_Get_Org_Contacts_Attributes; | |
| - end Org_Contacts_Attributes_Query; | |
| - | |
| - ------------------------------- | |
| - -- Org_Contacts_Full_Query -- | |
| - ------------------------------- | |
| - | |
| - function Org_Contacts_Full_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement | |
| - is | |
| - use Database; | |
| - use GNATCOLL.SQL; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Get_Org_Contacts_Full_Join : constant SQL_Left_Join_Table | |
| - := Join (Table1 => Contactentity, | |
| - Table2 => Organization_Contactentities, | |
| - On => | |
| - Contactentity.Ce_Id = Organization_Contactentities.Ce_Id); | |
| - | |
| - Get_Org_Contacts_Full_Left_Join : constant SQL_Left_Join_Table | |
| - := Left_Join (Full => Get_Org_Contacts_Full_Join, | |
| - Partial => Contactentity_Attributes, | |
| - On => | |
| - Contactentity.Ce_Id = Contactentity_Attributes.Ce_Id); | |
| - | |
| - Get_Org_Contacts_Full : constant SQL_Query | |
| - := SQL_Select (Fields => | |
| - Contactentity.Json & -- 0 | |
| - Contactentity.Ce_Id & -- 1 | |
| - Contactentity.Ce_Name & -- 2 | |
| - Contactentity.Is_Human & -- 3 | |
| - Contactentity_Attributes.Json & -- 4 | |
| - Contactentity_Attributes.Org_Id & -- 5 | |
| - Contactentity_Attributes.Ce_Id, -- 6 | |
| - From => Get_Org_Contacts_Full_Left_Join, | |
| - Where => | |
| - Organization_Contactentities.Org_Id = | |
| - Integer_Param (1) | |
| - and | |
| - (Contactentity_Attributes.Org_Id = Integer_Param (1) | |
| - or | |
| - Is_Null (Contactentity_Attributes.Org_Id))); | |
| - | |
| - Prepared_Get_Org_Contacts_Full : constant Prepared_Statement | |
| - := Prepare (Query => Get_Org_Contacts_Full, | |
| - Auto_Complete => True, | |
| - On_Server => True, | |
| - Name => "get_org_contacts_full"); | |
| - begin | |
| - return Prepared_Get_Org_Contacts_Full; | |
| - end Org_Contacts_Full_Query; | |
| - | |
| - -------------------------- | |
| - -- Org_Contacts_Query -- | |
| - -------------------------- | |
| - | |
| - function Org_Contacts_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement | |
| - is | |
| - use Database; | |
| - use GNATCOLL.SQL; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Get_Org_Contacts_Join : constant SQL_Left_Join_Table | |
| - := Join (Table1 => Contactentity, | |
| - Table2 => Organization_Contactentities, | |
| - On => | |
| - Contactentity.Ce_Id = Organization_Contactentities.Ce_Id); | |
| - | |
| - Get_Org_Contacts : constant SQL_Query | |
| - := SQL_Select (Fields => | |
| - Contactentity.Json & -- 0 | |
| - Contactentity.Ce_Id & -- 1 | |
| - Contactentity.Ce_Name & -- 2 | |
| - Contactentity.Is_Human, -- 3 | |
| - From => Get_Org_Contacts_Join, | |
| - Where => | |
| - Organization_Contactentities.Org_Id = | |
| - Integer_Param (1)); | |
| - | |
| - Prepared_Get_Org_Contacts : constant Prepared_Statement | |
| - := Prepare (Query => Get_Org_Contacts, | |
| - Auto_Complete => True, | |
| - On_Server => True, | |
| - Name => "get_org_contacts"); | |
| - begin | |
| - return Prepared_Get_Org_Contacts; | |
| - end Org_Contacts_Query; | |
| - | |
| - -------------------------- | |
| - -- Organization_Query -- | |
| - -------------------------- | |
| - | |
| - function Organization_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement | |
| - is | |
| - use Database; | |
| - use GNATCOLL.SQL; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Get_Organization : constant SQL_Query | |
| - := SQL_Select (Fields => | |
| - Organization.Json & -- 0 | |
| - Organization.Org_Id & -- 1 | |
| - Organization.Org_Name & -- 2 | |
| - Organization.Identifier, -- 3 | |
| - Where => Organization.Org_Id = Integer_Param (1)); | |
| - | |
| - Prepared_Get_Organization : constant Prepared_Statement | |
| - := Prepare (Query => Get_Organization, | |
| - Auto_Complete => True, | |
| - On_Server => True, | |
| - Name => "get_organization"); | |
| - begin | |
| - return Prepared_Get_Organization; | |
| - end Organization_Query; | |
| - | |
| -end Storage.Queries; | |
| diff --git a/src/storage-queries.ads b/src/storage-queries.ads | |
| deleted file mode 100644 | |
| index 174a4a3..0000000 | |
| --- a/src/storage-queries.ads | |
| +++ /dev/null | |
| @@ -1,204 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- Storage.Queries -- | |
| --- -- | |
| --- SPEC -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -with Ada.Strings.Unbounded; | |
| - | |
| -package Storage.Queries is | |
| - | |
| - type Pair_Boolean is | |
| - record | |
| - Name : Ada.Strings.Unbounded.Unbounded_String; | |
| - Value : Boolean; | |
| - end record; | |
| - | |
| - type Pair_Natural is | |
| - record | |
| - Name : Ada.Strings.Unbounded.Unbounded_String; | |
| - Value : Natural; | |
| - end record; | |
| - | |
| - type Pair_String is | |
| - record | |
| - Name : Ada.Strings.Unbounded.Unbounded_String; | |
| - Value : Ada.Strings.Unbounded.Unbounded_String; | |
| - end record; | |
| - | |
| - ---------------------------------------- | |
| - -- Contact record, cursor and query -- | |
| - ---------------------------------------- | |
| - | |
| - type Contact_Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with | |
| - null record; | |
| - | |
| - type Contact_Row is | |
| - record | |
| - JSON : Ada.Strings.Unbounded.Unbounded_String; | |
| - Ce_Id : Pair_Natural; | |
| - Ce_Name : Pair_String; | |
| - Is_Human : Pair_Boolean; | |
| - end record; | |
| - | |
| - function Element | |
| - (C : in Contact_Cursor) | |
| - return Contact_Row; | |
| - | |
| - function Contact_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement; | |
| - | |
| - --------------------------------------------------- | |
| - -- Contact Attributes record, cursor and query -- | |
| - --------------------------------------------------- | |
| - | |
| - type Contact_Attributes_Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with | |
| - null record; | |
| - | |
| - type Contact_Attributes_Row is | |
| - record | |
| - JSON : Ada.Strings.Unbounded.Unbounded_String; | |
| - Ce_Id : Pair_Natural; | |
| - Org_Id : Pair_Natural; | |
| - end record; | |
| - | |
| - function Element | |
| - (C : in Contact_Attributes_Cursor) | |
| - return Contact_Attributes_Row; | |
| - | |
| - function Contact_Attributes_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement; | |
| - | |
| - --------------------------------------------- | |
| - -- Contact Full record, cursor and query -- | |
| - --------------------------------------------- | |
| - | |
| - type Contact_Full_Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with | |
| - null record; | |
| - | |
| - type Contact_Full_Row is | |
| - record | |
| - JSON : Ada.Strings.Unbounded.Unbounded_String; | |
| - Ce_Id : Pair_Natural; | |
| - Ce_Name : Pair_String; | |
| - Is_Human : Pair_Boolean; | |
| - Attr_JSON : Ada.Strings.Unbounded.Unbounded_String; | |
| - Attr_Org_Id : Pair_Natural; | |
| - Attr_Ce_Id : Pair_Natural; | |
| - end record; | |
| - | |
| - function Element | |
| - (C : in Contact_Full_Cursor) | |
| - return Contact_Full_Row; | |
| - | |
| - function Contact_Full_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement; | |
| - | |
| - --------------------------------------------- | |
| - -- Organization record, cursor and query -- | |
| - --------------------------------------------- | |
| - | |
| - type Organization_Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with | |
| - null record; | |
| - | |
| - type Organization_Row is | |
| - record | |
| - JSON : Ada.Strings.Unbounded.Unbounded_String; | |
| - Org_Id : Pair_Natural; | |
| - Org_Name : Pair_String; | |
| - Identifier : Pair_String; | |
| - end record; | |
| - | |
| - function Element | |
| - (C : in Organization_Cursor) | |
| - return Organization_Row; | |
| - | |
| - function Organization_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement; | |
| - | |
| - --------------------------------------------- | |
| - -- Org_Contacts record, cursor and query -- | |
| - --------------------------------------------- | |
| - | |
| - type Org_Contacts_Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with | |
| - null record; | |
| - | |
| - type Org_Contacts_Row is | |
| - record | |
| - JSON : Ada.Strings.Unbounded.Unbounded_String; | |
| - Ce_Id : Pair_Natural; | |
| - Ce_Name : Pair_String; | |
| - Is_Human : Pair_Boolean; | |
| - end record; | |
| - | |
| - function Element | |
| - (C : in Org_Contacts_Cursor) | |
| - return Org_Contacts_Row; | |
| - | |
| - function Org_Contacts_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement; | |
| - | |
| - -------------------------------------------------------- | |
| - -- Org_Contacts_Attributes record, cursor and query -- | |
| - -------------------------------------------------------- | |
| - | |
| - type Org_Contacts_Attributes_Cursor is new | |
| - GNATCOLL.SQL.Exec.Forward_Cursor with null record; | |
| - | |
| - type Org_Contacts_Attributes_Row is | |
| - record | |
| - JSON : Ada.Strings.Unbounded.Unbounded_String; | |
| - Ce_Id : Pair_Natural; | |
| - Org_Id : Pair_Natural; | |
| - end record; | |
| - | |
| - function Element | |
| - (C : in Org_Contacts_Attributes_Cursor) | |
| - return Org_Contacts_Attributes_Row; | |
| - | |
| - function Org_Contacts_Attributes_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement; | |
| - | |
| - -------------------------------------------------- | |
| - -- Org_Contacts_Full record, cursor and query -- | |
| - -------------------------------------------------- | |
| - | |
| - type Org_Contacts_Full_Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with | |
| - null record; | |
| - | |
| - type Org_Contacts_Full_Row is | |
| - record | |
| - JSON : Ada.Strings.Unbounded.Unbounded_String; | |
| - Ce_Id : Pair_Natural; | |
| - Ce_Name : Pair_String; | |
| - Is_Human : Pair_Boolean; | |
| - Attr_JSON : Ada.Strings.Unbounded.Unbounded_String; | |
| - Attr_Org_Id : Pair_Natural; | |
| - Attr_Ce_Id : Pair_Natural; | |
| - end record; | |
| - | |
| - function Element | |
| - (C : in Org_Contacts_Full_Cursor) | |
| - return Org_Contacts_Full_Row; | |
| - | |
| - function Org_Contacts_Full_Query | |
| - return GNATCOLL.SQL.Exec.Prepared_Statement; | |
| - | |
| -end Storage.Queries; | |
| diff --git a/src/storage-read.adb b/src/storage-read.adb | |
| deleted file mode 100644 | |
| index f532bc9..0000000 | |
| --- a/src/storage-read.adb | |
| +++ /dev/null | |
| @@ -1,357 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- Storage.Read -- | |
| --- -- | |
| --- BODY -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -with Cache; | |
| -with Errors; | |
| -with JSONIFY; | |
| -with Storage.Queries; | |
| - | |
| -package body Storage.Read is | |
| - | |
| - procedure Failed_Query | |
| - (Connection_Pool : in out DB_Conn_Pool; | |
| - Connection_Type : in DB_Conn_Type); | |
| - -- If a query fails: | |
| - -- 1. Set the connection state to Failed. | |
| - -- 2. Raise the Database_Error exception if | |
| - -- Connection_Type = Database_Connection_Type'Last | |
| - -- 3. If 2 is not True, Output a message to the Error log trace. | |
| - | |
| - -------------------- | |
| - -- Failed_Query -- | |
| - -------------------- | |
| - | |
| - procedure Failed_Query | |
| - (Connection_Pool : in out DB_Conn_Pool; | |
| - Connection_Type : in DB_Conn_Type) | |
| - is | |
| - use Errors; | |
| - use GNATCOLL.SQL; | |
| - | |
| - Trimmed_DB_Error : constant String | |
| - := Trim (Exec.Error (Connection_Pool (Connection_Type).Host)); | |
| - | |
| - Connection : constant String | |
| - := DB_Conn_Type'Image (Connection_Type); | |
| - | |
| - Message : constant String := Trimmed_DB_Error & "-" & Connection; | |
| - begin | |
| - Connection_Pool (Connection_Type).State := Failed; | |
| - Register_Failed_DB_Connection (Pool => Connection_Pool); | |
| - | |
| - if Connection_Type = DB_Conn_Type'Last then | |
| - raise Database_Error with Message; | |
| - else | |
| - Error_Handler (Message); | |
| - end if; | |
| - end Failed_Query; | |
| - | |
| - ------------------- | |
| - -- Get_Contact -- | |
| - ------------------- | |
| - | |
| - function Get_Contact | |
| - (Ce_Id : in String) | |
| - return Common.JSON_Small.Bounded_String | |
| - is | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - C : Queries.Contact_Cursor; | |
| - DB_Connections : DB_Conn_Pool := Get_DB_Connections; | |
| - Value : JSON_Small.Bounded_String; | |
| - begin | |
| - Fetch_Data : | |
| - for k in DB_Connections'Range loop | |
| - C.Fetch (DB_Connections (k).Host, | |
| - Queries.Contact_Query, | |
| - Params => (1 => +Natural'Value (Ce_Id))); | |
| - | |
| - if DB_Connections (k).Host.Success then | |
| - JSONIFY.Contact (C, Value); | |
| - | |
| - if C.Processed_Rows > 0 then | |
| - Contact_Cache.Write (Key => Ce_Id, | |
| - Value => Value); | |
| - end if; | |
| - | |
| - exit Fetch_Data; | |
| - else | |
| - Failed_Query (Connection_Pool => DB_Connections, | |
| - Connection_Type => k); | |
| - end if; | |
| - end loop Fetch_Data; | |
| - | |
| - return Value; | |
| - end Get_Contact; | |
| - | |
| - ------------------------------ | |
| - -- Get_Contact_Attributes -- | |
| - ------------------------------ | |
| - | |
| - function Get_Contact_Attributes | |
| - (Ce_Id : in String) | |
| - return Common.JSON_Small.Bounded_String | |
| - is | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - C : Queries.Contact_Attributes_Cursor; | |
| - DB_Connections : DB_Conn_Pool := Get_DB_Connections; | |
| - Value : JSON_Small.Bounded_String; | |
| - begin | |
| - Fetch_Data : | |
| - for k in DB_Connections'Range loop | |
| - C.Fetch (DB_Connections (k).Host, | |
| - Queries.Contact_Attributes_Query, | |
| - Params => (1 => +Natural'Value (Ce_Id))); | |
| - | |
| - if DB_Connections (k).Host.Success then | |
| - JSONIFY.Contact_Attributes (C, Value); | |
| - | |
| - if C.Processed_Rows > 0 then | |
| - Contact_Attributes_Cache.Write (Key => Ce_Id, | |
| - Value => Value); | |
| - end if; | |
| - | |
| - exit Fetch_Data; | |
| - else | |
| - Failed_Query (Connection_Pool => DB_Connections, | |
| - Connection_Type => k); | |
| - end if; | |
| - end loop Fetch_Data; | |
| - | |
| - return Value; | |
| - end Get_Contact_Attributes; | |
| - | |
| - ------------------------ | |
| - -- Get_Contact_Full -- | |
| - ------------------------ | |
| - | |
| - function Get_Contact_Full | |
| - (Ce_Id : in String) | |
| - return Common.JSON_Small.Bounded_String | |
| - is | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Cursor : Queries.Contact_Full_Cursor; | |
| - DB_Connections : DB_Conn_Pool := Get_DB_Connections; | |
| - Value : JSON_Small.Bounded_String; | |
| - begin | |
| - Fetch_Data : | |
| - for k in DB_Connections'Range loop | |
| - Cursor.Fetch (DB_Connections (k).Host, | |
| - Queries.Contact_Full_Query, | |
| - Params => (1 => +Natural'Value (Ce_Id))); | |
| - | |
| - if DB_Connections (k).Host.Success then | |
| - JSONIFY.Contact_Full (Cursor, Value); | |
| - | |
| - if Cursor.Processed_Rows > 0 then | |
| - Contact_Full_Cache.Write (Key => Ce_Id, | |
| - Value => Value); | |
| - end if; | |
| - | |
| - exit Fetch_Data; | |
| - else | |
| - Failed_Query (Connection_Pool => DB_Connections, | |
| - Connection_Type => k); | |
| - end if; | |
| - end loop Fetch_Data; | |
| - | |
| - return Value; | |
| - end Get_Contact_Full; | |
| - | |
| - ------------------------ | |
| - -- Get_Org_Contacts -- | |
| - ------------------------ | |
| - | |
| - function Get_Org_Contacts | |
| - (Org_Id : in String) | |
| - return Common.JSON_Large.Bounded_String | |
| - is | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Cursor : Queries.Org_Contacts_Cursor; | |
| - DB_Connections : DB_Conn_Pool := Get_DB_Connections; | |
| - Value : JSON_Large.Bounded_String; | |
| - begin | |
| - Fetch_Data : | |
| - for k in DB_Connections'Range loop | |
| - Cursor.Fetch (DB_Connections (k).Host, | |
| - Queries.Org_Contacts_Query, | |
| - Params => (1 => +Natural'Value (Org_Id))); | |
| - | |
| - if DB_Connections (k).Host.Success then | |
| - JSONIFY.Org_Contacts (Cursor, Value); | |
| - | |
| - if Cursor.Processed_Rows > 0 then | |
| - Org_Contacts_Cache.Write (Key => Org_Id, | |
| - Value => Value); | |
| - end if; | |
| - | |
| - exit Fetch_Data; | |
| - else | |
| - Failed_Query (Connection_Pool => DB_Connections, | |
| - Connection_Type => k); | |
| - end if; | |
| - end loop Fetch_Data; | |
| - | |
| - return Value; | |
| - end Get_Org_Contacts; | |
| - | |
| - ----------------------------------- | |
| - -- Get_Org_Contacts_Attributes -- | |
| - ----------------------------------- | |
| - | |
| - function Get_Org_Contacts_Attributes | |
| - (Org_Id : in String) | |
| - return Common.JSON_Large.Bounded_String | |
| - is | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Cursor : Queries.Org_Contacts_Attributes_Cursor; | |
| - DB_Connections : DB_Conn_Pool := Get_DB_Connections; | |
| - Value : JSON_Large.Bounded_String; | |
| - begin | |
| - Fetch_Data : | |
| - for k in DB_Connections'Range loop | |
| - Cursor.Fetch (DB_Connections (k).Host, | |
| - Queries.Org_Contacts_Attributes_Query, | |
| - Params => (1 => +Natural'Value (Org_Id))); | |
| - | |
| - if DB_Connections (k).Host.Success then | |
| - JSONIFY.Org_Contacts_Attributes (Cursor, Value); | |
| - | |
| - if Cursor.Processed_Rows > 0 then | |
| - Org_Contacts_Attributes_Cache.Write (Key => Org_Id, | |
| - Value => Value); | |
| - end if; | |
| - | |
| - exit Fetch_Data; | |
| - else | |
| - Failed_Query (Connection_Pool => DB_Connections, | |
| - Connection_Type => k); | |
| - end if; | |
| - end loop Fetch_Data; | |
| - | |
| - return Value; | |
| - end Get_Org_Contacts_Attributes; | |
| - | |
| - ----------------------------- | |
| - -- Get_Org_Contacts_Full -- | |
| - ----------------------------- | |
| - | |
| - function Get_Org_Contacts_Full | |
| - (Org_Id : in String) | |
| - return Common.JSON_Large.Bounded_String | |
| - is | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Cursor : Queries.Org_Contacts_Full_Cursor; | |
| - DB_Connections : DB_Conn_Pool := Get_DB_Connections; | |
| - Value : JSON_Large.Bounded_String; | |
| - begin | |
| - Fetch_Data : | |
| - for k in DB_Connections'Range loop | |
| - Cursor.Fetch (DB_Connections (k).Host, | |
| - Queries.Org_Contacts_Full_Query, | |
| - Params => (1 => +Natural'Value (Org_Id))); | |
| - | |
| - if DB_Connections (k).Host.Success then | |
| - JSONIFY.Org_Contacts_Full (Cursor, Value); | |
| - | |
| - if Cursor.Processed_Rows > 0 then | |
| - Org_Contacts_Full_Cache.Write (Key => Org_Id, | |
| - Value => Value); | |
| - end if; | |
| - | |
| - exit Fetch_Data; | |
| - else | |
| - Failed_Query (Connection_Pool => DB_Connections, | |
| - Connection_Type => k); | |
| - end if; | |
| - end loop Fetch_Data; | |
| - | |
| - return Value; | |
| - end Get_Org_Contacts_Full; | |
| - | |
| - ------------------------ | |
| - -- Get_Organization -- | |
| - ------------------------ | |
| - | |
| - function Get_Organization | |
| - (Org_Id : in String) | |
| - return Common.JSON_Small.Bounded_String | |
| - is | |
| - use Cache; | |
| - use Common; | |
| - use Errors; | |
| - use GNATCOLL.SQL.Exec; | |
| - | |
| - Cursor : Queries.Organization_Cursor; | |
| - DB_Connections : DB_Conn_Pool := Get_DB_Connections; | |
| - Value : JSON_Small.Bounded_String := | |
| - JSON_Small.Null_Bounded_String; | |
| - begin | |
| - Fetch_Data : | |
| - for k in DB_Connections'Range loop | |
| - Cursor.Fetch (DB_Connections (k).Host, | |
| - Queries.Organization_Query, | |
| - Params => (1 => +Natural'Value (Org_Id))); | |
| - | |
| - if DB_Connections (k).Host.Success then | |
| - JSONIFY.Organization (Cursor, Value); | |
| - | |
| - if Cursor.Processed_Rows > 0 then | |
| - Organization_Cache.Write (Key => Org_Id, | |
| - Value => Value); | |
| - end if; | |
| - | |
| - exit Fetch_Data; | |
| - else | |
| - Failed_Query (Connection_Pool => DB_Connections, | |
| - Connection_Type => k); | |
| - end if; | |
| - end loop Fetch_Data; | |
| - | |
| - return Value; | |
| - end Get_Organization; | |
| - | |
| -end Storage.Read; | |
| diff --git a/src/storage-read.ads b/src/storage-read.ads | |
| deleted file mode 100644 | |
| index e185c18..0000000 | |
| --- a/src/storage-read.ads | |
| +++ /dev/null | |
| @@ -1,73 +0,0 @@ | |
| -------------------------------------------------------------------------------- | |
| --- -- | |
| --- Alice -- | |
| --- -- | |
| --- Storage.Read -- | |
| --- -- | |
| --- SPEC -- | |
| --- -- | |
| --- Copyright (C) 2012-, AdaHeads K/S -- | |
| --- -- | |
| --- This is free software; you can redistribute it and/or modify it -- | |
| --- under terms of the GNU General Public License as published by the -- | |
| --- Free Software Foundation; either version 3, 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. -- | |
| --- You should have received a copy of the GNU General Public License and -- | |
| --- a copy of the GCC Runtime Library Exception along with this program; -- | |
| --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| --- <http://www.gnu.org/licenses/>. -- | |
| --- -- | |
| -------------------------------------------------------------------------------- | |
| - | |
| -with Common; | |
| - | |
| -package Storage.Read is | |
| - | |
| - function Get_Contact | |
| - (Ce_Id : in String) | |
| - return Common.JSON_Small.Bounded_String; | |
| - -- Return a Contact JSON string. This contains the data for ONE contact | |
| - -- entity. | |
| - | |
| - function Get_Contact_Attributes | |
| - (Ce_Id : in String) | |
| - return Common.JSON_Small.Bounded_String; | |
| - -- Return a Contact_Attributes JSON string. This contains attributes for | |
| - -- ONE contact entity. Note that one contact entity can have several | |
| - -- different attribute sets, depending on the organization the contact | |
| - -- belongs to. | |
| - | |
| - function Get_Contact_Full | |
| - (Ce_Id : in String) | |
| - return Common.JSON_Small.Bounded_String; | |
| - -- Return a Contact JSON string with Attributes. This contains the data for | |
| - -- ONE contact entity. | |
| - | |
| - function Get_Org_Contacts | |
| - (Org_Id : in String) | |
| - return Common.JSON_Large.Bounded_String; | |
| - -- Return a Contacts JSON string. This contains all the contactentities | |
| - -- belonging to Org_Id. | |
| - | |
| - function Get_Org_Contacts_Attributes | |
| - (Org_Id : in String) | |
| - return Common.JSON_Large.Bounded_String; | |
| - -- Return a Contacts_Attributes JSON string. This contains all the | |
| - -- contactentity attributes that relates to the given Org_Id, meaning one | |
| - -- set of attributes per contactentity that relates to Org_Id. | |
| - | |
| - function Get_Org_Contacts_Full | |
| - (Org_Id : in String) | |
| - return Common.JSON_Large.Bounded_String; | |
| - -- Return a Contacts JSON string with Attributes. This contains all the | |
| - -- contact entities belonging to Org_Id. | |
| - | |
| - function Get_Organization | |
| - (Org_Id : in String) | |
| - return Common.JSON_Small.Bounded_String; | |
| - -- Return an Organization JSON string. This contains the data for ONE | |
| - -- organization. | |
| - | |
| -end Storage.Read; | |
| diff --git a/src/storage.adb b/src/storage.adb | |
| index 1521e09..9f7deb0 100644 | |
| --- a/src/storage.adb | |
| +++ b/src/storage.adb | |
| @@ -24,7 +24,9 @@ | |
| with Ada.Characters.Latin_1; | |
| with Ada.Strings.Fixed; | |
| with Ada.Task_Attributes; | |
| +with Errors; | |
| with GNATCOLL.SQL.Postgres; | |
| +with HTTP_Codes; | |
| with My_Configuration; | |
| package body Storage is | |
| @@ -75,6 +77,85 @@ package body Storage is | |
| SSL => GNATCOLL.SQL.Postgres.Allow, | |
| Cache_Support => True)); | |
| + -------------------- | |
| + -- Failed_Query -- | |
| + -------------------- | |
| + | |
| + procedure Failed_Query | |
| + (Connection_Pool : in out DB_Conn_Pool; | |
| + Connection_Type : in DB_Conn_Type) | |
| + is | |
| + use Errors; | |
| + use GNATCOLL.SQL; | |
| + | |
| + Trimmed_DB_Error : constant String | |
| + := Trim (Exec.Error (Connection_Pool (Connection_Type).Host)); | |
| + | |
| + Connection : constant String | |
| + := DB_Conn_Type'Image (Connection_Type); | |
| + | |
| + Message : constant String := Trimmed_DB_Error & "-" & Connection; | |
| + begin | |
| + Connection_Pool (Connection_Type).State := Failed; | |
| + Register_Failed_DB_Connection (Pool => Connection_Pool); | |
| + | |
| + if Connection_Type = DB_Conn_Type'Last then | |
| + raise Database_Error with Message; | |
| + else | |
| + Error_Handler (Message); | |
| + end if; | |
| + end Failed_Query; | |
| + | |
| + -------------------- | |
| + -- Generic_JSON -- | |
| + -------------------- | |
| + | |
| + package body Generic_Query_To_JSON is | |
| + | |
| + procedure Generate | |
| + (Key : in String; | |
| + Request : in AWS.Status.Data; | |
| + Status : out AWS.Messages.Status_Code; | |
| + Value : out Common.JSON_String) | |
| + is | |
| + use GNATCOLL.SQL.Exec; | |
| + use HTTP_Codes; | |
| + use Storage; | |
| + | |
| + C : Cursor; | |
| + DB_Connections : DB_Conn_Pool := Get_DB_Connections; | |
| + begin | |
| + Status := Server_Error; | |
| + -- Assume the worst. | |
| + | |
| + Fetch_Data : | |
| + for k in DB_Connections'Range loop | |
| + C.Fetch (DB_Connections (k).Host, | |
| + Query, | |
| + Params => Query_Parameters (Request)); | |
| + | |
| + if DB_Connections (k).Host.Success then | |
| + JSONIFY (C, Value); | |
| + | |
| + if C.Processed_Rows > 0 then | |
| + Write_To_Cache (Key => Key, | |
| + Value => Value); | |
| + | |
| + Status := OK; | |
| + else | |
| + Status := Not_Found; | |
| + end if; | |
| + | |
| + exit Fetch_Data; | |
| + else | |
| + Storage.Failed_Query (Connection_Pool => DB_Connections, | |
| + Connection_Type => k); | |
| + end if; | |
| + end loop Fetch_Data; | |
| + end Generate; | |
| + | |
| + end Generic_Query_To_JSON; | |
| + | |
| -------------------------- | |
| -- Get_DB_Connections -- | |
| -------------------------- | |
| diff --git a/src/storage.ads b/src/storage.ads | |
| index 58f864e..13a8587 100644 | |
| --- a/src/storage.ads | |
| +++ b/src/storage.ads | |
| @@ -21,6 +21,9 @@ | |
| -- -- | |
| ------------------------------------------------------------------------------- | |
| +with AWS.Status; | |
| +with AWS.Messages; | |
| +with Common; | |
| with GNATCOLL.SQL.Exec; | |
| package Storage is | |
| @@ -46,6 +49,15 @@ package Storage is | |
| type DB_Conn_Pool is array (DB_Conn_Type) of DB_Conn; | |
| + procedure Failed_Query | |
| + (Connection_Pool : in out DB_Conn_Pool; | |
| + Connection_Type : in DB_Conn_Type); | |
| + -- If a query fails: | |
| + -- 1. Set the connection state to Failed. | |
| + -- 2. Raise the Database_Error exception if | |
| + -- Connection_Type = Database_Connection_Type'Last | |
| + -- 3. If 2 is not True, Output a message to the Error log trace. | |
| + | |
| function Get_DB_Connections | |
| return DB_Conn_Pool; | |
| -- Return an array with the primary and secondary database connections. | |
| @@ -72,4 +84,38 @@ package Storage is | |
| -- function is here because the errors thrown by PostgreSQL is postfixed | |
| -- with a \n which we must remove before sending the message to syslogd. | |
| + generic | |
| + | |
| + type Cursor is new GNATCOLL.SQL.Exec.Forward_Cursor with private; | |
| + | |
| + with function Query | |
| + return GNATCOLL.SQL.Exec.Prepared_Statement; | |
| + -- TODO: Write comment | |
| + | |
| + with procedure JSONIFY | |
| + (C : in out Cursor; | |
| + Value : in out Common.JSON_String); | |
| + -- TODO: Write comment | |
| + | |
| + with function Query_Parameters | |
| + (Request : in AWS.Status.Data) | |
| + return GNATCOLL.SQL.Exec.SQL_Parameters; | |
| + -- TODO: Write comment | |
| + | |
| + with procedure Write_To_Cache | |
| + (Key : in String; | |
| + Value : in Common.JSON_String); | |
| + -- TODO: Write comment | |
| + | |
| + package Generic_Query_To_JSON is | |
| + | |
| + procedure Generate | |
| + (Key : in String; | |
| + Request : in AWS.Status.Data; | |
| + Status : out AWS.Messages.Status_Code; | |
| + Value : out Common.JSON_String); | |
| + -- TODO: Write comment | |
| + | |
| + end Generic_Query_To_JSON; | |
| + | |
| end Storage; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment