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

with ASF.Views.Nodes;
with ASF.Converters;
with ASF.Validators;
with EL.Objects;

private with Util.Beans.Objects.Hash;
private with Ada.Containers;
private with Ada.Containers.Hashed_Maps;

--  The ASF.Factory is the main factory for building the facelet
--  node tree and defining associated component factory.  A binding library
--  must be registered before the application starts.  The binding library
--  must not be changed (this is a read-only static definition of names
--  associated with create functions).
package ASF.Factory is

   use ASF;

   --  ------------------------------
   --  List of bindings
   --  ------------------------------
   --  The binding array defines a set of XML entity names that represent
   --  a library accessible through a XML name-space.  The binding array
   --  must be sorted on the binding name.  The Check procedure will
   --  verify this assumption when the bindings are registered in the factory.
   type Binding_Array is array (Natural range <>) of aliased ASF.Views.Nodes.Binding;
   type Binding_Array_Access is access constant Binding_Array;

   type Factory_Bindings is limited record
      URI      : ASF.Views.Nodes.Name_Access;
      Bindings : Binding_Array_Access;
   end record;
   type Factory_Bindings_Access is access constant Factory_Bindings;

   --  ------------------------------
   --  Component Factory
   --  ------------------------------
   --  The Component_Factory is the main entry point to register bindings
   --  and resolve them when an XML file is read.
   type Component_Factory is limited private;

   --  Register a binding library in the factory.
   procedure Register (Factory  : in out Component_Factory;
                       Bindings : in Factory_Bindings_Access);

   --  Find the create function in bound to the name in the given URI name-space.
   --  Returns null if no such binding exist.
   function Find (Factory : in Component_Factory;
                  URI     : in String;
                  Name    : in String) return ASF.Views.Nodes.Binding_Access;

   --  ------------------------------
   --  Converter Factory
   --  ------------------------------
   --  The Converter_Factory registers the converters which can be used
   --  to convert a value into a string or the opposite.

   --  Register the converter instance under the given name.
   procedure Register (Factory   : in out Component_Factory;
                       Name      : in String;
                       Converter : in ASF.Converters.Converter_Access);

   --  Find the converter instance that was registered under the given name.
   --  Returns null if no such converter exist.
   function Find (Factory : in Component_Factory;
                  Name    : in EL.Objects.Object) return ASF.Converters.Converter_Access;

   --  ------------------------------
   --  Validator Factory
   --  ------------------------------

   --  Register the validator instance under the given name.
   procedure Register (Factory   : in out Component_Factory;
                       Name      : in String;
                       Validator : in ASF.Validators.Validator_Access);

   --  Find the validator instance that was registered under the given name.
   --  Returns null if no such validator exist.
   function Find (Factory : in Component_Factory;
                  Name    : in EL.Objects.Object) return ASF.Validators.Validator_Access;

private

   use ASF.Converters;
   use ASF.Validators;
   use ASF.Views.Nodes;

   --  The tag name defines a URI with the name.
   type Tag_Name is record
      URI  : ASF.Views.Nodes.Name_Access;
      Name : ASF.Views.Nodes.Name_Access;
   end record;

   --  Compute a hash for the tag name.
   function Hash (Key : in Tag_Name) return Ada.Containers.Hash_Type;

   --  Returns true if both tag names are identical.
   function "=" (Left, Right : in Tag_Name) return Boolean;

   --  Tag library map indexed on the library namespace.
   package Factory_Maps is new
     Ada.Containers.Hashed_Maps (Key_Type        => Tag_Name,
                                 Element_Type    => Binding_Access,
                                 Hash            => Hash,
                                 Equivalent_Keys => "=");

   --  Converter map indexed on the converter name.
   --  The key is an EL.Objects.Object to minimize the conversions when searching
   --  for a converter.
   package Converter_Maps is new
     Ada.Containers.Hashed_Maps (Key_Type        => EL.Objects.Object,
                                 Element_Type    => Converter_Access,
                                 Hash            => EL.Objects.Hash,
                                 Equivalent_Keys => EL.Objects."=");

   --  Validator map indexed on the validator name.
   --  The key is an EL.Objects.Object to minimize the conversions when searching
   --  for a validator.
   package Validator_Maps is new
     Ada.Containers.Hashed_Maps (Key_Type        => EL.Objects.Object,
                                 Element_Type    => Validator_Access,
                                 Hash            => EL.Objects.Hash,
                                 Equivalent_Keys => EL.Objects."=");

   type Component_Factory is limited record
      Map        : Factory_Maps.Map;
      Converters : Converter_Maps.Map;
      Validators : Validator_Maps.Map;
   end record;

end ASF.Factory;

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

with ASF.Views.Nodes;
with ASF.Converters;
with ASF.Validators;
with EL.Objects;

private with Util.Beans.Objects.Hash;
private with Ada.Containers;
private with Ada.Containers.Hashed_Maps;

--  The ASF.Factory is the main factory for building the facelet
--  node tree and defining associated component factory.  A binding library
--  must be registered before the application starts.  The binding library
--  must not be changed (this is a read-only static definition of names
--  associated with create functions).
package ASF.Factory is

   --  ------------------------------
   --  List of bindings
   --  ------------------------------
   --  The binding array defines a set of XML entity names that represent
   --  a library accessible through a XML name-space.  The binding array
   --  must be sorted on the binding name.  The Check procedure will
   --  verify this assumption when the bindings are registered in the factory.
   type Binding_Array is array (Natural range <>) of aliased ASF.Views.Nodes.Binding_Type;
   type Binding_Array_Access is access constant Binding_Array;

   type Factory_Bindings is limited record
      URI      : ASF.Views.Nodes.Name_Access;
      Bindings : Binding_Array_Access;
   end record;
   type Factory_Bindings_Access is access constant Factory_Bindings;

   --  ------------------------------
   --  Component Factory
   --  ------------------------------
   --  The Component_Factory is the main entry point to register bindings
   --  and resolve them when an XML file is read.
   type Component_Factory is limited private;

   --  Register a binding library in the factory.
   procedure Register (Factory  : in out Component_Factory;
                       Bindings : in Factory_Bindings_Access);

   procedure Register (Factory   : in out Component_Factory;
                       URI       : in ASF.Views.Nodes.Name_Access;
                       Name      : in ASF.Views.Nodes.Name_Access;
                       Tag       : in ASF.Views.Nodes.Tag_Node_Create_Access;
                       Create    : in ASF.Views.Nodes.Create_Access);

   --  Find the create function in bound to the name in the given URI name-space.
   --  Returns null if no such binding exist.
   function Find (Factory : in Component_Factory;
                  URI     : in String;
                  Name    : in String) return ASF.Views.Nodes.Binding_Type;

   --  ------------------------------
   --  Converter Factory
   --  ------------------------------
   --  The Converter_Factory registers the converters which can be used
   --  to convert a value into a string or the opposite.

   --  Register the converter instance under the given name.
   procedure Register (Factory   : in out Component_Factory;
                       Name      : in String;
                       Converter : in ASF.Converters.Converter_Access);

   --  Find the converter instance that was registered under the given name.
   --  Returns null if no such converter exist.
   function Find (Factory : in Component_Factory;
                  Name    : in EL.Objects.Object) return ASF.Converters.Converter_Access;

   --  ------------------------------
   --  Validator Factory
   --  ------------------------------

   --  Register the validator instance under the given name.
   procedure Register (Factory   : in out Component_Factory;
                       Name      : in String;
                       Validator : in ASF.Validators.Validator_Access);

   --  Find the validator instance that was registered under the given name.
   --  Returns null if no such validator exist.
   function Find (Factory : in Component_Factory;
                  Name    : in EL.Objects.Object) return ASF.Validators.Validator_Access;

