-----------------------------------------------------------------------
--  util-log-appenders-files -- File log appenders
--  Copyright (C) 2001 - 2021 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.Text_IO;
with Util.Properties;

--  === File appender ===
--  The `File` appender recognises the following configurations:
--
--  | Name           | Description                                                          |
--  | -------------- | --------------------------------------------------------------       |
--  | layout         | Defines the format of the message printed by the appender.           |
--  | level          | Defines the minimum level above which messages are printed.          |
--  | File           | The path used by the appender to create the output file.             |
--  | append         | When 'true' or '1', the file is opened in append mode otherwise      |
--  |                | it is truncated (the default is to truncate).                        |
--  | immediateFlush | When 'true' or '1', the file is flushed after each message log.      |
--  |                | Immediate flush is useful in some situations to have the log file    |
--  |                | updated immediately at the expense of slowing down the processing    |
--  |                | of logs.                                                             |

package Util.Log.Appenders.Files is

   --  ------------------------------
   --  File appender
   --  ------------------------------
   type File_Appender (Length : Positive) is new Appender with private;
   type File_Appender_Access is access all File_Appender'Class;

   overriding
   procedure Append (Self    : in out File_Appender;
                     Message : in Util.Strings.Builders.Builder;
                     Date    : in Ada.Calendar.Time;
                     Level   : in Level_Type;
                     Logger  : in String);

   --  Set the file where the appender will write the logs.
   --  When <tt>Append</tt> is true, the log message are appended to the existing file.
   --  When set to false, the file is cleared before writing new messages.
   procedure Set_File (Self   : in out File_Appender;
                       Path   : in String;
                       Append : in Boolean := True);

   --  Flush the log events.
   overriding
   procedure Flush (Self   : in out File_Appender);

   --  Flush and close the file.
   overriding
   procedure Finalize (Self : in out File_Appender);

   --  Create a file appender and configure it according to the properties
   function Create (Name       : in String;
                    Properties : in Util.Properties.Manager;
                    Default    : in Level_Type)
     return Appender_Access;

private

   type File_Appender (Length : Positive) is new Appender (Length) with record
      Output          : Ada.Text_IO.File_Type;
      Immediate_Flush : Boolean := False;
   end record;

end Util.Log.Appenders.Files;

-----------------------------------------------------------------------
--  util-log-appenders-files -- File log appenders
--  Copyright (C) 2001 - 2021 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.Text_IO;
with Util.Properties;

--  === File appender ===
--  The `File` appender recognises the following configurations:
--
--  | Name           | Description                                                          |
--  | -------------- | --------------------------------------------------------------       |
--  | layout         | Defines the format of the message printed by the appender.           |
--  | level          | Defines the minimum level above which messages are printed.          |
--  | File           | The path used by the appender to create the output file.             |
--  | append         | When 'true' or '1', the file is opened in append mode otherwise      |
--  |                | it is truncated (the default is to truncate).                        |
--  | immediateFlush | When 'true' or '1', the file is flushed after each message log.      |
--  |                | Immediate flush is useful in some situations to have the log file    |
--  |                | updated immediately at the expense of slowing down the processing    |
--  |                | of logs.                                                             |
--
package Util.Log.Appenders.Files is

   --  ------------------------------
   --  File appender
   --  ------------------------------
   type File_Appender (Length : Positive) is new Appender with private;
   type File_Appender_Access is access all File_Appender'Class;

   overriding
   procedure Append (Self    : in out File_Appender;
                     Message : in Util.Strings.Builders.Builder;
                     Date    : in Ada.Calendar.Time;
                     Level   : in Level_Type;
                     Logger  : in String);

   --  Set the file where the appender will write the logs.
   --  When <tt>Append</tt> is true, the log message are appended to the existing file.
   --  When set to false, the file is cleared before writing new messages.
   procedure Set_File (Self   : in out File_Appender;
                       Path   : in String;
                       Append : in Boolean := True);

   --  Flush the log events.
   overriding
   procedure Flush (Self   : in out File_Appender);

   --  Flush and close the file.
   overriding
   procedure Finalize (Self : in out File_Appender);

   --  Create a file appender and configure it according to the properties
   function Create (Name       : in String;
                    Properties : in Util.Properties.Manager;
                    Default    : in Level_Type)
     return Appender_Access;

private

   type File_Appender (Length : Positive) is new Appender (Length) with record
      Output          : Ada.Text_IO.File_Type;
      Immediate_Flush : Boolean := False;
   end record;

end Util.Log.Appenders.Files;

Fix comment style

Fix comment style


--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  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.Pointers;

private with GL.Low_Level.Enums;

