-----------------------------------------------------------------------
--  util-dates -- Date utilities
--  Copyright (C) 2011, 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 Ada.Calendar.Arithmetic;
package body Util.Dates is

   --  ------------------------------
   --  Split the date into a date record (See Ada.Calendar.Formatting.Split).
   --  ------------------------------
   procedure Split (Into       : out Date_Record;
                    Date       : in Ada.Calendar.Time;
                    Time_Zone  : in Ada.Calendar.Time_Zones.Time_Offset := 0) is
   begin
      Into.Date      := Date;
      Into.Time_Zone := Time_Zone;
      Ada.Calendar.Formatting.Split (Date        => Date,
                                     Year        => Into.Year,
                                     Month       => Into.Month,
                                     Day         => Into.Month_Day,
                                     Hour        => Into.Hour,
                                     Minute      => Into.Minute,
                                     Second      => Into.Second,
                                     Sub_Second  => Into.Sub_Second,
                                     Leap_Second => Into.Leap_Second,
                                     Time_Zone   => Time_Zone);
      Into.Day := Ada.Calendar.Formatting.Day_Of_Week (Date);
   end Split;

   --  ------------------------------
   --  Returns true if the given year is a leap year.
   --  ------------------------------
   function Is_Leap_Year (Year : in Ada.Calendar.Year_Number) return Boolean is
   begin
      if Year mod 400 = 0 then
         return True;
      elsif Year mod 100 = 0 then
         return False;
      elsif Year mod 4 = 0 then
         return True;
      else
         return False;
      end if;
   end Is_Leap_Year;

   --  ------------------------------
   --  Get the number of days in the given year.
   --  ------------------------------
   function Get_Day_Count (Year : in Ada.Calendar.Year_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Is_Leap_Year (Year) then
         return 365;
      else
         return 366;
      end if;
   end Get_Day_Count;

   Month_Day_Count : constant array (Ada.Calendar.Month_Number)
     of Ada.Calendar.Arithmetic.Day_Count
       := (1 => 31, 2 => 28, 3 => 31, 4 => 30, 5 => 31, 6 => 30,
           7 => 31, 8 => 31, 9 => 30, 10 => 31, 11 => 30, 12 => 31);

   --  ------------------------------
   --  Get the number of days in the given month.
   --  ------------------------------
   function Get_Day_Count (Year  : in Ada.Calendar.Year_Number;
                           Month : in Ada.Calendar.Month_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Month /= 2 then
         return Month_Day_Count (Month);
      elsif Is_Leap_Year (Year) then
         return 29;
      else
         return 28;
      end if;
   end Get_Day_Count;

   --  ------------------------------
   --  Get a time representing the given date at 00:00:00.
   --  ------------------------------
   function Get_Day_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_Start;

   function Get_Day_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_Start (D);
   end Get_Day_Start;

   --  ------------------------------
   --  Get a time representing the given date at 23:59:59.
   --  ------------------------------
   function Get_Day_End (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_End;

   function Get_Day_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_End (D);
   end Get_Day_End;

   --  ------------------------------
   --  Get a time representing the beginning of the week at 00:00:00.
   --  ------------------------------
   function Get_Week_Start (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 0,
                                                 Minute      => 0,
                                                 Second      => 0,
                                                 Sub_Second  => 0.0,
                                                 Time_Zone   => Date.Time_Zone);
      Day : constant Ada.Calendar.Formatting.Day_Name := Ada.Calendar.Formatting.Day_Of_Week (T);
   begin
      if Day = Ada.Calendar.Formatting.Monday then
         return T;
      else
         return T - Day_Count (Day_Name'Pos (Day) - Day_Name'Pos (Monday));
      end if;
   end Get_Week_Start;

   function Get_Week_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_Start (D);
   end Get_Week_Start;

   --  ------------------------------
   --  Get a time representing the end of the week at 23:59:99.
   --  ------------------------------
   function Get_Week_End (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 23,
                                                 Minute      => 59,
                                                 Second      => 59,
                                                 Sub_Second  => 0.999,
                                                 Time_Zone   => Date.Time_Zone);
      Day : constant Ada.Calendar.Formatting.Day_Name := Ada.Calendar.Formatting.Day_Of_Week (T);
   begin
      --  End of week is 6 days + 23:59:59
      if Day = Ada.Calendar.Formatting.Monday then
         return T + Day_Count (6);
      else
         return T + Day_Count (6 - (Day_Name'Pos (Day) - Day_Name'Pos (Monday)));
      end if;
   end Get_Week_End;

   function Get_Week_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_End (D);
   end Get_Week_End;

   --  ------------------------------
   --  Get a time representing the beginning of the month at 00:00:00.
   --  ------------------------------
   function Get_Month_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Ada.Calendar.Day_Number'First,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_Start;

   function Get_Month_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_Start (D);
   end Get_Month_Start;

   --  ------------------------------
   --  Get a time representing the end of the month at 23:59:59.
   --  ------------------------------
   function Get_Month_End (Date : in Date_Record) return Ada.Calendar.Time is
      Last_Day : constant Ada.Calendar.Day_Number
        := Ada.Calendar.Day_Number (Get_Day_Count (Date.Year, Date.Month));
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Last_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_End;

   function Get_Month_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_End (D);
   end Get_Month_End;

end Util.Dates;

-----------------------------------------------------------------------
--  util-dates -- Date utilities
--  Copyright (C) 2011, 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.
-----------------------------------------------------------------------
package body Util.Dates is

   --  ------------------------------
   --  Split the date into a date record (See Ada.Calendar.Formatting.Split).
   --  ------------------------------
   procedure Split (Into       : out Date_Record;
                    Date       : in Ada.Calendar.Time;
                    Time_Zone  : in Ada.Calendar.Time_Zones.Time_Offset := 0) is
   begin
      Into.Date      := Date;
      Into.Time_Zone := Time_Zone;
      Ada.Calendar.Formatting.Split (Date        => Date,
                                     Year        => Into.Year,
                                     Month       => Into.Month,
                                     Day         => Into.Month_Day,
                                     Hour        => Into.Hour,
                                     Minute      => Into.Minute,
                                     Second      => Into.Second,
                                     Sub_Second  => Into.Sub_Second,
                                     Leap_Second => Into.Leap_Second,
                                     Time_Zone   => Time_Zone);
      Into.Day := Ada.Calendar.Formatting.Day_Of_Week (Date);
   end Split;

   --  ------------------------------
   --  Returns true if the given year is a leap year.
   --  ------------------------------
   function Is_Leap_Year (Year : in Ada.Calendar.Year_Number) return Boolean is
   begin
      if Year mod 400 = 0 then
         return True;
      elsif Year mod 100 = 0 then
         return False;
      elsif Year mod 4 = 0 then
         return True;
      else
         return False;
      end if;
   end Is_Leap_Year;

   --  ------------------------------
   --  Get the number of days in the given year.
   --  ------------------------------
   function Get_Day_Count (Year : in Ada.Calendar.Year_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Is_Leap_Year (Year) then
         return 365;
      else
         return 366;
      end if;
   end Get_Day_Count;

   Month_Day_Count : constant array (Ada.Calendar.Month_Number)
     of Ada.Calendar.Arithmetic.Day_Count
       := (1 => 31, 2 => 28, 3 => 31, 4 => 30, 5 => 31, 6 => 30,
           7 => 31, 8 => 31, 9 => 30, 10 => 31, 11 => 30, 12 => 31);

   --  ------------------------------
   --  Get the number of days in the given month.
   --  ------------------------------
   function Get_Day_Count (Year  : in Ada.Calendar.Year_Number;
                           Month : in Ada.Calendar.Month_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Month /= 2 then
         return Month_Day_Count (Month);
      elsif Is_Leap_Year (Year) then
         return 29;
      else
         return 28;
      end if;
   end Get_Day_Count;

   --  ------------------------------
   --  Get a time representing the given date at 00:00:00.
   --  ------------------------------
   function Get_Day_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_Start;

   function Get_Day_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_Start (D);
   end Get_Day_Start;

   --  ------------------------------
   --  Get a time representing the given date at 23:59:59.
   --  ------------------------------
   function Get_Day_End (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_End;

   function Get_Day_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_End (D);
   end Get_Day_End;

   --  ------------------------------
   --  Get a time representing the beginning of the week at 00:00:00.
   --  ------------------------------
   function Get_Week_Start (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 0,
                                                 Minute      => 0,
                                                 Second      => 0,
                                                 Sub_Second  => 0.0,
                                                 Time_Zone   => Date.Time_Zone);
      Day : constant Ada.Calendar.Formatting.Day_Name := Ada.Calendar.Formatting.Day_Of_Week (T);
   begin
      if Day = Ada.Calendar.Formatting.Monday then
         return T;
      else
         return T - Day_Count (Day_Name'Pos (Day) - Day_Name'Pos (Monday));
      end if;
   end Get_Week_Start;

   function Get_Week_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_Start (D);
   end Get_Week_Start;

   --  ------------------------------
   --  Get a time representing the end of the week at 23:59:99.
   --  ------------------------------
   function Get_Week_End (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 23,
                                                 Minute      => 59,
                                                 Second      => 59,
                                                 Sub_Second  => 0.999,
                                                 Time_Zone   => Date.Time_Zone);
      Day : constant Ada.Calendar.Formatting.Day_Name := Ada.Calendar.Formatting.Day_Of_Week (T);
   begin
      --  End of week is 6 days + 23:59:59
      if Day = Ada.Calendar.Formatting.Monday then
         return T + Day_Count (6);
      else
         return T + Day_Count (6 - (Day_Name'Pos (Day) - Day_Name'Pos (Monday)));
      end if;
   end Get_Week_End;

   function Get_Week_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_End (D);
   end Get_Week_End;

   --  ------------------------------
   --  Get a time representing the beginning of the month at 00:00:00.
   --  ------------------------------
   function Get_Month_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Ada.Calendar.Day_Number'First,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_Start;

   function Get_Month_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_Start (D);
   end Get_Month_Start;

   --  ------------------------------
   --  Get a time representing the end of the month at 23:59:59.
   --  ------------------------------
   function Get_Month_End (Date : in Date_Record) return Ada.Calendar.Time is
      Last_Day : constant Ada.Calendar.Day_Number
        := Ada.Calendar.Day_Number (Get_Day_Count (Date.Year, Date.Month));
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Last_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_End;

   function Get_Month_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_End (D);
   end Get_Month_End;

end Util.Dates;

Fix some compilation warning

Fix some compilation warning


-----------------------------------------------------------------------
--  ADO Postgresql statements -- Postgresql query statements
--  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 ADO.SQL;
with ADO.Schemas;
with PQ;

package ADO.Statements.Postgresql is

   --  ------------------------------
   --  Delete statement
   --  ------------------------------
   type Postgresql_Delete_Statement is new Delete_Statement with private;
   type Postgresql_Delete_Statement_Access is access all Postgresql_Delete_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Postgresql_Delete_Statement;
                      Result : out Natural);

   --  Create the delete statement
   function Create_Statement (Database : in PQ.PGconn_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access;

   --  ------------------------------
   --  Update statement
   --  ------------------------------
   type Postgresql_Update_Statement is new Update_Statement with private;
   type Postgresql_Update_Statement_Access is access all Postgresql_Update_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Postgresql_Update_Statement);

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Postgresql_Update_Statement;
                      Result : out Integer);

   --  Create an update statement.
   function Create_Statement (Database : in PQ.PGconn_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access;

   --  ------------------------------
   --  Insert statement
   --  ------------------------------
   type Postgresql_Insert_Statement is new Insert_Statement with private;
   type Postgresql_Insert_Statement_Access is access all Postgresql_Insert_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Postgresql_Insert_Statement;
                      Result : out Integer);

   --  Create an insert statement.
   function Create_Statement (Database : in PQ.PGconn_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access;

   --  ------------------------------
   --  Query statement for Postgresql
   --  ------------------------------
   type Postgresql_Query_Statement is new Query_Statement with private;
   type Postgresql_Query_Statement_Access is access all Postgresql_Query_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Postgresql_Query_Statement);

   --  Get the number of rows returned by the query
   overriding
   function Get_Row_Count (Query : in Postgresql_Query_Statement) return Natural;

   --  Returns True if there is more data (row) to fetch
   overriding
   function Has_Elements (Query : in Postgresql_Query_Statement) return Boolean;

   --  Fetch the next row
   overriding
   procedure Next (Query : in out Postgresql_Query_Statement);

   --  Returns true if the column Column is null.
   overriding
   function Is_Null (Query  : in Postgresql_Query_Statement;
                     Column : in Natural) return Boolean;

   --  Get the column value at position Column and
   --  return it as an Int64.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Int64 (Query  : Postgresql_Query_Statement;
                       Column : Natural) return Int64;

   --  Get the column value at position Column and
   --  return it as an Boolean.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Boolean (Query  : Postgresql_Query_Statement;
                         Column : Natural) return Boolean;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Unbounded_String (Query  : Postgresql_Query_Statement;
                                  Column : Natural) return Unbounded_String;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_String (Query  : Postgresql_Query_Statement;
                        Column : Natural) return String;

   --  Get the column value at position Column and
   --  return it as a Blob reference.
   overriding
   function Get_Blob (Query  : in Postgresql_Query_Statement;
                      Column : in Natural) return ADO.Blob_Ref;

   --  Get the column value at position Column and
   --  return it as an Time.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   function Get_Time (Query  : Postgresql_Query_Statement;
                      Column : Natural) return Ada.Calendar.Time;

   --  Get the column type
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Type (Query  : Postgresql_Query_Statement;
                             Column : Natural)
                             return ADO.Schemas.Column_Type;

   --  Get the column name.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Name (Query  : in Postgresql_Query_Statement;
                             Column : in Natural)
                             return String;

   --  Get the number of columns in the result.
   overriding
   function Get_Column_Count (Query  : in Postgresql_Query_Statement)
                              return Natural;

   overriding
   procedure Finalize (Query : in out Postgresql_Query_Statement);

   --  Create the query statement.
   function Create_Statement (Database : in PQ.PGconn_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access;

   function Create_Statement (Database : in PQ.PGconn_Access;
                              Query    : in String)
                              return Query_Statement_Access;

private
   type State is (HAS_ROW, HAS_MORE, DONE, ERROR);

   type Postgresql_Query_Statement is new Query_Statement with record
      This_Query : aliased ADO.SQL.Query;
      Connection : PQ.PGconn_Access   := PQ.Null_PGconn;
      Result     : PQ.PGresult_Access := PQ.Null_PGresult;
      Row        : Interfaces.C.int := 0;
      Row_Count  : Interfaces.C.int := 0;
      Counter    : Natural := 1;
      Status     : State := DONE;
      Max_Column : Natural;
   end record;

   --  Get a column field address.
   --  If the query was not executed, raises Invalid_Statement
   --  If the column is out of bound, raises Constraint_Error
   function Get_Field (Query  : Postgresql_Query_Statement'Class;
                       Column : Natural) return chars_ptr;

   --  Get a column field length.
   --  If the query was not executed, raises Invalid_Statement
   --  If the column is out of bound, raises Constraint_Error
   --  ------------------------------
   function Get_Field_Length (Query  : in Postgresql_Query_Statement'Class;
                              Column : in Natural) return Natural;

   type Postgresql_Delete_Statement is new Delete_Statement with record
      Connection   : PQ.PGconn_Access;
      Table        : ADO.Schemas.Class_Mapping_Access;
      Delete_Query : aliased ADO.SQL.Query;
   end record;

   type Postgresql_Update_Statement is new Update_Statement with record
      Connection : PQ.PGconn_Access;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

   type Postgresql_Insert_Statement is new Insert_Statement with record
      Connection : PQ.PGconn_Access;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

end ADO.Statements.Postgresql;

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

with ADO.SQL;
with ADO.Schemas;
with PQ;

package ADO.Statements.Postgresql is

   --  ------------------------------
   --  Delete statement
   --  ------------------------------
   type Postgresql_Delete_Statement is new Delete_Statement with private;
   type Postgresql_Delete_Statement_Access is access all Postgresql_Delete_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Postgresql_Delete_Statement;
                      Result : out Natural);

   --  Create the delete statement
   function Create_Statement (Database : in PQ.PGconn_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access;

   --  ------------------------------
   --  Update statement
   --  ------------------------------
   type Postgresql_Update_Statement is new Update_Statement with private;
   type Postgresql_Update_Statement_Access is access all Postgresql_Update_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Postgresql_Update_Statement);

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Postgresql_Update_Statement;
                      Result : out Integer);

   --  Create an update statement.
   function Create_Statement (Database : in PQ.PGconn_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access;

   --  ------------------------------
   --  Insert statement
   --  ------------------------------
   type Postgresql_Insert_Statement is new Insert_Statement with private;
   type Postgresql_Insert_Statement_Access is access all Postgresql_Insert_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Postgresql_Insert_Statement;
                      Result : out Integer);

   --  Create an insert statement.
   function Create_Statement (Database : in PQ.PGconn_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access;

   --  ------------------------------
   --  Query statement for Postgresql
   --  ------------------------------
   type Postgresql_Query_Statement is new Query_Statement with private;
   type Postgresql_Query_Statement_Access is access all Postgresql_Query_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Postgresql_Query_Statement);

   --  Get the number of rows returned by the query
   overriding
   function Get_Row_Count (Query : in Postgresql_Query_Statement) return Natural;

   --  Returns True if there is more data (row) to fetch
   overriding
   function Has_Elements (Query : in Postgresql_Query_Statement) return Boolean;

   --  Fetch the next row
   overriding
   procedure Next (Query : in out Postgresql_Query_Statement);

   --  Returns true if the column Column is null.
   overriding
   function Is_Null (Query  : in Postgresql_Query_Statement;
                     Column : in Natural) return Boolean;

   --  Get the column value at position Column and
   --  return it as an Int64.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Int64 (Query  : Postgresql_Query_Statement;
                       Column : Natural) return Int64;

   --  Get the column value at position Column and
   --  return it as an Long_Float.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Double (Query  : Postgresql_Query_Statement;
                        Column : Natural) return Long_Float;

   --  Get the column value at position Column and
   --  return it as an Boolean.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Boolean (Query  : Postgresql_Query_Statement;
                         Column : Natural) return Boolean;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Unbounded_String (Query  : Postgresql_Query_Statement;
                                  Column : Natural) return Unbounded_String;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_String (Query  : Postgresql_Query_Statement;
                        Column : Natural) return String;

   --  Get the column value at position Column and
   --  return it as a Blob reference.
   overriding
   function Get_Blob (Query  : in Postgresql_Query_Statement;
                      Column : in Natural) return ADO.Blob_Ref;

   --  Get the column value at position Column and
   --  return it as an Time.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   function Get_Time (Query  : Postgresql_Query_Statement;
                      Column : Natural) return Ada.Calendar.Time;

   --  Get the column type
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Type (Query  : Postgresql_Query_Statement;
                             Column : Natural)
                             return ADO.Schemas.Column_Type;

   --  Get the column name.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Name (Query  : in Postgresql_Query_Statement;
                             Column : in Natural)
                             return String;

   --  Get the number of columns in the result.
   overriding
   function Get_Column_Count (Query  : in Postgresql_Query_Statement)
                              return Natural;

   overriding
   procedure Finalize (Query : in out Postgresql_Query_Statement);

   --  Create the query statement.
   function Create_Statement (Database : in PQ.PGconn_Access;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access;

   function Create_Statement (Database : in PQ.PGconn_Access;
                              Query    : in String)
                              return Query_Statement_Access;

private
   type State is (HAS_ROW, HAS_MORE, DONE, ERROR);

   type Postgresql_Query_Statement is new Query_Statement with record
      This_Query : aliased ADO.SQL.Query;
      Connection : PQ.PGconn_Access   := PQ.Null_PGconn;
      Result     : PQ.PGresult_Access := PQ.Null_PGresult;
      Row        : Interfaces.C.int := 0;
      Row_Count  : Interfaces.C.int := 0;
      Counter    : Natural := 1;
      Status     : State := DONE;
      Max_Column : Natural;
   end record;

   --  Get a column field address.
   --  If the query was not executed, raises Invalid_Statement
   --  If the column is out of bound, raises Constraint_Error
   function Get_Field (Query  : Postgresql_Query_Statement'Class;
                       Column : Natural) return chars_ptr;

   --  Get a column field length.
   --  If the query was not executed, raises Invalid_Statement
   --  If the column is out of bound, raises Constraint_Error
   --  ------------------------------
   function Get_Field_Length (Query  : in Postgresql_Query_Statement'Class;
                              Column : in Natural) return Natural;

   type Postgresql_Delete_Statement is new Delete_Statement with record
      Connection   : PQ.PGconn_Access;
      Table        : ADO.Schemas.Class_Mapping_Access;
      Delete_Query : aliased ADO.SQL.Query;
   end record;

   type Postgresql_Update_Statement is new Update_Statement with record
      Connection : PQ.PGconn_Access;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

   type Postgresql_Insert_Statement is new Insert_Statement with record
      Connection : PQ.PGconn_Access;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

end ADO.Statements.Postgresql;

Declare the Get_Double function to support floating point columns


-----------------------------------------------------------------------
--  druss-commands-devices -- Print information about the devices
--  Copyright (C) 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Properties;
with Util.Log.Loggers;
with Bbox.API;
with Druss.Gateways;
with Ada.Strings.Unbounded;
package body Druss.Commands.Ping is

   use Ada.Strings.Unbounded;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Druss.Commands.Ping");

   --  ------------------------------
   --  Execute the wifi 'status' command to print the Wifi current status.
   --  ------------------------------
   procedure Do_Ping (Command   : in Command_Type;
                      Args      : in Argument_List'Class;
                      Selector  : in Device_Selector_Type;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Command, Args);
      procedure Do_Ping (Gateway : in out Druss.Gateways.Gateway_Type);
      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type);

      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;

      procedure Do_Ping (Gateway : in out Druss.Gateways.Gateway_Type) is
         procedure Ping_Device (Manager : in Util.Properties.Manager;
                                Name    : in String);

         Box  : Bbox.API.Client_Type;

         procedure Ping_Device (Manager : in Util.Properties.Manager;
                                Name    : in String) is
            Id   : constant String := Manager.Get (Name & ".id", "");
         begin
            case Selector is
               when DEVICE_ALL =>
                  null;

               when DEVICE_ACTIVE =>
                  if Manager.Get (Name & ".active", "") = "0" then
                     return;
                  end if;

               when DEVICE_INACTIVE =>
                  if Manager.Get (Name & ".active", "") = "1" then
                     return;
                  end if;

            end case;
            Log.Info ("Ping command on {0}", Manager.Get (Name & ".ipaddress", ""));
            Box.Post ("hosts/" & Id, "action=ping");
         end Ping_Device;

      begin
         if Ada.Strings.Unbounded.Length (Gateway.Passwd) = 0 then
            return;
         end if;
         Gateway.Refresh;
         Box.Set_Server (To_String (Gateway.Ip));
         Box.Login (To_String (Gateway.Passwd));

         Bbox.API.Iterate (Gateway.Hosts, "hosts.list", Ping_Device'Access);
      end Do_Ping;

      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type) is
         procedure Print_Device (Manager : in Util.Properties.Manager;
                                 Name    : in String);

         procedure Print_Device (Manager : in Util.Properties.Manager;
                                 Name    : in String) is
            Link : constant String := Manager.Get (Name & ".link", "");
         begin
            if Manager.Get (Name & ".active", "") = "0" then
               return;
            end if;
            Console.Start_Row;
            Console.Print_Field (F_BBOX_IP_ADDR, Gateway.Ip);
            Console.Print_Field (F_IP_ADDR, Manager.Get (Name & ".ipaddress", ""));
            Console.Print_Field (F_HOSTNAME, Manager.Get (Name & ".hostname", ""));
            Print_Perf (Console, F_ACTIVE, Manager.Get (Name & ".ping.average", ""));
            if Link = "Ethernet" then
               Console.Print_Field (F_LINK, Link & " port "
                                    & Manager.Get (Name & ".ethernet.logicalport", ""));
            else
               Console.Print_Field (F_LINK, Link & " RSSI "
                                    & Manager.Get (Name & ".wireless.rssi0", ""));
            end if;
            Console.End_Row;
         end Print_Device;

      begin
         Gateway.Refresh;

         Bbox.API.Iterate (Gateway.Hosts, "hosts.list", Print_Device'Access);
      end Box_Status;

   begin
      Druss.Gateways.Iterate (Context.Gateways, Gateways.ITER_ENABLE, Do_Ping'Access);
      delay 5.0;
      Console.Start_Title;
      Console.Print_Title (F_BBOX_IP_ADDR, "Bbox IP", 16);
      Console.Print_Title (F_IP_ADDR, "Device IP", 16);
      Console.Print_Title (F_HOSTNAME, "Hostname", 28);
      Console.Print_Title (F_ACTIVE, "Ping", 15);
      Console.Print_Title (F_LINK, "Link", 18);
      Console.End_Title;
      Druss.Gateways.Iterate (Context.Gateways, Gateways.ITER_ENABLE, Box_Status'Access);
   end Do_Ping;

   --  ------------------------------
   --  Execute a ping from the gateway to each device.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Name);
   begin
      if Args.Get_Count > 1 then
         Context.Console.Notice (N_USAGE, "Too many arguments to the command");
         Druss.Commands.Driver.Usage (Args);
      elsif Args.Get_Count = 0 then
         Command.Do_Ping (Args, DEVICE_ALL, Context);
      elsif Args.Get_Argument (1) = "all" then
         Command.Do_Ping (Args, DEVICE_ALL, Context);
      elsif Args.Get_Argument (1) = "active" then
         Command.Do_Ping (Args, DEVICE_ACTIVE, Context);
      elsif Args.Get_Argument (1) = "inactive" then
         Command.Do_Ping (Args, DEVICE_INACTIVE, Context);
      else
         Context.Console.Notice (N_USAGE, "Invalid argument: " & Args.Get_Argument (1));
         Druss.Commands.Driver.Usage (Args);
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type) is
      pragma Unreferenced (Command);
      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;
   begin
      Console.Notice (N_HELP, "ping: Ask the Bbox to ping the devices");
      Console.Notice (N_HELP, "Usage: ping [all | active | inactive]");
      Console.Notice (N_HELP, "");
      Console.Notice (N_HELP, "  Ask the Bbox to ping the devices.  By default it will ping");
      Console.Notice (N_HELP, "  all the devices that have been discovered by the Bbox.");
      Console.Notice (N_HELP, "  The command will wait 5 seconds and it will list the active");
      Console.Notice (N_HELP, "  devices with their ping performance.");
      Console.Notice (N_HELP, "");
      Console.Notice (N_HELP, "    all        Ping all the devices");
      Console.Notice (N_HELP, "    active     Ping the active devices only");
      Console.Notice (N_HELP, "    inative    Ping the inactive devices only");
   end Help;

end Druss.Commands.Ping;

-----------------------------------------------------------------------
--  druss-commands-devices -- Print information about the devices
--  Copyright (C) 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 Util.Properties;
with Util.Log.Loggers;
with Bbox.API;
with Druss.Gateways;
with Ada.Strings.Unbounded;
package body Druss.Commands.Ping is

   use Ada.Strings.Unbounded;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Druss.Commands.Ping");

   --  ------------------------------
   --  Execute the wifi 'status' command to print the Wifi current status.
   --  ------------------------------
   procedure Do_Ping (Command   : in Command_Type;
                      Args      : in Argument_List'Class;
                      Selector  : in Device_Selector_Type;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Command, Args);
      procedure Do_Ping (Gateway : in out Druss.Gateways.Gateway_Type);
      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type);

      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;

      procedure Do_Ping (Gateway : in out Druss.Gateways.Gateway_Type) is
         procedure Ping_Device (Manager : in Util.Properties.Manager;
                                Name    : in String);

         Box  : Bbox.API.Client_Type;

         procedure Ping_Device (Manager : in Util.Properties.Manager;
                                Name    : in String) is
            Id   : constant String := Manager.Get (Name & ".id", "");
         begin
            case Selector is
               when DEVICE_ALL =>
                  null;

               when DEVICE_ACTIVE =>
                  if Manager.Get (Name & ".active", "") = "0" then
                     return;
                  end if;

               when DEVICE_INACTIVE =>
                  if Manager.Get (Name & ".active", "") = "1" then
                     return;
                  end if;

            end case;
            Log.Info ("Ping command on {0}", Manager.Get (Name & ".ipaddress", ""));
            Box.Post ("hosts/" & Id, "action=ping");
         end Ping_Device;

      begin
         if Ada.Strings.Unbounded.Length (Gateway.Passwd) = 0 then
            return;
         end if;
         Gateway.Refresh;
         Box.Set_Server (To_String (Gateway.Ip));
         Box.Login (To_String (Gateway.Passwd));

         Bbox.API.Iterate (Gateway.Hosts, "hosts.list", Ping_Device'Access);
      end Do_Ping;

      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type) is
         procedure Print_Device (Manager : in Util.Properties.Manager;
                                 Name    : in String);

         procedure Print_Device (Manager : in Util.Properties.Manager;
                                 Name    : in String) is
            Link : constant String := Manager.Get (Name & ".link", "");
         begin
            if Manager.Get (Name & ".active", "") = "0" then
               return;
            end if;
            Console.Start_Row;
            Console.Print_Field (F_BBOX_IP_ADDR, Gateway.Ip);
            Console.Print_Field (F_IP_ADDR, Manager.Get (Name & ".ipaddress", ""));
            Console.Print_Field (F_HOSTNAME, Manager.Get (Name & ".hostname", ""));
            Print_Perf (Console, F_ACTIVE, Manager.Get (Name & ".ping.average", ""));
            if Link = "Ethernet" then
               Console.Print_Field (F_LINK, Link & " port "
                                    & Manager.Get (Name & ".ethernet.logicalport", ""));
            else
               Console.Print_Field (F_LINK, Link & " RSSI "
                                    & Manager.Get (Name & ".wireless.rssi0", ""));
            end if;
            Console.End_Row;
         end Print_Device;

      begin
         Gateway.Refresh;

         Bbox.API.Iterate (Gateway.Hosts, "hosts.list", Print_Device'Access);
      end Box_Status;

   begin
      Druss.Gateways.Iterate (Context.Gateways, Gateways.ITER_ENABLE, Do_Ping'Access);
      delay 5.0;
      Console.Start_Title;
      Console.Print_Title (F_BBOX_IP_ADDR, "Bbox IP", 16);
      Console.Print_Title (F_IP_ADDR, "Device IP", 16);
      Console.Print_Title (F_HOSTNAME, "Hostname", 28);
      Console.Print_Title (F_ACTIVE, "Ping", 15);
      Console.Print_Title (F_LINK, "Link", 18);
      Console.End_Title;
      Druss.Gateways.Iterate (Context.Gateways, Gateways.ITER_ENABLE, Box_Status'Access);
   end Do_Ping;

   --  ------------------------------
   --  Execute a ping from the gateway to each device.
   --  ------------------------------
   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      pragma Unreferenced (Name);
   begin
      if Args.Get_Count > 1 then
         Context.Console.Notice (N_USAGE, "Too many arguments to the command");
         Druss.Commands.Driver.Usage (Args, Context);
      elsif Args.Get_Count = 0 then
         Command.Do_Ping (Args, DEVICE_ALL, Context);
      elsif Args.Get_Argument (1) = "all" then
         Command.Do_Ping (Args, DEVICE_ALL, Context);
      elsif Args.Get_Argument (1) = "active" then
         Command.Do_Ping (Args, DEVICE_ACTIVE, Context);
      elsif Args.Get_Argument (1) = "inactive" then
         Command.Do_Ping (Args, DEVICE_INACTIVE, Context);
      else
         Context.Console.Notice (N_USAGE, "Invalid argument: " & Args.Get_Argument (1));
         Druss.Commands.Driver.Usage (Args, Context);
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in out Command_Type;
                   Context   : in out Context_Type) is
      pragma Unreferenced (Command);
      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;
   begin
      Console.Notice (N_HELP, "ping: Ask the Bbox to ping the devices");
      Console.Notice (N_HELP, "Usage: ping [all | active | inactive]");
      Console.Notice (N_HELP, "");
      Console.Notice (N_HELP, "  Ask the Bbox to ping the devices.  By default it will ping");
      Console.Notice (N_HELP, "  all the devices that have been discovered by the Bbox.");
      Console.Notice (N_HELP, "  The command will wait 5 seconds and it will list the active");
      Console.Notice (N_HELP, "  devices with their ping performance.");
      Console.Notice (N_HELP, "");
      Console.Notice (N_HELP, "    all        Ping all the devices");
      Console.Notice (N_HELP, "    active     Ping the active devices only");
      Console.Notice (N_HELP, "    inative    Ping the inactive devices only");
   end Help;

end Druss.Commands.Ping;

Change Help command to accept in out command


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

with Ada.Finalization;

with Util.Beans.Basic;
with EL.Expressions;
with EL.Contexts;

package ASF.Routes is

   type Route_Type is limited interface;
   type Route_Type_Access is access all Route_Type'Class;

   --  The <tt>Route_Context_Type</tt> defines the context information after a path
   --  has been routed.
   type Route_Context_Type is tagged limited private;

   --  Get path information after the routing.
   function Get_Path_Info (Context : in Route_Context_Type) return String;

   --  Return the route associated with the resolved route context.
   function Get_Route (Context : in Route_Context_Type) return Route_Type_Access;

   --  Inject the parameters that have been extracted from the path according
   --  to the selected route.
   procedure Inject_Parameters (Context   : in Route_Context_Type;
                                Into      : in out Util.Beans.Basic.Bean'Class;
                                ELContext : in EL.Contexts.ELContext'Class);

   --  The <tt>Router_Type</tt> registers the different routes with their rules and
   --  resolves a path into a route context information.
   type Router_Type is new Ada.Finalization.Limited_Controlled with private;
   type Router_Type_Access is access all Router_Type'Class;

   --  Add a route associated with the given path pattern.  The pattern is split into components.
   --  Some path components can be a fixed string (/home) and others can be variable.
   --  When a path component is variable, the value can be retrieved from the route context.
   procedure Add_Route (Router    : in out Router_Type;
                        Pattern   : in String;
                        To        : in Route_Type_Access;
                        ELContext : in EL.Contexts.ELContext'Class);

   --  Build the route context from the given path by looking at the different routes registered
   --  in the router with <tt>Add_Route</tt>.
   procedure Find_Route (Router  : in Router_Type;
                         Path    : in String;
                         Context : in out Route_Context_Type'Class);

   --  Walk the routes that have been added by <tt>Add_Route</tt> and call the <tt>Process</tt>
   --  procedure with each path pattern and route object.
   procedure Iterate (Router  : in Router_Type;
                      Process : not null access procedure (Pattern : in String;
                                                           Route   : in Route_Type_Access));

private

   type String_Access is access all String;

   type Route_Node_Type;
   type Route_Node_Access is access all Route_Node_Type'Class;

   type Route_Match_Type is (NO_MATCH, MAYBE_MATCH, WILDCARD_MATCH, YES_MATCH);

   type Route_Node_Type is abstract tagged limited record
      Next_Route : Route_Node_Access;
      Children   : Route_Node_Access;
      Route      : Route_Type_Access;
   end record;

   --  Inject the parameter that was extracted from the path.
   procedure Inject_Parameter (Node      : in Route_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class) is null;

   --  Check if the route node accepts the given path component.
   function Matches (Node    : in Route_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type is abstract;

   --  Return the component path pattern that this route node represents.
   --  Example: 'index.html', '#{user.id}', ':id'
   function Get_Pattern (Node : in Route_Node_Type) return String is abstract;

   --  Find recursively a match on the given route sub-tree.  The match must start at the position
   --  <tt>First</tt> in the path up to the last path position.  While the path components are
   --  checked, the route context is populated with variable components.  When the full path
   --  matches, <tt>YES_MATCH</tt> is returned in the context gets the route instance.
   procedure Find_Match (Node    : in Route_Node_Type;
                         Path    : in String;
                         First   : in Natural;
                         Match   : out Route_Match_Type;
                         Context : in out Route_Context_Type'Class);

   --  Walk the routes that have been added by <tt>Add_Route</tt> and call the <tt>Process</tt>
   --  procedure with each path pattern and route object.
   procedure Iterate (Node    : in Route_Node_Type;
                      Path    : in String;
                      Process : not null access procedure (Pattern : in String;
                                                           Route   : in Route_Type_Access));

   --  A fixed path component identification.
   type Path_Node_Type (Len : Natural) is new Route_Node_Type with record
      Name : aliased String (1 .. Len);
   end record;
   type Path_Node_Access is access all Path_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns YES_MATCH if the name corresponds exactly to the node's name.
   overriding
   function Matches (Node    : in Path_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, 'Name').
   overriding
   function Get_Pattern (Node : in Path_Node_Type) return String;

   --  A variable path component whose value is injected in an Ada bean using the EL expression.
   --  The route node is created each time an EL expression is found in the route pattern.
   --  Example: /home/#{user.id}/index.html
   --  In this example, the EL expression refers to <tt>user.id</tt>.
   type EL_Node_Type is new Route_Node_Type with record
      Value : EL.Expressions.Value_Expression;
   end record;
   type EL_Node_Access is access all EL_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in EL_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, the EL expr).
   overriding
   function Get_Pattern (Node : in EL_Node_Type) return String;

   --  Inject the parameter that was extracted from the path.
   overriding
   procedure Inject_Parameter (Node      : in EL_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class);

   --  A variable path component which can be injected in an Ada bean.
   --  Example: /home/:id/view.html
   --  The path component represented by <tt>:id</tt> is injected in the Ada bean object
   --  passed to the <tt>Inject_Parameters</tt> procedure.
   type Param_Node_Type (Len : Natural) is new Route_Node_Type with record
      Name : String (1 .. Len);
   end record;
   type Param_Node_Access is access all Param_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in Param_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, Name).
   overriding
   function Get_Pattern (Node : in Param_Node_Type) return String;

   --  Inject the parameter that was extracted from the path.
   overriding
   procedure Inject_Parameter (Node      : in Param_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class);

   type Extension_Node_Type (Len : Natural) is new Route_Node_Type with record
      Ext : String (1 .. Len);
   end record;
   type Extension_Node_Access is access all Extension_Node_Type'Class;

   --  Check if the route node accepts the given extension.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in Extension_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, *.Ext).
   overriding
   function Get_Pattern (Node : in Extension_Node_Type) return String;

   type Wildcard_Node_Type is new Route_Node_Type with null record;
   type Wildcard_Node_Access is access all Wildcard_Node_Type'Class;

   --  Check if the route node accepts the given extension.
   --  Returns WILDCARD_MATCH.
   overriding
   function Matches (Node    : in Wildcard_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, *).
   overriding
   function Get_Pattern (Node : in Wildcard_Node_Type) return String;

   --  Describes a variable path component whose value must be injected in an Ada bean.
   type Route_Param_Type is limited record
      Route : Route_Node_Access;
      First : Natural := 0;
      Last  : Natural := 0;
   end record;

   type Route_Param_Array is array (Positive range <>) of Route_Param_Type;

   MAX_ROUTE_PARAMS : constant Positive := 10;

   type Route_Context_Type is limited new Ada.Finalization.Limited_Controlled with record
      Route  : Route_Type_Access;
      Path   : String_Access;
      Params : Route_Param_Array (1 .. MAX_ROUTE_PARAMS);
      Count  : Natural := 0;
   end record;

   --  Release the storage held by the route context.
   overriding
   procedure Finalize (Context : in out Route_Context_Type);

   type Router_Type is new Ada.Finalization.Limited_Controlled with record
      Route : aliased Path_Node_Type (Len => 0);
   end record;

   --  Release the storage held by the router.
   overriding
   procedure Finalize (Router : in out Router_Type);

end ASF.Routes;

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

with Ada.Finalization;

with Util.Beans.Basic;
with EL.Expressions;
with EL.Contexts;

package ASF.Routes is

   type Route_Type is limited interface;
   type Route_Type_Access is access all Route_Type'Class;

   --  The <tt>Route_Context_Type</tt> defines the context information after a path
   --  has been routed.
   type Route_Context_Type is tagged limited private;

   --  Get path information after the routing.
   function Get_Path_Info (Context : in Route_Context_Type) return String;

   --  Return the position of the variable part of the path.
   --  If the URI matches a wildcard pattern, the position of the last '/' in the wildcard pattern
   --  is returned.
   function Get_Path_Pos (Context : in Route_Context_Type) return Natural;

   --  Return the route associated with the resolved route context.
   function Get_Route (Context : in Route_Context_Type) return Route_Type_Access;

   --  Inject the parameters that have been extracted from the path according
   --  to the selected route.
   procedure Inject_Parameters (Context   : in Route_Context_Type;
                                Into      : in out Util.Beans.Basic.Bean'Class;
                                ELContext : in EL.Contexts.ELContext'Class);

   --  The <tt>Router_Type</tt> registers the different routes with their rules and
   --  resolves a path into a route context information.
   type Router_Type is new Ada.Finalization.Limited_Controlled with private;
   type Router_Type_Access is access all Router_Type'Class;

   --  Add a route associated with the given path pattern.  The pattern is split into components.
   --  Some path components can be a fixed string (/home) and others can be variable.
   --  When a path component is variable, the value can be retrieved from the route context.
   procedure Add_Route (Router    : in out Router_Type;
                        Pattern   : in String;
                        To        : in Route_Type_Access;
                        ELContext : in EL.Contexts.ELContext'Class);

   --  Build the route context from the given path by looking at the different routes registered
   --  in the router with <tt>Add_Route</tt>.
   procedure Find_Route (Router  : in Router_Type;
                         Path    : in String;
                         Context : in out Route_Context_Type'Class);

   --  Walk the routes that have been added by <tt>Add_Route</tt> and call the <tt>Process</tt>
   --  procedure with each path pattern and route object.
   procedure Iterate (Router  : in Router_Type;
                      Process : not null access procedure (Pattern : in String;
                                                           Route   : in Route_Type_Access));

private

   type String_Access is access all String;

   type Route_Node_Type;
   type Route_Node_Access is access all Route_Node_Type'Class;

   type Route_Match_Type is (NO_MATCH, MAYBE_MATCH, WILDCARD_MATCH, YES_MATCH);

   type Route_Node_Type is abstract tagged limited record
      Next_Route : Route_Node_Access;
      Children   : Route_Node_Access;
      Route      : Route_Type_Access;
   end record;

   --  Inject the parameter that was extracted from the path.
   procedure Inject_Parameter (Node      : in Route_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class) is null;

   --  Check if the route node accepts the given path component.
   function Matches (Node    : in Route_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type is abstract;

   --  Return the component path pattern that this route node represents.
   --  Example: 'index.html', '#{user.id}', ':id'
   function Get_Pattern (Node : in Route_Node_Type) return String is abstract;

   --  Find recursively a match on the given route sub-tree.  The match must start at the position
   --  <tt>First</tt> in the path up to the last path position.  While the path components are
   --  checked, the route context is populated with variable components.  When the full path
   --  matches, <tt>YES_MATCH</tt> is returned in the context gets the route instance.
   procedure Find_Match (Node    : in Route_Node_Type;
                         Path    : in String;
                         First   : in Natural;
                         Match   : out Route_Match_Type;
                         Context : in out Route_Context_Type'Class);

   --  Walk the routes that have been added by <tt>Add_Route</tt> and call the <tt>Process</tt>
   --  procedure with each path pattern and route object.
   procedure Iterate (Node    : in Route_Node_Type;
                      Path    : in String;
                      Process : not null access procedure (Pattern : in String;
                                                           Route   : in Route_Type_Access));

   --  A fixed path component identification.
   type Path_Node_Type (Len : Natural) is new Route_Node_Type with record
      Name : aliased String (1 .. Len);
   end record;
   type Path_Node_Access is access all Path_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns YES_MATCH if the name corresponds exactly to the node's name.
   overriding
   function Matches (Node    : in Path_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, 'Name').
   overriding
   function Get_Pattern (Node : in Path_Node_Type) return String;

   --  A variable path component whose value is injected in an Ada bean using the EL expression.
   --  The route node is created each time an EL expression is found in the route pattern.
   --  Example: /home/#{user.id}/index.html
   --  In this example, the EL expression refers to <tt>user.id</tt>.
   type EL_Node_Type is new Route_Node_Type with record
      Value : EL.Expressions.Value_Expression;
   end record;
   type EL_Node_Access is access all EL_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in EL_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, the EL expr).
   overriding
   function Get_Pattern (Node : in EL_Node_Type) return String;

   --  Inject the parameter that was extracted from the path.
   overriding
   procedure Inject_Parameter (Node      : in EL_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class);

   --  A variable path component which can be injected in an Ada bean.
   --  Example: /home/:id/view.html
   --  The path component represented by <tt>:id</tt> is injected in the Ada bean object
   --  passed to the <tt>Inject_Parameters</tt> procedure.
   type Param_Node_Type (Len : Natural) is new Route_Node_Type with record
      Name : String (1 .. Len);
   end record;
   type Param_Node_Access is access all Param_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in Param_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, Name).
   overriding
   function Get_Pattern (Node : in Param_Node_Type) return String;

   --  Inject the parameter that was extracted from the path.
   overriding
   procedure Inject_Parameter (Node      : in Param_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class);

   type Extension_Node_Type (Len : Natural) is new Route_Node_Type with record
      Ext : String (1 .. Len);
   end record;
   type Extension_Node_Access is access all Extension_Node_Type'Class;

   --  Check if the route node accepts the given extension.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in Extension_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, *.Ext).
   overriding
   function Get_Pattern (Node : in Extension_Node_Type) return String;

   type Wildcard_Node_Type is new Route_Node_Type with null record;
   type Wildcard_Node_Access is access all Wildcard_Node_Type'Class;

   --  Check if the route node accepts the given extension.
   --  Returns WILDCARD_MATCH.
   overriding
   function Matches (Node    : in Wildcard_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, *).
   overriding
   function Get_Pattern (Node : in Wildcard_Node_Type) return String;

   --  Describes a variable path component whose value must be injected in an Ada bean.
   type Route_Param_Type is limited record
      Route : Route_Node_Access;
      First : Natural := 0;
      Last  : Natural := 0;
   end record;

   type Route_Param_Array is array (Positive range <>) of Route_Param_Type;

   MAX_ROUTE_PARAMS : constant Positive := 10;

   type Route_Context_Type is limited new Ada.Finalization.Limited_Controlled with record
      Route  : Route_Type_Access;
      Path   : String_Access;
      Params : Route_Param_Array (1 .. MAX_ROUTE_PARAMS);
      Count  : Natural := 0;
   end record;

   --  Release the storage held by the route context.
   overriding
   procedure Finalize (Context : in out Route_Context_Type);

   type Router_Type is new Ada.Finalization.Limited_Controlled with record
      Route : aliased Path_Node_Type (Len => 0);
   end record;

   --  Release the storage held by the router.
   overriding
   procedure Finalize (Router : in out Router_Type);

end ASF.Routes;

Declare the Get_Path_Info function

Declare the Get_Path_Info function


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

with Wiki.Attributes;
with Wiki.Documents;
with Wiki.Nodes;
with Wiki.Strings;

--  == Filters ==
--  The <b>Wiki.Filters</b> package provides a simple filter framework that allows to plug
--  specific filters when a wiki document is parsed and processed.  The <tt>Filter_Type</tt>
--  implements the <tt>Document_Reader</tt> interface to catch all the wiki document operations
--  and it forwards the different calls to a next wiki document instance.  A filter can do some
--  operations while calls are made so that it can:
--
--  * Get the text content and filter it by looking at forbidden words in some dictionary,
--  * Ignore some formatting construct (for example to forbid the use of links),
--  * Verify and do some corrections on HTML content embedded in wiki text,
--  * Expand some plugins, specific links to complex content.
--
--  To implement a new filter, the <tt>Filter_Type</tt> type must be used as a base type
--  and some of the operations have to be overriden.  The default <tt>Filter_Type</tt> operations
--  just propagate the call to the attached wiki document instance (ie, a kind of pass
--  through filter).
--
package Wiki.Filters is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   --  ------------------------------
   --  Filter type
   --  ------------------------------
   type Filter_Type is new Ada.Finalization.Limited_Controlled with private;
   type Filter_Type_Access is access all Filter_Type'Class;

   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   procedure Add_Node (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind);

   --  Add a text content with the given format to the document.
   procedure Add_Text (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Nodes.Format_Map);

   --  Add a section header with the given level in the document.
   procedure Add_Header (Filter    : in out Filter_Type;
                         Document  : in out Wiki.Nodes.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural);

   --  Push a HTML node with the given tag to the document.
   procedure Push_Node (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Tag        : in Wiki.Nodes.Html_Tag_Type;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type);

   --  Pop a HTML node with the given tag.
   procedure Pop_Node (Filter   : in out Filter_Type;
                       Document : in out Wiki.Nodes.Document;
                        Tag     : in Wiki.Nodes.Html_Tag_Type);

   --  Add a section header in the document.
   procedure Add_Header (Document : in out Filter_Type;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive);

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

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

   --  Add a link.
   procedure Add_Link (Document : in out Filter_Type;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String);

   --  Add an image.
   procedure Add_Image (Document    : in out Filter_Type;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String);

   --  Add a quote.
   procedure Add_Quote (Document : in out Filter_Type;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String);

   --  Add a text block with the given format.
   procedure Add_Text (Document : in out Filter_Type;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Wiki.Documents.Format_Map);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Document : in out Filter_Type;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String);

   procedure Start_Element (Document   : in out Filter_Type;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type);

   procedure End_Element (Document : in out Filter_Type;
                          Name     : in Unbounded_Wide_Wide_String);

   --  Finish the document after complete wiki text has been parsed.
   procedure Finish (Document : in out Filter_Type);

   --  Set the document reader.
   procedure Set_Document (Filter   : in out Filter_Type;
                           Document : in Wiki.Documents.Document_Reader_Access);

private

   type Filter_Type is new Ada.Finalization.Limited_Controlled with record
      Next     : Filter_Type_Access;
      Document : Wiki.Documents.Document_Reader_Access;
   end record;

end Wiki.Filters;

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

with Wiki.Attributes;
with Wiki.Documents;
with Wiki.Nodes;
with Wiki.Strings;

--  == Filters ==
--  The <b>Wiki.Filters</b> package provides a simple filter framework that allows to plug
--  specific filters when a wiki document is parsed and processed.  The <tt>Filter_Type</tt>
--  implements the <tt>Document_Reader</tt> interface to catch all the wiki document operations
--  and it forwards the different calls to a next wiki document instance.  A filter can do some
--  operations while calls are made so that it can:
--
--  * Get the text content and filter it by looking at forbidden words in some dictionary,
--  * Ignore some formatting construct (for example to forbid the use of links),
--  * Verify and do some corrections on HTML content embedded in wiki text,
--  * Expand some plugins, specific links to complex content.
--
--  To implement a new filter, the <tt>Filter_Type</tt> type must be used as a base type
--  and some of the operations have to be overriden.  The default <tt>Filter_Type</tt> operations
--  just propagate the call to the attached wiki document instance (ie, a kind of pass
--  through filter).
--
package Wiki.Filters is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   --  ------------------------------
   --  Filter type
   --  ------------------------------
   type Filter_Type is new Ada.Finalization.Limited_Controlled with private;
   type Filter_Type_Access is access all Filter_Type'Class;

   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   procedure Add_Node (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind);

   --  Add a text content with the given format to the document.
   procedure Add_Text (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Nodes.Format_Map);

   --  Add a section header with the given level in the document.
   procedure Add_Header (Filter    : in out Filter_Type;
                         Document  : in out Wiki.Nodes.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural);

   --  Push a HTML node with the given tag to the document.
   procedure Push_Node (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Tag        : in Wiki.Nodes.Html_Tag_Type;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type);

   --  Pop a HTML node with the given tag.
   procedure Pop_Node (Filter   : in out Filter_Type;
                       Document : in out Wiki.Nodes.Document;
                        Tag     : in Wiki.Nodes.Html_Tag_Type);

   --  Add a section header in the document.
   procedure Add_Header (Document : in out Filter_Type;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive);

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

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

   --  Add a link.
   procedure Add_Link (Document : in out Filter_Type;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String);

   --  Add an image.
   procedure Add_Image (Document    : in out Filter_Type;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String);

   --  Add a quote.
   procedure Add_Quote (Document : in out Filter_Type;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String);

   --  Add a text block with the given format.
   procedure Add_Text (Document : in out Filter_Type;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Wiki.Documents.Format_Map);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Document : in out Filter_Type;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String);

   procedure Start_Element (Document   : in out Filter_Type;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type);

   procedure End_Element (Document : in out Filter_Type;
                          Name     : in Unbounded_Wide_Wide_String);

   --  Finish the document after complete wiki text has been parsed.
   procedure Finish (Document : in out Filter_Type);

private

   type Filter_Type is new Ada.Finalization.Limited_Controlled with record
      Next     : Filter_Type_Access;
   end record;

end Wiki.Filters;

Remove the Set_Document procedure

Remove the Set_Document procedure