private

   use ASF.Converters;
   use ASF.Validators;
   use ASF.Views.Nodes;

   --  The tag name defines a URI with the name.
   type Tag_Name is record
      URI  : ASF.Views.Nodes.Name_Access;
      Name : ASF.Views.Nodes.Name_Access;
   end record;

   --  Compute a hash for the tag name.
   function Hash (Key : in Tag_Name) return Ada.Containers.Hash_Type;

   --  Returns true if both tag names are identical.
   function "=" (Left, Right : in Tag_Name) return Boolean;

   --  Tag library map indexed on the library namespace.
   package Factory_Maps is new
     Ada.Containers.Hashed_Maps (Key_Type        => Tag_Name,
                                 Element_Type    => Binding_Type,
                                 Hash            => Hash,
                                 Equivalent_Keys => "=");

   --  Converter map indexed on the converter name.
   --  The key is an EL.Objects.Object to minimize the conversions when searching
   --  for a converter.
   package Converter_Maps is new
     Ada.Containers.Hashed_Maps (Key_Type        => EL.Objects.Object,
                                 Element_Type    => Converter_Access,
                                 Hash            => EL.Objects.Hash,
                                 Equivalent_Keys => EL.Objects."=");

   --  Validator map indexed on the validator name.
   --  The key is an EL.Objects.Object to minimize the conversions when searching
   --  for a validator.
   package Validator_Maps is new
     Ada.Containers.Hashed_Maps (Key_Type        => EL.Objects.Object,
                                 Element_Type    => Validator_Access,
                                 Hash            => EL.Objects.Hash,
                                 Equivalent_Keys => EL.Objects."=");

   type Component_Factory is limited record
      Map        : Factory_Maps.Map;
      Converters : Converter_Maps.Map;
      Validators : Validator_Maps.Map;
   end record;

end ASF.Factory;

Update the factory to use the Binding_Type instead of the Binding_Access Declare a Register procedure to register a single binding instance


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

with ASF.Components.Base;
with ASF.Components.Html.Text;
with ASF.Components.Html.Lists;
with ASF.Components.Html.Links;
with ASF.Components.Html.Panels;
with ASF.Components.Html.Forms;
with ASF.Components.Html.Pages;
with ASF.Components.Html.Selects;
with ASF.Components.Html.Messages;
with ASF.Views.Nodes;
package body ASF.Components.Html.Factory is

   use ASF.Components.Base;

   function Create_Body return UIComponent_Access;
   function Create_Doctype return UIComponent_Access;
   function Create_Head return UIComponent_Access;
   function Create_Output return UIComponent_Access;
   function Create_Output_Label return UIComponent_Access;
   function Create_Output_Link return UIComponent_Access;
   function Create_Output_Format return UIComponent_Access;
   function Create_List return UIComponent_Access;
   function Create_PanelGroup return UIComponent_Access;
   function Create_Form return UIComponent_Access;
   function Create_Input_File return UIComponent_Access;
   function Create_Input_Hidden return UIComponent_Access;
   function Create_Input_Text return UIComponent_Access;
   function Create_Input_Textarea return UIComponent_Access;
   function Create_Command return UIComponent_Access;
   function Create_Message return UIComponent_Access;
   function Create_Messages return UIComponent_Access;
   function Create_SelectOne return UIComponent_Access;
   function Create_SelectOneRadio return UIComponent_Access;
   function Create_SelectBooleanCheckbox return UIComponent_Access;
   --  Create an UIInput secret component
   function Create_Input_Secret return ASF.Components.Base.UIComponent_Access;

   --  ------------------------------
   --  Create an UIBody component
   --  ------------------------------
   function Create_Body return UIComponent_Access is
   begin
      return new ASF.Components.Html.Pages.UIBody;
   end Create_Body;

   --  ------------------------------
   --  Create an UIDoctype component
   --  ------------------------------
   function Create_Doctype return UIComponent_Access is
   begin
      return new ASF.Components.Html.Pages.UIDoctype;
   end Create_Doctype;

   --  ------------------------------
   --  Create an UIHead component
   --  ------------------------------
   function Create_Head return UIComponent_Access is
   begin
      return new ASF.Components.Html.Pages.UIHead;
   end Create_Head;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutput;
   end Create_Output;

   --  ------------------------------
   --  Create an UIOutputLabel component
   --  ------------------------------
   function Create_Output_Label return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutputLabel;
   end Create_Output_Label;

   --  ------------------------------
   --  Create an UIOutputLink component
   --  ------------------------------
   function Create_Output_Link return UIComponent_Access is
   begin
      return new ASF.Components.Html.Links.UIOutputLink;
   end Create_Output_Link;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output_Format return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutputFormat;
   end Create_Output_Format;

   --  ------------------------------
   --  Create an UIList component
   --  ------------------------------
   function Create_List return UIComponent_Access is
   begin
      return new ASF.Components.Html.Lists.UIList;
   end Create_List;

   --  ------------------------------
   --  Create an UIPanelGroup component
   --  ------------------------------
   function Create_PanelGroup return UIComponent_Access is
   begin
      return new ASF.Components.Html.Panels.UIPanelGroup;
   end Create_PanelGroup;

   --  ------------------------------
   --  Create an UIForm component
   --  ------------------------------
   function Create_Form return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIForm;
   end Create_Form;

   --  ------------------------------
   --  Create an UIInput_Hidden component
   --  ------------------------------
   function Create_Input_Hidden return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInput_Hidden;
   end Create_Input_Hidden;

   --  ------------------------------
   --  Create an UIInput component
   --  ------------------------------
   function Create_Input_Text return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInput;
   end Create_Input_Text;

   --  ------------------------------
   --  Create an UIInput secret component
   --  ------------------------------
   function Create_Input_Secret return ASF.Components.Base.UIComponent_Access is
      Result : constant Html.Forms.UIInput_Access := new ASF.Components.Html.Forms.UIInput;
   begin
      Result.Set_Secret (True);
      return Result.all'Access;
   end Create_Input_Secret;

   --  ------------------------------
   --  Create an UIInputTextarea component
   --  ------------------------------
   function Create_Input_Textarea return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInputTextarea;
   end Create_Input_Textarea;

   --  ------------------------------
   --  Create an UIInput_File component
   --  ------------------------------
   function Create_Input_File return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInput_File;
   end Create_Input_File;

   --  ------------------------------
   --  Create an UICommand component
   --  ------------------------------
   function Create_Command return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UICommand;
   end Create_Command;

   --  ------------------------------
   --  Create an UIMessage component
   --  ------------------------------
   function Create_Message return UIComponent_Access is
   begin
      return new ASF.Components.Html.Messages.UIMessage;
   end Create_Message;

   --  ------------------------------
   --  Create an UIMessages component
   --  ------------------------------
   function Create_Messages return UIComponent_Access is
   begin
      return new ASF.Components.Html.Messages.UIMessages;
   end Create_Messages;

   --  ------------------------------
   --  Create an UISelectOne component
   --  ------------------------------
   function Create_SelectOne return UIComponent_Access is
   begin
      return new ASF.Components.Html.Selects.UISelectOne;
   end Create_SelectOne;

   --  ------------------------------
   --  Create an UISelectOneRadio component
   --  ------------------------------
   function Create_SelectOneRadio return UIComponent_Access is
   begin
      return new ASF.Components.Html.Selects.UISelectOneRadio;
   end Create_SelectOneRadio;

   --  ------------------------------
   --  Create an UISelectBoolean component
   --  ------------------------------
   function Create_SelectBooleanCheckbox return UIComponent_Access is
   begin
      return new ASF.Components.Html.Selects.UISelectBoolean;
   end Create_SelectBooleanCheckbox;

   use ASF.Views.Nodes;

   URI                : aliased constant String := "http://java.sun.com/jsf/html";

   BODY_TAG           : aliased constant String := "body";
   COMMAND_BUTTON_TAG : aliased constant String := "commandButton";
   DOCTYPE_TAG        : aliased constant String := "doctype";
   FORM_TAG           : aliased constant String := "form";
   HEAD_TAG           : aliased constant String := "head";
   INPUT_FILE_TAG     : aliased constant String := "inputFile";
   INPUT_HIDDEN_TAG   : aliased constant String := "inputHidden";
   INPUT_SECRET_TAG   : aliased constant String := "inputSecret";
   INPUT_TEXT_TAG     : aliased constant String := "inputText";
   INPUT_TEXTAREA_TAG : aliased constant String := "inputTextarea";
   LIST_TAG           : aliased constant String := "list";
   MESSAGE_TAG        : aliased constant String := "message";
   MESSAGES_TAG       : aliased constant String := "messages";
   OUTPUT_FORMAT_TAG  : aliased constant String := "outputFormat";
   OUTPUT_LABEL_TAG   : aliased constant String := "outputLabel";
   OUTPUT_LINK_TAG    : aliased constant String := "outputLink";
   OUTPUT_TEXT_TAG    : aliased constant String := "outputText";
   PANEL_GROUP_TAG    : aliased constant String := "panelGroup";
   SELECT_BOOLEAN_TAG  : aliased constant String := "selectBooleanCheckbox";
   SELECT_ONE_MENU_TAG : aliased constant String := "selectOneMenu";
   SELECT_ONE_RADIO_TAG : aliased constant String := "selectOneRadio";

   --  ------------------------------
   --  Get the HTML component factory.
   --  ------------------------------
   procedure Register (Factory : in out ASF.Factory.Component_Factory) is
   begin
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => BODY_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Body'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => COMMAND_BUTTON_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Command'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => DOCTYPE_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Doctype'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => FORM_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Form'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => HEAD_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Head'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INPUT_FILE_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Input_File'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INPUT_HIDDEN_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Input_Hidden'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INPUT_SECRET_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Input_Secret'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INPUT_TEXT_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Input_Text'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INPUT_TEXTAREA_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Input_Textarea'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => LIST_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_List'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => MESSAGE_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Message'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => MESSAGES_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Messages'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => OUTPUT_FORMAT_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Output_Format'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => OUTPUT_LABEL_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Output_Label'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => OUTPUT_LINK_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Output_Link'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => OUTPUT_TEXT_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Output'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => PANEL_GROUP_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_PanelGroup'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SELECT_BOOLEAN_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_SelectBooleanCheckbox'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SELECT_ONE_MENU_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_SelectOne'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SELECT_ONE_RADIO_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_SelectOneRadio'Access);
   end Register;

