-----------------------------------------------------------------------
--  awa-commands-setup -- Setup command to start and configure the application
--  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 GNAT.Command_Line;
with AWA.Applications;
with AWA.Setup.Applications;
with Servlet.Core;

package body AWA.Commands.Setup is

   use AWA.Applications;

   package Command_Drivers renames Start_Command.Command_Drivers;

   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Find_Application (Name : in String);
      procedure Enable_Application (URI : in String;
                                    App : in Servlet.Core.Servlet_Registry_Access);

      Count    : Natural := 0;
      Selected : Application_Access;

      procedure Find_Application (Name : in String) is
         procedure Find (URI : in String;
                         App : in Servlet.Core.Servlet_Registry_Access);

         procedure Find (URI : in String;
                         App : in Servlet.Core.Servlet_Registry_Access) is
         begin
            App.Disable;
            if URI (URI'First + 1 .. URI'Last) = Name then
               if App.all in Application'Class then
                  Selected := Application'Class (App.all)'Unchecked_Access;
                  Count := Count + 1;
               end if;
            end if;
         end Find;

      begin
         Command_Drivers.WS.Iterate (Find'Access);
      end Find_Application;

      procedure Enable_Application (URI : in String;
                                    App : in Servlet.Core.Servlet_Registry_Access) is
      begin
         App.Enable;
         App.Start;
      end Enable_Application;

      S : aliased AWA.Setup.Applications.Application;
   begin
      if Args.Get_Count /= 1 then
         Context.Console.Notice (N_ERROR, -("Missing application name"));
         return;
      end if;

      declare
         Name : constant String := Args.Get_Argument (1);
      begin
         Find_Application (Name);
         if Count /= 1 then
            Context.Console.Notice (N_ERROR, -("No application found"));
            return;
         end if;

         Command.Configure_Server (Context);
         Command.Start_Server (Context);
         S.Setup (Name, Command_Drivers.WS);
         Command.Configure_Applications (Context);
         S.Status.Set (AWA.Setup.Applications.READY);
         delay 2.0;
         Command_Drivers.WS.Remove_Application (S'Unchecked_Access);
         Command_Drivers.WS.Iterate (Enable_Application'Access);
         Command.Wait_Server (Context);
      end;
   end Execute;

   --  Setup the command before parsing the arguments and executing it.
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      Start_Command.Command_Type (Command).Setup (Config, Context);
   end Setup;

begin
   Command_Drivers.Driver.Add_Command ("setup",
                                       -("start the web server and setup the application"),
                                       Command'Access);
end AWA.Commands.Setup;

-----------------------------------------------------------------------
--  awa-commands-setup -- Setup command to start and configure the application
--  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 GNAT.Command_Line;
with AWA.Applications;
with AWA.Setup.Applications;
with Servlet.Core;

package body AWA.Commands.Setup is

   use AWA.Applications;

   package Command_Drivers renames Start_Command.Command_Drivers;

   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Find_Application (Name : in String);
      procedure Enable_Application (URI : in String;
                                    App : in Servlet.Core.Servlet_Registry_Access);

      Count    : Natural := 0;
      Selected : Application_Access;

      procedure Find_Application (Name : in String) is
         procedure Find (URI : in String;
                         App : in Servlet.Core.Servlet_Registry_Access);

         procedure Find (URI : in String;
                         App : in Servlet.Core.Servlet_Registry_Access) is
         begin
            App.Disable;
            if URI (URI'First + 1 .. URI'Last) = Name then
               if App.all in Application'Class then
                  Selected := Application'Class (App.all)'Unchecked_Access;
                  Count := Count + 1;
               end if;
            end if;
         end Find;

      begin
         Command_Drivers.WS.Iterate (Find'Access);
      end Find_Application;

      procedure Enable_Application (URI : in String;
                                    App : in Servlet.Core.Servlet_Registry_Access) is
         pragma Unreferenced (URI);
      begin
         App.Enable;
         App.Start;
      end Enable_Application;

      S : aliased AWA.Setup.Applications.Application;
   begin
      if Args.Get_Count /= 1 then
         Context.Console.Notice (N_ERROR, -("Missing application name"));
         return;
      end if;

      declare
         Name : constant String := Args.Get_Argument (1);
      begin
         Find_Application (Name);
         if Count /= 1 then
            Context.Console.Notice (N_ERROR, -("No application found"));
            return;
         end if;

         Command.Configure_Server (Context);
         Command.Start_Server (Context);
         S.Setup (Name, Command_Drivers.WS);
         Command.Configure_Applications (Context);
         S.Status.Set (AWA.Setup.Applications.READY);
         delay 2.0;
         Command_Drivers.WS.Remove_Application (S'Unchecked_Access);
         Command_Drivers.WS.Iterate (Enable_Application'Access);
         Command.Wait_Server (Context);
      end;
   end Execute;

   --  Setup the command before parsing the arguments and executing it.
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      Start_Command.Command_Type (Command).Setup (Config, Context);
   end Setup;

begin
   Command_Drivers.Driver.Add_Command ("setup",
                                       -("start the web server and setup the application"),
                                       Command'Access);
end AWA.Commands.Setup;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  ADO Sessions -- Sessions Management
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 Ada.Finalization;

with ADO.Schemas;
with ADO.Statements;
with ADO.Objects;
with ADO.Objects.Cache;
with ADO.Drivers.Connections;
with ADO.Queries;
with ADO.SQL;
with ADO.Caches;

with Util.Concurrent.Counters;
limited with ADO.Sequences;
limited with ADO.Schemas.Entities;

--  = Session =
--  The `ADO.Sessions` package defines the control and management of database sessions.
--  The database session is represented by the `Session` or `Master_Session` types.
--  It provides operation to create a database statement that can be executed.
--  The `Session` type is used to represent read-only database sessions.  It provides
--  operations to query the database but it does not allow to update or delete content.
--  The `Master_Session` type extends the `Session` type to provide write
--  access and it provides operations to get update or delete statements.  The differentiation
--  between the two sessions is provided for the support of database replications with
--  databases such as MySQL.
--
--  @include ado-sessions-sources.ads
--  @include ado-sessions-factory.ads
--  @include ado-caches.ads
package ADO.Sessions is

   use ADO.Statements;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   --  Raised if the database connection is not open.
   NOT_OPEN : exception;

   NOT_FOUND : exception;

   NO_DATABASE : exception;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  The database connection status
   type Connection_Status is (OPEN, CLOSED);

   type Object_Factory is tagged private;

   --  ---------
   --  Session
   --  ---------
   --  Read-only database connection (or slave connection).
   --
   type Session is tagged private;

   --  Get the session status.
   function Get_Status (Database : in Session) return Connection_Status;

   --  Get the database driver which manages this connection.
   function Get_Driver (Database : in Session) return ADO.Drivers.Connections.Driver_Access;

   --  Close the session.
   procedure Close (Database : in out Session);

   --  Insert a new cache in the manager.  The cache is identified by the given name.
   procedure Add_Cache (Database : in out Session;
                        Name     : in String;
                        Cache    : in ADO.Caches.Cache_Type_Access);

   --  Attach the object to the session.
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class);

   --  Check if the session contains the object identified by the given key.
   function Contains (Database : in Session;
                      Item     : in ADO.Objects.Object_Key) return Boolean;

   --  Remove the object from the session cache.
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key);

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Context'Class)
                              return Query_Statement;

   --  Create a query statement and initialize the SQL statement with the query definition.
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Query_Definition_Access)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in ADO.SQL.Query'Class;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement;

   --  Load the database schema definition for the current database.
   procedure Load_Schema (Database : in Session;
                          Schema   : out ADO.Schemas.Schema_Definition);

   --  Internal method to get the session proxy associated with the given database session.
   --  The session proxy is associated with some ADO objects to be able to retrieve the database
   --  session for the implementation of lazy loading.  The session proxy is kept until the
   --  session exist and at least one ADO object is refering to it.
   function Get_Session_Proxy (Database : in Session) return ADO.Objects.Session_Proxy_Access;

   --  ---------
   --  Master Session
   --  ---------
   --  Read-write session.
   --
   type Master_Session is new Session with private;

   --  Start a transaction.
   procedure Begin_Transaction (Database : in out Master_Session);

   --  Commit the current transaction.
   procedure Commit (Database : in out Master_Session);

   --  Rollback the current transaction.
   procedure Rollback (Database : in out Master_Session);

   --  Allocate an identifier for the table.
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class);

   --  Flush the objects that were modified.
   procedure Flush (Database : in out Master_Session);

   --  Create a delete statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement;

   --  Create an update statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement;

   --  Create an insert statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement;

   type Session_Record is limited private;
   type Session_Record_Access is access all Session_Record;

private

   type Entity_Cache_Access is access ADO.Schemas.Entities.Entity_Cache;

   type Object_Factory is tagged record
      A : Integer;
   end record;
   type Object_Factory_Access is access all Object_Factory'Class;

   --  The Session_Record maintains the connection information to the database for
   --  the duration of the session.  It also maintains a cache of application objects
   --  which is used when session objects are fetched (either through Load or a Find).
   --  The connection is released and the session record is deleted when the session
   --  is closed with Close.
   --
   --  For the lazy loading support, each object is associated with a shared Session_Proxy
   --  object that allows to give access to the session record associated with the object.
   --  When a session is closed, the Session_Proxy is not deleted but it is simply
   --  unlinked from the session record.
   type Session_Record is limited record
      Counter  : Util.Concurrent.Counters.Counter := Util.Concurrent.Counters.ONE;
      Database : ADO.Drivers.Connections.Ref.Ref;
      Proxy    : ADO.Objects.Session_Proxy_Access;
      Cache    : ADO.Objects.Cache.Object_Cache;
      Entities : Entity_Cache_Access;
      Values   : ADO.Caches.Cache_Manager_Access;
      Queries  : ADO.Queries.Query_Manager_Access;
   end record;

   type Session is new Ada.Finalization.Controlled with record
      Impl : Session_Record_Access := null;
   end record;

   overriding
   procedure Adjust (Object : in out Session);

   overriding
   procedure Finalize (Object : in out Session);

   type Factory_Access is access all ADO.Sequences.Factory;

   type Master_Session is new Session with record
      Sequences : Factory_Access;
   end record;

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "");
   pragma Inline (Check_Session);

end ADO.Sessions;

-----------------------------------------------------------------------
--  ADO Sessions -- Sessions Management
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 Ada.Finalization;

with ADO.Schemas;
with ADO.Statements;
with ADO.Objects;
with ADO.Objects.Cache;
with ADO.Drivers.Connections;
with ADO.Queries;
with ADO.SQL;
with ADO.Caches;

with Util.Concurrent.Counters;
limited with ADO.Sequences;
limited with ADO.Schemas.Entities;

--  = Session =
--  The `ADO.Sessions` package defines the control and management of database sessions.
--  The database session is represented by the `Session` or `Master_Session` types.
--  It provides operation to create a database statement that can be executed.
--  The `Session` type is used to represent read-only database sessions.  It provides
--  operations to query the database but it does not allow to update or delete content.
--  The `Master_Session` type extends the `Session` type to provide write
--  access and it provides operations to get update or delete statements.  The differentiation
--  between the two sessions is provided for the support of database replications with
--  databases such as MySQL.
--
--  @include ado-sessions-sources.ads
--  @include ado-sessions-factory.ads
--  @include ado-caches.ads
package ADO.Sessions is

   use ADO.Statements;

   --  Raised if the database connection is not open.
   Session_Error : exception;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception renames ADO.Drivers.Connection_Error;

   --  The database connection status
   type Connection_Status is (OPEN, CLOSED);

   type Object_Factory is tagged private;

   --  ---------
   --  Session
   --  ---------
   --  Read-only database connection (or slave connection).
   --
   type Session is tagged private;

   --  Get the session status.
   function Get_Status (Database : in Session) return Connection_Status;

   --  Get the database driver which manages this connection.
   function Get_Driver (Database : in Session) return ADO.Drivers.Connections.Driver_Access;

   --  Close the session.
   procedure Close (Database : in out Session);

   --  Insert a new cache in the manager.  The cache is identified by the given name.
   procedure Add_Cache (Database : in out Session;
                        Name     : in String;
                        Cache    : in ADO.Caches.Cache_Type_Access);

   --  Attach the object to the session.
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class);

   --  Check if the session contains the object identified by the given key.
   function Contains (Database : in Session;
                      Item     : in ADO.Objects.Object_Key) return Boolean;

   --  Remove the object from the session cache.
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key);

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Context'Class)
                              return Query_Statement;

   --  Create a query statement and initialize the SQL statement with the query definition.
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Query_Definition_Access)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Session;
                              Query    : in ADO.SQL.Query'Class;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement;

   --  Load the database schema definition for the current database.
   procedure Load_Schema (Database : in Session;
                          Schema   : out ADO.Schemas.Schema_Definition);

   --  Internal method to get the session proxy associated with the given database session.
   --  The session proxy is associated with some ADO objects to be able to retrieve the database
   --  session for the implementation of lazy loading.  The session proxy is kept until the
   --  session exist and at least one ADO object is refering to it.
   function Get_Session_Proxy (Database : in Session) return ADO.Objects.Session_Proxy_Access;

   --  ---------
   --  Master Session
   --  ---------
   --  Read-write session.
   --
   type Master_Session is new Session with private;

   --  Start a transaction.
   procedure Begin_Transaction (Database : in out Master_Session);

   --  Commit the current transaction.
   procedure Commit (Database : in out Master_Session);

   --  Rollback the current transaction.
   procedure Rollback (Database : in out Master_Session);

   --  Allocate an identifier for the table.
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class);

   --  Flush the objects that were modified.
   procedure Flush (Database : in out Master_Session);

   --  Create a delete statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement;

   --  Create an update statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement;

   --  Create an insert statement
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement;

   type Session_Record is limited private;
   type Session_Record_Access is access all Session_Record;

