-----------------------------------------------------------------------
--  awa-blogs-module -- Blog and post management module
--  Copyright (C) 2011, 2012, 2013, 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.Log.Loggers;

with AWA.Modules.Get;
with AWA.Modules.Beans;
with AWA.Blogs.Beans;
with AWA.Applications;
with AWA.Services.Contexts;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;

with ADO.Objects;
with ADO.Sessions;

with Ada.Calendar;

package body AWA.Blogs.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Blogs.Module");

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

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

      --  Setup the resource bundles.
      App.Register ("blogMsg", "blogs");

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_List_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Admin_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Admin_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Status_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Status_List'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Stat_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Stat_Bean'Access);

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

   --  ------------------------------
   --  Get the blog module instance associated with the current application.
   --  ------------------------------
   function Get_Blog_Module return Blog_Module_Access is
      function Get is new AWA.Modules.Get (Blog_Module, Blog_Module_Access, NAME);
   begin
      return Get;
   end Get_Blog_Module;

   --  ------------------------------
   --  Create a new blog for the user workspace.
   --  ------------------------------
   procedure Create_Blog (Model        : in Blog_Module;
                          Title        : in String;
                          Result       : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating blog {0} for user", Title);

      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

      --  Check that the user has the create blog permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Blog.Permission,
                             Entity     => WS);

      Blog.Set_Name (Title);
      Blog.Set_Workspace (WS);
      Blog.Set_Create_Date (Ada.Calendar.Clock);
      Blog.Save (DB);

      --  Add the permission for the user to use the new blog.
      AWA.Workspaces.Modules.Add_Permission (Session   => DB,
                                             User      => User,
                                             Entity    => Blog,
                                             Workspace => WS.Get_Id,
                                             List      => (ACL_Delete_Blog.Permission,
                                                           ACL_Update_Post.Permission,
                                                           ACL_Create_Post.Permission,
                                                           ACL_Delete_Post.Permission));
      Ctx.Commit;

      Result := Blog.Get_Id;
      Log.Info ("Blog {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Blog;

   --  ------------------------------
   --  Create a new post associated with the given blog identifier.
   --  ------------------------------
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Log.Debug ("Creating post for user");

      Ctx.Start;
      --  Get the blog instance.
      Blog.Load (Session => DB,
                 Id      => Blog_Id,
                 Found   => Found);
      if not Found then
         Log.Error ("Blog {0} not found", ADO.Identifier'Image (Blog_Id));
         raise Not_Found with "Blog not found";
      end if;

      --  Check that the user has the create post permission on the given blog.
      AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
                             Entity     => Blog);

      --  Build the new post.
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Create_Date (Ada.Calendar.Clock);
      Post.Set_Uri (URI);
      Post.Set_Author (Ctx.Get_User);
      Post.Set_Status (Status);
      Post.Set_Blog (Blog);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;

      Result := Post.Get_Id;
      Log.Info ("Post {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Post;

   --  ------------------------------
   --  Update the post title and text associated with the blog post identified by <b>Post</b>.
   --  ------------------------------
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type) is
      pragma Unreferenced (Model);
      use type AWA.Blogs.Models.Post_Status_Type;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the update post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Update_Post.Permission,
                             Entity     => Post);

      if Status = AWA.Blogs.Models.POST_PUBLISHED and then Post.Get_Publish_Date.Is_Null then
         Post.Set_Publish_Date (ADO.Nullable_Time '(Is_Null => False,
                                                    Value   => Ada.Calendar.Clock));
      end if;
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Uri (URI);
      Post.Set_Status (Status);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;
   end Update_Post;

   --  ------------------------------
   --  Delete the post identified by the given identifier.
   --  ------------------------------
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the delete post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Delete_Post.Permission,
                             Entity     => Post);

      Post.Delete (Session => DB);
      Ctx.Commit;
   end Delete_Post;

end AWA.Blogs.Modules;

-----------------------------------------------------------------------
--  awa-blogs-module -- Blog and post management module
--  Copyright (C) 2011, 2012, 2013, 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.Log.Loggers;

with AWA.Modules.Get;
with AWA.Modules.Beans;
with AWA.Blogs.Beans;
with AWA.Applications;
with AWA.Services.Contexts;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Storages.Models;

with ADO.Objects;
with ADO.Sessions;
with ADO.Statements;