end ASF.Components.Html.Factory;

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

with ASF.Components.Base;
with ASF.Components.Html.Text;
with ASF.Components.Html.Lists;
with ASF.Components.Html.Links;
with ASF.Components.Html.Panels;
with ASF.Components.Html.Forms;
with ASF.Components.Html.Pages;
with ASF.Components.Html.Selects;
with ASF.Components.Html.Messages;
with ASF.Views.Nodes;
package body ASF.Components.Html.Factory is

   use ASF.Components.Base;

   function Create_Body return UIComponent_Access;
   function Create_Doctype return UIComponent_Access;
   function Create_Head return UIComponent_Access;
   function Create_Output_Stylesheet return UIComponent_Access;
   function Create_Output return UIComponent_Access;
   function Create_Output_Label return UIComponent_Access;
   function Create_Output_Link return UIComponent_Access;
   function Create_Output_Format return UIComponent_Access;
   function Create_List return UIComponent_Access;
   function Create_PanelGroup return UIComponent_Access;
   function Create_Form return UIComponent_Access;
   function Create_Input_File return UIComponent_Access;
   function Create_Input_Hidden return UIComponent_Access;
   function Create_Input_Text return UIComponent_Access;
   function Create_Input_Textarea return UIComponent_Access;
   function Create_Command return UIComponent_Access;
   function Create_Message return UIComponent_Access;
   function Create_Messages return UIComponent_Access;
   function Create_SelectOne return UIComponent_Access;
   function Create_SelectOneRadio return UIComponent_Access;
   function Create_SelectBooleanCheckbox return UIComponent_Access;
   --  Create an UIInput secret component
   function Create_Input_Secret return ASF.Components.Base.UIComponent_Access;

   --  ------------------------------
   --  Create an UIBody component
   --  ------------------------------
   function Create_Body return UIComponent_Access is
   begin
      return new ASF.Components.Html.Pages.UIBody;
   end Create_Body;

   --  ------------------------------
   --  Create an UIDoctype component
   --  ------------------------------
   function Create_Doctype return UIComponent_Access is
   begin
      return new ASF.Components.Html.Pages.UIDoctype;
   end Create_Doctype;

   --  ------------------------------
   --  Create an UIHead component
   --  ------------------------------
   function Create_Head return UIComponent_Access is
   begin
      return new ASF.Components.Html.Pages.UIHead;
   end Create_Head;

   --  ------------------------------
   --  Create an UIOutputStylesheet component
   --  ------------------------------
   function Create_Output_Stylesheet return UIComponent_Access is
   begin
      return new ASF.Components.Html.Pages.UIOutputStylesheet;
   end Create_Output_Stylesheet;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutput;
   end Create_Output;

   --  ------------------------------
   --  Create an UIOutputLabel component
   --  ------------------------------
   function Create_Output_Label return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutputLabel;
   end Create_Output_Label;

   --  ------------------------------
   --  Create an UIOutputLink component
   --  ------------------------------
   function Create_Output_Link return UIComponent_Access is
   begin
      return new ASF.Components.Html.Links.UIOutputLink;
   end Create_Output_Link;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output_Format return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutputFormat;
   end Create_Output_Format;

   --  ------------------------------
   --  Create an UIList component
   --  ------------------------------
   function Create_List return UIComponent_Access is
   begin
      return new ASF.Components.Html.Lists.UIList;
   end Create_List;

   --  ------------------------------
   --  Create an UIPanelGroup component
   --  ------------------------------
   function Create_PanelGroup return UIComponent_Access is
   begin
      return new ASF.Components.Html.Panels.UIPanelGroup;
   end Create_PanelGroup;

   --  ------------------------------
   --  Create an UIForm component
   --  ------------------------------
   function Create_Form return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIForm;
   end Create_Form;

   --  ------------------------------
   --  Create an UIInput_Hidden component
   --  ------------------------------
   function Create_Input_Hidden return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInput_Hidden;
   end Create_Input_Hidden;

   --  ------------------------------
   --  Create an UIInput component
   --  ------------------------------
   function Create_Input_Text return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInput;
   end Create_Input_Text;

   --  ------------------------------
   --  Create an UIInput secret component
   --  ------------------------------
   function Create_Input_Secret return ASF.Components.Base.UIComponent_Access is
      Result : constant Html.Forms.UIInput_Access := new ASF.Components.Html.Forms.UIInput;
   begin
      Result.Set_Secret (True);
      return Result.all'Access;
   end Create_Input_Secret;

   --  ------------------------------
   --  Create an UIInputTextarea component
   --  ------------------------------
   function Create_Input_Textarea return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInputTextarea;
   end Create_Input_Textarea;

   --  ------------------------------
   --  Create an UIInput_File component
   --  ------------------------------
   function Create_Input_File return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInput_File;
   end Create_Input_File;

   --  ------------------------------
   --  Create an UICommand component
   --  ------------------------------
   function Create_Command return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UICommand;
   end Create_Command;

   --  ------------------------------
   --  Create an UIMessage component
   --  ------------------------------
   function Create_Message return UIComponent_Access is
   begin
      return new ASF.Components.Html.Messages.UIMessage;
   end Create_Message;

   --  ------------------------------
   --  Create an UIMessages component
   --  ------------------------------
   function Create_Messages return UIComponent_Access is
   begin
      return new ASF.Components.Html.Messages.UIMessages;
   end Create_Messages;

   --  ------------------------------
   --  Create an UISelectOne component
   --  ------------------------------
   function Create_SelectOne return UIComponent_Access is
   begin
      return new ASF.Components.Html.Selects.UISelectOne;
   end Create_SelectOne;

   --  ------------------------------
   --  Create an UISelectOneRadio component
   --  ------------------------------
   function Create_SelectOneRadio return UIComponent_Access is
   begin
      return new ASF.Components.Html.Selects.UISelectOneRadio;
   end Create_SelectOneRadio;

   --  ------------------------------
   --  Create an UISelectBoolean component
   --  ------------------------------
   function Create_SelectBooleanCheckbox return UIComponent_Access is
   begin
      return new ASF.Components.Html.Selects.UISelectBoolean;
   end Create_SelectBooleanCheckbox;

   use ASF.Views.Nodes;

   URI                : aliased constant String := "http://java.sun.com/jsf/html";

   BODY_TAG           : aliased constant String := "body";
   COMMAND_BUTTON_TAG : aliased constant String := "commandButton";
   DOCTYPE_TAG        : aliased constant String := "doctype";
   FORM_TAG           : aliased constant String := "form";
   HEAD_TAG           : aliased constant String := "head";
   INPUT_FILE_TAG     : aliased constant String := "inputFile";
   INPUT_HIDDEN_TAG   : aliased constant String := "inputHidden";
   INPUT_SECRET_TAG   : aliased constant String := "inputSecret";
   INPUT_TEXT_TAG     : aliased constant String := "inputText";
   INPUT_TEXTAREA_TAG : aliased constant String := "inputTextarea";
   LIST_TAG           : aliased constant String := "list";
   MESSAGE_TAG        : aliased constant String := "message";
   MESSAGES_TAG       : aliased constant String := "messages";
   OUTPUT_FORMAT_TAG  : aliased constant String := "outputFormat";
   OUTPUT_LABEL_TAG   : aliased constant String := "outputLabel";
   OUTPUT_LINK_TAG    : aliased constant String := "outputLink";
   OUTPUT_STYLESHEET_TAG : aliased constant String := "outputStylesheet";
   OUTPUT_TEXT_TAG    : aliased constant String := "outputText";
   PANEL_GROUP_TAG    : aliased constant String := "panelGroup";
   SELECT_BOOLEAN_TAG  : aliased constant String := "selectBooleanCheckbox";
   SELECT_ONE_MENU_TAG : aliased constant String := "selectOneMenu";
   SELECT_ONE_RADIO_TAG : aliased constant String := "selectOneRadio";

   --  ------------------------------
   --  Get the HTML component factory.
   --  ------------------------------
   procedure Register (Factory : in out ASF.Factory.Component_Factory) is
   begin
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => BODY_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Body'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => COMMAND_BUTTON_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Command'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => DOCTYPE_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Doctype'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => FORM_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Form'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => HEAD_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Head'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INPUT_FILE_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Input_File'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INPUT_HIDDEN_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Input_Hidden'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INPUT_SECRET_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Input_Secret'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INPUT_TEXT_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Input_Text'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => INPUT_TEXTAREA_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Input_Textarea'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => LIST_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_List'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => MESSAGE_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Message'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => MESSAGES_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Messages'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => OUTPUT_FORMAT_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Output_Format'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => OUTPUT_LABEL_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Output_Label'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => OUTPUT_LINK_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Output_Link'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => OUTPUT_STYLESHEET_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Output_Stylesheet'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => OUTPUT_TEXT_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Output'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => PANEL_GROUP_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_PanelGroup'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SELECT_BOOLEAN_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_SelectBooleanCheckbox'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SELECT_ONE_MENU_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_SelectOne'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SELECT_ONE_RADIO_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_SelectOneRadio'Access);
   end Register;