package GL.Objects.Buffers is
   pragma Preelaborate;

   function Minimum_Alignment return Types.Size
     with Post => Minimum_Alignment'Result >= 64;
   --  Minimum byte alignment of pointers returned by Map_Range
   --  (at least 64 bytes to support SIMD CPU instructions)

   type Access_Kind is (Read_Only, Write_Only, Read_Write);

   type Access_Bits is record
      Read              : Boolean := False;
      Write             : Boolean := False;
      Invalidate_Range  : Boolean := False;
      Invalidate_Buffer : Boolean := False;
      Flush_Explicit    : Boolean := False;
      Unsynchronized    : Boolean := False;
      Persistent        : Boolean := False;
      Coherent          : Boolean := False;
   end record;

   type Storage_Bits is record
      Read              : Boolean := False;
      Write             : Boolean := False;
      Persistent        : Boolean := False;
      Coherent          : Boolean := False;
      Dynamic_Storage   : Boolean := False;
      Client_Storage    : Boolean := False;
   end record
     with Dynamic_Predicate => (if Storage_Bits.Coherent then Storage_Bits.Persistent)
       and (if Storage_Bits.Persistent then Storage_Bits.Read or Storage_Bits.Write);

   type Buffer_Target (<>) is tagged limited private;

   type Buffer is new GL_Object with private;

   procedure Bind (Target : Buffer_Target; Object : Buffer'Class);
   --  Bind the buffer object to the target

   procedure Bind_Base (Target : Buffer_Target; Object : Buffer'Class; Index : Natural);
   --  Bind the buffer object to the index of the target as well as to
   --  the target itself.
   --
   --  Target must be one of the following:
   --
   --    * Atomic_Counter_Buffer
   --    * Transform_Feedback_Buffer
   --    * Uniform_Buffer
   --    * Shader_Storage_Buffer

   procedure Allocate (Object : Buffer; Number_Of_Elements : Long;
                       Kind : Numeric_Type; Storage_Flags : Storage_Bits);
   --  Use this instead of Load_To_Immutable_Buffer when you don't want
   --  to copy any data

   function Current_Object (Target : Buffer_Target) return Buffer'Class;

   function Access_Type   (Object : Buffer) return Access_Kind;
   function Immutable     (Object : Buffer) return Boolean;
   function Mapped        (Object : Buffer) return Boolean;
   function Size          (Object : Buffer) return Long_Size;
   function Storage_Flags (Object : Buffer) return Storage_Bits;

   overriding
   procedure Initialize_Id (Object : in out Buffer);

   overriding
   procedure Delete_Id (Object : in out Buffer);

   overriding
   function Identifier (Object : Buffer) return Types.Debug.Identifier is
     (Types.Debug.Buffer);

   procedure Unmap (Object : in out Buffer);

   procedure Clear_With_Zeros (Object : Buffer);

   procedure Invalidate_Data (Object : in out Buffer);

   generic
      with package Pointers is new Interfaces.C.Pointers (<>);
   package Buffer_Pointers is

      subtype Pointer is Pointers.Pointer;

      procedure Bind_Range (Target : Buffer_Target; Object : Buffer'Class; Index : Natural;
                            Offset, Length : Types.Size);
      --  Bind a part of the buffer object to the index of the target as
      --  well as to the target itself.
      --
      --  Target must be one of the following:
      --
      --    * Atomic_Counter_Buffer
      --    * Transform_Feedback_Buffer
      --    * Uniform_Buffer
      --    * Shader_Storage_Buffer

      procedure Load_To_Immutable_Buffer (Object : Buffer;
                                          Data   : Pointers.Element_Array;
                                          Storage_Flags : Storage_Bits);

      procedure Map_Range (Object : in out Buffer; Access_Flags : Access_Bits;
                           Offset, Length : Types.Size;
                           Pointer : out Pointers.Pointer);

      function Get_Mapped_Data
        (Pointer : not null Pointers.Pointer;
         Offset, Length : Types.Size) return Pointers.Element_Array
      with Pre  => Length > 0,
           Post => Get_Mapped_Data'Result'Length = Length;

      procedure Set_Mapped_Data
        (Pointer : not null Pointers.Pointer;
         Offset  : Types.Size;
         Data    : Pointers.Element_Array)
      with Pre => Data'Length > 0;

      procedure Set_Mapped_Data
        (Pointer : not null Pointers.Pointer;
         Offset  : Types.Size;
         Value   : Pointers.Element);

      procedure Flush_Buffer_Range (Object : in out Buffer;
                                    Offset, Length : Types.Size);

      function To_Pointer (Object : Buffer) return Pointers.Pointer;

      procedure Clear_Data
        (Object : Buffer;
         Kind : Numeric_Type;
         Data : in out Pointers.Element_Array)
      with Pre => Data'Length in 1 .. 4
        and then Kind /= Double_Type
        and then (if Data'Length = 3 then
          Kind not in Byte_Type | UByte_Type | Short_Type | UShort_Type | Half_Type);

      procedure Clear_Sub_Data
        (Object : Buffer;
         Offset, Length : Types.Size;
         Kind : Numeric_Type;
         Data : in out Pointers.Element_Array)
      with Pre => Data'Length in 1 .. 4
        and then Kind /= Double_Type
        and then (if Data'Length = 3 then
          Kind not in Byte_Type | UByte_Type | Short_Type | UShort_Type | Half_Type);

      procedure Clear_With_Zeros (Object : Buffer; Offset, Length : Types.Size);

      procedure Copy_Sub_Data (Object, Target_Object : Buffer;
                               Read_Offset, Write_Offset, Length : Types.Size);

      procedure Set_Sub_Data (Object : Buffer;
                              Offset : Types.Size;
                              Data   : in out Pointers.Element_Array);

      procedure Get_Sub_Data (Object : Buffer;
                              Offset : Types.Size;
                              Data   : out Pointers.Element_Array);

      procedure Invalidate_Sub_Data (Object : Buffer;
                                     Offset, Length : Types.Size);

   end Buffer_Pointers;

   Array_Buffer              : constant Buffer_Target;
   Element_Array_Buffer      : constant Buffer_Target;
   Pixel_Pack_Buffer         : constant Buffer_Target;
   Pixel_Unpack_Buffer       : constant Buffer_Target;
   Uniform_Buffer            : constant Buffer_Target;
   Texture_Buffer            : constant Buffer_Target;
   Transform_Feedback_Buffer : constant Buffer_Target;
   Copy_Read_Buffer          : constant Buffer_Target;
   Copy_Write_Buffer         : constant Buffer_Target;
   Draw_Indirect_Buffer      : constant Buffer_Target;
   Parameter_Buffer          : constant Buffer_Target;
   Shader_Storage_Buffer     : constant Buffer_Target;
   Dispatch_Indirect_Buffer  : constant Buffer_Target;
   Query_Buffer              : constant Buffer_Target;
   Atomic_Counter_Buffer     : constant Buffer_Target;

private

   for Access_Kind use (Read_Only  => 16#88B8#,
                        Write_Only => 16#88B9#,
                        Read_Write => 16#88BA#);
   for Access_Kind'Size use Low_Level.Enum'Size;

   for Access_Bits use record
      Read              at 0 range 0 .. 0;
      Write             at 0 range 1 .. 1;
      Invalidate_Range  at 0 range 2 .. 2;
      Invalidate_Buffer at 0 range 3 .. 3;
      Flush_Explicit    at 0 range 4 .. 4;
      Unsynchronized    at 0 range 5 .. 5;
      Persistent        at 0 range 6 .. 6;
      Coherent          at 0 range 7 .. 7;
   end record;
   for Access_Bits'Size use Low_Level.Bitfield'Size;

   for Storage_Bits use record
      Read              at 0 range 0 .. 0;
      Write             at 0 range 1 .. 1;
      Persistent        at 0 range 6 .. 6;
      Coherent          at 0 range 7 .. 7;
      Dynamic_Storage   at 0 range 8 .. 8;
      Client_Storage    at 0 range 9 .. 9;
   end record;
   for Storage_Bits'Size use Low_Level.Bitfield'Size;

   type Buffer_Target (Kind : Low_Level.Enums.Buffer_Kind) is
     tagged limited null record;

   type Buffer is new GL_Object with null record;

   Array_Buffer              : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Array_Buffer);
   Element_Array_Buffer      : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Element_Array_Buffer);
   Pixel_Pack_Buffer         : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Pixel_Pack_Buffer);
   Pixel_Unpack_Buffer       : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Pixel_Unpack_Buffer);
   Uniform_Buffer            : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Uniform_Buffer);
   Texture_Buffer            : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Texture_Buffer);
   Transform_Feedback_Buffer : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Transform_Feedback_Buffer);
   Copy_Read_Buffer          : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Copy_Read_Buffer);
   Copy_Write_Buffer         : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Copy_Write_Buffer);
   Draw_Indirect_Buffer      : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Draw_Indirect_Buffer);
   Parameter_Buffer          : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Parameter_Buffer);
   Shader_Storage_Buffer     : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Shader_Storage_Buffer);
   Dispatch_Indirect_Buffer  : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Dispatch_Indirect_Buffer);
   Query_Buffer              : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Query_Buffer);
   Atomic_Counter_Buffer     : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Atomic_Counter_Buffer);

end GL.Objects.Buffers;

--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  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.Pointers;

private with GL.Low_Level.Enums;