package body AWA.Blogs.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Blogs.Module");

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

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

      --  Setup the resource bundles.
      App.Register ("blogMsg", "blogs");

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_List_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Admin_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Admin_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Status_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Status_List'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Stat_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Stat_Bean'Access);

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

   --  ------------------------------
   --  Get the blog module instance associated with the current application.
   --  ------------------------------
   function Get_Blog_Module return Blog_Module_Access is
      function Get is new AWA.Modules.Get (Blog_Module, Blog_Module_Access, NAME);
   begin
      return Get;
   end Get_Blog_Module;

   --  ------------------------------
   --  Create a new blog for the user workspace.
   --  ------------------------------
   procedure Create_Blog (Model        : in Blog_Module;
                          Title        : in String;
                          Result       : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating blog {0} for user", Title);

      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

      --  Check that the user has the create blog permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Blog.Permission,
                             Entity     => WS);

      Blog.Set_Name (Title);
      Blog.Set_Workspace (WS);
      Blog.Set_Create_Date (Ada.Calendar.Clock);
      Blog.Save (DB);

      --  Add the permission for the user to use the new blog.
      AWA.Workspaces.Modules.Add_Permission (Session   => DB,
                                             User      => User,
                                             Entity    => Blog,
                                             Workspace => WS.Get_Id,
                                             List      => (ACL_Delete_Blog.Permission,
                                                           ACL_Update_Post.Permission,
                                                           ACL_Create_Post.Permission,
                                                           ACL_Delete_Post.Permission));
      Ctx.Commit;

      Result := Blog.Get_Id;
      Log.Info ("Blog {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Blog;

   --  ------------------------------
   --  Create a new post associated with the given blog identifier.
   --  ------------------------------
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Log.Debug ("Creating post for user");

      Ctx.Start;
      --  Get the blog instance.
      Blog.Load (Session => DB,
                 Id      => Blog_Id,
                 Found   => Found);
      if not Found then
         Log.Error ("Blog {0} not found", ADO.Identifier'Image (Blog_Id));
         raise Not_Found with "Blog not found";
      end if;

      --  Check that the user has the create post permission on the given blog.
      AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
                             Entity     => Blog);

      --  Build the new post.
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Create_Date (Ada.Calendar.Clock);
      Post.Set_Uri (URI);
      Post.Set_Author (Ctx.Get_User);
      Post.Set_Status (Status);
      Post.Set_Blog (Blog);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;

      Result := Post.Get_Id;
      Log.Info ("Post {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Post;

   --  ------------------------------
   --  Update the post title and text associated with the blog post identified by <b>Post</b>.
   --  ------------------------------
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type) is
      pragma Unreferenced (Model);
      use type AWA.Blogs.Models.Post_Status_Type;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the update post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Update_Post.Permission,
                             Entity     => Post);

      if Status = AWA.Blogs.Models.POST_PUBLISHED and then Post.Get_Publish_Date.Is_Null then
         Post.Set_Publish_Date (ADO.Nullable_Time '(Is_Null => False,
                                                    Value   => Ada.Calendar.Clock));
      end if;
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Uri (URI);
      Post.Set_Status (Status);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;
   end Update_Post;

   --  ------------------------------
   --  Delete the post identified by the given identifier.
   --  ------------------------------
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the delete post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Delete_Post.Permission,
                             Entity     => Post);

      Post.Delete (Session => DB);
      Ctx.Commit;
   end Delete_Post;

   --  ------------------------------
   --  Load the image data associated with a blog post.  The image must be public and the
   --  post visible for the image to be retrieved by anonymous users.
   --  ------------------------------
   procedure Load_Image (Model    : in Blog_Module;
                         Post_Id  : in ADO.Identifier;
                         Image_Id : in ADO.Identifier;
                         Width    : in out Natural;
                         Height   : in out Natural;
                         Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                         Date     : out Ada.Calendar.Time;
                         Into     : out ADO.Blob_Ref) is
      pragma Unreferenced (Model);
      use type AWA.Storages.Models.Storage_Type;

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Statements.Query_Statement;
      Kind  : AWA.Storages.Models.Storage_Type;
   begin
      if Width = Natural'Last or Height = Natural'Last then
         Query := DB.Create_Statement (Models.Query_Blog_Image_Get_Data);
      elsif Width > 0 then
         Query := DB.Create_Statement (Models.Query_Blog_Image_Width_Get_Data);
         Query.Bind_Param ("width", Width);
      elsif Height > 0 then
         Query := DB.Create_Statement (Models.Query_Blog_Image_Height_Get_Data);
         Query.Bind_Param ("height", Height);
      else
         Query := DB.Create_Statement (Models.Query_Blog_Image_Get_Data);
      end if;
      Query.Bind_Param ("post_id", Post_Id);
      Query.Bind_Param ("store_id", Image_Id);
      Query.Bind_Param ("user_id", User);
      Query.Execute;
      if not Query.Has_Elements then
         Log.Warn ("Blog post image entity {0} not found", ADO.Identifier'Image (Image_Id));
         raise ADO.Objects.NOT_FOUND;
      end if;
      Mime   := Query.Get_Unbounded_String (0);
      Date   := Query.Get_Time (1);
      Width  := Query.Get_Natural (4);
      Height := Query.Get_Natural (5);
      Kind   := AWA.Storages.Models.Storage_Type'Val (Query.Get_Integer (3));
      if Kind = AWA.Storages.Models.DATABASE then
         Into := Query.Get_Blob (6);
      else
         null;
      end if;
   end Load_Image;

end AWA.Blogs.Modules;

Implement the Load_Image procedure to load the image data for a post


-----------------------------------------------------------------------
--  awa-counters --
--  Copyright (C) 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 ADO.Objects;
with ADO.Schemas;
with Util.Strings;
with AWA.Index_Arrays;
package AWA.Counters is

   type Counter_Index_Type is new Natural;

   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object <tt>Object</tt>.
   procedure Increment (Counter : in Counter_Index_Type;
                        Object  : in ADO.Objects.Object_Ref'Class);

   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object key <tt>Key</tt>.
   procedure Increment (Counter : in Counter_Index_Type;
                        Key     : in ADO.Objects.Object_Key);

   --  Increment the global counter identified by <tt>Counter</tt>.
   procedure Increment (Counter : in Counter_Index_Type);

private

   type Counter_Def is record
      Table : ADO.Schemas.Class_Mapping_Access;
      Field : Util.Strings.Name_Access;
   end record;

   function "=" (Left, Right : in Counter_Def) return Boolean;
   function "<" (Left, Right : in Counter_Def) return Boolean;
   function "&" (Left  : in String;
                 Right : in Counter_Def) return String;

   package Counter_Arrays is new AWA.Index_Arrays (Counter_Index_Type, Counter_Def);

end AWA.Counters;

-----------------------------------------------------------------------
--  awa-counters --
--  Copyright (C) 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 ADO.Objects;
with ADO.Schemas;
with Util.Strings;
with AWA.Index_Arrays;

--  == Introduction ==
--  The Counters module defines a general purpose counter service that allows to
--  associate counters to database entities.  For example it can be used to track the number
--  of times a blog post or a wiki page is accessed.  The Counters module maintains the
--  counters in a table on a per-day and per-entity basis.  It allows to update the full counter
--  in the target database entity table.
--
--  @include awa-counters-modules.ads
--
--  === Counter Declaration ===
--  Each counter must be declared by instantiating the Definition package.
--  This instantiation serves as identification of the counter and it defines the database
--  table as well as the column in that table that will hold the total counter.  The following
--  definition is used for the read counter of a wiki page.  The wiki page table contains a
--  read_count column and it will be incremented each time the counter is incremented.
--
--     package Read_Counter is
--        new AWA.Counters.Definition (AWA.Wikis.Models.WIKI_PAGE_TABLE, "read_count");
--
--  When the database table does not contain any counter column, the counter definition is
--  defined as follows:
--
--     package Login_Counter is
--        new AWA.Counters.Definition (AWA.Users.Models.USER_PAGE_TABLE);
--
--  Sometimes a counter is not associated with any database entity.  Such counters are global
--  and they are assigned a unique name.
--
--     package Start_Counter is
--        new AWA.Counters.Definition (null, "startup_counter");
--
--  === Incrementing the counter ===
--  Incrementing the counter is done by calling the Increment operation.
--  When the counter is associated with a database entity, the entity primary key must be given.
--
--     AWA.Counters.Increment (Counter => Read_Counter.Counter, Key => Id);
--
--  A global counter is also incremented by using the Increment operation.
--
--     AWA.Counters.Increment (Counter => Start_Counter.Counter);
--
--  @include awa-counters-beans.ads
--  @include awa-counters-components.ads
--  @include counters.xml
--
--  == Model ==
--  [images/awa_counters_model.png]
--
package AWA.Counters is

   type Counter_Index_Type is new Natural;

   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object <tt>Object</tt>.
   procedure Increment (Counter : in Counter_Index_Type;
                        Object  : in ADO.Objects.Object_Ref'Class);

   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object key <tt>Key</tt>.
   procedure Increment (Counter : in Counter_Index_Type;
                        Key     : in ADO.Objects.Object_Key);

   --  Increment the global counter identified by <tt>Counter</tt>.
   procedure Increment (Counter : in Counter_Index_Type);

private

   type Counter_Def is record
      Table : ADO.Schemas.Class_Mapping_Access;
      Field : Util.Strings.Name_Access;
   end record;

   function "=" (Left, Right : in Counter_Def) return Boolean;
   function "<" (Left, Right : in Counter_Def) return Boolean;
   function "&" (Left  : in String;
                 Right : in Counter_Def) return String;

   package Counter_Arrays is new AWA.Index_Arrays (Counter_Index_Type, Counter_Def);

end AWA.Counters;

Document the AWA counters plugin

Document the AWA counters plugin


-----------------------------------------------------------------------
--  EL.Contexts -- Default contexts for evaluating an expression
--  Copyright (C) 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 EL.Variables;
with Ada.Finalization;

private with Util.Beans.Objects.Maps;
--  private with EL.Objects.Maps;  creates Assert_Failure sem_ch10.adb:2691
package EL.Contexts.Default is

   --  ------------------------------
   --  Default Context
   --  ------------------------------
   --  Context information for expression evaluation.
   type Default_Context is new Ada.Finalization.Controlled and ELContext with private;
   type Default_Context_Access is access all Default_Context'Class;

   --  Retrieves the ELResolver associated with this ELcontext.
   overriding
   function Get_Resolver (Context : Default_Context) return ELResolver_Access;

   --  Retrieves the VariableMapper associated with this ELContext.
   overriding
   function Get_Variable_Mapper (Context : Default_Context)
                                 return access EL.Variables.Variable_Mapper'Class;

   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   overriding
   function Get_Function_Mapper (Context : Default_Context)
                                 return EL.Functions.Function_Mapper_Access;

   --  Set the function mapper to be used when parsing an expression.
   overriding
   procedure Set_Function_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Functions.Function_Mapper'Class);

   --  Set the VariableMapper associated with this ELContext.
   overriding
   procedure Set_Variable_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Variables.Variable_Mapper'Class);

   --  Set the ELResolver associated with this ELcontext.
   procedure Set_Resolver (Context  : in out Default_Context;
                           Resolver : in ELResolver_Access);

   procedure Set_Variable (Context : in out Default_Context;
                           Name    : in String;
                           Value   : access Util.Beans.Basic.Readonly_Bean'Class);

   --  Handle the exception during expression evaluation.
   overriding
   procedure Handle_Exception (Context : in Default_Context;
                               Ex      : in Ada.Exceptions.Exception_Occurrence);

   --  ------------------------------
   --  Guarded Context
   --  ------------------------------
   --  The Guarded_Context is a proxy context that allows to handle exceptions
   --  raised when evaluating expressions.  The Handler procedure will be called
   --  when an exception is raised when the expression is evaluated.  This allows to
   --  report an error message and ignore or not the exception (See ASF).
   type Guarded_Context (Handler : not null access
                           procedure (Ex : in Ada.Exceptions.Exception_Occurrence);
                         Context : ELContext_Access)
     is new Ada.Finalization.Limited_Controlled and ELContext with null record;
   type Guarded_Context_Access is access all Default_Context'Class;

   --  Retrieves the ELResolver associated with this ELcontext.
   overriding
   function Get_Resolver (Context : in Guarded_Context) return ELResolver_Access;

   --  Retrieves the Variable_Mapper associated with this ELContext.
   overriding
   function Get_Variable_Mapper (Context : in Guarded_Context)
                                 return access EL.Variables.Variable_Mapper'Class;

   --  Retrieves the Function_Mapper associated with this ELContext.
   --  The Function_Mapper is only used when parsing an expression.
   overriding
   function Get_Function_Mapper (Context : in Guarded_Context)
                                 return EL.Functions.Function_Mapper_Access;

   --  Set the function mapper to be used when parsing an expression.
   overriding
   procedure Set_Function_Mapper (Context : in out Guarded_Context;
                                  Mapper  : access EL.Functions.Function_Mapper'Class);

   --  Set the Variable_Mapper associated with this ELContext.
   overriding
   procedure Set_Variable_Mapper (Context : in out Guarded_Context;
                                  Mapper  : access EL.Variables.Variable_Mapper'Class);

   --  Handle the exception during expression evaluation.
   overriding
   procedure Handle_Exception (Context : in Guarded_Context;
                               Ex      : in Ada.Exceptions.Exception_Occurrence);

   --  ------------------------------
   --  Default Resolver
   --  ------------------------------
   type Default_ELResolver is new ELResolver with private;
   type Default_ELResolver_Access is access all Default_ELResolver'Class;

   --  Get the value associated with a base object and a given property.
   overriding
   function Get_Value (Resolver : Default_ELResolver;
                       Context  : ELContext'Class;
                       Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                       Name     : Unbounded_String) return EL.Objects.Object;

   --  Set the value associated with a base object and a given property.
   overriding
   procedure Set_Value (Resolver : in out Default_ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access Util.Beans.Basic.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in EL.Objects.Object);

   --  Register the value under the given name.
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : in Util.Beans.Basic.Readonly_Bean_Access);

   --  Register the value under the given name.
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : in EL.Objects.Object);

private

   type Default_Context is new Ada.Finalization.Controlled and ELContext with record
      Var_Mapper         : EL.Variables.Variable_Mapper_Access;
      Resolver           : ELResolver_Access;
      Function_Mapper    : EL.Functions.Function_Mapper_Access;
      Var_Mapper_Created : Boolean := False;
   end record;

   overriding
   procedure Finalize (Obj : in out Default_Context);

   type Default_ELResolver is new ELResolver with record
      Map : EL.Objects.Maps.Map;
   end record;

end EL.Contexts.Default;

-----------------------------------------------------------------------
--  EL.Contexts -- Default contexts for evaluating an expression
--  Copyright (C) 2009, 2010, 2011, 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 EL.Variables;
with Ada.Finalization;

private with Util.Beans.Objects.Maps;
--  private with EL.Objects.Maps;  creates Assert_Failure sem_ch10.adb:2691
package EL.Contexts.Default is

   --  ------------------------------
   --  Default Context
   --  ------------------------------
   --  Context information for expression evaluation.
   type Default_Context is new Ada.Finalization.Controlled and ELContext with private;
   type Default_Context_Access is access all Default_Context'Class;

   overriding
   procedure Finalize (Obj : in out Default_Context);

   --  Retrieves the ELResolver associated with this ELcontext.
   overriding
   function Get_Resolver (Context : Default_Context) return ELResolver_Access;

   --  Retrieves the VariableMapper associated with this ELContext.
   overriding
   function Get_Variable_Mapper (Context : Default_Context)
                                 return access EL.Variables.Variable_Mapper'Class;

   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   overriding
   function Get_Function_Mapper (Context : Default_Context)
                                 return EL.Functions.Function_Mapper_Access;

   --  Set the function mapper to be used when parsing an expression.
   overriding
   procedure Set_Function_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Functions.Function_Mapper'Class);

   --  Set the VariableMapper associated with this ELContext.
   overriding
   procedure Set_Variable_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Variables.Variable_Mapper'Class);

   --  Set the ELResolver associated with this ELcontext.
   procedure Set_Resolver (Context  : in out Default_Context;
                           Resolver : in ELResolver_Access);

   procedure Set_Variable (Context : in out Default_Context;
                           Name    : in String;
                           Value   : access Util.Beans.Basic.Readonly_Bean'Class);

   --  Handle the exception during expression evaluation.
   overriding
   procedure Handle_Exception (Context : in Default_Context;
                               Ex      : in Ada.Exceptions.Exception_Occurrence);

   --  ------------------------------
   --  Guarded Context
   --  ------------------------------
   --  The Guarded_Context is a proxy context that allows to handle exceptions
   --  raised when evaluating expressions.  The Handler procedure will be called
   --  when an exception is raised when the expression is evaluated.  This allows to
   --  report an error message and ignore or not the exception (See ASF).
   type Guarded_Context (Handler : not null access
                           procedure (Ex : in Ada.Exceptions.Exception_Occurrence);
                         Context : ELContext_Access)
     is new Ada.Finalization.Limited_Controlled and ELContext with null record;
   type Guarded_Context_Access is access all Default_Context'Class;

   --  Retrieves the ELResolver associated with this ELcontext.
   overriding
   function Get_Resolver (Context : in Guarded_Context) return ELResolver_Access;

   --  Retrieves the Variable_Mapper associated with this ELContext.
   overriding
   function Get_Variable_Mapper (Context : in Guarded_Context)
                                 return access EL.Variables.Variable_Mapper'Class;

   --  Retrieves the Function_Mapper associated with this ELContext.
   --  The Function_Mapper is only used when parsing an expression.
   overriding
   function Get_Function_Mapper (Context : in Guarded_Context)
                                 return EL.Functions.Function_Mapper_Access;

   --  Set the function mapper to be used when parsing an expression.
   overriding
   procedure Set_Function_Mapper (Context : in out Guarded_Context;
                                  Mapper  : access EL.Functions.Function_Mapper'Class);

   --  Set the Variable_Mapper associated with this ELContext.
   overriding
   procedure Set_Variable_Mapper (Context : in out Guarded_Context;
                                  Mapper  : access EL.Variables.Variable_Mapper'Class);

   --  Handle the exception during expression evaluation.
   overriding
   procedure Handle_Exception (Context : in Guarded_Context;
                               Ex      : in Ada.Exceptions.Exception_Occurrence);

   --  ------------------------------
   --  Default Resolver
   --  ------------------------------
   type Default_ELResolver is new ELResolver with private;
   type Default_ELResolver_Access is access all Default_ELResolver'Class;

   --  Get the value associated with a base object and a given property.
   overriding
   function Get_Value (Resolver : Default_ELResolver;
                       Context  : ELContext'Class;
                       Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                       Name     : Unbounded_String) return EL.Objects.Object;

   --  Set the value associated with a base object and a given property.
   overriding
   procedure Set_Value (Resolver : in out Default_ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access Util.Beans.Basic.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in EL.Objects.Object);

   --  Register the value under the given name.
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : in Util.Beans.Basic.Readonly_Bean_Access);

   --  Register the value under the given name.
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : in EL.Objects.Object);

private

   type Default_Context is new Ada.Finalization.Controlled and ELContext with record
      Var_Mapper         : EL.Variables.Variable_Mapper_Access;
      Resolver           : ELResolver_Access;
      Function_Mapper    : EL.Functions.Function_Mapper_Access;
      Var_Mapper_Created : Boolean := False;
   end record;

   type Default_ELResolver is new ELResolver with record
      Map : EL.Objects.Maps.Map;
   end record;

end EL.Contexts.Default;

Make the Finalize procedure visible

Make the Finalize procedure visible


-----------------------------------------------------------------------
--  ado-statements-tests -- Test statements package
--  Copyright (C) 2015, 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.Tests;
package ADO.Statements.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   --  Test creation of several rows in test_table with different column type.
   procedure Test_Save (T : in out Test);

   --  Test queries using the $entity_type[] cache group.
   procedure Test_Entity_Types (T : in out Test);

end ADO.Statements.Tests;

-----------------------------------------------------------------------
--  ado-statements-tests -- Test statements package
--  Copyright (C) 2015, 2017, 2018 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.Tests;
package ADO.Statements.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   --  Test creation of several rows in test_table with different column type.
   procedure Test_Save (T : in out Test);

   --  Test queries using the $entity_type[] cache group.
   procedure Test_Entity_Types (T : in out Test);

   --  Test executing a SQL query and getting an invalid column.
   procedure Test_Invalid_Column (T : in out Test);

end ADO.Statements.Tests;

Declare the Test_Invalid_Column procedure


------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.S_Expressions.Printers.Pretty provides an implementation of the  --
-- S-expression Printer interface, using user-defines perferences to pretty --
-- print the S-expression into the output stream.                           --
------------------------------------------------------------------------------

with Ada.Streams;

with Natools.S_Expressions.Encodings;

package Natools.S_Expressions.Printers.Pretty is
   pragma Pure (Pretty);

   type Atom_Encoding is (Base64, Hexadecimal, Verbatim);
   type Character_Encoding is (ASCII, Latin, UTF_8);
   type Newline_Encoding is (CR, LF, CR_LF, LF_CR);
   type Entity is (Opening, Atom_Data, Closing);
   type Entity_Separator is array (Entity, Entity) of Boolean;
   type Indent_Type is (Spaces, Tabs, Tabs_And_Spaces);
   type Quoted_Escape_Type is (Hex_Escape, Octal_Escape);
   type Quoted_Option is (When_Shorter, Single_Line, No_Quoted);
   type Token_Option is (Extended_Token, Standard_Token, No_Token);
   type Screen_Offset is new Natural;

   subtype Screen_Column is Screen_Offset range 1 .. Screen_Offset'Last;

   type Parameters is record
      Width         : Screen_Offset        := 0;
      Newline_At    : Entity_Separator     := (others => (others => False));
      Space_At      : Entity_Separator     := (others => (others => False));
      Tab_Stop      : Screen_Column        := 8;                --  *
      Indentation   : Screen_Offset        := 0;
      Indent        : Indent_Type          := Spaces;           --  *
      Quoted        : Quoted_Option        := No_Quoted;
      Token         : Token_Option         := No_Token;
      Hex_Casing    : Encodings.Hex_Casing := Encodings.Upper;  --  *
      Quoted_Escape : Quoted_Escape_Type   := Hex_Escape;       --  *
      Char_Encoding : Character_Encoding   := ASCII;            --  *
      Fallback      : Atom_Encoding        := Verbatim;
      Newline       : Newline_Encoding     := LF;               --  *
   end record;
      --  Default values yield canonical encoding, though fields marked with
      --  an asterisk (*) can have any value and still be canonical.

   Canonical : constant Parameters := (others => <>);

   type Printer is abstract limited new Printers.Printer with private;
   pragma Preelaborable_Initialization (Printer);

   procedure Write_Raw
     (Output : in out Printer;
      Data : in Ada.Streams.Stream_Element_Array)
     is abstract;

   overriding procedure Open_List (Output : in out Printer);
   overriding procedure Append_Atom
     (Output : in out Printer;
      Data : in Atom);
   overriding procedure Close_List (Output : in out Printer);

   procedure Newline (Output : in out Printer);
      --  Open a new indented line in the output

   procedure Set_Parameters (Output : in out Printer; Param : in Parameters);
   function Get_Parameters (Output : Printer) return Parameters;

   procedure Set_Width
     (Output : in out Printer;
      Width : in Screen_Offset);
   procedure Set_Newline_At
     (Output : in out Printer;
      Newline_At : in Entity_Separator);
   procedure Set_Space_At
     (Output : in out Printer;
      Space_At : in Entity_Separator);
   procedure Set_Tab_Stop
     (Output : in out Printer;
      Tab_Stop : in Screen_Column);
   procedure Set_Indentation
     (Output : in out Printer;
      Indentation : in Screen_Offset);
   procedure Set_Indent
     (Output : in out Printer;
      Indent : in Indent_Type);
   procedure Set_Quoted
     (Output : in out Printer;
      Quoted : in Quoted_Option);
   procedure Set_Token
     (Output : in out Printer;
      Token : in Token_Option);
   procedure Set_Hex_Casing
     (Output : in out Printer;
      Hex_Casing : in Encodings.Hex_Casing);
   procedure Set_Quoted_Escape
     (Output : in out Printer;
      Quoted_Escape : in Quoted_Escape_Type);
   procedure Set_Char_Encoding
     (Output : in out Printer;
      Char_Encoding : in Character_Encoding);
   procedure Set_Fallback
     (Output : in out Printer;
      Fallback : in Atom_Encoding);
   procedure Set_Newline
     (Output : in out Printer;
      Newline : in Newline_Encoding);

   type Stream_Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     limited new Printers.Printer with private;

private

   type Printer is abstract limited new Printers.Printer with record
      Param        : Parameters;
      Cursor       : Screen_Column := 1;
      Previous     : Entity;
      First        : Boolean := True;
      Indent_Level : Screen_Offset := 0;
      Need_Blank   : Boolean := False;
   end record;

   type Stream_Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     new Printer with null record;

   overriding procedure Write_Raw
     (Output : in out Stream_Printer;
      Data : in Ada.Streams.Stream_Element_Array);

end Natools.S_Expressions.Printers.Pretty;

------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.S_Expressions.Printers.Pretty provides an implementation of the  --
-- S-expression Printer interface, using user-defines perferences to pretty --
-- print the S-expression into the output stream.                           --
------------------------------------------------------------------------------

with Ada.Streams;

with Natools.S_Expressions.Encodings;

package Natools.S_Expressions.Printers.Pretty is
   pragma Pure (Pretty);

   type Atom_Encoding is (Base64, Hexadecimal, Verbatim);
   type Character_Encoding is (ASCII, Latin, UTF_8);
   type Newline_Encoding is (CR, LF, CR_LF, LF_CR);
   type Entity is (Opening, Atom_Data, Closing);
   type Entity_Separator is array (Entity, Entity) of Boolean;
   type Indent_Type is (Spaces, Tabs, Tabs_And_Spaces);
   type Quoted_Escape_Type is (Hex_Escape, Octal_Escape);
   type Quoted_Option is (When_Shorter, Single_Line, No_Quoted);
   type Token_Option is (Extended_Token, Standard_Token, No_Token);
   type Screen_Offset is new Natural;

   subtype Screen_Column is Screen_Offset range 1 .. Screen_Offset'Last;

   type Parameters is record
      Width         : Screen_Offset        := 0;
      Newline_At    : Entity_Separator     := (others => (others => False));
      Space_At      : Entity_Separator     := (others => (others => False));
      Tab_Stop      : Screen_Column        := 8;                --  *
      Indentation   : Screen_Offset        := 0;
      Indent        : Indent_Type          := Spaces;           --  *
      Quoted        : Quoted_Option        := No_Quoted;
      Token         : Token_Option         := No_Token;
      Hex_Casing    : Encodings.Hex_Casing := Encodings.Upper;  --  *
      Quoted_Escape : Quoted_Escape_Type   := Hex_Escape;       --  *
      Char_Encoding : Character_Encoding   := ASCII;            --  *
      Fallback      : Atom_Encoding        := Verbatim;
      Newline       : Newline_Encoding     := LF;               --  *
   end record;
      --  Default values yield canonical encoding, though fields marked with
      --  an asterisk (*) can have any value and still be canonical.

   Canonical : constant Parameters := (others => <>);

   type Printer is abstract limited new Printers.Printer with private;
   pragma Preelaborable_Initialization (Printer);

   procedure Write_Raw
     (Output : in out Printer;
      Data : in Ada.Streams.Stream_Element_Array)
     is abstract;

   overriding procedure Open_List (Output : in out Printer);
   overriding procedure Append_Atom
     (Output : in out Printer;
      Data : in Atom);
   overriding procedure Close_List (Output : in out Printer);

   procedure Newline (Output : in out Printer);
      --  Open a new indented line in the output

   procedure Set_Parameters (Output : in out Printer; Param : in Parameters);
   function Get_Parameters (Output : Printer) return Parameters;

   procedure Set_Width
     (Output : in out Printer;
      Width : in Screen_Offset);
   procedure Set_Newline_At
     (Output : in out Printer;
      Newline_At : in Entity_Separator);
   procedure Set_Space_At
     (Output : in out Printer;
      Space_At : in Entity_Separator);
   procedure Set_Tab_Stop
     (Output : in out Printer;
      Tab_Stop : in Screen_Column);
   procedure Set_Indentation
     (Output : in out Printer;
      Indentation : in Screen_Offset);
   procedure Set_Indent
     (Output : in out Printer;
      Indent : in Indent_Type);
   procedure Set_Quoted
     (Output : in out Printer;
      Quoted : in Quoted_Option);
   procedure Set_Token
     (Output : in out Printer;
      Token : in Token_Option);
   procedure Set_Hex_Casing
     (Output : in out Printer;
      Hex_Casing : in Encodings.Hex_Casing);
   procedure Set_Quoted_Escape
     (Output : in out Printer;
      Quoted_Escape : in Quoted_Escape_Type);
   procedure Set_Char_Encoding
     (Output : in out Printer;
      Char_Encoding : in Character_Encoding);
   procedure Set_Fallback
     (Output : in out Printer;
      Fallback : in Atom_Encoding);
   procedure Set_Newline
     (Output : in out Printer;
      Newline : in Newline_Encoding);

   type Stream_Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     limited new Printer with private;

private

   type Printer is abstract limited new Printers.Printer with record
      Param        : Parameters;
      Cursor       : Screen_Column := 1;
      Previous     : Entity;
      First        : Boolean := True;
      Indent_Level : Screen_Offset := 0;
      Need_Blank   : Boolean := False;
   end record;

   type Stream_Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     new Printer with null record;

   overriding procedure Write_Raw
     (Output : in out Stream_Printer;
      Data : in Ada.Streams.Stream_Element_Array);

end Natools.S_Expressions.Printers.Pretty;

make ancestry of Stream_Parser public

s_expressions-printers-pretty: make ancestry of Stream_Parser public


-----------------------------------------------------------------------
--  ADO Sqlite Database -- SQLite Database connections
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 2017, 2018 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 Interfaces.C.Strings;

with Util.Log;
with Util.Log.Loggers;
with Util.Processes.Tools;
with ADO.Sessions;
with ADO.Statements.Sqlite;
with ADO.Schemas.Sqlite;

package body ADO.Drivers.Connections.Sqlite is

   use ADO.Statements.Sqlite;
   use Interfaces.C;

   pragma Linker_Options ("-lsqlite3");

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Databases.Sqlite");

   Driver_Name : aliased constant String := "sqlite";
   Driver      : aliased Sqlite_Driver;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access is
      pragma Unreferenced (Database);
   begin
      return Driver'Access;
   end Get_Driver;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Query => Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a delete statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Rollback;

   --  ------------------------------
   --  Closes the database connection
   --  ------------------------------
   overriding
   procedure Close (Database : in out Database_Connection) is
      Result : int;
   begin
      Log.Info ("Close connection {0}", Database.Name);

      if Database.Server /= null then
         Result := Sqlite3_H.sqlite3_close_v2 (Database.Server);
         if Result /= Sqlite3_H.SQLITE_OK then
            declare
               Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Result);
               Msg   : constant String := Strings.Value (Error);
            begin
               Log.Error ("Cannot close database {0}: {1}", To_String (Database.Name), Msg);
            end;
         end if;
         Database.Server := null;
      end if;
   end Close;

   --  ------------------------------
   --  Releases the sqlite connection if it is open
   --  ------------------------------
   overriding
   procedure Finalize (Database : in out Database_Connection) is
   begin
      Log.Debug ("Release database connection");

      if Database.Server /= null then
         Database.Close;
      end if;
   end Finalize;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   overriding
   procedure Load_Schema (Database : in Database_Connection;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      ADO.Schemas.Sqlite.Load_Schema (Database, Schema);
   end Load_Schema;

   --  ------------------------------
   --  Initialize the database connection manager.
   --  ------------------------------
   procedure Create_Connection (D      : in out Sqlite_Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
      pragma Unreferenced (D);
      use Strings;

      Name     : constant String := Config.Get_Database;
      Filename : Strings.chars_ptr;
      Status   : int;
      Handle   : aliased access Sqlite3;
      Flags    : constant int := Sqlite3_H.SQLITE_OPEN_FULLMUTEX + Sqlite3_H.SQLITE_OPEN_READWRITE;
   begin
      Log.Info ("Opening database {0}", Name);

      Filename := Strings.New_String (Name);
      Status := Sqlite3_H.sqlite3_open_v2 (Filename, Handle'Address,
                                           Flags,
                                           Strings.Null_Ptr);

      Strings.Free (Filename);
      if Status /= Sqlite3_H.SQLITE_OK then
         declare
            Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Status);
            Msg   : constant String := Strings.Value (Error);
         begin
            Log.Error ("Cannot open SQLite database: {0}", Msg);
            raise ADO.Configs.Connection_Error with "Cannot open database: " & Msg;
         end;
      end if;

      declare
         Database : constant Database_Connection_Access := new Database_Connection;

         procedure Configure (Name : in String;
                              Item : in Util.Properties.Value);
         function Escape (Value : in Util.Properties.Value) return String;

         function Escape (Value : in Util.Properties.Value) return String is
            S : constant String := Util.Properties.To_String (Value);
         begin
            if S'Length > 0 and then S (S'First) >= '0' and then S (S'First) <= '9' then
               return S;
            elsif S'Length > 0 and then S (S'First) = ''' then
               return S;
            else
               return "'" & S & "'";
            end if;
         end Escape;

         procedure Configure (Name : in String;
                              Item : in Util.Properties.Value) is
            SQL : constant String := "PRAGMA " & Name & "=" & Escape (Item);
         begin
            if Util.Strings.Index (Name, '.') = 0 then
               Log.Info ("Configure database with {0}", SQL);
               ADO.Statements.Sqlite.Execute (Database.Server, SQL);
            end if;

         exception
            when SQL_Error =>
               null;
         end Configure;

      begin
         Database.Server := Handle;
         Database.Name   := To_Unbounded_String (Config.Get_Database);
         Result := Ref.Create (Database.all'Access);

         --  Configure the connection by setting up the SQLite 'pragma X=Y' SQL commands.
         --  Typical configuration includes:
         --    synchronous=OFF
         --    temp_store=MEMORY
         --    encoding='UTF-8'
         Config.Iterate (Process => Configure'Access);
      end;
   end Create_Connection;

   --  ------------------------------
   --  Create the database and initialize it with the schema SQL file.
   --  The `Admin` parameter describes the database connection with administrator access.
   --  The `Config` parameter describes the target database connection.
   --  ------------------------------
   overriding
   procedure Create_Database (D           : in out Sqlite_Driver;
                              Admin       : in Configs.Configuration'Class;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector) is
      pragma Unreferenced (D, Admin);

      Status        : Integer;
      Database_Path : constant String := Config.Get_Database;
      Command       : constant String :=
        "sqlite3 --batch --init " & Schema_Path & " " & Database_Path;
   begin
      Log.Info ("Creating SQLite database {0}", Database_Path);
      Util.Processes.Tools.Execute (Command, Messages, Status);

      if Status = 0 then
         Log.Info ("Database schema created successfully.");
      elsif Status = 255 then
         Messages.Append ("Command not found: " & Command);
         Log.Error ("Command not found: {0}", Command);
      else
         Messages.Append ("Command " & Command & " failed with exit code "
                            & Util.Strings.Image (Status));
         Log.Error ("Command {0} failed with exit code {1}", Command,
                    Util.Strings.Image (Status));
      end if;
   end Create_Database;

   --  ------------------------------
   --  Initialize the SQLite driver.
   --  ------------------------------
   procedure Initialize is
      use type Util.Strings.Name_Access;
   begin
      Log.Debug ("Initializing sqlite driver");

      if Driver.Name = null then
         Driver.Name := Driver_Name'Access;
         Register (Driver'Access);
      end if;
   end Initialize;

end ADO.Drivers.Connections.Sqlite;

-----------------------------------------------------------------------
--  ADO Sqlite Database -- SQLite Database connections
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 2017, 2018 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 Interfaces.C.Strings;

with Util.Log;
with Util.Log.Loggers;
with Util.Processes.Tools;
with ADO.Sessions;
with ADO.Statements.Sqlite;
with ADO.Schemas.Sqlite;

package body ADO.Drivers.Connections.Sqlite is

   use ADO.Statements.Sqlite;
   use Interfaces.C;

   pragma Linker_Options ("-lsqlite3");

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Databases.Sqlite");

   Driver_Name : aliased constant String := "sqlite";
   Driver      : aliased Sqlite_Driver;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access is
      pragma Unreferenced (Database);
   begin
      return Driver'Access;
   end Get_Driver;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Query => Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a delete statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Rollback;

   --  ------------------------------
   --  Closes the database connection
   --  ------------------------------
   overriding
   procedure Close (Database : in out Database_Connection) is
   begin
      Log.Info ("Close connection {0}", Database.Name);
   end Close;

   --  ------------------------------
   --  Releases the sqlite connection if it is open
   --  ------------------------------
   overriding
   procedure Finalize (Database : in out Database_Connection) is
      Result : int;
   begin
      Log.Debug ("Release database connection");

      if Database.Server /= null then
         Result := Sqlite3_H.sqlite3_close_v2 (Database.Server);
         if Result /= Sqlite3_H.SQLITE_OK then
            declare
               Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Result);
               Msg   : constant String := Strings.Value (Error);
            begin
               Log.Error ("Cannot close database {0}: {1}", To_String (Database.Name), Msg);
            end;
         end if;
         Database.Server := null;
      end if;
   end Finalize;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   overriding
   procedure Load_Schema (Database : in Database_Connection;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      ADO.Schemas.Sqlite.Load_Schema (Database, Schema);
   end Load_Schema;

   protected body Sqlite_Connections is

      procedure Open (Config : in Configuration'Class;
                      Result : in out Ref.Ref'Class) is
         use Strings;

         URI : constant String := Config.Get_URI;
         Pos : Database_List.Cursor := Database_List.First (List);
         C   : Database_Connection_Access;
      begin
         --  Look first in the database list.
         while Database_List.Has_Element (Pos) loop
            C := Database_Connection'Class (Database_List.Element (Pos).Value.all)'Access;
            if C.URI = URI then
               Result := Ref.Ref'Class (Database_List.Element (Pos));
               return;
            end if;
            Database_List.Next (Pos);
         end loop;

         --  Now we can open a new database connection.
         declare
            Name     : constant String := Config.Get_Database;
            Filename : Strings.chars_ptr;
            Status   : int;
            Handle   : aliased access Sqlite3;
            Flags    : constant int
              := Sqlite3_H.SQLITE_OPEN_FULLMUTEX + Sqlite3_H.SQLITE_OPEN_READWRITE;
         begin
            Filename := Strings.New_String (Name);
            Status := Sqlite3_H.sqlite3_open_v2 (Filename, Handle'Address,
                                                 Flags,
                                                 Strings.Null_Ptr);

            Strings.Free (Filename);
            if Status /= Sqlite3_H.SQLITE_OK then
               declare
                  Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Status);
                  Msg   : constant String := Strings.Value (Error);
               begin
                  Log.Error ("Cannot open SQLite database: {0}", Msg);
                  raise ADO.Configs.Connection_Error with "Cannot open database: " & Msg;
               end;
            end if;

            declare
               Database : constant Database_Connection_Access := new Database_Connection;

               procedure Configure (Name : in String;
                                    Item : in Util.Properties.Value);
               function Escape (Value : in Util.Properties.Value) return String;

               function Escape (Value : in Util.Properties.Value) return String is
                  S : constant String := Util.Properties.To_String (Value);
               begin
                  if S'Length > 0 and then S (S'First) >= '0' and then S (S'First) <= '9' then
                     return S;
                  elsif S'Length > 0 and then S (S'First) = ''' then
                     return S;
                  else
                     return "'" & S & "'";
                  end if;
               end Escape;

               procedure Configure (Name : in String;
                                    Item : in Util.Properties.Value) is
                  SQL : constant String := "PRAGMA " & Name & "=" & Escape (Item);
               begin
                  if Util.Strings.Index (Name, '.') = 0 then
                     Log.Info ("Configure database with {0}", SQL);
                     ADO.Statements.Sqlite.Execute (Database.Server, SQL);
                  end if;

               exception
                  when SQL_Error =>
                     null;
               end Configure;

            begin
               Database.Server := Handle;
               Database.Name   := To_Unbounded_String (Config.Get_Database);
               Database.URI    := To_Unbounded_String (URI);
               Result := Ref.Create (Database.all'Access);

               Database_List.Prepend (Container => List, New_Item => Ref.Ref (Result));

               --  Configure the connection by setting up the SQLite 'pragma X=Y' SQL commands.
               --  Typical configuration includes:
               --    synchronous=OFF
               --    temp_store=MEMORY
               --    encoding='UTF-8'
               Config.Iterate (Process => Configure'Access);
            end;
         end;
      end Open;

   end Sqlite_Connections;

   --  ------------------------------
   --  Initialize the database connection manager.
   --  ------------------------------
   procedure Create_Connection (D      : in out Sqlite_Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
   begin
      D.Map.Open (Config, Result);
   end Create_Connection;

   --  ------------------------------
   --  Create the database and initialize it with the schema SQL file.
   --  The `Admin` parameter describes the database connection with administrator access.
   --  The `Config` parameter describes the target database connection.
   --  ------------------------------
   overriding
   procedure Create_Database (D           : in out Sqlite_Driver;
                              Admin       : in Configs.Configuration'Class;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector) is
      pragma Unreferenced (D, Admin);

      Status        : Integer;
      Database_Path : constant String := Config.Get_Database;
      Command       : constant String :=
        "sqlite3 --batch --init " & Schema_Path & " " & Database_Path;
   begin
      Log.Info ("Creating SQLite database {0}", Database_Path);
      Util.Processes.Tools.Execute (Command, Messages, Status);

      if Status = 0 then
         Log.Info ("Database schema created successfully.");
      elsif Status = 255 then
         Messages.Append ("Command not found: " & Command);
         Log.Error ("Command not found: {0}", Command);
      else
         Messages.Append ("Command " & Command & " failed with exit code "
                            & Util.Strings.Image (Status));
         Log.Error ("Command {0} failed with exit code {1}", Command,
                    Util.Strings.Image (Status));
      end if;
   end Create_Database;

   --  ------------------------------
   --  Initialize the SQLite driver.
   --  ------------------------------
   procedure Initialize is
      use type Util.Strings.Name_Access;
   begin
      Log.Debug ("Initializing sqlite driver");

      if Driver.Name = null then
         Driver.Name := Driver_Name'Access;
         Register (Driver'Access);
      end if;
   end Initialize;

   --  ------------------------------
   --  Deletes the SQLite driver.
   --  ------------------------------
   overriding
   procedure Finalize (D : in out Sqlite_Driver) is
      pragma Unreferenced (D);
   begin
      Log.Debug ("Deleting the sqlite driver");
   end Finalize;

end ADO.Drivers.Connections.Sqlite;

Implement Sqlite_Connections protected type Implement Finalize on SQLite driver


-----------------------------------------------------------------------
--  awa_command - Tests for AWA command
--  Copyright (C) 2020 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.Commands;
with Util.Tests;
with AWA.Commands.Drivers;
with AWA.Commands.List;
with AWA.Commands.Start;
with AWA.Commands.Stop;
with AWA.Commands.Info;
with Servlet.Server;
with ADO.Drivers;
with AWA.Testsuite;
with AWA_Test_App;
procedure AWA_Command is

   package Server_Commands is
     new AWA.Commands.Drivers (Driver_Name => "awa",
                               Container_Type => Servlet.Server.Container);

   package List_Command is
      new AWA.Commands.List (Server_Commands);

   package Start_Command is
      new AWA.Commands.Start (Server_Commands);

   package Stop_Command is
      new AWA.Commands.Stop (Server_Commands);

   package Info_Command is
      new AWA.Commands.Info (Server_Commands);

   App       : aliased AWA_Test_App.Application;
   Context   : AWA.Commands.Context_Type;
   Arguments : Util.Commands.Dynamic_Argument_List;
   Suite     : Util.Tests.Access_Test_Suite := AWA.Testsuite.Suite;
   pragma Unreferenced (Suite);
begin
   ADO.Drivers.Initialize;
   Server_Commands.WS.Register_Application ("/test", App'Unchecked_Access);
   Server_Commands.Run (Context, Arguments);

exception
   when E : others =>
      AWA.Commands.Print (Context, E);

end AWA_Command;

-----------------------------------------------------------------------
--  awa_command - Tests for AWA command
--  Copyright (C) 2020, 2022 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.Commands;
with Util.Tests;
with AWA.Commands.Drivers;
with AWA.Commands.List;
with AWA.Commands.Start;
with AWA.Commands.Stop;
with AWA.Commands.Info;
with Servlet.Server;
with ADO.Drivers;
with AWA.Testsuite;
with AWA_Test_App;
procedure AWA_Command is

   package Server_Commands is
     new AWA.Commands.Drivers (Driver_Name => "awa",
                               Container_Type => Servlet.Server.Container);

   package List_Command is
      new AWA.Commands.List (Server_Commands);

   package Start_Command is
      new AWA.Commands.Start (Server_Commands);

   package Stop_Command is
      new AWA.Commands.Stop (Server_Commands);

   package Info_Command is
      new AWA.Commands.Info (Server_Commands);
   pragma Unreferenced (List_Command, Start_Command, Stop_Command, Info_Command);

   App       : aliased AWA_Test_App.Application;
   Context   : AWA.Commands.Context_Type;
   Arguments : Util.Commands.Dynamic_Argument_List;
   Suite     : Util.Tests.Access_Test_Suite := AWA.Testsuite.Suite;
   pragma Unreferenced (Suite);
begin
   ADO.Drivers.Initialize;
   Server_Commands.WS.Register_Application ("/test", App'Unchecked_Access);
   Server_Commands.Run (Context, Arguments);

exception
   when E : others =>
      AWA.Commands.Print (Context, E);

end AWA_Command;

Fix style warnings: add missing overriding and update and then/or else conditions