-----------------------------------------------------------------------
--  views.nodes.jsf -- JSF Core Tag Library
--  Copyright (C) 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.Converters;
with ASF.Validators.Texts;
with ASF.Validators.Numbers;
with ASF.Components.Holders;
with ASF.Components.Core.Views;
package body ASF.Views.Nodes.Jsf is

   --  ------------------------------
   --  Converter Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Converter Tag
   --  ------------------------------
   function Create_Converter_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Converter_Tag_Node_Access := new Converter_Tag_Node;
      Conv : constant Tag_Attribute_Access := Find_Attribute (Attributes,
                                                              "converterId");
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      if Conv = null then
         Node.Error ("Missing 'converterId' attribute");
      else
         Node.Converter := EL.Objects.To_Object (Conv.Value);
      end if;
      return Node.all'Access;
   end Create_Converter_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.  Get the specified converter and
   --  add it to the parent component.  This operation does not create any
   --  new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Converter_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Holders;
      use type ASF.Converters.Converter_Access;

      Cvt : constant Converters.Converter_Access := Context.Get_Converter (Node.Converter);
   begin
      if not (Parent.all in Value_Holder'Class) then
         Node.Error ("Parent component is not an instance of Value_Holder");
         return;
      end if;

      if Cvt = null then
         Node.Error ("Converter was not found");
         return;
      end if;

      declare
         VH : constant access Value_Holder'Class := Value_Holder'Class (Parent.all)'Access;
      begin
         VH.Set_Converter (Converter => Cvt);
      end;
   end Build_Components;

   --  ------------------------------
   --  Validator Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Validator Tag
   --  ------------------------------
   function Create_Validator_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Validator_Tag_Node_Access := new Validator_Tag_Node;
      Vid  : constant Tag_Attribute_Access := Find_Attribute (Attributes,
                                                              "validatorId");
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      if Vid = null then
         Node.Error ("Missing 'validatorId' attribute");
      else
         Node.Validator := EL.Objects.To_Object (Vid.Value);
      end if;
      return Node.all'Access;
   end Create_Validator_Tag_Node;

   --  ------------------------------
   --  Get the specified validator and add it to the parent component.
   --  This operation does not create any new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Validator_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Holders;
      use type ASF.Validators.Validator_Access;

      V      : Validators.Validator_Access;
      Shared : Boolean;
   begin
      if not (Parent.all in Editable_Value_Holder'Class) then
         Node.Error ("Parent component is not an instance of Editable_Value_Holder");
         return;
      end if;

      Validator_Tag_Node'Class (Node.all).Get_Validator (Context, V, Shared);
      if V = null then
         Node.Error ("Validator was not found");
         return;
      end if;

      declare
         VH : constant access Editable_Value_Holder'Class
           := Editable_Value_Holder'Class (Parent.all)'Access;
      begin
         VH.Add_Validator (Validator => V, Shared => Shared);
      end;
   end Build_Components;

   --  ------------------------------
   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   --  ------------------------------
   procedure Get_Validator (Node      : in Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
   begin
      Validator := Context.Get_Validator (Node.Validator);
      Shared    := True;
   end Get_Validator;

   --  ------------------------------
   --  Range Validator Tag
   --  ------------------------------

   --  Create the Range_Validator Tag
   function Create_Range_Validator_Tag_Node (Binding    : in Binding_Access;
                                             Line       : in Views.Line_Info;
                                             Parent     : in Views.Nodes.Tag_Node_Access;
                                             Attributes : in Nodes.Tag_Attribute_Array_Access)
                                             return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Range_Validator_Tag_Node_Access := new Range_Validator_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Minimum := Find_Attribute (Attributes, "minimum");
      Node.Maximum := Find_Attribute (Attributes, "maximum");
      if Node.Minimum = null and Node.Maximum = null then
         Node.Error ("Missing 'minimum' or 'maximum' attribute");
      end if;
      return Node.all'Access;
   end Create_Range_Validator_Tag_Node;

   --  Get the validator instance that corresponds to the range validator.
   --  Returns in Validator the validator instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   overriding
   procedure Get_Validator (Node      : in Range_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
      use type ASF.Validators.Validator_Access;

      Min : Long_Long_Integer := Long_Long_Integer'First;
      Max : Long_Long_Integer := Long_Long_Integer'Last;
   begin
      --  Get the minimum and maximum attributes.
      begin
         if Node.Minimum /= null then
            Min := EL.Objects.To_Long_Long_Integer (Get_Value (Node.Minimum.all, Context));
         end if;
         if Node.Maximum /= null then
            Max := EL.Objects.To_Long_Long_Integer (Get_Value (Node.Maximum.all, Context));
         end if;

      exception
         when Constraint_Error =>
            Node.Error ("Invalid minimum or maximum value");
      end;
      Shared := False;
      if Max < Min then
         Node.Error ("Minimum ({0}) should be less than maximum ({1})",
                     Long_Long_Integer'Image (Min), Long_Long_Integer'Image (Max));
         return;
      end if;

      Validator := Validators.Numbers.Create_Range_Validator (Minimum => Min,
                                                              Maximum => Max);
   end Get_Validator;

   --  ------------------------------
   --  Length Validator Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Length_Validator Tag.  Verifies that the XML node defines
   --  the minimum or the maximum or both attributes.
   --  ------------------------------
   function Create_Length_Validator_Tag_Node (Binding    : in Binding_Access;
                                              Line       : in Views.Line_Info;
                                              Parent     : in Views.Nodes.Tag_Node_Access;
                                              Attributes : in Nodes.Tag_Attribute_Array_Access)
                                              return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Length_Validator_Tag_Node_Access := new Length_Validator_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Minimum := Find_Attribute (Attributes, "minimum");
      Node.Maximum := Find_Attribute (Attributes, "maximum");
      if Node.Minimum = null and Node.Maximum = null then
         Node.Error ("Missing 'minimum' or 'maximum' attribute");
      end if;
      return Node.all'Access;
   end Create_Length_Validator_Tag_Node;

   --  ------------------------------
   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   --  ------------------------------
   overriding
   procedure Get_Validator (Node      : in Length_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
      use type ASF.Validators.Validator_Access;

      Min : Natural := 0;
      Max : Natural := Natural'Last;
   begin
      --  Get the minimum and maximum attributes.
      begin
         if Node.Minimum /= null then
            Min := Natural (EL.Objects.To_Integer (Get_Value (Node.Minimum.all, Context)));
         end if;
         if Node.Maximum /= null then
            Max := Natural (EL.Objects.To_Integer (Get_Value (Node.Maximum.all, Context)));
         end if;

      exception
         when Constraint_Error =>
            Node.Error ("Invalid minimum or maximum value");
      end;
      Shared := False;
      if Max < Min then
         Node.Error ("Minimum ({0}) should be less than maximum ({1})",
                     Natural'Image (Min), Natural'Image (Max));
         return;
      end if;

      Validator := Validators.Texts.Create_Length_Validator (Minimum => Min,
                                                             Maximum => Max);
   end Get_Validator;

   --  ------------------------------
   --  Attribute Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Attribute Tag
   --  ------------------------------
   function Create_Attribute_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Attr : constant Tag_Attribute_Access := Find_Attribute (Attributes, "name");
      Node : Attribute_Tag_Node_Access;
   begin
      Node := new Attribute_Tag_Node;
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Attr_Name := Attr;
      Node.Value     := Find_Attribute (Attributes, "value");
      if Node.Attr_Name = null then
         Node.Error ("Missing 'name' attribute");
      else
         Node.Attr.Name := Attr.Value;
      end if;
      if Node.Value = null then
         Node.Error ("Missing 'value' attribute");
      end if;
      return Node.all'Access;
   end Create_Attribute_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  Adds the attribute to the component node.
   --  This operation does not create any new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Attribute_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use EL.Expressions;
   begin
      if Node.Attr_Name /= null and Node.Value /= null then
         if Node.Value.Binding /= null then
            declare
               Expr : constant EL.Expressions.Expression
                 := ASF.Views.Nodes.Reduce_Expression (Node.Value.all, Context);
            begin
               Parent.Set_Attribute (Def => Node.Attr'Access, Value => Expr);
            end;
         else
            Parent.Set_Attribute (Def   => Node.Attr'Access,
                                  Value => Get_Value (Node.Value.all, Context));
         end if;
      end if;
   end Build_Components;

   --  ------------------------------
   --  Facet Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Facet Tag
   --  ------------------------------
   function Create_Facet_Tag_Node (Binding    : in Binding_Access;
                                   Line       : in Views.Line_Info;
                                   Parent     : in Views.Nodes.Tag_Node_Access;
                                   Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                   return Views.Nodes.Tag_Node_Access is
      use ASF.Views.Nodes;

      Node : constant Facet_Tag_Node_Access := new Facet_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Facet_Name := Find_Attribute (Attributes, "name");
      if Node.Facet_Name = null then
         Node.Error ("Missing 'name' attribute");
      end if;
      return Node.all'Access;
   end Create_Facet_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the facet component of the given parent.  Calls recursively the
   --  method to create children.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Facet_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
   begin
      null;
   end Build_Components;

   --  ------------------------------
   --  Metadata Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Metadata Tag
   --  ------------------------------
   function Create_Metadata_Tag_Node (Binding    : in Binding_Access;
                                      Line       : in Views.Line_Info;
                                      Parent     : in Views.Nodes.Tag_Node_Access;
                                      Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                      return Views.Nodes.Tag_Node_Access is
      use ASF.Views.Nodes;

      Node : constant Metadata_Tag_Node_Access := new Metadata_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      return Node.all'Access;
   end Create_Metadata_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as a metadata information
   --  facet for the UIView parent component.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Metadata_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Core.Views;
   begin
      if not (Parent.all in UIView'Class) then
         Node.Error ("Parent component of <f:metadata> must be a <f:view>");
         return;
      end if;
      declare
         UI : constant UIViewMetaData_Access := new UIViewMetaData;
      begin
         UIView'Class (Parent.all).Set_Metadata (UI, Node);
         Build_Attributes (UI.all, Node.all, Context);
         UI.Initialize (UI.Get_Context.all);
         Node.Build_Children (UI.all'Access, Context);
      end;
   end Build_Components;

end ASF.Views.Nodes.Jsf;

-----------------------------------------------------------------------
--  views.nodes.jsf -- JSF Core Tag Library
--  Copyright (C) 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 Util.Beans.Objects;
with ASF.Converters;
with ASF.Validators.Texts;
with ASF.Validators.Numbers;
with ASF.Components.Holders;
with ASF.Components.Core.Views;
package body ASF.Views.Nodes.Jsf is

   --  ------------------------------
   --  Converter Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Converter Tag
   --  ------------------------------
   function Create_Converter_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Converter_Tag_Node_Access := new Converter_Tag_Node;
      Conv : constant Tag_Attribute_Access := Find_Attribute (Attributes,
                                                              "converterId");
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      if Conv = null then
         Node.Error ("Missing 'converterId' attribute");
      else
         Node.Converter := EL.Objects.To_Object (Conv.Value);
      end if;
      return Node.all'Access;
   end Create_Converter_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.  Get the specified converter and
   --  add it to the parent component.  This operation does not create any
   --  new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Converter_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Holders;
      use type ASF.Converters.Converter_Access;

      Cvt : constant Converters.Converter_Access := Context.Get_Converter (Node.Converter);
   begin
      if not (Parent.all in Value_Holder'Class) then
         Node.Error ("Parent component is not an instance of Value_Holder");
         return;
      end if;

      if Cvt = null then
         Node.Error ("Converter was not found");
         return;
      end if;

      declare
         VH : constant access Value_Holder'Class := Value_Holder'Class (Parent.all)'Access;
      begin
         VH.Set_Converter (Converter => Cvt);
      end;
   end Build_Components;

   --  ------------------------------
   --  Validator Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Validator Tag
   --  ------------------------------
   function Create_Validator_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Validator_Tag_Node_Access := new Validator_Tag_Node;
      Vid  : constant Tag_Attribute_Access := Find_Attribute (Attributes,
                                                              "validatorId");
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      if Vid = null then
         Node.Error ("Missing 'validatorId' attribute");
      else
         Node.Validator := EL.Objects.To_Object (Vid.Value);
      end if;
      return Node.all'Access;
   end Create_Validator_Tag_Node;

   --  ------------------------------
   --  Get the specified validator and add it to the parent component.
   --  This operation does not create any new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Validator_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Holders;
      use type ASF.Validators.Validator_Access;

      V      : Validators.Validator_Access;
      Shared : Boolean;
   begin
      if not (Parent.all in Editable_Value_Holder'Class) then
         Node.Error ("Parent component is not an instance of Editable_Value_Holder");
         return;
      end if;

      Validator_Tag_Node'Class (Node.all).Get_Validator (Context, V, Shared);
      if V = null then
         Node.Error ("Validator was not found");
         return;
      end if;

      declare
         VH : constant access Editable_Value_Holder'Class
           := Editable_Value_Holder'Class (Parent.all)'Access;
      begin
         VH.Add_Validator (Validator => V, Shared => Shared);
      end;
   end Build_Components;

   --  ------------------------------
   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   --  ------------------------------
   procedure Get_Validator (Node      : in Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
   begin
      Validator := Context.Get_Validator (Node.Validator);
      Shared    := True;
   end Get_Validator;

   --  ------------------------------
   --  Range Validator Tag
   --  ------------------------------

   --  Create the Range_Validator Tag
   function Create_Range_Validator_Tag_Node (Binding    : in Binding_Access;
                                             Line       : in Views.Line_Info;
                                             Parent     : in Views.Nodes.Tag_Node_Access;
                                             Attributes : in Nodes.Tag_Attribute_Array_Access)
                                             return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Range_Validator_Tag_Node_Access := new Range_Validator_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Minimum := Find_Attribute (Attributes, "minimum");
      Node.Maximum := Find_Attribute (Attributes, "maximum");
      if Node.Minimum = null and Node.Maximum = null then
         Node.Error ("Missing 'minimum' or 'maximum' attribute");
      end if;
      return Node.all'Access;
   end Create_Range_Validator_Tag_Node;

   --  Get the validator instance that corresponds to the range validator.
   --  Returns in Validator the validator instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   overriding
   procedure Get_Validator (Node      : in Range_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
      use type ASF.Validators.Validator_Access;

      Min : Long_Long_Integer := Long_Long_Integer'First;
      Max : Long_Long_Integer := Long_Long_Integer'Last;
   begin
      --  Get the minimum and maximum attributes.
      begin
         if Node.Minimum /= null then
            Min := EL.Objects.To_Long_Long_Integer (Get_Value (Node.Minimum.all, Context));
         end if;
         if Node.Maximum /= null then
            Max := EL.Objects.To_Long_Long_Integer (Get_Value (Node.Maximum.all, Context));
         end if;

      exception
         when Constraint_Error =>
            Node.Error ("Invalid minimum or maximum value");
      end;
      Shared := False;
      if Max < Min then
         Node.Error ("Minimum ({0}) should be less than maximum ({1})",
                     Long_Long_Integer'Image (Min), Long_Long_Integer'Image (Max));
         return;
      end if;

      Validator := Validators.Numbers.Create_Range_Validator (Minimum => Min,
                                                              Maximum => Max);
   end Get_Validator;

   --  ------------------------------
   --  Length Validator Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Length_Validator Tag.  Verifies that the XML node defines
   --  the minimum or the maximum or both attributes.
   --  ------------------------------
   function Create_Length_Validator_Tag_Node (Binding    : in Binding_Access;
                                              Line       : in Views.Line_Info;
                                              Parent     : in Views.Nodes.Tag_Node_Access;
                                              Attributes : in Nodes.Tag_Attribute_Array_Access)
                                              return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Node : constant Length_Validator_Tag_Node_Access := new Length_Validator_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Minimum := Find_Attribute (Attributes, "minimum");
      Node.Maximum := Find_Attribute (Attributes, "maximum");
      if Node.Minimum = null and Node.Maximum = null then
         Node.Error ("Missing 'minimum' or 'maximum' attribute");
      end if;
      return Node.all'Access;
   end Create_Length_Validator_Tag_Node;

   --  ------------------------------
   --  Get the validator instance that corresponds to the validator tag.
   --  Returns in Validator the instance if it exists and indicate
   --  in Shared whether it must be freed or not when the component is deleted.
   --  ------------------------------
   overriding
   procedure Get_Validator (Node      : in Length_Validator_Tag_Node;
                            Context   : in out Contexts.Facelets.Facelet_Context'Class;
                            Validator : out Validators.Validator_Access;
                            Shared    : out Boolean) is
      use type ASF.Validators.Validator_Access;

      Min : Natural := 0;
      Max : Natural := Natural'Last;
   begin
      --  Get the minimum and maximum attributes.
      begin
         if Node.Minimum /= null then
            Min := Natural (EL.Objects.To_Integer (Get_Value (Node.Minimum.all, Context)));
         end if;
         if Node.Maximum /= null then
            Max := Natural (EL.Objects.To_Integer (Get_Value (Node.Maximum.all, Context)));
         end if;

      exception
         when Constraint_Error =>
            Node.Error ("Invalid minimum or maximum value");
      end;
      Shared := False;
      if Max < Min then
         Node.Error ("Minimum ({0}) should be less than maximum ({1})",
                     Natural'Image (Min), Natural'Image (Max));
         return;
      end if;

      Validator := Validators.Texts.Create_Length_Validator (Minimum => Min,
                                                             Maximum => Max);
   end Get_Validator;

   --  ------------------------------
   --  Attribute Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Attribute Tag
   --  ------------------------------
   function Create_Attribute_Tag_Node (Binding    : in Binding_Access;
                                       Line       : in Views.Line_Info;
                                       Parent     : in Views.Nodes.Tag_Node_Access;
                                       Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                       return Views.Nodes.Tag_Node_Access is

      use ASF.Views.Nodes;

      Attr : constant Tag_Attribute_Access := Find_Attribute (Attributes, "name");
      Node : Attribute_Tag_Node_Access;
   begin
      Node := new Attribute_Tag_Node;
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Attr_Name := Attr;
      Node.Value     := Find_Attribute (Attributes, "value");
      if Node.Attr_Name = null then
         Node.Error ("Missing 'name' attribute");
      else
         Node.Attr.Name := Attr.Value;
      end if;
      if Node.Value = null then
         Node.Error ("Missing 'value' attribute");
      end if;
      return Node.all'Access;
   end Create_Attribute_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  Adds the attribute to the component node.
   --  This operation does not create any new UIComponent.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Attribute_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use EL.Expressions;
   begin
      if Node.Attr_Name /= null and Node.Value /= null then
         if Node.Value.Binding /= null then
            declare
               Expr : constant EL.Expressions.Expression
                 := ASF.Views.Nodes.Reduce_Expression (Node.Value.all, Context);
            begin
               Parent.Set_Attribute (Def => Node.Attr'Access, Value => Expr);
            end;
         else
            Parent.Set_Attribute (Def   => Node.Attr'Access,
                                  Value => Get_Value (Node.Value.all, Context));
         end if;
      end if;
   end Build_Components;

   --  ------------------------------
   --  Facet Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Facet Tag
   --  ------------------------------
   function Create_Facet_Tag_Node (Binding    : in Binding_Access;
                                   Line       : in Views.Line_Info;
                                   Parent     : in Views.Nodes.Tag_Node_Access;
                                   Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                   return Views.Nodes.Tag_Node_Access is
      use ASF.Views.Nodes;

      Node : constant Facet_Tag_Node_Access := new Facet_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      Node.Facet_Name := Find_Attribute (Attributes, "name");
      if Node.Facet_Name = null then
         Node.Error ("Missing 'name' attribute");
      end if;
      return Node.all'Access;
   end Create_Facet_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the facet component of the given parent.  Calls recursively the
   --  method to create children.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Facet_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      Facet : constant UIComponent_Access := new UIComponent;
      Name  : constant Util.Beans.Objects.Object := Get_Value (Node.Facet_Name.all, Context);
   begin
      Node.Build_Children (Facet, Context);
      Parent.Add_Facet (Util.Beans.Objects.To_String (Name), Facet.all'Access, Node);
   end Build_Components;

   --  ------------------------------
   --  Metadata Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Metadata Tag
   --  ------------------------------
   function Create_Metadata_Tag_Node (Binding    : in Binding_Access;
                                      Line       : in Views.Line_Info;
                                      Parent     : in Views.Nodes.Tag_Node_Access;
                                      Attributes : in Views.Nodes.Tag_Attribute_Array_Access)
                                      return Views.Nodes.Tag_Node_Access is
      use ASF.Views.Nodes;

      Node : constant Metadata_Tag_Node_Access := new Metadata_Tag_Node;
   begin
      Initialize (Node.all'Access, Binding, Line, Parent, Attributes);
      return Node.all'Access;
   end Create_Metadata_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as a metadata information
   --  facet for the UIView parent component.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Metadata_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Contexts.Facelets.Facelet_Context'Class) is
      use ASF.Components.Core.Views;
   begin
      if not (Parent.all in UIView'Class) then
         Node.Error ("Parent component of <f:metadata> must be a <f:view>");
         return;
      end if;
      declare
         UI : constant UIViewMetaData_Access := new UIViewMetaData;
      begin
         UIView'Class (Parent.all).Set_Metadata (UI, Node);
         Build_Attributes (UI.all, Node.all, Context);
         UI.Initialize (UI.Get_Context.all);
         Node.Build_Children (UI.all'Access, Context);
      end;
   end Build_Components;

end ASF.Views.Nodes.Jsf;

Fix implementation of <f:facet> to build the facet tree component and associate it with the parent component under the given facet name


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

with Ada.Directories;
with Util.Streams.Pipes;
with Util.Streams.Buffered;

package body PortScan.Packages is

   package AD  renames Ada.Directories;
   package STR renames Util.Streams;

   ----------------------------
   --  limited_sanity_check  --
   ----------------------------
   procedure limited_sanity_check (repository : String)
   is
      procedure check_package (cursor : ranking_crate.Cursor);
      procedure check_package (cursor : ranking_crate.Cursor)
      is
         QR       : constant queue_record := ranking_crate.Element (cursor);
         fullpath : constant String := repository & "/" &
           SU.To_String (all_ports (QR.ap_index).package_name);
         good : Boolean;
      begin
         if not AD.Exists (fullpath) then
            return;
         end if;

         good := passed_option_check (repository, QR.ap_index, True);
         if not good then
            TIO.Put_Line (get_catport (all_ports (QR.ap_index)) &
                            " failed option check, removing ...");
            return;
         end if;
         good := passed_dependency_check (repository, QR.ap_index, True);
         if not good then
            TIO.Put_Line (get_catport (all_ports (QR.ap_index)) &
                            " failed dependency check, removing ...");
         end if;
      end check_package;
   begin
      rank_queue.Iterate (check_package'Access);
   end limited_sanity_check;

   ------------------------
   --  clean_repository  --
   ------------------------
   procedure clean_repository (repository : String)
   is
      procedure save_package (cursor : ranking_crate.Cursor);
      procedure save_package (cursor : ranking_crate.Cursor)
      is
         QR  : constant queue_record := ranking_crate.Element (cursor);
         pcc : package_crate.Cursor;
         use type package_crate.Cursor;
      begin
         pcc := stored_packages.Find
           (Key => all_ports (QR.ap_index).package_name);
         if pcc /= package_crate.No_Element then
            stored_packages.Delete (Position => pcc);
         end if;
      end save_package;
   begin
      scan_repository (repository);
      TIO.Put_Line ("Scanned");

      rank_queue.Iterate (save_package'Access);

      declare
         cursor : package_crate.Cursor := stored_packages.First;
         use type package_crate.Cursor;
      begin
         while cursor /= package_crate.No_Element loop
            TIO.Put_Line ("remove " &
                            SU.To_String (package_crate.Key (cursor)));
            cursor := package_crate.Next (cursor);
         end loop;
      end;

   end clean_repository;

   -----------------------
   --  scan_repository  --
   -----------------------
   procedure scan_repository (repository : String)
   is
      pkg_search : AD.Search_Type;
      dirent     : AD.Directory_Entry_Type;
   begin
      stored_packages.Clear;
      AD.Start_Search (Search    => pkg_search,
                       Directory => repository,
                       Filter    => (AD.Ordinary_File => True, others => False),
                       Pattern   => "");
      while AD.More_Entries (Search => pkg_search) loop
         AD.Get_Next_Entry (Search => pkg_search,
                            Directory_Entry => dirent);
         declare
            pkgname  : SU.Unbounded_String :=
              SU.To_Unbounded_String (AD.Simple_Name (dirent));
         begin
            stored_packages.Insert (Key => pkgname, New_Item => False);
         end;
      end loop;
   end scan_repository;

   ---------------------------
   --  passed_option_check  --
   ---------------------------
   function passed_option_check (repository : String; id : port_id;
                                 skip_exist_check : Boolean := False)
                                 return Boolean
   is
   begin
      if id = port_match_failed or else not all_ports (id).scanned then
         return False;
      end if;
      declare
         fullpath : constant String := repository & "/" &
           SU.To_String (all_ports (id).package_name);
         command  : constant String := "pkg query -F " & fullpath & " %Ok:%Ov";
         pipe     : aliased STR.Pipes.Pipe_Stream;
         buffer   : STR.Buffered.Buffered_Stream;
         content  : SU.Unbounded_String;
         topline  : SU.Unbounded_String;
         status   : Integer;
         pkg_opts : package_crate.Map;
         colon    : Natural;

         use type SU.Unbounded_String;
      begin
         if not skip_exist_check and then not AD.Exists (Name => fullpath)
         then
            return False;
         end if;
         pipe.Open (Command => command);
         buffer.Initialize (Output => null,
                            Input  => pipe'Unchecked_Access,
                            Size   => 4096);
         buffer.Read (Into => content);
         pipe.Close;
         status := pipe.Get_Exit_Status;
         if status /= 0 then
            raise pkgng_execution with "pkg options query " &
              SU.To_String (all_ports (id).package_name) &
              " (return code =" & status'Img & ")";
         end if;
         loop
            nextline (lineblock => content, firstline => topline);
            exit when topline = SU.Null_Unbounded_String;
            colon := SU.Index (Source => topline, Pattern => ":");
            if colon < 2 then
               raise unknown_format with SU.To_String (topline);
            end if;
            declare
               knob : String := SU.Slice (Source => topline,
                                          Low    => colon + 1,
                                          High   => SU.Length (topline));
               name : SU.Unbounded_String := SU.To_Unbounded_String
                 (SU.Slice (Source => topline,
                            Low    => 1,
                            High   => colon - 1));
               insres : Boolean;
               dummy  : package_crate.Cursor;
            begin
               if knob = "on" then
                  pkg_opts.Insert (Key      => name,
                                   New_Item => True,
                                   Position => dummy,
                                   Inserted => insres);
               elsif knob = "off" then
                  pkg_opts.Insert (Key      => name,
                                   New_Item => False,
                                   Position => dummy,
                                   Inserted => insres);
               else
                  raise unknown_format
                    with "knob=" & knob & "(" & SU.To_String (topline) & ")";
               end if;
            end;
         end loop;

         declare
            num_opts : Natural := Natural (all_ports (id).options.Length);
            arrow    : package_crate.Cursor;
            arrowkey : SU.Unbounded_String;
            knobval  : Boolean;
            use type package_crate.Cursor;
         begin
            if num_opts /= Natural (pkg_opts.Length) then
               --  Different number of options, FAIL!
               return False;
            end if;
            arrow := pkg_opts.First;
            while arrow /= package_crate.No_Element loop
               arrowkey := package_crate.Key (arrow);
               knobval  := pkg_opts.Element (arrowkey);
               if all_ports (id).options.Contains (arrowkey) then
                  if knobval /= all_ports (id).options.Element (arrowkey) then
                     --  port option value doesn't match package option value
                     return False;
                  end if;
               else
                  --  Name of package option not found in port options
                  return False;
               end if;
               arrow := package_crate.Next (arrow);
            end loop;
         end;
         --  If we get this far, the package options must match port options
         return True;
      end;
   end passed_option_check;

   -------------------------------
   --  passed_dependency_check  --
   -------------------------------
   function passed_dependency_check (repository : String; id : port_id;
                                     skip_exist_check : Boolean := False)
                                     return Boolean
   is
   begin
      if id = port_match_failed or else not all_ports (id).scanned then
         return False;
      end if;
      declare
         fullpath : constant String := repository & "/" &
           SU.To_String (all_ports (id).package_name);
         command  : constant String := "pkg query -F " & fullpath &
                                       " %do:%dn-%dv";
         pipe     : aliased STR.Pipes.Pipe_Stream;
         buffer   : STR.Buffered.Buffered_Stream;
         content  : SU.Unbounded_String;
         topline  : SU.Unbounded_String;
         status   : Integer;
         colon    : Natural;
         required : Natural := Natural (all_ports (id).librun.Length);
         counter  : Natural := 0;

         use type SU.Unbounded_String;
      begin
         if not skip_exist_check and then not AD.Exists (Name => fullpath)
         then
            return False;
         end if;
         pipe.Open (Command => command);
         buffer.Initialize (Output => null,
                            Input  => pipe'Unchecked_Access,
                            Size   => 4096);
         buffer.Read (Into => content);
         pipe.Close;
         status := pipe.Get_Exit_Status;
         if status /= 0 then
            raise pkgng_execution with "pkg depends query " &
              SU.To_String (all_ports (id).package_name) &
              " (return code =" & status'Img & ")";
         end if;
         loop
            nextline (lineblock => content, firstline => topline);
            exit when topline = SU.Null_Unbounded_String;
            colon := SU.Index (Source => topline, Pattern => ":");
            if colon < 2 then
               raise unknown_format with SU.To_String (topline);
            end if;
            declare
               deppkg : String := SU.Slice (Source => topline,
                                            Low    => colon + 1,
                                            High   => SU.Length (topline))
                                  & ".txz";
               origin : SU.Unbounded_String := SU.To_Unbounded_String
                 (SU.Slice (Source => topline,
                            Low    => 1,
                            High   => colon - 1));
               target_id : port_index := ports_keys.Element (Key => origin);
            begin
               if target_id = port_match_failed then
                  --  package has a dependency that has been removed from
                  --  the ports tree
                  return False;
               end if;
               counter := counter + 1;
               if counter > required then
                  --  package has more dependencies than we are looking for
                  return False;
               end if;
               if deppkg /= SU.To_String (all_ports (target_id).package_name)
               then
                  --  The version that the package requires differs from the
                  --  version that the ports tree will now produce
                  return False;
               end if;
            end;
         end loop;
         if counter < required then
            --  The ports tree requires more dependencies than the existing
            --  package does
            return False;
         end if;

         --  If we get this far, the package dependencies match what the
         --  port tree requires exactly.  This package passed sanity check.
         return True;
      end;
   end passed_dependency_check;

   ---------------
   --  nextline  --
   ----------------
   procedure nextline (lineblock, firstline : out SU.Unbounded_String)
   is
      CR_loc : Natural;
      CR : constant String (1 .. 1) := (1 => Character'Val (10));
   begin
      --  As long as the string isn't empty, we'll find a carriage return
      if SU.Length (lineblock) = 0 then
         firstline := SU.Null_Unbounded_String;
         return;
      end if;
      CR_loc := SU.Index (Source => lineblock, Pattern => CR);
      firstline := SU.To_Unbounded_String (Source => SU.Slice
                   (Source => lineblock, Low => 1, High => CR_loc - 1));
      SU.Delete (Source => lineblock, From => 1, Through => CR_loc);
   end nextline;

end PortScan.Packages;

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

with Ada.Directories;
with Util.Streams.Pipes;
with Util.Streams.Buffered;

package body PortScan.Packages is

   package AD  renames Ada.Directories;
   package STR renames Util.Streams;

   ----------------------------
   --  limited_sanity_check  --
   ----------------------------
   procedure limited_sanity_check (repository : String)
   is
      procedure check_package (cursor : ranking_crate.Cursor);
      procedure check_package (cursor : ranking_crate.Cursor)
      is
         QR       : constant queue_record := ranking_crate.Element (cursor);
         fullpath : constant String := repository & "/" &
           SU.To_String (all_ports (QR.ap_index).package_name);
         good : Boolean;
      begin
         if not AD.Exists (fullpath) then
            return;
         end if;

         good := passed_option_check (repository, QR.ap_index, True);
         if not good then
            TIO.Put_Line (get_catport (all_ports (QR.ap_index)) &
                            " failed option check, removing ...");
            return;
         end if;
         good := passed_dependency_check (repository, QR.ap_index, True);
         if not good then
            TIO.Put_Line (get_catport (all_ports (QR.ap_index)) &
                            " failed dependency check, removing ...");
         end if;
      end check_package;
   begin
      rank_queue.Iterate (check_package'Access);
   end limited_sanity_check;

   ------------------------
   --  clean_repository  --
   ------------------------
   procedure clean_repository (repository : String)
   is
      procedure save_package (cursor : ranking_crate.Cursor);
      procedure save_package (cursor : ranking_crate.Cursor)
      is
         QR  : constant queue_record := ranking_crate.Element (cursor);
         pcc : package_crate.Cursor;
         use type package_crate.Cursor;
      begin
         pcc := stored_packages.Find
           (Key => all_ports (QR.ap_index).package_name);
         if pcc /= package_crate.No_Element then
            stored_packages.Delete (Position => pcc);
         end if;
      end save_package;
   begin
      scan_repository (repository);
      TIO.Put_Line ("Scanned");

      rank_queue.Iterate (save_package'Access);

      declare
         cursor : package_crate.Cursor := stored_packages.First;
         use type package_crate.Cursor;
      begin
         while cursor /= package_crate.No_Element loop
            TIO.Put_Line ("remove " &
                            SU.To_String (package_crate.Key (cursor)));
            cursor := package_crate.Next (cursor);
         end loop;
      end;

   end clean_repository;

   -----------------------
   --  scan_repository  --
   -----------------------
   procedure scan_repository (repository : String)
   is
      pkg_search : AD.Search_Type;
      dirent     : AD.Directory_Entry_Type;
   begin
      stored_packages.Clear;
      AD.Start_Search (Search    => pkg_search,
                       Directory => repository,
                       Filter    => (AD.Ordinary_File => True, others => False),
                       Pattern   => "");
      while AD.More_Entries (Search => pkg_search) loop
         AD.Get_Next_Entry (Search => pkg_search,
                            Directory_Entry => dirent);
         declare
            pkgname  : SU.Unbounded_String :=
              SU.To_Unbounded_String (AD.Simple_Name (dirent));
         begin
            stored_packages.Insert (Key => pkgname, New_Item => False);
         end;
      end loop;
   end scan_repository;

   ---------------------------
   --  passed_option_check  --
   ---------------------------
   function passed_option_check (repository : String; id : port_id;
                                 skip_exist_check : Boolean := False)
                                 return Boolean
   is
   begin
      if id = port_match_failed or else not all_ports (id).scanned then
         return False;
      end if;
      declare
         fullpath : constant String := repository & "/" &
           SU.To_String (all_ports (id).package_name);
         command  : constant String := "pkg query -F " & fullpath & " %Ok:%Ov";
         pipe     : aliased STR.Pipes.Pipe_Stream;
         buffer   : STR.Buffered.Buffered_Stream;
         content  : SU.Unbounded_String;
         topline  : SU.Unbounded_String;
         status   : Integer;
         colon    : Natural;
         required : Natural := Natural (all_ports (id).options.Length);
         counter  : Natural := 0;

         use type SU.Unbounded_String;
      begin
         if not skip_exist_check and then not AD.Exists (Name => fullpath)
         then
            return False;
         end if;
         pipe.Open (Command => command);
         buffer.Initialize (Output => null,
                            Input  => pipe'Unchecked_Access,
                            Size   => 4096);
         buffer.Read (Into => content);
         pipe.Close;
         status := pipe.Get_Exit_Status;
         if status /= 0 then
            raise pkgng_execution with "pkg options query " &
              SU.To_String (all_ports (id).package_name) &
              " (return code =" & status'Img & ")";
         end if;
         loop
            nextline (lineblock => content, firstline => topline);
            exit when topline = SU.Null_Unbounded_String;
            colon := SU.Index (Source => topline, Pattern => ":");
            if colon < 2 then
               raise unknown_format with SU.To_String (topline);
            end if;
            declare
               knob : String := SU.Slice (Source => topline,
                                          Low    => colon + 1,
                                          High   => SU.Length (topline));
               namekey : SU.Unbounded_String := SU.To_Unbounded_String
                 (SU.Slice (Source => topline,
                            Low    => 1,
                            High   => colon - 1));
               knobval  : Boolean;
            begin
               if knob = "on" then
                  knobval := True;
               elsif knob = "off" then
                  knobval := False;
               else
                  raise unknown_format
                    with "knob=" & knob & "(" & SU.To_String (topline) & ")";
               end if;
               counter := counter + 1;
               if counter > required then
                  --  package has more options than we are looking for
                  return False;
               end if;
               if all_ports (id).options.Contains (namekey) then
                  if knobval /= all_ports (id).options.Element (namekey) then
                     --  port option value doesn't match package option value
                     return False;
                  end if;
               else
                  --  Name of package option not found in port options
                  return False;
               end if;
            end;
         end loop;
         if counter < required then
            --  The ports tree has more options than the existing package
            return False;
         end if;

         --  If we get this far, the package options must match port options
         return True;
      end;
   end passed_option_check;

   -------------------------------
   --  passed_dependency_check  --
   -------------------------------
   function passed_dependency_check (repository : String; id : port_id;
                                     skip_exist_check : Boolean := False)
                                     return Boolean
   is
   begin
      if id = port_match_failed or else not all_ports (id).scanned then
         return False;
      end if;
      declare
         fullpath : constant String := repository & "/" &
           SU.To_String (all_ports (id).package_name);
         command  : constant String := "pkg query -F " & fullpath &
                                       " %do:%dn-%dv";
         pipe     : aliased STR.Pipes.Pipe_Stream;
         buffer   : STR.Buffered.Buffered_Stream;
         content  : SU.Unbounded_String;
         topline  : SU.Unbounded_String;
         status   : Integer;
         colon    : Natural;
         required : Natural := Natural (all_ports (id).librun.Length);
         counter  : Natural := 0;

         use type SU.Unbounded_String;
      begin
         if not skip_exist_check and then not AD.Exists (Name => fullpath)
         then
            return False;
         end if;
         pipe.Open (Command => command);
         buffer.Initialize (Output => null,
                            Input  => pipe'Unchecked_Access,
                            Size   => 4096);
         buffer.Read (Into => content);
         pipe.Close;
         status := pipe.Get_Exit_Status;
         if status /= 0 then
            raise pkgng_execution with "pkg depends query " &
              SU.To_String (all_ports (id).package_name) &
              " (return code =" & status'Img & ")";
         end if;
         loop
            nextline (lineblock => content, firstline => topline);
            exit when topline = SU.Null_Unbounded_String;
            colon := SU.Index (Source => topline, Pattern => ":");
            if colon < 2 then
               raise unknown_format with SU.To_String (topline);
            end if;
            declare
               deppkg : String := SU.Slice (Source => topline,
                                            Low    => colon + 1,
                                            High   => SU.Length (topline))
                                  & ".txz";
               origin : SU.Unbounded_String := SU.To_Unbounded_String
                 (SU.Slice (Source => topline,
                            Low    => 1,
                            High   => colon - 1));
               target_id : port_index := ports_keys.Element (Key => origin);
            begin
               if target_id = port_match_failed then
                  --  package has a dependency that has been removed from
                  --  the ports tree
                  return False;
               end if;
               counter := counter + 1;
               if counter > required then
                  --  package has more dependencies than we are looking for
                  return False;
               end if;
               if deppkg /= SU.To_String (all_ports (target_id).package_name)
               then
                  --  The version that the package requires differs from the
                  --  version that the ports tree will now produce
                  return False;
               end if;
            end;
         end loop;
         if counter < required then
            --  The ports tree requires more dependencies than the existing
            --  package does
            return False;
         end if;

         --  If we get this far, the package dependencies match what the
         --  port tree requires exactly.  This package passed sanity check.
         return True;
      end;
   end passed_dependency_check;

   ---------------
   --  nextline  --
   ----------------
   procedure nextline (lineblock, firstline : out SU.Unbounded_String)
   is
      CR_loc : Natural;
      CR : constant String (1 .. 1) := (1 => Character'Val (10));
   begin
      --  As long as the string isn't empty, we'll find a carriage return
      if SU.Length (lineblock) = 0 then
         firstline := SU.Null_Unbounded_String;
         return;
      end if;
      CR_loc := SU.Index (Source => lineblock, Pattern => CR);
      firstline := SU.To_Unbounded_String (Source => SU.Slice
                   (Source => lineblock, Low => 1, High => CR_loc - 1));
      SU.Delete (Source => lineblock, From => 1, Through => CR_loc);
   end nextline;

end PortScan.Packages;

Make options sanity check more efficient

Using the template of the dependency check, rework the options check
to avoid using a container.


-----------------------------------------------------------------------
--  security-auth-oauth -- OAuth based authentication
--  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 Security.OAuth.Clients;
private package Security.Auth.OAuth is

   --  ------------------------------
   --  OAuth Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OAuth authorization process.
   type Manager is abstract new Security.Auth.Manager with private;

   --  Initialize the authentication realm.
   overriding
   procedure Initialize (Realm     : in out Manager;
                         Params    : in Parameters'Class;
                         Provider  : in String := PROVIDER_OPENID);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   --  (See OpenID Section 7.3 Discovery)
   overriding
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   overriding
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   overriding
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   overriding
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the OAuth access token and retrieve information about the user.
   procedure Verify_Access_Token (Realm   : in Manager;
                                  Assoc   : in Association;
                                  Request : in Parameters'Class;
                                  Token   : in Security.OAuth.Clients.Access_Token_Access;
                                  Result  : in out Authentication) is abstract;

private

   type Manager is abstract new Security.Auth.Manager with record
      Return_To : Unbounded_String;
      Realm     : Unbounded_String;
      Scope     : Unbounded_String;
      App       : Security.OAuth.Clients.Application;
   end record;

end Security.Auth.OAuth;

-----------------------------------------------------------------------
--  security-auth-oauth -- OAuth based authentication
--  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 Security.OAuth.Clients;
private package Security.Auth.OAuth is

   --  ------------------------------
   --  OAuth Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OAuth authorization process.
   type Manager is abstract new Security.Auth.Manager with private;

   --  Initialize the authentication realm.
   overriding
   procedure Initialize (Realm     : in out Manager;
                         Params    : in Parameters'Class;
                         Provider  : in String := PROVIDER_OPENID);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   --  (See OpenID Section 7.3 Discovery)
   overriding
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   overriding
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   overriding
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   overriding
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the OAuth access token and retrieve information about the user.
   procedure Verify_Access_Token (Realm   : in Manager;
                                  Assoc   : in Association;
                                  Request : in Parameters'Class;
                                  Token   : in Security.OAuth.Clients.Access_Token_Access;
                                  Result  : in out Authentication) is abstract;

private

   type Manager is abstract new Security.Auth.Manager with record
      Return_To : Unbounded_String;
      Realm     : Unbounded_String;
      Scope     : Unbounded_String;
      Issuer    : Unbounded_String;
      App       : Security.OAuth.Clients.Application;
   end record;

end Security.Auth.OAuth;

Add the issuer initialize from the configuration parameters


-----------------------------------------------------------------------
--  AWA.Tags.Models -- AWA.Tags.Models
-----------------------------------------------------------------------
--  File generated by ada-gen DO NOT MODIFY
--  Template used: templates/model/package-spec.xhtml
--  Ada Generator: https://ada-gen.googlecode.com/svn/trunk Revision 1095
-----------------------------------------------------------------------
--  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.
-----------------------------------------------------------------------
pragma Warnings (Off, "unit * is not referenced");
with ADO.Sessions;
with ADO.Objects;
with ADO.Statements;
with ADO.SQL;
with ADO.Schemas;
with ADO.Queries;
with ADO.Queries.Loaders;
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded;
with Util.Beans.Objects;
with Util.Beans.Basic.Lists;
pragma Warnings (On, "unit * is not referenced");
package AWA.Tags.Models is
   type Tag_Ref is new ADO.Objects.Object_Ref with null record;

   type Tagged_Entity_Ref is new ADO.Objects.Object_Ref with null record;

   --  --------------------
   --  The tag definition.
   --  --------------------
   --  Create an object key for Tag.
   function Tag_Key (Id : in ADO.Identifier) return ADO.Objects.Object_Key;
   --  Create an object key for Tag from a string.
   --  Raises Constraint_Error if the string cannot be converted into the object key.
   function Tag_Key (Id : in String) return ADO.Objects.Object_Key;

   Null_Tag : constant Tag_Ref;
   function "=" (Left, Right : Tag_Ref'Class) return Boolean;

   --  Set the tag identifier
   procedure Set_Id (Object : in out Tag_Ref;
                     Value  : in ADO.Identifier);

   --  Get the tag identifier
   function Get_Id (Object : in Tag_Ref)
                 return ADO.Identifier;

   --  Set the tag name
   procedure Set_Name (Object : in out Tag_Ref;
                       Value  : in Ada.Strings.Unbounded.Unbounded_String);
   procedure Set_Name (Object : in out Tag_Ref;
                       Value : in String);

   --  Get the tag name
   function Get_Name (Object : in Tag_Ref)
                 return Ada.Strings.Unbounded.Unbounded_String;
   function Get_Name (Object : in Tag_Ref)
                 return String;

   --  Load the entity identified by 'Id'.
   --  Raises the NOT_FOUND exception if it does not exist.
   procedure Load (Object  : in out Tag_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier);

   --  Load the entity identified by 'Id'.
   --  Returns True in Found if the object was found and False if it does not exist.
   procedure Load (Object  : in out Tag_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier;
                   Found   : out Boolean);

   --  Find and load the entity.
   overriding
   procedure Find (Object  : in out Tag_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   --  Save the entity.  If the entity does not have an identifier, an identifier is allocated
   --  and it is inserted in the table.  Otherwise, only data fields which have been changed
   --  are updated.
   overriding
   procedure Save (Object  : in out Tag_Ref;
                   Session : in out ADO.Sessions.Master_Session'Class);

   --  Delete the entity.
   overriding
   procedure Delete (Object  : in out Tag_Ref;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   function Get_Value (From : in Tag_Ref;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Table definition
   TAG_TABLE : constant ADO.Schemas.Class_Mapping_Access;

   --  Internal method to allocate the Object_Record instance
   overriding
   procedure Allocate (Object : in out Tag_Ref);

   --  Copy of the object.
   procedure Copy (Object : in Tag_Ref;
                   Into   : in out Tag_Ref);

   package Tag_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Natural,
                                  Element_Type => Tag_Ref,
                                  "="          => "=");
   subtype Tag_Vector is Tag_Vectors.Vector;

   procedure List (Object  : in out Tag_Vector;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class);
   --  Create an object key for Tagged_Entity.
   function Tagged_Entity_Key (Id : in ADO.Identifier) return ADO.Objects.Object_Key;
   --  Create an object key for Tagged_Entity from a string.
   --  Raises Constraint_Error if the string cannot be converted into the object key.
   function Tagged_Entity_Key (Id : in String) return ADO.Objects.Object_Key;

   Null_Tagged_Entity : constant Tagged_Entity_Ref;
   function "=" (Left, Right : Tagged_Entity_Ref'Class) return Boolean;

   --  Set the tag entity identifier
   procedure Set_Id (Object : in out Tagged_Entity_Ref;
                     Value  : in ADO.Identifier);

   --  Get the tag entity identifier
   function Get_Id (Object : in Tagged_Entity_Ref)
                 return ADO.Identifier;

   --  Set Title: Tag model
   --  Date: 2013-02-23the database entity to which the tag is associated
   procedure Set_For_Entity_Id (Object : in out Tagged_Entity_Ref;
                                Value  : in ADO.Identifier);

   --  Get Title: Tag model
   --  Date: 2013-02-23the database entity to which the tag is associated
   function Get_For_Entity_Id (Object : in Tagged_Entity_Ref)
                 return ADO.Identifier;

   --  Set the entity type
   procedure Set_Entity_Type (Object : in out Tagged_Entity_Ref;
                              Value  : in ADO.Entity_Type);

   --  Get the entity type
   function Get_Entity_Type (Object : in Tagged_Entity_Ref)
                 return ADO.Entity_Type;

   --
   procedure Set_Tag (Object : in out Tagged_Entity_Ref;
                      Value  : in AWA.Tags.Models.Tag_Ref'Class);

   --
   function Get_Tag (Object : in Tagged_Entity_Ref)
                 return AWA.Tags.Models.Tag_Ref'Class;

   --  Load the entity identified by 'Id'.
   --  Raises the NOT_FOUND exception if it does not exist.
   procedure Load (Object  : in out Tagged_Entity_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier);

   --  Load the entity identified by 'Id'.
   --  Returns True in Found if the object was found and False if it does not exist.
   procedure Load (Object  : in out Tagged_Entity_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier;
                   Found   : out Boolean);

   --  Find and load the entity.
   overriding
   procedure Find (Object  : in out Tagged_Entity_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   --  Save the entity.  If the entity does not have an identifier, an identifier is allocated
   --  and it is inserted in the table.  Otherwise, only data fields which have been changed
   --  are updated.
   overriding
   procedure Save (Object  : in out Tagged_Entity_Ref;
                   Session : in out ADO.Sessions.Master_Session'Class);

   --  Delete the entity.
   overriding
   procedure Delete (Object  : in out Tagged_Entity_Ref;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   function Get_Value (From : in Tagged_Entity_Ref;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Table definition
   TAGGED_ENTITY_TABLE : constant ADO.Schemas.Class_Mapping_Access;

   --  Internal method to allocate the Object_Record instance
   overriding
   procedure Allocate (Object : in out Tagged_Entity_Ref);

   --  Copy of the object.
   procedure Copy (Object : in Tagged_Entity_Ref;
                   Into   : in out Tagged_Entity_Ref);

   package Tagged_Entity_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Natural,
                                  Element_Type => Tagged_Entity_Ref,
                                  "="          => "=");
   subtype Tagged_Entity_Vector is Tagged_Entity_Vectors.Vector;

   procedure List (Object  : in out Tagged_Entity_Vector;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class);

   Query_Check_Tag : constant ADO.Queries.Query_Definition_Access;

private
   TAG_NAME : aliased constant String := "awa_tag";
   COL_0_1_NAME : aliased constant String := "id";
   COL_1_1_NAME : aliased constant String := "name";

   TAG_DEF : aliased constant ADO.Schemas.Class_Mapping :=
     (Count => 2,
      Table => TAG_NAME'Access,
      Members => (
         1 => COL_0_1_NAME'Access,
         2 => COL_1_1_NAME'Access
)
     );
   TAG_TABLE : constant ADO.Schemas.Class_Mapping_Access
      := TAG_DEF'Access;

   Null_Tag : constant Tag_Ref
      := Tag_Ref'(ADO.Objects.Object_Ref with others => <>);

   type Tag_Impl is
      new ADO.Objects.Object_Record (Key_Type => ADO.Objects.KEY_INTEGER,
                                     Of_Class => TAG_DEF'Access)
   with record
       Name : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Tag_Access is access all Tag_Impl;

   overriding
   procedure Destroy (Object : access Tag_Impl);

   overriding
   procedure Find (Object  : in out Tag_Impl;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   overriding
   procedure Load (Object  : in out Tag_Impl;
                   Session : in out ADO.Sessions.Session'Class);
   procedure Load (Object  : in out Tag_Impl;
                   Stmt    : in out ADO.Statements.Query_Statement'Class;
                   Session : in out ADO.Sessions.Session'Class);

   overriding
   procedure Save (Object  : in out Tag_Impl;
                   Session : in out ADO.Sessions.Master_Session'Class);

   procedure Create (Object  : in out Tag_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   procedure Delete (Object  : in out Tag_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   procedure Set_Field (Object : in out Tag_Ref'Class;
                        Impl   : out Tag_Access);
   TAGGED_ENTITY_NAME : aliased constant String := "awa_tagged_entity";
   COL_0_2_NAME : aliased constant String := "id";
   COL_1_2_NAME : aliased constant String := "for_entity_id";
   COL_2_2_NAME : aliased constant String := "entity_type";
   COL_3_2_NAME : aliased constant String := "tag_id";

   TAGGED_ENTITY_DEF : aliased constant ADO.Schemas.Class_Mapping :=
     (Count => 4,
      Table => TAGGED_ENTITY_NAME'Access,
      Members => (
         1 => COL_0_2_NAME'Access,
         2 => COL_1_2_NAME'Access,
         3 => COL_2_2_NAME'Access,
         4 => COL_3_2_NAME'Access
)
     );
   TAGGED_ENTITY_TABLE : constant ADO.Schemas.Class_Mapping_Access
      := TAGGED_ENTITY_DEF'Access;

   Null_Tagged_Entity : constant Tagged_Entity_Ref
      := Tagged_Entity_Ref'(ADO.Objects.Object_Ref with others => <>);

   type Tagged_Entity_Impl is
      new ADO.Objects.Object_Record (Key_Type => ADO.Objects.KEY_INTEGER,
                                     Of_Class => TAGGED_ENTITY_DEF'Access)
   with record
       For_Entity_Id : ADO.Identifier;
       Entity_Type : ADO.Entity_Type;
       Tag : AWA.Tags.Models.Tag_Ref;
   end record;

   type Tagged_Entity_Access is access all Tagged_Entity_Impl;

   overriding
   procedure Destroy (Object : access Tagged_Entity_Impl);

   overriding
   procedure Find (Object  : in out Tagged_Entity_Impl;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   overriding
   procedure Load (Object  : in out Tagged_Entity_Impl;
                   Session : in out ADO.Sessions.Session'Class);
   procedure Load (Object  : in out Tagged_Entity_Impl;
                   Stmt    : in out ADO.Statements.Query_Statement'Class;
                   Session : in out ADO.Sessions.Session'Class);

   overriding
   procedure Save (Object  : in out Tagged_Entity_Impl;
                   Session : in out ADO.Sessions.Master_Session'Class);

   procedure Create (Object  : in out Tagged_Entity_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   procedure Delete (Object  : in out Tagged_Entity_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   procedure Set_Field (Object : in out Tagged_Entity_Ref'Class;
                        Impl   : out Tagged_Entity_Access);

   package File_1 is
      new ADO.Queries.Loaders.File (Path => "tag-queries.xml",
                                    Sha1 => "9B2B599473F75F92CB5AB5045675E4CCEF926543");

   package Def_Check_Tag is
      new ADO.Queries.Loaders.Query (Name => "check-tag",
                                     File => File_1.File'Access);
   Query_Check_Tag : constant ADO.Queries.Query_Definition_Access
   := Def_Check_Tag.Query'Access;
end AWA.Tags.Models;

-----------------------------------------------------------------------
--  AWA.Tags.Models -- AWA.Tags.Models
-----------------------------------------------------------------------
--  File generated by ada-gen DO NOT MODIFY
--  Template used: templates/model/package-spec.xhtml
--  Ada Generator: https://ada-gen.googlecode.com/svn/trunk Revision 1095
-----------------------------------------------------------------------
--  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.
-----------------------------------------------------------------------
pragma Warnings (Off, "unit * is not referenced");
with ADO.Sessions;
with ADO.Objects;
with ADO.Statements;
with ADO.SQL;
with ADO.Schemas;
with ADO.Queries;
with ADO.Queries.Loaders;
with Ada.Containers.Vectors;
with Ada.Strings.Unbounded;
with Util.Beans.Objects;
with Util.Beans.Basic.Lists;
pragma Warnings (On, "unit * is not referenced");
package AWA.Tags.Models is
   type Tag_Ref is new ADO.Objects.Object_Ref with null record;

   type Tagged_Entity_Ref is new ADO.Objects.Object_Ref with null record;

   --  --------------------
   --  The tag definition.
   --  --------------------
   --  Create an object key for Tag.
   function Tag_Key (Id : in ADO.Identifier) return ADO.Objects.Object_Key;
   --  Create an object key for Tag from a string.
   --  Raises Constraint_Error if the string cannot be converted into the object key.
   function Tag_Key (Id : in String) return ADO.Objects.Object_Key;

   Null_Tag : constant Tag_Ref;
   function "=" (Left, Right : Tag_Ref'Class) return Boolean;

   --  Set the tag identifier
   procedure Set_Id (Object : in out Tag_Ref;
                     Value  : in ADO.Identifier);

   --  Get the tag identifier
   function Get_Id (Object : in Tag_Ref)
                 return ADO.Identifier;

   --  Set the tag name
   procedure Set_Name (Object : in out Tag_Ref;
                       Value  : in Ada.Strings.Unbounded.Unbounded_String);
   procedure Set_Name (Object : in out Tag_Ref;
                       Value : in String);

   --  Get the tag name
   function Get_Name (Object : in Tag_Ref)
                 return Ada.Strings.Unbounded.Unbounded_String;
   function Get_Name (Object : in Tag_Ref)
                 return String;

   --  Load the entity identified by 'Id'.
   --  Raises the NOT_FOUND exception if it does not exist.
   procedure Load (Object  : in out Tag_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier);

   --  Load the entity identified by 'Id'.
   --  Returns True in Found if the object was found and False if it does not exist.
   procedure Load (Object  : in out Tag_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier;
                   Found   : out Boolean);

   --  Find and load the entity.
   overriding
   procedure Find (Object  : in out Tag_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   --  Save the entity.  If the entity does not have an identifier, an identifier is allocated
   --  and it is inserted in the table.  Otherwise, only data fields which have been changed
   --  are updated.
   overriding
   procedure Save (Object  : in out Tag_Ref;
                   Session : in out ADO.Sessions.Master_Session'Class);

   --  Delete the entity.
   overriding
   procedure Delete (Object  : in out Tag_Ref;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   function Get_Value (From : in Tag_Ref;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Table definition
   TAG_TABLE : constant ADO.Schemas.Class_Mapping_Access;

   --  Internal method to allocate the Object_Record instance
   overriding
   procedure Allocate (Object : in out Tag_Ref);

   --  Copy of the object.
   procedure Copy (Object : in Tag_Ref;
                   Into   : in out Tag_Ref);

   package Tag_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Natural,
                                  Element_Type => Tag_Ref,
                                  "="          => "=");
   subtype Tag_Vector is Tag_Vectors.Vector;

   procedure List (Object  : in out Tag_Vector;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class);
   --  Create an object key for Tagged_Entity.
   function Tagged_Entity_Key (Id : in ADO.Identifier) return ADO.Objects.Object_Key;
   --  Create an object key for Tagged_Entity from a string.
   --  Raises Constraint_Error if the string cannot be converted into the object key.
   function Tagged_Entity_Key (Id : in String) return ADO.Objects.Object_Key;

   Null_Tagged_Entity : constant Tagged_Entity_Ref;
   function "=" (Left, Right : Tagged_Entity_Ref'Class) return Boolean;

   --  Set the tag entity identifier
   procedure Set_Id (Object : in out Tagged_Entity_Ref;
                     Value  : in ADO.Identifier);

   --  Get the tag entity identifier
   function Get_Id (Object : in Tagged_Entity_Ref)
                 return ADO.Identifier;

   --  Set Title: Tag model
   --  Date: 2013-02-23the database entity to which the tag is associated
   procedure Set_For_Entity_Id (Object : in out Tagged_Entity_Ref;
                                Value  : in ADO.Identifier);

   --  Get Title: Tag model
   --  Date: 2013-02-23the database entity to which the tag is associated
   function Get_For_Entity_Id (Object : in Tagged_Entity_Ref)
                 return ADO.Identifier;

   --  Set the entity type
   procedure Set_Entity_Type (Object : in out Tagged_Entity_Ref;
                              Value  : in ADO.Entity_Type);

   --  Get the entity type
   function Get_Entity_Type (Object : in Tagged_Entity_Ref)
                 return ADO.Entity_Type;

   --
   procedure Set_Tag (Object : in out Tagged_Entity_Ref;
                      Value  : in AWA.Tags.Models.Tag_Ref'Class);

   --
   function Get_Tag (Object : in Tagged_Entity_Ref)
                 return AWA.Tags.Models.Tag_Ref'Class;

   --  Load the entity identified by 'Id'.
   --  Raises the NOT_FOUND exception if it does not exist.
   procedure Load (Object  : in out Tagged_Entity_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier);

   --  Load the entity identified by 'Id'.
   --  Returns True in Found if the object was found and False if it does not exist.
   procedure Load (Object  : in out Tagged_Entity_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Id      : in ADO.Identifier;
                   Found   : out Boolean);

   --  Find and load the entity.
   overriding
   procedure Find (Object  : in out Tagged_Entity_Ref;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   --  Save the entity.  If the entity does not have an identifier, an identifier is allocated
   --  and it is inserted in the table.  Otherwise, only data fields which have been changed
   --  are updated.
   overriding
   procedure Save (Object  : in out Tagged_Entity_Ref;
                   Session : in out ADO.Sessions.Master_Session'Class);

   --  Delete the entity.
   overriding
   procedure Delete (Object  : in out Tagged_Entity_Ref;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   function Get_Value (From : in Tagged_Entity_Ref;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Table definition
   TAGGED_ENTITY_TABLE : constant ADO.Schemas.Class_Mapping_Access;

   --  Internal method to allocate the Object_Record instance
   overriding
   procedure Allocate (Object : in out Tagged_Entity_Ref);

   --  Copy of the object.
   procedure Copy (Object : in Tagged_Entity_Ref;
                   Into   : in out Tagged_Entity_Ref);

   package Tagged_Entity_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Natural,
                                  Element_Type => Tagged_Entity_Ref,
                                  "="          => "=");
   subtype Tagged_Entity_Vector is Tagged_Entity_Vectors.Vector;

   procedure List (Object  : in out Tagged_Entity_Vector;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class);

   Query_Check_Tag : constant ADO.Queries.Query_Definition_Access;

   Query_Tag_List : constant ADO.Queries.Query_Definition_Access;

private
   TAG_NAME : aliased constant String := "awa_tag";
   COL_0_1_NAME : aliased constant String := "id";
   COL_1_1_NAME : aliased constant String := "name";

   TAG_DEF : aliased constant ADO.Schemas.Class_Mapping :=
     (Count => 2,
      Table => TAG_NAME'Access,
      Members => (
         1 => COL_0_1_NAME'Access,
         2 => COL_1_1_NAME'Access
)
     );
   TAG_TABLE : constant ADO.Schemas.Class_Mapping_Access
      := TAG_DEF'Access;

   Null_Tag : constant Tag_Ref
      := Tag_Ref'(ADO.Objects.Object_Ref with others => <>);

   type Tag_Impl is
      new ADO.Objects.Object_Record (Key_Type => ADO.Objects.KEY_INTEGER,
                                     Of_Class => TAG_DEF'Access)
   with record
       Name : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Tag_Access is access all Tag_Impl;

   overriding
   procedure Destroy (Object : access Tag_Impl);

   overriding
   procedure Find (Object  : in out Tag_Impl;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   overriding
   procedure Load (Object  : in out Tag_Impl;
                   Session : in out ADO.Sessions.Session'Class);
   procedure Load (Object  : in out Tag_Impl;
                   Stmt    : in out ADO.Statements.Query_Statement'Class;
                   Session : in out ADO.Sessions.Session'Class);

   overriding
   procedure Save (Object  : in out Tag_Impl;
                   Session : in out ADO.Sessions.Master_Session'Class);

   procedure Create (Object  : in out Tag_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   procedure Delete (Object  : in out Tag_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   procedure Set_Field (Object : in out Tag_Ref'Class;
                        Impl   : out Tag_Access);
   TAGGED_ENTITY_NAME : aliased constant String := "awa_tagged_entity";
   COL_0_2_NAME : aliased constant String := "id";
   COL_1_2_NAME : aliased constant String := "for_entity_id";
   COL_2_2_NAME : aliased constant String := "entity_type";
   COL_3_2_NAME : aliased constant String := "tag_id";

   TAGGED_ENTITY_DEF : aliased constant ADO.Schemas.Class_Mapping :=
     (Count => 4,
      Table => TAGGED_ENTITY_NAME'Access,
      Members => (
         1 => COL_0_2_NAME'Access,
         2 => COL_1_2_NAME'Access,
         3 => COL_2_2_NAME'Access,
         4 => COL_3_2_NAME'Access
)
     );
   TAGGED_ENTITY_TABLE : constant ADO.Schemas.Class_Mapping_Access
      := TAGGED_ENTITY_DEF'Access;

   Null_Tagged_Entity : constant Tagged_Entity_Ref
      := Tagged_Entity_Ref'(ADO.Objects.Object_Ref with others => <>);

   type Tagged_Entity_Impl is
      new ADO.Objects.Object_Record (Key_Type => ADO.Objects.KEY_INTEGER,
                                     Of_Class => TAGGED_ENTITY_DEF'Access)
   with record
       For_Entity_Id : ADO.Identifier;
       Entity_Type : ADO.Entity_Type;
       Tag : AWA.Tags.Models.Tag_Ref;
   end record;

   type Tagged_Entity_Access is access all Tagged_Entity_Impl;

   overriding
   procedure Destroy (Object : access Tagged_Entity_Impl);

   overriding
   procedure Find (Object  : in out Tagged_Entity_Impl;
                   Session : in out ADO.Sessions.Session'Class;
                   Query   : in ADO.SQL.Query'Class;
                   Found   : out Boolean);

   overriding
   procedure Load (Object  : in out Tagged_Entity_Impl;
                   Session : in out ADO.Sessions.Session'Class);
   procedure Load (Object  : in out Tagged_Entity_Impl;
                   Stmt    : in out ADO.Statements.Query_Statement'Class;
                   Session : in out ADO.Sessions.Session'Class);

   overriding
   procedure Save (Object  : in out Tagged_Entity_Impl;
                   Session : in out ADO.Sessions.Master_Session'Class);

   procedure Create (Object  : in out Tagged_Entity_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   overriding
   procedure Delete (Object  : in out Tagged_Entity_Impl;
                     Session : in out ADO.Sessions.Master_Session'Class);

   procedure Set_Field (Object : in out Tagged_Entity_Ref'Class;
                        Impl   : out Tagged_Entity_Access);

   package File_1 is
      new ADO.Queries.Loaders.File (Path => "tag-queries.xml",
                                    Sha1 => "9B2B599473F75F92CB5AB5045675E4CCEF926543");

   package Def_Check_Tag is
      new ADO.Queries.Loaders.Query (Name => "check-tag",
                                     File => File_1.File'Access);
   Query_Check_Tag : constant ADO.Queries.Query_Definition_Access
   := Def_Check_Tag.Query'Access;

   package Def_Tag_List is
      new ADO.Queries.Loaders.Query (Name => "tag-list",
                                     File => File_1.File'Access);
   Query_Tag_List : constant ADO.Queries.Query_Definition_Access
   := Def_Tag_List.Query'Access;
end AWA.Tags.Models;

Rebuild the model files

Rebuild the model files