-----------------------------------------------------------------------
--  util-events -- Events
--  Copyright (C) 2001, 2002, 2003, 2009, 2010 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;
package Util.Events is

   type Event is tagged private;

   --  Get the time identifying when the event was created.
   function Get_Time (Ev : Event) return Ada.Calendar.Time;

   type Event_Listener is limited interface;

private

   type Event is tagged record
      Date : Ada.Calendar.Time := Ada.Calendar.Clock;
   end record;

end Util.Events;

-----------------------------------------------------------------------
--  util-events -- Events
--  Copyright (C) 2001, 2002, 2003, 2009, 2010, 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;
package Util.Events is

   type Event is tagged limited private;

   --  Get the time identifying when the event was created.
   function Get_Time (Ev : Event) return Ada.Calendar.Time;

   type Event_Listener is limited interface;

private

   type Event is tagged limited record
      Date : Ada.Calendar.Time := Ada.Calendar.Clock;
   end record;

end Util.Events;

Change the Event type to a limited type

Change the Event type to a limited type


-----------------------------------------------------------------------
--  awa-settings --  Settings module
--  Copyright (C) 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
package AWA.Settings is

   --  Get the user setting identified by the given name.
   --  If the user does not have such setting, return the default value.
   function Get_User_Setting (Name    : in String;
                              Default : in String) return String;

   --  Get the user setting identified by the given name.
   --  If the user does not have such setting, return the default value.
   function Get_User_Setting (Name    : in String;
                              Default : in Integer) return Integer;

   --  Set the user setting identified by the given name.  If the user
   --  does not have such setting, it is created and set to the given value.
   --  Otherwise, the user setting is updated to hold the new value.
   procedure Set_User_Setting (Name   : in String;
                               Value  : in String);

   --  Set the user setting identified by the given name.  If the user
   --  does not have such setting, it is created and set to the given value.
   --  Otherwise, the user setting is updated to hold the new value.
   procedure Set_User_Setting (Name   : in String;
                               Value  : in Integer);

end AWA.Settings;

