-----------------------------------------------------------------------
--  awa-workspaces-module -- Module workspaces
--  Copyright (C) 2011, 2012, 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.
-----------------------------------------------------------------------

with Ada.Calendar;

with AWA.Users.Models;
with AWA.Modules.Beans;
with AWA.Permissions.Services;

with ADO.SQL;
with Util.Log.Loggers;
with AWA.Users.Modules;
with AWA.Workspaces.Beans;
package body AWA.Workspaces.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Workspaces.Module");

   package Register is new AWA.Modules.Beans (Module => Workspace_Module,
                                              Module_Access => Workspace_Module_Access);

   --  ------------------------------
   --  Initialize the workspaces module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the workspaces module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Workspaces_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Workspaces_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Member_List_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Member_List_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Invitation_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Invitation_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      Plugin.User_Manager := AWA.Users.Modules.Get_User_Manager;
      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   --  ------------------------------
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref) is
      User    : constant AWA.Users.Models.User_Ref := Context.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Member  : AWA.Workspaces.Models.Workspace_Member_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
   begin
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         Workspace := AWA.Workspaces.Models.Null_Workspace;
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (Session, Query, Found);
      if Found then
         Workspace := WS;
         return;
      end if;

      --  Create a workspace for this user.
      WS.Set_Owner (User);
      WS.Set_Create_Date (Ada.Calendar.Clock);
      WS.Save (Session);

      --  Create the member instance for this user.
      Member.Set_Workspace (WS);
      Member.Set_Member (User);
      Member.Set_Role ("Owner");
      Member.Set_Join_Date (ADO.Nullable_Time '(Is_Null => False, Value => WS.Get_Create_Date));
      Member.Save (Session);

      --  And give full control of the workspace for this user
      AWA.Permissions.Services.Add_Permission (Session => Session,
                                               User    => User.Get_Id,
                                               Entity  => WS);

      Workspace := WS;
   end Get_Workspace;

   --  ------------------------------
   --  Load the invitation from the access key and verify that the key is still valid.
   --  ------------------------------
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class;
                              Inviter    : in out AWA.Users.Models.User_Ref) is
      use type Ada.Calendar.Time;

      Ctx    : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB     : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query  : ADO.SQL.Query;
      DB_Key : AWA.Users.Models.Access_Key_Ref;
      Found  : Boolean;
   begin
      Log.Debug ("Loading invitation from key {0}", Key);

      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Ada.Calendar.Clock then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Query.Set_Filter ("o.invitee_id = :user");
      Query.Bind_Param ("user", DB_Key.Get_User.Get_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;
      Inviter := AWA.Users.Models.User_Ref (Invitation.Get_Inviter);
   end Load_Invitation;

   --  ------------------------------
   --  Accept the invitation identified by the access key.
   --  ------------------------------
   procedure Accept_Invitation (Module     : in Workspace_Module;
                                Key        : in String) is
      use type Ada.Calendar.Time;

      Ctx     : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query   : ADO.SQL.Query;
      DB_Key  : AWA.Users.Models.Access_Key_Ref;
      Found   : Boolean;
      Invitation : AWA.Workspaces.Models.Invitation_Ref;
   begin
      Log.Debug ("Accept invitation with key {0}", Key);
      Ctx.Start;
      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Ada.Calendar.Clock then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Query.Set_Filter ("o.invitee_id = :user");
      Query.Bind_Param ("user", DB_Key.Get_User.Get_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;
      DB_Key.Delete (DB);
      Invitation.Set_Acceptance_Date (ADO.Nullable_Time '(Is_Null => False,
                                                          Value => Ada.Calendar.Clock));
      Invitation.Save (DB);
      Ctx.Commit;
   end Accept_Invitation;

   --  ------------------------------
   --  Send the invitation to the user.
   --  ------------------------------
   procedure Send_Invitation (Module     : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      use type ADO.Identifier;

      Ctx     : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User    : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
      Key     : AWA.Users.Models.Access_Key_Ref;
      Email   : AWA.Users.Models.Email_Ref;
      Invitee : AWA.Users.Models.User_Ref;
      Invit   : AWA.Workspaces.Models.Invitation_Ref;
      Member  : AWA.Workspaces.Models.Workspace_Member_Ref;
      Email_Address : constant String := Invitation.Get_Email;
   begin
      Log.Info ("Sending invitation to {0}", Email_Address);

      Ctx.Start;
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (DB, Query, Found);
      if not Found then
         return;
      end if;

      Query.Clear;
      Query.Set_Filter ("o.email = ?");
      Query.Add_Param (Email_Address);
      Email.Find (DB, Query, Found);
      if not Found then
         Email.Set_User_Id (0);
         Email.Set_Email (Email_Address);
         Email.Save (DB);
         Invitee.Set_Email (Email);
         Invitee.Set_Name (Email_Address);
         Invitee.Save (DB);
         Email.Set_User_Id (Invitee.Get_Id);
         Email.Save (DB);
      else
         Invitee.Load (DB, Email.Get_User_Id);
      end if;

      --  Create the workspace member relation.
      Query.Clear;
      Query.Set_Filter ("o.member_id = ? AND o.workspace_id = ?");
      Query.Add_Param (Invitee.Get_Id);
      Query.Add_Param (WS.Get_Id);
      Member.Find (DB, Query, Found);
      if not Found then
         Member.Set_Member (Invitee);
         Member.Set_Workspace (WS);
         Member.Set_Role ("Invited");
         Member.Save (DB);
      end if;

      --  Check for a previous invitation for the user and delete it.
      Query.Set_Filter ("o.invitee_id = ? AND o.workspace_id = ?");
      Invit.Find (DB, Query, Found);
      if Found then
         Key := AWA.Users.Models.Access_Key_Ref (Invit.Get_Access_Key);
         Key.Delete (DB);
         if not Invitation.Is_Inserted or else Invit.Get_Id /= Invitation.Get_Id then
            Invit.Delete (DB);
         end if;
      end if;
      Key := AWA.Users.Models.Access_Key_Ref (Invitation.Get_Access_Key);
      Module.User_Manager.Create_Access_Key (Invitee, Key, 365 * 86400.0, DB);
      Key.Save (DB);
      Invitation.Set_Access_Key (Key);
      Invitation.Set_Inviter (User);
      Invitation.Set_Invitee (Invitee);
      Invitation.Set_Workspace (WS);
      Invitation.Set_Create_Date (Ada.Calendar.Clock);
      Invitation.Save (DB);

      --  Send the email with the reset password key
      declare
         Event : AWA.Events.Module_Event;
      begin
         Event.Set_Parameter ("key", Key.Get_Access_Key);
         Event.Set_Parameter ("email", Email_Address);
         Event.Set_Parameter ("name", Invitee.Get_Name);
         Event.Set_Parameter ("message", Invitation.Get_Message);
         Event.Set_Parameter ("inviter", User.Get_Name);
         Event.Set_Event_Kind (Invite_User_Event.Kind);
         Module.Send_Event (Event);
      end;

      Ctx.Commit;
   end Send_Invitation;

end AWA.Workspaces.Modules;

-----------------------------------------------------------------------
--  awa-workspaces-module -- Module workspaces
--  Copyright (C) 2011, 2012, 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.
-----------------------------------------------------------------------

with Ada.Calendar;

with AWA.Users.Models;
with AWA.Modules.Beans;
with AWA.Permissions.Services;

with ADO.SQL;
with Util.Log.Loggers;
with AWA.Users.Modules;
with AWA.Workspaces.Beans;
package body AWA.Workspaces.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Workspaces.Module");

   package Register is new AWA.Modules.Beans (Module => Workspace_Module,
                                              Module_Access => Workspace_Module_Access);

   --  ------------------------------
   --  Initialize the workspaces module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the workspaces module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Workspaces_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Workspaces_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Member_List_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Member_List_Bean'Access);
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Invitation_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Invitation_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      Plugin.User_Manager := AWA.Users.Modules.Get_User_Manager;
      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   --  ------------------------------
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref) is
      User    : constant AWA.Users.Models.User_Ref := Context.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Member  : AWA.Workspaces.Models.Workspace_Member_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
   begin
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         Workspace := AWA.Workspaces.Models.Null_Workspace;
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (Session, Query, Found);
      if Found then
         Workspace := WS;
         return;
      end if;

      --  Create a workspace for this user.
      WS.Set_Owner (User);
      WS.Set_Create_Date (Ada.Calendar.Clock);
      WS.Save (Session);

      --  Create the member instance for this user.
      Member.Set_Workspace (WS);
      Member.Set_Member (User);
      Member.Set_Role ("Owner");
      Member.Set_Join_Date (ADO.Nullable_Time '(Is_Null => False, Value => WS.Get_Create_Date));
      Member.Save (Session);

      --  And give full control of the workspace for this user
      AWA.Permissions.Services.Add_Permission (Session => Session,
                                               User    => User.Get_Id,
                                               Entity  => WS);

      Workspace := WS;
   end Get_Workspace;

   --  ------------------------------
   --  Load the invitation from the access key and verify that the key is still valid.
   --  ------------------------------
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class;
                              Inviter    : in out AWA.Users.Models.User_Ref) is
      use type Ada.Calendar.Time;

      Ctx    : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB     : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query  : ADO.SQL.Query;
      DB_Key : AWA.Users.Models.Access_Key_Ref;
      Found  : Boolean;
   begin
      Log.Debug ("Loading invitation from key {0}", Key);

      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Ada.Calendar.Clock then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Query.Set_Filter ("o.invitee_id = :user");
      Query.Bind_Param ("user", DB_Key.Get_User.Get_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;
      Inviter := AWA.Users.Models.User_Ref (Invitation.Get_Inviter);
   end Load_Invitation;

   --  ------------------------------
   --  Accept the invitation identified by the access key.
   --  ------------------------------
   procedure Accept_Invitation (Module     : in Workspace_Module;
                                Key        : in String) is
      use type Ada.Calendar.Time;
      use type ADO.Identifier;

      Ctx        : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User       : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB         : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query      : ADO.SQL.Query;
      DB_Key     : AWA.Users.Models.Access_Key_Ref;
      Found      : Boolean;
      Invitation : AWA.Workspaces.Models.Invitation_Ref;
      Invitee_Id : ADO.Identifier;
      Member     : AWA.Workspaces.Models.Workspace_Member_Ref;
      Now        : constant Ada.Calendar.Time := Ada.Calendar.Clock;
   begin
      Log.Debug ("Accept invitation with key {0}", Key);
      Ctx.Start;
      Query.Set_Filter ("o.access_key = :key");
      Query.Bind_Param ("key", Key);
      DB_Key.Find (DB, Query, Found);
      if not Found then
         Log.Info ("Invitation key {0} does not exist");
         raise Not_Found;
      end if;
      if DB_Key.Get_Expire_Date < Now then
         Log.Info ("Invitation key {0} has expired");
         raise Not_Found;
      end if;
      Invitee_Id := DB_Key.Get_User.Get_Id;
      Query.Set_Filter ("o.invitee_id = :user");
      Query.Bind_Param ("user", Invitee_Id);
      Invitation.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;

      --  Update the workspace member relation.
      Query.Clear;
      Query.Set_Filter ("o.member_id = ? AND o.workspace_id = ?");
      Query.Add_Param (Invitee_Id);
      Query.Add_Param (Invitation.Get_Workspace.Get_Id);
      Member.Find (DB, Query, Found);
      if not Found then
         Log.Warn ("Invitation key {0} has been withdawn");
         raise Not_Found;
      end if;

      --  The user who received the invitation is different from the user who is
      --  logged and accepted the validation.   Since the key is verified, this is
      --  the same user but the user who accepted the invitation registered using
      --  another email address.
      if Invitee_Id /= User.Get_Id then
         Invitation.Set_Invitee (User);
         Member.Set_Member (User);
         Log.Info ("Invitation accepted by user with another email address");
      end if;

      Member.Set_Join_Date (ADO.Nullable_Time '(Is_Null => False,
                                                Value   => Now));
      Member.Save (DB);
      DB_Key.Delete (DB);
      Invitation.Set_Acceptance_Date (ADO.Nullable_Time '(Is_Null => False,
                                                          Value   => Now));
      Invitation.Save (DB);
      Ctx.Commit;
   end Accept_Invitation;

   --  ------------------------------
   --  Send the invitation to the user.
   --  ------------------------------
   procedure Send_Invitation (Module     : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      use type ADO.Identifier;

      Ctx     : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User    : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
      Key     : AWA.Users.Models.Access_Key_Ref;
      Email   : AWA.Users.Models.Email_Ref;
      Invitee : AWA.Users.Models.User_Ref;
      Invit   : AWA.Workspaces.Models.Invitation_Ref;
      Member  : AWA.Workspaces.Models.Workspace_Member_Ref;
      Email_Address : constant String := Invitation.Get_Email;
   begin
      Log.Info ("Sending invitation to {0}", Email_Address);

      Ctx.Start;
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (DB, Query, Found);
      if not Found then
         return;
      end if;

      Query.Clear;
      Query.Set_Filter ("o.email = ?");
      Query.Add_Param (Email_Address);
      Email.Find (DB, Query, Found);
      if not Found then
         Email.Set_User_Id (0);
         Email.Set_Email (Email_Address);
         Email.Save (DB);
         Invitee.Set_Email (Email);
         Invitee.Set_Name (Email_Address);
         Invitee.Save (DB);
         Email.Set_User_Id (Invitee.Get_Id);
         Email.Save (DB);
      else
         Invitee.Load (DB, Email.Get_User_Id);
      end if;

      --  Create the workspace member relation.
      Query.Clear;
      Query.Set_Filter ("o.member_id = ? AND o.workspace_id = ?");
      Query.Add_Param (Invitee.Get_Id);
      Query.Add_Param (WS.Get_Id);
      Member.Find (DB, Query, Found);
      if not Found then
         Member.Set_Member (Invitee);
         Member.Set_Workspace (WS);
         Member.Set_Role ("Invited");
         Member.Save (DB);
      end if;

      --  Check for a previous invitation for the user and delete it.
      Query.Set_Filter ("o.invitee_id = ? AND o.workspace_id = ?");
      Invit.Find (DB, Query, Found);
      if Found then
         Key := AWA.Users.Models.Access_Key_Ref (Invit.Get_Access_Key);
         Key.Delete (DB);
         if not Invitation.Is_Inserted or else Invit.Get_Id /= Invitation.Get_Id then
            Invit.Delete (DB);
         end if;
      end if;
      Key := AWA.Users.Models.Access_Key_Ref (Invitation.Get_Access_Key);
      Module.User_Manager.Create_Access_Key (Invitee, Key, 365 * 86400.0, DB);
      Key.Save (DB);
      Invitation.Set_Access_Key (Key);
      Invitation.Set_Inviter (User);
      Invitation.Set_Invitee (Invitee);
      Invitation.Set_Workspace (WS);
      Invitation.Set_Create_Date (Ada.Calendar.Clock);
      Invitation.Save (DB);

      --  Send the email with the reset password key
      declare
         Event : AWA.Events.Module_Event;
      begin
         Event.Set_Parameter ("key", Key.Get_Access_Key);
         Event.Set_Parameter ("email", Email_Address);
         Event.Set_Parameter ("name", Invitee.Get_Name);
         Event.Set_Parameter ("message", Invitation.Get_Message);
         Event.Set_Parameter ("inviter", User.Get_Name);
         Event.Set_Event_Kind (Invite_User_Event.Kind);
         Module.Send_Event (Event);
      end;

      Ctx.Commit;
   end Send_Invitation;

end AWA.Workspaces.Modules;

Update the accept_invitation procedure to update the workspace member and update the invitation if the user accepted the invitation from another email address


-----------------------------------------------------------------------
--  mat-readers-sockets -- Reader for TCP/IP sockets
--  Copyright (C) 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.Streams;
with Util.Log.Loggers;

package body MAT.Readers.Streams.Sockets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Sockets");

   BUFFER_SIZE  : constant Natural := 100 * 1024;

   --  ------------------------------
   --  Initialize the socket listener.
   --  ------------------------------
   overriding
   procedure Initialize (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Create_Selector (Listener.Accept_Selector);
   end Initialize;

   --  ------------------------------
   --  Destroy the socket listener.
   --  ------------------------------
   overriding
   procedure Finalize (Listener : in out Socket_Listener_Type) is
      use type GNAT.Sockets.Selector_Type;
   begin
      GNAT.Sockets.Close_Selector (Listener.Accept_Selector);
   end Finalize;

   --  ------------------------------
   --  Open the socket to accept connections and start the listener task.
   --  ------------------------------
   procedure Start (Listener : in out Socket_Listener_Type;
                    Address  : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Starting the listener socket task");

      Listener.Listener.Start (Listener'Unchecked_Access, Address);
   end Start;

   --  ------------------------------
   --  Stop the listener socket.
   --  ------------------------------
   procedure Stop (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Abort_Selector (Listener.Accept_Selector);
   end Stop;

   --  Create a target instance for the new client.
   procedure Create_Target (Listener : in out Socket_Listener_Type;
                            Client   : in GNAT.Sockets.Socket_Type;
                            Address  : in GNAT.Sockets.Sock_Addr_Type) is
      Reader : Socket_Reader_Type_Access := new Socket_Reader_Type;
   begin
      null;
   end Create_Target;

   task body Socket_Listener_Task is
      use type GNAT.Sockets.Socket_Type;
      use type GNAT.Sockets.Selector_Status;

      Peer     : GNAT.Sockets.Sock_Addr_Type;
      Server   : GNAT.Sockets.Socket_Type;
      Instance : Socket_Listener_Type_Access;
      Client   : GNAT.Sockets.Socket_Type;
      Status   : GNAT.Sockets.Selector_Status;
      Selector_Status : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (Listener : in Socket_Listener_Type_Access;
                       Address  : in GNAT.Sockets.Sock_Addr_Type) do
            Instance := Listener;
            GNAT.Sockets.Create_Socket (Server);
            GNAT.Sockets.Set_Socket_Option (Server, GNAT.Sockets.Socket_Level,
                                            (GNAT.Sockets.Reuse_Address, True));
            GNAT.Sockets.Bind_Socket (Server, Address);
            GNAT.Sockets.Listen_Socket (Server);
         end Start;
      or
         terminate;
      end select;
      loop
         GNAT.Sockets.Accept_Socket (Server   => Server,
                                     Socket   => Client,
                                     Address  => Peer,
                                     Timeout  => GNAT.Sockets.Forever,
                                     Selector => Instance.Accept_Selector'Access,
                                     Status   => Selector_Status);
         exit when Selector_Status = GNAT.Sockets.Aborted;
         if Selector_Status = GNAT.Sockets.Completed then
            GNAT.Sockets.Close_Socket (Client);
         end if;
      end loop;
      GNAT.Sockets.Close_Socket (Server);
   end Socket_Listener_Task;

   task body Socket_Reader_Task is
      use type GNAT.Sockets.Socket_Type;

      Instance : Socket_Reader_Type_Access;
      Socket   : GNAT.Sockets.Socket_Type;
      Status   : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (Reader  : in Socket_Reader_Type_Access;
                       Client  : in GNAT.Sockets.Socket_Type) do
            Instance := Reader;
            Socket := Client;
         end Start;
      or
         terminate;
      end select;
      Instance.Socket.Open (Socket);
      Instance.Read_All;
      GNAT.Sockets.Close_Socket (Socket);

   exception
      when E : others =>
         Log.Error ("Exception", E);
         GNAT.Sockets.Close_Socket (Socket);

   end Socket_Reader_Task;

   --  Open the socket to accept connections.
   procedure Open (Reader  : in out Socket_Reader_Type;
                   Address : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Reading server stream");

      Reader.Stream.Initialize (Size   => BUFFER_SIZE,
                                Input  => Reader.Socket'Unchecked_Access,
                                Output => null);
      Reader.Server.Start (Reader'Unchecked_Access, Address);
   end Open;

   procedure Close (Reader : in out Socket_Reader_Type) is
   begin
      Reader.Stop := True;
   end Close;

end MAT.Readers.Streams.Sockets;

-----------------------------------------------------------------------
--  mat-readers-sockets -- Reader for TCP/IP sockets
--  Copyright (C) 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.Streams;
with Util.Log.Loggers;

package body MAT.Readers.Streams.Sockets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Sockets");

   BUFFER_SIZE  : constant Natural := 100 * 1024;

   --  ------------------------------
   --  Initialize the socket listener.
   --  ------------------------------
   overriding
   procedure Initialize (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Create_Selector (Listener.Accept_Selector);
   end Initialize;

   --  ------------------------------
   --  Destroy the socket listener.
   --  ------------------------------
   overriding
   procedure Finalize (Listener : in out Socket_Listener_Type) is
      use type GNAT.Sockets.Selector_Type;
   begin
      GNAT.Sockets.Close_Selector (Listener.Accept_Selector);
   end Finalize;

   --  ------------------------------
   --  Open the socket to accept connections and start the listener task.
   --  ------------------------------
   procedure Start (Listener : in out Socket_Listener_Type;
                    Address  : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Starting the listener socket task");

      Listener.Listener.Start (Listener'Unchecked_Access, Address);
   end Start;

   --  ------------------------------
   --  Stop the listener socket.
   --  ------------------------------
   procedure Stop (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Abort_Selector (Listener.Accept_Selector);
   end Stop;

   --  Create a target instance for the new client.
   procedure Create_Target (Listener : in out Socket_Listener_Type;
                            Client   : in GNAT.Sockets.Socket_Type;
                            Address  : in GNAT.Sockets.Sock_Addr_Type) is
      Reader : Socket_Reader_Type_Access := new Socket_Reader_Type;
   begin
      Reader.Server.Start (Reader, Client);
   end Create_Target;

   task body Socket_Listener_Task is
      use type GNAT.Sockets.Socket_Type;
      use type GNAT.Sockets.Selector_Status;

      Peer     : GNAT.Sockets.Sock_Addr_Type;
      Server   : GNAT.Sockets.Socket_Type;
      Instance : Socket_Listener_Type_Access;
      Client   : GNAT.Sockets.Socket_Type;
      Status   : GNAT.Sockets.Selector_Status;
      Selector_Status : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (Listener : in Socket_Listener_Type_Access;
                       Address  : in GNAT.Sockets.Sock_Addr_Type) do
            Instance := Listener;
            GNAT.Sockets.Create_Socket (Server);
            GNAT.Sockets.Set_Socket_Option (Server, GNAT.Sockets.Socket_Level,
                                            (GNAT.Sockets.Reuse_Address, True));
            GNAT.Sockets.Bind_Socket (Server, Address);
            GNAT.Sockets.Listen_Socket (Server);
         end Start;
      or
         terminate;
      end select;
      loop
         GNAT.Sockets.Accept_Socket (Server   => Server,
                                     Socket   => Client,
                                     Address  => Peer,
                                     Timeout  => GNAT.Sockets.Forever,
                                     Selector => Instance.Accept_Selector'Access,
                                     Status   => Selector_Status);
         exit when Selector_Status = GNAT.Sockets.Aborted;
         if Selector_Status = GNAT.Sockets.Completed then
            GNAT.Sockets.Close_Socket (Client);
         end if;
      end loop;
      GNAT.Sockets.Close_Socket (Server);
   end Socket_Listener_Task;

   task body Socket_Reader_Task is
      use type GNAT.Sockets.Socket_Type;

      Instance : Socket_Reader_Type_Access;
      Socket   : GNAT.Sockets.Socket_Type;
      Status   : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (Reader  : in Socket_Reader_Type_Access;
                       Client  : in GNAT.Sockets.Socket_Type) do
            Instance := Reader;
            Socket := Client;
         end Start;
      or
         terminate;
      end select;
      Instance.Socket.Open (Socket);
      Instance.Read_All;
      GNAT.Sockets.Close_Socket (Socket);

   exception
      when E : others =>
         Log.Error ("Exception", E);
         GNAT.Sockets.Close_Socket (Socket);

   end Socket_Reader_Task;

   procedure Close (Reader : in out Socket_Reader_Type) is
   begin
      Reader.Stop := True;
   end Close;

end MAT.Readers.Streams.Sockets;

Remove the Open procedure

Remove the Open procedure


-----------------------------------------------------------------------
--  awa-workspaces-tests -- Unit tests for workspaces and invitations
--  Copyright (C) 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 Ada.Strings.Unbounded;
with Util.Test_Caller;
with Util.Strings;
with ADO;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Principals;
with ASF.Helpers.Beans;
with ASF.Tests;
with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Tests.Helpers.Users;
with Security.Contexts;
with AWA.Workspaces.Beans;

package body AWA.Workspaces.Tests is

   use Ada.Strings.Unbounded;
   use AWA.Tests;

   function Get_Invitation_Bean is
     new ASF.Helpers.Beans.Get_Request_Bean (Element_Type   => Beans.Invitation_Bean,
                                             Element_Access => Beans.Invitation_Bean_Access);

   package Caller is new Util.Test_Caller (Test, "Workspaces.Beans");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Send",
                       Test_Invite_User'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get some access on the blog as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T    : in out Test;
                               Key  : in String) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html", "invitation-view.html");
      ASF.Tests.Assert_Contains (T, "Blog posts", Reply, "This invitation is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=test", "invitation-bad.html");
      ASF.Tests.Assert_Contains (T, "Tag - test", Reply, "Blog tag page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=x" & key,
                        "invitation-bad2.html");
      ASF.Tests.Assert_Contains (T, "The post you are looking for does not exist",
                                 Reply, "Blog post missing page is invalid");

      if Key = "" then
         return;
      end if;

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=" & Key, "invitation-ok.html");
      ASF.Tests.Assert_Contains (T, "post-title", Reply, "Blog post page is invalid");

   end Verify_Anonymous;

   --  ------------------------------
   --  Test sending an invitation.
   --  ------------------------------
   procedure Test_Invite_User (T : in out Test) is
      use type ADO.Identifier;
      use type AWA.Workspaces.Beans.Invitation_Bean_Access;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Invite    : AWA.Workspaces.Beans.Invitation_Bean_Access;
      Check     : AWA.Workspaces.Beans.Invitation_Bean;
      Key       : AWA.Users.Models.Access_Key_Ref;
      Outcome   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      AWA.Tests.Helpers.Users.Login ("test-invite@test.com", Request);
      Request.Set_Parameter ("email", "invited-user@test.com");
      Request.Set_Parameter ("message", "I invite you to this application");
      Request.Set_Parameter ("send", "1");
      Request.Set_Parameter ("invite", "1");
      ASF.Tests.Do_Post (Request, Reply, "/workspaces/invite.html", "invite.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK,
                "Invalid response after invitation creation");

      --  Verify the invitation by looking at the inviteUser bean.
      Invite := Get_Invitation_Bean (Request, "inviteUser");
      T.Assert (Invite /= null, "Null inviteUser bean");
      T.Assert (Invite.Get_Id /= ADO.NO_IDENTIFIER, "The invite ID is invalid");
      T.Assert (not Invite.Get_Access_Key.Is_Null, "The invite access key is null");
      Check.Key := Invite.Get_Access_Key.Get_Access_Key;
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
      Check.Load (Outcome);
      Util.Tests.Assert_Equals (T, "success", To_String (Outcome), "Invalid invitation key");
   end Test_Invite_User;

end AWA.Workspaces.Tests;

-----------------------------------------------------------------------
--  awa-workspaces-tests -- Unit tests for workspaces and invitations
--  Copyright (C) 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 Ada.Strings.Unbounded;
with Util.Test_Caller;
with Util.Strings;
with ADO;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Principals;
with ASF.Helpers.Beans;
with ASF.Tests;
with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Tests.Helpers.Users;
with Security.Contexts;
with AWA.Workspaces.Beans;

package body AWA.Workspaces.Tests is

   use Ada.Strings.Unbounded;
   use AWA.Tests;

   function Get_Invitation_Bean is
     new ASF.Helpers.Beans.Get_Request_Bean (Element_Type   => Beans.Invitation_Bean,
                                             Element_Access => Beans.Invitation_Bean_Access);

   package Caller is new Util.Test_Caller (Test, "Workspaces.Beans");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Send",
                       Test_Invite_User'Access);
   end Add_Tests;

   --  ------------------------------
   --  Verify the anonymous access for the invitation page.
   --  ------------------------------
   procedure Verify_Anonymous (T    : in out Test;
                               Key  : in String) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html", "invitation-view.html");
      ASF.Tests.Assert_Contains (T, "Bad or invalid invitation", Reply,
                                 "This invitation is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=test", "invitation-bad.html");
      ASF.Tests.Assert_Contains (T, "This invitation is invalid or has expired", Reply,
                                 "This invitation is invalid (key)");

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=x" & key,
                        "invitation-bad2.html");
      ASF.Tests.Assert_Contains (T, "This invitation is invalid or has expired",
                                 Reply, "This invitation is invalid (key)");

      if Key = "" then
         return;
      end if;

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=" & Key, "invitation-ok.html");
      ASF.Tests.Assert_Contains (T, "Accept invitation", Reply,
                                 "Accept invitation page is invalid");

   end Verify_Anonymous;

   --  ------------------------------
   --  Test sending an invitation.
   --  ------------------------------
   procedure Test_Invite_User (T : in out Test) is
      use type ADO.Identifier;
      use type AWA.Workspaces.Beans.Invitation_Bean_Access;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Invite    : AWA.Workspaces.Beans.Invitation_Bean_Access;
      Check     : AWA.Workspaces.Beans.Invitation_Bean;
   begin
      AWA.Tests.Helpers.Users.Login ("test-invite@test.com", Request);
      Request.Set_Parameter ("email", "invited-user@test.com");
      Request.Set_Parameter ("message", "I invite you to this application");
      Request.Set_Parameter ("send", "1");
      Request.Set_Parameter ("invite", "1");
      ASF.Tests.Do_Post (Request, Reply, "/workspaces/invite.html", "invite.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK,
                "Invalid response after invitation creation");

      --  Verify the invitation by looking at the inviteUser bean.
      Invite := Get_Invitation_Bean (Request, "inviteUser");
      T.Assert (Invite /= null, "Null inviteUser bean");
      T.Assert (Invite.Get_Id /= ADO.NO_IDENTIFIER, "The invite ID is invalid");
      T.Assert (not Invite.Get_Access_Key.Is_Null, "The invite access key is null");
      Check.Key := Invite.Get_Access_Key.Get_Access_Key;
      T.Verify_Anonymous (Invite.Get_Access_Key.Get_Access_Key);
   end Test_Invite_User;

end AWA.Workspaces.Tests;

Update the test to verify the invitation page


-----------------------------------------------------------------------
--  components-widgets-likes -- Social Likes Components
--  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.
-----------------------------------------------------------------------
with Util.Locales;
with Util.Beans.Objects;
with Util.Strings.Tokenizers;

--  GNAT bug, the with clause is necessary to call Get_Global on the application.
pragma Warnings (Off, "*is not referenced");
with ASF.Applications.Main;
pragma Warnings (On, "*is not referenced");

with ASF.Requests;
with ASF.Contexts.Writer;
package body ASF.Components.Widgets.Likes is

   FB_LAYOUT_ATTR      : aliased constant String := "data-layout";
   FB_SHOW_FACES_ATTR  : aliased constant String := "data-show-faces";
   FB_WIDTH_ATTR       : aliased constant String := "data-width";
   FB_ACTION_ATTR      : aliased constant String := "data-action";
   FB_FONT_ATTR        : aliased constant String := "data-font";
   FB_COlORSCHEME_ATTR : aliased constant String := "data-colorscheme";
   FB_REF_ATTR         : aliased constant String := "data-ref";
   FB_KIDS_ATTR        : aliased constant String := "data-kid_directed_site";
   FB_SEND_ATTR        : aliased constant String := "data-send";

   TW_VIA_ATTR         : aliased constant String := "data-via";
   TW_COUNT_ATTR       : aliased constant String := "data-count";
   TW_SIZE_ATTR        : aliased constant String := "data-size";

   G_ANNOTATION_ATTR   : aliased constant String := "data-annotation";
   G_WIDTH_ATTR        : aliased constant String := "data-width";

   FACEBOOK_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;
   FACEBOOK_SCRIPT_ATTRIBUTE : constant String := "asf.widgets.facebook.script";

   GOOGLE_ATTRIBUTE_NAMES    : Util.Strings.String_Set.Set;
   GOOGLE_SCRIPT_ATTRIBUTE   : constant String := "asf.widgets.google.script";

   TWITTER_ATTRIBUTE_NAMES    : Util.Strings.String_Set.Set;
   TWITTER_SCRIPT_ATTRIBUTE   : constant String := "asf.widgets.twitter.script";

   type Like_Generator_Binding is record
      Name      : Util.Strings.Name_Access;
      Generator : Like_Generator_Access;
   end record;

   type Like_Generator_Array is array (1 .. MAX_LIKE_GENERATOR) of Like_Generator_Binding;

   FB_NAME      : aliased constant String := "facebook";
   FB_GENERATOR : aliased Facebook_Like_Generator;

   G_NAME       : aliased constant String := "google+";
   G_GENERATOR  : aliased Google_Like_Generator;

   TWITTER_NAME       : aliased constant String := "twitter";
   TWITTER_GENERATOR  : aliased Twitter_Like_Generator;

   Generators : Like_Generator_Array := (1 => (FB_NAME'Access, FB_GENERATOR'Access),
                                         2 => (G_NAME'Access, G_GENERATOR'Access),
                                         3 => (TWITTER_NAME'Access, TWITTER_GENERATOR'Access),
                                         others => (null, null));

   --  ------------------------------
   --  Render the facebook like button according to the component attributes.
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Facebook_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (Generator);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (FACEBOOK_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (FACEBOOK_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Script ("(function(d, s, id) { var js, fjs = d.getElementsByTagName(s)[0];"
                              & "if (d.getElementById(id)) return;"
                              & "js = d.createElement(s); js.id = id;js.async=true;"
                              & "js.src = ""//connect.facebook.net/");
         Writer.Queue_Script (Util.Locales.To_String (Context.Get_Locale));
         Writer.Queue_Script ("/all.js#xfbml=1&;appId=");
         declare
            App_Id : constant String
              := Context.Get_Application.Get_Config (P_Facebook_App_Id.P);
         begin
            if App_Id'Length = 0 then
               UI.Log_Error ("The facebook client application id is empty");
               UI.Log_Error ("Please, configure the '{0}' property "
                             & "in the application", P_Facebook_App_Id.PARAM_NAME);
            else
               Writer.Queue_Script (App_Id);
            end if;
         end;
         Writer.Queue_Script (""";fjs.parentNode.insertBefore(js, fjs);"
                              & "}(document, 'script', 'facebook-jssdk'));");
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("id", "fb-root");
         Writer.End_Element ("div");
      end if;
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "fb-like");
      Writer.Write_Attribute ("data-href", Href);
      UI.Render_Attributes (Context, FACEBOOK_ATTRIBUTE_NAMES, Writer);
      Writer.End_Element ("div");
   end Render_Like;

   --  ------------------------------
   --  Google like generator
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Google_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (Generator);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (GOOGLE_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (GOOGLE_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Include_Script ("https://apis.google.com/js/plusone.js");
      end if;
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "g-plusone");
      Writer.Write_Attribute ("data-href", Href);
      UI.Render_Attributes (Context, GOOGLE_ATTRIBUTE_NAMES, Writer);
      Writer.End_Element ("div");
   end Render_Like;

   --  ------------------------------
   --  Tweeter like generator
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Twitter_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (Generator);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
      Lang    : constant String := Util.Locales.Get_ISO3_Language (Context.Get_Locale);
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (TWITTER_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (TWITTER_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Script ("!function(d,s,id){var js,fjs=d.getElementsByTagName(s)[0],"
                              & "p=/^http:/.test(d.location)?'http':'https';"
                              & "if(!d.getElementById(id)){js=d.createElement(s);js.id=id;"
                              & "js.src=p+'://platform.twitter.com/widgets.js';"
                              & "fjs.parentNode.insertBefore(js,fjs);}}"
                              & "(document, 'script', 'twitter-wjs');");
      end if;
      Writer.Start_Element ("a");
      Writer.Write_Attribute ("href", "https://twitter.com/share");
      Writer.Write_Attribute ("class", "twitter-share-button");
      Writer.Write_Attribute ("data-url", Href);
      Writer.Write_Attribute ("data-lang", Lang);
      UI.Render_Attributes (Context, TWITTER_ATTRIBUTE_NAMES, Writer);
      Writer.Write_Text ("Tweet");
      Writer.End_Element ("a");
   end Render_Like;

   --  ------------------------------
   --  Get the link to submit in the like action.
   --  ------------------------------
   function Get_Link (UI      : in UILike;
                      Context : in ASF.Contexts.Faces.Faces_Context'Class) return String is
      Href : constant String := UI.Get_Attribute ("href", Context, "");
   begin
      if Href'Length > 0 then
         return Href;
      else
         return Context.Get_Request.Get_Request_URI;
      end if;
   end Get_Link;

   --  ------------------------------
   --  Render an image with the source link created from an email address to the Gravatars service.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UILike;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
   begin
      if UI.Is_Rendered (Context) then
         declare
            Writer : constant Contexts.Writer.Response_Writer_Access
              := Context.Get_Response_Writer;
            Kind   : constant String := UI.Get_Attribute ("type", Context, "");
            Href   : constant String := UILike'Class (UI).Get_Link (Context);
            Style  : constant String := UI.Get_Attribute ("style", Context, "");
            Class  : constant String := UI.Get_Attribute ("styleClass", Context, "");

            procedure Render (Name : in String; Done : out Boolean);

            procedure Render (Name : in String;
                              Done : out Boolean) is
               use type Util.Strings.Name_Access;
            begin
               Done := False;
               for I in Generators'Range loop
                  exit when Generators (I).Name = null;
                  if Generators (I).Name.all = Name then
                     Writer.Start_Element ("div");
                     if Style'Length > 0 then
                        Writer.Write_Attribute ("style", Style);
                     end if;
                     if Class'Length > 0 then
                        Writer.Write_Attribute ("class", Class);
                     end if;
                     Generators (I).Generator.Render_Like (UI, Href, Context);
                     Writer.End_Element ("div");
                     return;
                  end if;
               end loop;
               UI.Log_Error ("Like type {0} is not recognized", Name);
            end Render;

         begin
            if Kind'Length = 0 then
               UI.Log_Error ("The like type is empty.");
            else
               Util.Strings.Tokenizers.Iterate_Tokens (Content => Kind, Pattern => ",",
                                                       Process => Render'Access);
            end if;
         end;
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Register the like generator under the given name.
   --  ------------------------------
   procedure Register_Like (Name      : in Util.Strings.Name_Access;
                            Generator : in Like_Generator_Access) is
      use type Util.Strings.Name_Access;
   begin
      for I in Generators'Range loop
         if Generators (I).Name = null then
            Generators (I).Name := Name;
            Generators (I).Generator := Generator;
            return;
         end if;
      end loop;
   end Register_Like;

begin
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_LAYOUT_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_SHOW_FACES_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_WIDTH_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_ACTION_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_FONT_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_COlORSCHEME_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_REF_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_KIDS_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_SEND_ATTR'Access);

   TWITTER_ATTRIBUTE_NAMES.Insert (TW_SIZE_ATTR'Access);
   TWITTER_ATTRIBUTE_NAMES.Insert (TW_COUNT_ATTR'Access);
   TWITTER_ATTRIBUTE_NAMES.Insert (TW_VIA_ATTR'Access);

   GOOGLE_ATTRIBUTE_NAMES.Insert (G_ANNOTATION_ATTR'Access);
   GOOGLE_ATTRIBUTE_NAMES.Insert (G_WIDTH_ATTR'Access);
end ASF.Components.Widgets.Likes;

-----------------------------------------------------------------------
--  components-widgets-likes -- Social Likes Components
--  Copyright (C) 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 Util.Locales;
with Util.Beans.Objects;
with Util.Strings.Tokenizers;

--  GNAT bug, the with clause is necessary to call Get_Global on the application.
pragma Warnings (Off, "*is not referenced");
with ASF.Applications.Main;
pragma Warnings (On, "*is not referenced");

with ASF.Requests;
with ASF.Contexts.Writer;
package body ASF.Components.Widgets.Likes is

   FB_LAYOUT_ATTR      : aliased constant String := "data-layout";
   FB_SHOW_FACES_ATTR  : aliased constant String := "data-show-faces";
   FB_WIDTH_ATTR       : aliased constant String := "data-width";
   FB_ACTION_ATTR      : aliased constant String := "data-action";
   FB_FONT_ATTR        : aliased constant String := "data-font";
   FB_COlORSCHEME_ATTR : aliased constant String := "data-colorscheme";
   FB_REF_ATTR         : aliased constant String := "data-ref";
   FB_KIDS_ATTR        : aliased constant String := "data-kid_directed_site";
   FB_SEND_ATTR        : aliased constant String := "data-send";

   TW_VIA_ATTR         : aliased constant String := "data-via";
   TW_COUNT_ATTR       : aliased constant String := "data-count";
   TW_SIZE_ATTR        : aliased constant String := "data-size";
   TW_COUNTURL_ATTR    : aliased constant String := "data-counturl";
   TW_TEXT_ATTR        : aliased constant String := "data-text";
   TW_RELATED_ATTR     : aliased constant String := "data-related";
   TW_LANG_ATTR        : aliased constant String := "data-lang";
   TW_HASHTAGS_ATTR    : aliased constant String := "data-hashtags";

   G_ANNOTATION_ATTR   : aliased constant String := "data-annotation";
   G_WIDTH_ATTR        : aliased constant String := "data-width";

   FACEBOOK_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;
   FACEBOOK_SCRIPT_ATTRIBUTE : constant String := "asf.widgets.facebook.script";

   GOOGLE_ATTRIBUTE_NAMES    : Util.Strings.String_Set.Set;
   GOOGLE_SCRIPT_ATTRIBUTE   : constant String := "asf.widgets.google.script";

   TWITTER_ATTRIBUTE_NAMES    : Util.Strings.String_Set.Set;
   TWITTER_SCRIPT_ATTRIBUTE   : constant String := "asf.widgets.twitter.script";

   type Like_Generator_Binding is record
      Name      : Util.Strings.Name_Access;
      Generator : Like_Generator_Access;
   end record;

   type Like_Generator_Array is array (1 .. MAX_LIKE_GENERATOR) of Like_Generator_Binding;

   FB_NAME      : aliased constant String := "facebook";
   FB_GENERATOR : aliased Facebook_Like_Generator;

   G_NAME       : aliased constant String := "google+";
   G_GENERATOR  : aliased Google_Like_Generator;

   TWITTER_NAME       : aliased constant String := "twitter";
   TWITTER_GENERATOR  : aliased Twitter_Like_Generator;

   Generators : Like_Generator_Array := (1 => (FB_NAME'Access, FB_GENERATOR'Access),
                                         2 => (G_NAME'Access, G_GENERATOR'Access),
                                         3 => (TWITTER_NAME'Access, TWITTER_GENERATOR'Access),
                                         others => (null, null));

   --  ------------------------------
   --  Render the facebook like button according to the component attributes.
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Facebook_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (Generator);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (FACEBOOK_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (FACEBOOK_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Script ("(function(d, s, id) { var js, fjs = d.getElementsByTagName(s)[0];"
                              & "if (d.getElementById(id)) return;"
                              & "js = d.createElement(s); js.id = id;js.async=true;"
                              & "js.src = ""//connect.facebook.net/");
         Writer.Queue_Script (Util.Locales.To_String (Context.Get_Locale));
         Writer.Queue_Script ("/all.js#xfbml=1&;appId=");
         declare
            App_Id : constant String
              := Context.Get_Application.Get_Config (P_Facebook_App_Id.P);
         begin
            if App_Id'Length = 0 then
               UI.Log_Error ("The facebook client application id is empty");
               UI.Log_Error ("Please, configure the '{0}' property "
                             & "in the application", P_Facebook_App_Id.PARAM_NAME);
            else
               Writer.Queue_Script (App_Id);
            end if;
         end;
         Writer.Queue_Script (""";fjs.parentNode.insertBefore(js, fjs);"
                              & "}(document, 'script', 'facebook-jssdk'));");
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("id", "fb-root");
         Writer.End_Element ("div");
      end if;
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "fb-like");
      Writer.Write_Attribute ("data-href", Href);
      UI.Render_Attributes (Context, FACEBOOK_ATTRIBUTE_NAMES, Writer);
      Writer.End_Element ("div");
   end Render_Like;

   --  ------------------------------
   --  Google like generator
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Google_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (Generator);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (GOOGLE_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (GOOGLE_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Include_Script ("https://apis.google.com/js/plusone.js");
      end if;
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "g-plusone");
      Writer.Write_Attribute ("data-href", Href);
      UI.Render_Attributes (Context, GOOGLE_ATTRIBUTE_NAMES, Writer);
      Writer.End_Element ("div");
   end Render_Like;

   --  ------------------------------
   --  Tweeter like generator
   --  ------------------------------
   overriding
   procedure Render_Like (Generator : in Twitter_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (Generator);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      Request : constant ASF.Requests.Request_Access := Context.Get_Request;
      Lang    : constant String := Util.Locales.Get_ISO3_Language (Context.Get_Locale);
   begin
      if not Context.Is_Ajax_Request and then
        Util.Beans.Objects.Is_Null (Request.Get_Attribute (TWITTER_SCRIPT_ATTRIBUTE)) then

         Request.Set_Attribute (TWITTER_SCRIPT_ATTRIBUTE, Util.Beans.Objects.To_Object (True));
         Writer.Queue_Script ("!function(d,s,id){var js,fjs=d.getElementsByTagName(s)[0],"
                              & "p=/^http:/.test(d.location)?'http':'https';"
                              & "if(!d.getElementById(id)){js=d.createElement(s);js.id=id;"
                              & "js.src=p+'://platform.twitter.com/widgets.js';"
                              & "fjs.parentNode.insertBefore(js,fjs);}}"
                              & "(document, 'script', 'twitter-wjs');");
      end if;
      Writer.Start_Element ("a");
      Writer.Write_Attribute ("href", "https://twitter.com/share");
      Writer.Write_Attribute ("class", "twitter-share-button");
      Writer.Write_Attribute ("data-url", Href);
      Writer.Write_Attribute ("data-lang", Lang);
      UI.Render_Attributes (Context, TWITTER_ATTRIBUTE_NAMES, Writer);
      Writer.Write_Text ("Tweet");
      Writer.End_Element ("a");
   end Render_Like;

   --  ------------------------------
   --  Get the link to submit in the like action.
   --  ------------------------------
   function Get_Link (UI      : in UILike;
                      Context : in ASF.Contexts.Faces.Faces_Context'Class) return String is
      Href : constant String := UI.Get_Attribute ("href", Context, "");
   begin
      if Href'Length > 0 then
         return Href;
      else
         return Context.Get_Request.Get_Request_URI;
      end if;
   end Get_Link;

   --  ------------------------------
   --  Render an image with the source link created from an email address to the Gravatars service.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UILike;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
   begin
      if UI.Is_Rendered (Context) then
         declare
            Writer : constant Contexts.Writer.Response_Writer_Access
              := Context.Get_Response_Writer;
            Kind   : constant String := UI.Get_Attribute ("type", Context, "");
            Href   : constant String := UILike'Class (UI).Get_Link (Context);
            Style  : constant String := UI.Get_Attribute ("style", Context, "");
            Class  : constant String := UI.Get_Attribute ("styleClass", Context, "");

            procedure Render (Name : in String; Done : out Boolean);

            procedure Render (Name : in String;
                              Done : out Boolean) is
               use type Util.Strings.Name_Access;
            begin
               Done := False;
               for I in Generators'Range loop
                  exit when Generators (I).Name = null;
                  if Generators (I).Name.all = Name then
                     Writer.Start_Element ("div");
                     if Style'Length > 0 then
                        Writer.Write_Attribute ("style", Style);
                     end if;
                     if Class'Length > 0 then
                        Writer.Write_Attribute ("class", Class);
                     end if;
                     Generators (I).Generator.Render_Like (UI, Href, Context);
                     Writer.End_Element ("div");
                     return;
                  end if;
               end loop;
               UI.Log_Error ("Like type {0} is not recognized", Name);
            end Render;

         begin
            if Kind'Length = 0 then
               UI.Log_Error ("The like type is empty.");
            else
               Util.Strings.Tokenizers.Iterate_Tokens (Content => Kind, Pattern => ",",
                                                       Process => Render'Access);
            end if;
         end;
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Register the like generator under the given name.
   --  ------------------------------
   procedure Register_Like (Name      : in Util.Strings.Name_Access;
                            Generator : in Like_Generator_Access) is
      use type Util.Strings.Name_Access;
   begin
      for I in Generators'Range loop
         if Generators (I).Name = null then
            Generators (I).Name := Name;
            Generators (I).Generator := Generator;
            return;
         end if;
      end loop;
   end Register_Like;

begin
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_LAYOUT_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_SHOW_FACES_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_WIDTH_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_ACTION_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_FONT_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_COlORSCHEME_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_REF_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_KIDS_ATTR'Access);
   FACEBOOK_ATTRIBUTE_NAMES.Insert (FB_SEND_ATTR'Access);

   TWITTER_ATTRIBUTE_NAMES.Insert (TW_SIZE_ATTR'Access);
   TWITTER_ATTRIBUTE_NAMES.Insert (TW_COUNT_ATTR'Access);
   TWITTER_ATTRIBUTE_NAMES.Insert (TW_VIA_ATTR'Access);
   TWITTER_ATTRIBUTE_NAMES.Insert (TW_COUNTURL_ATTR'Access);
   TWITTER_ATTRIBUTE_NAMES.Insert (TW_TEXT_ATTR'Access);
   TWITTER_ATTRIBUTE_NAMES.Insert (TW_RELATED_ATTR'Access);
   TWITTER_ATTRIBUTE_NAMES.Insert (TW_LANG_ATTR'Access);
   TWITTER_ATTRIBUTE_NAMES.Insert (TW_HASHTAGS_ATTR'Access);

   GOOGLE_ATTRIBUTE_NAMES.Insert (G_ANNOTATION_ATTR'Access);
   GOOGLE_ATTRIBUTE_NAMES.Insert (G_WIDTH_ATTR'Access);
end ASF.Components.Widgets.Likes;

Add several Twitter attributes for the Tweet button


-----------------------------------------------------------------------
--  components-widgets-likes -- Social Likes Components
--  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.
-----------------------------------------------------------------------
with Util.Strings;

with ASF.Components.Html;
with ASF.Contexts.Faces;
package ASF.Components.Widgets.Likes is

   --  ------------------------------
   --  UILike
   --  ------------------------------
   --  The <b>UILike</b> component displays a social like button to recommend a page.
   type UILike is new ASF.Components.Html.UIHtmlComponent with null record;

   --  Get the link to submit in the like action.
   function Get_Link (UI      : in UILike;
                      Context : in ASF.Contexts.Faces.Faces_Context'Class) return String;

   --  Render the like button for Facebook or Google+.
   overriding
   procedure Encode_Begin (UI      : in UILike;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  ------------------------------
   --  Like Generator
   --  ------------------------------
   --  The <tt>Like_Generator</tt> represents the specific method for the generation of
   --  a social like generator.  A generator is registered under a given name with the
   --  <tt>Register_Like</tt> operation.  The current implementation provides a Facebook
   --  like generator.
   type Like_Generator is limited interface;
   type Like_Generator_Access is access all Like_Generator'Class;

   --  Render the like button according to the generator and the component attributes.
   procedure Render_Like (Generator : in Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is abstract;

   --  Maximum number of generators that can be registered.
   MAX_LIKE_GENERATOR : constant Positive := 5;

   --  Register the like generator under the given name.
   procedure Register_Like (Name      : in Util.Strings.Name_Access;
                            Generator : in Like_Generator_Access);

   --  ------------------------------
   --  Facebook like generator
   --  ------------------------------
   type Facebook_Like_Generator is new Like_Generator with record
      App_Id : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   overriding
   procedure Render_Like (Generator : in Facebook_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class);

end ASF.Components.Widgets.Likes;

-----------------------------------------------------------------------
--  components-widgets-likes -- Social Likes Components
--  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.
-----------------------------------------------------------------------
with Util.Strings;

with ASF.Components.Html;
with ASF.Contexts.Faces;
package ASF.Components.Widgets.Likes is

   --  ------------------------------
   --  UILike
   --  ------------------------------
   --  The <b>UILike</b> component displays a social like button to recommend a page.
   type UILike is new ASF.Components.Html.UIHtmlComponent with null record;

   --  Get the link to submit in the like action.
   function Get_Link (UI      : in UILike;
                      Context : in ASF.Contexts.Faces.Faces_Context'Class) return String;

   --  Render the like button for Facebook or Google+.
   overriding
   procedure Encode_Begin (UI      : in UILike;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  ------------------------------
   --  Like Generator
   --  ------------------------------
   --  The <tt>Like_Generator</tt> represents the specific method for the generation of
   --  a social like generator.  A generator is registered under a given name with the
   --  <tt>Register_Like</tt> operation.  The current implementation provides a Facebook
   --  like generator.
   type Like_Generator is limited interface;
   type Like_Generator_Access is access all Like_Generator'Class;

   --  Render the like button according to the generator and the component attributes.
   procedure Render_Like (Generator : in Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is abstract;

   --  Maximum number of generators that can be registered.
   MAX_LIKE_GENERATOR : constant Positive := 5;

   --  Register the like generator under the given name.
   procedure Register_Like (Name      : in Util.Strings.Name_Access;
                            Generator : in Like_Generator_Access);

   --  ------------------------------
   --  Facebook like generator
   --  ------------------------------
   type Facebook_Like_Generator is new Like_Generator with record
      App_Id : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   overriding
   procedure Render_Like (Generator : in Facebook_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  ------------------------------
   --  Google like generator
   --  ------------------------------
   type Google_Like_Generator is new Like_Generator with null record;

   overriding
   procedure Render_Like (Generator : in Google_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class);

end ASF.Components.Widgets.Likes;

Define the Google_Like_Generator type

Define the Google_Like_Generator type