--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "67";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_make           : constant String := "/usr/bin/make";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   host_bmake          : constant String := host_localbase & "/bin/bmake";
   host_make_program   : constant String := host_make;
   chroot_make         : constant String := "/usr/bin/make";
   chroot_bmake        : constant String := "/usr/pkg/bin/bmake -m /usr/pkg/share/mk";
   chroot_make_program : constant String := chroot_make;
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type package_system is (ports_collection, pkgsrc);

   software_framework : constant package_system := ports_collection;

   --  Notes for tailoring Synth.  Use sed to:
   --  1. Modify host_localbase to value of LOCALBASE
   --  2. Change software_framework to "pkgsrc" for pkgsrc version
   --  3. Change host_make_program to "host_bmake" for Non-NetBSD pkgsrc platforms
   --  4. Change chroot_make_program to "chroot_bmake" for pkgsrc version
   --  5. On replicant.ads, change "/usr/local" to "/usr/pkg" on pkgsrc

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "68";
   copyright_years     : constant String := "2015-2017";
   host_localbase      : constant String := "/usr/local";
   host_make           : constant String := "/usr/bin/make";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   host_bmake          : constant String := host_localbase & "/bin/bmake";
   host_make_program   : constant String := host_make;
   chroot_make         : constant String := "/usr/bin/make";
   chroot_bmake        : constant String := "/usr/pkg/bin/bmake -m /usr/pkg/share/mk";
   chroot_make_program : constant String := chroot_make;
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type package_system is (ports_collection, pkgsrc);

   software_framework : constant package_system := ports_collection;

   --  Notes for tailoring Synth.  Use sed to:
   --  1. Modify host_localbase to value of LOCALBASE
   --  2. Change software_framework to "pkgsrc" for pkgsrc version
   --  3. Change host_make_program to "host_bmake" for Non-NetBSD pkgsrc platforms
   --  4. Change chroot_make_program to "chroot_bmake" for pkgsrc version
   --  5. On replicant.ads, change "/usr/local" to "/usr/pkg" on pkgsrc

end Definitions;

Bump version and copyright years

Bump version and copyright years


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2016 onox <denkpadje@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 System;

with GL.API;
with GL.Low_Level;
with GL.Types.Indirect;

package body GL.Drawing is

   procedure Draw_Arrays
     (Mode          : Connection_Mode;
      Offset, Count : Size;
      Instances     : Size := 1;
      Base_Instance : Size := 0) is
   begin
      API.Draw_Arrays_Instanced_Base_Instance.Ref
        (Mode, Offset, Count, Instances, UInt (Base_Instance));
   end Draw_Arrays;

   procedure Draw_Multiple_Arrays_Indirect
     (Mode   : Connection_Mode;
      Count  : Size;
      Offset : Size := 0)
   is
      use GL.Types.Indirect;

      Offset_In_Bytes : constant Size
        := Offset * Arrays_Indirect_Command'Size / System.Storage_Unit;
   begin
      API.Multi_Draw_Arrays_Indirect.Ref (Mode, Offset_In_Bytes, Count, 0);
   end Draw_Multiple_Arrays_Indirect;

   procedure Draw_Multiple_Arrays_Indirect_Count
     (Mode      : Connection_Mode;
      Max_Count : Size;
      Offset, Count_Offset : Size := 0)
   is
      use GL.Types.Indirect;

      Offset_In_Bytes : constant Size
        := Offset * Arrays_Indirect_Command'Size / System.Storage_Unit;
      Count_Offset_In_Bytes : constant Size
        := Offset * Size'Size / System.Storage_Unit;
      pragma Assert (Count_Offset_In_Bytes mod 4 = 0);
   begin
      API.Multi_Draw_Arrays_Indirect_Count.Ref
        (Mode, Offset_In_Bytes, Low_Level.IntPtr (Count_Offset), Max_Count, 0);
   end Draw_Multiple_Arrays_Indirect_Count;

   procedure Draw_Elements
     (Mode          : Connection_Mode;
      Count         : Size;
      Index_Kind    : Index_Type;
      Index_Offset  : Natural;
      Instances     : Size := 1;
      Base_Instance : Size := 0;
      Base_Vertex   : Size := 0)
   is
      Element_Bytes : Natural;
   begin
      case Index_Kind is
         when UShort_Type => Element_Bytes := 2;
         when UInt_Type   => Element_Bytes := 4;
      end case;
      API.Draw_Elements_Instanced_Base_Vertex_Base_Instance.Ref
        (Mode, Count, Index_Kind, Low_Level.IntPtr (Element_Bytes * Index_Offset),
         Instances, Int (Base_Vertex), UInt (Base_Instance));
   end Draw_Elements;

   procedure Draw_Multiple_Elements_Indirect
     (Mode       : Connection_Mode;
      Index_Kind : Index_Type;
      Count      : Size;
      Offset     : Size := 0)
   is
      use GL.Types.Indirect;

      Offset_In_Bytes : constant Size
        := Offset * Elements_Indirect_Command'Size / System.Storage_Unit;
   begin
      API.Multi_Draw_Elements_Indirect.Ref
        (Mode, Index_Kind, Offset_In_Bytes, Count, 0);
   end Draw_Multiple_Elements_Indirect;

   procedure Draw_Multiple_Elements_Indirect_Count
     (Mode         : Connection_Mode;
      Index_Kind   : Index_Type;
      Max_Count    : Size;
      Offset, Count_Offset : Size := 0)
   is
      use GL.Types.Indirect;

      Offset_In_Bytes : constant Size
        := Offset * Elements_Indirect_Command'Size / System.Storage_Unit;
      Count_Offset_In_Bytes : constant Size
        := Offset * Size'Size / System.Storage_Unit;
      pragma Assert (Count_Offset_In_Bytes mod 4 = 0);
   begin
      API.Multi_Draw_Elements_Indirect_Count.Ref
        (Mode, Index_Kind, Offset_In_Bytes,
         Low_Level.IntPtr (Count_Offset_In_Bytes), Max_Count, 0);
   end Draw_Multiple_Elements_Indirect_Count;

end GL.Drawing;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2016 onox <denkpadje@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 System;

with GL.API;
with GL.Low_Level;
with GL.Types.Indirect;

