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

with Sax.Exceptions;
with Sax.Locators;
with Sax.Readers;
with Sax.Attributes;
with Unicode.CES;
with Input_Sources;

with Ada.Streams;
with Ada.Strings.Unbounded;
with Util.Streams.Buffered;
with Util.Streams.Texts;
package Util.Serialize.IO.XML is

   Parse_Error : exception;

   type Parser is new Serialize.IO.Parser with private;

   --  Parse the stream using the JSON parser.
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class;
                    Sink    : in out Reader'Class);

   --  Set the XHTML reader to ignore or not the white spaces.
   --  When set to True, the ignorable white spaces will not be kept.
   procedure Set_Ignore_White_Spaces (Reader : in out Parser;
                                      Value  : in Boolean);

   --  Set the XHTML reader to ignore empty lines.
   procedure Set_Ignore_Empty_Lines (Reader : in out Parser;
                                     Value  : in Boolean);

   --  Get the current location (file and line) to report an error message.
   function Get_Location (Handler : in Parser) return String;

   type Xhtml_Reader is new Sax.Readers.Reader with private;

   --  ------------------------------
   --  XML Output Stream
   --  ------------------------------
   --  The <b>Output_Stream</b> provides methods for creating an XML output stream.
   --  The stream object takes care of the XML escape rules.
   type Output_Stream is limited new Util.Serialize.IO.Output_Stream with private;

   --  Set the target output stream.
   procedure Initialize (Stream : in out Output_Stream;
                         Output : in Util.Streams.Texts.Print_Stream_Access);

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

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

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

   --  Write a raw character on the stream.
   procedure Write (Stream : in out Output_Stream;
                    Char   : in Character);

   --  Write a wide character on the stream doing some conversion if necessary.
   --  The default implementation translates the wide character to a UTF-8 sequence.
   procedure Write_Wide (Stream : in out Output_Stream;
                         Item   : in Wide_Wide_Character);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Output_Stream;
                    Item   : in String);

   --  Write a character on the response stream and escape that character as necessary.
   procedure Write_Escape (Stream : in out Output_Stream'Class;
                           Char   : in Wide_Wide_Character);

   --  Write the value as a XML string.  Special characters are escaped using the XML
   --  escape rules.
   procedure Write_String (Stream : in out Output_Stream;
                           Value  : in String);

   --  Write the value as a XML string.  Special characters are escaped using the XML
   --  escape rules.
   procedure Write_Wide_String (Stream : in out Output_Stream;
                                Value  : in Wide_Wide_String);

   --  Write the value as a XML string.  Special characters are escaped using the XML
   --  escape rules.
   procedure Write_String (Stream : in out Output_Stream;
                           Value  : in Util.Beans.Objects.Object);

   --  Start a new XML object.
   procedure Start_Entity (Stream : in out Output_Stream;
                           Name   : in String);

   --  Terminates the current XML object.
   procedure End_Entity (Stream : in out Output_Stream;
                         Name   : in String);

   --  Write the attribute name/value pair.
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String);

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Nullables.Nullable_String);

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String);

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer);

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean);

   --  Write a XML name/value attribute.
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object);

   --  Write the attribute with a null value.
   overriding
   procedure Write_Null_Attribute (Stream : in out Output_Stream;
                                   Name   : in String);

   --  Write the entity value.
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Nullables.Nullable_String);

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time);

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer);

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String);

   --  Write a XML name/value entity (see Write_Attribute).
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object);

   --  Write an entity with a null value.
   overriding
   procedure Write_Null_Entity (Stream : in out Output_Stream;
                                Name   : in String);

   --  Starts a XML array.
   overriding
   procedure Start_Array (Stream : in out Output_Stream;
                          Name   : in String);

   --  Terminates a XML array.
   overriding
   procedure End_Array (Stream : in out Output_Stream;
                        Name   : in String);

   --  Return the location where the exception was raised.
   function Get_Location (Except : Sax.Exceptions.Sax_Parse_Exception'Class)
                          return String;

private

   overriding
   procedure Warning (Handler : in out Xhtml_Reader;
                      Except  : in Sax.Exceptions.Sax_Parse_Exception'Class);

   overriding
   procedure Error (Handler : in out Xhtml_Reader;
                    Except  : in Sax.Exceptions.Sax_Parse_Exception'Class);

   overriding
   procedure Fatal_Error (Handler : in out Xhtml_Reader;
                          Except  : in Sax.Exceptions.Sax_Parse_Exception'Class);

   overriding
   procedure Set_Document_Locator (Handler : in out Xhtml_Reader;
                                   Loc     : in out Sax.Locators.Locator);

   overriding
   procedure Start_Document (Handler : in out Xhtml_Reader);

   overriding
   procedure End_Document (Handler : in out Xhtml_Reader);

   overriding
   procedure Start_Prefix_Mapping (Handler : in out Xhtml_Reader;
                                   Prefix  : in Unicode.CES.Byte_Sequence;
                                   URI     : in Unicode.CES.Byte_Sequence);

   overriding
   procedure End_Prefix_Mapping (Handler : in out Xhtml_Reader;
                                 Prefix  : in Unicode.CES.Byte_Sequence);

   overriding
   procedure Start_Element (Handler       : in out Xhtml_Reader;
                            Namespace_URI : in Unicode.CES.Byte_Sequence := "";
                            Local_Name    : in Unicode.CES.Byte_Sequence := "";
                            Qname         : in Unicode.CES.Byte_Sequence := "";
                            Atts          : in Sax.Attributes.Attributes'Class);

   overriding
   procedure End_Element (Handler       : in out Xhtml_Reader;
                          Namespace_URI : in Unicode.CES.Byte_Sequence := "";
                          Local_Name    : in Unicode.CES.Byte_Sequence := "";
                          Qname         : in Unicode.CES.Byte_Sequence := "");

   overriding
   procedure Characters (Handler : in out Xhtml_Reader;
                         Ch      : in Unicode.CES.Byte_Sequence);

   overriding
   procedure Ignorable_Whitespace (Handler : in out Xhtml_Reader;
                                   Ch      : in Unicode.CES.Byte_Sequence);

   overriding
   procedure Processing_Instruction (Handler : in out Xhtml_Reader;
                                     Target  : in Unicode.CES.Byte_Sequence;
                                     Data    : in Unicode.CES.Byte_Sequence);

   overriding
   procedure Skipped_Entity (Handler : in out Xhtml_Reader;
                             Name    : in Unicode.CES.Byte_Sequence);

   overriding
   procedure Start_Cdata (Handler : in out Xhtml_Reader);

   overriding
   procedure End_Cdata (Handler : in out Xhtml_Reader);

   overriding
   function Resolve_Entity (Handler   : Xhtml_Reader;
                            Public_Id : Unicode.CES.Byte_Sequence;
                            System_Id : Unicode.CES.Byte_Sequence)
                            return Input_Sources.Input_Source_Access;

   overriding
   procedure Start_DTD (Handler   : in out Xhtml_Reader;
                        Name      : Unicode.CES.Byte_Sequence;
                        Public_Id : Unicode.CES.Byte_Sequence := "";
                        System_Id : Unicode.CES.Byte_Sequence := "");

   procedure Collect_Text (Handler : in out Xhtml_Reader;
                           Content : Unicode.CES.Byte_Sequence);

   type Xhtml_Reader is new Sax.Readers.Reader with record
      Stack_Pos  : Natural := 0;
      Handler    : access Parser'Class;

      Text : Ada.Strings.Unbounded.Unbounded_String;

      --  Whether white spaces can be ignored.
      Ignore_White_Spaces : Boolean := True;

      --  Whether empty lines should be ignored (when white spaces are kept).
      Ignore_Empty_Lines : Boolean := True;

      Sink               : access Reader'Class;
   end record;

   type Parser is new Util.Serialize.IO.Parser with record
      --  The SAX locator to find the current file and line number.
      Locator             : Sax.Locators.Locator;
      Has_Pending_Char   : Boolean := False;
      Pending_Char       : Character;

      --  Whether white spaces can be ignored.
      Ignore_White_Spaces : Boolean := True;

      --  Whether empty lines should be ignored (when white spaces are kept).
      Ignore_Empty_Lines  : Boolean := True;
   end record;

   type Output_Stream is limited new Util.Serialize.IO.Output_Stream with record
      Close_Start : Boolean := False;
      Stream      : Util.Streams.Texts.Print_Stream_Access;
   end record;

end Util.Serialize.IO.XML;

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

with Sax.Exceptions;
with Sax.Locators;
with Sax.Readers;
with Sax.Attributes;
with Unicode.CES;
with Input_Sources;

with Ada.Streams;
with Ada.Strings.Unbounded;
with Util.Streams.Buffered;
with Util.Streams.Texts;
package Util.Serialize.IO.XML is

   Parse_Error : exception;

   type Parser is new Serialize.IO.Parser with private;

   --  Parse the stream using the JSON parser.
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class;
                    Sink    : in out Reader'Class);

   --  Set the XHTML reader to ignore or not the white spaces.
   --  When set to True, the ignorable white spaces will not be kept.
   procedure Set_Ignore_White_Spaces (Reader : in out Parser;
                                      Value  : in Boolean);

   --  Set the XHTML reader to ignore empty lines.
   procedure Set_Ignore_Empty_Lines (Reader : in out Parser;
                                     Value  : in Boolean);

   --  Get the current location (file and line) to report an error message.
   function Get_Location (Handler : in Parser) return String;

   type Xhtml_Reader is new Sax.Readers.Reader with private;

   --  ------------------------------
   --  XML Output Stream
   --  ------------------------------
   --  The <b>Output_Stream</b> provides methods for creating an XML output stream.
   --  The stream object takes care of the XML escape rules.
   type Output_Stream is limited new Util.Serialize.IO.Output_Stream with private;

   --  Set the target output stream.
   procedure Initialize (Stream : in out Output_Stream;
                         Output : in Util.Streams.Texts.Print_Stream_Access);

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

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

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

   --  Write a raw character on the stream.
   procedure Write (Stream : in out Output_Stream;
                    Char   : in Character);

   --  Write a wide character on the stream doing some conversion if necessary.
   --  The default implementation translates the wide character to a UTF-8 sequence.
   procedure Write_Wide (Stream : in out Output_Stream;
                         Item   : in Wide_Wide_Character);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Output_Stream;
                    Item   : in String);

   --  Write a character on the response stream and escape that character as necessary.
   procedure Write_Escape (Stream : in out Output_Stream'Class;
                           Char   : in Wide_Wide_Character);

   --  Write the value as a XML string.  Special characters are escaped using the XML
   --  escape rules.
   procedure Write_String (Stream : in out Output_Stream;
                           Value  : in String);

   --  Write the value as a XML string.  Special characters are escaped using the XML
   --  escape rules.
   procedure Write_Wide_String (Stream : in out Output_Stream;
                                Value  : in Wide_Wide_String);

   --  Write the value as a XML string.  Special characters are escaped using the XML
   --  escape rules.
   procedure Write_String (Stream : in out Output_Stream;
                           Value  : in Util.Beans.Objects.Object);

   --  Start a new XML object.
   procedure Start_Entity (Stream : in out Output_Stream;
                           Name   : in String);

   --  Terminates the current XML object.
   procedure End_Entity (Stream : in out Output_Stream;
                         Name   : in String);

   --  Write the attribute name/value pair.
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String);

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String);

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer);

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean);

   --  Write a XML name/value attribute.
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object);

   --  Write the attribute with a null value.
   overriding
   procedure Write_Null_Attribute (Stream : in out Output_Stream;
                                   Name   : in String);

   --  Write the entity value.
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String);

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time);

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer);

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String);

   --  Write a XML name/value entity (see Write_Attribute).
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object);

   --  Write an entity with a null value.
   overriding
   procedure Write_Null_Entity (Stream : in out Output_Stream;
                                Name   : in String);

   --  Starts a XML array.
   overriding
   procedure Start_Array (Stream : in out Output_Stream;
                          Name   : in String);

   --  Terminates a XML array.
   overriding
   procedure End_Array (Stream : in out Output_Stream;
                        Name   : in String);

   --  Return the location where the exception was raised.
   function Get_Location (Except : Sax.Exceptions.Sax_Parse_Exception'Class)
                          return String;

private

   overriding
   procedure Warning (Handler : in out Xhtml_Reader;
                      Except  : in Sax.Exceptions.Sax_Parse_Exception'Class);

   overriding
   procedure Error (Handler : in out Xhtml_Reader;
                    Except  : in Sax.Exceptions.Sax_Parse_Exception'Class);

   overriding
   procedure Fatal_Error (Handler : in out Xhtml_Reader;
                          Except  : in Sax.Exceptions.Sax_Parse_Exception'Class);

   overriding
   procedure Set_Document_Locator (Handler : in out Xhtml_Reader;
                                   Loc     : in out Sax.Locators.Locator);

   overriding
   procedure Start_Document (Handler : in out Xhtml_Reader);

   overriding
   procedure End_Document (Handler : in out Xhtml_Reader);

   overriding
   procedure Start_Prefix_Mapping (Handler : in out Xhtml_Reader;
                                   Prefix  : in Unicode.CES.Byte_Sequence;
                                   URI     : in Unicode.CES.Byte_Sequence);

   overriding
   procedure End_Prefix_Mapping (Handler : in out Xhtml_Reader;
                                 Prefix  : in Unicode.CES.Byte_Sequence);

   overriding
   procedure Start_Element (Handler       : in out Xhtml_Reader;
                            Namespace_URI : in Unicode.CES.Byte_Sequence := "";
                            Local_Name    : in Unicode.CES.Byte_Sequence := "";
                            Qname         : in Unicode.CES.Byte_Sequence := "";
                            Atts          : in Sax.Attributes.Attributes'Class);

   overriding
   procedure End_Element (Handler       : in out Xhtml_Reader;
                          Namespace_URI : in Unicode.CES.Byte_Sequence := "";
                          Local_Name    : in Unicode.CES.Byte_Sequence := "";
                          Qname         : in Unicode.CES.Byte_Sequence := "");

   overriding
   procedure Characters (Handler : in out Xhtml_Reader;
                         Ch      : in Unicode.CES.Byte_Sequence);

   overriding
   procedure Ignorable_Whitespace (Handler : in out Xhtml_Reader;
                                   Ch      : in Unicode.CES.Byte_Sequence);

   overriding
   procedure Processing_Instruction (Handler : in out Xhtml_Reader;
                                     Target  : in Unicode.CES.Byte_Sequence;
                                     Data    : in Unicode.CES.Byte_Sequence);

   overriding
   procedure Skipped_Entity (Handler : in out Xhtml_Reader;
                             Name    : in Unicode.CES.Byte_Sequence);

   overriding
   procedure Start_Cdata (Handler : in out Xhtml_Reader);

   overriding
   procedure End_Cdata (Handler : in out Xhtml_Reader);

   overriding
   function Resolve_Entity (Handler   : Xhtml_Reader;
                            Public_Id : Unicode.CES.Byte_Sequence;
                            System_Id : Unicode.CES.Byte_Sequence)
                            return Input_Sources.Input_Source_Access;

   overriding
   procedure Start_DTD (Handler   : in out Xhtml_Reader;
                        Name      : Unicode.CES.Byte_Sequence;
                        Public_Id : Unicode.CES.Byte_Sequence := "";
                        System_Id : Unicode.CES.Byte_Sequence := "");

   procedure Collect_Text (Handler : in out Xhtml_Reader;
                           Content : Unicode.CES.Byte_Sequence);

   type Xhtml_Reader is new Sax.Readers.Reader with record
      Stack_Pos  : Natural := 0;
      Handler    : access Parser'Class;

      Text : Ada.Strings.Unbounded.Unbounded_String;

      --  Whether white spaces can be ignored.
      Ignore_White_Spaces : Boolean := True;

      --  Whether empty lines should be ignored (when white spaces are kept).
      Ignore_Empty_Lines : Boolean := True;

      Sink               : access Reader'Class;
   end record;

   type Parser is new Util.Serialize.IO.Parser with record
      --  The SAX locator to find the current file and line number.
      Locator             : Sax.Locators.Locator;
      Has_Pending_Char   : Boolean := False;
      Pending_Char       : Character;

      --  Whether white spaces can be ignored.
      Ignore_White_Spaces : Boolean := True;

      --  Whether empty lines should be ignored (when white spaces are kept).
      Ignore_Empty_Lines  : Boolean := True;
   end record;

   type Output_Stream is limited new Util.Serialize.IO.Output_Stream with record
      Close_Start : Boolean := False;
      Stream      : Util.Streams.Texts.Print_Stream_Access;
   end record;

end Util.Serialize.IO.XML;

Remove Write_Entity and Write_Attribute on Nullable_String


-----------------------------------------------------------------------
--  util-streams-texts -- Text stream utilities
--  Copyright (C) 2010, 2011, 2012, 2015, 2016, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with Util.Streams.Buffered;
with Ada.Calendar;
with GNAT.Calendar.Time_IO;

--  == Texts ==
--  The <tt>Util.Streams.Texts</tt> package implements text oriented input and output streams.
--  The <tt>Print_Stream</tt> type extends the <tt>Output_Buffer_Stream</tt> to allow writing
--  text content.
--
--  The <tt>Reader_Stream</tt> package extends the <tt>Input_Buffer_Stream</tt> and allows to
--  read text content.
package Util.Streams.Texts is

   --  -----------------------
   --  Print stream
   --  -----------------------
   --  The Print_Stream is an output stream which provides helper methods
   --  for writing text streams.
   type Print_Stream is new Buffered.Output_Buffer_Stream with private;
   type Print_Stream_Access is access all Print_Stream'Class;

   procedure Initialize (Stream : in out Print_Stream;
                         To     : in Output_Stream_Access);

   --  Write a raw character on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Char   : in Character);

   --  Write a wide character on the stream doing some conversion if necessary.
   --  The default implementation translates the wide character to a UTF-8 sequence.
   procedure Write_Wide (Stream : in out Print_Stream;
                         Item   : in Wide_Wide_Character);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Integer);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Long_Long_Integer);

   --  Write a date on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Calendar.Time;
                    Format : in GNAT.Calendar.Time_IO.Picture_String
                    := GNAT.Calendar.Time_IO.ISO_Date);

   --  Get the output stream content as a string.
   function To_String (Stream : in Buffered.Output_Buffer_Stream'Class) return String;

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Print_Stream'Class;
                         Item   : in Character);

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Print_Stream'Class;
                         Item   : in Wide_Wide_Character);

   --  -----------------------
   --  Reader stream
   --  -----------------------
   --  The Reader_Stream is an input stream which provides helper methods
   --  for reading text streams.
   type Reader_Stream is new Buffered.Input_Buffer_Stream with private;
   type Reader_Stream_Access is access all Reader_Stream'Class;

   --  Initialize the reader to read the input from the input stream given in From.
   procedure Initialize (Stream : in out Reader_Stream;
                         From   : in Input_Stream_Access);

   --  Read an input line from the input stream.  The line is terminated by ASCII.LF.
   --  When Strip is set, the line terminators (ASCII.CR, ASCII.LF) are removed.
   procedure Read_Line (Stream : in out Reader_Stream;
                        Into   : out Ada.Strings.Unbounded.Unbounded_String;
                        Strip  : in Boolean := False);