private

   type Entity_Cache_Access is access ADO.Schemas.Entities.Entity_Cache;

   type Object_Factory is tagged record
      A : Integer;
   end record;
   type Object_Factory_Access is access all Object_Factory'Class;

   --  The Session_Record maintains the connection information to the database for
   --  the duration of the session.  It also maintains a cache of application objects
   --  which is used when session objects are fetched (either through Load or a Find).
   --  The connection is released and the session record is deleted when the session
   --  is closed with Close.
   --
   --  For the lazy loading support, each object is associated with a shared Session_Proxy
   --  object that allows to give access to the session record associated with the object.
   --  When a session is closed, the Session_Proxy is not deleted but it is simply
   --  unlinked from the session record.
   type Session_Record is limited record
      Counter  : Util.Concurrent.Counters.Counter := Util.Concurrent.Counters.ONE;
      Database : ADO.Drivers.Connections.Ref.Ref;
      Proxy    : ADO.Objects.Session_Proxy_Access;
      Cache    : ADO.Objects.Cache.Object_Cache;
      Entities : Entity_Cache_Access;
      Values   : ADO.Caches.Cache_Manager_Access;
      Queries  : ADO.Queries.Query_Manager_Access;
   end record;

   type Session is new Ada.Finalization.Controlled with record
      Impl : Session_Record_Access := null;
   end record;

   overriding
   procedure Adjust (Object : in out Session);

   overriding
   procedure Finalize (Object : in out Session);

   type Factory_Access is access all ADO.Sequences.Factory;

   type Master_Session is new Session with record
      Sequences : Factory_Access;
   end record;

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "");
   pragma Inline (Check_Session);