package body GL.Drawing is

   procedure Draw_Arrays
     (Mode          : Connection_Mode;
      Offset, Count : Size;
      Instances     : Size := 1;
      Base_Instance : Size := 0) is
   begin
      API.Draw_Arrays_Instanced_Base_Instance.Ref
        (Mode, Offset, Count, Instances, UInt (Base_Instance));
   end Draw_Arrays;

   procedure Draw_Multiple_Arrays_Indirect
     (Mode   : Connection_Mode;
      Count  : Size;
      Offset : Size := 0)
   is
      use GL.Types.Indirect;

      Offset_In_Bytes : constant Size
        := Offset * Arrays_Indirect_Command'Size / System.Storage_Unit;
   begin
      API.Multi_Draw_Arrays_Indirect.Ref (Mode, Offset_In_Bytes, Count, 0);
   end Draw_Multiple_Arrays_Indirect;

   procedure Draw_Multiple_Arrays_Indirect_Count
     (Mode      : Connection_Mode;
      Max_Count : Size;
      Offset, Count_Offset : Size := 0)
   is
      use GL.Types.Indirect;

      Offset_In_Bytes : constant Size
        := Offset * Arrays_Indirect_Command'Size / System.Storage_Unit;
      Count_Offset_In_Bytes : constant Size
        := Offset * Size'Size / System.Storage_Unit;
      pragma Assert (Count_Offset_In_Bytes mod 4 = 0);
   begin
      API.Multi_Draw_Arrays_Indirect_Count.Ref
        (Mode, Offset_In_Bytes, Low_Level.IntPtr (Count_Offset), Max_Count, 0);
   end Draw_Multiple_Arrays_Indirect_Count;

   procedure Draw_Elements
     (Mode          : Connection_Mode;
      Count         : Size;
      Index_Kind    : Index_Type;
      Index_Offset  : Natural;
      Instances     : Size := 1;
      Base_Instance : Size := 0;
      Base_Vertex   : Size := 0)
   is
      Element_Bytes : Natural;
   begin
      case Index_Kind is
         when UShort_Type => Element_Bytes := 2;
         when UInt_Type   => Element_Bytes := 4;
      end case;
      API.Draw_Elements_Instanced_Base_Vertex_Base_Instance.Ref
        (Mode, Count, Index_Kind, Low_Level.IntPtr (Element_Bytes * Index_Offset),
         Instances, Int (Base_Vertex), UInt (Base_Instance));
   end Draw_Elements;

   procedure Draw_Multiple_Elements_Indirect
     (Mode       : Connection_Mode;
      Index_Kind : Index_Type;
      Count      : Size;
      Offset     : Size := 0)
   is
      use GL.Types.Indirect;

      Offset_In_Bytes : constant Size
        := Offset * Elements_Indirect_Command'Size / System.Storage_Unit;
   begin
      API.Multi_Draw_Elements_Indirect.Ref
        (Mode, Index_Kind, Offset_In_Bytes, Count, 0);
   end Draw_Multiple_Elements_Indirect;

   procedure Draw_Multiple_Elements_Indirect_Count
     (Mode         : Connection_Mode;
      Index_Kind   : Index_Type;
      Max_Count    : Size;
      Offset, Count_Offset : Size := 0)
   is
      use GL.Types.Indirect;

      Offset_In_Bytes : constant Size
        := Offset * Elements_Indirect_Command'Size / System.Storage_Unit;
      Count_Offset_In_Bytes : constant Size
        := Count_Offset * Size'Size / System.Storage_Unit;
      pragma Assert (Count_Offset_In_Bytes mod 4 = 0);
   begin
      API.Multi_Draw_Elements_Indirect_Count.Ref
        (Mode, Index_Kind, Offset_In_Bytes,
         Low_Level.IntPtr (Count_Offset_In_Bytes), Max_Count, 0);
   end Draw_Multiple_Elements_Indirect_Count;

end GL.Drawing;

gl: Fix unused formal parameter of a procedure in package GL.Drawing

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


-----------------------------------------------------------------------
--  util-streams-buffered -- Buffered streams utilities
--  Copyright (C) 2010, 2013, 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.Finalization;

--  == Buffered Streams ==
--  The `Output_Buffer_Stream` and `Input_Buffer_Stream` implement an output
--  and input stream respectively which manages an output or input buffer.  The data is
--  first written to the buffer and when the buffer is full or flushed, it gets written
--  to the target output stream.
--
--  The `Output_Buffer_Stream` must be initialized to indicate the buffer size as well
--  as the target output stream onto which the data will be flushed.  For example, a
--  pipe stream could be created and configured to use the buffer as follows:
--
--    with Util.Streams.Buffered;
--    with Util.Streams.Pipes;
--    ...
--       Pipe   : aliased Util.Streams.Pipes.Pipe_Stream;
--       Buffer : Util.Streams.Buffered.Output_Buffer_Stream;
--       ...
--          Buffer.Initialize (Output => Pipe'Unchecked_Access,
--                             Size => 1024);
--
--  In this example, the buffer of 1024 bytes is configured to flush its content to the
--  pipe input stream so that what is written to the buffer will be received as input by
--  the program.
--  The `Output_Buffer_Stream` provides write operation that deal only with binary data
--  (`Stream_Element`).  To write text, it is best to use the `Print_Stream` type from
--  the `Util.Streams.Texts` package as it extends the `Output_Buffer_Stream` and provides
--  several operations to write character and strings.
--
--  The `Input_Buffer_Stream` must also be initialized to also indicate the buffer size
--  and either an input stream or an input content.  When configured, the input stream is used
--  to fill the input stream buffer.  The buffer configuration is very similar as the
--  output stream:
--
--    with Util.Streams.Buffered;
--    with Util.Streams.Pipes;
--    ...
--       Pipe   : aliased Util.Streams.Pipes.Pipe_Stream;
--       Buffer : Util.Streams.Buffered.Input_Buffer_Stream;
--       ...
--          Buffer.Initialize (Input => Pipe'Unchecked_Access, Size => 1024);
--
--  In this case, the buffer of 1024 bytes is filled by reading the pipe stream, and thus
--  getting the program's output.
package Util.Streams.Buffered is

   pragma Preelaborate;

   type Buffer_Access is access Ada.Streams.Stream_Element_Array;

   --  -----------------------
   --  Output buffer stream
   --  -----------------------
   --  The Output_Buffer_Stream is an output stream which uses
   --  an intermediate buffer to write the data.
   --
   --  It is necessary to call Flush to make sure the data
   --  is written to the target stream.  The Flush operation will
   --  be called when finalizing the output buffer stream.
   type Output_Buffer_Stream is limited new Output_Stream with private;

   --  Initialize the stream to write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream  : in out Output_Buffer_Stream;
                         Output  : access Output_Stream'Class;
                         Size    : in Positive);

   --  Initialize the stream with a buffer of Size bytes.
   procedure Initialize (Stream  : in out Output_Buffer_Stream;
                         Size    : in Positive);

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

   --  Get the direct access to the buffer.
   function Get_Buffer (Stream : in Output_Buffer_Stream) return Buffer_Access;

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

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Output_Buffer_Stream);

   --  Flush the buffer in the <tt>Into</tt> array and return the index of the
   --  last element (inclusive) in <tt>Last</tt>.
   procedure Flush (Stream : in out Output_Buffer_Stream;
                    Into   : out Ada.Streams.Stream_Element_Array;
                    Last   : out Ada.Streams.Stream_Element_Offset);

   --  Flush the buffer stream to the unbounded string.
   procedure Flush (Stream : in out Output_Buffer_Stream;
                    Into   : out Ada.Strings.Unbounded.Unbounded_String);

   --  Get the number of element in the stream.
   function Get_Size (Stream : in Output_Buffer_Stream) return Natural;

   type Input_Buffer_Stream is limited new Input_Stream with private;

   --  Initialize the stream to read from the string.
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         Content : in String);

   --  Initialize the stream to read the given streams.
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         Input   : access Input_Stream'Class;
                         Size    : in Positive);

   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   procedure Fill (Stream : in out Input_Buffer_Stream);

   --  Read one character from the input stream.
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Char   : out Character);

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

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Returns True if the end of the stream is reached.
   function Is_Eof (Stream : in Input_Buffer_Stream) return Boolean;

private

   use Ada.Streams;

   type Output_Buffer_Stream is limited new Ada.Finalization.Limited_Controlled
     and Output_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The output stream to use for flushing the buffer.
      Output      : access Output_Stream'Class;

      No_Flush    : Boolean := False;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Output_Buffer_Stream);

   type Input_Buffer_Stream is limited new Ada.Finalization.Limited_Controlled
     and Input_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The input stream to use to fill the buffer.
      Input       : access Input_Stream'Class;

      --  Reached end of file when reading.
      Eof         : Boolean := False;
   end record;

   --  Release the buffer.
   overriding
   procedure Finalize (Object : in out Input_Buffer_Stream);

end Util.Streams.Buffered;

-----------------------------------------------------------------------
--  util-streams-buffered -- Buffered streams utilities
--  Copyright (C) 2010, 2013, 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.Finalization;