package GL.Objects.Buffers is
   pragma Preelaborate;

   function Minimum_Alignment return Types.Size
     with Post => Minimum_Alignment'Result >= 64;
   --  Minimum byte alignment of pointers returned by Map_Range
   --  (at least 64 bytes to support SIMD CPU instructions)

   type Access_Kind is (Read_Only, Write_Only, Read_Write);

   type Access_Bits is record
      Read              : Boolean := False;
      Write             : Boolean := False;
      Invalidate_Range  : Boolean := False;
      Invalidate_Buffer : Boolean := False;
      Flush_Explicit    : Boolean := False;
      Unsynchronized    : Boolean := False;
      Persistent        : Boolean := False;
      Coherent          : Boolean := False;
   end record;

   type Storage_Bits is record
      Read              : Boolean := False;
      Write             : Boolean := False;
      Persistent        : Boolean := False;
      Coherent          : Boolean := False;
      Dynamic_Storage   : Boolean := False;
      Client_Storage    : Boolean := False;
   end record
     with Dynamic_Predicate => (if Storage_Bits.Coherent then Storage_Bits.Persistent)
       and (if Storage_Bits.Persistent then Storage_Bits.Read or Storage_Bits.Write);

   type Buffer_Target (<>) is tagged limited private;

   type Buffer is new GL_Object with private;

   procedure Bind (Target : Buffer_Target; Object : Buffer'Class);
   --  Bind the buffer object to the target
   --  TODO Not one of the four targets used by Bind_Base

   procedure Bind_Base (Target : Buffer_Target; Object : Buffer'Class; Index : Natural);
   --  Bind the buffer object to the index of the target as well as to
   --  the target itself.
   --
   --  Target must be one of the following:
   --
   --    * Atomic_Counter_Buffer
   --    * Transform_Feedback_Buffer
   --    * Uniform_Buffer
   --    * Shader_Storage_Buffer

   procedure Allocate (Object : Buffer; Number_Of_Elements : Long;
                       Kind : Numeric_Type; Storage_Flags : Storage_Bits);
   --  Use this instead of Load_To_Immutable_Buffer when you don't want
   --  to copy any data

   function Current_Object (Target : Buffer_Target) return Buffer'Class;

   function Access_Type   (Object : Buffer) return Access_Kind;
   function Immutable     (Object : Buffer) return Boolean;
   function Mapped        (Object : Buffer) return Boolean;
   function Size          (Object : Buffer) return Long_Size;
   function Storage_Flags (Object : Buffer) return Storage_Bits;

   overriding
   procedure Initialize_Id (Object : in out Buffer);

   overriding
   procedure Delete_Id (Object : in out Buffer);

   overriding
   function Identifier (Object : Buffer) return Types.Debug.Identifier is
     (Types.Debug.Buffer);

   procedure Unmap (Object : in out Buffer);

   procedure Clear_With_Zeros (Object : Buffer);

   procedure Invalidate_Data (Object : in out Buffer);

   generic
      with package Pointers is new Interfaces.C.Pointers (<>);
   package Buffer_Pointers is

      subtype Pointer is Pointers.Pointer;

      procedure Bind_Range (Target : Buffer_Target; Object : Buffer'Class; Index : Natural;
                            Offset, Length : Types.Size);
      --  Bind a part of the buffer object to the index of the target as
      --  well as to the target itself.
      --
      --  Target must be one of the following:
      --
      --    * Atomic_Counter_Buffer
      --    * Transform_Feedback_Buffer
      --    * Uniform_Buffer
      --    * Shader_Storage_Buffer

      procedure Load_To_Immutable_Buffer (Object : Buffer;
                                          Data   : Pointers.Element_Array;
                                          Storage_Flags : Storage_Bits);

      procedure Map_Range (Object : in out Buffer; Access_Flags : Access_Bits;
                           Offset, Length : Types.Size;
                           Pointer : out Pointers.Pointer);

      function Get_Mapped_Data
        (Pointer : not null Pointers.Pointer;
         Offset, Length : Types.Size) return Pointers.Element_Array
      with Pre  => Length > 0,
           Post => Get_Mapped_Data'Result'Length = Length;

      procedure Set_Mapped_Data
        (Pointer : not null Pointers.Pointer;
         Offset  : Types.Size;
         Data    : Pointers.Element_Array)
      with Pre => Data'Length > 0;

      procedure Set_Mapped_Data
        (Pointer : not null Pointers.Pointer;
         Offset  : Types.Size;
         Value   : Pointers.Element);

      procedure Flush_Buffer_Range (Object : in out Buffer;
                                    Offset, Length : Types.Size);

      function To_Pointer (Object : Buffer) return Pointers.Pointer;

      procedure Clear_Data
        (Object : Buffer;
         Kind : Numeric_Type;
         Data : in out Pointers.Element_Array)
      with Pre => Data'Length in 1 .. 4
        and then Kind /= Double_Type
        and then (if Data'Length = 3 then
          Kind not in Byte_Type | UByte_Type | Short_Type | UShort_Type | Half_Type);

      procedure Clear_Sub_Data
        (Object : Buffer;
         Offset, Length : Types.Size;
         Kind : Numeric_Type;
         Data : in out Pointers.Element_Array)
      with Pre => Data'Length in 1 .. 4
        and then Kind /= Double_Type
        and then (if Data'Length = 3 then
          Kind not in Byte_Type | UByte_Type | Short_Type | UShort_Type | Half_Type);

      procedure Clear_With_Zeros (Object : Buffer; Offset, Length : Types.Size);

      procedure Copy_Sub_Data (Object, Target_Object : Buffer;
                               Read_Offset, Write_Offset, Length : Types.Size);

      procedure Set_Sub_Data (Object : Buffer;
                              Offset : Types.Size;
                              Data   : in out Pointers.Element_Array);

      procedure Get_Sub_Data (Object : Buffer;
                              Offset : Types.Size;
                              Data   : out Pointers.Element_Array);

      procedure Invalidate_Sub_Data (Object : Buffer;
                                     Offset, Length : Types.Size);

   end Buffer_Pointers;

   --  Array_Buffer, Element_Array_Buffer, Texture_Buffer,
   --  Copy_Read_Buffer, and Copy_Write_Buffer are no longer needed
   --  since the GL.Objects.* packages use DSA
   Pixel_Pack_Buffer         : constant Buffer_Target;
   Pixel_Unpack_Buffer       : constant Buffer_Target;
   Uniform_Buffer            : constant Buffer_Target;
   Transform_Feedback_Buffer : constant Buffer_Target;
   Draw_Indirect_Buffer      : constant Buffer_Target;
   Parameter_Buffer          : constant Buffer_Target;
   Shader_Storage_Buffer     : constant Buffer_Target;
   Dispatch_Indirect_Buffer  : constant Buffer_Target;
   Query_Buffer              : constant Buffer_Target;
   Atomic_Counter_Buffer     : constant Buffer_Target;

private

   for Access_Kind use (Read_Only  => 16#88B8#,
                        Write_Only => 16#88B9#,
                        Read_Write => 16#88BA#);
   for Access_Kind'Size use Low_Level.Enum'Size;

   for Access_Bits use record
      Read              at 0 range 0 .. 0;
      Write             at 0 range 1 .. 1;
      Invalidate_Range  at 0 range 2 .. 2;
      Invalidate_Buffer at 0 range 3 .. 3;
      Flush_Explicit    at 0 range 4 .. 4;
      Unsynchronized    at 0 range 5 .. 5;
      Persistent        at 0 range 6 .. 6;
      Coherent          at 0 range 7 .. 7;
   end record;
   for Access_Bits'Size use Low_Level.Bitfield'Size;

   for Storage_Bits use record
      Read              at 0 range 0 .. 0;
      Write             at 0 range 1 .. 1;
      Persistent        at 0 range 6 .. 6;
      Coherent          at 0 range 7 .. 7;
      Dynamic_Storage   at 0 range 8 .. 8;
      Client_Storage    at 0 range 9 .. 9;
   end record;
   for Storage_Bits'Size use Low_Level.Bitfield'Size;

   type Buffer_Target (Kind : Low_Level.Enums.Buffer_Kind) is
     tagged limited null record;

   type Buffer is new GL_Object with null record;

   Pixel_Pack_Buffer         : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Pixel_Pack_Buffer);
   Pixel_Unpack_Buffer       : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Pixel_Unpack_Buffer);
   Uniform_Buffer            : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Uniform_Buffer);
   Transform_Feedback_Buffer : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Transform_Feedback_Buffer);
   Draw_Indirect_Buffer      : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Draw_Indirect_Buffer);
   Parameter_Buffer          : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Parameter_Buffer);
   Shader_Storage_Buffer     : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Shader_Storage_Buffer);
   Dispatch_Indirect_Buffer  : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Dispatch_Indirect_Buffer);
   Query_Buffer              : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Query_Buffer);
   Atomic_Counter_Buffer     : constant Buffer_Target
     := Buffer_Target'(Kind => Low_Level.Enums.Atomic_Counter_Buffer);

end GL.Objects.Buffers;