-----------------------------------------------------------------------
--  awa-settings --  Settings module
--  Copyright (C) 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Settings</b> module provides management of application and user settings.
--  A setting is identified by a unique name in the application.  It is saved in
--  the database and associated to a user.
--
--  === Getting a user setting ===
--  Getting a user setting is as simple as calling a function with the setting name
--  and the default value.  If the setting was modified by the user and saved in the
--  database, the saved value will be returned.  Otherwise, the default value is returned.
--  For example, if an application defines a <tt>row-per-page</tt> setting to define how
--  many rows are defined in a list, the user setting can be retrieved with:
--
--    Row_Per_Page : constant Integer := AWA.Settings.Get_User_Setting ("row-per-page", 10);
--
--  === Saving a user setting ===
--  When a user changes the setting value, we just have to save it in the database.
--  The setting value will either be updated if it exists or created.
--
--    AWA.Settings.Set_User_Setting ("row-per-page", 20);
--
--  == Model ==
--  [http://ada-awa.googlecode.com/svn/wiki/awa_settings_model.png]
--
package AWA.Settings is

   --  Get the user setting identified by the given name.
   --  If the user does not have such setting, return the default value.
   function Get_User_Setting (Name    : in String;
                              Default : in String) return String;

   --  Get the user setting identified by the given name.
   --  If the user does not have such setting, return the default value.
   function Get_User_Setting (Name    : in String;
                              Default : in Integer) return Integer;

   --  Set the user setting identified by the given name.  If the user
   --  does not have such setting, it is created and set to the given value.
   --  Otherwise, the user setting is updated to hold the new value.
   procedure Set_User_Setting (Name   : in String;
                               Value  : in String);

   --  Set the user setting identified by the given name.  If the user
   --  does not have such setting, it is created and set to the given value.
   --  Otherwise, the user setting is updated to hold the new value.
   procedure Set_User_Setting (Name   : in String;
                               Value  : in Integer);

end AWA.Settings;

Document the AWA.Settings module

Document the AWA.Settings module


-----------------------------------------------------------------------
--  security -- Security
--  Copyright (C) 2010, 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <tt>Security</tt> package provides security frameworks that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  @include security-permissions.ads
--  @include security-openid.ads
--  @include security-oauth.ads
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

-----------------------------------------------------------------------
--  security -- Security
--  Copyright (C) 2010, 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <tt>Security</tt> package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--  A permission is checked by using the security manager.  The security manager uses a
--  security controller to enforce the permission.
--
--  @include security-permissions.ads
--  @include security-openid.ads
--  @include security-oauth.ads
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

Document the permission

Document the permission


-----------------------------------------------------------------------
--  awa-jobs -- AWA Jobs
--  Copyright (C) 2012, 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Finalization;

with Util.Beans.Objects;
with Util.Beans.Objects.Maps;

with ADO.Sessions;
with ADO.Objects;

with AWA.Events;
with AWA.Jobs.Models;

--  == Job Service ==
--  The AWA.Jobs.Services package defines the type abstractions and the core operation
--  to define a job operation procedure, create and schedule a job and perform the job work
--  when it is scheduled.
--
--  @type Abstract_Job_Type
--
--  @type
package AWA.Jobs.Services is

   --  The job is closed.  The status cannot be modified.
   Closed_Error   : exception;

   --  The job is already scheduled.
   Schedule_Error : exception;

   --  The job had an execution error.
   Execute_Error  : exception;

   --  The parameter value is invalid and cannot be set on the job instance.
   Invalid_Value  : exception;

   --  Event posted when a job is created.
   package Job_Create_Event is new AWA.Events.Definition (Name => "job-create");

   --  Get the job status.
   function Get_Job_Status (Id : in ADO.Identifier) return AWA.Jobs.Models.Job_Status_Type;

   --  ------------------------------
   --  Abstract_Job Type
   --  ------------------------------
   --  The Abstract_Job_Type is an abstract tagged record which defines a job that can be
   --  scheduled and executed.  This is the base type of any job implementation.  It defines
   --  the <tt>Execute</tt> abstract procedure that must be implemented in concrete job types.
   --  It provides operation to setup and retrieve the job parameter.  When the job
   --  <tt>Execute</tt> procedure is called, it allows to set the job execution status and result.
   type Abstract_Job_Type is abstract new Ada.Finalization.Limited_Controlled with private;
   type Abstract_Job_Access is access all Abstract_Job_Type'Class;

   type Work_Access is access procedure (Job : in out Abstract_Job_Type'Class);

   --  Execute the job.  This operation must be implemented and should perform the work
   --  represented by the job.  It should use the <tt>Get_Parameter</tt> function to retrieve
   --  the job parameter and it can use the <tt>Set_Result</tt> operation to save the result.
   procedure Execute (Job : in out Abstract_Job_Type) is abstract;

   --  Set the job parameter identified by the Name to the value given in Value.
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in String);

   --  Set the job parameter identified by the Name to the value given in Value.
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in Integer);

   --  Set the job parameter identified by the Name to the value given in Value.
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in ADO.Objects.Object_Ref'Class);

   --  Set the job parameter identified by the Name to the value given in Value.
   --  The value object can hold any kind of basic value type (integer, enum, date, strings).
   --  If the value represents a bean, the <tt>Invalid_Value</tt> exception is raised.
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in Util.Beans.Objects.Object);

   --  Get the job parameter identified by the Name and convert the value into a string.
   function Get_Parameter (Job  : in Abstract_Job_Type;
                           Name : in String) return String;

   --  Get the job parameter identified by the Name and convert the value as an integer.
   --  If the parameter is not defined, return the default value passed in Default.
   function Get_Parameter (Job     : in Abstract_Job_Type;
                           Name    : in String;
                           Default : in Integer) return Integer;

   --  Get the job parameter identified by the Name and return it as a typed object.
   function Get_Parameter (Job  : in Abstract_Job_Type;
                           Name : in String) return Util.Beans.Objects.Object;

   --  Get the job status.
   function Get_Status (Job : in Abstract_Job_Type) return AWA.Jobs.Models.Job_Status_Type;

   --  Get the job identifier once the job was scheduled.  The job identifier allows to
   --  retrieve the job and check its execution and completion status later on.
   function Get_Identifier (Job : in Abstract_Job_Type) return ADO.Identifier;

   --  Set the job status.
   --  When the job is terminated, it is closed and the job parameters or results cannot be
   --  changed.
   procedure Set_Status (Job    : in out Abstract_Job_Type;
                         Status : in AWA.Jobs.Models.Job_Status_Type);

   --  Set the job result identified by the Name to the value given in Value.
   --  The value object can hold any kind of basic value type (integer, enum, date, strings).
   --  If the value represents a bean, the <tt>Invalid_Value</tt> exception is raised.
   procedure Set_Result (Job   : in out Abstract_Job_Type;
                         Name  : in String;
                         Value : in Util.Beans.Objects.Object);

   --  Set the job result identified by the Name to the value given in Value.
   procedure Set_Result (Job   : in out Abstract_Job_Type;
                         Name  : in String;
                         Value : in String);

   --  Save the job information in the database.  Use the database session defined by DB
   --  to save the job.
   procedure Save (Job : in out Abstract_Job_Type;
                   DB  : in out ADO.Sessions.Master_Session'Class);
   --  ------------------------------
   --  Job Factory
   --  ------------------------------
   --  The Job_Factory is the interface that allows to create a job instance in order
   --  to execute a scheduled job.  The <tt>Create</tt> function is called to create a new
   --  job instance when the job is scheduled for execution.
   type Job_Factory is abstract tagged limited null record;
   type Job_Factory_Access is access all Job_Factory'Class;

   --  Create the job instance using the job factory.
   function Create (Factory : in Job_Factory) return Abstract_Job_Access is abstract;

   --  Get the job factory name.
   function Get_Name (Factory : in Job_Factory'Class) return String;

   --  Schedule the job.
   procedure Schedule (Job        : in out Abstract_Job_Type;
                       Definition : in Job_Factory'Class);

   --  ------------------------------
   --  Job Type
   --  ------------------------------
   --  The <tt>Job_Type</tt> is a concrete job used by the <tt>Work_Factory</tt> to execute
   --  a simple <tt>Work_Access</tt> procedure.
   type Job_Type is new Abstract_Job_Type with private;

   overriding
   procedure Execute (Job : in out Job_Type);

   --  ------------------------------
   --  Work Factory
   --  ------------------------------
   --  The <tt>Work_Factory</tt> is a simplified <tt>Job_Factory</tt> that allows to register
   --  simple <tt>Work_Access</tt> procedures to execute the job.
   type Work_Factory (Work : Work_Access) is new Job_Factory with null record;

   --  Create the job instance to execute the associated <tt>Work_Access</tt> procedure.
   overriding
   function Create (Factory : in Work_Factory) return Abstract_Job_Access;

   --  ------------------------------
   --  Job Declaration
   --  ------------------------------
   --  The <tt>Definition</tt> package must be instantiated with a given job type to
   --  register the new job definition.
   generic
      type T is new Abstract_Job_Type with private;
   package Definition is
      type Job_Type_Factory is new Job_Factory with null record;

      overriding
      function Create (Factory : in Job_Type_Factory) return Abstract_Job_Access;

      --  The job factory.
      Factory : constant Job_Factory_Access;

   private
      Instance : aliased Job_Type_Factory;
      Factory  : constant Job_Factory_Access := Instance'Access;
   end Definition;

   generic
      Work : in Work_Access;
   package Work_Definition is
      type S_Factory is new Work_Factory with null record;

      --  The job factory.
      Factory : constant Job_Factory_Access;
   private
      Instance : aliased S_Factory := S_Factory '(Work => Work);
      Factory  : constant Job_Factory_Access := Instance'Access;
   end Work_Definition;

   --  Execute the job associated with the given event.
   procedure Execute (Event : in AWA.Events.Module_Event'Class);

private

   --  Execute the job and save the job information in the database.
   procedure Execute (Job : in out Abstract_Job_Type'Class;
                      DB  : in out ADO.Sessions.Master_Session'Class);

   type Abstract_Job_Type is abstract new Ada.Finalization.Limited_Controlled with record
      Job              : AWA.Jobs.Models.Job_Ref;
      Props            : Util.Beans.Objects.Maps.Map;
      Results          : Util.Beans.Objects.Maps.Map;
      Props_Modified   : Boolean := False;
      Results_Modified : Boolean := False;
   end record;

   --  ------------------------------
   --  Job Type
   --  ------------------------------
   --  The <tt>Job_Type</tt> is a concrete job used by the <tt>Work_Factory</tt> to execute
   --  a simple <tt>Work_Access</tt> procedure.
   type Job_Type is new Abstract_Job_Type with record
      Work : Work_Access;
   end record;

end AWA.Jobs.Services;

-----------------------------------------------------------------------
--  awa-jobs -- AWA Jobs
--  Copyright (C) 2012, 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Finalization;

with Util.Beans.Objects;
with Util.Beans.Objects.Maps;

with ADO.Sessions;
with ADO.Objects;

with AWA.Events;
with AWA.Jobs.Models;

--  == Job Service ==
--  The AWA.Jobs.Services package defines the type abstractions and the core operation
--  to define a job operation procedure, create and schedule a job and perform the job work
--  when it is scheduled.
--
--  @type Abstract_Job_Type
--
--  @type
package AWA.Jobs.Services is

   --  The job is closed.  The status cannot be modified.
   Closed_Error   : exception;

   --  The job is already scheduled.
   Schedule_Error : exception;

   --  The job had an execution error.
   Execute_Error  : exception;

   --  The parameter value is invalid and cannot be set on the job instance.
   Invalid_Value  : exception;

   --  Event posted when a job is created.
   package Job_Create_Event is new AWA.Events.Definition (Name => "job-create");

   --  Get the job status.
   function Get_Job_Status (Id : in ADO.Identifier) return AWA.Jobs.Models.Job_Status_Type;

   --  ------------------------------
   --  Abstract_Job Type
   --  ------------------------------
   --  The Abstract_Job_Type is an abstract tagged record which defines a job that can be
   --  scheduled and executed.  This is the base type of any job implementation.  It defines
   --  the <tt>Execute</tt> abstract procedure that must be implemented in concrete job types.
   --  It provides operation to setup and retrieve the job parameter.  When the job
   --  <tt>Execute</tt> procedure is called, it allows to set the job execution status and result.
   type Abstract_Job_Type is abstract new Ada.Finalization.Limited_Controlled with private;
   type Abstract_Job_Access is access all Abstract_Job_Type'Class;

   type Work_Access is access procedure (Job : in out Abstract_Job_Type'Class);

   --  Execute the job.  This operation must be implemented and should perform the work
   --  represented by the job.  It should use the <tt>Get_Parameter</tt> function to retrieve
   --  the job parameter and it can use the <tt>Set_Result</tt> operation to save the result.
   procedure Execute (Job : in out Abstract_Job_Type) is abstract;

   --  Set the job parameter identified by the Name to the value given in Value.
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in String);

   --  Set the job parameter identified by the Name to the value given in Value.
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in Integer);

   --  Set the job parameter identified by the Name to the value given in Value.
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in ADO.Objects.Object_Ref'Class);

   --  Set the job parameter identified by the Name to the value given in Value.
   --  The value object can hold any kind of basic value type (integer, enum, date, strings).
   --  If the value represents a bean, the <tt>Invalid_Value</tt> exception is raised.
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in Util.Beans.Objects.Object);

   --  Get the job parameter identified by the Name and convert the value into a string.
   function Get_Parameter (Job  : in Abstract_Job_Type;
                           Name : in String) return String;

   --  Get the job parameter identified by the Name and convert the value as an integer.
   --  If the parameter is not defined, return the default value passed in Default.
   function Get_Parameter (Job     : in Abstract_Job_Type;
                           Name    : in String;
                           Default : in Integer) return Integer;

   --  Get the job parameter identified by the Name and convert the value as a database
   --  identifier.  If the parameter is not defined, return the <tt>ADO.NO_IDENTIFIER</tt>.
   function Get_Parameter (Job     : in Abstract_Job_Type;
                           Name    : in String) return ADO.Identifier;

   --  Get the job parameter identified by the Name and return it as a typed object.
   function Get_Parameter (Job  : in Abstract_Job_Type;
                           Name : in String) return Util.Beans.Objects.Object;

   --  Get the job status.
   function Get_Status (Job : in Abstract_Job_Type) return AWA.Jobs.Models.Job_Status_Type;

   --  Get the job identifier once the job was scheduled.  The job identifier allows to
   --  retrieve the job and check its execution and completion status later on.
   function Get_Identifier (Job : in Abstract_Job_Type) return ADO.Identifier;

   --  Set the job status.
   --  When the job is terminated, it is closed and the job parameters or results cannot be
   --  changed.
   procedure Set_Status (Job    : in out Abstract_Job_Type;
                         Status : in AWA.Jobs.Models.Job_Status_Type);

   --  Set the job result identified by the Name to the value given in Value.
   --  The value object can hold any kind of basic value type (integer, enum, date, strings).
   --  If the value represents a bean, the <tt>Invalid_Value</tt> exception is raised.
   procedure Set_Result (Job   : in out Abstract_Job_Type;
                         Name  : in String;
                         Value : in Util.Beans.Objects.Object);

   --  Set the job result identified by the Name to the value given in Value.
   procedure Set_Result (Job   : in out Abstract_Job_Type;
                         Name  : in String;
                         Value : in String);

   --  Save the job information in the database.  Use the database session defined by DB
   --  to save the job.
   procedure Save (Job : in out Abstract_Job_Type;
                   DB  : in out ADO.Sessions.Master_Session'Class);
   --  ------------------------------
   --  Job Factory
   --  ------------------------------
   --  The Job_Factory is the interface that allows to create a job instance in order
   --  to execute a scheduled job.  The <tt>Create</tt> function is called to create a new
   --  job instance when the job is scheduled for execution.
   type Job_Factory is abstract tagged limited null record;
   type Job_Factory_Access is access all Job_Factory'Class;

   --  Create the job instance using the job factory.
   function Create (Factory : in Job_Factory) return Abstract_Job_Access is abstract;

   --  Get the job factory name.
   function Get_Name (Factory : in Job_Factory'Class) return String;

   --  Schedule the job.
   procedure Schedule (Job        : in out Abstract_Job_Type;
                       Definition : in Job_Factory'Class);

   --  ------------------------------
   --  Job Type
   --  ------------------------------
   --  The <tt>Job_Type</tt> is a concrete job used by the <tt>Work_Factory</tt> to execute
   --  a simple <tt>Work_Access</tt> procedure.
   type Job_Type is new Abstract_Job_Type with private;

   overriding
   procedure Execute (Job : in out Job_Type);

   --  ------------------------------
   --  Work Factory
   --  ------------------------------
   --  The <tt>Work_Factory</tt> is a simplified <tt>Job_Factory</tt> that allows to register
   --  simple <tt>Work_Access</tt> procedures to execute the job.
   type Work_Factory (Work : Work_Access) is new Job_Factory with null record;

   --  Create the job instance to execute the associated <tt>Work_Access</tt> procedure.
   overriding
   function Create (Factory : in Work_Factory) return Abstract_Job_Access;

   --  ------------------------------
   --  Job Declaration
   --  ------------------------------
   --  The <tt>Definition</tt> package must be instantiated with a given job type to
   --  register the new job definition.
   generic
      type T is new Abstract_Job_Type with private;
   package Definition is
      type Job_Type_Factory is new Job_Factory with null record;

      overriding
      function Create (Factory : in Job_Type_Factory) return Abstract_Job_Access;

      --  The job factory.
      Factory : constant Job_Factory_Access;

   private
      Instance : aliased Job_Type_Factory;
      Factory  : constant Job_Factory_Access := Instance'Access;
   end Definition;

   generic
      Work : in Work_Access;
   package Work_Definition is
      type S_Factory is new Work_Factory with null record;

      --  The job factory.
      Factory : constant Job_Factory_Access;
   private
      Instance : aliased S_Factory := S_Factory '(Work => Work);
      Factory  : constant Job_Factory_Access := Instance'Access;
   end Work_Definition;

   --  Execute the job associated with the given event.
   procedure Execute (Event : in AWA.Events.Module_Event'Class);

private

   --  Execute the job and save the job information in the database.
   procedure Execute (Job : in out Abstract_Job_Type'Class;
                      DB  : in out ADO.Sessions.Master_Session'Class);

   type Abstract_Job_Type is abstract new Ada.Finalization.Limited_Controlled with record
      Job              : AWA.Jobs.Models.Job_Ref;
      Props            : Util.Beans.Objects.Maps.Map;
      Results          : Util.Beans.Objects.Maps.Map;
      Props_Modified   : Boolean := False;
      Results_Modified : Boolean := False;
   end record;

   --  ------------------------------
   --  Job Type
   --  ------------------------------
   --  The <tt>Job_Type</tt> is a concrete job used by the <tt>Work_Factory</tt> to execute
   --  a simple <tt>Work_Access</tt> procedure.
   type Job_Type is new Abstract_Job_Type with record
      Work : Work_Access;
   end record;

end AWA.Jobs.Services;

Declare the Get_Parameter procedure to retrieve a database identifier


-----------------------------------------------------------------------
--  util-http-clients-curl -- HTTP Clients with CURL
--  Copyright (C) 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Strings;
with Util.Log.Loggers;
with Util.Http.Clients.Curl.Constants;
package body Util.Http.Clients.Curl is

   use System;

   pragma Linker_Options ("-lcurl");

   Log   : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients.Curl");

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access;

   Manager : aliased Curl_Http_Manager;

   --  ------------------------------
   --  Register the CURL Http manager.
   --  ------------------------------
   procedure Register is
   begin
      Default_Http_Manager := Manager'Access;
   end Register;

   --  ------------------------------
   --  Check the CURL result code and report and exception and a log message if
   --  the CURL code indicates an error.
   --  ------------------------------
   procedure Check_Code (Code    : in CURL_Code;
                         Message : in String) is
   begin
      if Code /= CURLE_OK then
         declare
            Error : constant Chars_Ptr := Curl_Easy_Strerror (Code);
            Msg   : constant String := Interfaces.C.Strings.Value (Error);
         begin
            Log.Error ("{0}: {1}", Message, Msg);
            raise Connection_Error with Msg;
         end;
      end if;
   end Check_Code;

   --  ------------------------------
   --  Create a new HTTP request associated with the current request manager.
   --  ------------------------------
   procedure Create (Manager  : in Curl_Http_Manager;
                     Http     : in out Client'Class) is
      pragma Unreferenced (Manager);

      Request : Curl_Http_Request_Access;
      Data    : CURL;
   begin
      Data := Curl_Easy_Init;
      if Data = System.Null_Address then
         raise Storage_Error with "curl_easy_init cannot create the CURL instance";
      end if;
      Request := new Curl_Http_Request;
      Request.Data  := Data;
      Http.Delegate := Request.all'Access;
   end Create;

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access is
   begin
      return Curl_Http_Request'Class (Http.Delegate.all)'Access;
   end Get_Request;

   --  ------------------------------
   --  This function is called by CURL when a response line was read.
   --  ------------------------------
   function Read_Response (Data     : in Chars_Ptr;
                           Size     : in Size_T;
                           Nmemb    : in Size_T;
                           Response : in Curl_Http_Response_Access) return Size_T is

      Total : constant Size_T := Size * Nmemb;
      Line  : constant String := Interfaces.C.Strings.Value (Data, Total);
   begin
      Log.Info ("RCV: {0}", Line);
      if Response.Parsing_Body then
         Ada.Strings.Unbounded.Append (Response.Content, Line);

      elsif Total = 2 and then Line (1) = ASCII.CR and then Line (2) = ASCII.LF then
         Response.Parsing_Body := True;

      else
         declare
            Pos   : constant Natural := Util.Strings.Index (Line, ':');
            Start : Natural;
            Last  : Natural;
         begin
            if Pos > 0 then
               Start := Pos + 1;
               while Start <= Line'Last and Line (Start) = ' ' loop
                  Start := Start + 1;
               end loop;
               Last := Line'Last;
               while Last >= Start and (Line (Last) = ASCII.CR or Line (Last) = ASCII.LF) loop
                  Last := Last - 1;
               end loop;
               Response.Add_Header (Name  => Line (Line'First .. Pos - 1),
                                    Value => Line (Start .. Last));
            end if;
         end;
      end if;
      return Total;
   end Read_Response;

   procedure Do_Get (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("GET {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Get;

   procedure Do_Post (Manager  : in Curl_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("POST {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Interfaces.C.Strings.Free (Req.Content);
      Req.Content := Strings.New_String (Data);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_POSTFIELDS, Req.Content);
      Check_Code (Result, "set post data");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POSTFIELDSIZE, Data'Length);
      Check_Code (Result, "set post data");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Post;

   overriding
   procedure Finalize (Request : in out Curl_Http_Request) is
   begin
      if Request.Data /= System.Null_Address then
         Curl_Easy_Cleanup (Request.Data);
         Request.Data := System.Null_Address;
      end if;
      if Request.Headers /= null then
         Curl_Slist_Free_All (Request.Headers);
         Request.Headers := null;
      end if;
      Interfaces.C.Strings.Free (Request.URL);
      Interfaces.C.Strings.Free (Request.Content);
   end Finalize;

   --  ------------------------------
   --  Get the response body as a string.
   --  ------------------------------
   overriding
   function Get_Body (Reply : in Curl_Http_Response) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Reply.Content);
   end Get_Body;

   --  ------------------------------
   --  Get the response status code.
   --  ------------------------------
   overriding
   function Get_Status (Reply : in Curl_Http_Response) return Natural is
   begin
      return Reply.Status;
   end Get_Status;

end Util.Http.Clients.Curl;

-----------------------------------------------------------------------
--  util-http-clients-curl -- HTTP Clients with CURL
--  Copyright (C) 2012, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Strings;
with Util.Log.Loggers;
with Util.Http.Clients.Curl.Constants;
package body Util.Http.Clients.Curl is

   use System;

   pragma Linker_Options ("-lcurl");

   Log   : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients.Curl");

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access;

   Manager : aliased Curl_Http_Manager;

   --  ------------------------------
   --  Register the CURL Http manager.
   --  ------------------------------
   procedure Register is
   begin
      Default_Http_Manager := Manager'Access;
   end Register;

   --  ------------------------------
   --  Check the CURL result code and report and exception and a log message if
   --  the CURL code indicates an error.
   --  ------------------------------
   procedure Check_Code (Code    : in CURL_Code;
                         Message : in String) is
   begin
      if Code /= CURLE_OK then
         declare
            Error : constant Chars_Ptr := Curl_Easy_Strerror (Code);
            Msg   : constant String := Interfaces.C.Strings.Value (Error);
         begin
            Log.Error ("{0}: {1}", Message, Msg);
            raise Connection_Error with Msg;
         end;
      end if;
   end Check_Code;

   --  ------------------------------
   --  Create a new HTTP request associated with the current request manager.
   --  ------------------------------
   procedure Create (Manager  : in Curl_Http_Manager;
                     Http     : in out Client'Class) is
      pragma Unreferenced (Manager);

      Request : Curl_Http_Request_Access;
      Data    : CURL;
   begin
      Data := Curl_Easy_Init;
      if Data = System.Null_Address then
         raise Storage_Error with "curl_easy_init cannot create the CURL instance";
      end if;
      Request := new Curl_Http_Request;
      Request.Data  := Data;
      Http.Delegate := Request.all'Access;
   end Create;

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access is
   begin
      return Curl_Http_Request'Class (Http.Delegate.all)'Access;
   end Get_Request;

   --  ------------------------------
   --  This function is called by CURL when a response line was read.
   --  ------------------------------
   function Read_Response (Data     : in Chars_Ptr;
                           Size     : in Size_T;
                           Nmemb    : in Size_T;
                           Response : in Curl_Http_Response_Access) return Size_T is

      Total : constant Size_T := Size * Nmemb;
      Line  : constant String := Interfaces.C.Strings.Value (Data, Total);
   begin
      Log.Info ("RCV: {0}", Line);
      if Response.Parsing_Body then
         Ada.Strings.Unbounded.Append (Response.Content, Line);

      elsif Total = 2 and then Line (1) = ASCII.CR and then Line (2) = ASCII.LF then
         Response.Parsing_Body := True;

      else
         declare
            Pos   : constant Natural := Util.Strings.Index (Line, ':');
            Start : Natural;
            Last  : Natural;
         begin
            if Pos > 0 then
               Start := Pos + 1;
               while Start <= Line'Last and Line (Start) = ' ' loop
                  Start := Start + 1;
               end loop;
               Last := Line'Last;
               while Last >= Start and (Line (Last) = ASCII.CR or Line (Last) = ASCII.LF) loop
                  Last := Last - 1;
               end loop;
               Response.Add_Header (Name  => Line (Line'First .. Pos - 1),
                                    Value => Line (Start .. Last));
            end if;
         end;
      end if;
      return Total;
   end Read_Response;

   procedure Do_Get (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("GET {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HTTPGET, 1);
      Check_Code (Result, "set http GET");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Get;

   procedure Do_Post (Manager  : in Curl_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("POST {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Interfaces.C.Strings.Free (Req.Content);
      Req.Content := Strings.New_String (Data);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POST, 1);
      Check_Code (Result, "set http POST");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_POSTFIELDS, Req.Content);
      Check_Code (Result, "set post data");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POSTFIELDSIZE, Data'Length);
      Check_Code (Result, "set post data");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Post;

   overriding
   procedure Finalize (Request : in out Curl_Http_Request) is
   begin
      if Request.Data /= System.Null_Address then
         Curl_Easy_Cleanup (Request.Data);
         Request.Data := System.Null_Address;
      end if;
      if Request.Headers /= null then
         Curl_Slist_Free_All (Request.Headers);
         Request.Headers := null;
      end if;
      Interfaces.C.Strings.Free (Request.URL);
      Interfaces.C.Strings.Free (Request.Content);
   end Finalize;

   --  ------------------------------
   --  Get the response body as a string.
   --  ------------------------------
   overriding
   function Get_Body (Reply : in Curl_Http_Response) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Reply.Content);
   end Get_Body;

   --  ------------------------------
   --  Get the response status code.
   --  ------------------------------
   overriding
   function Get_Status (Reply : in Curl_Http_Response) return Natural is
   begin
      return Reply.Status;
   end Get_Status;

end Util.Http.Clients.Curl;

Fix the Get and Post operation to explicitly set the GET or POST operation on each request (because curl keeps the previous settings)


-----------------------------------------------------------------------
--  util-http-clients-curl -- HTTP Clients with CURL
--  Copyright (C) 2012, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Strings;
with Util.Log.Loggers;
with Util.Http.Clients.Curl.Constants;
package body Util.Http.Clients.Curl is

   use System;

   pragma Linker_Options ("-lcurl");

   Log   : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients.Curl");

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access;

   Manager : aliased Curl_Http_Manager;

   --  ------------------------------
   --  Register the CURL Http manager.
   --  ------------------------------
   procedure Register is
   begin
      Default_Http_Manager := Manager'Access;
   end Register;

   --  ------------------------------
   --  Check the CURL result code and report and exception and a log message if
   --  the CURL code indicates an error.
   --  ------------------------------
   procedure Check_Code (Code    : in CURL_Code;
                         Message : in String) is
   begin
      if Code /= CURLE_OK then
         declare
            Error : constant Chars_Ptr := Curl_Easy_Strerror (Code);
            Msg   : constant String := Interfaces.C.Strings.Value (Error);
         begin
            Log.Error ("{0}: {1}", Message, Msg);
            raise Connection_Error with Msg;
         end;
      end if;
   end Check_Code;

   --  ------------------------------
   --  Create a new HTTP request associated with the current request manager.
   --  ------------------------------
   procedure Create (Manager  : in Curl_Http_Manager;
                     Http     : in out Client'Class) is
      pragma Unreferenced (Manager);

      Request : Curl_Http_Request_Access;
      Data    : CURL;
   begin
      Data := Curl_Easy_Init;
      if Data = System.Null_Address then
         raise Storage_Error with "curl_easy_init cannot create the CURL instance";
      end if;
      Request := new Curl_Http_Request;
      Request.Data  := Data;
      Http.Delegate := Request.all'Access;
   end Create;

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access is
   begin
      return Curl_Http_Request'Class (Http.Delegate.all)'Access;
   end Get_Request;

   --  ------------------------------
   --  This function is called by CURL when a response line was read.
   --  ------------------------------
   function Read_Response (Data     : in Chars_Ptr;
                           Size     : in Size_T;
                           Nmemb    : in Size_T;
                           Response : in Curl_Http_Response_Access) return Size_T is

      Total : constant Size_T := Size * Nmemb;
      Line  : constant String := Interfaces.C.Strings.Value (Data, Total);
   begin
      Log.Info ("RCV: {0}", Line);
      if Response.Parsing_Body then
         Ada.Strings.Unbounded.Append (Response.Content, Line);

      elsif Total = 2 and then Line (1) = ASCII.CR and then Line (2) = ASCII.LF then
         Response.Parsing_Body := True;

      else
         declare
            Pos   : constant Natural := Util.Strings.Index (Line, ':');
            Start : Natural;
            Last  : Natural;
         begin
            if Pos > 0 then
               Start := Pos + 1;
               while Start <= Line'Last and Line (Start) = ' ' loop
                  Start := Start + 1;
               end loop;
               Last := Line'Last;
               while Last >= Start and (Line (Last) = ASCII.CR or Line (Last) = ASCII.LF) loop
                  Last := Last - 1;
               end loop;
               Response.Add_Header (Name  => Line (Line'First .. Pos - 1),
                                    Value => Line (Start .. Last));
            end if;
         end;
      end if;
      return Total;
   end Read_Response;

   procedure Do_Get (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("GET {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HTTPGET, 1);
      Check_Code (Result, "set http GET");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Get;

   procedure Do_Post (Manager  : in Curl_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("POST {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Interfaces.C.Strings.Free (Req.Content);
      Req.Content := Strings.New_String (Data);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POST, 1);
      Check_Code (Result, "set http POST");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_POSTFIELDS, Req.Content);
      Check_Code (Result, "set post data");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POSTFIELDSIZE, Data'Length);
      Check_Code (Result, "set post data");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Post;

   overriding
   procedure Finalize (Request : in out Curl_Http_Request) is
   begin
      if Request.Data /= System.Null_Address then
         Curl_Easy_Cleanup (Request.Data);
         Request.Data := System.Null_Address;
      end if;
      if Request.Headers /= null then
         Curl_Slist_Free_All (Request.Headers);
         Request.Headers := null;
      end if;
      Interfaces.C.Strings.Free (Request.URL);
      Interfaces.C.Strings.Free (Request.Content);
   end Finalize;

   --  ------------------------------
   --  Get the response body as a string.
   --  ------------------------------
   overriding
   function Get_Body (Reply : in Curl_Http_Response) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Reply.Content);
   end Get_Body;

   --  ------------------------------
   --  Get the response status code.
   --  ------------------------------
   overriding
   function Get_Status (Reply : in Curl_Http_Response) return Natural is
   begin
      return Reply.Status;
   end Get_Status;

end Util.Http.Clients.Curl;

-----------------------------------------------------------------------
--  util-http-clients-curl -- HTTP Clients with CURL
--  Copyright (C) 2012, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Strings;
with Util.Log.Loggers;
with Util.Http.Clients.Curl.Constants;
package body Util.Http.Clients.Curl is

   use System;

   pragma Linker_Options ("-lcurl");

   Log   : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients.Curl");

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access;

   Manager : aliased Curl_Http_Manager;

   --  ------------------------------
   --  Register the CURL Http manager.
   --  ------------------------------
   procedure Register is
   begin
      Default_Http_Manager := Manager'Access;
   end Register;

   --  ------------------------------
   --  Check the CURL result code and report and exception and a log message if
   --  the CURL code indicates an error.
   --  ------------------------------
   procedure Check_Code (Code    : in CURL_Code;
                         Message : in String) is
   begin
      if Code /= CURLE_OK then
         declare
            Error : constant Chars_Ptr := Curl_Easy_Strerror (Code);
            Msg   : constant String := Interfaces.C.Strings.Value (Error);
         begin
            Log.Error ("{0}: {1}", Message, Msg);
            raise Connection_Error with Msg;
         end;
      end if;
   end Check_Code;

   --  ------------------------------
   --  Create a new HTTP request associated with the current request manager.
   --  ------------------------------
   procedure Create (Manager  : in Curl_Http_Manager;
                     Http     : in out Client'Class) is
      pragma Unreferenced (Manager);

      Request : Curl_Http_Request_Access;
      Data    : CURL;
   begin
      Data := Curl_Easy_Init;
      if Data = System.Null_Address then
         raise Storage_Error with "curl_easy_init cannot create the CURL instance";
      end if;
      Request := new Curl_Http_Request;
      Request.Data  := Data;
      Http.Delegate := Request.all'Access;
   end Create;

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access is
   begin
      return Curl_Http_Request'Class (Http.Delegate.all)'Access;
   end Get_Request;

   --  ------------------------------
   --  This function is called by CURL when a response line was read.
   --  ------------------------------
   function Read_Response (Data     : in Chars_Ptr;
                           Size     : in Size_T;
                           Nmemb    : in Size_T;
                           Response : in Curl_Http_Response_Access) return Size_T is

      Total : constant Size_T := Size * Nmemb;
      Line  : constant String := Interfaces.C.Strings.Value (Data, Total);
   begin
      Log.Info ("RCV: {0}", Line);
      if Response.Parsing_Body then
         Ada.Strings.Unbounded.Append (Response.Content, Line);

      elsif Total = 2 and then Line (1) = ASCII.CR and then Line (2) = ASCII.LF then
         Response.Parsing_Body := True;

      else
         declare
            Pos   : constant Natural := Util.Strings.Index (Line, ':');
            Start : Natural;
            Last  : Natural;
         begin
            if Pos > 0 then
               Start := Pos + 1;
               while Start <= Line'Last and Line (Start) = ' ' loop
                  Start := Start + 1;
               end loop;
               Last := Line'Last;
               while Last >= Start and (Line (Last) = ASCII.CR or Line (Last) = ASCII.LF) loop
                  Last := Last - 1;
               end loop;
               Response.Add_Header (Name  => Line (Line'First .. Pos - 1),
                                    Value => Line (Start .. Last));
            end if;
         end;
      end if;
      return Total;
   end Read_Response;

   --  ------------------------------
   --  Prepare to setup the headers in the request.
   --  ------------------------------
   procedure Set_Headers (Request : in out Curl_Http_Request) is

      procedure Process (Name, Value : in String) is
         S : Chars_Ptr := Strings.New_String (Name & ": " & Value);
      begin
         Request.Curl_Headers := Curl_Slist_Append (Request.Curl_Headers, S);
         Interfaces.C.Strings.Free (S);
      end Process;

   begin
      if Request.Curl_Headers /= null then
         Curl_Slist_Free_All (Request.Curl_Headers);
         Request.Curl_Headers := null;
      end if;

      Request.Iterate_Headers (Process'Access);
   end Set_Headers;

   procedure Do_Get (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("GET {0}", URI);
      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");

      Req.Set_Headers;

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HTTPGET, 1);
      Check_Code (Result, "set http GET");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_Slist (Req.Data, Constants.CURLOPT_HTTPHEADER, Req.Curl_Headers);
      Check_Code (Result, "set http GET headers");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Get;

   procedure Do_Post (Manager  : in Curl_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("POST {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");
      Req.Set_Headers;

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Interfaces.C.Strings.Free (Req.Content);
      Req.Content := Strings.New_String (Data);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POST, 1);
      Check_Code (Result, "set http POST");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_Slist (Req.Data, Constants.CURLOPT_HTTPHEADER, Req.Curl_Headers);
      Check_Code (Result, "set http GET headers");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_POSTFIELDS, Req.Content);
      Check_Code (Result, "set post data");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POSTFIELDSIZE, Data'Length);
      Check_Code (Result, "set post data");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Post;

   overriding
   procedure Finalize (Request : in out Curl_Http_Request) is
   begin
      if Request.Data /= System.Null_Address then
         Curl_Easy_Cleanup (Request.Data);
         Request.Data := System.Null_Address;
      end if;
      if Request.Curl_Headers /= null then
         Curl_Slist_Free_All (Request.Curl_Headers);
         Request.Curl_Headers := null;
      end if;
      Interfaces.C.Strings.Free (Request.URL);
      Interfaces.C.Strings.Free (Request.Content);
   end Finalize;

   --  ------------------------------
   --  Get the response body as a string.
   --  ------------------------------
   overriding
   function Get_Body (Reply : in Curl_Http_Response) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Reply.Content);
   end Get_Body;

   --  ------------------------------
   --  Get the response status code.
   --  ------------------------------
   overriding
   function Get_Status (Reply : in Curl_Http_Response) return Natural is
   begin
      return Reply.Status;
   end Get_Status;

end Util.Http.Clients.Curl;

Implement the Set_Headers procedure to make the request header Use it in the Do_Get and Do_Post operations


-----------------------------------------------------------------------
--  awa-blogs-beans -- Beans for blog module
--  Copyright (C) 2011, 2012, 2013, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;

with ADO;

with AWA.Blogs.Modules;
with AWA.Blogs.Models;
with AWA.Tags.Beans;

--  == Blog Beans ==
--  Several bean types are provided to represent and manage the blogs and their posts.
--  The blog module registers the bean constructors when it is initialized.
--  To use them, one must declare a bean definition in the application XML configuration.
package AWA.Blogs.Beans is

   --  Attributes exposed by Post_Bean
   BLOG_ID_ATTR      : constant String := "blogId";
   POST_ID_ATTR      : constant String := "id";
   POST_UID_ATTR     : constant String := "uid";
   POST_TITLE_ATTR   : constant String := "title";
   POST_TEXT_ATTR    : constant String := "text";
   POST_URI_ATTR     : constant String := "uri";
   POST_STATUS_ATTR  : constant String := "status";
   POST_USERNAME_ATTR : constant String := "username";
   POST_TAG_ATTR      : constant String := "tags";
   POST_ALLOW_COMMENTS_ATTR : constant String := "allow_comments";

   --  ------------------------------
   --  Blog Bean
   --  ------------------------------
   --  The Blog_Bean holds the information about the current blog.
   --  It allows to create the blog as well as update its primary title.
   type Blog_Bean is new AWA.Blogs.Models.Blog_Bean with record
      Module  : AWA.Blogs.Modules.Blog_Module_Access := null;
   end record;
   type Blog_Bean_Access is access all Blog_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Blog_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Blog_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create a new blog.
   overriding
   procedure Create (Bean    : in out Blog_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Blog_Bean bean instance.
   function Create_Blog_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Post Bean
   --  ------------------------------
   --  The Post_Bean is used to create or update a post associated with a blog.
   type Post_Bean is new AWA.Blogs.Models.Post_Bean with record
      Module  : AWA.Blogs.Modules.Blog_Module_Access := null;
      Blog_Id : ADO.Identifier;

      --  List of tags associated with the post.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Post_Bean_Access is access all Post_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Post_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Post_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the post.
   procedure Load_Post (Post : in out Post_Bean;
                        Id   : in ADO.Identifier);

   --  Create or save the post.
   overriding
   procedure Save (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete a post.
   overriding
   procedure Delete (Bean    : in out Post_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the post.
   overriding
   procedure Load (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Post_Bean bean instance.
   function Create_Post_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Post List Bean
   --  ------------------------------
   --  The Post_List_Bean gives a list of visible posts to be displayed to users.
   --  The list can be filtered by a given tag.  The list pagination is supported.
   type Post_List_Bean is new AWA.Blogs.Models.Post_List_Bean with record
      Posts      : aliased AWA.Blogs.Models.Post_Info_List_Bean;
      Service    : Modules.Blog_Module_Access := null;
      Tags       : AWA.Tags.Beans.Entity_Tag_Map;
      Posts_Bean : AWA.Blogs.Models.Post_Info_List_Bean_Access;
   end record;
   type Post_List_Bean_Access is access all Post_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Post_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Post_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (From    : in out Post_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the list of posts.  If a tag was set, filter the list of posts with the tag.
   procedure Load_List (Into : in out Post_List_Bean);

   --  Create the Post_List_Bean bean instance.
   function Create_Post_List_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access;

   --  Get a select item list which contains a list of post status.
   function Create_Status_List (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_BLOG_LIST, INIT_POST_LIST, INIT_COMMENT_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Admin List Bean
   --  ------------------------------
   --  The Blog_Admin_Bean is used for the administration of a blog.  It gives the
   --  list of posts that are created, published or not.
   type Blog_Admin_Bean is new Util.Beans.Basic.Bean with record
      Module : AWA.Blogs.Modules.Blog_Module_Access := null;

      --  The blog identifier.
      Blog_Id          : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of blogs.
      Blog_List        : aliased AWA.Blogs.Models.Blog_Info_List_Bean;
      Blog_List_Bean   : AWA.Blogs.Models.Blog_Info_List_Bean_Access;

      --  List of posts.
      Post_List        : aliased AWA.Blogs.Models.Admin_Post_Info_List_Bean;
      Post_List_Bean   : AWA.Blogs.Models.Admin_Post_Info_List_Bean_Access;

      --  List of comments.
      Comment_List      : aliased AWA.Blogs.Models.Comment_Info_List_Bean;
      Comment_List_Bean : AWA.Blogs.Models.Comment_Info_List_Bean_Access;

      --  Initialization flags.
      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Blog_Admin_Bean_Access is access all Blog_Admin_Bean;

   --  Get the blog identifier.
   function Get_Blog_Id (List : in Blog_Admin_Bean) return ADO.Identifier;

   --  Load the posts associated with the current blog.
   procedure Load_Posts (List : in Blog_Admin_Bean);

   --  Load the comments associated with the current blog.
   procedure Load_Comments (List : in Blog_Admin_Bean);

   overriding
   function Get_Value (List : in Blog_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Blog_Admin_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the list of blogs.
   procedure Load_Blogs (List : in Blog_Admin_Bean);

   --  Create the Blog_Admin_Bean bean instance.
   function Create_Blog_Admin_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Blogs.Beans;

-----------------------------------------------------------------------
--  awa-blogs-beans -- Beans for blog module
--  Copyright (C) 2011, 2012, 2013, 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;

with ADO;

with AWA.Blogs.Modules;
with AWA.Blogs.Models;
with AWA.Tags.Beans;

--  == Blog Beans ==
--  Several bean types are provided to represent and manage the blogs and their posts.
--  The blog module registers the bean constructors when it is initialized.
--  To use them, one must declare a bean definition in the application XML configuration.
package AWA.Blogs.Beans is

   --  Attributes exposed by Post_Bean
   BLOG_ID_ATTR      : constant String := "blogId";
   POST_ID_ATTR      : constant String := "id";
   POST_UID_ATTR     : constant String := "uid";
   POST_TITLE_ATTR   : constant String := "title";
   POST_TEXT_ATTR    : constant String := "text";
   POST_URI_ATTR     : constant String := "uri";
   POST_STATUS_ATTR  : constant String := "status";
   POST_USERNAME_ATTR : constant String := "username";
   POST_TAG_ATTR      : constant String := "tags";
   POST_ALLOW_COMMENTS_ATTR : constant String := "allow_comments";

   --  ------------------------------
   --  Blog Bean
   --  ------------------------------
   --  The Blog_Bean holds the information about the current blog.
   --  It allows to create the blog as well as update its primary title.
   type Blog_Bean is new AWA.Blogs.Models.Blog_Bean with record
      Module  : AWA.Blogs.Modules.Blog_Module_Access := null;
   end record;
   type Blog_Bean_Access is access all Blog_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Blog_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Create a new blog.
   overriding
   procedure Create (Bean    : in out Blog_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Blog_Bean bean instance.
   function Create_Blog_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Post Bean
   --  ------------------------------
   --  The Post_Bean is used to create or update a post associated with a blog.
   type Post_Bean is new AWA.Blogs.Models.Post_Bean with record
      Module  : AWA.Blogs.Modules.Blog_Module_Access := null;
      Blog_Id : ADO.Identifier;

      --  List of tags associated with the post.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Post_Bean_Access is access all Post_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Post_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Post_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the post.
   procedure Load_Post (Post : in out Post_Bean;
                        Id   : in ADO.Identifier);

   --  Create or save the post.
   overriding
   procedure Save (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete a post.
   overriding
   procedure Delete (Bean    : in out Post_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the post.
   overriding
   procedure Load (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Post_Bean bean instance.
   function Create_Post_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Post List Bean
   --  ------------------------------
   --  The Post_List_Bean gives a list of visible posts to be displayed to users.
   --  The list can be filtered by a given tag.  The list pagination is supported.
   type Post_List_Bean is new AWA.Blogs.Models.Post_List_Bean with record
      Posts      : aliased AWA.Blogs.Models.Post_Info_List_Bean;
      Service    : Modules.Blog_Module_Access := null;
      Tags       : AWA.Tags.Beans.Entity_Tag_Map;
      Posts_Bean : AWA.Blogs.Models.Post_Info_List_Bean_Access;
   end record;
   type Post_List_Bean_Access is access all Post_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Post_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Post_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (From    : in out Post_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the list of posts.  If a tag was set, filter the list of posts with the tag.
   procedure Load_List (Into : in out Post_List_Bean);

   --  Create the Post_List_Bean bean instance.
   function Create_Post_List_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access;

   --  Get a select item list which contains a list of post status.
   function Create_Status_List (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_BLOG_LIST, INIT_POST_LIST, INIT_COMMENT_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Admin List Bean
   --  ------------------------------
   --  The Blog_Admin_Bean is used for the administration of a blog.  It gives the
   --  list of posts that are created, published or not.
   type Blog_Admin_Bean is new Util.Beans.Basic.Bean with record
      Module : AWA.Blogs.Modules.Blog_Module_Access := null;

      --  The blog identifier.
      Blog_Id          : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of blogs.
      Blog_List        : aliased AWA.Blogs.Models.Blog_Info_List_Bean;
      Blog_List_Bean   : AWA.Blogs.Models.Blog_Info_List_Bean_Access;

      --  List of posts.
      Post_List        : aliased AWA.Blogs.Models.Admin_Post_Info_List_Bean;
      Post_List_Bean   : AWA.Blogs.Models.Admin_Post_Info_List_Bean_Access;

      --  List of comments.
      Comment_List      : aliased AWA.Blogs.Models.Comment_Info_List_Bean;
      Comment_List_Bean : AWA.Blogs.Models.Comment_Info_List_Bean_Access;

      --  Initialization flags.
      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Blog_Admin_Bean_Access is access all Blog_Admin_Bean;

   --  Get the blog identifier.
   function Get_Blog_Id (List : in Blog_Admin_Bean) return ADO.Identifier;

   --  Load the posts associated with the current blog.
   procedure Load_Posts (List : in Blog_Admin_Bean);

   --  Load the comments associated with the current blog.
   procedure Load_Comments (List : in Blog_Admin_Bean);

   overriding
   function Get_Value (List : in Blog_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Blog_Admin_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the list of blogs.
   procedure Load_Blogs (List : in Blog_Admin_Bean);

   --  Create the Blog_Admin_Bean bean instance.
   function Create_Blog_Admin_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Blogs.Beans;

Remove the Set_Value operation on the Blog_Bean type because it is now generated in the Models package