end ADO.Sessions;

Declare Session_Error and Connection_Error exception and remove unused exceptions


------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, AdaCore                           --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of STMicroelectronics nor the names of its       --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with System;        use System;
with STM32_SVD;     use STM32_SVD;

with STM32.Device;  use STM32.Device;

package body STM32.PWM is

   subtype Hertz is Word;

   procedure Compute_Prescalar_and_Period
     (This                : access Timer;
      Requested_Frequency : Hertz;
      Prescalar           : out Word;
      Period              : out Word)
     with Pre => Requested_Frequency > 0;
   --  Computes the minimum prescaler and thus the maximum resolution for the
   --  given timer, based on the system clocks and the requested frequency

   function Has_HCLOCK_Frequency  (This : Timer) return Boolean;
   -- timers 1, 8, 9, 10, 11

   function Has_PCLOCK2_Frequency (This : Timer) return Boolean;
   -- timers 3, 4, 6, 7, 12, 13, 14

   procedure Configure_PWM_GPIO
     (Output : GPIO_Point;
      PWM_AF : GPIO_Alternate_Function);

   --------------------
   -- Set_Duty_Cycle --
   --------------------

   procedure Set_Duty_Cycle
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Value   : Percentage)
   is
      Pulse : Short;
   begin
      This.Outputs (Channel).Duty_Cycle := Value;
      if Value = 0 then
         Set_Compare_Value (This.Output_Timer.all, Channel, Short'(0));
      else
         Pulse := Short ((This.Timer_Period + 1) * Word (Value) / 100) - 1;
         --  for a Value of 0, the computation of Pulse wraps around to
         --  65535, so we only compute it when not zero
         Set_Compare_Value (This.Output_Timer.all, Channel, Pulse);
      end if;
   end Set_Duty_Cycle;

   -------------------
   -- Set_Duty_Time --
   -------------------

   procedure Set_Duty_Time
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Value   : Microseconds)
   is
      Pulse         : Short;
      Period        : constant Word := This.Timer_Period + 1;
      uS_Per_Period : constant Word := 1_000_000 / This.Frequency;
   begin
      if Value > uS_per_Period then
         raise Invalid_Request with "duty time too high";
      end if;
      Pulse := Short ((Period * Value) / uS_per_Period) - 1;
      Set_Compare_Value (This.Output_Timer.all, Channel, Pulse);
   end Set_Duty_Time;

   ------------------------
   -- Current_Duty_Cycle --
   ------------------------

   function Current_Duty_Cycle
     (This    : PWM_Modulator;
      Channel : Timer_Channel)
      return Percentage
   is
   begin
      return This.Outputs (Channel).Duty_Cycle;
   end Current_Duty_Cycle;

   ------------------------------
   -- Initialise_PWM_Modulator --
   ------------------------------

   procedure Initialise_PWM_Modulator
     (This                   : in out PWM_Modulator;
      Requested_Frequency    : Float;
      PWM_Timer              : not null access Timer;
      PWM_AF                 : GPIO_Alternate_Function)
   is
      Prescalar : Word;
   begin
      This.Output_Timer := PWM_Timer;
      This.AF := PWM_AF;

      Enable_Clock (PWM_Timer.all);

      Compute_Prescalar_and_Period
        (PWM_Timer,
         Requested_Frequency => Word (Requested_Frequency),
         Prescalar           => Prescalar,
         Period              => This.Timer_Period);

      This.Timer_Period := This.Timer_Period - 1;
      This.Frequency := Word (Requested_Frequency);

      Configure
        (PWM_Timer.all,
         Prescaler     => Short (Prescalar),
         Period        => This.Timer_Period,
         Clock_Divisor => Div1,
         Counter_Mode  => Up);

      Set_Autoreload_Preload (PWM_Timer.all, True);

      Enable (PWM_Timer.all);

      for Channel in Timer_Channel loop
         This.Outputs (Channel).Attached := False;
      end loop;
   end Initialise_PWM_Modulator;

   ------------------------
   -- Attach_PWM_Channel --
   ------------------------

   procedure Attach_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Point   : GPIO_Point)
   is
   begin
      This.Outputs (Channel).Attached := True;

      Enable_CLock (Point);

      Configure_PWM_GPIO (Point, This.AF);

      Configure_Channel_Output
        (This.Output_Timer.all,
         Channel  => Channel,
         Mode     => PWM1,
         State    => Disable,
         Pulse    => 0,
         Polarity => High);

      Set_Compare_Value (This.Output_Timer.all, Channel, Short (0));

   end Attach_PWM_Channel;

   procedure Enable_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel)
   is
   begin
      Enable_Channel (This.Output_Timer.all, Channel);
   end Enable_PWM_Channel;

   procedure Disable_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel)
   is
   begin
      Disable_Channel (This.Output_Timer.all, Channel);
   end Disable_PWM_Channel;

   --------------
   -- Attached --
   --------------

   function Attached (This : PWM_Modulator;  Channel : Timer_Channel) return Boolean is
     (This.Outputs (Channel).Attached);

   ------------------------
   -- Configure_PWM_GPIO --
   ------------------------

   procedure Configure_PWM_GPIO
     (Output : GPIO_Point;
      PWM_AF : GPIO_Alternate_Function)
   is
      Configuration : GPIO_Port_Configuration;
   begin
      Configuration.Mode        := Mode_AF;
      Configuration.Output_Type := Push_Pull;
      Configuration.Speed       := Speed_100MHz;
      Configuration.Resistors   := Pull_Down;

      Configure_IO (Point  => Output,
                    Config => Configuration);

      Configure_Alternate_Function (Output, AF => PWM_AF);

      Lock (Output);
   end Configure_PWM_GPIO;

   ----------------------------------
   -- Compute_Prescalar_and_Period --
   ----------------------------------

   procedure Compute_Prescalar_And_Period
     (This                : access Timer;
      Requested_Frequency : Hertz;
      Prescalar           : out Word;
      Period              : out Word)
   is
      Max_Prescalar      : constant := 16#FFFF#;
      Max_Period         : Word;
      Hardware_Frequency : Word;
      Clocks             : constant RCC_System_Clocks := System_Clock_Frequencies;
   begin
      if Has_32bit_Counter (This.all) then  --  timers 2 and 5
         Hardware_Frequency := Clocks.PCLK2;
         Max_Period := 16#FFFF_FFFF#;
      elsif Has_HCLOCK_Frequency (This.all) then
         Hardware_Frequency := Clocks.HCLK;
         Max_Period := 16#FFFF#;
      elsif Has_PCLOCK2_Frequency (This.all) then
         Hardware_Frequency := Clocks.PCLK2;
         Max_Period := 16#FFFF#;
      else
         raise Unknown_Timer;
      end if;

      if Requested_Frequency > Hardware_Frequency then
         raise Invalid_Request with "Freq too high";
      end if;

      Prescalar := 0;
      loop
         Period := Hardware_Frequency / (Prescalar + 1);
         Period := Period / Requested_Frequency;
         Prescalar := Prescalar + 1;

         exit when not
           ((Period > Max_Period) and
            (Prescalar <= Max_Prescalar + 1));
      end loop;

      if Prescalar > Max_Prescalar + 1 then
         raise Invalid_Request with "Freq too low";
      end if;
   end Compute_Prescalar_and_Period;

   --------------------------
   -- Has_HCLOCK_Frequency --
   --------------------------

   function Has_HCLOCK_Frequency (This : Timer) return Boolean is
     (This'Address = STM32_SVD.TIM1_Base or
      This'Address = STM32_SVD.TIM8_Base or
      This'Address = STM32_SVD.TIM9_Base or
      This'Address = STM32_SVD.TIM10_Base or
      This'Address = STM32_SVD.TIM11_Base);

   ---------------------------
   -- Has_PCLOCK2_Frequency --
   ---------------------------

   function Has_PCLOCK2_Frequency (This : Timer) return Boolean is
     (This'Address = STM32_SVD.TIM3_Base or
      This'Address = STM32_SVD.TIM4_Base or
      This'Address = STM32_SVD.TIM6_Base or
      This'Address = STM32_SVD.TIM7_Base or
      This'Address = STM32_SVD.TIM12_Base or
      This'Address = STM32_SVD.TIM13_Base or
      This'Address = STM32_SVD.TIM14_Base);

end STM32.PWM;

------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, AdaCore                           --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of STMicroelectronics nor the names of its       --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with System;        use System;
with STM32_SVD;     use STM32_SVD;

with STM32.Device;  use STM32.Device;

package body STM32.PWM is

   subtype Hertz is Word;

   procedure Compute_Prescalar_and_Period
     (This                : access Timer;
      Requested_Frequency : Hertz;
      Prescalar           : out Word;
      Period              : out Word)
     with Pre => Requested_Frequency > 0;
   --  Computes the minimum prescaler and thus the maximum resolution for the
   --  given timer, based on the system clocks and the requested frequency

   function Has_APB2_Frequency  (This : Timer) return Boolean;
   -- timers 1, 8, 9, 10, 11

   function Has_APB1_Frequency (This : Timer) return Boolean;
   -- timers 3, 4, 6, 7, 12, 13, 14

   procedure Configure_PWM_GPIO
     (Output : GPIO_Point;
      PWM_AF : GPIO_Alternate_Function);

   --------------------
   -- Set_Duty_Cycle --
   --------------------

   procedure Set_Duty_Cycle
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Value   : Percentage)
   is
      Pulse : Short;
   begin
      This.Outputs (Channel).Duty_Cycle := Value;
      if Value = 0 then
         Set_Compare_Value (This.Output_Timer.all, Channel, Short'(0));
      else
         Pulse := Short ((This.Timer_Period + 1) * Word (Value) / 100) - 1;
         --  for a Value of 0, the computation of Pulse wraps around to
         --  65535, so we only compute it when not zero
         Set_Compare_Value (This.Output_Timer.all, Channel, Pulse);
      end if;
   end Set_Duty_Cycle;

   -------------------
   -- Set_Duty_Time --
   -------------------

   procedure Set_Duty_Time
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Value   : Microseconds)
   is
      Pulse         : Short;
      Period        : constant Word := This.Timer_Period + 1;
      uS_Per_Period : constant Word := 1_000_000 / This.Frequency;
   begin
      if Value > uS_per_Period then
         raise Invalid_Request with "duty time too high";
      end if;
      Pulse := Short ((Period * Value) / uS_per_Period) - 1;
      Set_Compare_Value (This.Output_Timer.all, Channel, Pulse);
   end Set_Duty_Time;

   ------------------------
   -- Current_Duty_Cycle --
   ------------------------

   function Current_Duty_Cycle
     (This    : PWM_Modulator;
      Channel : Timer_Channel)
      return Percentage
   is
   begin
      return This.Outputs (Channel).Duty_Cycle;
   end Current_Duty_Cycle;

   ------------------------------
   -- Initialise_PWM_Modulator --
   ------------------------------

   procedure Initialise_PWM_Modulator
     (This                   : in out PWM_Modulator;
      Requested_Frequency    : Float;
      PWM_Timer              : not null access Timer;
      PWM_AF                 : GPIO_Alternate_Function)
   is
      Prescalar : Word;
   begin
      This.Output_Timer := PWM_Timer;
      This.AF := PWM_AF;

      Enable_Clock (PWM_Timer.all);

      Compute_Prescalar_and_Period
        (PWM_Timer,
         Requested_Frequency => Word (Requested_Frequency),
         Prescalar           => Prescalar,
         Period              => This.Timer_Period);

      This.Timer_Period := This.Timer_Period - 1;
      This.Frequency := Word (Requested_Frequency);

      Configure
        (PWM_Timer.all,
         Prescaler     => Short (Prescalar),
         Period        => This.Timer_Period,
         Clock_Divisor => Div1,
         Counter_Mode  => Up);

      Set_Autoreload_Preload (PWM_Timer.all, True);

      Enable (PWM_Timer.all);

      for Channel in Timer_Channel loop
         This.Outputs (Channel).Attached := False;
      end loop;
   end Initialise_PWM_Modulator;

   ------------------------
   -- Attach_PWM_Channel --
   ------------------------

   procedure Attach_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Point   : GPIO_Point)
   is
   begin
      This.Outputs (Channel).Attached := True;

      Enable_CLock (Point);

      Configure_PWM_GPIO (Point, This.AF);

      Configure_Channel_Output
        (This.Output_Timer.all,
         Channel  => Channel,
         Mode     => PWM1,
         State    => Disable,
         Pulse    => 0,
         Polarity => High);

      Set_Compare_Value (This.Output_Timer.all, Channel, Short (0));

   end Attach_PWM_Channel;

   procedure Enable_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel)
   is
   begin
      Enable_Channel (This.Output_Timer.all, Channel);
   end Enable_PWM_Channel;

   procedure Disable_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel)
   is
   begin
      Disable_Channel (This.Output_Timer.all, Channel);
   end Disable_PWM_Channel;

   --------------
   -- Attached --
   --------------

   function Attached (This : PWM_Modulator;  Channel : Timer_Channel) return Boolean is
     (This.Outputs (Channel).Attached);

   ------------------------
   -- Configure_PWM_GPIO --
   ------------------------

   procedure Configure_PWM_GPIO
     (Output : GPIO_Point;
      PWM_AF : GPIO_Alternate_Function)
   is
      Configuration : GPIO_Port_Configuration;
   begin
      Configuration.Mode        := Mode_AF;
      Configuration.Output_Type := Push_Pull;
      Configuration.Speed       := Speed_100MHz;
      Configuration.Resistors   := Floating;

      Configure_IO (Point  => Output,
                    Config => Configuration);

      Configure_Alternate_Function (Output, AF => PWM_AF);

      Lock (Output);
   end Configure_PWM_GPIO;

   ----------------------------------
   -- Compute_Prescalar_and_Period --
   ----------------------------------

   procedure Compute_Prescalar_And_Period
     (This                : access Timer;
      Requested_Frequency : Hertz;
      Prescalar           : out Word;
      Period              : out Word)
   is
      Max_Prescalar      : constant := 16#FFFF#;
      Max_Period         : Word;
      Hardware_Frequency : Word;
      Clocks             : constant RCC_System_Clocks := System_Clock_Frequencies;
   begin
      if Has_APB1_Frequency (This.all) then
         Hardware_Frequency := Clocks.TIMCLK1;
      elsif Has_APB2_Frequency (This.all) then
         Hardware_Frequency := Clocks.TIMCLK2;
      else
         raise Unknown_Timer;
      end if;

      if Has_32bit_Counter (This.all) then
         Max_Period := 16#FFFF_FFFF#;
      else
         Max_Period := 16#FFFF#;
      end if;

      if Requested_Frequency > Hardware_Frequency then
         raise Invalid_Request with "Freq too high";
      end if;

      Prescalar := 0;
      loop
         Period := Hardware_Frequency / (Prescalar + 1);
         Period := Period / Requested_Frequency;

         exit when not
           ((Period > Max_Period) and
            (Prescalar <= Max_Prescalar));

         Prescalar := Prescalar + 1;
      end loop;

      if Prescalar > Max_Prescalar then
         raise Invalid_Request with "Freq too low";
      end if;
   end Compute_Prescalar_and_Period;

   ------------------------
   -- Has_APB2_Frequency --
   ------------------------

   function Has_APB2_Frequency (This : Timer) return Boolean is
     (This'Address = STM32_SVD.TIM1_Base or
      This'Address = STM32_SVD.TIM8_Base or
      This'Address = STM32_SVD.TIM9_Base or
      This'Address = STM32_SVD.TIM10_Base or
      This'Address = STM32_SVD.TIM11_Base);

   ------------------------
   -- Has_APB1_Frequency --
   ------------------------

   function Has_APB1_Frequency (This : Timer) return Boolean is
     (This'Address = STM32_SVD.TIM3_Base or
      This'Address = STM32_SVD.TIM4_Base or
      This'Address = STM32_SVD.TIM6_Base or
      This'Address = STM32_SVD.TIM7_Base or
      This'Address = STM32_SVD.TIM12_Base or
      This'Address = STM32_SVD.TIM13_Base or
      This'Address = STM32_SVD.TIM14_Base);

end STM32.PWM;

Fix Compute_Prescalar_And_Period

STM32.PWM: Fix Compute_Prescalar_And_Period

- Timers were assigned to the wrong APB
- APB clock value was used instead of timer clock
- Prescalar was off by one


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

with Ada.Strings.Unbounded;
with Ada.Finalization;

with ADO.Statements;
with ADO.Schemas;
with Util.Properties;

--  The <b>ADO.Drivers</b> package represents the database driver that will create
--  database connections and provide the database specific implementation.
package ADO.Drivers is

   use ADO.Statements;

   use Ada.Strings.Unbounded;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   --  ------------------------------
   --  Database connection implementation
   --  ------------------------------
   --
   type Database_Connection is abstract tagged limited record
      Count : Natural := 0;
   end record;
   type Database_Connection_Access is access all Database_Connection'Class;

   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is abstract;

   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is abstract;

   --  Create a delete statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is abstract;

   --  Create an insert statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is abstract;

   --  Create an update statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is abstract;

   --  Start a transaction.
   procedure Begin_Transaction (Database : in out Database_Connection) is abstract;

   --  Commit the current transaction.
   procedure Commit (Database : in out Database_Connection) is abstract;

   --  Rollback the current transaction.
   procedure Rollback (Database : in out Database_Connection) is abstract;

   procedure Execute (Database : in out Database_Connection;
                      SQL : in Query_String) is abstract;

   procedure Execute (Database : in out Database_Connection;
                      SQL      : in Query_String;
                      Id       : out Identifier) is abstract;

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

   --  Closes the database connection
   procedure Close (Database : in out Database_Connection) is abstract;

   --  Releases the connection and all resources used to maintain it.
   procedure Release (Database : access Database_Connection) is abstract;

   --  ------------------------------
   --  The database configuration properties
   --  ------------------------------
   type Configuration is new Ada.Finalization.Controlled with private;
   type Configuration_Access is access all Configuration'Class;

   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String);

   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String);

   --  Get a property from the data source configuration.
   --  If the property does not exist, an empty string is returned.
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String;

   --  Create a new connection using the configuration parameters.
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : out Database_Connection_Access);

   --  ------------------------------
   --  Database Driver
   --  ------------------------------
   type Driver is abstract tagged limited private;
   type Driver_Access is access all Driver'Class;

   --  Create a new connection using the configuration parameters.
   procedure Create_Connection (D      : in out Driver;
                                Config : in Configuration'Class;
                                Result : out Database_Connection_Access) is abstract;

   --  Register a database driver.
   procedure Register (Driver : in Driver_Access);

   --  Get a database driver given its name.
   function Get_Driver (Name : in String) return Driver_Access;

