with Ada.IO_Exceptions;
with Ada.Characters.Latin_1;
with Ada.Exceptions;
with Ada.Strings.Maps.Constants;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Smart_Pointers;
with Types.Vector;
with Types.Hash_Map;

package body Reader is

   use Types;

   package ACL renames Ada.Characters.Latin_1;

   type Lexemes is (Ignored_Tok,
                    Start_List_Tok, Start_Vector_Tok, Start_Hash_Tok,
                    Meta_Tok, Deref_Tok,
                    Quote_Tok, Quasi_Quote_Tok, Splice_Unq_Tok, Unquote_Tok,
                    Int_Tok, Float_Tok,
                    Str_Tok, Sym_Tok);

   type Token (ID : Lexemes := Ignored_Tok) is record
      case ID is
         when Int_Tok =>
            Int_Val : Mal_Integer;
         when Float_Tok =>
            Float_Val : Mal_Float;
         when Str_Tok | Sym_Tok =>
            Start_Char, Stop_Char : Natural;
         when others => null;
      end case;
   end record;

   Lisp_Whitespace : constant Ada.Strings.Maps.Character_Set :=
     Ada.Strings.Maps.To_Set
       (ACL.HT & ACL.LF & ACL.CR & ACL.Space & ACL.Comma);

   -- [^\s\[\]{}('"`,;)]
   Terminator_Syms : Ada.Strings.Maps.Character_Set :=
     Ada.Strings.Maps."or"
       (Lisp_Whitespace,
        Ada.Strings.Maps.To_Set ("[]{}('""`,;)"));

   -- The unterminated string error
   String_Error : exception;

   function Convert_String (S : String) return String is
      use Ada.Strings.Unbounded;
      Res : Unbounded_String;
      I : Positive;
      Str_Last : Natural;
   begin
      Str_Last := S'Last;
      I := S'First;
      while I <= Str_Last loop
         if S (I) = '\' then
            if I+1 > Str_Last then
               Append (Res, S (I));
               I := I + 1;
            elsif S (I+1) = 'n' then
               Append (Res, Ada.Characters.Latin_1.LF);
               I := I + 2;
            elsif S (I+1) = '"' then
               Append (Res, S (I+1));
               I := I + 2;
            elsif S (I+1) = '\' then
               Append (Res, S (I+1));
               I := I + 2;
            else
               Append (Res, S (I));
               I := I + 1;
            end if;
         else
            Append (Res, S (I));
            I := I + 1;
         end if;
      end loop;
      return To_String (Res);
   end Convert_String;

   Str_Len : Natural := 0;
   Saved_Line : Ada.Strings.Unbounded.Unbounded_String;
   Char_To_Read : Natural := 1;

   function Get_Token return Token is
      Res : Token;
      I, J : Natural;
      use Ada.Strings.Unbounded;
   begin

      <<Tail_Call_Opt>>

      -- Skip over whitespace...
      I := Char_To_Read;
      while I <= Str_Len and then
            Ada.Strings.Maps.Is_In (Element (Saved_Line, I), Lisp_Whitespace) loop
         I := I + 1;
      end loop;

      -- Filter out lines consisting of only whitespace
      if I > Str_Len then
         return (ID => Ignored_Tok);
      end if;

      J := I;

      case Element (Saved_Line, J) is

         when ''' => Res := (ID => Quote_Tok); Char_To_Read := J+1;

         when '`' => Res := (ID => Quasi_Quote_Tok); Char_To_Read := J+1;

         when '~' => -- Tilde

            if J+1 <= Str_Len and then Element (Saved_Line, J+1) = '@' then
               Res := (ID => Splice_Unq_Tok);
               Char_To_Read := J+2;
            else
               -- Just a Tilde
               Res := (ID => Unquote_Tok);
               Char_To_Read := J+1;
            end if;

         when '(' => Res := (ID => Start_List_Tok); Char_To_Read := J+1;
         when '[' => Res := (ID => Start_Vector_Tok); Char_To_Read := J+1;
         when '{' => Res := (ID => Start_Hash_Tok); Char_To_Read := J+1;

         when '^' => Res := (ID => Meta_Tok); Char_To_Read := J+1;
         when '@' => Res := (ID => Deref_Tok); Char_To_Read := J+1;

         when ']' | '}' | ')' =>

            Res := (ID => Sym_Tok, Start_Char => J, Stop_Char => J);
            Char_To_Read := J+1;

         when '"' => -- a string

            -- Skip over "
            J := J + 1;
            while J <= Str_Len and then
               (Element (Saved_Line, J) /= '"' or else
                 Element (Saved_Line, J-1) = '\') loop
               J := J + 1;
            end loop;

            -- So we either ran out of string..
            if J > Str_Len then
               raise String_Error;
            end if;

            -- or we reached an unescaped "
            Res := (ID => Str_Tok, Start_Char => I, Stop_Char => J);
            Char_To_Read := J + 1;

         when ';' => -- a comment

            -- Read to the end of the line or until
            -- the saved_line string is exhausted.
            -- NB if we reach the end we don't care
            -- what the last char was.
            while J < Str_Len and Element (Saved_Line, J) /= ACL.LF loop
               J := J + 1;
            end loop;
            if J = Str_Len then
               Res := (ID => Ignored_Tok);
            else
               Char_To_Read := J + 1;
               -- was: Res := Get_Token;
               goto Tail_Call_Opt;
            end if;

         when others => -- an atom

            while J <= Str_Len and then
               not Ada.Strings.Maps.Is_In (Element (Saved_Line, J), Terminator_Syms) loop
               J := J + 1;
            end loop;

            -- Either we ran out of string or
            -- the one at J was the start of a new token
            Char_To_Read := J;
            J := J - 1;

            declare
               Dots : Natural;
               All_Digits : Boolean;
            begin
               -- check if all digits or .
               Dots := 0;
               All_Digits := True;
               for K in I .. J loop
                  if Element (Saved_Line, K) = '.' then
                     Dots := Dots + 1;
                  elsif not (Element (Saved_Line, K) in '0' .. '9') then
                     All_Digits := False;
                     exit;
                  end if;
               end loop;

               if All_Digits then
                  if Dots = 0 then
                     Res :=
                       (ID => Int_Tok,
                        Int_Val => Mal_Integer'Value (Slice (Saved_Line, I, J)));
                  elsif Dots = 1 then
                     Res :=
                       (ID => Float_Tok,
                        Float_Val => Mal_Float'Value (Slice (Saved_Line, I, J)));
                  else
                     Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J);
                  end if;
               else
                  Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J);
               end if;

            end;

      end case;

      return Res;

   end Get_Token;

   function Read_List (LT : Types.List_Types)
   return Types.Mal_Handle is

      MTA : Mal_Handle;

   begin

      MTA := Read_Form;

      declare
         List_SP : Mal_Handle;
         List_P : List_Class_Ptr;
         Close : String (1..1) := (1 => Types.Closing (LT));
      begin

         case LT is
            when List_List   => List_SP := New_List_Mal_Type (List_Type => LT);
            when Vector_List => List_SP := Vector.New_Vector_Mal_Type;
            when Hashed_List => List_SP := Hash_Map.New_Hash_Map_Mal_Type;
         end case;

         -- Need to append to a variable so...
         List_P := Deref_List_Class (List_SP);

         loop

            if Is_Null (MTA) then
               return New_Error_Mal_Type (Str => "expected '" & Close & "'");
            end if;

            exit when Deref (MTA).Sym_Type = Sym and then
                      Symbol_Mal_Type (Deref (MTA).all).Get_Sym = Close;

            Append (List_P.all, MTA);

            MTA := Read_Form;

         end loop;

         return List_SP;

      end;

   end Read_List;

   function Read_Form return Types.Mal_Handle is
      Tok : Token;
      MTS : Mal_Handle;
      use Ada.Strings.Unbounded;
   begin

      Tok := Get_Token;

      case Tok.ID is

         when Ignored_Tok => return Smart_Pointers.Null_Smart_Pointer;

         when Int_Tok => return New_Int_Mal_Type (Tok.Int_Val);

         when Float_Tok => return New_Float_Mal_Type (Tok.Float_Val);

         when Start_List_Tok => return Read_List (List_List);

         when Start_Vector_Tok => return Read_List (Vector_List);

         when Start_Hash_Tok => return Read_List (Hashed_List);

         when Meta_Tok =>

            declare
               Meta, Obj : Mal_Handle;
            begin
               Meta := Read_Form;
               Obj := Read_Form;
               return Make_New_List
                        ((1 => New_Symbol_Mal_Type ("with-meta"),
                          2 => Obj,
                          3 => Meta));
            end;

         when Deref_Tok =>

            return Make_New_List
                     ((1 => New_Symbol_Mal_Type ("deref"),
                       2 => Read_Form));

         when Quote_Tok =>

            return Make_New_List
                     ((1 => New_Symbol_Mal_Type ("quote"),
                       2 => Read_Form));

         when Quasi_Quote_Tok =>

            return Make_New_List
                     ((1 => New_Symbol_Mal_Type ("quasiquote"),
                       2 => Read_Form));

         when Splice_Unq_Tok =>

            return Make_New_List
                     ((1 =>  New_Symbol_Mal_Type ("splice-unquote"),
                       2 => Read_Form));

         when Unquote_Tok =>

            return Make_New_List
                     ((1 => New_Symbol_Mal_Type ("unquote"),
                       2 => Read_Form));

         when Str_Tok =>

            return New_String_Mal_Type
                     (Convert_String (Slice (Saved_Line, Tok.Start_Char, Tok.Stop_Char)));

         when Sym_Tok =>

            return New_Symbol_Mal_Type
                     (Slice (Saved_Line, Tok.Start_Char, Tok.Stop_Char));

      end case;

   end Read_Form;

   procedure Lex_Init (S : String) is
   begin
      Str_Len := S'Length;
      Saved_Line := Ada.Strings.Unbounded.To_Unbounded_String (S);
      Char_To_Read := 1;
   end Lex_Init;

   function Read_Str (S : String) return Types.Mal_Handle is
      I, Str_Len : Natural := S'Length;
   begin

      Lex_Init (S);

      return Read_Form;

   exception
      when String_Error =>
        return New_Error_Mal_Type (Str => "expected '""'");
   end Read_Str;

end Reader;

with Ada.IO_Exceptions;
with Ada.Characters.Latin_1;
with Ada.Exceptions;
with Ada.Strings.Maps.Constants;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Smart_Pointers;
with Types.Vector;
with Types.Hash_Map;

package body Reader is

   use Types;

   package ACL renames Ada.Characters.Latin_1;

   type Lexemes is (Ignored_Tok,
                    Start_List_Tok, Start_Vector_Tok, Start_Hash_Tok,
                    Meta_Tok, Deref_Tok,
                    Quote_Tok, Quasi_Quote_Tok, Splice_Unq_Tok, Unquote_Tok,
                    Int_Tok, Float_Tok,
                    Str_Tok, Sym_Tok);

   type Token (ID : Lexemes := Ignored_Tok) is record
      case ID is
         when Int_Tok =>
            Int_Val : Mal_Integer;
         when Float_Tok =>
            Float_Val : Mal_Float;
         when Str_Tok | Sym_Tok =>
            Start_Char, Stop_Char : Natural;
         when others => null;
      end case;
   end record;

   Lisp_Whitespace : constant Ada.Strings.Maps.Character_Set :=
     Ada.Strings.Maps.To_Set
       (ACL.HT & ACL.LF & ACL.CR & ACL.Space & ACL.Comma);

   -- [^\s\[\]{}('"`,;)]
   Terminator_Syms : Ada.Strings.Maps.Character_Set :=
     Ada.Strings.Maps."or"
       (Lisp_Whitespace,
        Ada.Strings.Maps.To_Set ("[]{}('""`,;)"));

   -- The unterminated string error
   String_Error : exception;

   function Convert_String (S : String) return String is
      use Ada.Strings.Unbounded;
      Res : Unbounded_String;
      I : Positive;
      Str_Last : Natural;
   begin
      Str_Last := S'Last;
      I := S'First;
      while I <= Str_Last loop
         if S (I) = '\' then
            if I+1 > Str_Last then
               Append (Res, S (I));
               I := I + 1;
            elsif S (I+1) = 'n' then
               Append (Res, Ada.Characters.Latin_1.LF);
               I := I + 2;
            elsif S (I+1) = '"' then
               Append (Res, S (I+1));
               I := I + 2;
            elsif S (I+1) = '\' then
               Append (Res, S (I+1));
               I := I + 2;
            else
               Append (Res, S (I));
               I := I + 1;
            end if;
         else
            Append (Res, S (I));
            I := I + 1;
         end if;
      end loop;
      return To_String (Res);
   end Convert_String;

   Str_Len : Natural := 0;
   Saved_Line : Ada.Strings.Unbounded.Unbounded_String;
   Char_To_Read : Natural := 1;

   function Get_Token return Token is
      Res : Token;
      I, J : Natural;
      use Ada.Strings.Unbounded;
   begin

      <<Tail_Call_Opt>>

      -- Skip over whitespace...
      I := Char_To_Read;
      while I <= Str_Len and then
            Ada.Strings.Maps.Is_In (Element (Saved_Line, I), Lisp_Whitespace) loop
         I := I + 1;
      end loop;

      -- Filter out lines consisting of only whitespace
      if I > Str_Len then
         return (ID => Ignored_Tok);
      end if;

      J := I;

      case Element (Saved_Line, J) is

         when ''' => Res := (ID => Quote_Tok); Char_To_Read := J+1;

         when '`' => Res := (ID => Quasi_Quote_Tok); Char_To_Read := J+1;

         when '~' => -- Tilde

            if J+1 <= Str_Len and then Element (Saved_Line, J+1) = '@' then
               Res := (ID => Splice_Unq_Tok);
               Char_To_Read := J+2;
            else
               -- Just a Tilde
               Res := (ID => Unquote_Tok);
               Char_To_Read := J+1;
            end if;

         when '(' => Res := (ID => Start_List_Tok); Char_To_Read := J+1;
         when '[' => Res := (ID => Start_Vector_Tok); Char_To_Read := J+1;
         when '{' => Res := (ID => Start_Hash_Tok); Char_To_Read := J+1;

         when '^' => Res := (ID => Meta_Tok); Char_To_Read := J+1;
         when '@' => Res := (ID => Deref_Tok); Char_To_Read := J+1;

         when ']' | '}' | ')' =>

            Res := (ID => Sym_Tok, Start_Char => J, Stop_Char => J);
            Char_To_Read := J+1;

         when '"' => -- a string

            -- Skip over "
            J := J + 1;
            while J <= Str_Len and then
               (Element (Saved_Line, J) /= '"' or else
                 Element (Saved_Line, J-1) = '\') loop
               J := J + 1;
            end loop;

            -- So we either ran out of string..
            if J > Str_Len then
               raise String_Error;
            end if;

            -- or we reached an unescaped "
            Res := (ID => Str_Tok, Start_Char => I, Stop_Char => J);
            Char_To_Read := J + 1;

         when ';' => -- a comment

            -- Read to the end of the line or until
            -- the saved_line string is exhausted.
            -- NB if we reach the end we don't care
            -- what the last char was.
            while J < Str_Len and Element (Saved_Line, J) /= ACL.LF loop
               J := J + 1;
            end loop;
            if J = Str_Len then
               Res := (ID => Ignored_Tok);
            else
               Char_To_Read := J + 1;
               -- was: Res := Get_Token;
               goto Tail_Call_Opt;
            end if;

         when others => -- an atom

            while J <= Str_Len and then
               not Ada.Strings.Maps.Is_In (Element (Saved_Line, J), Terminator_Syms) loop
               J := J + 1;
            end loop;

            -- Either we ran out of string or
            -- the one at J was the start of a new token
            Char_To_Read := J;
            J := J - 1;

            declare
               Dots : Natural;
               All_Digits : Boolean;
            begin
               -- check if all digits or .
               Dots := 0;
               All_Digits := True;
               for K in I .. J loop
                  if Element (Saved_Line, K) = '.' then
                     Dots := Dots + 1;
                  elsif not (Element (Saved_Line, K) in '0' .. '9') then
                     All_Digits := False;
                     exit;
                  end if;
               end loop;

               if All_Digits then
                  if Dots = 0 then
                     Res :=
                       (ID => Int_Tok,
                        Int_Val => Mal_Integer'Value (Slice (Saved_Line, I, J)));
                  elsif Dots = 1 then
                     Res :=
                       (ID => Float_Tok,
                        Float_Val => Mal_Float'Value (Slice (Saved_Line, I, J)));
                  else
                     Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J);
                  end if;
               else
                  Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J);
               end if;

            end;

      end case;

      return Res;

   end Get_Token;

   function Read_List (LT : Types.List_Types)
   return Types.Mal_Handle is

      MTA : Mal_Handle;

   begin

      MTA := Read_Form;

      declare
         List_SP : Mal_Handle;
         List_P : List_Class_Ptr;
         Close : String (1..1) := (1 => Types.Closing (LT));
      begin

         case LT is
            when List_List   => List_SP := New_List_Mal_Type (List_Type => LT);
            when Vector_List => List_SP := Vector.New_Vector_Mal_Type;
            when Hashed_List => List_SP := Hash_Map.New_Hash_Map_Mal_Type;
         end case;

         -- Need to append to a variable so...
         List_P := Deref_List_Class (List_SP);

         loop

            if Is_Null (MTA) then
               return New_Error_Mal_Type (Str => "expected '" & Close & "'");
            end if;

            exit when Deref (MTA).Sym_Type = Sym and then
                      Symbol_Mal_Type (Deref (MTA).all).Get_Sym = Close;

            Append (List_P.all, MTA);

            MTA := Read_Form;

         end loop;

         return List_SP;

      end;

   end Read_List;

   function Read_Form return Types.Mal_Handle is
      Tok : Token;
      MTS : Mal_Handle;
      use Ada.Strings.Unbounded;
   begin

      Tok := Get_Token;

      case Tok.ID is

         when Ignored_Tok => return Smart_Pointers.Null_Smart_Pointer;

         when Int_Tok => return New_Int_Mal_Type (Tok.Int_Val);

         when Float_Tok => return New_Float_Mal_Type (Tok.Float_Val);

         when Start_List_Tok => return Read_List (List_List);

         when Start_Vector_Tok => return Read_List (Vector_List);

         when Start_Hash_Tok => return Read_List (Hashed_List);

         when Meta_Tok =>

            declare
               Meta, Obj : Mal_Handle;
            begin
               Meta := Read_Form;
               Obj := Read_Form;
               return Make_New_List
                        ((1 => New_Symbol_Mal_Type ("with-meta"),
                          2 => Obj,
                          3 => Meta));
            end;

         when Deref_Tok =>

            return Make_New_List
                     ((1 => New_Symbol_Mal_Type ("deref"),
                       2 => Read_Form));

         when Quote_Tok =>

            return Make_New_List
                     ((1 => New_Symbol_Mal_Type ("quote"),
                       2 => Read_Form));

         when Quasi_Quote_Tok =>

            return Make_New_List
                     ((1 => New_Symbol_Mal_Type ("quasiquote"),
                       2 => Read_Form));

         when Splice_Unq_Tok =>

            return Make_New_List
                     ((1 =>  New_Symbol_Mal_Type ("splice-unquote"),
                       2 => Read_Form));

         when Unquote_Tok =>

            return Make_New_List
                     ((1 => New_Symbol_Mal_Type ("unquote"),
                       2 => Read_Form));

         when Str_Tok =>

            return New_String_Mal_Type
                     (Convert_String (Slice (Saved_Line, Tok.Start_Char, Tok.Stop_Char)));

         when Sym_Tok =>

            -- Mal interpreter is required to know about true, false and nil.
            declare
               S : String := Slice (Saved_Line, Tok.Start_Char, Tok.Stop_Char);
            begin
               if S = "true" then
                  return New_Bool_Mal_Type (True);
               elsif S = "false" then
                  return New_Bool_Mal_Type (False);
               else
                  return New_Symbol_Mal_Type (S);
               end if;
            end;

      end case;

   end Read_Form;

   procedure Lex_Init (S : String) is
   begin
      Str_Len := S'Length;
      Saved_Line := Ada.Strings.Unbounded.To_Unbounded_String (S);
      Char_To_Read := 1;
   end Lex_Init;

   function Read_Str (S : String) return Types.Mal_Handle is
      I, Str_Len : Natural := S'Length;
   begin

      Lex_Init (S);

      return Read_Form;

   exception
      when String_Error =>
        return New_Error_Mal_Type (Str => "expected '""'");
   end Read_Str;

end Reader;

Ada: build in knowledge about true and false into reader


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

with ADO.Objects;
with ADO.Schemas;
with Util.Beans.Objects;
with Util.Beans.Basic;

with AWA.Counters.Modules;
with AWA.Counters.Models;

--  == Counter Bean ==
--  The <b>Counter_Bean</b> allows to represent a counter associated with some database
--  entity and allows its control by the <awa:counter> component.
--
package AWA.Counters.Beans is

   type Counter_Bean (Of_Type  : ADO.Objects.Object_Key_Type;
                      Of_Class : ADO.Schemas.Class_Mapping_Access) is
     new Util.Beans.Basic.Readonly_Bean with record
      Counter : Counter_Index_Type;
      Value   : Integer := -1;
      Object  : ADO.Objects.Object_Key (Of_Type, Of_Class);
   end record;
   type Counter_Bean_Access is access all Counter_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Counter_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   type Counter_Stat_Bean is new AWA.Counters.Models.Stat_List_Bean with record
      Module           : AWA.Counters.Modules.Counter_Module_Access;

      Stats            : aliased AWA.Counters.Models.Stat_Info_List_Bean;
      Stats_Bean       : AWA.Counters.Models.Stat_Info_List_Bean_Access;
   end record;
   type Counter_Stat_Bean_Access is access all Counter_Stat_Bean'Class;

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

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Counter_Stat_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the statistics information.
   overriding
   procedure Load (List    : in out Counter_Stat_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Blog_Stat_Bean bean instance.
   function Create_Counter_Stat_Bean (Module : in AWA.Counters.Modules.Counter_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Counters.Beans;

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

with ADO.Objects;
with ADO.Schemas;
with ADO.Queries;
with Util.Beans.Objects;
with Util.Beans.Basic;

with AWA.Counters.Modules;
with AWA.Counters.Models;

--  == Counter Bean ==
--  The <b>Counter_Bean</b> allows to represent a counter associated with some database
--  entity and allows its control by the <awa:counter> component.
--
package AWA.Counters.Beans is

   type Counter_Bean (Of_Type  : ADO.Objects.Object_Key_Type;
                      Of_Class : ADO.Schemas.Class_Mapping_Access) is
     new Util.Beans.Basic.Readonly_Bean with record
      Counter : Counter_Index_Type;
      Value   : Integer := -1;
      Object  : ADO.Objects.Object_Key (Of_Type, Of_Class);
   end record;
   type Counter_Bean_Access is access all Counter_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Counter_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   type Counter_Stat_Bean is new AWA.Counters.Models.Stat_List_Bean with record
      Module           : AWA.Counters.Modules.Counter_Module_Access;

      Stats            : aliased AWA.Counters.Models.Stat_Info_List_Bean;
      Stats_Bean       : AWA.Counters.Models.Stat_Info_List_Bean_Access;
   end record;
   type Counter_Stat_Bean_Access is access all Counter_Stat_Bean'Class;

   --  Get the query definition to collect the counter statistics.
   function Get_Query (From : in Counter_Stat_Bean) return ADO.Queries.Query_Definition_Access;

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

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Counter_Stat_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the statistics information.
   overriding
   procedure Load (List    : in out Counter_Stat_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Blog_Stat_Bean bean instance.
   function Create_Counter_Stat_Bean (Module : in AWA.Counters.Modules.Counter_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Counters.Beans;

Declare the Get_Query operation

Declare the Get_Query operation


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

   use Ada.Streams;
   subtype Offset is Ada.Streams.Stream_Element_Offset;

   procedure Initialize (Stream : in out Print_Stream;
                         To     : access Output_Stream'Class) is
   begin
      Stream.Initialize (Output => To, Size => 4096);
   end Initialize;

   --  ------------------------------
   --  Write a raw character on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Char   : in Character) is
      Buf : constant Ada.Streams.Stream_Element_Array (1 .. 1)
        := (1 => Ada.Streams.Stream_Element (Character'Pos (Char)));
   begin
      Stream.Write (Buf);
   end Write;

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

      Val : Unsigned_32;
      Buf : Ada.Streams.Stream_Element_Array (1 .. 4);
   begin
      --  UTF-8 conversion
      --  7  U+0000   U+007F   1  0xxxxxxx
      --  11 U+0080   U+07FF   2  110xxxxx 10xxxxxx
      --  16 U+0800   U+FFFF   3  1110xxxx 10xxxxxx 10xxxxxx
      --  21 U+10000  U+1FFFFF 4  11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
      Val := Wide_Wide_Character'Pos (Item);
      if Val <= 16#7f# then
         Buf (1) := Ada.Streams.Stream_Element (Val);
         Stream.Write (Buf (1 .. 1));
      elsif Val <= 16#07FF# then
         Buf (1) := Stream_Element (16#C0# or Shift_Right (Val, 6));
         Buf (2) := Stream_Element (16#80# or (Val and 16#03F#));
         Stream.Write (Buf (1 .. 2));
      elsif Val <= 16#0FFFF# then
         Buf (1) := Stream_Element (16#E0# or Shift_Right (Val, 12));
         Val := Val and 16#0FFF#;
         Buf (2) := Stream_Element (16#80# or Shift_Right (Val, 6));
         Buf (3) := Stream_Element (16#80# or (Val and 16#03F#));
         Stream.Write (Buf (1 .. 3));
      else
         Val := Val and 16#1FFFFF#;
         Buf (1) := Stream_Element (16#F0# or Shift_Right (Val, 18));
         Val := Val and 16#3FFFF#;
         Buf (2) := Stream_Element (16#80# or Shift_Right (Val, 12));
         Val := Val and 16#0FFF#;
         Buf (3) := Stream_Element (16#80# or Shift_Right (Val, 6));
         Buf (4) := Stream_Element (16#80# or (Val and 16#03F#));
         Stream.Write (Buf (1 .. 4));
      end if;
   end Write_Wide;

   --  ------------------------------
   --  Write a raw string on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in String) is
      Buf : Ada.Streams.Stream_Element_Array (Offset (Item'First) .. Offset (Item'Last));
      for Buf'Address use Item'Address;
   begin
      Stream.Write (Buf);
   end Write;

   --  ------------------------------
   --  Write a raw string on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String) is
      Count : constant Natural := Ada.Strings.Unbounded.Length (Item);
   begin
      if Count > 0 then
         for I in 1 .. Count loop
            Stream.Write (Char => Ada.Strings.Unbounded.Element (Item, I));
         end loop;
      end if;
   end Write;

   --  ------------------------------
   --  Write a raw string on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
      Count : constant Natural := Ada.Strings.Wide_Wide_Unbounded.Length (Item);
      C     : Wide_Wide_Character;
   begin
      if Count > 0 then
         for I in 1 .. Count loop
            C := Ada.Strings.Wide_Wide_Unbounded.Element (Item, I);
            Stream.Write (Char => Character'Val (Wide_Wide_Character'Pos (C)));
         end loop;
      end if;
   end Write;

   --  ------------------------------
   --  Write an integer on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Integer) is
      S : constant String := Integer'Image (Item);
   begin
      if Item > 0 then
         Stream.Write (S (S'First + 1 .. S'Last));
      else
         Stream.Write (S);
      end if;
   end Write;

   --  ------------------------------
   --  Write an integer on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Long_Long_Integer) is
      S : constant String := Long_Long_Integer'Image (Item);
   begin
      if Item > 0 then
         Stream.Write (S (S'First + 1 .. S'Last));
      else
         Stream.Write (S);
      end if;
   end Write;

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

   --  ------------------------------
   --  Get the output stream content as a string.
   --  ------------------------------
   function To_String (Stream : in Buffered.Output_Buffer_Stream'Class) return String is
      Size   : constant Natural := Stream.Get_Size;
      Buffer : constant Streams.Buffered.Buffer_Access := Stream.Get_Buffer;
      Result : String (1 .. Size);
   begin
      for I in Result'Range loop
         Result (I) := Character'Val (Buffer (Stream_Element_Offset (I)));
      end loop;
      return Result;
   end To_String;

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

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

   --  ------------------------------
   --  Initialize the reader to read the input from the input stream given in From.
   --  ------------------------------
   procedure Initialize (Stream : in out Reader_Stream;
                         From   : access Input_Stream'Class) is
   begin
      Stream.Initialize (Input => From, Size => 4096);
   end Initialize;

   --  ------------------------------
   --  Read an input line from the input stream.  The line is terminated by ASCII.LF.
   --  When Strip is set, the line terminators (ASCII.CR, ASCII.LF) are removed.
   --  ------------------------------
   procedure Read_Line (Stream : in out Reader_Stream;
                        Into   : out Ada.Strings.Unbounded.Unbounded_String;
                        Strip  : in Boolean := False) is
      C : Character;
   begin
      while not Stream.Is_Eof loop
         Stream.Read (C);
         if C = ASCII.LF then
            if not Strip then
               Ada.Strings.Unbounded.Append (Into, C);
            end if;
            return;
         elsif C /= ASCII.CR or not Strip then
            Ada.Strings.Unbounded.Append (Into, C);
         end if;
      end loop;

   exception
      when Ada.IO_Exceptions.Data_Error =>
         return;
   end Read_Line;

end Util.Streams.Texts;

-----------------------------------------------------------------------
--  util-streams-texts -- Text stream utilities
--  Copyright (C) 2010, 2011, 2012, 2016, 2017, 2019, 2020 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 Interfaces;
with Ada.IO_Exceptions;
package body Util.Streams.Texts is

   use Ada.Streams;
   subtype Offset is Ada.Streams.Stream_Element_Offset;

   procedure Initialize (Stream : in out Print_Stream;
                         To     : access Output_Stream'Class) is
   begin
      Stream.Initialize (Output => To, Size => 4096);
   end Initialize;

   --  ------------------------------
   --  Write a raw string on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String) is
      Count : constant Natural := Ada.Strings.Unbounded.Length (Item);
   begin
      if Count > 0 then
         for I in 1 .. Count loop
            Stream.Write (Item => Ada.Strings.Unbounded.Element (Item, I));
         end loop;
      end if;
   end Write;

   --  ------------------------------
   --  Write a raw string on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
      Count : constant Natural := Ada.Strings.Wide_Wide_Unbounded.Length (Item);
      C     : Wide_Wide_Character;
   begin
      if Count > 0 then
         for I in 1 .. Count loop
            C := Ada.Strings.Wide_Wide_Unbounded.Element (Item, I);
            Stream.Write_Wide (C);
         end loop;
      end if;
   end Write;

   --  ------------------------------
   --  Write an integer on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Integer) is
      S : constant String := Integer'Image (Item);
   begin
      if Item > 0 then
         Stream.Write (S (S'First + 1 .. S'Last));
      else
         Stream.Write (S);
      end if;
   end Write;

   --  ------------------------------
   --  Write an integer on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Long_Long_Integer) is
      S : constant String := Long_Long_Integer'Image (Item);
   begin
      if Item > 0 then
         Stream.Write (S (S'First + 1 .. S'Last));
      else
         Stream.Write (S);
      end if;
   end Write;

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

   --  ------------------------------
   --  Get the output stream content as a string.
   --  ------------------------------
   function To_String (Stream : in Buffered.Output_Buffer_Stream'Class) return String is
      Size   : constant Natural := Stream.Get_Size;
      Buffer : constant Streams.Buffered.Buffer_Access := Stream.Get_Buffer;
      Result : String (1 .. Size);
   begin
      for I in Result'Range loop
         Result (I) := Character'Val (Buffer (Stream_Element_Offset (I)));
      end loop;
      return Result;
   end To_String;

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

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

   --  ------------------------------
   --  Initialize the reader to read the input from the input stream given in From.
   --  ------------------------------
   procedure Initialize (Stream : in out Reader_Stream;
                         From   : access Input_Stream'Class) is
   begin
      Stream.Initialize (Input => From, Size => 4096);
   end Initialize;

   --  ------------------------------
   --  Read an input line from the input stream.  The line is terminated by ASCII.LF.
   --  When Strip is set, the line terminators (ASCII.CR, ASCII.LF) are removed.
   --  ------------------------------
   procedure Read_Line (Stream : in out Reader_Stream;
                        Into   : out Ada.Strings.Unbounded.Unbounded_String;
                        Strip  : in Boolean := False) is
      C : Character;
   begin
      while not Stream.Is_Eof loop
         Stream.Read (C);
         if C = ASCII.LF then
            if not Strip then
               Ada.Strings.Unbounded.Append (Into, C);
            end if;
            return;
         elsif C /= ASCII.CR or not Strip then
            Ada.Strings.Unbounded.Append (Into, C);
         end if;
      end loop;

   exception
      when Ada.IO_Exceptions.Data_Error =>
         return;
   end Read_Line;

end Util.Streams.Texts;

Remove Write and Write_Wide procedures which are now provided by a parent package


------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: ISC License (see COPYING file)                                  --
--                                                                          --
--                        Copyright © 2015 darkestkhan                      --
------------------------------------------------------------------------------
-- Permission to use, copy, modify, and/or distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- The software is provided "as is" and the author disclaims all warranties --
-- with regard to this software including all implied warranties of         --
-- merchantability and fitness. In no event shall the author be liable for  --
-- any special, direct, indirect, or consequential damages or any damages   --
-- whatsoever resulting from loss of use, data or profits, whether in an    --
-- action of contract, negligence or other tortious action, arising out of  --
-- or in connection with the use or performance of this software.           --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Vectors;

  ------------------------------------------------------------------------------
  -- Small and simple callback based library for processing program arguments --
  ------------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  --                            U  S  A  G  E                              --
  ---------------------------------------------------------------------------
  -- First register all callbacks you are interested in, then call
  -- Process_Arguments.
  --
  -- NOTE: "=" sign can't be part of argument name for registered callback.
  --
  -- Only one callback can be registered per argument, otherwise
  -- Constraint_Error is propagated.
  ---------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  -- Leading single hyphen and double hyphen are stripped (if present) when
  -- processing arguments that are placed before first "--" argument,
  -- so ie. "--help", "-help" and "help" are functionally
  -- equivalent, treated as if "help" was actually passed in all 3 cases.
  -- (you should register callback just for "help", if you register it for
  -- "--help" then actually passed argument would have to be "----help" in order
  -- for it to trigger said callback)
  --
  -- In addition if you registered callback as case insensitive, then
  -- (using above example) "Help", "HELP", "help" and "HeLp" all would result in
  -- call to said callback.
  --
  -- If Argument_Type is Variable then callback will receive part of argument
  -- that is after "=" sign. (ie. "OS=Linux" argument would result in callback
  -- receiving only "Linux" as its argument), otherwise actual argument will be
  -- passed.
  --
  -- For Variable, case insensitive callbacks simple rule applies:
  -- only variable name is case insensitive, with actual value (when passed to
  -- program) being unchanged.
  --
  -- All arguments with no associated callback are added to Unknown_Arguments
  --  vector as long as they appear before first "--" argument.
  --
  -- All arguments after first "--" (standalone double hyphen) are added to
  --  Input_Argument vector (this includes another "--"), w/o any kind of
  --  hyphen stripping being performed on them.
  --
  -- NOTE: No care is taken to ensure that all Input_Arguments
  --  (or Unknown_Arguments) are unique.
  ---------------------------------------------------------------------------

package CBAP is

  ---------------------------------------------------------------------------
  -- Yes, I do realize this is actually vector...
  package Argument_Lists is new
    Ada.Containers.Indefinite_Vectors (Positive, String);

  -- List of all arguments (before first "--" argument) for which callbacks
  --  where not registered.
  Unknown_Arguments : Argument_Lists.Vector := Argument_Lists.Empty_Vector;
  -- List of all arguments after first "--" argument.
  Input_Arguments   : Argument_Lists.Vector := Argument_Lists.Empty_Vector;

  -- Argument_Types decides if argument is just a simple value, or a variable
  -- with value assigned to it (difference between "--val" and "--var=val")
  type Argument_Types is (Value, Variable);

  -- Argument is useful mostly for Variable type of arguments.
  type Callbacks is not null access procedure (Argument: in String);

  ---------------------------------------------------------------------------
  -- Register callbacks for processing arguments.
  -- @Callback      : Action to be performed in case appropriate argument is
  --    detected.
  -- @Called_On     : Argument for which callback is to be performed.
  -- @Argument_Type : {Value, Variable}. Value is simple argument that needs no
  --    additional parsing. Variable is argument of "Arg_Name=Some_Val" form.
  --    When callback is triggered, Value is passed to callback as input, in
  --    case of Variable it is content of argument after first "=" that is
  --    passed to callback.
  -- @Case_Sensitive: Whether or not case is significant. When False all forms
  --    of argument are treated as if written in lower case.
  procedure Register
    ( Callback      : in Callbacks;
      Called_On     : in String;
      Argument_Type : in Argument_Types := Value;
      Case_Sensitive: in Boolean        := True
    );

  -- Raised if Called_On contains "=".
  Incorrect_Called_On: exception;

  ---------------------------------------------------------------------------
  -- Parse arguments supplied to program, calling callbacks when argument with
  -- associated callback is detected.
  -- NOTE: Process_Arguments will call callbacks however many times argument
  --  with associated callback is called. So if you have callback for "help",
  --  then ./program help help help
  --  will result in 3 calls to said callback.
  procedure Process_Arguments;

  ---------------------------------------------------------------------------

end CBAP;

------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: ISC License (see COPYING file)                                  --
--                                                                          --
--                        Copyright © 2015 darkestkhan                      --
------------------------------------------------------------------------------
-- Permission to use, copy, modify, and/or distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- The software is provided "as is" and the author disclaims all warranties --
-- with regard to this software including all implied warranties of         --
-- merchantability and fitness. In no event shall the author be liable for  --
-- any special, direct, indirect, or consequential damages or any damages   --
-- whatsoever resulting from loss of use, data or profits, whether in an    --
-- action of contract, negligence or other tortious action, arising out of  --
-- or in connection with the use or performance of this software.           --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Vectors;

  ------------------------------------------------------------------------------
  -- Small and simple callback based library for processing program arguments --
  ------------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  --                            U  S  A  G  E                              --
  ---------------------------------------------------------------------------
  -- First register all callbacks you are interested in, then call
  -- Process_Arguments.
  --
  -- NOTE: "=" sign can't be part of argument name for registered callback.
  --
  -- Only one callback can be registered per argument, otherwise
  -- Constraint_Error is propagated.
  ---------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  -- Leading single hyphen and double hyphen are stripped (if present) when
  -- processing arguments that are placed before first "--" argument,
  -- so ie. "--help", "-help" and "help" are functionally
  -- equivalent, treated as if "help" was actually passed in all 3 cases.
  -- (you should register callback just for "help", if you register it for
  -- "--help" then actually passed argument would have to be "----help" in order
  -- for it to trigger said callback)
  --
  -- In addition if you registered callback as case insensitive, then
  -- (using above example) "Help", "HELP", "help" and "HeLp" all would result in
  -- call to said callback.
  --
  -- If Argument_Type is Variable then callback will receive part of argument
  -- that is after "=" sign. (ie. "OS=Linux" argument would result in callback
  -- receiving only "Linux" as its argument), otherwise actual argument will be
  -- passed.
  --
  -- For Variable, case insensitive callbacks simple rule applies:
  -- only variable name is case insensitive, with actual value (when passed to
  -- program) being unchanged.
  --
  -- If argument for which callback is registered is passed few times
  -- (ie. ./program help help help) then callback is triggered however many
  -- times said argument is detected.
  --
  -- All arguments with no associated callback are added to Unknown_Arguments
  --  vector as long as they appear before first "--" argument.
  --
  -- All arguments after first "--" (standalone double hyphen) are added to
  --  Input_Argument vector (this includes another "--"), w/o any kind of
  --  hyphen stripping being performed on them.
  --
  -- NOTE: No care is taken to ensure that all Input_Arguments
  --  (or Unknown_Arguments) are unique.
  ---------------------------------------------------------------------------

package CBAP is

  ---------------------------------------------------------------------------
  -- Yes, I do realize this is actually vector...
  package Argument_Lists is new
    Ada.Containers.Indefinite_Vectors (Positive, String);

  -- List of all arguments (before first "--" argument) for which callbacks
  --  where not registered.
  Unknown_Arguments : Argument_Lists.Vector := Argument_Lists.Empty_Vector;
  -- List of all arguments after first "--" argument.
  Input_Arguments   : Argument_Lists.Vector := Argument_Lists.Empty_Vector;

  -- Argument_Types decides if argument is just a simple value, or a variable
  -- with value assigned to it (difference between "--val" and "--var=val")
  type Argument_Types is (Value, Variable);

  -- Argument is useful mostly for Variable type of arguments.
  type Callbacks is not null access procedure (Argument: in String);

  ---------------------------------------------------------------------------
  -- Register callbacks for processing arguments.
  -- @Callback      : Action to be performed in case appropriate argument is
  --    detected.
  -- @Called_On     : Argument for which callback is to be performed.
  -- @Argument_Type : {Value, Variable}. Value is simple argument that needs no
  --    additional parsing. Variable is argument of "Arg_Name=Some_Val" form.
  --    When callback is triggered, Value is passed to callback as input, in
  --    case of Variable it is content of argument after first "=" that is
  --    passed to callback.
  -- @Case_Sensitive: Whether or not case is significant. When False all forms
  --    of argument are treated as if written in lower case.
  procedure Register
    ( Callback      : in Callbacks;
      Called_On     : in String;
      Argument_Type : in Argument_Types := Value;
      Case_Sensitive: in Boolean        := True
    );

  -- Raised if Called_On contains "=".
  Incorrect_Called_On: exception;

  ---------------------------------------------------------------------------
  -- Parse arguments supplied to program, calling callbacks when argument with
  -- associated callback is detected.
  -- NOTE: Process_Arguments will call callbacks however many times argument
  --  with associated callback is called. So if you have callback for "help",
  --  then ./program help help help
  --  will result in 3 calls to said callback.
  procedure Process_Arguments;

  ---------------------------------------------------------------------------

end CBAP;

Update comments.

Update comments.

Signed-off-by: darkestkhan <e9a7a7cf2a6af79e93742343a7a5cac5d90f9bd2@gmail.com>


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

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

   type Test_Context_Type is record
      Number  : Integer;
      Success : Boolean := False;
   end record;

   package Test_Command is new
     Util.Commands.Drivers (Context_Type => Test_Context_Type,
                            Config_Parser => Util.Commands.Parsers.GNAT_Parser.Config_Parser,
                            Driver_Name  => "test");

   type Test_Command_Type is new Test_Command.Command_Type with record
      Opt_Count : aliased Integer := 0;
      Opt_V     : aliased Boolean := False;
      Opt_N     : aliased Boolean := False;
      Expect_V  : Boolean := False;
      Expect_N  : Boolean := False;
      Expect_C  : Integer := 0;
      Expect_A  : Integer := 0;
      Expect_Help : Boolean := False;
   end record;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type);

   --  Setup the command before parsing the arguments and executing it.
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration);

   --  Write the help associated with the command.
   procedure Help (Command   : in Test_Command_Type;
                   Context   : in out Test_Context_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Execute",
                       Test_Execute'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Help",
                       Test_Help'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Usage",
                       Test_Usage'Access);
   end Add_Tests;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type) is
   begin
      Context.Success := Command.Opt_Count = Command.Expect_C and
        Command.Opt_V = Command.Expect_V and
        Command.Opt_N = Command.Expect_N and
        Args.Get_Count = Command.Expect_A and
        not Command.Expect_Help;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration) is
   begin
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-c:",
                                       Long_Switch => "--count=",
                                       Help        => "Number option",
                                       Section     => "",
                                       Initial     => Integer (0),
                                       Default     => Integer (10),
                                       Output      => Command.Opt_Count'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-v",
                                       Long_Switch => "--verbose",
                                       Help        => "Verbose option",
                                       Section     => "",
                                       Output      => Command.Opt_V'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-n",
                                       Long_Switch => "--not",
                                       Help        => "Not option",
                                       Section     => "",
                                       Output      => Command.Opt_N'Access);
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in Test_Command_Type;
                   Context   : in out Test_Context_Type) is

   begin
      Context.Success := Command.Expect_Help;
   end Help;

   --  ------------------------------
   --  Tests when the execution of commands.
   --  ------------------------------
   procedure Test_Execute (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := True;
         C1.Expect_N := True;
         C1.Expect_C := 4;
         C1.Expect_A := 2;
         Initialize (Args, "list --count=4 -v -n test titi");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := False;
         C1.Expect_N := True;
         C1.Expect_C := 8;
         C1.Expect_A := 3;
         Initialize (Args, "list -c 8 -n test titi last");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

   end Test_Execute;

   --  ------------------------------
   --  Test execution of help.
   --  ------------------------------
   procedure Test_Help (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C2.Expect_Help := True;
         Initialize (Args, "help print");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Help;

   --  ------------------------------
   --  Test usage operation.
   --  ------------------------------
   procedure Test_Usage (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      D.Usage (Args);
      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Usage;

end Util.Commands.Tests;

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

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

   type Test_Context_Type is record
      Number  : Integer;
      Success : Boolean := False;
   end record;

   package Test_Command is new
     Util.Commands.Drivers (Context_Type => Test_Context_Type,
                            Config_Parser => Util.Commands.Parsers.GNAT_Parser.Config_Parser,
                            Driver_Name  => "test");

   type Test_Command_Type is new Test_Command.Command_Type with record
      Opt_Count : aliased Integer := 0;
      Opt_V     : aliased Boolean := False;
      Opt_N     : aliased Boolean := False;
      Expect_V  : Boolean := False;
      Expect_N  : Boolean := False;
      Expect_C  : Integer := 0;
      Expect_A  : Integer := 0;
      Expect_Help : Boolean := False;
   end record;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type);

   --  Setup the command before parsing the arguments and executing it.
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration);

   --  Write the help associated with the command.
   procedure Help (Command   : in Test_Command_Type;
                   Context   : in out Test_Context_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Execute",
                       Test_Execute'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Help",
                       Test_Help'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Usage",
                       Test_Usage'Access);
   end Add_Tests;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type) is
   begin
      Context.Success := Command.Opt_Count = Command.Expect_C and
        Command.Opt_V = Command.Expect_V and
        Command.Opt_N = Command.Expect_N and
        Args.Get_Count = Command.Expect_A and
        not Command.Expect_Help;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration) is
   begin
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-c:",
                                       Long_Switch => "--count=",
                                       Help        => "Number option",
                                       Section     => "",
                                       Initial     => Integer (0),
                                       Default     => Integer (10),
                                       Output      => Command.Opt_Count'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-v",
                                       Long_Switch => "--verbose",
                                       Help        => "Verbose option",
                                       Section     => "",
                                       Output      => Command.Opt_V'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-n",
                                       Long_Switch => "--not",
                                       Help        => "Not option",
                                       Section     => "",
                                       Output      => Command.Opt_N'Access);
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in Test_Command_Type;
                   Context   : in out Test_Context_Type) is

   begin
      Context.Success := Command.Expect_Help;
   end Help;

   --  ------------------------------
   --  Tests when the execution of commands.
   --  ------------------------------
   procedure Test_Execute (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := True;
         C1.Expect_N := True;
         C1.Expect_C := 4;
         C1.Expect_A := 2;
         Initialize (Args, "list --count=4 -v -n test titi");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := False;
         C1.Expect_N := True;
         C1.Expect_C := 8;
         C1.Expect_A := 3;
         Initialize (Args, "list -c 8 -n test titi last");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

   end Test_Execute;

   --  ------------------------------
   --  Test execution of help.
   --  ------------------------------
   procedure Test_Help (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C2.Expect_Help := True;
         Initialize (Args, "help print");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Help;

   --  ------------------------------
   --  Test usage operation.
   --  ------------------------------
   procedure Test_Usage (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      Args.Initialize (Line => "cmd list");
      D.Usage (Args);
      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Usage;

end Util.Commands.Tests;

Fix the Test_Usage unit test

Fix the Test_Usage unit test


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

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

with Security.Permissions;

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

   NAME : constant String := "blogs";

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

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

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

   Not_Found : exception;

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

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

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

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

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

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

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

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

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

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

private

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

end AWA.Blogs.Modules;

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

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

with Security.Permissions;

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

   NAME : constant String := "blogs";

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

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

   --  Definition the events.
   package Post_Publish_Event is new AWA.Events.Definition (Name => "blog-post-publish");

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

   Not_Found : exception;

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

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

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

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

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

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

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

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

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

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

private

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

end AWA.Blogs.Modules;

Declare Post_Publish_Event to provide the 'blog-post-publish' event


-----------------------------------------------------------------------
--  awa-votes-modules -- Module votes
--  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 ASF.Applications;

with AWA.Modules;
package AWA.Votes.Modules is

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

   --  ------------------------------
   --  Module votes
   --  ------------------------------
   type Vote_Module is new AWA.Modules.Module with private;
   type Vote_Module_Access is access all Vote_Module'Class;

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

   --  Get the votes module.
   function Get_Vote_Module return Vote_Module_Access;

private

   type Vote_Module is new AWA.Modules.Module with null record;

end AWA.Votes.Modules;

-----------------------------------------------------------------------
--  awa-votes-modules -- Module votes
--  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 ASF.Applications;
with ADO;
with AWA.Modules;
package AWA.Votes.Modules is

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

   --  ------------------------------
   --  Module votes
   --  ------------------------------
   type Vote_Module is new AWA.Modules.Module with private;
   type Vote_Module_Access is access all Vote_Module'Class;

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

   --  Get the votes module.
   function Get_Vote_Module return Vote_Module_Access;

   --  Vote for the given element.
   procedure Vote_For (Model       : in Vote_Module;
                       Id          : in ADO.Identifier;
                       Entity_Type : in String;
                       Permission  : in String;
                       Rating      : in Integer);

private

   type Vote_Module is new AWA.Modules.Module with null record;

end AWA.Votes.Modules;

Move the vote service implementation in the vote module to simplify the implementation