--  == Buffered Streams ==
--  The `Output_Buffer_Stream` and `Input_Buffer_Stream` implement an output
--  and input stream respectively which manages an output or input buffer.  The data is
--  first written to the buffer and when the buffer is full or flushed, it gets written
--  to the target output stream.
--
--  The `Output_Buffer_Stream` must be initialized to indicate the buffer size as well
--  as the target output stream onto which the data will be flushed.  For example, a
--  pipe stream could be created and configured to use the buffer as follows:
--
--    with Util.Streams.Buffered;
--    with Util.Streams.Pipes;
--    ...
--       Pipe   : aliased Util.Streams.Pipes.Pipe_Stream;
--       Buffer : Util.Streams.Buffered.Output_Buffer_Stream;
--       ...
--          Buffer.Initialize (Output => Pipe'Unchecked_Access,
--                             Size => 1024);
--
--  In this example, the buffer of 1024 bytes is configured to flush its content to the
--  pipe input stream so that what is written to the buffer will be received as input by
--  the program.
--  The `Output_Buffer_Stream` provides write operation that deal only with binary data
--  (`Stream_Element`).  To write text, it is best to use the `Print_Stream` type from
--  the `Util.Streams.Texts` package as it extends the `Output_Buffer_Stream` and provides
--  several operations to write character and strings.
--
--  The `Input_Buffer_Stream` must also be initialized to also indicate the buffer size
--  and either an input stream or an input content.  When configured, the input stream is used
--  to fill the input stream buffer.  The buffer configuration is very similar as the
--  output stream:
--
--    with Util.Streams.Buffered;
--    with Util.Streams.Pipes;
--    ...
--       Pipe   : aliased Util.Streams.Pipes.Pipe_Stream;
--       Buffer : Util.Streams.Buffered.Input_Buffer_Stream;
--       ...
--          Buffer.Initialize (Input => Pipe'Unchecked_Access, Size => 1024);
--
--  In this case, the buffer of 1024 bytes is filled by reading the pipe stream, and thus
--  getting the program's output.
package Util.Streams.Buffered is

   pragma Preelaborate;

   type Buffer_Access is access Ada.Streams.Stream_Element_Array;

   --  -----------------------
   --  Output buffer stream
   --  -----------------------
   --  The Output_Buffer_Stream is an output stream which uses
   --  an intermediate buffer to write the data.
   --
   --  It is necessary to call Flush to make sure the data
   --  is written to the target stream.  The Flush operation will
   --  be called when finalizing the output buffer stream.
   type Output_Buffer_Stream is limited new Output_Stream with private;

   --  Initialize the stream to write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream  : in out Output_Buffer_Stream;
                         Output  : access Output_Stream'Class;
                         Size    : in Positive);

   --  Initialize the stream with a buffer of Size bytes.
   procedure Initialize (Stream  : in out Output_Buffer_Stream;
                         Size    : in Positive);

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

   --  Get the direct access to the buffer.
   function Get_Buffer (Stream : in Output_Buffer_Stream) return Buffer_Access;

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

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Output_Buffer_Stream);

   --  Flush the buffer in the <tt>Into</tt> array and return the index of the
   --  last element (inclusive) in <tt>Last</tt>.
   procedure Flush (Stream : in out Output_Buffer_Stream;
                    Into   : out Ada.Streams.Stream_Element_Array;
                    Last   : out Ada.Streams.Stream_Element_Offset);

   --  Flush the buffer stream to the unbounded string.
   procedure Flush (Stream : in out Output_Buffer_Stream;
                    Into   : out Ada.Strings.Unbounded.Unbounded_String);

   --  Get the number of element in the stream.
   function Get_Size (Stream : in Output_Buffer_Stream) return Natural;

   type Input_Buffer_Stream is limited new Input_Stream with private;

   --  Initialize the stream to read from the string.
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         Content : in String);

   --  Initialize the stream to read the given streams.
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         Input   : access Input_Stream'Class;
                         Size    : in Positive);

   --  Initialize the stream from the buffer created for an output stream.
   procedure Initialize (Stream  : in out Input_Buffer_Stream;
                         From    : in out Output_Buffer_Stream'Class);

   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   procedure Fill (Stream : in out Input_Buffer_Stream);

   --  Read one character from the input stream.
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Char   : out Character);

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

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Input_Buffer_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Returns True if the end of the stream is reached.
   function Is_Eof (Stream : in Input_Buffer_Stream) return Boolean;

private

   use Ada.Streams;

   type Output_Buffer_Stream is limited new Ada.Finalization.Limited_Controlled
     and Output_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The output stream to use for flushing the buffer.
      Output      : access Output_Stream'Class;

      No_Flush    : Boolean := False;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Output_Buffer_Stream);

   type Input_Buffer_Stream is limited new Ada.Finalization.Limited_Controlled
     and Input_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The input stream to use to fill the buffer.
      Input       : access Input_Stream'Class;

      --  Reached end of file when reading.
      Eof         : Boolean := False;
   end record;

   --  Release the buffer.
   overriding
   procedure Finalize (Object : in out Input_Buffer_Stream);

end Util.Streams.Buffered;

Declare a new Initialize procedure to setup an Input_Stream from the content of an Output_Stream


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