private

   type Driver is abstract new Ada.Finalization.Limited_Controlled with record
      Name : Unbounded_String;
   end record;

   type Configuration is new Ada.Finalization.Controlled with record
      URI        : Unbounded_String := Null_Unbounded_String;
      Server     : Unbounded_String := Null_Unbounded_String;
      Port       : Integer := 0;
      Database   : Unbounded_String := Null_Unbounded_String;
      Properties : Util.Properties.Manager;
      Driver     : Driver_Access;
   end record;

end ADO.Drivers;

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

with Ada.Strings.Unbounded;
with Ada.Finalization;

with ADO.Statements;
with ADO.Schemas;
with Util.Properties;

--  The <b>ADO.Drivers</b> package represents the database driver that will create
--  database connections and provide the database specific implementation.
package ADO.Drivers is

   use ADO.Statements;

   use Ada.Strings.Unbounded;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   --  ------------------------------
   --  Database connection implementation
   --  ------------------------------
   --
   type Database_Connection is abstract new Ada.Finalization.Limited_Controlled with record
      Count : Natural := 0;
   end record;
   type Database_Connection_Access is access all Database_Connection'Class;

   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is abstract;

   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is abstract;

   --  Create a delete statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is abstract;

   --  Create an insert statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is abstract;

   --  Create an update statement.
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is abstract;

   --  Start a transaction.
   procedure Begin_Transaction (Database : in out Database_Connection) is abstract;

   --  Commit the current transaction.
   procedure Commit (Database : in out Database_Connection) is abstract;

   --  Rollback the current transaction.
   procedure Rollback (Database : in out Database_Connection) is abstract;

   procedure Execute (Database : in out Database_Connection;
                      SQL : in Query_String) is abstract;

   procedure Execute (Database : in out Database_Connection;
                      SQL      : in Query_String;
                      Id       : out Identifier) is abstract;

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

   --  Closes the database connection
   procedure Close (Database : in out Database_Connection) is abstract;

   --  ------------------------------
   --  The database configuration properties
   --  ------------------------------
   type Configuration is new Ada.Finalization.Controlled with private;
   type Configuration_Access is access all Configuration'Class;

   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String);

   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String);

   --  Get a property from the data source configuration.
   --  If the property does not exist, an empty string is returned.
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String;

   --  Create a new connection using the configuration parameters.
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : out Database_Connection_Access);

   --  ------------------------------
   --  Database Driver
   --  ------------------------------
   type Driver is abstract tagged limited private;
   type Driver_Access is access all Driver'Class;

   --  Create a new connection using the configuration parameters.
   procedure Create_Connection (D      : in out Driver;
                                Config : in Configuration'Class;
                                Result : out Database_Connection_Access) is abstract;

   --  Register a database driver.
   procedure Register (Driver : in Driver_Access);

   --  Get a database driver given its name.
   function Get_Driver (Name : in String) return Driver_Access;