private

   type Print_Stream is new Buffered.Output_Buffer_Stream with null record;

   type Reader_Stream is new Buffered.Input_Buffer_Stream with null record;

end Util.Streams.Texts;

-----------------------------------------------------------------------
--  util-streams-texts -- Text stream utilities
--  Copyright (C) 2010, 2011, 2012, 2015, 2016, 2017, 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.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with Util.Streams.Buffered;
with Ada.Calendar;
with GNAT.Calendar.Time_IO;

--  == Texts ==
--  The <tt>Util.Streams.Texts</tt> package implements text oriented input and output streams.
--  The <tt>Print_Stream</tt> type extends the <tt>Output_Buffer_Stream</tt> to allow writing
--  text content.
--
--  The <tt>Reader_Stream</tt> package extends the <tt>Input_Buffer_Stream</tt> and allows to
--  read text content.
package Util.Streams.Texts is

   --  -----------------------
   --  Print stream
   --  -----------------------
   --  The Print_Stream is an output stream which provides helper methods
   --  for writing text streams.
   type Print_Stream is new Buffered.Output_Buffer_Stream with private;
   type Print_Stream_Access is access all Print_Stream'Class;

   procedure Initialize (Stream : in out Print_Stream;
                         To     : access Output_Stream'Class);

   --  Write a raw character on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Char   : in Character);

   --  Write a wide character on the stream doing some conversion if necessary.
   --  The default implementation translates the wide character to a UTF-8 sequence.
   procedure Write_Wide (Stream : in out Print_Stream;
                         Item   : in Wide_Wide_Character);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Integer);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Long_Long_Integer);

   --  Write a date on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Calendar.Time;
                    Format : in GNAT.Calendar.Time_IO.Picture_String
                    := GNAT.Calendar.Time_IO.ISO_Date);

   --  Get the output stream content as a string.
   function To_String (Stream : in Buffered.Output_Buffer_Stream'Class) return String;

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Print_Stream'Class;
                         Item   : in Character);

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Print_Stream'Class;
                         Item   : in Wide_Wide_Character);

   --  -----------------------
   --  Reader stream
   --  -----------------------
   --  The Reader_Stream is an input stream which provides helper methods
   --  for reading text streams.
   type Reader_Stream is new Buffered.Input_Buffer_Stream with private;
   type Reader_Stream_Access is access all Reader_Stream'Class;

   --  Initialize the reader to read the input from the input stream given in From.
   procedure Initialize (Stream : in out Reader_Stream;
                         From   : access Input_Stream'Class);

   --  Read an input line from the input stream.  The line is terminated by ASCII.LF.
   --  When Strip is set, the line terminators (ASCII.CR, ASCII.LF) are removed.
   procedure Read_Line (Stream : in out Reader_Stream;
                        Into   : out Ada.Strings.Unbounded.Unbounded_String;
                        Strip  : in Boolean := False);

private

   type Print_Stream is new Buffered.Output_Buffer_Stream with null record;

   type Reader_Stream is new Buffered.Input_Buffer_Stream with null record;

end Util.Streams.Texts;

Use anonymous access type for the input and output streams


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

package body MAT.Targets.Readers is

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

   MSG_BEGIN  : constant MAT.Events.Internal_Reference := 0;
   MSG_END    : constant MAT.Events.Internal_Reference := 1;

   M_PID      : constant MAT.Events.Internal_Reference := 1;
   M_EXE      : constant MAT.Events.Internal_Reference := 2;

   PID_NAME   : aliased constant String := "pid";
   EXE_NAME   : aliased constant String := "exe";

   Process_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => PID_NAME'Access, Size => 0,
            Kind => MAT.Events.T_SIZE_T, Ref => M_PID),
      2 => (Name => EXE_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_EXE));

   procedure Create_Process (For_Servant : in out Process_Servant;
                             Pid         : in MAT.Types.Target_Process_Ref) is
   begin
      MAT.Memory.Targets.Initialize (Memory => For_Servant.Process.Memory,
                                     Reader => For_Servant.Reader.all);
   end Create_Process;

   overriding
   procedure Dispatch (For_Servant : in out Process_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out MAT.Readers.Message) is
   begin
      case Id is
         when MSG_BEGIN =>
            null;

         when MSG_END =>
            null;

         when others =>
            null;

      end case;
   end Dispatch;

   --  Register the reader to extract and analyze process events.
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Process_Reader_Access) is
   begin
      Into.Register_Reader (Reader.all'Access, "begin", MSG_BEGIN,
                            Process_Attributes'Access);
      Into.Register_Reader (Reader.all'Access, "end", MSG_END,
                            Process_Attributes'Access);
   end Register;

end MAT.Targets.Readers;

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

package body MAT.Targets.Readers is

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

   MSG_BEGIN  : constant MAT.Events.Internal_Reference := 0;
   MSG_END    : constant MAT.Events.Internal_Reference := 1;

   M_PID      : constant MAT.Events.Internal_Reference := 1;
   M_EXE      : constant MAT.Events.Internal_Reference := 2;

   PID_NAME   : aliased constant String := "pid";
   EXE_NAME   : aliased constant String := "exe";

   Process_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => PID_NAME'Access, Size => 0,
            Kind => MAT.Events.T_SIZE_T, Ref => M_PID),
      2 => (Name => EXE_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_EXE));

   procedure Create_Process (For_Servant : in out Process_Servant;
                             Pid         : in MAT.Types.Target_Process_Ref) is
   begin
      MAT.Memory.Targets.Initialize (Memory => For_Servant.Process.Memory,
                                     Reader => For_Servant.Reader.all);
   end Create_Process;

   overriding
   procedure Dispatch (For_Servant : in out Process_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out MAT.Readers.Message) is
   begin
      case Id is
         when MSG_BEGIN =>
            null;

         when MSG_END =>
            null;

         when others =>
            null;

      end case;
   end Dispatch;

   --  ------------------------------
   --  Register the reader to extract and analyze process events.
   --  ------------------------------
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Process_Reader_Access) is
   begin
      Reader.Reader := Into'Unchecked_Access;
      Into.Register_Reader (Reader.all'Access, "begin", MSG_BEGIN,
                            Process_Attributes'Access);
      Into.Register_Reader (Reader.all'Access, "end", MSG_END,
                            Process_Attributes'Access);
   end Register;

   --  ------------------------------
   --  Initialize the target object to prepare for reading process events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
      Process_Reader : constant Process_Reader_Access
        := new Process_Servant;
   begin
      Process_Reader.Target := Target'Unrestricted_Access;
      Register (Reader, Process_Reader);
   end Initialize;

end MAT.Targets.Readers;

Implement the Initialize procedure

Implement the Initialize procedure


--  bkp-files -- File and directories
-----------------------------------------------------------------------
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Directories;
with Ada.Containers.Vectors;
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Streams.Stream_IO;
with Util.Log.Loggers;
with Util.Files;
with Interfaces.C;
package body Babel.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bkp.Files");

   --  ------------------------------
   --  Allocate a File_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type is
      Result : constant File_Type := new File '(Len    => Name'Length,
                                                Id     => NO_IDENTIFIER,
                                                Dir    => Dir,
                                                Name   => Name,
                                                others => <>);
   begin
      return Result;
   end Allocate;

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      if Element.Id = NO_IDENTIFIER then
         return True;
      elsif (Element.Status and FILE_MODIFIED) /= 0 then
         return True;
      else
         return False;
      end if;
   end Is_Modified;

   --  ------------------------------
   --  Set the file as modified.
   --  ------------------------------
   procedure Set_Modified (Element : in File_Type) is
   begin
      Element.Status := Element.Status or FILE_MODIFIED;
   end Set_Modified;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File) return String is
   begin
      return Util.Files.Compose (Ada.Strings.Unbounded.To_String (Element.Path),
                                 Ada.Strings.Unbounded.To_String (Element.Name));
   end Get_Path;

   overriding
   procedure Add_File (Into    : in out File_Queue;
                       Path    : in String;
                       Element : in File) is
   begin
      Into.Queue.Enqueue (Element);
   end Add_File;

   overriding
   procedure Add_Directory (Into : in out File_Queue;
                            Path : in String;
                            Name : in String) is
   begin
      Into.Directories.Append (Util.Files.Compose (Path, Name));
   end Add_Directory;

   procedure Compute_Sha1 (Path : in String;
                           Into : in out File) is
      use Ada.Strings.Unbounded;
      use type Ada.Streams.Stream_Element_Offset;

      File : Ada.Streams.Stream_IO.File_Type;
      Name : constant String := Path & "/" & To_String (Into.Name);
      Last : Ada.Streams.Stream_Element_Offset;
      Buf  : Ada.Streams.Stream_Element_Array (0 .. 32_767);
      Ctx  : Util.Encoders.SHA1.Context;
   begin
      Ada.Streams.Stream_IO.Open (File, Ada.Streams.Stream_IO.In_File, Name);
      loop
         Ada.Streams.Stream_IO.Read (File, Buf, Last);
         Util.Encoders.SHA1.Update (Ctx, Buf (Buf'First .. Last));
         exit when Last /= Buf'Last;
      end loop;
      Ada.Streams.Stream_IO.Close (File);
      Util.Encoders.SHA1.Finish (Ctx, Into.SHA1);
   end Compute_Sha1;

   procedure Iterate_Files (Path   : in String;
                            Dir    : in out Directory;
                            Depth  : in Natural;
                            Update : access procedure (P : in String; F : in out File)) is
      use Ada.Strings.Unbounded;

      Iter : File_Vectors.Cursor := Dir.Files.First;

      procedure Iterate_File (Item : in out File) is
      begin
         Update (Path, Item);
      end Iterate_File;

      procedure Iterate_Child (Item : in out Directory) is
      begin
         Iterate_Files (Path & "/" & To_String (Item.Name), Item, Depth - 1, Update);
      end Iterate_Child;

   begin
      while File_Vectors.Has_Element (Iter) loop
         Dir.Files.Update_Element (Iter, Iterate_File'Access);
         File_Vectors.Next (Iter);
      end loop;
      if Depth > 0 and then Dir.Children /= null then
         declare
            Dir_Iter : Directory_Vectors.Cursor := Dir.Children.First;
         begin
            while Directory_Vectors.Has_Element (Dir_Iter) loop
               Dir.Children.Update_Element (Dir_Iter, Iterate_Child'Access);
               Directory_Vectors.Next (Dir_Iter);
            end loop;
         end;
      end if;
   end Iterate_Files;

   procedure Scan_Files (Path : in String;
                         Into : in out Directory) is
      Iter : File_Vectors.Cursor := Into.Files.First;

      procedure Compute_Sha1 (Item : in out File) is
      begin
         Compute_Sha1 (Path, Item);
      end Compute_Sha1;

   begin
      while File_Vectors.Has_Element (Iter) loop
         Into.Files.Update_Element (Iter, Compute_Sha1'Access);
         File_Vectors.Next (Iter);
      end loop;
   end Scan_Files;

   procedure Scan_Children (Path : in String;
                            Into : in out Directory) is
      procedure Update (Dir : in out Directory) is
         use Ada.Strings.Unbounded;
         use type Ada.Directories.File_Size;
      begin
         Scan (Path & "/" & To_String (Dir.Name), Dir);
         Into.Tot_Files := Into.Tot_Files + Dir.Tot_Files;
         Into.Tot_Size  := Into.Tot_Size + Dir.Tot_Size;
         Into.Tot_Dirs  := Into.Tot_Dirs + Dir.Tot_Dirs;
      end Update;

   begin
      if Into.Children /= null then
         declare
            Iter : Directory_Vectors.Cursor := Into.Children.First;
         begin
            while Directory_Vectors.Has_Element (Iter) loop
               Into.Children.Update_Element (Iter, Update'Access);
               Directory_Vectors.Next (Iter);
            end loop;
         end;
      end if;
   end Scan_Children;

   procedure Scan (Path : in String;
                   Into : in out Directory) is
      use Ada.Directories;

      Filter : constant Ada.Directories.Filter_Type := (Ordinary_File => True,
                                                        Ada.Directories.Directory => True,
                                                        Special_File => False);
      Search   : Search_Type;
      Ent      : Directory_Entry_Type;
      New_File : File;
      Child    : Directory;
   begin
      Into.Tot_Size  := 0;
      Into.Tot_Files := 0;
      Into.Tot_Dirs  := 0;
      Start_Search (Search, Directory => Path, Pattern => "*", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Name : constant String    := Simple_Name (Ent);
            Kind : constant File_Kind := Ada.Directories.Kind (Ent);
         begin
            if Kind = Ordinary_File then
               New_File.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
               begin
                  New_File.Size := Ada.Directories.Size (Ent);
               exception
                  when Constraint_Error =>
                     New_File.Size := Ada.Directories.File_Size (Interfaces.Unsigned_32'Last);
               end;
               Into.Files.Append (New_File);
               if New_File.Size > 0 then
                  begin
                     Into.Tot_Size  := Into.Tot_Size + New_File.Size;
                  exception
                     when Constraint_Error =>
                        Ada.Text_IO.Put_Line ("Size: " & Ada.Directories.File_Size'Image (New_File.Size)
                                              & " for " & Path & "/" & Name);
                        Ada.Text_IO.Put_Line ("Size: " & Ada.Directories.File_Size'Image (Into.Tot_Size));

                  end;
               end if;
               Into.Tot_Files := Into.Tot_Files + 1;
            elsif Name /= "." and Name /= ".." then
               if Into.Children = null then
                  Into.Children := new Directory_Vector;
               end if;
               Child.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
               Into.Children.Append (Child);
               Into.Tot_Dirs := Into.Tot_Dirs + 1;
            end if;
         end;
      end loop;
      Scan_Children (Path, Into);
      Scan_Files (Path, Into);

   exception
      when E : others =>
            Log.Error ("Exception ", E);
   end Scan;

end Babel.Files;

--  bkp-files -- File and directories
-----------------------------------------------------------------------
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Directories;
with Ada.Containers.Vectors;
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Streams.Stream_IO;
with Util.Log.Loggers;
with Util.Files;
with Interfaces.C;
package body Babel.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bkp.Files");

   --  ------------------------------
   --  Allocate a File_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type is
      Result : constant File_Type := new File '(Len    => Name'Length,
                                                Id     => NO_IDENTIFIER,
                                                Dir    => Dir,
                                                Name   => Name,
                                                others => <>);
   begin
      return Result;
   end Allocate;

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      if Element.Id = NO_IDENTIFIER then
         return True;
      elsif (Element.Status and FILE_MODIFIED) /= 0 then
         return True;
      else
         return False;
      end if;
   end Is_Modified;

   --  ------------------------------
   --  Set the file as modified.
   --  ------------------------------
   procedure Set_Modified (Element : in File_Type) is
   begin
      Element.Status := Element.Status or FILE_MODIFIED;
   end Set_Modified;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File) return String is
   begin
      return Util.Files.Compose (Ada.Strings.Unbounded.To_String (Element.Path),
                                 Ada.Strings.Unbounded.To_String (Element.Name));
   end Get_Path;

   overriding
   procedure Add_File (Into    : in out File_Queue;
                       Path    : in String;
                       Element : in File) is
   begin
      Into.Queue.Enqueue (Element);
   end Add_File;

   overriding
   procedure Add_Directory (Into : in out File_Queue;
                            Path : in String;
                            Name : in String) is
   begin
      Into.Directories.Append (Util.Files.Compose (Path, Name));
   end Add_Directory;

   procedure Iterate_Files (Path   : in String;
                            Dir    : in out Directory;
                            Depth  : in Natural;
                            Update : access procedure (P : in String; F : in out File)) is
      use Ada.Strings.Unbounded;

      Iter : File_Vectors.Cursor := Dir.Files.First;

      procedure Iterate_File (Item : in out File) is
      begin
         Update (Path, Item);
      end Iterate_File;

      procedure Iterate_Child (Item : in out Directory) is
      begin
         Iterate_Files (Path & "/" & To_String (Item.Name), Item, Depth - 1, Update);
      end Iterate_Child;

   begin
      while File_Vectors.Has_Element (Iter) loop
         Dir.Files.Update_Element (Iter, Iterate_File'Access);
         File_Vectors.Next (Iter);
      end loop;
      if Depth > 0 and then Dir.Children /= null then
         declare
            Dir_Iter : Directory_Vectors.Cursor := Dir.Children.First;
         begin
            while Directory_Vectors.Has_Element (Dir_Iter) loop
               Dir.Children.Update_Element (Dir_Iter, Iterate_Child'Access);
               Directory_Vectors.Next (Dir_Iter);
            end loop;
         end;
      end if;
   end Iterate_Files;

   procedure Scan_Files (Path : in String;
                         Into : in out Directory) is
      Iter : File_Vectors.Cursor := Into.Files.First;

      procedure Compute_Sha1 (Item : in out File) is
      begin
         Compute_Sha1 (Path, Item);
      end Compute_Sha1;

   begin
      while File_Vectors.Has_Element (Iter) loop
         Into.Files.Update_Element (Iter, Compute_Sha1'Access);
         File_Vectors.Next (Iter);
      end loop;
   end Scan_Files;

   procedure Scan_Children (Path : in String;
                            Into : in out Directory) is
      procedure Update (Dir : in out Directory) is
         use Ada.Strings.Unbounded;
         use type Ada.Directories.File_Size;
      begin
         Scan (Path & "/" & To_String (Dir.Name), Dir);
         Into.Tot_Files := Into.Tot_Files + Dir.Tot_Files;
         Into.Tot_Size  := Into.Tot_Size + Dir.Tot_Size;
         Into.Tot_Dirs  := Into.Tot_Dirs + Dir.Tot_Dirs;
      end Update;

   begin
      if Into.Children /= null then
         declare
            Iter : Directory_Vectors.Cursor := Into.Children.First;
         begin
            while Directory_Vectors.Has_Element (Iter) loop
               Into.Children.Update_Element (Iter, Update'Access);
               Directory_Vectors.Next (Iter);
            end loop;
         end;
      end if;
   end Scan_Children;

   procedure Scan (Path : in String;
                   Into : in out Directory) is
      use Ada.Directories;

      Filter : constant Ada.Directories.Filter_Type := (Ordinary_File => True,
                                                        Ada.Directories.Directory => True,
                                                        Special_File => False);
      Search   : Search_Type;
      Ent      : Directory_Entry_Type;
      New_File : File;
      Child    : Directory;
   begin
      Into.Tot_Size  := 0;
      Into.Tot_Files := 0;
      Into.Tot_Dirs  := 0;
      Start_Search (Search, Directory => Path, Pattern => "*", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Name : constant String    := Simple_Name (Ent);
            Kind : constant File_Kind := Ada.Directories.Kind (Ent);
         begin
            if Kind = Ordinary_File then
               New_File.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
               begin
                  New_File.Size := Ada.Directories.Size (Ent);
               exception
                  when Constraint_Error =>
                     New_File.Size := Ada.Directories.File_Size (Interfaces.Unsigned_32'Last);
               end;
               Into.Files.Append (New_File);
               if New_File.Size > 0 then
                  begin
                     Into.Tot_Size  := Into.Tot_Size + New_File.Size;
                  exception
                     when Constraint_Error =>
                        Ada.Text_IO.Put_Line ("Size: " & Ada.Directories.File_Size'Image (New_File.Size)
                                              & " for " & Path & "/" & Name);
                        Ada.Text_IO.Put_Line ("Size: " & Ada.Directories.File_Size'Image (Into.Tot_Size));

                  end;
               end if;
               Into.Tot_Files := Into.Tot_Files + 1;
            elsif Name /= "." and Name /= ".." then
               if Into.Children = null then
                  Into.Children := new Directory_Vector;
               end if;
               Child.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
               Into.Children.Append (Child);
               Into.Tot_Dirs := Into.Tot_Dirs + 1;
            end if;
         end;
      end loop;
      Scan_Children (Path, Into);
      Scan_Files (Path, Into);

   exception
      when E : others =>
            Log.Error ("Exception ", E);
   end Scan;

end Babel.Files;

Remove the old Compute_Sha1 procedure

Remove the old Compute_Sha1 procedure


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

with ADO;
with Wiki.Strings;
with AWA.Modules;
with AWA.Blogs.Models;
with AWA.Counters.Definition;
with AWA.Blogs.Servlets;

with Security.Permissions;

--  == Integration ==
--  The <tt>Blog_Module</tt> manages the creation, update, removal of blog posts in an application.
--  It provides operations that are used by the blog beans or other services to create and update
--  posts.  An instance of the <tt>Blog_Module</tt> must be declared and registered in the
--  AWA application.  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Blog_Module : aliased AWA.Blogs.Modules.Blog_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Blogs.Modules.NAME,
--              URI    => "blogs",
--              Module => App.Blog_Module'Access);
--
package AWA.Blogs.Modules is

   NAME : constant String := "blogs";

   --  The configuration parameter that defines the image link prefix in rendered HTML content.
   PARAM_IMAGE_PREFIX : constant String := "image_prefix";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   --  Define the read post counter.
   package Read_Counter is new AWA.Counters.Definition (Models.POST_TABLE, "read_count");

   Not_Found : exception;

   type Blog_Module is new AWA.Modules.Module with private;
   type Blog_Module_Access is access all Blog_Module'Class;

   --  Initialize the blog module.
   overriding
   procedure Initialize (Plugin : in out Blog_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Blog_Module;
                        Props  : in ASF.Applications.Config);

   --  Get the blog module instance associated with the current application.
   function Get_Blog_Module return Blog_Module_Access;

   --  Get the image prefix that was configured for the Blog module.
   function Get_Image_Prefix (Module : in Blog_Module)
                              return Wiki.Strings.UString;

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

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

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

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

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

private

   type Blog_Module is new AWA.Modules.Module with record
      Image_Prefix : Wiki.Strings.UString;
      Image_Servlet : aliased AWA.Blogs.Servlets.Image_Servlet;
   end record;

end AWA.Blogs.Modules;

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

with ADO;
with Wiki.Strings;
with AWA.Modules;
with AWA.Blogs.Models;
with AWA.Counters.Definition;
with AWA.Blogs.Servlets;

with Security.Permissions;

--  == Integration ==
--  The <tt>Blog_Module</tt> manages the creation, update, removal of blog posts in an application.
--  It provides operations that are used by the blog beans or other services to create and update
--  posts.  An instance of the <tt>Blog_Module</tt> must be declared and registered in the
--  AWA application.  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Blog_Module : aliased AWA.Blogs.Modules.Blog_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Blogs.Modules.NAME,
--              URI    => "blogs",
--              Module => App.Blog_Module'Access);
--
package AWA.Blogs.Modules is

   NAME : constant String := "blogs";

   --  The configuration parameter that defines the image link prefix in rendered HTML content.
   PARAM_IMAGE_PREFIX : constant String := "image_prefix";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   --  Define the read post counter.
   package Read_Counter is new AWA.Counters.Definition (Models.POST_TABLE, "read_count");

   Not_Found : exception;

   type Blog_Module is new AWA.Modules.Module with private;
   type Blog_Module_Access is access all Blog_Module'Class;

   --  Initialize the blog module.
   overriding
   procedure Initialize (Plugin : in out Blog_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Blog_Module;
                        Props  : in ASF.Applications.Config);

   --  Get the blog module instance associated with the current application.
   function Get_Blog_Module return Blog_Module_Access;

   --  Get the image prefix that was configured for the Blog module.
   function Get_Image_Prefix (Module : in Blog_Module)
                              return Wiki.Strings.UString;

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

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

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

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

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

private

   type Blog_Module is new AWA.Modules.Module with record
      Image_Prefix : Wiki.Strings.UString;
      Image_Servlet : aliased AWA.Blogs.Servlets.Image_Servlet;
   end record;

end AWA.Blogs.Modules;

Add a Publish_Date member to the Update_Post operation


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

with ADO.Sessions;

with ASF.Applications;

with AWA.Modules;
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Users.Services;
package AWA.Workspaces.Modules is

   Not_Found : exception;

   --  The name under which the module is registered.
   NAME : constant String := "workspaces";

   --  ------------------------------
   --  Module workspaces
   --  ------------------------------
   type Workspace_Module is new AWA.Modules.Module with private;
   type Workspace_Module_Access is access all Workspace_Module'Class;

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

   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref);

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

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

private

   type Workspace_Module is new AWA.Modules.Module with record
      User_Manager : AWA.Users.Services.User_Service_Access;
   end record;

end AWA.Workspaces.Modules;

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

with ADO.Sessions;

with ASF.Applications;

with AWA.Modules;
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Users.Services;
package AWA.Workspaces.Modules is

   Not_Found : exception;

   --  The name under which the module is registered.
   NAME : constant String := "workspaces";

   --  ------------------------------
   --  Module workspaces
   --  ------------------------------
   type Workspace_Module is new AWA.Modules.Module with private;
   type Workspace_Module_Access is access all Workspace_Module'Class;

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

   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref);

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

   --  Accept the invitation identified by the access key.
   procedure Accept_Invitation (Module     : in Workspace_Module;
                                Key        : in String);

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

private

   type Workspace_Module is new AWA.Modules.Module with record
      User_Manager : AWA.Users.Services.User_Service_Access;
   end record;

end AWA.Workspaces.Modules;

Declare the Accept_Invitation procedure

Declare the Accept_Invitation procedure


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

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

   pragma Preelaborate;

end AWA.Questions;

Add Preelaborate

Add Preelaborate


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

with Security.Permissions;

with AWA.Modules;

with EL.Expressions;

with AWA.Storages.Models;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
package AWA.Images.Services is

   package ACL_Create_Storage is new Security.Permissions.Definition ("storage-create");
   package ACL_Delete_Storage is new Security.Permissions.Definition ("storage-delete");
   package ACL_Create_Folder is new Security.Permissions.Definition ("folder-create");

   PARAM_THUMBNAIL_COMMAND : constant String := "thumbnail_command";

   --  ------------------------------
   --  Image Service
   --  ------------------------------
   --  The Image_Service works closely with the storage service.  It extracts the
   --  information of an image, creates the image thumbnail.
   type Image_Service is new AWA.Modules.Module_Manager with private;
   type Image_Service_Access is access all Image_Service'Class;

   --  Initializes the image service.
   overriding
   procedure Initialize (Service : in out Image_Service;
                         Module  : in AWA.Modules.Module'Class);

   procedure Create_Thumbnail (Service : in Image_Service;
                               Source  : in String;
                               Into    : in String;
                               Width   : out Natural;
                               Height  : out Natural);

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Create_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class);

   --  Deletes the storage instance.
   procedure Delete_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class);

private

   type Image_Service is new AWA.Modules.Module_Manager with record
      Thumbnail_Command : EL.Expressions.Expression;
   end record;

end AWA.Images.Services;

-----------------------------------------------------------------------
--  awa-images-services -- Image service
--  Copyright (C) 2012, 2013, 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 Security.Permissions;

with ADO;

with AWA.Modules;

with EL.Expressions;

with AWA.Storages.Models;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
package AWA.Images.Services is

   package ACL_Create_Storage is new Security.Permissions.Definition ("storage-create");
   package ACL_Delete_Storage is new Security.Permissions.Definition ("storage-delete");
   package ACL_Create_Folder is new Security.Permissions.Definition ("folder-create");

   PARAM_THUMBNAIL_COMMAND : constant String := "thumbnail_command";

   --  ------------------------------
   --  Image Service
   --  ------------------------------
   --  The Image_Service works closely with the storage service.  It extracts the
   --  information of an image, creates the image thumbnail.
   type Image_Service is new AWA.Modules.Module_Manager with private;
   type Image_Service_Access is access all Image_Service'Class;

   --  Initializes the image service.
   overriding
   procedure Initialize (Service : in out Image_Service;
                         Module  : in AWA.Modules.Module'Class);

   procedure Create_Thumbnail (Service : in Image_Service;
                               Source  : in String;
                               Into    : in String;
                               Width   : out Natural;
                               Height  : out Natural);

   --  Build a thumbnail for the image identified by the Id.
   procedure Build_Thumbnail (Service : in Image_Service;
                              Id      : in ADO.Identifier);

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Create_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class);

   --  Deletes the storage instance.
   procedure Delete_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class);

private

   type Image_Service is new AWA.Modules.Module_Manager with record
      Thumbnail_Command : EL.Expressions.Expression;
   end record;

end AWA.Images.Services;

Declare the Build_Thumbnail procedure

Declare the Build_Thumbnail procedure


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

with Util.Systems.Os;
with Interfaces.C;
private package Util.Processes.Os is

   use Util.Systems.Os;

   type Wchar_Ptr is access all Interfaces.C.wchar_array;

   type System_Process is new Util.Processes.System_Process with record
      Process_Info : aliased Util.Systems.Os.PROCESS_INFORMATION;
      Command      : Wchar_Ptr := null;
      Pos          : Interfaces.C.size_t := 0;
   end record;

   --  Wait for the process to exit.
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration);

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE);

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15);

   --  Append the argument to the process argument list.
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String);

   --  Set the process input, output and error streams to redirect and use specified files.
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean);

   --  Deletes the storage held by the system process.
   overriding
   procedure Finalize (Sys : in out System_Process);

   --  Build the output pipe redirection to read the process output.
   procedure Build_Output_Pipe (Proc : in out Process'Class;
                                Into : in out Startup_Info);

   --  Build the input pipe redirection to write the process standard input.
   procedure Build_Input_Pipe (Proc : in out Process'Class;
                               Into : in out Startup_Info);

private

   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   function Create_Stream (File : in Util.Streams.Raw.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access;

end Util.Processes.Os;

-----------------------------------------------------------------------
--  util-processes-os -- Windows specific and low level operations
--  Copyright (C) 2011, 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 Util.Streams.Raw;

with Util.Systems.Os;
with Interfaces.C;
private package Util.Processes.Os is

   use Util.Systems.Os;

   SHELL : constant String := "";

   type Wchar_Ptr is access all Interfaces.C.wchar_array;

   type System_Process is new Util.Processes.System_Process with record
      Process_Info : aliased Util.Systems.Os.PROCESS_INFORMATION;
      Command      : Wchar_Ptr := null;
      Pos          : Interfaces.C.size_t := 0;
   end record;

   --  Wait for the process to exit.
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration);

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE);

   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15);

   --  Append the argument to the process argument list.
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String);

   --  Set the process input, output and error streams to redirect and use specified files.
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean);

   --  Deletes the storage held by the system process.
   overriding
   procedure Finalize (Sys : in out System_Process);

   --  Build the output pipe redirection to read the process output.
   procedure Build_Output_Pipe (Proc : in out Process'Class;
                                Into : in out Startup_Info);

   --  Build the input pipe redirection to write the process standard input.
   procedure Build_Input_Pipe (Proc : in out Process'Class;
                               Into : in out Startup_Info);

private

   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   function Create_Stream (File : in Util.Streams.Raw.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access;

end Util.Processes.Os;

Declare the SHELL constant (empty so that we use the default argument splitting method)