with Util.Systems.Os;
with Util.Streams.Texts;
package body Util.Processes.Tools is

   procedure Execute (Command : in String;
                      Process : in out Util.Streams.Pipes.Pipe_Stream;
                      Output  : in out Util.Strings.Vectors.Vector;
                      Status  : out Integer) is
      Text : Util.Streams.Texts.Reader_Stream;
   begin
      Text.Initialize (Process'Unchecked_Access);
      Process.Open (Command, Util.Processes.READ);
      while not Text.Is_Eof loop
         declare
            Line : Ada.Strings.Unbounded.Unbounded_String;
         begin
            Text.Read_Line (Line, Strip => True);
            if Ada.Strings.Unbounded.Length (Line) > 0 then
	       Output.Append (Ada.Strings.Unbounded.To_String (Line));
	    end if;
         end;
      end loop;
      Process.Close;
      Status := Process.Get_Exit_Status;
   end Execute;

   --  ------------------------------
   --  Execute the command and append the output in the vector array.
   --  The program output is read line by line and the standard input is closed.
   --  Return the program exit status.
   --  ------------------------------
   procedure Execute (Command : in String;
                      Output  : in out Util.Strings.Vectors.Vector;
                      Status  : out Integer) is
      Proc : Util.Streams.Pipes.Pipe_Stream;
   begin
      Proc.Add_Close (Util.Systems.Os.STDIN_FILENO);
      Execute (Command, Proc, Output, Status);
   end Execute;

   procedure Execute (Command    : in String;
                      Input_Path : in String;
                      Output     : in out Util.Strings.Vectors.Vector;
                      Status     : out Integer) is
      Proc : Util.Streams.Pipes.Pipe_Stream;
   begin
      Proc.Set_Input_Stream (Input_Path);
      Execute (Command, Proc, Output, Status);
   end Execute;

end Util.Processes.Tools;

Replace tabs by spaces

Replace tabs by spaces


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

with Util.Test_Caller;
with Util.Log.Loggers;
with Util.Streams.Files;
with Util.Beans.Objects.Readers;

package body Util.Serialize.IO.Form.Tests is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.IO.Form");

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.Form");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Parse (parse errors)",
                       Test_Parse_Error'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Parse (parse Ok)",
                       Test_Parser'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Write",
                       Test_Output'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Read",
                       Test_Read'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various form parsing errors.
   --  ------------------------------
   procedure Test_Parse_Error (T : in out Test) is

      procedure Check_Parse_Error (Content : in String);

      procedure Check_Parse_Error (Content : in String) is
         P : Parser;
         R : Util.Beans.Objects.Readers.Reader;
      begin
         P.Parse_String (Content, R);
         Log.Error ("No exception raised for: {0}", Content);
         T.Fail ("No exception for " & Content);

      exception
         when Parse_Error =>
            null;
      end Check_Parse_Error;

   begin
      Check_Parse_Error ("bad");
      Check_Parse_Error ("bad=%rw%ad");
   end Test_Parse_Error;

   --  ------------------------------
   --  Check various (basic) JSformON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is

      procedure Check_Parse (Content : in String);

      procedure Check_Parse (Content : in String) is
         P : Parser;
         R : Util.Beans.Objects.Readers.Reader;
      begin
         P.Parse_String (Content, R);

      exception
         when Parse_Error =>
            Log.Error ("Parse error for: " & Content);
            T.Fail ("Parse error for: " & Content);
      end Check_Parse;

   begin
      Check_Parse ("name=value");
      Check_Parse ("name=value&param=value");
      Check_Parse ("name+name=value+value");
      Check_Parse ("name%20%30=value%23%ce");
   end Test_Parser;

   --  ------------------------------
   --  Generate some output stream for the test.
   --  ------------------------------
   procedure Write_Stream (Stream : in out Util.Serialize.IO.Output_Stream'Class) is
      Name : Ada.Strings.Unbounded.Unbounded_String;
      Wide : constant Wide_Wide_String :=
        Ada.Characters.Wide_Wide_Latin_1.CR &
        Ada.Characters.Wide_Wide_Latin_1.LF &
        Ada.Characters.Wide_Wide_Latin_1.HT &
        Wide_Wide_Character'Val (16#080#) &
        Wide_Wide_Character'Val (16#1fC#) &
        Wide_Wide_Character'Val (16#20AC#) & -- Euro sign
        Wide_Wide_Character'Val (16#2acbf#);
      T : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 23, 0, 0);
   begin
      Ada.Strings.Unbounded.Append (Name, "Katniss Everdeen");
      Stream.Start_Document;
      Stream.Start_Entity ("root");
      Stream.Start_Entity ("person");
      Stream.Write_Attribute ("id", 1);
      Stream.Write_Attribute ("name", Name);
      Stream.Write_Entity ("name", Name);
      Stream.Write_Entity ("gender", "female");
      Stream.Write_Entity ("volunteer", True);
      Stream.Write_Entity ("age", 17);
      Stream.Write_Entity ("date", T);
      Stream.Write_Wide_Entity ("skin", "olive skin");
      Stream.Start_Array ("badges");

      Stream.Start_Entity ("badge");
      Stream.Write_Entity ("level", "gold");
      Stream.Write_Entity ("name", "hunter");
      Stream.End_Entity ("badge");

      Stream.Start_Entity ("badge");
      Stream.Write_Entity ("level", "gold");
      Stream.Write_Entity ("name", "archery");
      Stream.End_Entity ("badge");
      Stream.End_Array ("badges");

      Stream.Start_Entity ("district");
      Stream.Write_Attribute ("id", 12);
      Stream.Write_Wide_Attribute ("industry", "Coal mining");
      Stream.Write_Attribute ("state", "<destroyed>");
      Stream.Write_Long_Entity ("members", 10_000);
      Stream.Write_Entity ("description", "<TBW>&""");
      Stream.Write_Wide_Entity ("wescape", "'""<>&;,@!`~[]{}^%*()-+=");
      Stream.Write_Entity ("escape", "'""<>&;,@!`~\[]{}^%*()-+=");
      Stream.Write_Wide_Entity ("wide", Wide);
      Stream.End_Entity ("district");

      Stream.End_Entity ("person");
      Stream.End_Entity ("root");
      Stream.End_Document;
   end Write_Stream;

   --  ------------------------------
   --  Test the JSON output stream generation.
   --  ------------------------------
   procedure Test_Output (T : in out Test) is
      File   : aliased Util.Streams.Files.File_Stream;
      Buffer : aliased Util.Streams.Texts.Print_Stream;
      Stream : Util.Serialize.IO.Form.Output_Stream;
      Expect : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.form");
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.form");
   begin
      File.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Path);
      Buffer.Initialize (Output => File'Unchecked_Access, Size => 10000);
      Stream.Initialize (Output => Buffer'Unchecked_Access);
      Write_Stream (Stream);
      Stream.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "Form output serialization");
   end Test_Output;

   --  ------------------------------
   --  Test reading a form content into an Object tree.
   --  ------------------------------
   procedure Test_Read (T : in out Test) is
      use Util.Beans.Objects;
      Path  : constant String := Util.Tests.Get_Test_Path ("regtests/files/pass-01.form");
      Root  : Util.Beans.Objects.Object;
      Value : Util.Beans.Objects.Object;
   begin
      Root := Read (Path);
      T.Assert (not Util.Beans.Objects.Is_Null (Root), "Read should not return null object");
      T.Assert (not Util.Beans.Objects.Is_Array (Root), "Root object is not an array");

      Value := Util.Beans.Objects.Get_Value (Root, "home");
      Util.Tests.Assert_Equals (T, "Cosby",
                                Util.Beans.Objects.To_String (Value),
                                "Invalid first parameter");
      Value := Util.Beans.Objects.Get_Value (Root, "favorite flavor");
      Util.Tests.Assert_Equals (T, "flies",
                                Util.Beans.Objects.To_String (Value),
                                "Invalid second parameter");
   end Test_Read;

end Util.Serialize.IO.Form.Tests;

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

with Util.Test_Caller;
with Util.Log.Loggers;
with Util.Streams.Files;
with Util.Beans.Objects.Readers;

package body Util.Serialize.IO.Form.Tests is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.IO.Form");

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.Form");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Parse (parse errors)",
                       Test_Parse_Error'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Parse (parse Ok)",
                       Test_Parser'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Write",
                       Test_Output'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Read",
                       Test_Read'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various form parsing errors.
   --  ------------------------------
   procedure Test_Parse_Error (T : in out Test) is

      procedure Check_Parse_Error (Content : in String);

      procedure Check_Parse_Error (Content : in String) is
         P : Parser;
         R : Util.Beans.Objects.Readers.Reader;
      begin
         P.Parse_String (Content, R);
         Log.Error ("No exception raised for: {0}", Content);
         T.Fail ("No exception for " & Content);

      exception
         when Parse_Error =>
            null;
      end Check_Parse_Error;

   begin
      --  Check_Parse_Error ("bad");
      Check_Parse_Error ("bad=%rw%ad");
   end Test_Parse_Error;

   --  ------------------------------
   --  Check various (basic) JSformON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is

      procedure Check_Parse (Content : in String);

      procedure Check_Parse (Content : in String) is
         P : Parser;
         R : Util.Beans.Objects.Readers.Reader;
      begin
         P.Parse_String (Content, R);

      exception
         when Parse_Error =>
            Log.Error ("Parse error for: " & Content);
            T.Fail ("Parse error for: " & Content);
      end Check_Parse;

   begin
      Check_Parse ("name=value");
      Check_Parse ("name=value&param=value");
      Check_Parse ("name+name=value+value");
      Check_Parse ("name%20%30=value%23%ce");
   end Test_Parser;

   --  ------------------------------
   --  Generate some output stream for the test.
   --  ------------------------------
   procedure Write_Stream (Stream : in out Util.Serialize.IO.Output_Stream'Class) is
      Name : Ada.Strings.Unbounded.Unbounded_String;
      Wide : constant Wide_Wide_String :=
        Ada.Characters.Wide_Wide_Latin_1.CR &
        Ada.Characters.Wide_Wide_Latin_1.LF &
        Ada.Characters.Wide_Wide_Latin_1.HT &
        Wide_Wide_Character'Val (16#080#) &
        Wide_Wide_Character'Val (16#1fC#) &
        Wide_Wide_Character'Val (16#20AC#) & -- Euro sign
        Wide_Wide_Character'Val (16#2acbf#);
      T : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 23, 0, 0);
   begin
      Ada.Strings.Unbounded.Append (Name, "Katniss Everdeen");
      Stream.Start_Document;
      Stream.Start_Entity ("root");
      Stream.Start_Entity ("person");
      Stream.Write_Attribute ("id", 1);
      Stream.Write_Attribute ("name", Name);
      Stream.Write_Entity ("name", Name);
      Stream.Write_Entity ("gender", "female");
      Stream.Write_Entity ("volunteer", True);
      Stream.Write_Entity ("age", 17);
      Stream.Write_Entity ("date", T);
      Stream.Write_Wide_Entity ("skin", "olive skin");
      Stream.Start_Array ("badges");

      Stream.Start_Entity ("badge");
      Stream.Write_Entity ("level", "gold");
      Stream.Write_Entity ("name", "hunter");
      Stream.End_Entity ("badge");

      Stream.Start_Entity ("badge");
      Stream.Write_Entity ("level", "gold");
      Stream.Write_Entity ("name", "archery");
      Stream.End_Entity ("badge");
      Stream.End_Array ("badges");

      Stream.Start_Entity ("district");
      Stream.Write_Attribute ("id", 12);
      Stream.Write_Wide_Attribute ("industry", "Coal mining");
      Stream.Write_Attribute ("state", "<destroyed>");
      Stream.Write_Long_Entity ("members", 10_000);
      Stream.Write_Entity ("description", "<TBW>&""");
      Stream.Write_Wide_Entity ("wescape", "'""<>&;,@!`~[]{}^%*()-+=");
      Stream.Write_Entity ("escape", "'""<>&;,@!`~\[]{}^%*()-+=");
      Stream.Write_Wide_Entity ("wide", Wide);
      Stream.End_Entity ("district");

      Stream.End_Entity ("person");
      Stream.End_Entity ("root");
      Stream.End_Document;
   end Write_Stream;

   --  ------------------------------
   --  Test the JSON output stream generation.
   --  ------------------------------
   procedure Test_Output (T : in out Test) is
      File   : aliased Util.Streams.Files.File_Stream;
      Buffer : aliased Util.Streams.Texts.Print_Stream;
      Stream : Util.Serialize.IO.Form.Output_Stream;
      Expect : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.form");
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.form");
   begin
      File.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Path);
      Buffer.Initialize (Output => File'Unchecked_Access, Size => 10000);
      Stream.Initialize (Output => Buffer'Unchecked_Access);
      Write_Stream (Stream);
      Stream.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "Form output serialization");
   end Test_Output;

   --  ------------------------------
   --  Test reading a form content into an Object tree.
   --  ------------------------------
   procedure Test_Read (T : in out Test) is
      use Util.Beans.Objects;
      Path  : constant String := Util.Tests.Get_Test_Path ("regtests/files/pass-01.form");
      Root  : Util.Beans.Objects.Object;
      Value : Util.Beans.Objects.Object;
   begin
      Root := Read (Path);
      T.Assert (not Util.Beans.Objects.Is_Null (Root), "Read should not return null object");
      T.Assert (not Util.Beans.Objects.Is_Array (Root), "Root object is not an array");

      Value := Util.Beans.Objects.Get_Value (Root, "home");
      Util.Tests.Assert_Equals (T, "Cosby",
                                Util.Beans.Objects.To_String (Value),
                                "Invalid first parameter");
      Value := Util.Beans.Objects.Get_Value (Root, "favorite flavor");
      Util.Tests.Assert_Equals (T, "flies",
                                Util.Beans.Objects.To_String (Value),
                                "Invalid second parameter");
   end Test_Read;

end Util.Serialize.IO.Form.Tests;

Disable possibly wrong test

Disable possibly wrong test


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

with Ada.Streams;

with Util.Streams.Pipes;
with Util.Strings;

with ASF.Parts;
package body Upload_Servlet is

   --  ------------------------------
   --  Write the upload form page with an optional response message.
   --  ------------------------------
   procedure Write (Response : in out Responses.Response'Class;
                    Message  : in String) is
      Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
   begin
      Output.Write ("<title>Upload servlet example</title>"
                    & ""
                    & ""
                    & "
Upload files to identify them
");

      --  Display the response or some error.
      if Message /= "" then
         Output.Write ("
" & Message & "
");
      end if;

      --  Render the form.  If we have some existing Radius or Height
      --  use them to set the initial values.
      Output.Write ("
Enter the height and radius of the cylinder
"
                    & "<form method='post' enctype='multipart/form-data'>"
                    & "
"
                    & "
File 1	"
                    & "<input type='file' size='50' name='file1' maxlength='100000'/>	"
                    & "

File 2	"
                    & "<input type='file' size='50' name='file2' maxlength='100000'/>	"
                    & "

File 3	"
                    & "<input type='file' size='50' name='file3' maxlength='100000'/>	"
                    & "
"
                    & "
	<input type='submit' value='Compute'></input>
"
                    & "
</form>"
                    & "");
      Response.Set_Status (Responses.SC_OK);
   end Write;

   --  ------------------------------
   --  Called by the servlet container when a GET request is received.
   --  Display the volume form page.
   --  ------------------------------
   procedure Do_Get (Server   : in Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is
      pragma Unreferenced (Server, Request);
   begin
      Write (Response, "");
   end Do_Get;

   --  ------------------------------
   --  Execute a command and write the result to the output stream.
   --  ------------------------------
   procedure Execute (Command : in String;
                      Output  : in out ASF.Streams.Print_Stream) is
      use type Ada.Streams.Stream_Element_Offset;

      Proc     : Util.Streams.Pipes.Pipe_Stream;
      Content  : Ada.Streams.Stream_Element_Array (0 .. 1024);
      Pos      : Ada.Streams.Stream_Element_Offset;
   begin
      Proc.Open (Command);
      loop
         Proc.Read (Into => Content,
                    Last => Pos);
         exit when Pos < 0;
         Output.Write (Content (0 .. Pos));
      end loop;
      Proc.Close;
      if Proc.Get_Exit_Status /= 0 then
         Output.Write ("Command '" & Command & "' exited with code "
                       & Integer'Image (Proc.Get_Exit_Status));
      end if;
   end Execute;

   --  ------------------------------
   --  Guess a file type depending on a content type or a file name.
   --  ------------------------------
   function Get_File_Type (Content_Type : in String;
                           Name         : in String) return File_Type is
   begin
      if Content_Type = "application/pdf" then
         return PDF;
      elsif Content_Type = "image/png" or Content_Type = "image/jpeg" then
         return IMAGE;
      elsif Content_Type = "image/gif" then
         return IMAGE;
      elsif Content_Type = "application/zip" then
         return ZIP;
      end if;
      declare
         Ext_Pos      : constant Natural := Util.Strings.Rindex (Name, '.');
      begin
         if Ext_Pos > 0 then
            if Name (Ext_Pos .. Name'Last) = ".gz" or Name (Ext_Pos .. Name'Last) = ".tgz" then
               return TAR_GZ;

            elsif Name (Ext_Pos .. Name'Last) = ".tar" then
               return TAR;

            elsif Name (Ext_Pos .. Name'Last) = ".jpg"
              or Name (Ext_Pos .. Name'Last) = ".gif"
              or Name (Ext_Pos .. Name'Last) = ".xbm"
              or Name (Ext_Pos .. Name'Last) = ".png" then
               return IMAGE;

            elsif Name (Ext_Pos .. Name'Last) = ".zip" then
               return ZIP;

            elsif Name (Ext_Pos .. Name'Last) = ".pdf" then
               return PDF;

            end if;
         end if;
         return UNKNOWN;
      end;
   end Get_File_Type;

   --  ------------------------------
   --  Called by the servlet container when a POST request is received.
   --  Receives the uploaded files and identify them using some external command.
   --  ------------------------------
   procedure Do_Post (Server   : in Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class) is
      pragma Unreferenced (Server);

      procedure Process_Part (Part : in ASF.Parts.Part'Class);

      Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;

      procedure Process_Part (Part : in ASF.Parts.Part'Class) is
         Name         : constant String := Part.Get_Name;
         Content_Type : constant String := Part.Get_Content_Type;
         Path         : constant String := Part.Get_Local_Filename;
         Kind         : constant File_Type := Get_File_Type (Content_Type, Name);
      begin
         Output.Write ("
Name: " & Name);
         Output.Write ("	Content_Type: " & Content_Type & "	");
         Output.Write ("Path: " & Path & "	");
         Output.Write ("Length: " & Natural'Image (Part.Get_Size) & "	");
         Output.Write ("

");

         case Kind is
            when TAR_GZ =>
               Execute ("tar tvzf " & Path, Output);

            when TAR =>
               Execute ("tar tvf " & Path, Output);

            when IMAGE =>

               Execute ("identify " & Path, Output);

            when ZIP =>
               Execute ("zipinfo " & Path, Output);

            when PDF =>
               Execute ("pdfinfo " & Path, Output);

            when others =>
               Output.Write ("Unknown file type");

         end case;
         Output.Write ("

");
      end Process_Part;

   begin
      Response.Set_Content_Type ("text/html");
      Output.Write ("");
      Output.Write ("
");
      for I in 1 .. Request.Get_Part_Count loop
         Request.Process_Part (I, Process_Part'Access);
      end loop;
      Output.Write ("
");
      Output.Write ("");
   end Do_Post;

end Upload_Servlet;

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

with Ada.Streams;

with Util.Streams.Pipes;
with Util.Strings;

with ASF.Parts;
package body Upload_Servlet is

   --  ------------------------------
   --  Write the upload form page with an optional response message.
   --  ------------------------------
   procedure Write (Response : in out Responses.Response'Class;
                    Message  : in String) is
      Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
   begin
      Output.Write ("<title>Upload servlet example</title>"
                    & ""
                    & ""
                    & "
Upload files to identify them
");

      --  Display the response or some error.
      if Message /= "" then
         Output.Write ("
" & Message & "
");
      end if;

      --  Render the form.  If we have some existing Radius or Height
      --  use them to set the initial values.
      Output.Write ("
Identifies images, PDF, tar, tar.gz, zip
"
                    & "<form method='post' enctype='multipart/form-data'>"
                    & "
"
                    & "
File 1	"
                    & "<input type='file' size='50' name='file1' maxlength='100000'/>	"
                    & "

File 2	"
                    & "<input type='file' size='50' name='file2' maxlength='100000'/>	"
                    & "

File 3	"
                    & "<input type='file' size='50' name='file3' maxlength='100000'/>	"
                    & "
"
                    & "
	<input type='submit' value='Identify'></input>
"
                    & "
</form>"
                    & "");
      Response.Set_Status (Responses.SC_OK);
   end Write;

   --  ------------------------------
   --  Called by the servlet container when a GET request is received.
   --  Display the volume form page.
   --  ------------------------------
   procedure Do_Get (Server   : in Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is
      pragma Unreferenced (Server, Request);
   begin
      Write (Response, "");
   end Do_Get;

   --  ------------------------------
   --  Execute a command and write the result to the output stream.
   --  ------------------------------
   procedure Execute (Command : in String;
                      Output  : in out ASF.Streams.Print_Stream) is
      use type Ada.Streams.Stream_Element_Offset;

      Proc     : Util.Streams.Pipes.Pipe_Stream;
      Content  : Ada.Streams.Stream_Element_Array (0 .. 1024);
      Pos      : Ada.Streams.Stream_Element_Offset;
   begin
      Proc.Open (Command);
      loop
         Proc.Read (Into => Content,
                    Last => Pos);
         exit when Pos < 0;
         Output.Write (Content (0 .. Pos));
      end loop;
      Proc.Close;
      if Proc.Get_Exit_Status /= 0 then
         Output.Write ("Command '" & Command & "' exited with code "
                       & Integer'Image (Proc.Get_Exit_Status));
      end if;
   end Execute;

   --  ------------------------------
   --  Guess a file type depending on a content type or a file name.
   --  ------------------------------
   function Get_File_Type (Content_Type : in String;
                           Name         : in String) return File_Type is
   begin
      if Content_Type = "application/pdf" then
         return PDF;
      elsif Content_Type = "image/png" or Content_Type = "image/jpeg" then
         return IMAGE;
      elsif Content_Type = "image/gif" then
         return IMAGE;
      elsif Content_Type = "application/zip" then
         return ZIP;
      end if;
      declare
         Ext_Pos      : constant Natural := Util.Strings.Rindex (Name, '.');
      begin
         if Ext_Pos > 0 then
            if Name (Ext_Pos .. Name'Last) = ".gz" or Name (Ext_Pos .. Name'Last) = ".tgz" then
               return TAR_GZ;

            elsif Name (Ext_Pos .. Name'Last) = ".tar" then
               return TAR;

            elsif Name (Ext_Pos .. Name'Last) = ".jpg"
              or Name (Ext_Pos .. Name'Last) = ".gif"
              or Name (Ext_Pos .. Name'Last) = ".xbm"
              or Name (Ext_Pos .. Name'Last) = ".png" then
               return IMAGE;

            elsif Name (Ext_Pos .. Name'Last) = ".zip"
              or Name (Ext_Pos .. Name'Last) = ".jar" then
               return ZIP;

            elsif Name (Ext_Pos .. Name'Last) = ".pdf" then
               return PDF;

            end if;
         end if;
         return UNKNOWN;
      end;
   end Get_File_Type;

   --  ------------------------------
   --  Called by the servlet container when a POST request is received.
   --  Receives the uploaded files and identify them using some external command.
   --  ------------------------------
   procedure Do_Post (Server   : in Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class) is
      pragma Unreferenced (Server);

      procedure Process_Part (Part : in ASF.Parts.Part'Class);

      Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;

      procedure Process_Part (Part : in ASF.Parts.Part'Class) is
         Name         : constant String := Part.Get_Name;
         Content_Type : constant String := Part.Get_Content_Type;
         Path         : constant String := Part.Get_Local_Filename;
         Kind         : constant File_Type := Get_File_Type (Content_Type, Name);
      begin
         Output.Write ("
Name: " & Name);
         Output.Write ("	Content_Type: " & Content_Type & "	");
         Output.Write ("Path: " & Path & "	");
         Output.Write ("Length: " & Natural'Image (Part.Get_Size) & "	");
         Output.Write ("

");

         case Kind is
            when TAR_GZ =>
               Execute ("tar tvzf " & Path, Output);

            when TAR =>
               Execute ("tar tvf " & Path, Output);

            when IMAGE =>

               Execute ("identify " & Path, Output);

            when ZIP =>
               Execute ("zipinfo " & Path, Output);

            when PDF =>
               Execute ("pdfinfo " & Path, Output);

            when others =>
               Output.Write ("Unknown file type");

         end case;
         Output.Write ("

");
      end Process_Part;

   begin
      Response.Set_Content_Type ("text/html");
      Output.Write ("");
      Output.Write ("
");
      for I in 1 .. Request.Get_Part_Count loop
         Request.Process_Part (I, Process_Part'Access);
      end loop;
      Output.Write ("
Upload new files
");
      Output.Write ("
");
      Output.Write ("");
   end Do_Post;

end Upload_Servlet;

Update the page description and recognize JAR files (as a ZIP)


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

with Util.Properties;

--  === SQLite Database Driver ===
--  The SQLite database driver can be initialize explicitly by using the `ado_mysql`
--  GNAT project and calling the initialization procedure.
--
--    ADO.Sqlite.Initialize ("db.properties");
--
--  The set of configuration properties can be set programatically and passed to the
--  `Initialize` operation.
--
--    Config : Util.Properties.Manager;
--    ...
--      Config.Set ("ado.database", "sqlite:///regtests.db?synchronous=OFF&encoding=UTF-8");
--      Config.Set ("ado.queries.path", ".;db");
--      ADO.Sqlite.Initialize (Config);
--
--  The SQLite database driver will pass all the properties as SQLite `pragma` allowing
--  the configuration of the SQLite database.
--
package ADO.Sqlite is

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

end ADO.Sqlite;

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

with Util.Properties;

--  === SQLite Database Driver ===
--  The SQLite database driver can be initialize explicitly by using the `ado_mysql`
--  GNAT project and calling the initialization procedure.
--
--    ADO.Sqlite.Initialize ("db.properties");
--
--  The set of configuration properties can be set programatically and passed to the
--  `Initialize` operation.
--
--    Config : Util.Properties.Manager;
--    ...
--      Config.Set ("ado.database", "sqlite:///regtests.db?synchronous=OFF&encoding=UTF-8");
--      Config.Set ("ado.queries.path", ".;db");
--      ADO.Sqlite.Initialize (Config);
--
--  The SQLite database driver will pass all the properties as SQLite `pragma` allowing
--  the configuration of the SQLite database.
--
package ADO.Sqlite is

   --  Initialize the SQLite driver.
   procedure Initialize;

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

end ADO.Sqlite;

Declare the Initialize procedure

Declare the Initialize procedure


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

--  == Writer interfaces ==
--  The <tt>Wiki.Writers</tt> package defines the interfaces used by the renderer to write
--  their outputs.
--
--  The <tt>Input_Stream</tt> interface defines the interface that must be implemented to
--  read the source Wiki content.  The <tt>Read</tt> procedure is called by the parser
--  repeatedly while scanning the Wiki content.
package Wiki.Streams.Html is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Html_Output_Stream is limited interface and Output_Stream;
   type Html_Output_Stream_Access is access all Html_Output_Stream'Class;

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   procedure Write_Wide_Element (Writer  : in out Html_Output_Stream;
                                 Name    : in String;
                                 Content : in Wiki.Strings.WString) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_Output_Stream;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_Output_Stream;
                                   Name    : in String;
                                   Content : in Wide_Wide_String) is abstract;

   --  Start an XML element with the given name.
   procedure Start_Element (Writer : in out Html_Output_Stream;
                            Name   : in String) is abstract;

   --  Closes an XML element of the given name.
   procedure End_Element (Writer : in out Html_Output_Stream;
                          Name   : in String) is abstract;

   --  Write a text escaping any character as necessary.
   procedure Write_Wide_Text (Writer  : in out Html_Output_Stream;
                              Content : in Wiki.Strings.WString) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Attribute (Writer  : in out Html_Output_Stream'Class;
                              Name    : in String;
                              Content : in String);

end Wiki.Streams.Html;

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

--  === HTML Output Stream ===
--  The <tt>Wiki.Writers</tt> package defines the interfaces used by the renderer to write
--  their outputs.
--
--  The <tt>Input_Stream</tt> interface defines the interface that must be implemented to
--  read the source Wiki content.  The <tt>Read</tt> procedure is called by the parser
--  repeatedly while scanning the Wiki content.
package Wiki.Streams.Html is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Html_Output_Stream is limited interface and Output_Stream;
   type Html_Output_Stream_Access is access all Html_Output_Stream'Class;

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   procedure Write_Wide_Element (Writer  : in out Html_Output_Stream;
                                 Name    : in String;
                                 Content : in Wiki.Strings.WString) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_Output_Stream;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Wide_Attribute (Writer  : in out Html_Output_Stream;
                                   Name    : in String;
                                   Content : in Wide_Wide_String) is abstract;

   --  Start an XML element with the given name.
   procedure Start_Element (Writer : in out Html_Output_Stream;
                            Name   : in String) is abstract;

   --  Closes an XML element of the given name.
   procedure End_Element (Writer : in out Html_Output_Stream;
                          Name   : in String) is abstract;

   --  Write a text escaping any character as necessary.
   procedure Write_Wide_Text (Writer  : in out Html_Output_Stream;
                              Content : in Wiki.Strings.WString) is abstract;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Attribute (Writer  : in out Html_Output_Stream'Class;
                              Name    : in String;
                              Content : in String);

end Wiki.Streams.Html;

Add some documentation

Add some documentation


-----------------------------------------------------------------------
--  util-beans-objects-maps -- Object maps
--  Copyright (C) 2010, 2011, 2012, 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.
-----------------------------------------------------------------------

package body Util.Beans.Objects.Maps is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Value (From : in Map_Bean;
                       Name : in String) return Object is
      Pos : constant Cursor := From.Find (Name);
   begin
      if Has_Element (Pos) then
         return Element (Pos);
      else
         return Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   --  ------------------------------
   procedure Set_Value (From  : in out Map_Bean;
                        Name  : in String;
                        Value : in Object) is
   begin
      From.Include (Name, Value);
   end Set_Value;

   --  ------------------------------
   --  Iterate over the members of the map.
   --  ------------------------------
   procedure Iterate (From    : in Object;
                      Process : not null access procedure (Name : in String;
                                                           Item : in Object)) is
      procedure Process_One (Pos : in Maps.Cursor);

      procedure Process_One (Pos : in Maps.Cursor) is
      begin
         Process (Maps.Key (Pos), Maps.Element (Pos));
      end Process_One;

      Bean : constant access Util.Beans.Basic.Readonly_Bean'Class := To_Bean (From);
   begin
      if Bean /= null and then Bean.all in Util.Beans.Objects.Maps.Map_Bean'Class then
         Map_Bean'Class (Bean.all).Iterate (Process_One'Access);
      end if;
   end Iterate;

   --  ------------------------------
   --  Create an object that contains a <tt>Map_Bean</tt> instance.
   --  ------------------------------
   function Create return Object is
      M : constant Map_Bean_Access := new Map_Bean;
   begin
      return To_Object (Value => M, Storage => DYNAMIC);
   end Create;

end Util.Beans.Objects.Maps;

-----------------------------------------------------------------------
--  util-beans-objects-maps -- Object maps
--  Copyright (C) 2010, 2011, 2012, 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.
-----------------------------------------------------------------------

package body Util.Beans.Objects.Maps is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Map_Bean;
                       Name : in String) return Object is
      Pos : constant Cursor := From.Find (Name);
   begin
      if Has_Element (Pos) then
         return Element (Pos);
      else
         return Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Map_Bean;
                        Name  : in String;
                        Value : in Object) is
   begin
      From.Include (Name, Value);
   end Set_Value;

   --  ------------------------------
   --  Get an iterator to iterate starting with the first element.
   --  ------------------------------
   overriding
   function First (From : in Map_Bean) return Iterators.Proxy_Iterator_Access is
      Iter : constant Map_Iterator_Access := new Map_Iterator;
   begin
      Iter.Pos := From.First;
      return Iter.all'Access;
   end First;

   --  ------------------------------
   --  Get an iterator to iterate starting with the last element.
   --  ------------------------------
   overriding
   function Last (From : in Map_Bean) return Iterators.Proxy_Iterator_Access is
   begin
      return null;
   end Last;

   --  ------------------------------
   --  Iterate over the members of the map.
   --  ------------------------------
   procedure Iterate (From    : in Object;
                      Process : not null access procedure (Name : in String;
                                                           Item : in Object)) is
      procedure Process_One (Pos : in Maps.Cursor);

      procedure Process_One (Pos : in Maps.Cursor) is
      begin
         Process (Maps.Key (Pos), Maps.Element (Pos));
      end Process_One;

      Bean : constant access Util.Beans.Basic.Readonly_Bean'Class := To_Bean (From);
   begin
      if Bean /= null and then Bean.all in Util.Beans.Objects.Maps.Map_Bean'Class then
         Map_Bean'Class (Bean.all).Iterate (Process_One'Access);
      end if;
   end Iterate;

   --  ------------------------------
   --  Create an object that contains a <tt>Map_Bean</tt> instance.
   --  ------------------------------
   function Create return Object is
      M : constant Map_Bean_Access := new Map_Bean;
   begin
      return To_Object (Value => M, Storage => DYNAMIC);
   end Create;

   function Get_Map is
      new Util.Beans.Objects.Iterators.Get_Bean (Map_Bean, Map_Bean_Access);

   overriding
   function Has_Element (Iter : in Map_Iterator) return Boolean is
      Map : constant Map_Bean_Access := Get_Map (Iter);
   begin
      return Map /= null and then Has_Element (Iter.Pos);
   end Has_Element;

   overriding
   procedure Next (Iter : in out Map_Iterator) is
   begin
      Next (Iter.Pos);
   end Next;

   overriding
   procedure Previous (Iter : in out Map_Iterator) is
   begin
      null;
   end Previous;

   overriding
   function Element (Iter : in Map_Iterator) return Object is
   begin
      return Element (Iter.Pos);
   end Element;

   overriding
   function Key (Iter : in Map_Iterator) return String is
   begin
      return Key (Iter.Pos);
   end Key;

end Util.Beans.Objects.Maps;

Implement the Map_Iterator operations

Implement the Map_Iterator operations


-----------------------------------------------------------------------
--  gen-commands-project -- Project creation command for dynamo
--  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 Ada.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with GNAT.Command_Line;
with GNAT.OS_Lib;

with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Project is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String;

   --  ------------------------------
   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String is
      Pos : Natural := Util.Strings.Index (Email, '<');
   begin
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      end if;
      Pos := Util.Strings.Index (Email, '@');
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      else
         return Email;
      end if;
   end Get_Name_From_Email;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use GNAT.Command_Line;

      Web_Flag  : aliased Boolean := False;
      Tool_Flag : aliased Boolean := False;
      Ado_Flag  : aliased Boolean := False;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: -web -tool -ado") is
         when ASCII.NUL => exit;

         when '-' =>
            if Full_Switch = "-web" then
               Web_Flag := True;
            elsif Full_Switch = "-tool" then
               Tool_Flag := True;
            elsif Full_Switch = "-ado" then
               Ado_Flag := True;
            end if;

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      if not Web_Flag and not Ado_Flag and not Tool_Flag then
         Web_Flag := True;
      end if;
      declare
         Name  : constant String := Get_Argument;
         Arg2  : constant String := Get_Argument;
         Arg3  : constant String := Get_Argument;
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing project name");
            Gen.Commands.Usage;
            return;
         end if;

         if Util.Strings.Index (Arg2, '@') > Arg2'First then
            Generator.Set_Project_Property ("author_email", Arg2);
            if Arg3'Length = 0 then
               Generator.Set_Project_Property ("author", Get_Name_From_Email (Arg2));
            else
               Generator.Set_Project_Property ("author", Arg3);
            end if;

         elsif Util.Strings.Index (Arg3, '@') > Arg3'First then
            Generator.Set_Project_Property ("author", Arg2);
            Generator.Set_Project_Property ("author_email", Arg3);

         elsif Arg3'Length > 0 then
            Generator.Error ("The last argument should be the author's email address.");
            Gen.Commands.Usage;
            return;
         end if;

         Generator.Set_Project_Name (Name);
         Generator.Set_Force_Save (False);
         Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project");

         Generator.Save_Project;
         declare
            use type GNAT.OS_Lib.String_Access;

            Path   : constant GNAT.OS_Lib.String_Access
              := GNAT.OS_Lib.Locate_Exec_On_Path ("autoconf");
            Args   : GNAT.OS_Lib.Argument_List (1 .. 0);
            Status : Boolean;
         begin
            if Path = null then
               Generator.Error ("The 'autoconf' tool was not found.  It is necessary to "
                                & "generate the configure script.");
               Generator.Error ("Install 'autoconf' or launch it manually.");
            else
               Ada.Directories.Set_Directory (Generator.Get_Result_Directory);
               Log.Info ("Executing {0}", Path.all);
               GNAT.OS_Lib.Spawn (Path.all, Args, Status);
               if not Status then
                  Generator.Error ("Execution of {0} failed", Path.all);
               end if;
            end if;
         end;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-project: Create a new Ada Web Application project");
      Put_Line ("Usage: create-project [-l apache|gpl|proprietary] [-web] [-tool] [-ado] "
                & "NAME [AUTHOR] [EMAIL]");
      New_Line;
      Put_Line ("  Creates a new AWA application with the name passed in NAME.");
      Put_Line ("  The application license is controlled with the -l option. ");
      Put_Line ("  License headers can use either the Apache, the GNU license or");
      Put_Line ("  a proprietary license. The author's name and email addresses");
      Put_Line ("  are also reported in generated files.");
      New_Line;
      Put_Line ("  -web   Generate a Web application");
      Put_Line ("  -tool  Generate a command line tool");
      Put_Line ("  -ado   Generate a database tool operation for ADO");
   end Help;

end Gen.Commands.Project;

-----------------------------------------------------------------------
--  gen-commands-project -- Project creation command for dynamo
--  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 Ada.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with GNAT.Command_Line;
with GNAT.OS_Lib;

with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Project is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String;

   --  ------------------------------
   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String is
      Pos : Natural := Util.Strings.Index (Email, '<');
   begin
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      end if;
      Pos := Util.Strings.Index (Email, '@');
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      else
         return Email;
      end if;
   end Get_Name_From_Email;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use GNAT.Command_Line;

      Web_Flag  : aliased Boolean := False;
      Tool_Flag : aliased Boolean := False;
      Ado_Flag  : aliased Boolean := False;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: ? -web -tool -ado") is
         when ASCII.NUL => exit;

         when '-' =>
            if Full_Switch = "-web" then
               Web_Flag := True;
            elsif Full_Switch = "-tool" then
               Tool_Flag := True;
            elsif Full_Switch = "-ado" then
               Ado_Flag := True;
            end if;

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      if not Web_Flag and not Ado_Flag and not Tool_Flag then
         Web_Flag := True;
      end if;
      declare
         Name  : constant String := Get_Argument;
         Arg2  : constant String := Get_Argument;
         Arg3  : constant String := Get_Argument;
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing project name");
            Gen.Commands.Usage;
            return;
         end if;

         if Util.Strings.Index (Arg2, '@') > Arg2'First then
            Generator.Set_Project_Property ("author_email", Arg2);
            if Arg3'Length = 0 then
               Generator.Set_Project_Property ("author", Get_Name_From_Email (Arg2));
            else
               Generator.Set_Project_Property ("author", Arg3);
            end if;

         elsif Util.Strings.Index (Arg3, '@') > Arg3'First then
            Generator.Set_Project_Property ("author", Arg2);
            Generator.Set_Project_Property ("author_email", Arg3);

         elsif Arg3'Length > 0 then
            Generator.Error ("The last argument should be the author's email address.");
            Gen.Commands.Usage;
            return;
         end if;

         Generator.Set_Project_Property ("is_web", Boolean'Image (Web_Flag));
         Generator.Set_Project_Property ("is_tool", Boolean'Image (Tool_Flag));
         Generator.Set_Project_Property ("is_ado", Boolean'Image (Ado_Flag));
         Generator.Set_Project_Name (Name);
         Generator.Set_Force_Save (False);
         if Ado_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-ado");
         else
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project");
         end if;

         Generator.Save_Project;
         declare
            use type GNAT.OS_Lib.String_Access;

            Path   : constant GNAT.OS_Lib.String_Access
              := GNAT.OS_Lib.Locate_Exec_On_Path ("autoconf");
            Args   : GNAT.OS_Lib.Argument_List (1 .. 0);
            Status : Boolean;
         begin
            if Path = null then
               Generator.Error ("The 'autoconf' tool was not found.  It is necessary to "
                                & "generate the configure script.");
               Generator.Error ("Install 'autoconf' or launch it manually.");
            else
               Ada.Directories.Set_Directory (Generator.Get_Result_Directory);
               Log.Info ("Executing {0}", Path.all);
               GNAT.OS_Lib.Spawn (Path.all, Args, Status);
               if not Status then
                  Generator.Error ("Execution of {0} failed", Path.all);
               end if;
            end if;
         end;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-project: Create a new Ada Web Application project");
      Put_Line ("Usage: create-project [-l apache|gpl|proprietary] [-web] [-tool] [-ado] "
                & "NAME [AUTHOR] [EMAIL]");
      New_Line;
      Put_Line ("  Creates a new AWA application with the name passed in NAME.");
      Put_Line ("  The application license is controlled with the -l option. ");
      Put_Line ("  License headers can use either the Apache, the GNU license or");
      Put_Line ("  a proprietary license. The author's name and email addresses");
      Put_Line ("  are also reported in generated files.");
      New_Line;
      Put_Line ("  -web   Generate a Web application");
      Put_Line ("  -tool  Generate a command line tool");
      Put_Line ("  -ado   Generate a database tool operation for ADO");
   end Help;

end Gen.Commands.Project;

Use another project template for Ado utilities