private

   type Driver is abstract new Ada.Finalization.Limited_Controlled with record
      Name : Unbounded_String;
   end record;

   type Configuration is new Ada.Finalization.Controlled with record
      URI        : Unbounded_String := Null_Unbounded_String;
      Server     : Unbounded_String := Null_Unbounded_String;
      Port       : Integer := 0;
      Database   : Unbounded_String := Null_Unbounded_String;
      Properties : Util.Properties.Manager;
      Driver     : Driver_Access;
   end record;

end ADO.Drivers;

Replace the Release by the Finalize method


-----------------------------------------------------------------------
--  Util.Streams -- Stream utilities
--  Copyright (C) 2010, 2016 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;
package Util.Streams is

   pragma Preelaborate;

   --  -----------------------
   --  Output stream
   --  -----------------------
   --  The Output_Stream is an interface that accepts output bytes
   --  and sends them to a sink.
   type Output_Stream is limited interface;
   type Output_Stream_Access is access all Output_Stream'Class;

   --  Write the buffer array to the output stream.
   procedure Write (Stream : in out Output_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is abstract;

   --  Flush the buffer (if any) to the sink.
   procedure Flush (Stream : in out Output_Stream) is null;

   --  Close the sink.
   procedure Close (Stream : in out Output_Stream) is null;

   --  -----------------------
   --  Input stream
   --  -----------------------
   --  The Input_Stream is the interface that reads input bytes
   --  from a source and returns them.
   type Input_Stream is limited interface;
   type Input_Stream_Access is access all Input_Stream'Class;

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Input_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Copy the input stream to the output stream until the end of the input stream
   --  is reached.
   procedure Copy (From : in out Input_Stream'Class;
                   Into : in out Output_Stream'Class);

   --  Copy the stream array to the string.
   --  The string must be large enough to hold the stream array
   --  or a Constraint_Error exception is raised.
   procedure Copy (From : in Ada.Streams.Stream_Element_Array;
                   Into : in out String);

   --  Copy the string to the stream array.
   --  The stream array must be large enough to hold the string
   --  or a Constraint_Error exception is raised.
   procedure Copy (From : in String;
                   Into : in out Ada.Streams.Stream_Element_Array);

   --  Notes:
   --  ------
   --  The Ada.Streams.Root_Stream_Type implements the Output_Stream
   --  and Input_Stream.  It is however not easy to use for composing various
   --  stream behaviors.
end Util.Streams;

-----------------------------------------------------------------------
--  util-streams -- Stream utilities
--  Copyright (C) 2010, 2016, 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 Ada.Streams;

--  == Streams ==
--  The <tt>Util.Streams</tt> package provides several types and operations to allow the
--  composition of input and output streams.
--
--  @include util-streams-buffered.ads
--  @include util-streams-files.ads
--  @include util-streams-pipes.ads
--  @include util-streams-sockets.ads
--  @include util-streams-raw.ads
--  @include util-streams-texts.ads
--  @include util-streams-buffered-encoders.ads
package Util.Streams is

   pragma Preelaborate;

   --  -----------------------
   --  Output stream
   --  -----------------------
   --  The Output_Stream is an interface that accepts output bytes
   --  and sends them to a sink.
   type Output_Stream is limited interface;
   type Output_Stream_Access is access all Output_Stream'Class;

   --  Write the buffer array to the output stream.
   procedure Write (Stream : in out Output_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is abstract;

   --  Flush the buffer (if any) to the sink.
   procedure Flush (Stream : in out Output_Stream) is null;

   --  Close the sink.
   procedure Close (Stream : in out Output_Stream) is null;

   --  -----------------------
   --  Input stream
   --  -----------------------
   --  The Input_Stream is the interface that reads input bytes
   --  from a source and returns them.
   type Input_Stream is limited interface;
   type Input_Stream_Access is access all Input_Stream'Class;

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Input_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Copy the input stream to the output stream until the end of the input stream
   --  is reached.
   procedure Copy (From : in out Input_Stream'Class;
                   Into : in out Output_Stream'Class);

   --  Copy the stream array to the string.
   --  The string must be large enough to hold the stream array
   --  or a Constraint_Error exception is raised.
   procedure Copy (From : in Ada.Streams.Stream_Element_Array;
                   Into : in out String);

   --  Copy the string to the stream array.
   --  The stream array must be large enough to hold the string
   --  or a Constraint_Error exception is raised.
   procedure Copy (From : in String;
                   Into : in out Ada.Streams.Stream_Element_Array);

   --  Notes:
   --  ------
   --  The Ada.Streams.Root_Stream_Type implements the Output_Stream
   --  and Input_Stream.  It is however not easy to use for composing various
   --  stream behaviors.
end Util.Streams;

Document the streams framework

Document the streams framework


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

with Util.Strings;
with Util.Log.Loggers;
package body AWA.Images.Modules is

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

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

      --  Setup the resource bundles.
      App.Register ("imageMsg", "images");

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

      Plugin.Add_Listener (AWA.Storages.Modules.NAME, Plugin'Unchecked_Access);
   end Initialize;

   --  ------------------------------
   --  Configures the module after its initialization and after having read its XML configuration.
   --  ------------------------------
   overriding
   procedure Configure (Plugin : in out Image_Module;
                        Props  : in ASF.Applications.Config) is
      pragma Unreferenced (Props);
   begin
      --  Create the image manager when everything is initialized.
      Plugin.Manager := Plugin.Create_Image_Manager;
   end Configure;

   --  ------------------------------
   --  Get the image manager.
   --  ------------------------------
   function Get_Image_Manager (Plugin : in Image_Module)
                                 return Services.Image_Service_Access is
   begin
      return Plugin.Manager;
   end Get_Image_Manager;

   --  ------------------------------
   --  Create an image manager.  This operation can be overridden to provide another
   --  image service implementation.
   --  ------------------------------
   function Create_Image_Manager (Plugin : in Image_Module)
                                    return Services.Image_Service_Access is
      Result : constant Services.Image_Service_Access := new Services.Image_Service;
   begin
      Result.Initialize (Plugin);
      return Result;
   end Create_Image_Manager;

   --  ------------------------------
   --  Returns true if the storage file has an image mime type.
   --  ------------------------------
   function Is_Image (File : in AWA.Storages.Models.Storage_Ref'Class) return Boolean is
      Mime : constant String := File.Get_Mime_Type;
      Pos  : constant Natural := Util.Strings.Index (Mime, '/');
   begin
      if Pos = 0 then
         return False;
      else
         return Mime (Mime'First .. Pos - 1) = "image";
      end if;
   end Is_Image;

   --  ------------------------------
   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the item.
   --  ------------------------------
   overriding
   procedure On_Create (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class) is
   begin
      if Is_Image (Item) then
         Instance.Manager.Create_Image (Item);
      end if;
   end On_Create;

   --  ------------------------------
   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the item.
   --  ------------------------------
   overriding
   procedure On_Update (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class) is
   begin
      if Is_Image (Item) then
         Instance.Manager.Create_Image (Item);
      else
         Instance.Manager.Delete_Image (Item);
      end if;
   end On_Update;

   --  ------------------------------
   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the item.
   --  ------------------------------
   overriding
   procedure On_Delete (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class) is
   begin
      Instance.Manager.Delete_Image (Item);
   end On_Delete;

   --  ------------------------------
   --  Get the image module instance associated with the current application.
   --  ------------------------------
   function Get_Image_Module return Image_Module_Access is
      function Get is new AWA.Modules.Get (Image_Module, Image_Module_Access, NAME);
   begin
      return Get;
   end Get_Image_Module;

   --  ------------------------------
   --  Get the image manager instance associated with the current application.
   --  ------------------------------
   function Get_Image_Manager return Services.Image_Service_Access is
      Module : constant Image_Module_Access := Get_Image_Module;
   begin
      if Module = null then
         Log.Error ("There is no active Storage_Module");
         return null;
      else
         return Module.Get_Image_Manager;
      end if;
   end Get_Image_Manager;

end AWA.Images.Modules;

-----------------------------------------------------------------------
--  awa-images-modules -- Image management module
--  Copyright (C) 2012, 2016 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 AWA.Modules.Get;
with AWA.Applications;
with AWA.Storages.Modules;
with AWA.Services.Contexts;

with ADO.Sessions;

with Util.Strings;
with Util.Log.Loggers;
package body AWA.Images.Modules is

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

   --  ------------------------------
   --  Job worker procedure to identify an image and generate its thumnbnail.
   --  ------------------------------
   procedure Thumbnail_Worker (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
      Module : constant Image_Module_Access := Get_Image_Module;
   begin
      Module.Do_Thumbnail_Job (Job);
   end Thumbnail_Worker;

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

      --  Setup the resource bundles.
      App.Register ("imageMsg", "images");

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

      Plugin.Add_Listener (AWA.Storages.Modules.NAME, Plugin'Unchecked_Access);
   end Initialize;

   --  ------------------------------
   --  Configures the module after its initialization and after having read its XML configuration.
   --  ------------------------------
   overriding
   procedure Configure (Plugin : in out Image_Module;
                        Props  : in ASF.Applications.Config) is
      pragma Unreferenced (Props);
   begin
      --  Create the image manager when everything is initialized.
      Plugin.Manager := Plugin.Create_Image_Manager;
      Plugin.Job_Module := AWA.Jobs.Modules.Get_Job_Module;
      Plugin.Job_Module.Register (Definition => Thumbnail_Job_Definition.Factory);
   end Configure;

   --  ------------------------------
   --  Get the image manager.
   --  ------------------------------
   function Get_Image_Manager (Plugin : in Image_Module)
                                 return Services.Image_Service_Access is
   begin
      return Plugin.Manager;
   end Get_Image_Manager;

   --  ------------------------------
   --  Create an image manager.  This operation can be overridden to provide another
   --  image service implementation.
   --  ------------------------------
   function Create_Image_Manager (Plugin : in Image_Module)
                                    return Services.Image_Service_Access is
      Result : constant Services.Image_Service_Access := new Services.Image_Service;
   begin
      Result.Initialize (Plugin);
      return Result;
   end Create_Image_Manager;

   --  ------------------------------
   --  Create a thumbnail job for the image.
   --  ------------------------------
   procedure Make_Thumbnail_Job (Plugin : in Image_Module;
                                 Image  : in AWA.Images.Models.Image_Ref'Class) is
      pragma Unreferenced (Plugin);

      J : AWA.Jobs.Services.Job_Type;
   begin
      J.Set_Parameter ("image_id", Image);
      J.Schedule (Thumbnail_Job_Definition.Factory.all);
   end Make_Thumbnail_Job;

   --  ------------------------------
   --  Returns true if the storage file has an image mime type.
   --  ------------------------------
   function Is_Image (File : in AWA.Storages.Models.Storage_Ref'Class) return Boolean is
      Mime : constant String := File.Get_Mime_Type;
      Pos  : constant Natural := Util.Strings.Index (Mime, '/');
   begin
      if Pos = 0 then
         return False;
      else
         return Mime (Mime'First .. Pos - 1) = "image";
      end if;
   end Is_Image;

   --  ------------------------------
   --  Create an image instance.
   --  ------------------------------
   procedure Create_Image (Plugin  : in Image_Module;
                           File    : in AWA.Storages.Models.Storage_Ref'Class) is
      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Img : AWA.Images.Models.Image_Ref;
   begin
      Img.Set_Width (0);
      Img.Set_Height (0);
      Img.Set_Thumb_Height (0);
      Img.Set_Thumb_Width (0);
      Img.Set_Storage (File);
      Img.Set_Folder (File.Get_Folder);
      Img.Set_Owner (File.Get_Owner);
      Img.Save (DB);
      Plugin.Make_Thumbnail_Job (Img);
   end Create_Image;

   --  ------------------------------
   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the item.
   --  ------------------------------
   overriding
   procedure On_Create (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class) is
   begin
      if Is_Image (Item) then
         Instance.Create_Image (Item);
      end if;
   end On_Create;

   --  ------------------------------
   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the item.
   --  ------------------------------
   overriding
   procedure On_Update (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class) is
   begin
      if Is_Image (Item) then
         Instance.Create_Image (Item);
      else
         Instance.Manager.Delete_Image (Item);
      end if;
   end On_Update;

   --  ------------------------------
   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the item.
   --  ------------------------------
   overriding
   procedure On_Delete (Instance : in Image_Module;
                        Item     : in AWA.Storages.Models.Storage_Ref'Class) is
   begin
      Instance.Manager.Delete_Image (Item);
   end On_Delete;

   --  ------------------------------
   --  Thumbnail job to identify the image dimension and produce a thumbnail.
   --  ------------------------------
   procedure Do_Thumbnail_Job (Plugin : in Image_Module;
                               Job    : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
      Image_Id : constant ADO.Identifier := Job.Get_Parameter ("image_id");
   begin
      Plugin.Manager.Build_Thumbnail (Image_Id);
   end Do_Thumbnail_Job;

   --  ------------------------------
   --  Get the image module instance associated with the current application.
   --  ------------------------------
   function Get_Image_Module return Image_Module_Access is
      function Get is new AWA.Modules.Get (Image_Module, Image_Module_Access, NAME);
   begin
      return Get;
   end Get_Image_Module;

   --  ------------------------------
   --  Get the image manager instance associated with the current application.
   --  ------------------------------
   function Get_Image_Manager return Services.Image_Service_Access is
      Module : constant Image_Module_Access := Get_Image_Module;
   begin
      if Module = null then
         Log.Error ("There is no active Storage_Module");
         return null;
      else
         return Module.Get_Image_Manager;
      end if;
   end Get_Image_Manager;

end AWA.Images.Modules;

Implement the thumnail job and related procedure to make a thumbnail of an image