end ASF.Components.Html.Factory;

Declare and register the <h:outputStylesheet> component


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

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

with Security.Contexts;

with ADO.Utils;

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

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Comments.Modules");
--
--     function Create_Tag_List_Bean (Module : in Tag_Module_Access)
--                                    return AWA.Tags.Beans.Tag_List_Bean_Access;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Comments.Modules.Create_Comment (PUBLISHED)",
                       Test_Create_Published_Comment'Access);
      Caller.Add_Test (Suite, "Test AWA.Comments.Modules.Create_Comment (WAITING)",
                       Test_Create_Waiting_Comment'Access);
      Caller.Add_Test (Suite, "Test AWA.Comments.Modules.Delete_Comment",
                       Test_Remove_Comment'Access);
      Caller.Add_Test (Suite, "Test AWA.Comments.Modules.Update_Comment (publish)",
                       Test_Publish_Comment'Access);
   end Add_Tests;

   function Get_Count (Bean : in Util.Beans.Objects.Object) return Natural is
      Value : constant Util.Beans.Objects.Object := Util.Beans.Objects.Get_Value (Bean, "count");
   begin
      return Util.Beans.Objects.To_Integer (Value);
   end Get_Count;

   procedure List_Comments (T    : in out Test;
                            User : in ADO.Identifier;
                            Into : out Util.Beans.Objects.Object) is
      Comment_Manager  : constant Comment_Module_Access := Get_Comment_Module;
      Bean             : Util.Beans.Basic.Readonly_Bean_Access;
      List             : AWA.Comments.Beans.Comment_List_Bean_Access;
   begin
      Bean := Beans.Create_Comment_List_Bean (Comment_Manager);
      Into := Util.Beans.Objects.To_Object (Bean.all'Access);
      List := AWA.Comments.Beans.Comment_List_Bean'Class (Bean.all)'Access;
      List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));
      Util.Tests.Assert_Equals (T, 0, Integer (List.Get_Count), "Invalid number of comments");

      --  Load the existing comments.
      List.Load_Comments (User);
   end List_Comments;

   --  ------------------------------
   --  Create a comment and return the list of comments before and after the creation.
   --  ------------------------------
   procedure Create_Comment (T : in out Test;
                             Status : in AWA.Comments.Models.Status_Type;
                             Before : out Util.Beans.Objects.Object;
                             After  : out Util.Beans.Objects.Object;
                             Id     : out ADO.Identifier) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-comment@test.com");

      declare
         Comment_Manager  : constant Comment_Module_Access := Get_Comment_Module;
         User             : constant AWA.Users.Models.User_Ref := Context.Get_User;
         Bean             : Util.Beans.Basic.Readonly_Bean_Access;
         Comment          : AWA.Comments.Beans.Comment_Bean_Access;
         Cleanup          : Util.Beans.Objects.Object;
         Outcome          : Ada.Strings.Unbounded.Unbounded_String;
      begin
         T.Assert (Comment_Manager /= null, "There is no comment module");

         T.List_Comments (User.Get_Id, Before);

         --  Create a new comment associated with the current user.
         Bean := Beans.Create_Comment_Bean (Comment_Manager);
         Cleanup := Util.Beans.Objects.To_Object (Bean.all'Access);
         Comment := AWA.Comments.Beans.Comment_Bean'Class (Bean.all)'Access;
         Comment.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));
         Comment.Set_Value ("permission", Util.Beans.Objects.To_Object (String '("logged-user")));
         Comment.Set_Status (Status);
         Comment.Set_Entity_Id (User.Get_Id);

         --  Create the comment.
         Comment.Set_Message ("the comment message for the current user " &
                              AWA.Comments.Models.Status_Type'Image (Status));
         Comment.Create (Outcome);
         Id := Comment.Get_Id;
         T.Assert (Id /= ADO.NO_IDENTIFIER, "Invalid new comment identifier");

         --  Load again the comments.
         T.List_Comments (User.Get_Id, After);
         T.Assert (not Util.Beans.Objects.Is_Null (Cleanup), "Comment bean is null");
      end;
      T.Assert (not Util.Beans.Objects.Is_Null (Before), "Before list instance is null");
      T.Assert (not Util.Beans.Objects.Is_Null (After), "After list instance is null");
   end Create_Comment;

   --  ------------------------------
   --  Test comment creation (PUBLISHED).
   --  ------------------------------
   procedure Test_Create_Published_Comment (T : in out Test) is
      Before   : Util.Beans.Objects.Object;
      After    : Util.Beans.Objects.Object;
      Id       : ADO.Identifier;
   begin
      T.Create_Comment (AWA.Comments.Models.COMMENT_PUBLISHED, Before, After, Id);
      declare
         Before_Count : constant Natural := Get_Count (Before);
         After_Count  : constant Natural := Get_Count (After);
      begin
         Util.Tests.Assert_Equals (T, Before_Count + 1, After_Count,
                                   "The new comment does not appear in the list");
      end;
   end Test_Create_Published_Comment;

   --  ------------------------------
   --  Test comment creation (WAITING).
   --  ------------------------------
   procedure Test_Create_Waiting_Comment (T : in out Test) is
      Before   : Util.Beans.Objects.Object;
      After    : Util.Beans.Objects.Object;
      Id       : ADO.Identifier;
   begin
      T.Create_Comment (AWA.Comments.Models.COMMENT_WAITING, Before, After, Id);
      declare
         Before_Count : constant Natural := Get_Count (Before);
         After_Count  : constant Natural := Get_Count (After);
      begin
         Util.Tests.Assert_Equals (T, Before_Count, After_Count,
                                   "The new comment MUST not appear in the list");
      end;
   end Test_Create_Waiting_Comment;

   --  ------------------------------
   --  Test comment removal.
   --  ------------------------------
   procedure Test_Remove_Comment (T : in out Test) is
      Sec_Ctx  : Security.Contexts.Security_Context;
      Context  : AWA.Services.Contexts.Service_Context;
      Before   : Util.Beans.Objects.Object;
      After    : Util.Beans.Objects.Object;
      Id       : ADO.Identifier;
   begin
      T.Create_Comment (AWA.Comments.Models.COMMENT_PUBLISHED, Before, After, Id);
      Util.Tests.Assert_Equals (T, Get_Count (Before) + 1, Get_Count (After),
                                "The new comment MUST have been added in the list");

      --  Now, simulate a user that logs in and deletes the comment.
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-comment@test.com");
      declare
         Comment_Manager  : constant Comment_Module_Access := Get_Comment_Module;
         User             : constant AWA.Users.Models.User_Ref := Context.Get_User;
         Comment          : AWA.Comments.Beans.Comment_Bean_Access;
         Bean             : Util.Beans.Basic.Readonly_Bean_Access;
         Outcome          : Ada.Strings.Unbounded.Unbounded_String;
         Cleanup          : Util.Beans.Objects.Object;
      begin
         T.Assert (Comment_Manager /= null, "There is no comment module");

         --  Create the comment bean for the deletion.
         Bean := Beans.Create_Comment_Bean (Comment_Manager);
         Cleanup := Util.Beans.Objects.To_Object (Bean.all'Access);
         Comment := AWA.Comments.Beans.Comment_Bean'Class (Bean.all)'Access;
         Comment.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));
         Comment.Set_Value ("permission", Util.Beans.Objects.To_Object (String '("logged-user")));
         Comment.Set_Value ("id", ADO.Utils.To_Object (Id));

         Comment.Delete (Outcome);

         T.List_Comments (User.Get_Id, After);
         T.Assert (not Util.Beans.Objects.Is_Null (Cleanup), "Comment bean is null");
      end;
      Util.Tests.Assert_Equals (T, Get_Count (Before), Get_Count (After),
                                "The new comment MUST have been removed from the list");
   end Test_Remove_Comment;

   --  ------------------------------
   --  Test comment publication.
   --  ------------------------------
   procedure Test_Publish_Comment (T : in out Test) is
      Before    : Util.Beans.Objects.Object;
      After     : Util.Beans.Objects.Object;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Id        : ADO.Identifier;
   begin
      T.Create_Comment (AWA.Comments.Models.COMMENT_WAITING, Before, After, Id);
      Util.Tests.Assert_Equals (T, Get_Count (Before), Get_Count (After),
                                "The new comment MUST not be in the list");

      --  Now, simulate a user that logs in and publishes the comment.
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-comment@test.com");
      declare
         Comment_Manager  : constant Comment_Module_Access := Get_Comment_Module;
         User             : constant AWA.Users.Models.User_Ref := Context.Get_User;
         Comment          : AWA.Comments.Beans.Comment_Bean_Access;
         Bean             : Util.Beans.Basic.Readonly_Bean_Access;
         Outcome          : Ada.Strings.Unbounded.Unbounded_String;
         Cleanup          : Util.Beans.Objects.Object;
      begin
         T.Assert (Comment_Manager /= null, "There is no comment module");

         --  Create the comment bean for the deletion.
         Bean := Beans.Create_Comment_Bean (Comment_Manager);
         Cleanup := Util.Beans.Objects.To_Object (Bean.all'Access);
         Comment := AWA.Comments.Beans.Comment_Bean'Class (Bean.all)'Access;
         Comment.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));
         Comment.Set_Value ("permission", Util.Beans.Objects.To_Object (String '("logged-user")));
         Comment.Set_Value ("id", ADO.Utils.To_Object (Id));

         Comment.Set_Status (AWA.Comments.Models.COMMENT_PUBLISHED);
         Comment.Save (Outcome);

         T.List_Comments (User.Get_Id, After);
         T.Assert (not Util.Beans.Objects.Is_Null (Cleanup), "Comment bean is null");
      end;
      Util.Tests.Assert_Equals (T, Get_Count (Before) + 1, Get_Count (After),
                                "The new comment MUST be present in the list after publication");
   end Test_Publish_Comment;

end AWA.Comments.Modules.Tests;

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

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

with Security.Contexts;

with ADO.Utils;

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

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Comments.Modules");

   function Get_Count (Bean : in Util.Beans.Objects.Object) return Natural;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Comments.Modules.Create_Comment (PUBLISHED)",
                       Test_Create_Published_Comment'Access);
      Caller.Add_Test (Suite, "Test AWA.Comments.Modules.Create_Comment (WAITING)",
                       Test_Create_Waiting_Comment'Access);
      Caller.Add_Test (Suite, "Test AWA.Comments.Modules.Delete_Comment",
                       Test_Remove_Comment'Access);
      Caller.Add_Test (Suite, "Test AWA.Comments.Modules.Update_Comment (publish)",
                       Test_Update_Comment'Access);
      Caller.Add_Test (Suite, "Test AWA.Comments.Modules.Publish_Comment (publish)",
                       Test_Publish_Comment'Access);
   end Add_Tests;

   function Get_Count (Bean : in Util.Beans.Objects.Object) return Natural is
      Value : constant Util.Beans.Objects.Object := Util.Beans.Objects.Get_Value (Bean, "count");
   begin
      return Util.Beans.Objects.To_Integer (Value);
   end Get_Count;

   procedure List_Comments (T    : in out Test;
                            User : in ADO.Identifier;
                            Into : out Util.Beans.Objects.Object) is
      Comment_Manager  : constant Comment_Module_Access := Get_Comment_Module;
      Bean             : Util.Beans.Basic.Readonly_Bean_Access;
      List             : AWA.Comments.Beans.Comment_List_Bean_Access;
   begin
      Bean := Beans.Create_Comment_List_Bean (Comment_Manager);
      Into := Util.Beans.Objects.To_Object (Bean.all'Access);
      List := AWA.Comments.Beans.Comment_List_Bean'Class (Bean.all)'Access;
      List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));
      Util.Tests.Assert_Equals (T, 0, Integer (List.Get_Count), "Invalid number of comments");

      --  Load the existing comments.
      List.Load_Comments (User);
   end List_Comments;

   --  ------------------------------
   --  Create a comment and return the list of comments before and after the creation.
   --  ------------------------------
   procedure Create_Comment (T : in out Test;
                             Status : in AWA.Comments.Models.Status_Type;
                             Before : out Util.Beans.Objects.Object;
                             After  : out Util.Beans.Objects.Object;
                             Id     : out ADO.Identifier) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-comment@test.com");

      declare
         Comment_Manager  : constant Comment_Module_Access := Get_Comment_Module;
         User             : constant AWA.Users.Models.User_Ref := Context.Get_User;
         Bean             : Util.Beans.Basic.Readonly_Bean_Access;
         Comment          : AWA.Comments.Beans.Comment_Bean_Access;
         Cleanup          : Util.Beans.Objects.Object;
         Outcome          : Ada.Strings.Unbounded.Unbounded_String;
      begin
         T.Assert (Comment_Manager /= null, "There is no comment module");

         T.List_Comments (User.Get_Id, Before);

         --  Create a new comment associated with the current user.
         Bean := Beans.Create_Comment_Bean (Comment_Manager);
         Cleanup := Util.Beans.Objects.To_Object (Bean.all'Access);
         Comment := AWA.Comments.Beans.Comment_Bean'Class (Bean.all)'Access;
         Comment.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));
         Comment.Set_Value ("permission", Util.Beans.Objects.To_Object (String '("logged-user")));
         Comment.Set_Status (Status);
         Comment.Set_Entity_Id (User.Get_Id);

         --  Create the comment.
         Comment.Set_Message ("the comment message for the current user " &
                              AWA.Comments.Models.Status_Type'Image (Status));
         Comment.Create (Outcome);
         Id := Comment.Get_Id;
         T.Assert (Id /= ADO.NO_IDENTIFIER, "Invalid new comment identifier");

         --  Load again the comments.
         T.List_Comments (User.Get_Id, After);
         T.Assert (not Util.Beans.Objects.Is_Null (Cleanup), "Comment bean is null");
      end;
      T.Assert (not Util.Beans.Objects.Is_Null (Before), "Before list instance is null");
      T.Assert (not Util.Beans.Objects.Is_Null (After), "After list instance is null");
   end Create_Comment;

   --  ------------------------------
   --  Test comment creation (PUBLISHED).
   --  ------------------------------
   procedure Test_Create_Published_Comment (T : in out Test) is
      Before   : Util.Beans.Objects.Object;
      After    : Util.Beans.Objects.Object;
      Id       : ADO.Identifier;
   begin
      T.Create_Comment (AWA.Comments.Models.COMMENT_PUBLISHED, Before, After, Id);
      declare
         Before_Count : constant Natural := Get_Count (Before);
         After_Count  : constant Natural := Get_Count (After);
      begin
         Util.Tests.Assert_Equals (T, Before_Count + 1, After_Count,
                                   "The new comment does not appear in the list");
      end;
   end Test_Create_Published_Comment;

   --  ------------------------------
   --  Test comment creation (WAITING).
   --  ------------------------------
   procedure Test_Create_Waiting_Comment (T : in out Test) is
      Before   : Util.Beans.Objects.Object;
      After    : Util.Beans.Objects.Object;
      Id       : ADO.Identifier;
   begin
      T.Create_Comment (AWA.Comments.Models.COMMENT_WAITING, Before, After, Id);
      declare
         Before_Count : constant Natural := Get_Count (Before);
         After_Count  : constant Natural := Get_Count (After);
      begin
         Util.Tests.Assert_Equals (T, Before_Count, After_Count,
                                   "The new comment MUST not appear in the list");
      end;
   end Test_Create_Waiting_Comment;

   --  ------------------------------
   --  Test comment removal.
   --  ------------------------------
   procedure Test_Remove_Comment (T : in out Test) is
      Sec_Ctx  : Security.Contexts.Security_Context;
      Context  : AWA.Services.Contexts.Service_Context;
      Before   : Util.Beans.Objects.Object;
      After    : Util.Beans.Objects.Object;
      Id       : ADO.Identifier;
   begin
      T.Create_Comment (AWA.Comments.Models.COMMENT_PUBLISHED, Before, After, Id);
      Util.Tests.Assert_Equals (T, Get_Count (Before) + 1, Get_Count (After),
                                "The new comment MUST have been added in the list");

      --  Now, simulate a user that logs in and deletes the comment.
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-comment@test.com");
      declare
         Comment_Manager  : constant Comment_Module_Access := Get_Comment_Module;
         User             : constant AWA.Users.Models.User_Ref := Context.Get_User;
         Comment          : AWA.Comments.Beans.Comment_Bean_Access;
         Bean             : Util.Beans.Basic.Readonly_Bean_Access;
         Outcome          : Ada.Strings.Unbounded.Unbounded_String;
         Cleanup          : Util.Beans.Objects.Object;
      begin
         T.Assert (Comment_Manager /= null, "There is no comment module");

         --  Create the comment bean for the deletion.
         Bean := Beans.Create_Comment_Bean (Comment_Manager);
         Cleanup := Util.Beans.Objects.To_Object (Bean.all'Access);
         Comment := AWA.Comments.Beans.Comment_Bean'Class (Bean.all)'Access;
         Comment.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));
         Comment.Set_Value ("permission", Util.Beans.Objects.To_Object (String '("logged-user")));
         Comment.Set_Value ("id", ADO.Utils.To_Object (Id));

         Comment.Delete (Outcome);

         T.List_Comments (User.Get_Id, After);
         T.Assert (not Util.Beans.Objects.Is_Null (Cleanup), "Comment bean is null");
      end;
      Util.Tests.Assert_Equals (T, Get_Count (Before), Get_Count (After),
                                "The new comment MUST have been removed from the list");
   end Test_Remove_Comment;

   --  ------------------------------
   --  Test comment publication.
   --  ------------------------------
   procedure Test_Update_Comment (T : in out Test) is
      Before    : Util.Beans.Objects.Object;
      After     : Util.Beans.Objects.Object;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Id        : ADO.Identifier;
   begin
      T.Create_Comment (AWA.Comments.Models.COMMENT_WAITING, Before, After, Id);
      Util.Tests.Assert_Equals (T, Get_Count (Before), Get_Count (After),
                                "The new comment MUST not be in the list");

      --  Now, simulate a user that logs in and publishes the comment.
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-comment@test.com");
      declare
         Comment_Manager  : constant Comment_Module_Access := Get_Comment_Module;
         User             : constant AWA.Users.Models.User_Ref := Context.Get_User;
         Comment          : AWA.Comments.Beans.Comment_Bean_Access;
         Bean             : Util.Beans.Basic.Readonly_Bean_Access;
         Outcome          : Ada.Strings.Unbounded.Unbounded_String;
         Cleanup          : Util.Beans.Objects.Object;
      begin
         T.Assert (Comment_Manager /= null, "There is no comment module");

         --  Create the comment bean for the deletion.
         Bean := Beans.Create_Comment_Bean (Comment_Manager);
         Cleanup := Util.Beans.Objects.To_Object (Bean.all'Access);
         Comment := AWA.Comments.Beans.Comment_Bean'Class (Bean.all)'Access;
         Comment.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));
         Comment.Set_Value ("permission", Util.Beans.Objects.To_Object (String '("logged-user")));
         Comment.Set_Value ("id", ADO.Utils.To_Object (Id));

         Comment.Set_Status (AWA.Comments.Models.COMMENT_PUBLISHED);
         Comment.Save (Outcome);

         T.List_Comments (User.Get_Id, After);
         T.Assert (not Util.Beans.Objects.Is_Null (Cleanup), "Comment bean is null");
      end;
      Util.Tests.Assert_Equals (T, Get_Count (Before) + 1, Get_Count (After),
                                "The new comment MUST be present in the list after publication");
   end Test_Update_Comment;

   --  ------------------------------
   --  Test comment publication through the publish operation bean.
   --  ------------------------------
   procedure Test_Publish_Comment (T : in out Test) is
      Before    : Util.Beans.Objects.Object;
      After     : Util.Beans.Objects.Object;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Id        : ADO.Identifier;
   begin
      T.Create_Comment (AWA.Comments.Models.COMMENT_WAITING, Before, After, Id);
      Util.Tests.Assert_Equals (T, Get_Count (Before), Get_Count (After),
                                "The new comment MUST not be in the list");

      --  Now, simulate a user that logs in and publishes the comment.
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-comment@test.com");
      declare
         Comment_Manager  : constant Comment_Module_Access := Get_Comment_Module;
         User             : constant AWA.Users.Models.User_Ref := Context.Get_User;
         Comment          : AWA.Comments.Beans.Comment_Bean;
      begin
         T.Assert (Comment_Manager /= null, "There is no comment module");

         Comment_Manager.Publish_Comment ("logged-user", Id, AWA.Comments.Models.COMMENT_PUBLISHED,
                                          Comment);
         T.Assert (not Comment.Is_Null, "Comment bean is null");

         T.List_Comments (User.Get_Id, After);
      end;
      Util.Tests.Assert_Equals (T, Get_Count (Before) + 1, Get_Count (After),
                                "The new comment MUST be present in the list after publication");
   end Test_Publish_Comment;

end AWA.Comments.Modules.Tests;

Add the new unit test for the publis_comment operation


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

with Util.Tests;

package Util.Serialize.IO.XML.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   --  Test XML de-serialization
   procedure Test_Parser (T : in out Test);

   procedure Test_Parser2 (T : in out Test);

   --  Test (*) wildcard mapping for serialization.
   procedure Test_Parser_Wildcard_Mapping (T : in out Test);

   --  Test (**) wildcard mapping for serialization.
   procedure Test_Parser_Deep_Wildcard_Mapping (T : in out Test);

   --  Test XML de-serialization with some errors.
   procedure Test_Parser_Error (T : in out Test);

   --  Test XML serialization
   procedure Test_Writer (T : in out Test);

end Util.Serialize.IO.XML.Tests;

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

with Util.Tests;

package Util.Serialize.IO.XML.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   --  Test XML de-serialization
   procedure Test_Parser (T : in out Test);

   procedure Test_Parser2 (T : in out Test);

   --  Test (*) wildcard mapping for serialization.
   procedure Test_Parser_Wildcard_Mapping (T : in out Test);

   --  Test (**) wildcard mapping for serialization.
   procedure Test_Parser_Deep_Wildcard_Mapping (T : in out Test);

   --  Test XML de-serialization with some errors.
   procedure Test_Parser_Error (T : in out Test);

   --  Test XML serialization
   procedure Test_Writer (T : in out Test);

   --  Test the XML output stream generation.
   procedure Test_Output (T : in out Test);

end Util.Serialize.IO.XML.Tests;

Declare the Test_Output procedure

Declare the Test_Output procedure


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

with Util.Encoders.Lzma;
package body Util.Streams.Buffered.Lzma is

   --  -----------------------
   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   --  -----------------------
   procedure Initialize (Stream  : in out Compress_Stream;
                         Output  : in Output_Stream_Access;
                         Size    : in Natural;
                         Format  : in String) is
      pragma Unreferenced (Format);
   begin
      Stream.Initialize (Output, Size);
      Stream.Transform := new Util.Encoders.Lzma.Compress;
   end Initialize;

   --  -----------------------
   --  Close the sink.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Compress_Stream) is
   begin
      Stream.Flush;
      Stream.Output.Close;
   end Close;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Compress_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      First_Encoded : Ada.Streams.Stream_Element_Offset := Buffer'First;
      Last_Encoded  : Ada.Streams.Stream_Element_Offset;
      Last_Pos      : Ada.Streams.Stream_Element_Offset;
   begin
      while First_Encoded <= Buffer'Last loop
         Stream.Transform.Transform
           (Data    => Buffer (First_Encoded .. Buffer'Last),
            Into    => Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
            Last    => Last_Pos,
            Encoded => Last_Encoded);
         if Last_Pos + 1 >= Stream.Buffer'Last then
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Write_Pos := Stream.Buffer'First;
         else
            Stream.Write_Pos := Last_Pos + 1;
         end if;
         First_Encoded := Last_Encoded + 1;
      end loop;
   end Write;

   --  -----------------------
   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   --  -----------------------
   overriding
   procedure Flush (Stream : in out Compress_Stream) is
      Last_Pos : Ada.Streams.Stream_Element_Offset := Stream.Write_Pos - 1;
   begin
      loop
         Stream.Transform.Finish (Stream.Buffer (Stream.Write_Pos .. Stream.Buffer'Last),
                                  Last_Pos);
         Stream.Write_Pos := Last_Pos + 1;
         Output_Buffer_Stream (Stream).Flush;
         exit when Stream.Write_Pos < Stream.Buffer'Last;
         Stream.Write_Pos := 1;
      end loop;
   end Flush;

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

end Util.Streams.Buffered.Lzma;

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

   use type Interfaces.C.size_t;
   use type Base.lzma_ret;

   subtype Offset is Ada.Streams.Stream_Element_Offset;

   --  -----------------------
   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   --  -----------------------
   overriding
   procedure Initialize (Stream  : in out Compress_Stream;
                         Output  : in Output_Stream_Access;
                         Size    : in Positive) is
      Result : Base.lzma_ret;
   begin
      Output_Buffer_Stream (Stream).Initialize (Output, Size);

      Stream.Stream.next_out := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
      Stream.Stream.avail_out := Stream.Buffer'Length;
      Result := Container.lzma_easy_encoder (Stream.Stream'Unchecked_Access, 6,
                                             Check.LZMA_CHECK_CRC64);
   end Initialize;

   --  -----------------------
   --  Close the sink.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Compress_Stream) is
   begin
      Stream.Flush;
      Stream.Output.Close;
   end Close;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Compress_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      Last_Pos  : Ada.Streams.Stream_Element_Offset;
      Encoded   : Boolean := False;
      Result    : Base.lzma_ret;
   begin
      loop
         if Stream.Stream.avail_in = 0 then
            Stream.Stream.next_in := Buffer (Buffer'First)'Unrestricted_Access;
            Stream.Stream.avail_in := Interfaces.C.size_t (Buffer'Length);
            Encoded := True;
         end if;

         Result := Base.lzma_code (Stream.Stream'Unchecked_Access, Base.LZMA_RUN);

         --  Write the output data when the buffer is full or we reached the end of stream.
         if Stream.Stream.avail_out = 0 or Result = Base.LZMA_STREAM_END then
            Last_Pos := Stream.Buffer'First + Stream.Buffer'Length
              - Offset (Stream.Stream.avail_out) - 1;
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Stream.next_out := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
            Stream.Stream.avail_out := Stream.Buffer'Length;
         end if;
         exit when Result /= Base.LZMA_OK or (Stream.Stream.avail_in = 0 and Encoded);
      end loop;
   end Write;

   --  -----------------------
   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   --  -----------------------
   overriding
   procedure Flush (Stream : in out Compress_Stream) is
      Last_Pos : Ada.Streams.Stream_Element_Offset;
      Result : Base.lzma_ret;
   begin
      Stream.Stream.next_in := null;
      Stream.Stream.avail_in := 0;
      loop
         Result := Base.lzma_code (Stream.Stream'Unchecked_Access, Base.LZMA_FINISH);

         if Stream.Stream.avail_out = 0 or Result = Base.LZMA_STREAM_END then
            Last_Pos := Stream.Buffer'First + Stream.Buffer'Length
              - Offset (Stream.Stream.avail_out) - 1;
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Stream.next_out := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
            Stream.Stream.avail_out := Stream.Buffer'Length;
         end if;
         exit when Result /= Base.LZMA_OK;
      end loop;
   end Flush;

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

end Util.Streams.Buffered.Lzma;

Refactor the implementation of the buffered LZMA stream


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

with Util.Strings.Transforms;
with GNAT.MD5;

with ASF.Utils;
with ASF.Contexts.Writer;
package body ASF.Components.Widgets.Gravatars is

   IMAGE_ATTRIBUTE_NAMES : Util.Strings.String_Set.Set;

   --  ------------------------------
   --  Given an Email address, return the Gravatar link to the user image.
   --  (See http://en.gravatar.com/site/implement/hash/ and
   --  http://en.gravatar.com/site/implement/images/)
   --  ------------------------------
   function Get_Link (Email  : in String;
                      Secure : in Boolean := False) return String is
      E : constant String := Util.Strings.Transforms.To_Lower_Case (Email);
      C : constant GNAT.MD5.Message_Digest := GNAT.MD5.Digest (E);
   begin
      if Secure then
         return "https://secure.gravatar.com/avatar/" & C;
      else
         return "http://www.gravatar.com/avatar/" & C;
      end if;
   end Get_Link;

   --  ------------------------------
   --  Render an image with the source link created from an email address to the Gravatars service.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIGravatar;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer   : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.Start_Element ("img");
         UI.Render_Attributes (Context, IMAGE_ATTRIBUTE_NAMES, Writer);
         declare
            Email   : constant String := UI.Get_Attribute ("email", Context, "");
            Size    : constant Natural := UI.Get_Attribute ("size", Context, 60);
            Default : constant String := UI.Get_Attribute ("default", Context, "identicon");
            Secure  : constant Boolean := UI.Get_Attribute ("secure", Context, False);
            D       : constant String := Util.Strings.Image (Size);
         begin
            Writer.Write_Attribute ("width", D);
            Writer.Write_Attribute ("height", D);
            Writer.Write_Attribute ("src", Get_Link (Email, Secure)
                                    & "?d=" & Default & "&s=" & D);
         end;
         Writer.End_Element ("img");
      end if;
   end Encode_Begin;

begin
   Utils.Set_Text_Attributes (IMAGE_ATTRIBUTE_NAMES);
end ASF.Components.Widgets.Gravatars;

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

with Util.Strings.Transforms;
with GNAT.MD5;

with ASF.Utils;
with ASF.Contexts.Writer;
package body ASF.Components.Widgets.Gravatars is

   IMAGE_ATTRIBUTE_NAMES : Util.Strings.String_Set.Set;

   --  ------------------------------
   --  Given an Email address, return the Gravatar link to the user image.
   --  (See http://en.gravatar.com/site/implement/hash/ and
   --  http://en.gravatar.com/site/implement/images/)
   --  ------------------------------
   function Get_Link (Email  : in String;
                      Secure : in Boolean := False) return String is
      E : constant String := Util.Strings.Transforms.To_Lower_Case (Email);
      C : constant GNAT.MD5.Message_Digest := GNAT.MD5.Digest (E);
   begin
      if Secure then
         return "https://secure.gravatar.com/avatar/" & C;
      else
         return "http://www.gravatar.com/avatar/" & C;
      end if;
   end Get_Link;

   --  ------------------------------
   --  Render an image with the source link created from an email address to the Gravatars service.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIGravatar;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer   : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.Start_Element ("img");
         UI.Render_Attributes (Context, IMAGE_ATTRIBUTE_NAMES, Writer);
         declare
            Email   : constant String := UI.Get_Attribute ("email", Context, "");
            Size    : Natural := UI.Get_Attribute ("size", Context, 80);
            Default : constant String := UI.Get_Attribute ("default", Context, "identicon");
            Secure  : constant Boolean := UI.Get_Attribute ("secure", Context, False);
            D       : constant String := Util.Strings.Image (Size);
            Alt     : constant String := UI.Get_Attribute ("alt", Context, "");
         begin
            if Size < 0 or Size > 2048 then
               Size := 80;
            end if;
            Writer.Write_Attribute ("width", D);
            Writer.Write_Attribute ("height", D);
            if Alt'Length > 0 then
               Writer.Write_Attribute ("alt", Alt);
            else
               Writer.Write_Attribute ("alt", Email);
            end if;
            Writer.Write_Attribute ("src", Get_Link (Email, Secure)
                                    & "?d=" & Default & "&s=" & D);
         end;
         Writer.End_Element ("img");
      end if;
   end Encode_Begin;

begin
   Utils.Set_Text_Attributes (IMAGE_ATTRIBUTE_NAMES);
end ASF.Components.Widgets.Gravatars;

Add the 'alt' attribute on the gravatar image Make sure the image size is in the 1 .. 2048 range, ignore the size attribute if it is not valid


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

with AWA.Images.Modules;
with AWA.Wikis.Modules;
package body AWA.Wikis.Servlets is

   --  ------------------------------
   --  Load the data content that correspond to the GET request and get the name as well
   --  as mime-type and date.
   --  ------------------------------
   overriding
   procedure Load (Server   : in Image_Servlet;
                   Request  : in out ASF.Requests.Request'Class;
                   Name     : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                   Date     : out Ada.Calendar.Time;
                   Data     : out ADO.Blob_Ref) is
      pragma Unreferenced (Server, Name);

      Wiki      : constant String := Request.Get_Path_Parameter (1);
      File      : constant String := Request.Get_Path_Parameter (2);
      Size      : constant String := Request.Get_Path_Parameter (3);
      Module    : constant AWA.Wikis.Modules.Wiki_Module_Access := Wikis.Modules.Get_Wiki_Module;
      Wiki_Id   : ADO.Identifier;
      File_Id   : ADO.Identifier;
      Width     : Natural;
      Height    : Natural;
      Img_Width : Natural;
      Img_Height : Natural;
   begin
      Wiki_Id := ADO.Identifier'Value (Wiki);
      File_Id := ADO.Identifier'Value (File);

      AWA.Images.Modules.Get_Sizes (Dimension => Size,
                                    Width     => Width,
                                    Height    => Height);

      Img_Width  := Width;
      Img_Height := Height;
      Module.Load_Image (Wiki_Id  => Wiki_Id,
                         Image_Id => File_Id,
                         Width    => Img_Width,
                         Height   => Img_Height,
                         Mime     => Mime,
                         Date     => Date,
                         Into     => Data);

   end Load;

end AWA.Wikis.Servlets;

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

with AWA.Images.Modules;
with AWA.Wikis.Modules;
package body AWA.Wikis.Servlets is

   --  ------------------------------
   --  Load the data content that correspond to the GET request and get the name as well
   --  as mime-type and date.
   --  ------------------------------
   overriding
   procedure Load (Server   : in Image_Servlet;
                   Request  : in out ASF.Requests.Request'Class;
                   Name     : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                   Date     : out Ada.Calendar.Time;
                   Data     : out ADO.Blob_Ref) is
      pragma Unreferenced (Server, Name);

      Wiki      : constant String := Request.Get_Path_Parameter (1);
      File      : constant String := Request.Get_Path_Parameter (2);
      Size      : constant String := Request.Get_Path_Parameter (3);
      Module    : constant AWA.Wikis.Modules.Wiki_Module_Access := Wikis.Modules.Get_Wiki_Module;
      Wiki_Id   : ADO.Identifier;
      File_Id   : ADO.Identifier;
      Width     : Natural;
      Height    : Natural;
      Img_Width : Natural;
      Img_Height : Natural;
   begin
      Wiki_Id := ADO.Identifier'Value (Wiki);
      File_Id := ADO.Identifier'Value (File);

      AWA.Images.Modules.Get_Sizes (Dimension => Size,
                                    Width     => Width,
                                    Height    => Height);

      Img_Width  := Width;
      Img_Height := Height;
      Module.Load_Image (Wiki_Id  => Wiki_Id,
                         Image_Id => File_Id,
                         Width    => Img_Width,
                         Height   => Img_Height,
                         Mime     => Mime,
                         Date     => Date,
                         Into     => Data);

   end Load;

   --  ------------------------------
   --  Get the expected return mode (content disposition for download or inline).
   --  ------------------------------
   overriding
   function Get_Format (Server   : in Image_Servlet;
                        Request  : in ASF.Requests.Request'Class)
                        return AWA.Storages.Servlets.Get_Type is
      pragma Unreferenced (Server, Request);
   begin
      return AWA.Storages.Servlets.DEFAULT;
   end Get_Format;

end AWA.Wikis.Servlets;

Implement the overriden Get_Format function