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

with Ada.Unchecked_Deallocation;
with Util.Encoders.Base16;
with Util.Encoders.Base64;
with Util.Encoders.SHA1;
package body Util.Encoders is

   use Ada;
   use Ada.Strings.Unbounded;

   use type Ada.Streams.Stream_Element_Offset;

   --  ------------------------------
   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   --  ------------------------------
   function Encode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Encode = null then
         raise Not_Supported with "There is no encoder";
      end if;
      return E.Encode.Transform (Data);
   end Encode;

   --  ------------------------------
   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   --  ------------------------------
   function Decode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Decode = null then
         raise Not_Supported with "There is no decoder";
      end if;
      return E.Decode.Transform (Data);
   end Decode;

   MIN_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 64;
   MAX_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 2_048;

   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset;
   pragma Inline (Best_Size);

   --  ------------------------------
   --  Compute a good size for allocating a buffer on the stack
   --  ------------------------------
   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset is
   begin
      if Length < Natural (MIN_BUFFER_SIZE) then
         return MIN_BUFFER_SIZE;
      elsif Length > Natural (MAX_BUFFER_SIZE) then
         return MAX_BUFFER_SIZE;
      else
         return Streams.Stream_Element_Offset (((Length + 15) / 16) * 16);
      end if;
   end Best_Size;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in Transformer'Class;
                       Data : in String) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Pos      : Natural := Data'First;
   begin
      while Pos <= Data'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            First_Encoded : Streams.Stream_Element_Offset := 1;
            Last          : Streams.Stream_Element_Offset;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in out result string.
            loop
               E.Transform (Data    => Buf (First_Encoded .. Size),
                            Into    => Res,
                            Encoded => Last_Encoded,
                            Last    => Last);

               --  If the encoder generated nothing, move the position backward
               --  to take into account the remaining bytes not taken into account.
               if Last < 1 then
                  Next_Pos := Next_Pos - Natural (Size - First_Encoded + 1);
                  exit;
               end if;
               for I in 1 .. Last loop
                  Tmp (Natural (I)) := Character'Val (Res (I));
               end loop;
               Append (Result, Tmp (1 .. Natural (Last)));
               exit when Last_Encoded = Size;
               First_Encoded := Last_Encoded + 1;
            end loop;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            Pos := Next_Pos;
         end;
      end loop;
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in Transformer'Class;
                       Data : in Streams.Stream_Element_Array) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Last_Encoded  : Streams.Stream_Element_Offset;
      Last          : Streams.Stream_Element_Offset;
   begin

      --  Encode that buffer and put the result in out result string.
      E.Transform (Data    => Data,
                   Into    => Res,
                   Encoded => Last_Encoded,
                   Last    => Last);

      for I in 1 .. Last loop
         Tmp (Natural (I)) := Character'Val (Res (I));
      end loop;
      Append (Result, Tmp (1 .. Natural (Last)));
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   --  ------------------------------
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;

      P    : Ada.Streams.Stream_Element_Offset := Pos;
      V, U : Interfaces.Unsigned_64;
   begin
      V := Val;
      loop
         if V < 16#07F# then
            Into (P) := Ada.Streams.Stream_Element (V);
            Last := P;
            return;
         end if;
         U := V and 16#07F#;
         Into (P) := Ada.Streams.Stream_Element (U or 16#80#);
         P := P + 1;
         V := Interfaces.Shift_Right (V, 7);
      end loop;
   end Encode_LEB128;

   --  ------------------------------
   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   --  ------------------------------
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;
      use type Interfaces.Unsigned_8;

      P     : Ada.Streams.Stream_Element_Offset := Pos;
      Value : Interfaces.Unsigned_64 := 0;
      V     : Interfaces.Unsigned_8;
      Shift : Integer := 0;
   begin
      loop
         V := Interfaces.Unsigned_8 (From (P));
         if (V and 16#80#) = 0 then
            Val := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
            Last := P + 1;
            return;
         end if;
         V := V and 16#07F#;
         Value := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
         P := P + 1;
         Shift := Shift + 7;
      end loop;
   end Decode_LEB128;

   --  ------------------------------
   --  Create the encoder object for the specified algorithm.
   --  ------------------------------
   function Create (Name : String) return Encoder is
   begin
      if Name = BASE_16 or Name = HEX then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base16.Encoder;
            E.Decode := new Util.Encoders.Base16.Decoder;
         end return;

      elsif Name = BASE_64 then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base64.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;

      elsif Name = BASE_64_URL then
         return E : Encoder do
            E.Encode := Util.Encoders.Base64.Create_URL_Encoder;
            E.Decode := Util.Encoders.Base64.Create_URL_Decoder;
         end return;

      elsif Name = HASH_SHA1 then
         return E : Encoder do
            E.Encode := new Util.Encoders.SHA1.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;
      end if;
      raise Not_Supported with "Invalid encoder: " & Name;
   end Create;

   --  ------------------------------
   --  Delete the transformers
   --  ------------------------------
   overriding
   procedure Finalize (E : in out Encoder) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Transformer'Class, Transformer_Access);

   begin
      Free (E.Encode);
      Free (E.Decode);
   end Finalize;

end Util.Encoders;

-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 2010, 2011, 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.Unchecked_Deallocation;
with Util.Encoders.Base16;
with Util.Encoders.Base64;
with Util.Encoders.SHA1;
package body Util.Encoders is

   use Ada;
   use Ada.Strings.Unbounded;

   use type Ada.Streams.Stream_Element_Offset;

   --  ------------------------------
   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   --  ------------------------------
   function Encode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Encode = null then
         raise Not_Supported with "There is no encoder";
      end if;
      return E.Encode.Transform (Data);
   end Encode;

   --  ------------------------------
   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   --  ------------------------------
   function Decode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Decode = null then
         raise Not_Supported with "There is no decoder";
      end if;
      return E.Decode.Transform (Data);
   end Decode;

   MIN_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 64;
   MAX_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 2_048;

   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset;
   pragma Inline (Best_Size);

   --  ------------------------------
   --  Compute a good size for allocating a buffer on the stack
   --  ------------------------------
   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset is
   begin
      if Length < Natural (MIN_BUFFER_SIZE) then
         return MIN_BUFFER_SIZE;
      elsif Length > Natural (MAX_BUFFER_SIZE) then
         return MAX_BUFFER_SIZE;
      else
         return Streams.Stream_Element_Offset (((Length + 15) / 16) * 16);
      end if;
   end Best_Size;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in Transformer'Class;
                       Data : in String) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Pos      : Natural := Data'First;
   begin
      while Pos <= Data'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            First_Encoded : Streams.Stream_Element_Offset := 1;
            Last          : Streams.Stream_Element_Offset;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in out result string.
            loop
               E.Transform (Data    => Buf (First_Encoded .. Size),
                            Into    => Res,
                            Encoded => Last_Encoded,
                            Last    => Last);

               --  If the encoder generated nothing, move the position backward
               --  to take into account the remaining bytes not taken into account.
               if Last < 1 then
                  Next_Pos := Next_Pos - Natural (Size - First_Encoded + 1);
                  exit;
               end if;
               for I in 1 .. Last loop
                  Tmp (Natural (I)) := Character'Val (Res (I));
               end loop;
               Append (Result, Tmp (1 .. Natural (Last)));
               exit when Last_Encoded = Size;
               First_Encoded := Last_Encoded + 1;
            end loop;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            Pos := Next_Pos;
         end;
      end loop;
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   procedure Transform (E    : in Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset) is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Pos      : Natural := Data'First;
      First    : Streams.Stream_Element_Offset := Into'First;
   begin
      while Pos <= Data'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            First_Encoded : Streams.Stream_Element_Offset := 1;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in the output data array.
            loop
               E.Transform (Data    => Buf (First_Encoded .. Size),
                            Into    => Into (First .. Into'Last),
                            Encoded => Last_Encoded,
                            Last    => Last);

               --  If the encoder generated nothing, move the position backward
               --  to take into account the remaining bytes not taken into account.
               if Last < First then
                  Next_Pos := Next_Pos - Natural (Size - First_Encoded + 1);
                  exit;
               end if;
               exit when Last_Encoded = Size;
               First_Encoded := Last_Encoded + 1;
            end loop;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            First := Last;
            Pos := Next_Pos;
         end;
      end loop;
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in Transformer'Class;
                       Data : in Streams.Stream_Element_Array) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Last_Encoded  : Streams.Stream_Element_Offset;
      Last          : Streams.Stream_Element_Offset;
   begin

      --  Encode that buffer and put the result in out result string.
      E.Transform (Data    => Data,
                   Into    => Res,
                   Encoded => Last_Encoded,
                   Last    => Last);

      for I in 1 .. Last loop
         Tmp (Natural (I)) := Character'Val (Res (I));
      end loop;
      Append (Result, Tmp (1 .. Natural (Last)));
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   --  ------------------------------
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;

      P    : Ada.Streams.Stream_Element_Offset := Pos;
      V, U : Interfaces.Unsigned_64;
   begin
      V := Val;
      loop
         if V < 16#07F# then
            Into (P) := Ada.Streams.Stream_Element (V);
            Last := P;
            return;
         end if;
         U := V and 16#07F#;
         Into (P) := Ada.Streams.Stream_Element (U or 16#80#);
         P := P + 1;
         V := Interfaces.Shift_Right (V, 7);
      end loop;
   end Encode_LEB128;

   --  ------------------------------
   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   --  ------------------------------
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;
      use type Interfaces.Unsigned_8;

      P     : Ada.Streams.Stream_Element_Offset := Pos;
      Value : Interfaces.Unsigned_64 := 0;
      V     : Interfaces.Unsigned_8;
      Shift : Integer := 0;
   begin
      loop
         V := Interfaces.Unsigned_8 (From (P));
         if (V and 16#80#) = 0 then
            Val := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
            Last := P + 1;
            return;
         end if;
         V := V and 16#07F#;
         Value := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
         P := P + 1;
         Shift := Shift + 7;
      end loop;
   end Decode_LEB128;

   --  ------------------------------
   --  Create the encoder object for the specified algorithm.
   --  ------------------------------
   function Create (Name : String) return Encoder is
   begin
      if Name = BASE_16 or Name = HEX then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base16.Encoder;
            E.Decode := new Util.Encoders.Base16.Decoder;
         end return;

      elsif Name = BASE_64 then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base64.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;

      elsif Name = BASE_64_URL then
         return E : Encoder do
            E.Encode := Util.Encoders.Base64.Create_URL_Encoder;
            E.Decode := Util.Encoders.Base64.Create_URL_Decoder;
         end return;

      elsif Name = HASH_SHA1 then
         return E : Encoder do
            E.Encode := new Util.Encoders.SHA1.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;
      end if;
      raise Not_Supported with "Invalid encoder: " & Name;
   end Create;

   --  ------------------------------
   --  Delete the transformers
   --  ------------------------------
   overriding
   procedure Finalize (E : in out Encoder) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Transformer'Class, Transformer_Access);

   begin
      Free (E.Encode);
      Free (E.Decode);
   end Finalize;

end Util.Encoders;

Implement new Transform procedure that gets a String as input data, transform that into some stream element array and calls the transform encoder operation


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

with Util.Test_Caller;

with Util.Beans.Objects;

with Ada.Unchecked_Deallocation;

with EL.Contexts.Default;

with ASF.Applications.Tests;
package body ASF.Applications.Main.Tests is

   use Util.Tests;

   function Create_Form_Bean return Util.Beans.Basic.Readonly_Bean_Access;

   package Caller is new Util.Test_Caller (Test);

   procedure Add_Tests (Suite : AUnit.Test_Suites.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Read_Configuration",
                       Test_Read_Configuration'Access);
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Create",
                       Test_Create_Bean'Access);
   end Add_Tests;

   --  ------------------------------
   --  Initialize the test application
   --  ------------------------------
   procedure Set_Up (T : in out Test) is
      Fact : ASF.Applications.Main.Application_Factory;
      C    : ASF.Applications.Config;
   begin
      T.App := new ASF.Applications.Main.Application;
      C.Copy (Util.Tests.Get_Properties);
      T.App.Initialize (C, Fact);
      T.App.Register ("layoutMsg", "layout");
   end Set_Up;

   --  ------------------------------
   --  Deletes the application object
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out Test) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => ASF.Applications.Main.Application'Class,
                                        Name   => ASF.Applications.Main.Application_Access);
   begin
      Free (T.App);
   end Tear_Down;

   function Create_Form_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Applications.Tests.Form_Bean_Access := new Applications.Tests.Form_Bean;
   begin
      return Result.all'Access;
   end Create_Form_Bean;

   --  ------------------------------
   --  Test creation of module
   --  ------------------------------
   procedure Test_Read_Configuration (T : in out Test) is
      Path : constant String := Util.Tests.Get_Test_Path ("config/empty.xml");
   begin
      T.App.Read_Configuration (Path);

   end Test_Read_Configuration;

   --  ------------------------------
   --  Test creation of a module and registration in an application.
   --  ------------------------------
   procedure Test_Create_Bean (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      procedure Check (Name : in String;
                       Kind : in ASF.Beans.Scope_Type);

      procedure Check (Name : in String;
                       Kind : in ASF.Beans.Scope_Type) is
         Value : Util.Beans.Objects.Object;
         Bean  : Util.Beans.Basic.Readonly_Bean_Access;
         Scope : ASF.Beans.Scope_Type;
         Context : EL.Contexts.Default.Default_Context;
      begin
         T.App.Create (Name    => Ada.Strings.Unbounded.To_Unbounded_String (Name),
                       Context => Context,
                       Result  => Bean,
                       Scope   => Scope);
         T.Assert (Kind = Scope, "Invalid scope for " & Name);
         T.Assert (Bean /= null, "Invalid bean object");
         Value := Util.Beans.Objects.To_Object (Bean);
         T.Assert (not Util.Beans.Objects.Is_Null (Value), "Invalid bean");

         --  Special test for the sessionForm bean which is initialized by configuration properties
         if Name = "sessionForm" then
            T.Assert_Equals ("John.Rambo@gmail.com",
                             Util.Beans.Objects.To_String (Bean.Get_Value ("email")),
                             "Session form not initialized");
         end if;
      end Check;

      Path : constant String := Util.Tests.Get_Test_Path ("regtests/config/test-module.xml");

   begin
      T.App.Register_Class ("ASF.Applications.Tests.Form_Bean", Create_Form_Bean'Access);
      T.App.Read_Configuration (Path);

      --  Check the 'regtests/config/test-module.xml' managed bean configuration.
      Check ("applicationForm", ASF.Beans.APPLICATION_SCOPE);
      Check ("sessionForm", ASF.Beans.SESSION_SCOPE);
      Check ("requestForm", ASF.Beans.REQUEST_SCOPE);
   end Test_Create_Bean;

end ASF.Applications.Main.Tests;

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

with Util.Test_Caller;

with Util.Beans.Objects;

with Ada.Unchecked_Deallocation;

with EL.Contexts.Default;

with ASF.Applications.Tests;
with ASF.Applications.Main.Configs;
package body ASF.Applications.Main.Tests is

   use Util.Tests;

   function Create_Form_Bean return Util.Beans.Basic.Readonly_Bean_Access;

   package Caller is new Util.Test_Caller (Test);

   procedure Add_Tests (Suite : AUnit.Test_Suites.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Read_Configuration",
                       Test_Read_Configuration'Access);
      Caller.Add_Test (Suite, "Test ASF.Applications.Main.Create",
                       Test_Create_Bean'Access);
   end Add_Tests;

   --  ------------------------------
   --  Initialize the test application
   --  ------------------------------
   procedure Set_Up (T : in out Test) is
      Fact : ASF.Applications.Main.Application_Factory;
      C    : ASF.Applications.Config;
   begin
      T.App := new ASF.Applications.Main.Application;
      C.Copy (Util.Tests.Get_Properties);
      T.App.Initialize (C, Fact);
      T.App.Register ("layoutMsg", "layout");
   end Set_Up;

   --  ------------------------------
   --  Deletes the application object
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out Test) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => ASF.Applications.Main.Application'Class,
                                        Name   => ASF.Applications.Main.Application_Access);
   begin
      Free (T.App);
   end Tear_Down;

   function Create_Form_Bean return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Applications.Tests.Form_Bean_Access := new Applications.Tests.Form_Bean;
   begin
      return Result.all'Access;
   end Create_Form_Bean;

   --  ------------------------------
   --  Test creation of module
   --  ------------------------------
   procedure Test_Read_Configuration (T : in out Test) is
      Path : constant String := Util.Tests.Get_Test_Path ("config/empty.xml");
   begin
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

   end Test_Read_Configuration;

   --  ------------------------------
   --  Test creation of a module and registration in an application.
   --  ------------------------------
   procedure Test_Create_Bean (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      procedure Check (Name : in String;
                       Kind : in ASF.Beans.Scope_Type);

      procedure Check (Name : in String;
                       Kind : in ASF.Beans.Scope_Type) is
         Value : Util.Beans.Objects.Object;
         Bean  : Util.Beans.Basic.Readonly_Bean_Access;
         Scope : ASF.Beans.Scope_Type;
         Context : EL.Contexts.Default.Default_Context;
      begin
         T.App.Create (Name    => Ada.Strings.Unbounded.To_Unbounded_String (Name),
                       Context => Context,
                       Result  => Bean,
                       Scope   => Scope);
         T.Assert (Kind = Scope, "Invalid scope for " & Name);
         T.Assert (Bean /= null, "Invalid bean object");
         Value := Util.Beans.Objects.To_Object (Bean);
         T.Assert (not Util.Beans.Objects.Is_Null (Value), "Invalid bean");

         --  Special test for the sessionForm bean which is initialized by configuration properties
         if Name = "sessionForm" then
            T.Assert_Equals ("John.Rambo@gmail.com",
                             Util.Beans.Objects.To_String (Bean.Get_Value ("email")),
                             "Session form not initialized");
         end if;
      end Check;

      Path : constant String := Util.Tests.Get_Test_Path ("regtests/config/test-module.xml");

   begin
      T.App.Register_Class ("ASF.Applications.Tests.Form_Bean", Create_Form_Bean'Access);
      ASF.Applications.Main.Configs.Read_Configuration (T.App.all, Path);

      --  Check the 'regtests/config/test-module.xml' managed bean configuration.
      Check ("applicationForm", ASF.Beans.APPLICATION_SCOPE);
      Check ("sessionForm", ASF.Beans.SESSION_SCOPE);
      Check ("requestForm", ASF.Beans.REQUEST_SCOPE);
   end Test_Create_Bean;

end ASF.Applications.Main.Tests;

Fix compilation of unit test

Fix compilation of unit test


-----------------------------------------------------------------------
--  writer -- Response stream writer
--  Copyright (C) 2009, 2010, 2011 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 Unicode;
package body ASF.Contexts.Writer is

   use Unicode;

   procedure Write_Escape (Stream : in out ResponseWriter'Class;
                           Char   : in Character);

   --  Close the current XML entity if an entity was started
   procedure Close_Current (Stream : in out ResponseWriter'Class);

   --  ------------------------------
   --  Response Writer
   --  ------------------------------

   --  ------------------------------
   --  Initialize the response stream for the given content type and
   --  encoding.  An internal buffer is allocated for writing the stream.
   --  ------------------------------
   procedure Initialize (Stream       : in out ResponseWriter;
                         Content_Type : in String;
                         Encoding     : in String;
                         Output       : in ASF.Streams.Print_Stream) is
   begin
      Stream.Initialize (Output);
      Stream.Content_Type := To_Unbounded_String (Content_Type);
      Stream.Encoding     := Unicode.Encodings.Get_By_Name (Encoding);
   end Initialize;

   --  ------------------------------
   --  Flush the response stream and release the buffer.
   --  ------------------------------
   procedure Finalize (Object : in out ResponseWriter) is
   begin
      Object.Flush;
   end Finalize;

   --  ------------------------------
   --  Get the content type.
   --  ------------------------------
   function Get_Content_Type (Stream : in ResponseWriter) return String is
   begin
      return To_String (Stream.Content_Type);
   end Get_Content_Type;

   --  ------------------------------
   --  Get the character encoding.
   --  ------------------------------
   function Get_Encoding (Stream : in ResponseWriter) return String is
   begin
      return Stream.Encoding.Name.all;
   end Get_Encoding;

   --  ------------------------------
   --  Close the current XML entity if an entity was started
   --  ------------------------------
   procedure Close_Current (Stream : in out ResponseWriter'Class) is
   begin
      if Stream.Close_Start then
         Stream.Write ('>');
         Stream.Close_Start := False;
      end if;
   end Close_Current;

   --  ------------------------------
   --  Start an XML element with the given name.
   --  ------------------------------
   procedure Start_Element (Stream : in out ResponseWriter;
                            Name   : in String) is
   begin
      Close_Current (Stream);
      Stream.Write ('<');
      Stream.Write (Name);
      Stream.Close_Start := True;
   end Start_Element;

   --  ------------------------------
   --  Start an XML element with the given name.
   --  ------------------------------
   procedure Start_Optional_Element (Stream : in out ResponseWriter;
                                     Name   : in String) is
   begin
      Close_Current (Stream);
      Stream.Optional_Element (1 .. Name'Length) := Name;
      Stream.Optional_Element_Size := Name'Length;
   end Start_Optional_Element;

   --  ------------------------------
   --  Closes an XML element of the given name.
   --  ------------------------------
   procedure End_Element (Stream : in out ResponseWriter;
                          Name   : in String) is
   begin
      Close_Current (Stream);
      Stream.Write ("</");
      Stream.Write (Name);
      Stream.Write ('>');
   end End_Element;

   --  ------------------------------
   --  Closes an XML element of the given name.
   --  ------------------------------
   procedure End_Optional_Element (Stream : in out ResponseWriter;
                                   Name   : in String) is
   begin
      Close_Current (Stream);
      if Stream.Optional_Element_Written then
         Stream.Write ("</");
         Stream.Write (Name);
         Stream.Write ('>');
      end if;
      Stream.Optional_Element_Written := False;
      Stream.Optional_Element_Size    := 0;
   end End_Optional_Element;

   --  ------------------------------
   --  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_Element (Stream   : in out ResponseWriter;
                            Name     : in String;
                            Content  : in String) is
   begin
      Stream.Start_Element (Name);
      Stream.Write_Text (Content);
      Stream.End_Element (Name);
   end Write_Element;

   procedure Write_Wide_Element (Stream   : in out ResponseWriter;
                                 Name     : in String;
                                 Content  : in Wide_Wide_String) is
   begin
      Stream.Start_Element (Name);
      Stream.Write_Wide_Text (Content);
      Stream.End_Element (Name);
   end Write_Wide_Element;

   procedure Write_Attribute (Stream : in out ResponseWriter;
                              Name   : in String;
                              Value  : in String) is
   begin
      --  If we have an optional element, start it.
      if Stream.Optional_Element_Size > 0 and not Stream.Optional_Element_Written then
         Stream.Write ('<');
         Stream.Write (Stream.Optional_Element (1 .. Stream.Optional_Element_Size));
         Stream.Close_Start := True;
         Stream.Optional_Element_Written := True;
      end if;
      if Stream.Close_Start then
         Stream.Write (' ');
         Stream.Write (Name);
         Stream.Write ('=');
         Stream.Write ('"');
         for I in Value'Range loop
            declare
               C : constant Character := Value (I);
            begin
               if C = '"' then
                  Stream.Write (""");
               else
                  Stream.Write_Escape (C);
               end if;
            end;
         end loop;
         Stream.Write ('"');
      end if;
   end Write_Attribute;

   procedure Write_Attribute (Stream : in out ResponseWriter;
                              Name   : in String;
                              Value  : in Unbounded_String) is
   begin
      Stream.Write_Attribute (Name, To_String (Value));
   end Write_Attribute;

   procedure Write_Attribute (Stream : in out ResponseWriter;
                              Name   : in String;
                              Value  : in EL.Objects.Object) is
      S : constant String := EL.Objects.To_String (Value);
   begin
      Stream.Write_Attribute (Name, S);
   end Write_Attribute;

   --  ------------------------------
   --  Write a text escaping any character as necessary.
   --  ------------------------------
   procedure Write_Text (Stream : in out ResponseWriter;
                         Text   : in String) is
   begin
      for I in Text'Range loop
         ResponseWriter'Class (Stream).Write_Char (Text (I));
      end loop;
   end Write_Text;

   procedure Write_Text (Stream : in out ResponseWriter;
                         Text   : in Unbounded_String) is
      Count : constant Natural := Length (Text);
   begin
      if Count > 0 then
         for I in 1 .. Count loop
            ResponseWriter'Class (Stream).Write_Char (Element (Text, I));
         end loop;
      end if;
   end Write_Text;

   procedure Write_Wide_Text (Stream : in out ResponseWriter;
                              Text   : in Wide_Wide_String) is
   begin
      for I in Text'Range loop
         ResponseWriter'Class (Stream).Write_Wide_Char (Text (I));
      end loop;
   end Write_Wide_Text;

   procedure Write_Text (Stream : in out ResponseWriter;
                         Value  : in EL.Objects.Object) is
      use EL.Objects;

      Of_Type : constant EL.Objects.Data_Type := EL.Objects.Get_Type (Value);
   begin
      case Of_Type is
         when TYPE_BOOLEAN =>
            Close_Current (Stream);
            if To_Boolean (Value) then
               ResponseWriter'Class (Stream).Write ("true");
            else
               ResponseWriter'Class (Stream).Write ("false");
            end if;

         when TYPE_INTEGER | TYPE_FLOAT =>
            Close_Current (Stream);
            ResponseWriter'Class (Stream).Write (To_String (Value));

         when TYPE_STRING =>
            ResponseWriter'Class (Stream).Write_Text (To_String (Value));

         when others =>
            ResponseWriter'Class (Stream).Write_Wide_Text (To_Wide_Wide_String (Value));

      end case;
   end Write_Text;

   --  ------------------------------
   --  Write a character on the response stream and escape that character
   --  as necessary.
   --  ------------------------------
   procedure Write_Char (Stream : in out ResponseWriter;
                         Char   : in Character) is
   begin
      Close_Current (Stream);
      Write_Escape (Stream, Char);
   end Write_Char;

   --  ------------------------------
   --  Internal method to write a character on the response stream
   --  and escape that character as necessary.  Unlike 'Write_Char',
   --  this operation does not closes the current XML entity.
   --  ------------------------------
   procedure Write_Escape (Stream : in out ResponseWriter'Class;
                           Char   : in Character) is
      Code : constant Unicode_Char := Character'Pos (Char);
   begin
      --  Tilde or less...
      if Code < 16#A0# then
         --  If "?" or over, no escaping is needed (this covers
         --  most of the Latin alphabet)
         if Code > 16#3F# or Code <= 16#20# then
            Stream.Write (Char);
         elsif Char = '<' then
            Stream.Write ("<");
         elsif Char = '>' then
            Stream.Write (">");
         elsif Char = '&' then
            Stream.Write ("&");
         else
            Stream.Write (Char);
         end if;
      else
         declare
            S : String (1 .. 5) := "�";
            C : Unicode_Char;
         begin
            C := Code and 16#0F#;
            if C > 10 then
               S (4) := Character'Val (C - 10 + Character'Pos ('A'));
            else
               S (4) := Character'Val (C + Character'Pos ('0'));
            end if;
            C := (Code / 16) and 16#0F#;
            if C > 10 then
               S (3) := Character'Val (C - 10 + Character'Pos ('A'));
            else
               S (3) := Character'Val (C + Character'Pos ('0'));
            end if;
            Stream.Write (S);
         end;
      end if;
   end Write_Escape;

   --  ------------------------------
   --  Write a character on the response stream and escape that character
   --  as necessary.
   --  ------------------------------
   procedure Write_Wide_Char (Stream : in out ResponseWriter;
                              Char   : in Wide_Wide_Character) is
      Code : constant Unicode_Char := Wide_Wide_Character'Pos (Char);
   begin
      Close_Current (Stream);
      --  Tilde or less...
      if Code < 16#100# then
         Stream.Write_Char (Character'Val (Code));
      else
         declare
            S : String (1 .. 5) := "�";
            C : Unicode_Char;
         begin
            C := Code and 16#0F#;
            if C > 10 then
               S (4) := Character'Val (C - 10 + Character'Pos ('A'));
            else
               S (4) := Character'Val (C + Character'Pos ('0'));
            end if;
            C := (Code / 16) and 16#0F#;
            if C > 10 then
               S (3) := Character'Val (C - 10 + Character'Pos ('A'));
            else
               S (3) := Character'Val (C + Character'Pos ('0'));
            end if;
            Stream.Write (S);
         end;
      end if;
   end Write_Wide_Char;

   --  ------------------------------
   --  Write a string on the stream.
   --  ------------------------------
   procedure Write (Stream : in out ResponseWriter;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Close_Current (Stream);
      ASF.Streams.Print_Stream (Stream).Write (Item);
   end Write;

end ASF.Contexts.Writer;

-----------------------------------------------------------------------
--  writer -- Response stream writer
--  Copyright (C) 2009, 2010, 2011 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 Unicode;
package body ASF.Contexts.Writer is

   use Unicode;

   procedure Write_Escape (Stream : in out ResponseWriter'Class;
                           Char   : in Character);

   --  Close the current XML entity if an entity was started
   procedure Close_Current (Stream : in out ResponseWriter'Class);

   --  ------------------------------
   --  Response Writer
   --  ------------------------------

   --  ------------------------------
   --  Initialize the response stream for the given content type and
   --  encoding.  An internal buffer is allocated for writing the stream.
   --  ------------------------------
   procedure Initialize (Stream       : in out ResponseWriter;
                         Content_Type : in String;
                         Encoding     : in String;
                         Output       : in ASF.Streams.Print_Stream) is
   begin
      Stream.Initialize (Output);
      Stream.Content_Type := To_Unbounded_String (Content_Type);
      Stream.Encoding     := Unicode.Encodings.Get_By_Name (Encoding);
   end Initialize;

   --  ------------------------------
   --  Flush the response stream and release the buffer.
   --  ------------------------------
   procedure Finalize (Object : in out ResponseWriter) is
   begin
      Object.Flush;
   end Finalize;

   --  ------------------------------
   --  Get the content type.
   --  ------------------------------
   function Get_Content_Type (Stream : in ResponseWriter) return String is
   begin
      return To_String (Stream.Content_Type);
   end Get_Content_Type;

   --  ------------------------------
   --  Get the character encoding.
   --  ------------------------------
   function Get_Encoding (Stream : in ResponseWriter) return String is
   begin
      return Stream.Encoding.Name.all;
   end Get_Encoding;

   --  ------------------------------
   --  Close the current XML entity if an entity was started
   --  ------------------------------
   procedure Close_Current (Stream : in out ResponseWriter'Class) is
   begin
      if Stream.Close_Start then
         Stream.Write ('>');
         Stream.Close_Start := False;
      end if;
   end Close_Current;

   --  ------------------------------
   --  Start an XML element with the given name.
   --  ------------------------------
   procedure Start_Element (Stream : in out ResponseWriter;
                            Name   : in String) is
   begin
      Close_Current (Stream);
      Stream.Write ('<');
      Stream.Write (Name);
      Stream.Close_Start := True;
   end Start_Element;

   --  ------------------------------
   --  Start an XML element with the given name.
   --  ------------------------------
   procedure Start_Optional_Element (Stream : in out ResponseWriter;
                                     Name   : in String) is
   begin
      Close_Current (Stream);
      Stream.Optional_Element (1 .. Name'Length) := Name;
      Stream.Optional_Element_Size := Name'Length;
   end Start_Optional_Element;

   --  ------------------------------
   --  Closes an XML element of the given name.
   --  ------------------------------
   procedure End_Element (Stream : in out ResponseWriter;
                          Name   : in String) is
   begin
      Close_Current (Stream);
      Stream.Write ("</");
      Stream.Write (Name);
      Stream.Write ('>');
   end End_Element;

   --  ------------------------------
   --  Closes an XML element of the given name.
   --  ------------------------------
   procedure End_Optional_Element (Stream : in out ResponseWriter;
                                   Name   : in String) is
   begin
      Close_Current (Stream);
      if Stream.Optional_Element_Written then
         Stream.Write ("</");
         Stream.Write (Name);
         Stream.Write ('>');
      end if;
      Stream.Optional_Element_Written := False;
      Stream.Optional_Element_Size    := 0;
   end End_Optional_Element;

   --  ------------------------------
   --  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_Element (Stream   : in out ResponseWriter;
                            Name     : in String;
                            Content  : in String) is
   begin
      Stream.Start_Element (Name);
      Stream.Write_Text (Content);
      Stream.End_Element (Name);
   end Write_Element;

   procedure Write_Wide_Element (Stream   : in out ResponseWriter;
                                 Name     : in String;
                                 Content  : in Wide_Wide_String) is
   begin
      Stream.Start_Element (Name);
      Stream.Write_Wide_Text (Content);
      Stream.End_Element (Name);
   end Write_Wide_Element;

   procedure Write_Attribute (Stream : in out ResponseWriter;
                              Name   : in String;
                              Value  : in String) is
   begin
      --  If we have an optional element, start it.
      if Stream.Optional_Element_Size > 0 and not Stream.Optional_Element_Written then
         Stream.Write ('<');
         Stream.Write (Stream.Optional_Element (1 .. Stream.Optional_Element_Size));
         Stream.Close_Start := True;
         Stream.Optional_Element_Written := True;
      end if;
      if Stream.Close_Start then
         Stream.Write (' ');
         Stream.Write (Name);
         Stream.Write ('=');
         Stream.Write ('"');
         for I in Value'Range loop
            declare
               C : constant Character := Value (I);
            begin
               if C = '"' then
                  Stream.Write (""");
               else
                  Stream.Write_Escape (C);
               end if;
            end;
         end loop;
         Stream.Write ('"');
      end if;
   end Write_Attribute;

   procedure Write_Attribute (Stream : in out ResponseWriter;
                              Name   : in String;
                              Value  : in Unbounded_String) is
   begin
      Stream.Write_Attribute (Name, To_String (Value));
   end Write_Attribute;

   procedure Write_Attribute (Stream : in out ResponseWriter;
                              Name   : in String;
                              Value  : in EL.Objects.Object) is
      S : constant String := EL.Objects.To_String (Value);
   begin
      Stream.Write_Attribute (Name, S);
   end Write_Attribute;

   --  ------------------------------
   --  Write a text escaping any character as necessary.
   --  ------------------------------
   procedure Write_Text (Stream : in out ResponseWriter;
                         Text   : in String) is
   begin
      for I in Text'Range loop
         ResponseWriter'Class (Stream).Write_Char (Text (I));
      end loop;
   end Write_Text;

   procedure Write_Text (Stream : in out ResponseWriter;
                         Text   : in Unbounded_String) is
      Count : constant Natural := Length (Text);
   begin
      if Count > 0 then
         for I in 1 .. Count loop
            ResponseWriter'Class (Stream).Write_Char (Element (Text, I));
         end loop;
      end if;
   end Write_Text;

   procedure Write_Wide_Text (Stream : in out ResponseWriter;
                              Text   : in Wide_Wide_String) is
   begin
      for I in Text'Range loop
         ResponseWriter'Class (Stream).Write_Wide_Char (Text (I));
      end loop;
   end Write_Wide_Text;

   procedure Write_Text (Stream : in out ResponseWriter;
                         Value  : in EL.Objects.Object) is
      use EL.Objects;

      Of_Type : constant EL.Objects.Data_Type := EL.Objects.Get_Type (Value);
   begin
      case Of_Type is
         when TYPE_BOOLEAN =>
            Close_Current (Stream);
            if To_Boolean (Value) then
               ResponseWriter'Class (Stream).Write ("true");
            else
               ResponseWriter'Class (Stream).Write ("false");
            end if;

         when TYPE_INTEGER | TYPE_FLOAT =>
            Close_Current (Stream);
            ResponseWriter'Class (Stream).Write (To_String (Value));

         when TYPE_STRING =>
            ResponseWriter'Class (Stream).Write_Text (To_String (Value));

         when others =>
            ResponseWriter'Class (Stream).Write_Wide_Text (To_Wide_Wide_String (Value));

      end case;
   end Write_Text;

   --  ------------------------------
   --  Write a character on the response stream and escape that character
   --  as necessary.
   --  ------------------------------
   procedure Write_Char (Stream : in out ResponseWriter;
                         Char   : in Character) is
   begin
      Close_Current (Stream);
      Write_Escape (Stream, Char);
   end Write_Char;

   --  ------------------------------
   --  Internal method to write a character on the response stream
   --  and escape that character as necessary.  Unlike 'Write_Char',
   --  this operation does not closes the current XML entity.
   --  ------------------------------
   procedure Write_Escape (Stream : in out ResponseWriter'Class;
                           Char   : in Character) is
      Code : constant Unicode_Char := Character'Pos (Char);
   begin
      --  Tilde or less...
--        if Code < 16#A0# then
         --  If "?" or over, no escaping is needed (this covers
         --  most of the Latin alphabet)
         if Code > 16#3F# or Code <= 16#20# then
            Stream.Write (Char);
         elsif Char = '<' then
            Stream.Write ("<");
         elsif Char = '>' then
            Stream.Write (">");
         elsif Char = '&' then
            Stream.Write ("&");
         else
            Stream.Write (Char);
         end if;
--        else
--           declare
--              S : String (1 .. 5) := "�";
--              C : Unicode_Char;
--           begin
--              C := Code and 16#0F#;
--              if C > 10 then
--                 S (4) := Character'Val (C - 10 + Character'Pos ('A'));
--              else
--                 S (4) := Character'Val (C + Character'Pos ('0'));
--              end if;
--              C := (Code / 16) and 16#0F#;
--              if C > 10 then
--                 S (3) := Character'Val (C - 10 + Character'Pos ('A'));
--              else
--                 S (3) := Character'Val (C + Character'Pos ('0'));
--              end if;
--              Stream.Write (S);
--           end;
--        end if;
   end Write_Escape;

   --  ------------------------------
   --  Write a character on the response stream and escape that character
   --  as necessary.
   --  ------------------------------
   procedure Write_Wide_Char (Stream : in out ResponseWriter;
                              Char   : in Wide_Wide_Character) is
      Code : constant Unicode_Char := Wide_Wide_Character'Pos (Char);
   begin
      Close_Current (Stream);
      --  Tilde or less...
      if Code < 16#100# then
         Stream.Write_Char (Character'Val (Code));
      else
         declare
            S : String (1 .. 5) := "�";
            C : Unicode_Char;
         begin
            C := Code and 16#0F#;
            if C > 10 then
               S (4) := Character'Val (C - 10 + Character'Pos ('A'));
            else
               S (4) := Character'Val (C + Character'Pos ('0'));
            end if;
            C := (Code / 16) and 16#0F#;
            if C > 10 then
               S (3) := Character'Val (C - 10 + Character'Pos ('A'));
            else
               S (3) := Character'Val (C + Character'Pos ('0'));
            end if;
            Stream.Write (S);
         end;
      end if;
   end Write_Wide_Char;

   --  ------------------------------
   --  Write a string on the stream.
   --  ------------------------------
   procedure Write (Stream : in out ResponseWriter;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Close_Current (Stream);
      ASF.Streams.Print_Stream (Stream).Write (Item);
   end Write;

end ASF.Contexts.Writer;

Write the character above 0xA0 as is. This allows to have UTF-8 sequences in a String and generate UTF-8 pages.


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

package body Wiki.Filters is

   --  ------------------------------
   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   --  ------------------------------
   procedure Add_Node (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Node (Document, Kind);
      else
         Wiki.Nodes.Append (Document, Kind);
      end if;
   end Add_Node;

   --  ------------------------------
   --  Add a text content with the given format to the document.
   --  ------------------------------
   procedure Add_Text (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Nodes.Format_Map) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Text (Document, Text, Format);
      else
         Wiki.Nodes.Append (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   procedure Add_Header (Filter    : in out Filter_Type;
                         Document  : in out Wiki.Nodes.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Header (Document, Header, Level);
      else
         Wiki.Nodes.Append (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Push a HTML node with the given tag to the document.
   --  ------------------------------
   procedure Push_Node (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Tag        : in Wiki.Nodes.Html_Tag_Type;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Push_Node (Document, Tag, Attributes);
      else
         Wiki.Nodes.Push_Node (Document, Tag, Attributes);
      end if;
   end Push_Node;

   --  ------------------------------
   --  Pop a HTML node with the given tag.
   --  ------------------------------
   procedure Pop_Node (Filter   : in out Filter_Type;
                       Document : in out Wiki.Nodes.Document;
                       Tag     : in Wiki.Nodes.Html_Tag_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Pop_Node (Document, Tag);
      else
         Wiki.Nodes.Pop_Node (Document, Tag);
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Document : in out Filter_Type;
                             Level    : in Natural) is
   begin
      Document.Document.Add_Blockquote (Level);
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Document : in out Filter_Type;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      Document.Document.Add_List_Item (Level, Ordered);
   end Add_List_Item;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Filter     : in out Filter_Type;
                       Document   : in out Wiki.Nodes.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Link (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Image (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Image (Document, Name, Attributes);
      end if;
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Quote (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Quote (Document, Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Filter   : in out Filter_Type;
                               Document : in out Wiki.Nodes.Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Unbounded_Wide_Wide_String) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Preformatted (Document, Text, Format);
      else
         Wiki.Nodes.Add_Preformatted (Document, Text, Format);
      end if;
   end Add_Preformatted;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   procedure Finish (Filter : in out Filter_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Finish;
      end if;
   end Finish;

end Wiki.Filters;

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

package body Wiki.Filters is

   --  ------------------------------
   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   --  ------------------------------
   procedure Add_Node (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Node (Document, Kind);
      else
         Wiki.Nodes.Append (Document, Kind);
      end if;
   end Add_Node;

   --  ------------------------------
   --  Add a text content with the given format to the document.
   --  ------------------------------
   procedure Add_Text (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Nodes.Format_Map) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Text (Document, Text, Format);
      else
         Wiki.Nodes.Append (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   procedure Add_Header (Filter    : in out Filter_Type;
                         Document  : in out Wiki.Nodes.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Header (Document, Header, Level);
      else
         Wiki.Nodes.Append (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Push a HTML node with the given tag to the document.
   --  ------------------------------
   procedure Push_Node (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Tag        : in Wiki.Nodes.Html_Tag_Type;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Push_Node (Document, Tag, Attributes);
      else
         Wiki.Nodes.Push_Node (Document, Tag, Attributes);
      end if;
   end Push_Node;

   --  ------------------------------
   --  Pop a HTML node with the given tag.
   --  ------------------------------
   procedure Pop_Node (Filter   : in out Filter_Type;
                       Document : in out Wiki.Nodes.Document;
                       Tag     : in Wiki.Nodes.Html_Tag_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Pop_Node (Document, Tag);
      else
         Wiki.Nodes.Pop_Node (Document, Tag);
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Filter   : in out Filter_Type;
                             Document : in out Wiki.Nodes.Document;
                             Level    : in Natural) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Blockquote (Document, Level);
      else
         Wiki.Nodes.Add_Blockquote (Document, Level);
      end if;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Filter   : in out Filter_Type;
                            Document : in out Wiki.Nodes.Document;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_List_Item (Document, Level, Ordered);
      else
         Wiki.Nodes.Add_List_Item (Document, Level, Ordered);
      end if;
   end Add_List_Item;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Filter     : in out Filter_Type;
                       Document   : in out Wiki.Nodes.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Link (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Image (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Image (Document, Name, Attributes);
      end if;
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Quote (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Quote (Document, Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Filter   : in out Filter_Type;
                               Document : in out Wiki.Nodes.Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Unbounded_Wide_Wide_String) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Preformatted (Document, Text, Format);
      else
         Wiki.Nodes.Add_Preformatted (Document, Text, Format);
      end if;
   end Add_Preformatted;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   procedure Finish (Filter : in out Filter_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Finish;
      end if;
   end Finish;

end Wiki.Filters;

Update Add_Blockquote and Add_List_Item procedures


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

with Wiki.Documents;

--  The AWA.Wikis.Parsers package implements a parser for several well known wiki formats.
--  The parser works with the Document_Reader interface type which defines several
--  procedures that are called by the parser when the wiki text is scanned.
package Wiki.Parsers is

   pragma Preelaborate;

   --  Defines the possible wiki syntax supported by the parser.
   type Wiki_Syntax_Type
     is (
         --  Google wiki syntax http://code.google.com/p/support/wiki/WikiSyntax
         SYNTAX_GOOGLE,

         --  Creole wiki syntax http://www.wikicreole.org/wiki/Creole1.0
         SYNTAX_CREOLE,

         --  Dotclear syntax http://dotclear.org/documentation/2.0/usage/syntaxes
         SYNTAX_DOTCLEAR,

         --  PhpBB syntax http://wiki.phpbb.com/Help:Formatting
         SYNTAX_PHPBB,

         --  MediaWiki syntax http://www.mediawiki.org/wiki/Help:Formatting
         SYNTAX_MEDIA_WIKI,

         --  A mix of the above
         SYNTAX_MIX);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  specified in Syntax and invoke the document reader procedures defined
   --  by into.
   procedure Parse (Into   : in Wiki.Documents.Document_Reader_Access;
                    Text   : in Wide_Wide_String;
                    Syntax : in Wiki_Syntax_Type := SYNTAX_MIX);

private

   HT : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#09#);
   LF : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0A#);
   CR : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0D#);

   type Input is interface;
   type Input_Access is access all Input'Class;
   procedure Read_Char (From : in out Input;
                        Token : out Wide_Wide_Character;
                        Eof   : out Boolean) is abstract;

   type Parser is limited record
      Pending             : Wide_Wide_Character;
      Has_Pending         : Boolean;
      Document            : Wiki.Documents.Document_Reader_Access;
      Format              : Wiki.Documents.Format_Map;
      Text                : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      Empty_Line          : Boolean := True;
      Is_Eof              : Boolean := False;
      In_Paragraph        : Boolean := False;
      Need_Paragraph      : Boolean := True;
      Link_Double_Bracket : Boolean := False;
      Is_Dotclear         : Boolean := False;
      Header_Offset       : Integer := 0;
      Quote_Level         : Natural := 0;
      Escape_Char         : Wide_Wide_Character;
      List_Level          : Natural := 0;
      Reader              : Input_Access := null;
   end record;

   type Parser_Handler is access procedure (P     : in out Parser;
                                            Token : in Wide_Wide_Character);

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

end Wiki.Parsers;

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

with Wiki.Documents;

--  The AWA.Wikis.Parsers package implements a parser for several well known wiki formats.
--  The parser works with the Document_Reader interface type which defines several
--  procedures that are called by the parser when the wiki text is scanned.
package Wiki.Parsers is

   pragma Preelaborate;

   --  Defines the possible wiki syntax supported by the parser.
   type Wiki_Syntax_Type
     is (
         --  Google wiki syntax http://code.google.com/p/support/wiki/WikiSyntax
         SYNTAX_GOOGLE,

         --  Creole wiki syntax http://www.wikicreole.org/wiki/Creole1.0
         SYNTAX_CREOLE,

         --  Dotclear syntax http://dotclear.org/documentation/2.0/usage/syntaxes
         SYNTAX_DOTCLEAR,

         --  PhpBB syntax http://wiki.phpbb.com/Help:Formatting
         SYNTAX_PHPBB,

         --  MediaWiki syntax http://www.mediawiki.org/wiki/Help:Formatting
         SYNTAX_MEDIA_WIKI,

         --  Markdown
         SYNTAX_MARKDOWN,

         --  A mix of the above
         SYNTAX_MIX);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  specified in Syntax and invoke the document reader procedures defined
   --  by into.
   procedure Parse (Into   : in Wiki.Documents.Document_Reader_Access;
                    Text   : in Wide_Wide_String;
                    Syntax : in Wiki_Syntax_Type := SYNTAX_MIX);

private

   HT : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#09#);
   LF : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0A#);
   CR : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0D#);

   type Input is interface;
   type Input_Access is access all Input'Class;
   procedure Read_Char (From : in out Input;
                        Token : out Wide_Wide_Character;
                        Eof   : out Boolean) is abstract;

   type Parser is limited record
      Pending             : Wide_Wide_Character;
      Has_Pending         : Boolean;
      Document            : Wiki.Documents.Document_Reader_Access;
      Format              : Wiki.Documents.Format_Map;
      Text                : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      Empty_Line          : Boolean := True;
      Is_Eof              : Boolean := False;
      In_Paragraph        : Boolean := False;
      Need_Paragraph      : Boolean := True;
      Link_Double_Bracket : Boolean := False;
      Is_Dotclear         : Boolean := False;
      Header_Offset       : Integer := 0;
      Quote_Level         : Natural := 0;
      Escape_Char         : Wide_Wide_Character;
      List_Level          : Natural := 0;
      Reader              : Input_Access := null;
   end record;

   type Parser_Handler is access procedure (P     : in out Parser;
                                            Token : in Wide_Wide_Character);

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

end Wiki.Parsers;

Add the Markdown syntax

Add the Markdown syntax


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

with Util.Test_Caller;

with ASF.Tests;
with AWA.Users.Models;
with AWA.Tests.Helpers.Users;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Principals;
package body AWA.Users.Tests is

   use ASF.Tests;
   use AWA.Tests;

   package Caller is new Util.Test_Caller (Test, "Users.Tests");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Users.Tests.Create_User (/users/register.xhtml)",
                       Test_Create_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Services.Close_Session",
                       Test_Logout_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Tests.Login_User (/users/login.xhtml)",
                       Test_Login_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Services.Lost_Password, Reset_Password",
                       Test_Reset_Password_User'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of user by simulating web requests.
   --  ------------------------------
   procedure Test_Create_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Email     : constant String := "Joe-" & Util.Tests.Get_Uuid & "@gmail.com";
      Principal : AWA.Tests.Helpers.Users.Test_User;
   begin
      AWA.Tests.Helpers.Users.Initialize (Principal);

      Do_Get (Request, Reply, "/auth/register.html", "create-user-1.html");

      Request.Set_Parameter ("email", Email);
      Request.Set_Parameter ("password", "asdf");
      Request.Set_Parameter ("password2", "asdf");
      Request.Set_Parameter ("firstName", "joe");
      Request.Set_Parameter ("lastName", "dalton");
      Request.Set_Parameter ("register", "1");
      Request.Set_Parameter ("register-button", "1");
      Do_Post (Request, Reply, "/auth/register.html", "create-user-2.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

      --  Check that the user is NOT logged.
      T.Assert (Request.Get_User_Principal = null, "A user principal should not be defined");

      --  Now, get the access key and simulate a click on the validation link.
      declare

         Key       : AWA.Users.Models.Access_Key_Ref;
      begin
         AWA.Tests.Helpers.Users.Find_Access_Key (Principal, Email, Key);
         T.Assert (not Key.Is_Null, "There is no access key associated with the user");
         Request.Set_Parameter ("key", Key.Get_Access_Key);
         Do_Get (Request, Reply, "/auth/validate.html", "validate-user-1.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");
      end;

      --  Check that the user is logged and we have a user principal now.
      T.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
   end Test_Create_User;

   procedure Test_Logout_User (T : in out Test) is
   begin
      null;
   end Test_Logout_User;

   --  ------------------------------
   --  Test user authentication by simulating a web request.
   --  ------------------------------
   procedure Test_Login_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Principal : AWA.Tests.Helpers.Users.Test_User;
   begin
      AWA.Tests.Set_Application_Context;
      AWA.Tests.Helpers.Users.Create_User (Principal, "Joe@gmail.com");

      Do_Get (Request, Reply, "/auth/login.html", "login-user-1.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

      --  Check that the user is NOT logged.
      T.Assert (Request.Get_User_Principal = null, "A user principal should not be defined");

      Request.Set_Parameter ("email", "Joe@gmail.com");
      Request.Set_Parameter ("password", "admin");
      Request.Set_Parameter ("login", "1");
      Request.Set_Parameter ("login-button", "1");
      Do_Post (Request, Reply, "/auth/login.html", "login-user-2.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

      --  Check that the user is logged and we have a user principal now.
      T.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
   end Test_Login_User;

   --  ------------------------------
   --  Test the reset password by simulating web requests.
   --  ------------------------------
   procedure Test_Reset_Password_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Email   : constant String := "Joe@gmail.com";
   begin
      Do_Get (Request, Reply, "/auth/lost-password.html", "lost-password-1.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

      Request.Set_Parameter ("email", Email);
      Request.Set_Parameter ("lost-password", "1");
      Request.Set_Parameter ("lost-password-button", "1");
      Do_Post (Request, Reply, "/auth/lost-password.html", "lost-password-2.html");

      ASF.Tests.Assert_Redirect (T, "/asfunit/auth/login.html",
                                 Reply, "Invalid redirect after lost password");

      --  Now, get the access key and simulate a click on the reset password link.
      declare
         Principal : AWA.Tests.Helpers.Users.Test_User;
         Key       : AWA.Users.Models.Access_Key_Ref;
      begin
         AWA.Tests.Set_Application_Context;
         AWA.Tests.Helpers.Users.Find_Access_Key (Principal, Email, Key);
         T.Assert (not Key.Is_Null, "There is no access key associated with the user");

         --  Simulate user clicking on the reset password link.
         --  This verifies the key, login the user and redirect him to the change-password page
         Request.Set_Parameter ("key", Key.Get_Access_Key);
         Do_Get (Request, Reply, "/auth/reset-password.html", "reset-password-1.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

         --  Post the reset password
         Request.Set_Parameter ("password", "asd");
         Request.Set_Parameter ("reset-password", "1");
         Do_Post (Request, Reply, "/auth/change-password.html", "reset-password-2.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

         --  Check that the user is logged and we have a user principal now.
         T.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
      end;
   end Test_Reset_Password_User;

end AWA.Users.Tests;

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

with Util.Test_Caller;

with ASF.Tests;
with AWA.Users.Models;
with AWA.Tests.Helpers.Users;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Principals;
package body AWA.Users.Tests is

   use ASF.Tests;
   use AWA.Tests;

   package Caller is new Util.Test_Caller (Test, "Users.Tests");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Users.Tests.Create_User (/users/register.xhtml)",
                       Test_Create_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Services.Close_Session",
                       Test_Logout_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Tests.Login_User (/users/login.xhtml)",
                       Test_Login_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Services.Lost_Password, Reset_Password",
                       Test_Reset_Password_User'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of user by simulating web requests.
   --  ------------------------------
   procedure Test_Create_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Email     : constant String := "Joe-" & Util.Tests.Get_Uuid & "@gmail.com";
      Principal : AWA.Tests.Helpers.Users.Test_User;
   begin
      AWA.Tests.Helpers.Users.Initialize (Principal);

      Do_Get (Request, Reply, "/auth/register.html", "create-user-1.html");

      Request.Set_Parameter ("email", Email);
      Request.Set_Parameter ("password", "asdf");
      Request.Set_Parameter ("password2", "asdf");
      Request.Set_Parameter ("firstName", "joe");
      Request.Set_Parameter ("lastName", "dalton");
      Request.Set_Parameter ("register", "1");
      Request.Set_Parameter ("register-button", "1");
      Do_Post (Request, Reply, "/auth/register.html", "create-user-2.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

      --  Check that the user is NOT logged.
      T.Assert (Request.Get_User_Principal = null, "A user principal should not be defined");

      --  Now, get the access key and simulate a click on the validation link.
      declare

         Key       : AWA.Users.Models.Access_Key_Ref;
      begin
         AWA.Tests.Helpers.Users.Find_Access_Key (Principal, Email, Key);
         T.Assert (not Key.Is_Null, "There is no access key associated with the user");
         Request.Set_Parameter ("key", Key.Get_Access_Key);
         Do_Get (Request, Reply, "/auth/validate.html", "validate-user-1.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");
      end;

      --  Check that the user is logged and we have a user principal now.
      T.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
   end Test_Create_User;

   procedure Test_Logout_User (T : in out Test) is
   begin
      null;
   end Test_Logout_User;

   --  ------------------------------
   --  Test user authentication by simulating a web request.
   --  ------------------------------
   procedure Test_Login_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Principal : AWA.Tests.Helpers.Users.Test_User;
   begin
      AWA.Tests.Set_Application_Context;
      AWA.Tests.Helpers.Users.Create_User (Principal, "Joe@gmail.com");

      Do_Get (Request, Reply, "/auth/login.html", "login-user-1.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

      --  Check that the user is NOT logged.
      T.Assert (Request.Get_User_Principal = null, "A user principal should not be defined");

      Request.Set_Parameter ("email", "Joe@gmail.com");
      Request.Set_Parameter ("password", "admin");
      Request.Set_Parameter ("login", "1");
      Request.Set_Parameter ("login-button", "1");
      Do_Post (Request, Reply, "/auth/login.html", "login-user-2.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

      --  Check that the user is logged and we have a user principal now.
      T.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
   end Test_Login_User;

   --  ------------------------------
   --  Test the reset password by simulating web requests.
   --  ------------------------------
   procedure Test_Reset_Password_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Email   : constant String := "Joe@gmail.com";
   begin
      Do_Get (Request, Reply, "/auth/lost-password.html", "lost-password-1.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

      Request.Set_Parameter ("email", Email);
      Request.Set_Parameter ("lost-password", "1");
      Request.Set_Parameter ("lost-password-button", "1");
      Do_Post (Request, Reply, "/auth/lost-password.html", "lost-password-2.html");

      ASF.Tests.Assert_Redirect (T, "/asfunit/auth/login.html",
                                 Reply, "Invalid redirect after lost password");

      --  Now, get the access key and simulate a click on the reset password link.
      declare
         Principal : AWA.Tests.Helpers.Users.Test_User;
         Key       : AWA.Users.Models.Access_Key_Ref;
      begin
         AWA.Tests.Set_Application_Context;
         AWA.Tests.Helpers.Users.Find_Access_Key (Principal, Email, Key);
         T.Assert (not Key.Is_Null, "There is no access key associated with the user");

         --  Simulate user clicking on the reset password link.
         --  This verifies the key, login the user and redirect him to the change-password page
         Request.Set_Parameter ("key", Key.Get_Access_Key);
         Request.Set_Parameter ("password", "asd");
         Request.Set_Parameter ("reset-password", "1");
         Do_Post (Request, Reply, "/auth/change-password.html", "reset-password-2.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

         --  Check that the user is logged and we have a user principal now.
         T.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
      end;
   end Test_Reset_Password_User;

end AWA.Users.Tests;

Update the unit test according to the lost password recovery process