-----------------------------------------------------------------------
--  wiki-parsers -- Wiki parser
--  Copyright (C) 2011, 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 Wiki.Attributes;
with Wiki.Plugins;
with Wiki.Filters;
with Wiki.Strings;
with Wiki.Documents;
with Wiki.Streams;

--  === Wiki Parsers ===
--  The Wikis.Parsers package implements a parser for several well known wiki formats
--  but also for HTML.  While reading the input, the parser populates a wiki <tt>Document</tt>
--  instance with headers, paragraphs, links, and other elements.
--
--     Engine : Wiki.Parsers.Parser;
--
--  Before using the parser, it must be configured to choose the syntax by using the
--  <tt>Set_Syntax</tt> procedure:
--
--    Engine.Set_Syntax (Wiki.SYNTAX_HTML);
--
--  The parser can be configured to use filters.  A filter is added by using the
--  <tt>Add_Filter</tt> procedure.  A filter is added at begining of the chain so that
--  the filter added last is called first.  The wiki <tt>Document</tt> is always built through
--  the filter chain so this allows filters to change or alter the content that was parsed.
--
--    Engine.Add_Filter (TOC'Unchecked_Access);
--    Engine.Add_Filter (Filter'Unchecked_Access);
--
--  The <tt>Parse</tt> procedure is then used to parse either a string content or some stream
--  represented by the <tt>Input_Stream</tt> interface.  After the <tt>Parse</tt> procedure
--  completes, the <tt>Document</tt> instance holds the wiki document.
--
--    Engine.Parse (Some_Text, Doc);
--
package Wiki.Parsers is

   pragma Preelaborate;

   type Parser is tagged limited private;

   --  Set the plugin factory to find and use plugins.
   procedure Set_Plugin_Factory (Engine  : in out Parser;
                                 Factory : in Wiki.Plugins.Plugin_Factory_Access);

   --  Set the wiki syntax that the wiki engine must use.
   procedure Set_Syntax (Engine : in out Parser;
                         Syntax : in Wiki_Syntax := SYNTAX_MIX);

   --  Add a filter in the wiki engine.
   procedure Add_Filter (Engine : in out Parser;
                         Filter : in Wiki.Filters.Filter_Type_Access);

   --  Set the plugin context.
   procedure Set_Context (Engine  : in out Parser;
                          Context : in Wiki.Plugins.Plugin_Context);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  defined on the parser.
   procedure Parse (Engine : in out Parser;
                    Text   : in Wiki.Strings.WString;
                    Doc    : in out Wiki.Documents.Document);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  defined on the parser.
   procedure Parse (Engine : in out Parser;
                    Text   : in Wiki.Strings.UString;
                    Doc    : in out Wiki.Documents.Document);

   --  Parse the wiki stream managed by <tt>Stream</tt> according to the wiki syntax configured
   --  on the wiki engine.
   procedure Parse (Engine : in out Parser;
                    Stream : in Wiki.Streams.Input_Stream_Access;
                    Doc    : in out Wiki.Documents.Document);

private

   type Parser_Handler is access procedure (P     : in out Parser;
                                            Token : in Wiki.Strings.WChar);

   type Parser_Table is array (0 .. 127) of Parser_Handler;
   type Parser_Table_Access is access constant Parser_Table;

   type Parser is tagged limited record
      Context             : Wiki.Plugins.Plugin_Context;
      Pending             : Wiki.Strings.WChar;
      Has_Pending         : Boolean;
      Previous_Syntax     : Wiki_Syntax;
      Table               : Parser_Table_Access;
      Document            : Wiki.Documents.Document;
      Format              : Wiki.Format_Map;
      Text                : Wiki.Strings.BString (512);
      Empty_Line          : Boolean := True;
      Is_Eof              : Boolean := False;
      In_Paragraph        : Boolean := False;
      In_List             : Boolean := False;
      Need_Paragraph      : Boolean := True;
      Link_Double_Bracket : Boolean := False;
      Link_No_Space       : Boolean := False;
      Is_Dotclear         : Boolean := False;
      Link_Title_First    : Boolean := False;
      Check_Image_Link    : Boolean := False;
      Is_Hidden           : Boolean := False;
      Header_Offset       : Integer := 0;
      Quote_Level         : Natural := 0;
      Escape_Char         : Wiki.Strings.WChar;
      Param_Char          : Wiki.Strings.WChar;
      List_Level          : Natural := 0;
      Reader              : Wiki.Streams.Input_Stream_Access := null;
      Attributes          : Wiki.Attributes.Attribute_List;
   end record;

   --  Peek the next character from the wiki text buffer.
   procedure Peek (P     : in out Parser;
                   Token : out Wiki.Strings.WChar);

   --  Put back the character so that it will be returned by the next call to Peek.
   procedure Put_Back (P     : in out Parser;
                       Token : in Wiki.Strings.WChar);

   --  Skip all the spaces and tabs as well as end of the current line (CR+LF).
   procedure Skip_End_Of_Line (P : in out Parser);

   --  Skip white spaces and tabs.
   procedure Skip_Spaces (P : in out Parser);

   --  Flush the wiki text that was collected in the text buffer.
   procedure Flush_Text (P : in out Parser);

   --  Flush the wiki dl/dt/dd definition list.
   procedure Flush_List (P : in out Parser);

   --  Append a character to the wiki text buffer.
   procedure Parse_Text (P     : in out Parser;
                         Token : in Wiki.Strings.WChar);

   --  Check if the link refers to an image and must be rendered as an image.
   function Is_Image (P    : in Parser;
                      Link : in Wiki.Strings.WString) return Boolean;

   --  Find the plugin with the given name.
   --  Returns null if there is no such plugin.
   function Find (P    : in Parser;
                  Name : in Wiki.Strings.WString) return Wiki.Plugins.Wiki_Plugin_Access;

   type String_Array is array (Positive range <>) of Wiki.String_Access;

   --  Extract a list of parameters separated by the given separator (ex: '|').
   procedure Parse_Parameters (P          : in out Parser;
                               Separator  : in Wiki.Strings.WChar;
                               Terminator : in Wiki.Strings.WChar;
                               Names      : in String_Array);

   procedure Start_Element (P          : in out Parser;
                            Tag        : in Wiki.Html_Tag;
                            Attributes : in out Wiki.Attributes.Attribute_List);

   procedure End_Element (P    : in out Parser;
                          Tag  : in Wiki.Html_Tag);

   procedure Parse_Token (P     : in out Parser);

end Wiki.Parsers;

-----------------------------------------------------------------------
--  wiki-parsers -- Wiki parser
--  Copyright (C) 2011, 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 Wiki.Attributes;
with Wiki.Plugins;
with Wiki.Filters;
with Wiki.Strings;
with Wiki.Documents;
with Wiki.Streams;

--  === Wiki Parsers ===
--  The Wikis.Parsers package implements a parser for several well known wiki formats
--  but also for HTML.  While reading the input, the parser populates a wiki <tt>Document</tt>
--  instance with headers, paragraphs, links, and other elements.
--
--     Engine : Wiki.Parsers.Parser;
--
--  Before using the parser, it must be configured to choose the syntax by using the
--  <tt>Set_Syntax</tt> procedure:
--
--    Engine.Set_Syntax (Wiki.SYNTAX_HTML);
--
--  The parser can be configured to use filters.  A filter is added by using the
--  <tt>Add_Filter</tt> procedure.  A filter is added at begining of the chain so that
--  the filter added last is called first.  The wiki <tt>Document</tt> is always built through
--  the filter chain so this allows filters to change or alter the content that was parsed.
--
--    Engine.Add_Filter (TOC'Unchecked_Access);
--    Engine.Add_Filter (Filter'Unchecked_Access);
--
--  The <tt>Parse</tt> procedure is then used to parse either a string content or some stream
--  represented by the <tt>Input_Stream</tt> interface.  After the <tt>Parse</tt> procedure
--  completes, the <tt>Document</tt> instance holds the wiki document.
--
--    Engine.Parse (Some_Text, Doc);
--
package Wiki.Parsers is

   pragma Preelaborate;

   type Parser is tagged limited private;

   --  Set the plugin factory to find and use plugins.
   procedure Set_Plugin_Factory (Engine  : in out Parser;
                                 Factory : in Wiki.Plugins.Plugin_Factory_Access);

   --  Set the wiki syntax that the wiki engine must use.
   procedure Set_Syntax (Engine : in out Parser;
                         Syntax : in Wiki_Syntax := SYNTAX_MIX);

   --  Add a filter in the wiki engine.
   procedure Add_Filter (Engine : in out Parser;
                         Filter : in Wiki.Filters.Filter_Type_Access);

   --  Set the plugin context.
   procedure Set_Context (Engine  : in out Parser;
                          Context : in Wiki.Plugins.Plugin_Context);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  defined on the parser.
   procedure Parse (Engine : in out Parser;
                    Text   : in Wiki.Strings.WString;
                    Doc    : in out Wiki.Documents.Document);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  defined on the parser.
   procedure Parse (Engine : in out Parser;
                    Text   : in Wiki.Strings.UString;
                    Doc    : in out Wiki.Documents.Document);

   --  Parse the wiki stream managed by <tt>Stream</tt> according to the wiki syntax configured
   --  on the wiki engine.
   procedure Parse (Engine : in out Parser;
                    Stream : in Wiki.Streams.Input_Stream_Access;
                    Doc    : in out Wiki.Documents.Document);

private

   type Parser_Handler is access procedure (P     : in out Parser;
                                            Token : in Wiki.Strings.WChar);

   type Parser_Table is array (0 .. 127) of Parser_Handler;
   type Parser_Table_Access is access constant Parser_Table;

   type Parser is tagged limited record
      Context             : Wiki.Plugins.Plugin_Context;
      Pending             : Wiki.Strings.WChar;
      Has_Pending         : Boolean;
      Previous_Syntax     : Wiki_Syntax;
      Table               : Parser_Table_Access;
      Document            : Wiki.Documents.Document;
      Format              : Wiki.Format_Map;
      Text                : Wiki.Strings.BString (512);
      Empty_Line          : Boolean := True;
      Is_Eof              : Boolean := False;
      In_Paragraph        : Boolean := False;
      In_List             : Boolean := False;
      Need_Paragraph      : Boolean := True;
      Link_Double_Bracket : Boolean := False;
      Link_No_Space       : Boolean := False;
      Is_Dotclear         : Boolean := False;
      Link_Title_First    : Boolean := False;
      Check_Image_Link    : Boolean := False;
      Is_Hidden           : Boolean := False;
      Header_Offset       : Integer := 0;
      Quote_Level         : Natural := 0;
      Escape_Char         : Wiki.Strings.WChar;
      Param_Char          : Wiki.Strings.WChar;
      List_Level          : Natural := 0;
      Reader              : Wiki.Streams.Input_Stream_Access := null;
      Attributes          : Wiki.Attributes.Attribute_List;
   end record;

   --  Peek the next character from the wiki text buffer.
   procedure Peek (P     : in out Parser;
                   Token : out Wiki.Strings.WChar);

   --  Put back the character so that it will be returned by the next call to Peek.
   procedure Put_Back (P     : in out Parser;
                       Token : in Wiki.Strings.WChar);

   --  Skip all the spaces and tabs as well as end of the current line (CR+LF).
   procedure Skip_End_Of_Line (P : in out Parser);

   --  Skip white spaces and tabs.
   procedure Skip_Spaces (P : in out Parser);

   --  Flush the wiki text that was collected in the text buffer.
   procedure Flush_Text (P : in out Parser);

   --  Flush the wiki dl/dt/dd definition list.
   procedure Flush_List (P : in out Parser);

   --  Append a character to the wiki text buffer.
   procedure Parse_Text (P     : in out Parser;
                         Token : in Wiki.Strings.WChar);

   --  Check if the link refers to an image and must be rendered as an image.
   function Is_Image (P    : in Parser;
                      Link : in Wiki.Strings.WString) return Boolean;

   --  Find the plugin with the given name.
   --  Returns null if there is no such plugin.
   function Find (P    : in Parser;
                  Name : in Wiki.Strings.WString) return Wiki.Plugins.Wiki_Plugin_Access;

   type String_Array is array (Positive range <>) of Wiki.String_Access;

   --  Extract a list of parameters separated by the given separator (ex: '|').
   procedure Parse_Parameters (P          : in out Parser;
                               Separator  : in Wiki.Strings.WChar;
                               Terminator : in Wiki.Strings.WChar;
                               Names      : in String_Array;
                               Max        : in Positive := 200);

   procedure Start_Element (P          : in out Parser;
                            Tag        : in Wiki.Html_Tag;
                            Attributes : in out Wiki.Attributes.Attribute_List);

   procedure End_Element (P    : in out Parser;
                          Tag  : in Wiki.Html_Tag);

   procedure Parse_Token (P     : in out Parser);

end Wiki.Parsers;

Add a Max parameter to the Parse_Parameters procedure


-----------------------------------------------------------------------
--  awa-mail-clients-files -- Mail client dump/file implementation
--  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 Ada.Strings.Unbounded;

with Util.Properties;
with Util.Concurrent.Counters;

--  The AWA.Mail.Clients.Files package provides a dump implementation of the
--  mail client interfaces on top of raw system files.
package AWA.Mail.Clients.Files is

   NAME : constant String := "file";

   --  ------------------------------
   --  Mail Message
   --  ------------------------------
   --  The File_Mail_Message represents a mail message that is written on a file in
   --  in specific directory.
   type File_Mail_Message is new Mail_Message with private;
   type File_Mail_Message_Access is access all File_Mail_Message'Class;

   --  Set the <tt>From</tt> part of the message.
   overriding
   procedure Set_From (Message : in out File_Mail_Message;
                       Name    : in String;
                       Address : in String);

   --  Add a recipient for the message.
   overriding
   procedure Add_Recipient (Message : in out File_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String);

   --  Set the subject of the message.
   overriding
   procedure Set_Subject (Message : in out File_Mail_Message;
                          Subject : in String);

   --  Set the body of the message.
   overriding
   procedure Set_Body (Message : in out File_Mail_Message;
                       Content : in String);

   --  Send the email message.
   overriding
   procedure Send (Message : in out File_Mail_Message);

   --  ------------------------------
   --  Mail Manager
   --  ------------------------------
   --  The Mail_Manager is the entry point to create a new mail message
   --  and be able to send it.
   type File_Mail_Manager is new Mail_Manager with private;
   type File_Mail_Manager_Access is access all File_Mail_Manager'Class;

   --  Create a file based mail manager and configure it according to the properties.
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access;

   --  Create a new mail message.
   overriding
   function Create_Message (Manager : in File_Mail_Manager) return Mail_Message_Access;

private

   type File_Mail_Message is new Mail_Message with record
      Manager : File_Mail_Manager_Access;
      From    : Ada.Strings.Unbounded.Unbounded_String;
      To      : Ada.Strings.Unbounded.Unbounded_String;
      Cc      : Ada.Strings.Unbounded.Unbounded_String;
      Bcc     : Ada.Strings.Unbounded.Unbounded_String;
      Subject : Ada.Strings.Unbounded.Unbounded_String;
      Message : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type File_Mail_Manager is new Mail_Manager with record
      Self    : File_Mail_Manager_Access;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Index   : Util.Concurrent.Counters.Counter;
   end record;

end AWA.Mail.Clients.Files;

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

with Ada.Strings.Unbounded;

with Util.Properties;
with Util.Concurrent.Counters;

--  The AWA.Mail.Clients.Files package provides a dump implementation of the
--  mail client interfaces on top of raw system files.
package AWA.Mail.Clients.Files is

   NAME : constant String := "file";

   --  ------------------------------
   --  Mail Message
   --  ------------------------------
   --  The File_Mail_Message represents a mail message that is written on a file in
   --  in specific directory.
   type File_Mail_Message is new Mail_Message with private;
   type File_Mail_Message_Access is access all File_Mail_Message'Class;

   --  Set the <tt>From</tt> part of the message.
   overriding
   procedure Set_From (Message : in out File_Mail_Message;
                       Name    : in String;
                       Address : in String);

   --  Add a recipient for the message.
   overriding
   procedure Add_Recipient (Message : in out File_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String);

   --  Set the subject of the message.
   overriding
   procedure Set_Subject (Message : in out File_Mail_Message;
                          Subject : in String);

   --  Set the body of the message.
   overriding
   procedure Set_Body (Message : in out File_Mail_Message;
                       Content : in String);

   --  Send the email message.
   overriding
   procedure Send (Message : in out File_Mail_Message);

   --  ------------------------------
   --  Mail Manager
   --  ------------------------------
   --  The Mail_Manager is the entry point to create a new mail message
   --  and be able to send it.
   type File_Mail_Manager is limited new Mail_Manager with private;
   type File_Mail_Manager_Access is access all File_Mail_Manager'Class;

   --  Create a file based mail manager and configure it according to the properties.
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access;

   --  Create a new mail message.
   overriding
   function Create_Message (Manager : in File_Mail_Manager) return Mail_Message_Access;

private

   type File_Mail_Message is new Mail_Message with record
      Manager : File_Mail_Manager_Access;
      From    : Ada.Strings.Unbounded.Unbounded_String;
      To      : Ada.Strings.Unbounded.Unbounded_String;
      Cc      : Ada.Strings.Unbounded.Unbounded_String;
      Bcc     : Ada.Strings.Unbounded.Unbounded_String;
      Subject : Ada.Strings.Unbounded.Unbounded_String;
      Message : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type File_Mail_Manager is limited new Mail_Manager with record
      Self    : File_Mail_Manager_Access;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Index   : Util.Concurrent.Counters.Counter;
   end record;

end AWA.Mail.Clients.Files;

Make the File_Mail_Manager type a limited type


-----------------------------------------------------------------------
--  util-system-os -- Windows system operations
--  Copyright (C) 2011, 2012, 2015, 2018, 2019 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.Characters.Conversions;
package body Util.Systems.Os is

   use type Interfaces.Unsigned_32;
   use type Interfaces.Unsigned_64;
   use type Interfaces.C.size_t;

   function To_WSTR (Value : in String) return Wchar_Ptr is
      Result : constant Wchar_Ptr := new Interfaces.C.wchar_array (0 .. Value'Length + 1);
      Pos    : Interfaces.C.size_t := 0;
   begin
      for C of Value loop
         Result (Pos)
           := Interfaces.C.To_C (Ada.Characters.Conversions.To_Wide_Character (C));
         Pos := Pos + 1;
      end loop;
      Result (Pos) := Interfaces.C.wide_nul;
      return Result;
   end To_WSTR;

   function Sys_SetFilePointerEx (Fs : in File_Type;
                                  Offset : in Util.Systems.Types.off_t;
                                  Result : access Util.Systems.Types.off_t;
                                  Mode   : in Util.Systems.Types.Seek_Mode) return BOOL
     with Import => True, Convention => Stdcall, Link_Name => "SetFilePointerEx";

   function Sys_Lseek (Fs : in File_Type;
                       Offset : in Util.Systems.Types.off_t;
                       Mode   : in Util.Systems.Types.Seek_Mode)
                       return Util.Systems.Types.off_t is
      Result : aliased Util.Systems.Types.off_t;
   begin
      if Sys_SetFilePointerEx (Fs, Offset, Result'Access, Mode) /= 0 then
         return Result;
      else
         return -1;
      end if;
   end Sys_Lseek;

   function Sys_GetFileSizeEx (Fs : in File_Type;
                               Result : access Util.Systems.Types.off_t) return BOOL
     with Import => True, Convention => Stdcall, Link_Name => "GetFileSizeEx";

   function Sys_GetFileTime (Fs : in File_Type;
                             Create     : access FileTime;
                             AccessTime : access FileTime;
                             ModifyTime : access FileTime) return BOOL
     with Import => True, Convention => Stdcall, Link_Name => "GetFileTime";

   TICKS_PER_SECOND : constant := 10000000;
   EPOCH_DIFFERENCE : constant := 11644473600;

   function To_Time (Time : in FileTime) return Types.Time_Type is
      Value : Interfaces.Unsigned_64;
   begin
      Value := Interfaces.Shift_Left (Interfaces.Unsigned_64 (Time.dwHighDateTime), 32);
      Value := Value + Interfaces.Unsigned_64 (Time.dwLowDateTime);
      Value := Value / TICKS_PER_SECOND;
      Value := Value - EPOCH_DIFFERENCE;
      return Types.Time_Type (Value);
   end To_Time;

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer is
      Size          : aliased Util.Systems.Types.off_t;
      Creation_Time : aliased FileTime;
      Access_Time   : aliased FileTime;
      Write_Time    : aliased FileTime;
   begin
      Stat.st_dev := 0;
      Stat.st_ino := 0;
      Stat.st_mode := 0;
      Stat.st_nlink := 0;
      Stat.st_uid := 0;
      Stat.st_gid := 0;
      Stat.st_rdev := 0;
      Stat.st_atime := 0;
      Stat.st_mtime := 0;
      Stat.st_ctime := 0;
      if Sys_GetFileSizeEx (Fs, Size'Access) = 0 then
         return -1;
      end if;
      if Sys_GetFileTime (Fs, Creation_Time'Access, Access_Time'Access, Write_Time'Access) = 0 then
         return -1;
      end if;
      Stat.st_size := Size;
      Stat.st_ctime := To_Time (Creation_Time);
      Stat.st_mtime := To_Time (Write_Time);
      Stat.st_atime := To_Time (Access_Time);
      return 0;
   end Sys_Fstat;

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Util.Systems.Types.mode_t) return File_Type is
      pragma Unreferenced (Mode);

      function Has_Flag (M : in Interfaces.C.int;
                         F : in Interfaces.C.int) return Boolean
        is ((Interfaces.Unsigned_32 (M) and Interfaces.Unsigned_32 (F)) /= 0);

      Sec            : aliased Security_Attributes;
      Result         : File_Type;
      Desired_Access : DWORD;
      Share_Mode     : DWORD := FILE_SHARE_READ + FILE_SHARE_WRITE;
      Creation       : DWORD;
      WPath          : Wchar_Ptr;
   begin
      WPath := To_WSTR (Interfaces.C.Strings.Value (Path));
      Sec.Length := Security_Attributes'Size / 8;
      Sec.Security_Descriptor := System.Null_Address;
      Sec.Inherit := True;

      if Has_Flag (Flags, O_WRONLY) then
         Desired_Access := GENERIC_WRITE;
      elsif Has_Flag (Flags, O_RDWR) then
         Desired_Access := GENERIC_READ + GENERIC_WRITE;
      else
         Desired_Access := GENERIC_READ;
      end if;
      if Has_Flag (Flags, O_CREAT) then
         if Has_Flag (Flags, O_EXCL) then
            Creation := CREATE_NEW;
         else
            Creation := CREATE_ALWAYS;
         end if;
      else
         Creation := OPEN_EXISTING;
      end if;
      if Has_Flag (Flags, O_APPEND) then
         Desired_Access := FILE_APPEND_DATA;
      end if;
      if Has_Flag (Flags, O_EXCL) then
         Share_Mode := 0;
      end if;
      Result := Create_File (WPath.all'Address,
                             Desired_Access,
                             Share_Mode,
                             Sec'Unchecked_Access,
                             Creation,
                             FILE_ATTRIBUTE_NORMAL,
                             NO_FILE);

      Free (WPath);
      return Result;
   end Sys_Open;

   function Sys_SetEndOfFile (Fs : in File_Type) return BOOL
     with Import => True, Convention => Stdcall, Link_Name => "SetEndOfFile";

   function Sys_Ftruncate (Fs : in File_Type;
                           Length : in Util.Systems.Types.off_t) return Integer is
   begin
      if Sys_Lseek (Fs, Length, Util.Systems.Types.SEEK_SET) < 0 then
         return -1;
      end if;
      if Sys_SetEndOfFile (Fs) = 0 then
         return -1;
      end if;
      return 0;
   end Sys_Ftruncate;

   function Sys_Fchmod (Fd   : in File_Type;
                        Mode : in Util.Systems.Types.mode_t) return Integer is
      pragma Unreferenced (Fd, Mode);
   begin
      return 0;
   end Sys_Fchmod;

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer is
   begin
      if Close_Handle (Fd) = 0 then
         return -1;
      else
         return 0;
      end if;
   end Sys_Close;

end Util.Systems.Os;

-----------------------------------------------------------------------
--  util-system-os -- Windows system operations
--  Copyright (C) 2011, 2012, 2015, 2018, 2019 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.Characters.Conversions;
package body Util.Systems.Os is

   use type Interfaces.Unsigned_32;
   use type Interfaces.Unsigned_64;
   use type Interfaces.C.size_t;

   function To_WSTR (Value : in String) return Wchar_Ptr is
      Result : constant Wchar_Ptr := new Interfaces.C.wchar_array (0 .. Value'Length + 1);
      Pos    : Interfaces.C.size_t := 0;
   begin
      for C of Value loop
         Result (Pos)
           := Interfaces.C.To_C (Ada.Characters.Conversions.To_Wide_Character (C));
         Pos := Pos + 1;
      end loop;
      Result (Pos) := Interfaces.C.wide_nul;
      return Result;
   end To_WSTR;

   function Sys_SetFilePointerEx (Fs : in File_Type;
                                  Offset : in Util.Systems.Types.off_t;
                                  Result : access Util.Systems.Types.off_t;
                                  Mode   : in Util.Systems.Types.Seek_Mode) return BOOL
     with Import => True, Convention => Stdcall, Link_Name => "SetFilePointerEx";

   function Sys_Lseek (Fs : in File_Type;
                       Offset : in Util.Systems.Types.off_t;
                       Mode   : in Util.Systems.Types.Seek_Mode)
                       return Util.Systems.Types.off_t is
      Result : aliased Util.Systems.Types.off_t;
   begin
      if Sys_SetFilePointerEx (Fs, Offset, Result'Access, Mode) /= 0 then
         return Result;
      else
         return -1;
      end if;
   end Sys_Lseek;

   function Sys_GetFileSizeEx (Fs : in File_Type;
                               Result : access Util.Systems.Types.off_t) return BOOL
     with Import => True, Convention => Stdcall, Link_Name => "GetFileSizeEx";

   function Sys_GetFileTime (Fs : in File_Type;
                             Create     : access FileTime;
                             AccessTime : access FileTime;
                             ModifyTime : access FileTime) return BOOL
     with Import => True, Convention => Stdcall, Link_Name => "GetFileTime";

   TICKS_PER_SECOND : constant := 10000000;
   EPOCH_DIFFERENCE : constant := 11644473600;

   function To_Time (Time : in FileTime) return Types.Time_Type is
      Value : Interfaces.Unsigned_64;
   begin
      Value := Interfaces.Shift_Left (Interfaces.Unsigned_64 (Time.dwHighDateTime), 32);
      Value := Value + Interfaces.Unsigned_64 (Time.dwLowDateTime);
      Value := Value / TICKS_PER_SECOND;
      Value := Value - EPOCH_DIFFERENCE;
      return Types.Time_Type (Value);
   end To_Time;

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer is
      Size          : aliased Util.Systems.Types.off_t;
      Creation_Time : aliased FileTime;
      Access_Time   : aliased FileTime;
      Write_Time    : aliased FileTime;
   begin
      Stat.st_dev := 0;
      Stat.st_ino := 0;
      Stat.st_mode := 0;
      Stat.st_nlink := 0;
      Stat.st_uid := 0;
      Stat.st_gid := 0;
      Stat.st_rdev := 0;
      Stat.st_atime := 0;
      Stat.st_mtime := 0;
      Stat.st_ctime := 0;
      if Sys_GetFileSizeEx (Fs, Size'Access) = 0 then
         return -1;
      end if;
      if Sys_GetFileTime (Fs, Creation_Time'Access, Access_Time'Access, Write_Time'Access) = 0 then
         return -1;
      end if;
      Stat.st_size := Size;
      Stat.st_ctime := To_Time (Creation_Time);
      Stat.st_mtime := To_Time (Write_Time);
      Stat.st_atime := To_Time (Access_Time);
      return 0;
   end Sys_Fstat;

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Util.Systems.Types.mode_t) return File_Type is
      pragma Unreferenced (Mode);

      function Has_Flag (M : in Interfaces.C.int;
                         F : in Interfaces.C.int) return Boolean
        is ((Interfaces.Unsigned_32 (M) and Interfaces.Unsigned_32 (F)) /= 0);

      Sec            : aliased Security_Attributes;
      Result         : File_Type;
      Desired_Access : DWORD;
      Share_Mode     : DWORD := FILE_SHARE_READ + FILE_SHARE_WRITE;
      Creation       : DWORD;
      WPath          : Wchar_Ptr;
   begin
      WPath := To_WSTR (Interfaces.C.Strings.Value (Path));
      Sec.Length := Security_Attributes'Size / 8;
      Sec.Security_Descriptor := System.Null_Address;
      Sec.Inherit := True;

      if Has_Flag (Flags, O_WRONLY) then
         Desired_Access := GENERIC_WRITE;
      elsif Has_Flag (Flags, O_RDWR) then
         Desired_Access := GENERIC_READ + GENERIC_WRITE;
      else
         Desired_Access := GENERIC_READ;
      end if;
      if Has_Flag (Flags, O_CREAT) then
         if Has_Flag (Flags, O_EXCL) then
            Creation := CREATE_NEW;
         else
            Creation := CREATE_ALWAYS;
         end if;
      else
         Creation := OPEN_EXISTING;
      end if;
      if Has_Flag (Flags, O_APPEND) then
         Desired_Access := FILE_APPEND_DATA;
      end if;
      if Has_Flag (Flags, O_EXCL) then
         Share_Mode := 0;
      end if;
      Result := Create_File (WPath.all'Address,
                             Desired_Access,
                             Share_Mode,
                             Sec'Unchecked_Access,
                             Creation,
                             FILE_ATTRIBUTE_NORMAL,
                             NO_FILE);

      Free (WPath);
      return (if Result = INVALID_HANDLE_VALUE then NO_FILE else Result);
   end Sys_Open;

   function Sys_SetEndOfFile (Fs : in File_Type) return BOOL
     with Import => True, Convention => Stdcall, Link_Name => "SetEndOfFile";

   function Sys_Ftruncate (Fs : in File_Type;
                           Length : in Util.Systems.Types.off_t) return Integer is
   begin
      if Sys_Lseek (Fs, Length, Util.Systems.Types.SEEK_SET) < 0 then
         return -1;
      end if;
      if Sys_SetEndOfFile (Fs) = 0 then
         return -1;
      end if;
      return 0;
   end Sys_Ftruncate;

   function Sys_Fchmod (Fd   : in File_Type;
                        Mode : in Util.Systems.Types.mode_t) return Integer is
      pragma Unreferenced (Fd, Mode);
   begin
      return 0;
   end Sys_Fchmod;

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer is
   begin
      if Close_Handle (Fd) = 0 then
         return -1;
      else
         return 0;
      end if;
   end Sys_Close;

end Util.Systems.Os;

Fix Sys_Open to return NO_FILE if we fail to open/create the file


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

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

with ADO;
with ADO.Objects;

with Security.Contexts;

with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Votes.Modules;
with AWA.Tests.Helpers.Users;
package body AWA.Votes.Modules.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Votes.Services");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Votes.Services.Vote_Up",
                       Test_Vote_Up'Access);
    end Add_Tests;

   --  ------------------------------
   --  Test creation of a question.
   --  ------------------------------
   procedure Test_Vote_Up (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      declare
         Vote_Manager : Vote_Module_Access := Get_Vote_Module;
         User         : AWA.Users.Models.User_Ref := Context.Get_User;
         Total        : Integer;
      begin
         T.Assert (Vote_Manager /= null, "There is no vote module");

         Vote_Manager.Vote_For (User.Get_Id, "awa_user", "workspaces-create", 1, Total);
         Vote_Manager.Vote_For (User.Get_Id, "awa_user", "workspaces-create", 2, Total);
      end;
  end Test_Vote_Up;

end AWA.Votes.Modules.Tests;

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

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

with ADO;
with ADO.Objects;

with Security.Contexts;

with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Votes.Modules;
with AWA.Tests.Helpers.Users;
package body AWA.Votes.Modules.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Votes.Services");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Votes.Modules.Vote_For",
                       Test_Vote_Up'Access);
      Caller.Add_Test (Suite, "Test AWA.Votes.Modules.Vote_For (Undo)",
                       Test_Vote_Undo'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a question.
   --  ------------------------------
   procedure Test_Vote_Up (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      declare
         Vote_Manager : Vote_Module_Access := Get_Vote_Module;
         User         : AWA.Users.Models.User_Ref := Context.Get_User;
         Total        : Integer;
      begin
         T.Assert (Vote_Manager /= null, "There is no vote module");

         Vote_Manager.Vote_For (User.Get_Id, "awa_user", "workspaces-create", 1, Total);
         Vote_Manager.Vote_For (User.Get_Id, "awa_user", "workspaces-create", 2, Total);
      end;
  end Test_Vote_Up;

   --  ------------------------------
   --  Test vote.
   --  ------------------------------
   procedure Test_Vote_Undo (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-vote@test.com");

      declare
         Vote_Manager : Vote_Module_Access := Get_Vote_Module;
         User         : AWA.Users.Models.User_Ref := Context.Get_User;
         Total        : Integer;
      begin
         T.Assert (Vote_Manager /= null, "There is no vote module");

         Vote_Manager.Vote_For (User.Get_Id, "awa_user", "workspaces-create", 1, Total);
         Vote_Manager.Vote_For (User.Get_Id, "awa_user", "workspaces-create", 2, Total);
         Vote_Manager.Vote_For (User.Get_Id, "awa_user", "workspaces-create", 0, Total);
      end;
   end Test_Vote_Undo;

end AWA.Votes.Modules.Tests;

Add unit test for undo vote

Add unit test for undo vote


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

with ADO.Sessions;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end AWA.Images.Modules;

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

with ADO.Sessions;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end AWA.Images.Modules;

Create the Image database instance and scheduler the image thumbnail job only for files that don't have any thumbnail yet


-----------------------------------------------------------------------
--  awa-mail-clients-aws_smtp -- Mail client implementation on top of AWS SMTP client
--  Copyright (C) 2012, 2016, 2017, 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 Ada.Unchecked_Deallocation;

with AWS.SMTP.Client;

with Util.Log.Loggers;

package body AWA.Mail.Clients.AWS_SMTP is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Mail.Clients.AWS_SMTP");

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => AWS.SMTP.Recipients,
                                      Name   => Recipients_Access);

   --  Get a printable representation of the email recipients.
   function Image (Recipients : in AWS.SMTP.Recipients) return String;

   --  ------------------------------
   --  Set the <tt>From</tt> part of the message.
   --  ------------------------------
   overriding
   procedure Set_From (Message : in out AWS_Mail_Message;
                       Name    : in String;
                       Address : in String) is
   begin
      Message.From := AWS.SMTP.E_Mail (Name    => Name,
                                       Address => Address);
   end Set_From;

   --  ------------------------------
   --  Add a recipient for the message.
   --  ------------------------------
   overriding
   procedure Add_Recipient (Message : in out AWS_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String) is
      pragma Unreferenced (Kind);
   begin
      if Message.To = null then
         Message.To := new AWS.SMTP.Recipients (1 .. 1);
      else
         declare
            To : constant Recipients_Access := new AWS.SMTP.Recipients (1 .. Message.To'Last + 1);
         begin
            To (Message.To'Range) := Message.To.all;
            Free (Message.To);
            Message.To := To;
         end;
      end if;
      Message.To (Message.To'Last) := AWS.SMTP.E_Mail (Name    => Name,
                                                       Address => Address);
   end Add_Recipient;

   --  ------------------------------
   --  Set the subject of the message.
   --  ------------------------------
   overriding
   procedure Set_Subject (Message : in out AWS_Mail_Message;
                          Subject : in String) is
   begin
      Message.Subject := To_Unbounded_String (Subject);
   end Set_Subject;

   --  ------------------------------
   --  Set the body of the message.
   --  ------------------------------
   overriding
   procedure Set_Body (Message      : in out AWS_Mail_Message;
                       Content      : in Unbounded_String;
                       Alternative  : in Unbounded_String;
                       Content_Type : in String) is
   begin
      if Length (Alternative) = 0 then
         AWS.Attachments.Add (Message.Attachments, "",
                              AWS.Attachments.Value (To_String (Content)));
      else
         declare
            Parts : AWS.Attachments.Alternatives;
         begin
            AWS.Attachments.Add (Parts,
                                 AWS.Attachments.Value (To_String (Content),
                                                        Content_Type => Content_Type));
            AWS.Attachments.Add (Parts,
                                 AWS.Attachments.Value (To_String (Alternative),
                                                        Content_Type => "text/plain"));
            AWS.Attachments.Add (Message.Attachments, Parts);
         end;
      end if;
   end Set_Body;

   --  ------------------------------
   --  Add an attachment with the given content.
   --  ------------------------------
   overriding
   procedure Add_Attachment (Message      : in out AWS_Mail_Message;
                             Content      : in Unbounded_String;
                             Content_Id   : in String;
                             Content_Type : in String) is
      Data : constant AWS.Attachments.Content
        := AWS.Attachments.Value (Data => To_String (Content),
                                  Content_Id => Content_Id,
                                  Content_Type => Content_Type);
   begin
      AWS.Attachments.Add (Attachments => Message.Attachments,
                           Name => Content_Id,
                           Data => Data);
   end Add_Attachment;

   --  ------------------------------
   --  Get a printable representation of the email recipients.
   --  ------------------------------
   function Image (Recipients : in AWS.SMTP.Recipients) return String is
      Result : Unbounded_String;
   begin
      for I in Recipients'Range loop
         Append (Result, AWS.SMTP.Image (Recipients (I)));
      end loop;
      return To_String (Result);
   end Image;

   --  ------------------------------
   --  Send the email message.
   --  ------------------------------
   overriding
   procedure Send (Message : in out AWS_Mail_Message) is
      Result   : AWS.SMTP.Status;
   begin
      if Message.To = null then
         return;
      end if;

      if Message.Manager.Enable then
         Log.Info ("Send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To.all));

         AWS.SMTP.Client.Send (Server  => Message.Manager.Server,
                               From    => Message.From,
                               To      => Message.To.all,
                               Subject => To_String (Message.Subject),
                               Attachments => Message.Attachments,
                               Status  => Result);
         if not AWS.SMTP.Is_Ok (Result) then
            Log.Error ("Cannot send email: {0}",
                       AWS.SMTP.Status_Message (Result));
         end if;

      else
         Log.Info ("Disable send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To.all));
      end if;
   end Send;

   --  ------------------------------
   --  Deletes the mail message.
   --  ------------------------------
   overriding
   procedure Finalize (Message : in out AWS_Mail_Message) is
   begin
      Log.Info ("Finalize mail message");
      Free (Message.To);
   end Finalize;

   procedure Initialize (Client : in out AWS_Mail_Manager'Class;
                         Props  : in Util.Properties.Manager'Class) is separate;

   --  ------------------------------
   --  Create a SMTP based mail manager and configure it according to the properties.
   --  ------------------------------
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access is
      Server : constant String := Props.Get (Name => "smtp.host", Default => "localhost");
      Port   : constant String := Props.Get (Name => "smtp.port", Default => "25");
      Enable : constant String := Props.Get (Name => "smtp.enable", Default => "1");
      Result : constant AWS_Mail_Manager_Access := new AWS_Mail_Manager;
   begin
      Log.Info ("Creating SMTP mail manager to server {0}:{1}", Server, Port);

      Result.Port   := Positive'Value (Port);
      Result.Enable := Enable = "1" or Enable = "yes" or Enable = "true";
      Result.Self   := Result;
      Initialize (Result.all, Props);
      return Result.all'Access;
   end Create_Manager;

   --  ------------------------------
   --  Create a new mail message.
   --  ------------------------------
   overriding
   function Create_Message (Manager : in AWS_Mail_Manager) return Mail_Message_Access is
      Result : constant AWS_Mail_Message_Access := new AWS_Mail_Message;
   begin
      Result.Manager := Manager.Self;
      return Result.all'Access;
   end Create_Message;

end AWA.Mail.Clients.AWS_SMTP;

-----------------------------------------------------------------------
--  awa-mail-clients-aws_smtp -- Mail client implementation on top of AWS SMTP client
--  Copyright (C) 2012, 2016, 2017, 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 Ada.Unchecked_Deallocation;

with AWS.SMTP.Client;

with Util.Log.Loggers;

package body AWA.Mail.Clients.AWS_SMTP is

   use AWS.SMTP;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Mail.Clients.AWS_SMTP");

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => AWS.SMTP.Recipients,
                                      Name   => Recipients_Access);

   --  Get a printable representation of the email recipients.
   function Image (Recipients : in Recipients_Access) return String;

   --  ------------------------------
   --  Set the <tt>From</tt> part of the message.
   --  ------------------------------
   overriding
   procedure Set_From (Message : in out AWS_Mail_Message;
                       Name    : in String;
                       Address : in String) is
   begin
      Message.From := AWS.SMTP.E_Mail (Name    => Name,
                                       Address => Address);
   end Set_From;

   --  ------------------------------
   --  Add a recipient for the message.
   --  ------------------------------
   overriding
   procedure Add_Recipient (Message : in out AWS_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String) is
      List : Recipients_Access := Message.To (Kind);
   begin
      if List = null then
         List := new AWS.SMTP.Recipients (1 .. 1);
      else
         declare
            To : constant Recipients_Access := new AWS.SMTP.Recipients (1 .. List'Last + 1);
         begin
            List (List'Range) := List.all;
            Free (List);
            List := To;
         end;
      end if;
      List (List'Last) := AWS.SMTP.E_Mail (Name    => Name,
                                           Address => Address);
      Message.To (Kind) := List;
   end Add_Recipient;

   --  ------------------------------
   --  Set the subject of the message.
   --  ------------------------------
   overriding
   procedure Set_Subject (Message : in out AWS_Mail_Message;
                          Subject : in String) is
   begin
      Message.Subject := To_Unbounded_String (Subject);
   end Set_Subject;

   --  ------------------------------
   --  Set the body of the message.
   --  ------------------------------
   overriding
   procedure Set_Body (Message      : in out AWS_Mail_Message;
                       Content      : in Unbounded_String;
                       Alternative  : in Unbounded_String;
                       Content_Type : in String) is
   begin
      if Length (Alternative) = 0 then
         AWS.Attachments.Add (Message.Attachments, "",
                              AWS.Attachments.Value (To_String (Content)));
      else
         declare
            Parts : AWS.Attachments.Alternatives;
         begin
            AWS.Attachments.Add
              (Parts,
               AWS.Attachments.Value (To_String (Content),
                                      Content_Type => Content_Type));
            AWS.Attachments.Add
              (Parts,
               AWS.Attachments.Value (To_String (Alternative),
                                      Content_Type => "text/plain; charset=UTF-8"));
            AWS.Attachments.Add
              (Message.Attachments, Parts);
         end;
      end if;
   end Set_Body;

   --  ------------------------------
   --  Add an attachment with the given content.
   --  ------------------------------
   overriding
   procedure Add_Attachment (Message      : in out AWS_Mail_Message;
                             Content      : in Unbounded_String;
                             Content_Id   : in String;
                             Content_Type : in String) is
      Data : constant AWS.Attachments.Content
        := AWS.Attachments.Value (Data => To_String (Content),
                                  Content_Id => Content_Id,
                                  Content_Type => Content_Type);
   begin
      AWS.Attachments.Add (Attachments => Message.Attachments,
                           Name => Content_Id,
                           Data => Data);
   end Add_Attachment;

   --  ------------------------------
   --  Get a printable representation of the email recipients.
   --  ------------------------------
   function Image (Recipients : in Recipients_Access) return String is
      Result : Unbounded_String;
   begin
      if Recipients /= null then
         for I in Recipients'Range loop
            Append (Result, AWS.SMTP.Image (Recipients (I)));
         end loop;
      end if;
      return To_String (Result);
   end Image;

   --  ------------------------------
   --  Send the email message.
   --  ------------------------------
   overriding
   procedure Send (Message : in out AWS_Mail_Message) is
      Result   : AWS.SMTP.Status;
   begin
      if (for all Recipient of Message.To => Recipient = null) then
         return;
      end if;

      if Message.Manager.Enable then
         Log.Info ("Send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To (Clients.TO)));

         AWS.SMTP.Client.Send
           (Server  => Message.Manager.Server,
            From    => Message.From,
            To      => (if Message.To (Clients.TO) /= null then Message.To (Clients.TO).all else No_Recipient),
            CC      => (if Message.To (Clients.CC) /= null then Message.To (Clients.CC).all else No_Recipient),
            BCC     => (if Message.To (Clients.BCC) /= null then Message.To (Clients.BCC).all else No_Recipient),
            Subject => To_String (Message.Subject),
            Attachments => Message.Attachments,
            Status  => Result);
         if not AWS.SMTP.Is_Ok (Result) then
            Log.Error ("Cannot send email: {0}",
                       AWS.SMTP.Status_Message (Result));
         end if;

      else
         Log.Info ("Disable send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To (Clients.TO)));
      end if;
   end Send;

   --  ------------------------------
   --  Deletes the mail message.
   --  ------------------------------
   overriding
   procedure Finalize (Message : in out AWS_Mail_Message) is
   begin
      Log.Info ("Finalize mail message");
      Free (Message.To (AWA.Mail.Clients.TO));
      Free (Message.To (AWA.Mail.Clients.CC));
      Free (Message.To (AWA.Mail.Clients.BCC));
   end Finalize;

   procedure Initialize (Client : in out AWS_Mail_Manager'Class;
                         Props  : in Util.Properties.Manager'Class) is separate;

   --  ------------------------------
   --  Create a SMTP based mail manager and configure it according to the properties.
   --  ------------------------------
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access is
      Server : constant String := Props.Get (Name => "smtp.host", Default => "localhost");
      Port   : constant String := Props.Get (Name => "smtp.port", Default => "25");
      Enable : constant String := Props.Get (Name => "smtp.enable", Default => "1");
      Result : constant AWS_Mail_Manager_Access := new AWS_Mail_Manager;
   begin
      Log.Info ("Creating SMTP mail manager to server {0}:{1}", Server, Port);

      Result.Port   := Positive'Value (Port);
      Result.Enable := Enable = "1" or Enable = "yes" or Enable = "true";
      Result.Self   := Result;
      Initialize (Result.all, Props);
      return Result.all'Access;
   end Create_Manager;

   --  ------------------------------
   --  Create a new mail message.
   --  ------------------------------
   overriding
   function Create_Message (Manager : in AWS_Mail_Manager) return Mail_Message_Access is
      Result : constant AWS_Mail_Message_Access := new AWS_Mail_Message;
   begin
      Result.Manager := Manager.Self;
      return Result.all'Access;
   end Create_Message;

end AWA.Mail.Clients.AWS_SMTP;

Fix to collect the TO, CC, BCC recipients in separate lists and send the e-mail accordingly


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

with Util.Test_Caller;
with Util.Strings;

with Servlet.Streams;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Tests;
with AWA.Tests.Helpers.Users;

package body AWA.Questions.Tests is

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

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans.Load_List (Anonymous)",
                       Test_Anonymous_Access'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans.Save",
                       Test_Create_Question'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans.Load (missing)",
                       Test_Missing_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans.Save (answer)",
                       Test_Answer_Question'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get some access on the wiki as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T     : in out Test;
                               Page  : in String;
                               Title : in String) is
      function Get_Link (Title : in String) return String;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;

      function Get_Link (Title : in String) return String is
         Stream  : Servlet.Streams.Print_Stream := Reply.Get_Output_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Reply.Read_Content (Content);
         Stream.Write (Content);
         return AWA.Tests.Helpers.Extract_Link (To_String (Content), Title);
      end Get_Link;

   begin
      ASF.Tests.Do_Get (Request, Reply, "/questions/list.html",
                        "question-list.html");
      ASF.Tests.Assert_Contains (T, "<title>Questions</title>", Reply,
                                 "Questions list page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/questions/tags/tag",
                        "question-list-tagged.html");
      ASF.Tests.Assert_Contains (T, "<title>Questions</title>", Reply,
                                 "Questions tag page is invalid");

      if Page'Length > 0 then
         ASF.Tests.Do_Get (Request, Reply, "/questions/view/" & Page,
                           "question-page-" & Page & ".html");
         ASF.Tests.Assert_Contains (T, Title, Reply,
                                    "Question page " & Page & " is invalid");
         ASF.Tests.Assert_Matches (T, ".input type=.hidden. name=.question-id. "
                                   & "value=.[0-9]+. id=.question-id.../input", Reply,
                                    "Question page " & Page & " is invalid");
      end if;
   end Verify_Anonymous;

   --  ------------------------------
   --  Verify that the question list contains the given question.
   --  ------------------------------
   procedure Verify_List_Contains (T     : in out Test;
                                   Id    : in String;
                                   Title : in String) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/questions/list.html",
                        "question-list-recent.html");
      ASF.Tests.Assert_Contains (T, "Questions", Reply,
                                 "List of questions page is invalid");
      ASF.Tests.Assert_Contains (T, "/questions/view/" & Id, Reply,
                                 "List of questions page does not reference the page");
      ASF.Tests.Assert_Contains (T, Title, Reply,
                                 "List of questions page does not contain the question");

   end Verify_List_Contains;

   --  ------------------------------
   --  Test access to the question as anonymous user.
   --  ------------------------------
   procedure Test_Anonymous_Access (T : in out Test) is
   begin
      T.Verify_Anonymous ("", "");
   end Test_Anonymous_Access;

   --  ------------------------------
   --  Test creation of question by simulating web requests.
   --  ------------------------------
   procedure Test_Create_Question (T : in out Test) is
      procedure Create_Question (Title : in String);

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Uuid      : constant String := Util.Tests.Get_Uuid;

      procedure Create_Question (Title : in String) is
      begin
         Request.Set_Parameter ("post", "1");
         Request.Set_Parameter ("title", Title);
         Request.Set_Parameter ("text", "# Main title" & ASCII.LF
                                & "* The question content." & ASCII.LF
                                & "* Second item." & ASCII.LF);
         Request.Set_Parameter ("save", "1");
         ASF.Tests.Do_Post (Request, Reply, "/questions/ask.html", "questions-ask.html");

         T.Question_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/questions/view/");

         Util.Tests.Assert_Matches (T, "[0-9]+$", To_String (T.Question_Ident),
                                   "Invalid redirect after question creation");

         --  Remove the 'question' bean from the request so that we get a new instance
         --  for the next call.
         Request.Remove_Attribute ("question");
      end Create_Question;

   begin
      AWA.Tests.Helpers.Users.Login ("test-question@test.com", Request);

      Create_Question ("Question 1 page title1");
      T.Verify_List_Contains (To_String (T.Question_Ident), "Question 1 page title1");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Question 1 page title1");

      Create_Question ("Question 2 page title2");
      T.Verify_List_Contains (To_String (T.Question_Ident), "Question 2 page title2");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Question 2 page title2");

      Create_Question ("Question 3 page title3");
      T.Verify_List_Contains (To_String (T.Question_Ident), "Question 3 page title3");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Question 3 page title3");

   end Test_Create_Question;

   --  ------------------------------
   --  Test getting a wiki page which does not exist.
   --  ------------------------------
   procedure Test_Missing_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/questions/view.html?id=12345678",
                        "question-page-missing.html");
      ASF.Tests.Assert_Matches (T, "<title>Question not found</title>", Reply,
                                "Question page title '12345678' is invalid",
                                ASF.Responses.SC_NOT_FOUND);
      ASF.Tests.Assert_Matches (T, "question.*removed", Reply,
                                "Question page content '12345678' is invalid",
                                ASF.Responses.SC_NOT_FOUND);
   end Test_Missing_Page;

   --  ------------------------------
   --  Test answer of question by simulating web requests.
   --  ------------------------------
   procedure Test_Answer_Question (T : in out Test) is
      procedure Create_Answer (Content : in String);

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;

      procedure Create_Answer (Content : in String) is
      begin
         Request.Set_Parameter ("post", "1");
         Request.Set_Parameter ("question-id", To_String (T.Question_Ident));
         Request.Set_Parameter ("answer-id", "");
         Request.Set_Parameter ("text", Content);
         Request.Set_Parameter ("save", "1");
         ASF.Tests.Do_Post (Request, Reply, "/questions/forms/answer-form.html",
                            "questions-answer.html");

         ASF.Tests.Assert_Contains (T, "/questions/view/" &  To_String (T.Question_Ident),
                                    Reply,
                                    "Answer response is invalid");

         --  Remove the 'question' bean from the request so that we get a new instance
         --  for the next call.
         Request.Remove_Attribute ("answer");
      end Create_Answer;

   begin
      AWA.Tests.Helpers.Users.Login ("test-answer@test.com", Request);

      Create_Answer ("Answer content 1");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 1");

      Create_Answer ("Answer content 2");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 1");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 2");

      Create_Answer ("Answer content 3");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 1");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 2");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 3");

   end Test_Answer_Question;

end AWA.Questions.Tests;

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

with Util.Test_Caller;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Tests;
with AWA.Tests.Helpers.Users;

package body AWA.Questions.Tests is

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

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans.Load_List (Anonymous)",
                       Test_Anonymous_Access'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans.Save",
                       Test_Create_Question'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans.Load (missing)",
                       Test_Missing_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans.Save (answer)",
                       Test_Answer_Question'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get some access on the wiki as anonymous users.
   --  ------------------------------
   procedure Verify_Anonymous (T     : in out Test;
                               Page  : in String;
                               Title : in String) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/questions/list.html",
                        "question-list.html");
      ASF.Tests.Assert_Contains (T, "<title>Questions</title>", Reply,
                                 "Questions list page is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/questions/tags/tag",
                        "question-list-tagged.html");
      ASF.Tests.Assert_Contains (T, "<title>Questions</title>", Reply,
                                 "Questions tag page is invalid");

      if Page'Length > 0 then
         ASF.Tests.Do_Get (Request, Reply, "/questions/view/" & Page,
                           "question-page-" & Page & ".html");
         ASF.Tests.Assert_Contains (T, Title, Reply,
                                    "Question page " & Page & " is invalid");
         ASF.Tests.Assert_Matches (T, ".input type=.hidden. name=.question-id. "
                                   & "value=.[0-9]+. id=.question-id.../input", Reply,
                                    "Question page " & Page & " is invalid");
      end if;
   end Verify_Anonymous;

   --  ------------------------------
   --  Verify that the question list contains the given question.
   --  ------------------------------
   procedure Verify_List_Contains (T     : in out Test;
                                   Id    : in String;
                                   Title : in String) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/questions/list.html",
                        "question-list-recent.html");
      ASF.Tests.Assert_Contains (T, "Questions", Reply,
                                 "List of questions page is invalid");
      ASF.Tests.Assert_Contains (T, "/questions/view/" & Id, Reply,
                                 "List of questions page does not reference the page");
      ASF.Tests.Assert_Contains (T, Title, Reply,
                                 "List of questions page does not contain the question");

   end Verify_List_Contains;

   --  ------------------------------
   --  Test access to the question as anonymous user.
   --  ------------------------------
   procedure Test_Anonymous_Access (T : in out Test) is
   begin
      T.Verify_Anonymous ("", "");
   end Test_Anonymous_Access;

   --  ------------------------------
   --  Test creation of question by simulating web requests.
   --  ------------------------------
   procedure Test_Create_Question (T : in out Test) is
      procedure Create_Question (Title : in String);

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;

      procedure Create_Question (Title : in String) is
      begin
         Request.Set_Parameter ("post", "1");
         Request.Set_Parameter ("title", Title);
         Request.Set_Parameter ("text", "# Main title" & ASCII.LF
                                & "* The question content." & ASCII.LF
                                & "* Second item." & ASCII.LF);
         Request.Set_Parameter ("save", "1");
         ASF.Tests.Do_Post (Request, Reply, "/questions/ask.html", "questions-ask.html");

         T.Question_Ident := Helpers.Extract_Redirect (Reply, "/asfunit/questions/view/");

         Util.Tests.Assert_Matches (T, "[0-9]+$", To_String (T.Question_Ident),
                                   "Invalid redirect after question creation");

         --  Remove the 'question' bean from the request so that we get a new instance
         --  for the next call.
         Request.Remove_Attribute ("question");
      end Create_Question;

   begin
      AWA.Tests.Helpers.Users.Login ("test-question@test.com", Request);

      Create_Question ("Question 1 page title1");
      T.Verify_List_Contains (To_String (T.Question_Ident), "Question 1 page title1");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Question 1 page title1");

      Create_Question ("Question 2 page title2");
      T.Verify_List_Contains (To_String (T.Question_Ident), "Question 2 page title2");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Question 2 page title2");

      Create_Question ("Question 3 page title3");
      T.Verify_List_Contains (To_String (T.Question_Ident), "Question 3 page title3");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Question 3 page title3");

   end Test_Create_Question;

   --  ------------------------------
   --  Test getting a wiki page which does not exist.
   --  ------------------------------
   procedure Test_Missing_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/questions/view.html?id=12345678",
                        "question-page-missing.html");
      ASF.Tests.Assert_Matches (T, "<title>Question not found</title>", Reply,
                                "Question page title '12345678' is invalid",
                                ASF.Responses.SC_NOT_FOUND);
      ASF.Tests.Assert_Matches (T, "question.*removed", Reply,
                                "Question page content '12345678' is invalid",
                                ASF.Responses.SC_NOT_FOUND);
   end Test_Missing_Page;

   --  ------------------------------
   --  Test answer of question by simulating web requests.
   --  ------------------------------
   procedure Test_Answer_Question (T : in out Test) is
      procedure Create_Answer (Content : in String);

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;

      procedure Create_Answer (Content : in String) is
      begin
         Request.Set_Parameter ("post", "1");
         Request.Set_Parameter ("question-id", To_String (T.Question_Ident));
         Request.Set_Parameter ("answer-id", "");
         Request.Set_Parameter ("text", Content);
         Request.Set_Parameter ("save", "1");
         ASF.Tests.Do_Post (Request, Reply, "/questions/forms/answer-form.html",
                            "questions-answer.html");

         ASF.Tests.Assert_Contains (T, "/questions/view/" &  To_String (T.Question_Ident),
                                    Reply,
                                    "Answer response is invalid");

         --  Remove the 'question' bean from the request so that we get a new instance
         --  for the next call.
         Request.Remove_Attribute ("answer");
      end Create_Answer;

   begin
      AWA.Tests.Helpers.Users.Login ("test-answer@test.com", Request);

      Create_Answer ("Answer content 1");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 1");

      Create_Answer ("Answer content 2");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 1");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 2");

      Create_Answer ("Answer content 3");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 1");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 2");
      T.Verify_Anonymous (To_String (T.Question_Ident), "Answer content 3");

   end Test_Answer_Question;

end AWA.Questions.Tests;

Fix compilation warnings

Fix compilation warnings


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

--  == Introduction ==
--
--
--  @include "security-contexts.ads"
--  @include "security-controllers.ads"
package Security is

end Security;

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

--  == Introduction ==
--
--
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

end Security;

Fix documentation links

Fix documentation links