gl: Remove some useless buffer binding targets

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  awa-commands-stop -- Command to stop the web server
--  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.Sockets;
with Util.Streams.Sockets;
with Util.Streams.Texts;
package body AWA.Commands.Stop is

   --  ------------------------------
   --  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
      GC.Set_Usage (Config => Config,
                    Usage  => Command.Get_Name & " [arguments]",
                    Help   => Command.Get_Description);
      GC.Define_Switch (Config => Config,
                        Output => Command.Management_Port'Access,
                        Switch => "-m:",
                        Long_Switch => "--management-port=",
                        Initial  => Command.Management_Port,
                        Argument => "NUMBER",
                        Help   => -("The server listening management port on localhost"));
      AWA.Commands.Setup (Config, Context);
   end Setup;

   --  ------------------------------
   --  Stop the server by sending a 'stop' command on the management socket.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Name, Args, Context);

      Address : GNAT.Sockets.Sock_Addr_Type;
      Stream  : aliased Util.Streams.Sockets.Socket_Stream;
      Writer  : Util.Streams.Texts.Print_Stream;
   begin
      Address.Addr := GNAT.Sockets.Loopback_Inet_Addr;
      Address.Port := GNAT.Sockets.Port_Type (Command.Management_Port);
      Stream.Connect (Address);
      Writer.Initialize (Stream'Access, 1024);
      Writer.Write ("stop" & ASCII.CR & ASCII.LF);
      Writer.Flush;
      Writer.Close;
   end Execute;

begin
   Command_Drivers.Driver.Add_Command ("stop",
                                       -("stop the web server"),
                                       Command'Access);
end AWA.Commands.Stop;

-----------------------------------------------------------------------
--  awa-commands-stop -- Command to stop the web server
--  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.Sockets;
with Util.Streams.Sockets;
with Util.Streams.Texts;
package body AWA.Commands.Stop is

   --  ------------------------------
   --  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
      GC.Set_Usage (Config => Config,
                    Usage  => Command.Get_Name & " [arguments]",
                    Help   => Command.Get_Description);
      GC.Define_Switch (Config => Config,
                        Output => Command.Management_Port'Access,
                        Switch => "-m:",
                        Long_Switch => "--management-port=",
                        Initial  => Command.Management_Port,
                        Argument => "NUMBER",
                        Help   => -("The server listening management port on localhost"));
      AWA.Commands.Setup_Command (Config, Context);
   end Setup;

   --  ------------------------------
   --  Stop the server by sending a 'stop' command on the management socket.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Name, Args, Context);

      Address : GNAT.Sockets.Sock_Addr_Type;
      Stream  : aliased Util.Streams.Sockets.Socket_Stream;
      Writer  : Util.Streams.Texts.Print_Stream;
   begin
      Address.Addr := GNAT.Sockets.Loopback_Inet_Addr;
      Address.Port := GNAT.Sockets.Port_Type (Command.Management_Port);
      Stream.Connect (Address);
      Writer.Initialize (Stream'Access, 1024);
      Writer.Write ("stop" & ASCII.CR & ASCII.LF);
      Writer.Flush;
      Writer.Close;
   end Execute;

begin
   Command_Drivers.Driver.Add_Command ("stop",
                                       -("stop the web server"),
                                       Command'Access);
end AWA.Commands.Stop;

Rename procedure Setup into Setup_Command because it generates conflict bug in GNAT 2019


-----------------------------------------------------------------------
--  ADO Mysql Database -- MySQL Database connections
--  Copyright (C) 2009, 2010, 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 Mysql.Mysql; use Mysql.Mysql;

package ADO.Drivers.Connections.Mysql is

   type Mysql_Driver is limited private;

   --  Initialize the Mysql driver.
   procedure Initialize;

private

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

   type Mysql_Driver is new ADO.Drivers.Connections.Driver with record
      Id : Natural := 0;
   end record;

   --  Deletes the Mysql driver.
   overriding
   procedure Finalize (D : in out Mysql_Driver);

   --  Database connection implementation
   type Database_Connection is new ADO.Drivers.Connections.Database_Connection with record
      Name        : Unbounded_String := Null_Unbounded_String;
      Server_Name : Unbounded_String := Null_Unbounded_String;
      Login_Name  : Unbounded_String := Null_Unbounded_String;
      Password    : Unbounded_String := Null_Unbounded_String;

      Server      : Mysql_Access := null;

      Connected   : Boolean      := False;

      --  MySQL autocommit flag
      Autocommit  : Boolean := True;
   end record;

   type Database_Connection_Access is access all Database_Connection'Class;

   --  Get the database driver which manages this connection.
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access;

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

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

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

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

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

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

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

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

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

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

   overriding
   procedure Finalize (Database : in out Database_Connection);

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

   --  Create the database and initialize it with the schema SQL file.
   overriding
   procedure Create_Database (Database    : in Database_Connection;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector);

end ADO.Drivers.Connections.Mysql;

-----------------------------------------------------------------------
--  ADO Mysql Database -- MySQL Database connections
--  Copyright (C) 2009, 2010, 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 Mysql.Mysql; use Mysql.Mysql;

package ADO.Drivers.Connections.Mysql is

   type Mysql_Driver is limited private;

   --  Initialize the Mysql driver.
   procedure Initialize;

private

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

   type Mysql_Driver is new ADO.Drivers.Connections.Driver with record
      Id : Natural := 0;
   end record;

   --  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 Mysql_Driver;
                              Admin       : in Configs.Configuration'Class;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector);

   --  Deletes the Mysql driver.
   overriding
   procedure Finalize (D : in out Mysql_Driver);

   --  Database connection implementation
   type Database_Connection is new ADO.Drivers.Connections.Database_Connection with record
      Name        : Unbounded_String := Null_Unbounded_String;
      Server_Name : Unbounded_String := Null_Unbounded_String;
      Login_Name  : Unbounded_String := Null_Unbounded_String;
      Password    : Unbounded_String := Null_Unbounded_String;

      Server      : Mysql_Access := null;

      Connected   : Boolean      := False;

      --  MySQL autocommit flag
      Autocommit  : Boolean := True;
   end record;

   type Database_Connection_Access is access all Database_Connection'Class;

   --  Get the database driver which manages this connection.
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access;

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

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

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

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

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

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

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

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

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

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

   overriding
   procedure Finalize (Database : in out Database_Connection);

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

end ADO.Drivers.Connections.Mysql;

Move the Create_Database operation on the Driver instead of the database connection


with Ada.Containers.Ordered_Sets;
with Ada.Strings.Bounded;
with Ada.Unchecked_Deallocation;
with Jack.Thin;
with System;

pragma Elaborate_All (Jack.Thin);

package Jack.Client is

  --
  -- Types.
  --

  type Number_Of_Frames_t is new Thin.Number_Of_Frames_t;

  --
  -- Options
  --

  type Option_Selector_t is
    (Do_Not_Start_Server,
     Use_Exact_Name,
     Server_Name,
     Load_Name,
     Load_Initialize);

  type Options_t is array (Option_Selector_t) of Boolean;

  --
  -- Status
  --

  type Status_Selector_t is
    (Failure,
     Invalid_Option,
     Name_Not_Unique,
     Server_Started,
     Server_Failed,
     Server_Error,
     No_Such_Client,
     Load_Failure,
     Init_Failure,
     Shared_Memory_Failure,
     Version_Error);

  type Status_t is array (Status_Selector_t) of Boolean;

  --
  -- Port flags
  --

  type Port_Flag_Selector_t is
    (Port_Is_Input,
     Port_Is_Output,
     Port_Is_Physical,
     Port_Can_Monitor,
     Port_Is_Terminal);

  type Port_Flags_t is array (Port_Flag_Selector_t) of Boolean;

  --
  -- Client
  --

  type Client_t is limited private;

  Invalid_Client : constant Client_t;

  function Compare
    (Left  : in Client_t;
     Right : in Client_t) return Boolean;

  function "="
    (Left  : in Client_t;
     Right : in Client_t) return Boolean renames Compare;

  --
  -- Port
  --

  type Port_t is limited private;

  Invalid_Port : constant Port_t;

  --
  -- Port name
  --

  subtype Port_Name_Size_t  is Natural          range 0 .. Natural (Thin.Port_Name_Size);
  subtype Port_Name_Index_t is Port_Name_Size_t range 1 .. Port_Name_Size_t'Last;

  package Port_Names is new
    Ada.Strings.Bounded.Generic_Bounded_Length (Port_Name_Index_t'Last);

  subtype Port_Name_t is Port_Names.Bounded_String;

  package Port_Name_Sets is new Ada.Containers.Ordered_Sets
    (Element_Type => Port_Name_t,
     "="          => Port_Names."=",
     "<"          => Port_Names."<");

  subtype Port_Name_Set_t is Port_Name_Sets.Set;

  --
  -- API
  --

  -- proc_map : jack_client_close
  procedure Close
    (Client : in     Client_t;
     Failed :    out Boolean);

  -- proc_map : jack_connect
  procedure Connect
    (Client           : in     Client_t;
     Source_Port      : in     Port_Name_t;
     Destination_Port : in     Port_Name_t;
     Failed           :    out Boolean);

  -- proc_map : jack_disconnect
  procedure Disconnect
    (Client           : in     Client_t;
     Source_Port      : in     Port_Name_t;
     Destination_Port : in     Port_Name_t;
     Failed           :    out Boolean);

  -- proc_map : jack_client_open
  procedure Open
    (Client_Name : in     String;
     Options     : in     Options_t;
     Client      :    out Client_t;
     Status      : in out Status_t);

  Default_Audio_Type : constant String := "32 bit float mono audio";

  -- proc_map : jack_port_register
  procedure Port_Register
    (Client      : in     Client_t;
     Port        :    out Port_t;
     Port_Name   : in     Port_Name_t;
     Port_Type   : in     String;
     Port_Flags  : in     Port_Flags_t;
     Buffer_Size : in     Natural := 0);

  -- proc_map : jack_activate
  procedure Activate
    (Client : in     Client_t;
     Failed :    out Boolean);

  -- proc_map : jack_get_ports
  procedure Get_Ports
    (Client            : in     Client_t;
     Port_Name_Pattern : in     String;
     Port_Type_Pattern : in     String;
     Port_Flags        : in     Port_Flags_t;
     Ports             :    out Port_Name_Set_t);

  generic
    type User_Data_Type        is private;
    type User_Data_Access_Type is access User_Data_Type;

  package Generic_Callbacks is

    type Process_Callback_State_t is record
      Callback  : access procedure
        (Number_Of_Frames : in Number_Of_Frames_t;
         User_Data        : in User_Data_Access_Type);
      User_Data : User_Data_Access_Type;
    end record;

    type Process_Callback_State_Access_t is access Process_Callback_State_t;

    procedure Deallocate_State is new Ada.Unchecked_Deallocation
      (Object => User_Data_Type,
       Name   => User_Data_Access_Type);

    -- proc_map : jack_set_process_callback
    procedure Set_Process_Callback
      (Client    : in     Client_t;
       State     : in     Process_Callback_State_Access_t;
       Failed    :    out Boolean);

  end Generic_Callbacks;

  --
  -- Private
  --

  function To_Address (Client : in Client_t) return System.Address;
  pragma Inline (To_Address);

  function To_Address (Port : in Port_t) return System.Address;
  pragma Inline (To_Address);

private

  type Client_t is new System.Address;
  type Port_t   is new System.Address;

  Invalid_Client : constant Client_t := Client_t (System.Null_Address);
  Invalid_Port   : constant Port_t   := Port_t (System.Null_Address);

  function Map_Status_To_Thin (Status : Status_t) return Thin.Status_t;
  pragma Inline (Map_Status_To_Thin);

  function Map_Thin_To_Status (Status : Thin.Status_t) return Status_t;
  pragma Inline (Map_Thin_To_Status);

  function Map_Options_To_Thin (Options : Options_t) return Thin.Options_t;
  pragma Inline (Map_Options_To_Thin);

  function Map_Thin_To_Options (Options : Thin.Options_t) return Options_t;
  pragma Inline (Map_Thin_To_Options);

  function Map_Port_Flags_To_Thin (Port_Flags : Port_Flags_t) return Thin.Port_Flags_t;
  pragma Inline (Map_Port_Flags_To_Thin);

  function Map_Thin_To_Port_Flags (Port_Flags : Thin.Port_Flags_t) return Port_Flags_t;
  pragma Inline (Map_Thin_To_Port_Flags);

end Jack.Client;

with Ada.Containers.Ordered_Sets;
with Ada.Strings.Bounded;
with Ada.Strings;
with Ada.Unchecked_Deallocation;
with Jack.Thin;
with System;

pragma Elaborate_All (Jack.Thin);

package Jack.Client is

  --
  -- Types.
  --

  type Number_Of_Frames_t is new Thin.Number_Of_Frames_t;

  --
  -- Options
  --

  type Option_Selector_t is
    (Do_Not_Start_Server,
     Use_Exact_Name,
     Server_Name,
     Load_Name,
     Load_Initialize);

  type Options_t is array (Option_Selector_t) of Boolean;

  --
  -- Status
  --

  type Status_Selector_t is
    (Failure,
     Invalid_Option,
     Name_Not_Unique,
     Server_Started,
     Server_Failed,
     Server_Error,
     No_Such_Client,
     Load_Failure,
     Init_Failure,
     Shared_Memory_Failure,
     Version_Error);

  type Status_t is array (Status_Selector_t) of Boolean;

  --
  -- Port flags
  --

  type Port_Flag_Selector_t is
    (Port_Is_Input,
     Port_Is_Output,
     Port_Is_Physical,
     Port_Can_Monitor,
     Port_Is_Terminal);

  type Port_Flags_t is array (Port_Flag_Selector_t) of Boolean;

  --
  -- Client
  --

  type Client_t is limited private;

  Invalid_Client : constant Client_t;

  function Compare
    (Left  : in Client_t;
     Right : in Client_t) return Boolean;

  function "="
    (Left  : in Client_t;
     Right : in Client_t) return Boolean renames Compare;

  --
  -- Port
  --

  type Port_t is limited private;

  Invalid_Port : constant Port_t;

  --
  -- Port name
  --

  subtype Port_Name_Size_t  is Natural          range 0 .. Natural (Thin.Port_Name_Size);
  subtype Port_Name_Index_t is Port_Name_Size_t range 1 .. Port_Name_Size_t'Last;

  package Port_Names is new
    Ada.Strings.Bounded.Generic_Bounded_Length (Port_Name_Index_t'Last);

  function To_Port_Name
    (Input : in String;
     Drop  : in Ada.Strings.Truncation := Ada.Strings.Error)
    return Port_Names.Bounded_String renames Port_Names.To_Bounded_String;

  subtype Port_Name_t is Port_Names.Bounded_String;

  package Port_Name_Sets is new Ada.Containers.Ordered_Sets
    (Element_Type => Port_Name_t,
     "="          => Port_Names."=",
     "<"          => Port_Names."<");

  subtype Port_Name_Set_t is Port_Name_Sets.Set;

  --
  -- API
  --

  -- proc_map : jack_client_close
  procedure Close
    (Client : in     Client_t;
     Failed :    out Boolean);

  -- proc_map : jack_connect
  procedure Connect
    (Client           : in     Client_t;
     Source_Port      : in     Port_Name_t;
     Destination_Port : in     Port_Name_t;
     Failed           :    out Boolean);

  -- proc_map : jack_disconnect
  procedure Disconnect
    (Client           : in     Client_t;
     Source_Port      : in     Port_Name_t;
     Destination_Port : in     Port_Name_t;
     Failed           :    out Boolean);

  -- proc_map : jack_client_open
  procedure Open
    (Client_Name : in     String;
     Options     : in     Options_t;
     Client      :    out Client_t;
     Status      : in out Status_t);

  Default_Audio_Type : constant String := "32 bit float mono audio";

  -- proc_map : jack_port_register
  procedure Port_Register
    (Client      : in     Client_t;
     Port        :    out Port_t;
     Port_Name   : in     Port_Name_t;
     Port_Type   : in     String;
     Port_Flags  : in     Port_Flags_t;
     Buffer_Size : in     Natural := 0);

  -- proc_map : jack_activate
  procedure Activate
    (Client : in     Client_t;
     Failed :    out Boolean);

  -- proc_map : jack_get_ports
  procedure Get_Ports
    (Client            : in     Client_t;
     Port_Name_Pattern : in     String;
     Port_Type_Pattern : in     String;
     Port_Flags        : in     Port_Flags_t;
     Ports             :    out Port_Name_Set_t);

  generic
    type User_Data_Type        is private;
    type User_Data_Access_Type is access User_Data_Type;

  package Generic_Callbacks is

    type Process_Callback_State_t is record
      Callback  : access procedure
        (Number_Of_Frames : in Number_Of_Frames_t;
         User_Data        : in User_Data_Access_Type);
      User_Data : User_Data_Access_Type;
    end record;

    type Process_Callback_State_Access_t is access Process_Callback_State_t;

    procedure Deallocate_State is new Ada.Unchecked_Deallocation
      (Object => User_Data_Type,
       Name   => User_Data_Access_Type);

    -- proc_map : jack_set_process_callback
    procedure Set_Process_Callback
      (Client    : in     Client_t;
       State     : in     Process_Callback_State_Access_t;
       Failed    :    out Boolean);

  end Generic_Callbacks;

  --
  -- Private
  --

  function To_Address (Client : in Client_t) return System.Address;
  pragma Inline (To_Address);

  function To_Address (Port : in Port_t) return System.Address;
  pragma Inline (To_Address);

private

  type Client_t is new System.Address;
  type Port_t   is new System.Address;

  Invalid_Client : constant Client_t := Client_t (System.Null_Address);
  Invalid_Port   : constant Port_t   := Port_t (System.Null_Address);

  function Map_Status_To_Thin (Status : Status_t) return Thin.Status_t;
  pragma Inline (Map_Status_To_Thin);

  function Map_Thin_To_Status (Status : Thin.Status_t) return Status_t;
  pragma Inline (Map_Thin_To_Status);

  function Map_Options_To_Thin (Options : Options_t) return Thin.Options_t;
  pragma Inline (Map_Options_To_Thin);

  function Map_Thin_To_Options (Options : Thin.Options_t) return Options_t;
  pragma Inline (Map_Thin_To_Options);

  function Map_Port_Flags_To_Thin (Port_Flags : Port_Flags_t) return Thin.Port_Flags_t;
  pragma Inline (Map_Port_Flags_To_Thin);

  function Map_Thin_To_Port_Flags (Port_Flags : Thin.Port_Flags_t) return Port_Flags_t;
  pragma Inline (Map_Thin_To_Port_Flags);

end Jack.Client;

Add to_port_name shorthand

Add to_port_name shorthand


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

with Security.Permissions;

--  == OpenID ==
--  The Security.Openid package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
--
--  === Authentication process ==
--  The process is the following:
--
--    * The Initialize procedure is called to configure the OpenID realm and set the
--      OpenID return callback CB.
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--    * The Get_Authentication_URL builds the provider OpenID authentication
--      URL for the association.
--    * The application should redirected the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
package Security.Openid is

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

   function Get_Parameter (Params : in Parameters;
                           Name   : in String) return String is abstract;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --  The End_Point represents the OpenID provider that will authenticate
   --  the user.
   type End_Point is private;

   function To_String (OP : End_Point) return String;

   --  ------------------------------
   --  Association
   --  ------------------------------
   --  The OpenID association contains the shared secret between the relying party
   --  and the OpenID provider.  The association can be cached and reused to authenticate
   --  different users using the same OpenID provider.  The association also has an
   --  expiration date.
   type Association is private;

   --  Dump the association as a string (for debugging purposes)
   function To_String (Assoc : Association) return String;

   type Auth_Result is (AUTHENTICATED, CANCEL, SETUP_NEEDED, UNKNOWN, INVALID_SIGNATURE);

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --
   type Authentication is private;

   --  Get the email address
   function Get_Email (Auth : in Authentication) return String;

   --  Get the user first name.
   function Get_First_Name (Auth : in Authentication) return String;

   --  Get the user last name.
   function Get_Last_Name (Auth : in Authentication) return String;

   --  Get the user full name.
   function Get_Full_Name (Auth : in Authentication) return String;

   --  Get the user identity.
   function Get_Identity (Auth : in Authentication) return String;

   --  Get the user claimed identity.
   function Get_Claimed_Id (Auth : in Authentication) return String;

   --  Get the user language.
   function Get_Language (Auth : in Authentication) return String;

   --  Get the user country.
   function Get_Country (Auth : in Authentication) return String;

   --  Get the result of the authentication.
   function Get_Status (Auth : in Authentication) return Auth_Result;

   --  ------------------------------
   --  OpenID Default principal
   --  ------------------------------
   type Principal is new Security.Permissions.Principal with private;
   type Principal_Access is access all Principal'Class;

   --  Returns true if the given role is stored in the user principal.
   function Has_Role (User : in Principal;
                      Role : in Permissions.Role_Type) return Boolean;

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

   --  Get the user email address.
   function Get_Email (From : in Principal) return String;

   --  Get the authentication data.
   function Get_Authentication (From : in Principal) return Authentication;

   --  Create a principal with the given authentication results.
   function Create_Principal (Auth : in Authentication) return Principal_Access;

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   type Manager is tagged limited private;

   --  Initialize the OpenID realm.
   procedure Initialize (Realm     : in out Manager;
                         Name      : in String;
                         Return_To : in String);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  (See OpenID Section 7.3 Discovery)
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the authentication result
   procedure Verify_Discovered (Realm   : in out Manager;
                                Assoc   : in Association;
                                Request : in Parameters'Class;
                                Result  : out Authentication);

   --  Verify the signature part of the result
   procedure Verify_Signature (Realm   : in Manager;
                               Assoc   : in Association;
                               Request : in Parameters'Class;
                               Result  : in out Authentication);

   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   procedure Discover_XRDS (Realm  : in out Manager;
                            URI    : in String;
                            Result : out End_Point);

   --  Extract from the XRDS content the OpenID provider URI.
   --  The default implementation is very basic as it returns the first <URI>
   --  available in the stream without validating the XRDS document.
   --  Raises the Invalid_End_Point exception if the URI cannot be found.
   procedure Extract_XRDS (Realm   : in out Manager;
                           Content : in String;
                           Result  : out End_Point);

private

   use Ada.Strings.Unbounded;

   type Association is record
      Session_Type : Unbounded_String;
      Assoc_Type   : Unbounded_String;
      Assoc_Handle : Unbounded_String;
      Mac_Key      : Unbounded_String;
      Expired      : Ada.Calendar.Time;
   end record;

   type Authentication is record
      Status     : Auth_Result;
      Identity   : Unbounded_String;
      Claimed_Id : Unbounded_String;
      Email      : Unbounded_String;
      Full_Name  : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Language   : Unbounded_String;
      Country    : Unbounded_String;
      Gender     : Unbounded_String;
      Timezone   : Unbounded_String;
      Nickname   : Unbounded_String;
   end record;

   type End_Point is record
      URL        : Unbounded_String;
      Alias      : Unbounded_String;
      Expired    : Ada.Calendar.Time;
   end record;

   type Manager is new Ada.Finalization.Limited_Controlled with record
      Realm     : Unbounded_String;
      Return_To : Unbounded_String;
   end record;

   type Principal is new Security.Permissions.Principal with record
      Auth : Authentication;
   end record;

end Security.Openid;

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

with Security.Permissions;

--  == OpenID ==
--  The Security.Openid package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
--
--  The authentication process is the following:
--
--    * The Initialize procedure is called to configure the OpenID realm and set the
--      OpenID return callback CB.
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--    * The Get_Authentication_URL builds the provider OpenID authentication
--      URL for the association.
--    * The application should redirected the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  There are basically two steps that an application must implement.
--
--  == Step 1: creating the authentication URL ==
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenId manager, discover the OpenID provider,
--  associate with us and get an End_Point.
--
--    Mgr   : Openid.Manager;
--    OP    : Openid.End_Point;
--    Assoc : constant Association_Access := new Association;
--
--  The
--
--    Server.Initialize (Mgr);
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  == Step 2: verify the authentication in the callback URL ==
--  The second step is done when the user has finished the authentication successfully or not.
--
--    Mgr     : Openid.Manager;
--    Assoc   : Association_Access := ...;  --  Get the association saved in the session.
--    Auth    : Openid.Authentication;
--    Params  : Auth_Params;
--
--    Server.Initialize (Mgr);
--    Mgr.Verify (Assoc.all, Params, Auth);
--    if Openid.Get_Status (Auth) /= Openid.AUTHENTICATED then ...  -- Failure.
--
--
--
package Security.Openid is

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

   function Get_Parameter (Params : in Parameters;
                           Name   : in String) return String is abstract;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --  The End_Point represents the OpenID provider that will authenticate
   --  the user.
   type End_Point is private;

   function To_String (OP : End_Point) return String;

   --  ------------------------------
   --  Association
   --  ------------------------------
   --  The OpenID association contains the shared secret between the relying party
   --  and the OpenID provider.  The association can be cached and reused to authenticate
   --  different users using the same OpenID provider.  The association also has an
   --  expiration date.
   type Association is private;

   --  Dump the association as a string (for debugging purposes)
   function To_String (Assoc : Association) return String;

   type Auth_Result is (AUTHENTICATED, CANCEL, SETUP_NEEDED, UNKNOWN, INVALID_SIGNATURE);

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --
   type Authentication is private;

   --  Get the email address
   function Get_Email (Auth : in Authentication) return String;

   --  Get the user first name.
   function Get_First_Name (Auth : in Authentication) return String;

   --  Get the user last name.
   function Get_Last_Name (Auth : in Authentication) return String;

   --  Get the user full name.
   function Get_Full_Name (Auth : in Authentication) return String;

   --  Get the user identity.
   function Get_Identity (Auth : in Authentication) return String;

   --  Get the user claimed identity.
   function Get_Claimed_Id (Auth : in Authentication) return String;

   --  Get the user language.
   function Get_Language (Auth : in Authentication) return String;

   --  Get the user country.
   function Get_Country (Auth : in Authentication) return String;

   --  Get the result of the authentication.
   function Get_Status (Auth : in Authentication) return Auth_Result;

   --  ------------------------------
   --  OpenID Default principal
   --  ------------------------------
   type Principal is new Security.Permissions.Principal with private;
   type Principal_Access is access all Principal'Class;

   --  Returns true if the given role is stored in the user principal.
   function Has_Role (User : in Principal;
                      Role : in Permissions.Role_Type) return Boolean;

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

   --  Get the user email address.
   function Get_Email (From : in Principal) return String;

   --  Get the authentication data.
   function Get_Authentication (From : in Principal) return Authentication;

   --  Create a principal with the given authentication results.
   function Create_Principal (Auth : in Authentication) return Principal_Access;

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   type Manager is tagged limited private;

   --  Initialize the OpenID realm.
   procedure Initialize (Realm     : in out Manager;
                         Name      : in String;
                         Return_To : in String);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  (See OpenID Section 7.3 Discovery)
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the authentication result
   procedure Verify_Discovered (Realm   : in out Manager;
                                Assoc   : in Association;
                                Request : in Parameters'Class;
                                Result  : out Authentication);

   --  Verify the signature part of the result
   procedure Verify_Signature (Realm   : in Manager;
                               Assoc   : in Association;
                               Request : in Parameters'Class;
                               Result  : in out Authentication);

   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   procedure Discover_XRDS (Realm  : in out Manager;
                            URI    : in String;
                            Result : out End_Point);

   --  Extract from the XRDS content the OpenID provider URI.
   --  The default implementation is very basic as it returns the first <URI>
   --  available in the stream without validating the XRDS document.
   --  Raises the Invalid_End_Point exception if the URI cannot be found.
   procedure Extract_XRDS (Realm   : in out Manager;
                           Content : in String;
                           Result  : out End_Point);

private

   use Ada.Strings.Unbounded;

   type Association is record
      Session_Type : Unbounded_String;
      Assoc_Type   : Unbounded_String;
      Assoc_Handle : Unbounded_String;
      Mac_Key      : Unbounded_String;
      Expired      : Ada.Calendar.Time;
   end record;

   type Authentication is record
      Status     : Auth_Result;
      Identity   : Unbounded_String;
      Claimed_Id : Unbounded_String;
      Email      : Unbounded_String;
      Full_Name  : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Language   : Unbounded_String;
      Country    : Unbounded_String;
      Gender     : Unbounded_String;
      Timezone   : Unbounded_String;
      Nickname   : Unbounded_String;
   end record;

   type End_Point is record
      URL        : Unbounded_String;
      Alias      : Unbounded_String;
      Expired    : Ada.Calendar.Time;
   end record;

   type Manager is new Ada.Finalization.Limited_Controlled with record
      Realm     : Unbounded_String;
      Return_To : Unbounded_String;
   end record;

   type Principal is new Security.Permissions.Principal with record
      Auth : Authentication;
   end record;

end Security.Openid;

Document the OpenID process

Document the OpenID process


-----------------------------------------------------------------------
--  awa-counters-beans -- Counter bean definition
--  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.
-----------------------------------------------------------------------

package body AWA.Counters.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Counter_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Name);
   begin
      return Util.Beans.Objects.To_Object (From.Value);
   end Get_Value;

end AWA.Counters.Beans;

-----------------------------------------------------------------------
--  awa-counters-beans -- Counter bean definition
--  Copyright (C) 2015, 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.Calendar;
with Util.Dates.ISO8601;
with ADO.Queries.Loaders;
with ADO.Sessions.Entities;
with AWA.Services.Contexts;
package body AWA.Counters.Beans is

   package ASC renames AWA.Services.Contexts;

   function Parse_Date (Date : in String;
                        Now  : in Ada.Calendar.Time) return Ada.Calendar.Time;
   function Get_Query (From : in Counter_Stat_Bean) return ADO.Queries.Query_Definition_Access;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Counter_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Name);
   begin
      return Util.Beans.Objects.To_Object (From.Value);
   end Get_Value;

   overriding
   function Get_Value (List : in Counter_Stat_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "stats" then
         return Util.Beans.Objects.To_Object (Value   => List.Stats_Bean,
                                              Storage => Util.Beans.Objects.STATIC);
      else
         return AWA.Counters.Models.Stat_List_Bean (List).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Counter_Stat_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if not Util.Beans.Objects.Is_Empty (Value) then
         AWA.Counters.Models.Stat_List_Bean (From).Set_Value (Name, Value);
      end if;
   end Set_Value;

   function Get_Query (From : in Counter_Stat_Bean) return ADO.Queries.Query_Definition_Access is
      Name : constant String := Ada.Strings.Unbounded.To_String (From.Query_Name);
   begin
      return ADO.Queries.Loaders.Find_Query (Name);
   end Get_Query;

   function Parse_Date (Date : in String;
                        Now  : in Ada.Calendar.Time) return Ada.Calendar.Time is
      use type Ada.Calendar.Time;

      Day : Natural;
   begin
      if Date'Length = 0 or Date = "now" then
         return Now;
      elsif Date'Length > 5 and then Date (Date'First .. Date'First + 3) = "now-" then
         Day := Natural'Value (Date (Date'First + 4 .. Date'Last));
         return Now - Duration (Day * 86400);
      else
         return Util.Dates.ISO8601.Value (Date);
      end if;
   end Parse_Date;

   --  ------------------------------
   --  Load the statistics information.
   --  ------------------------------
   overriding
   procedure Load (List    : in out Counter_Stat_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
      use type ADO.Identifier;
      use type ADO.Queries.Query_Definition_Access;

      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      User        : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Now         : constant Ada.Calendar.Time := Ada.Calendar.Clock;
      Def         : constant ADO.Queries.Query_Definition_Access := List.Get_Query;
      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (List.Entity_Type);
      Session     : ADO.Sessions.Session := List.Module.Get_Session;
      Kind        : ADO.Entity_Type;
      First_Date  : Ada.Calendar.Time;
      Last_Date   : Ada.Calendar.Time;
      Query       : ADO.Queries.Context;
   begin
      Kind := ADO.Sessions.Entities.Find_Entity_Type (Session, Entity_Type);
      First_Date := Parse_Date (Ada.Strings.Unbounded.To_String (List.First_Date), Now);
      Last_Date := Parse_Date (Ada.Strings.Unbounded.To_String (List.Last_Date), Now);
      if List.Entity_Id /= ADO.NO_IDENTIFIER and Def /= null then
         Query.Set_Query (Def);
         Query.Bind_Param ("entity_type", Kind);
         Query.Bind_Param ("entity_id", List.Entity_Id);
         Query.Bind_Param ("user_id", User);
         Query.Bind_Param ("first_date", First_Date);
         Query.Bind_Param ("last_date", Last_Date);
         Query.Bind_Param ("counter_name", List.Counter_Name);

         AWA.Counters.Models.List (List.Stats, Session, Query);
      end if;
   end Load;

   --  ------------------------------
   --  Create the Blog_Stat_Bean bean instance.
   --  ------------------------------
   function Create_Counter_Stat_Bean (Module : in AWA.Counters.Modules.Counter_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Counter_Stat_Bean_Access := new Counter_Stat_Bean;
   begin
      Object.Module     := Module;
      Object.Stats_Bean := Object.Stats'Access;
      return Object.all'Access;
   end Create_Counter_Stat_Bean;

end AWA.Counters.Beans;

Implement the Get_Value, Set_Value, Load and Create_Counter_Stat_Bean operations


-----------------------------------------------------------------------
--  awa-storages-beans -- Storage Ada Beans
--  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 ADO;
with ADO.Queries;
with ADO.Sessions;
with ADO.Objects;
with ADO.Sessions.Entities;

with AWA.Helpers.Requests;
with AWA.Workspaces.Models;
with AWA.Services.Contexts;
with AWA.Storages.Services;
package body AWA.Storages.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "folderId" then
         return ADO.Objects.To_Object (From.Get_Folder.Get_Key);
      end if;
      return AWA.Storages.Models.Storage_Ref (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
      Manager : constant Services.Storage_Service_Access := From.Module.Get_Storage_Manager;
      Folder  : Models.Storage_Folder_Ref;
   begin
      if Name = "folderId" then
         Manager.Load_Folder (Folder, ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
         From.Set_Folder (Folder);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Save the uploaded file in the storage service.
   --  ------------------------------
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Bean.Set_Name (Part.Get_Name);
      Bean.Set_Mime_Type (Part.Get_Content_Type);
      Bean.Set_File_Size (Part.Get_Size);
      Manager.Save (Bean, Part, AWA.Storages.Models.DATABASE);
   end Save_Part;

   --  ------------------------------
   --  Upload the file.
   --  ------------------------------
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is

   begin
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Upload;

   --  ------------------------------
   --  Delete the file.
   --  @method
   --  ------------------------------
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Delete (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Delete;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return AWA.Storages.Models.Storage_Folder_Ref (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the folder.
   --  ------------------------------
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Save_Folder (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Save;

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return Models.Storage_Info_List_Bean (List).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Create the Folder_List_Bean bean instance.
   --  ------------------------------
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;

      Object  : constant Folder_Info_List_Bean_Access := new Folder_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_Folder_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      AWA.Storages.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Folder_List_Bean;

   --  ------------------------------
   --  Create the Storage_List_Bean bean instance.
   --  ------------------------------
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User      : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Object    : constant Storage_List_Bean_Access := new Storage_List_Bean;
      Session   : ADO.Sessions.Session := Module.Get_Session;
      Query     : ADO.Queries.Context;
      Folder_Id : constant ADO.Identifier := Helpers.Requests.Get_Parameter (FOLDER_ID_PARAMETER);
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      if Folder_Id = ADO.NO_IDENTIFIER then
         Query.Bind_Null_Param ("folder_id");
      else
         Query.Bind_Param ("folder_id", Folder_Id);
      end if;
      AWA.Storages.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Storage_List_Bean;

end AWA.Storages.Beans;

-----------------------------------------------------------------------
--  awa-storages-beans -- Storage Ada Beans
--  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 ADO;
with ADO.Queries;
with ADO.Sessions;
with ADO.Objects;
with ADO.Sessions.Entities;

with AWA.Helpers.Requests;
with AWA.Workspaces.Models;
with AWA.Services.Contexts;
with AWA.Storages.Services;
package body AWA.Storages.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "folderId" then
         return ADO.Objects.To_Object (From.Get_Folder.Get_Key);
      end if;
      return AWA.Storages.Models.Storage_Ref (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
      Manager : constant Services.Storage_Service_Access := From.Module.Get_Storage_Manager;
      Folder  : Models.Storage_Folder_Ref;
   begin
      if Name = "folderId" then
         Manager.Load_Folder (Folder, ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
         From.Set_Folder (Folder);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Save the uploaded file in the storage service.
   --  ------------------------------
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Bean.Set_Name (Part.Get_Name);
      Bean.Set_Mime_Type (Part.Get_Content_Type);
      Bean.Set_File_Size (Part.Get_Size);
      Manager.Save (Bean, Part, AWA.Storages.Models.DATABASE);
   end Save_Part;

   --  ------------------------------
   --  Upload the file.
   --  ------------------------------
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is

   begin
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Upload;

   --  ------------------------------
   --  Delete the file.
   --  @method
   --  ------------------------------
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Delete (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Delete;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if ADO.Objects.Is_Null (From) then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Storages.Models.Storage_Folder_Ref (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the folder.
   --  ------------------------------
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Save_Folder (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Save;

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return Models.Storage_Info_List_Bean (List).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Create the Folder_List_Bean bean instance.
   --  ------------------------------
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;

      Object  : constant Folder_Info_List_Bean_Access := new Folder_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_Folder_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      AWA.Storages.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Folder_List_Bean;

   --  ------------------------------
   --  Create the Storage_List_Bean bean instance.
   --  ------------------------------
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User      : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Object    : constant Storage_List_Bean_Access := new Storage_List_Bean;
      Session   : ADO.Sessions.Session := Module.Get_Session;
      Query     : ADO.Queries.Context;
      Folder_Id : constant ADO.Identifier := Helpers.Requests.Get_Parameter (FOLDER_ID_PARAMETER);
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      if Folder_Id = ADO.NO_IDENTIFIER then
         Query.Bind_Null_Param ("folder_id");
      else
         Query.Bind_Param ("folder_id", Folder_Id);
      end if;
      AWA.Storages.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Storage_List_Bean;

end AWA.Storages.Beans;

Check that the folder instance is not null