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

with ADO;
with ADO.Drivers.Mysql;
with ADO.Schemas.Mysql;
with ADO.Databases;
with ADO.Sessions;
with ADO.Sessions.Factory;
with ADO.Schemas;

with Ada.Text_IO;
with Ada.Strings.Unbounded;
with Ada.Command_Line;

with Util.Log.Loggers;

procedure Pschema is

   use ADO;
   use Ada;
   use Ada.Strings.Unbounded;
   use ADO.Schemas;

   Controller : ADO.Databases.DataSource;
   Factory    : ADO.Sessions.Factory.Session_Factory;

   Verbose : Boolean;

begin
   Util.Log.Loggers.Initialize ("samples.properties");

   --  Initialize the database drivers.
   ADO.Drivers.Initialize ("samples.properties");

   --  Initialize the session factory to connect to the
   --  database defined by 'ado.database' property.
   Factory.Create (ADO.Drivers.Get_Config ("ado.database"));

   declare
      DB     : ADO.Sessions.Master_Session := Factory.Get_Master_Session;
      Schema : ADO.Schemas.Schema_Definition;
      Iter   : Table_Cursor;
   begin
      ADO.Schemas.Mysql.Load_Schema (DB.Get_Connection, Schema);

      --  Dump the database schema using SQL create table forms.
      Iter := Get_Tables (Schema);
      while Has_Element (Iter) loop
         declare
            Table : constant Table_Definition := Element (Iter);
            CITer : Column_Cursor := Get_Columns (Table);
         begin
            Ada.Text_IO.Put_Line ("create table " & Get_Name (Table) & " (");
            while Has_Element (CIter) loop
               declare
                  Col : constant Column_Definition := Element (CIter);
               begin
                  Ada.Text_IO.Put ("  ");
                  Ada.Text_IO.Put (Get_Name (Col));
                  Ada.Text_IO.Put (" ");
                  Ada.Text_IO.Put (Column_Type'Image (Get_Type (Col)));
                  if not Is_Null (Col) then
                     Ada.Text_IO.Put (" not null");
                  end if;
                  Ada.Text_IO.Put_Line (",");
               end;
               Next (CIter);
            end loop;
            Ada.Text_IO.Put_Line (");");
         end;
         Next (Iter);
      end loop;
   end;
end Pschema;

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

with ADO;
with ADO.Schemas.Mysql;
with ADO.Drivers;
with ADO.Sessions;
with ADO.Sessions.Factory;
with ADO.Schemas;

with Ada.Text_IO;

with Util.Log.Loggers;

procedure Pschema is

   use ADO;
   use Ada;
   use ADO.Schemas;

   Factory    : ADO.Sessions.Factory.Session_Factory;

begin
   Util.Log.Loggers.Initialize ("samples.properties");

   --  Initialize the database drivers.
   ADO.Drivers.Initialize ("samples.properties");

   --  Initialize the session factory to connect to the
   --  database defined by 'ado.database' property.
   Factory.Create (ADO.Drivers.Get_Config ("ado.database"));

   declare
      DB     : constant ADO.Sessions.Master_Session := Factory.Get_Master_Session;
      Schema : ADO.Schemas.Schema_Definition;
      Iter   : Table_Cursor;
   begin
      ADO.Schemas.Mysql.Load_Schema (DB.Get_Connection, Schema);

      --  Dump the database schema using SQL create table forms.
      Iter := Get_Tables (Schema);
      while Has_Element (Iter) loop
         declare
            Table      : constant Table_Definition := Element (Iter);
            Table_Iter : Column_Cursor := Get_Columns (Table);
         begin
            Ada.Text_IO.Put_Line ("create table " & Get_Name (Table) & " (");
            while Has_Element (Table_Iter) loop
               declare
                  Col : constant Column_Definition := Element (Table_Iter);
               begin
                  Ada.Text_IO.Put ("  ");
                  Ada.Text_IO.Put (Get_Name (Col));
                  Ada.Text_IO.Put (" ");
                  Ada.Text_IO.Put (Column_Type'Image (Get_Type (Col)));
                  if not Is_Null (Col) then
                     Ada.Text_IO.Put (" not null");
                  end if;
                  Ada.Text_IO.Put_Line (",");
               end;
               Next (Table_Iter);
            end loop;
            Ada.Text_IO.Put_Line (");");
         end;
         Next (Iter);
      end loop;
   end;
end Pschema;

Fix compilation warnings

Fix compilation warnings


-----------------------------------------------------------------------
--  mat-readers-marshaller -- Marshalling of data in communication buffer
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Interfaces;
with System;
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
with Util.Log.Loggers;
package body MAT.Readers.Marshaller is

   use type System.Storage_Elements.Storage_Offset;
   use type Interfaces.Unsigned_32;
   use type Interfaces.Unsigned_64;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Marshaller");

   package Uint8_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint8);

   package Uint32_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint32);

   --  ------------------------------
   --  Get an 8-bit value from the buffer.
   --  ------------------------------
   function Get_Uint8 (Buffer : in Buffer_Ptr) return MAT.Types.Uint8 is
      use Uint8_Access;

      P : constant Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size = 0 then
         Log.Error ("Not enough data to get a uint8");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 1;
      Buffer.Current := Buffer.Current + System.Storage_Elements.Storage_Offset (1);
      return P.all;
   end Get_Uint8;

   --  ------------------------------
   --  Get a 16-bit value either from big-endian or little endian.
   --  ------------------------------
   function Get_Uint16 (Buffer : in Buffer_Ptr) return MAT.Types.Uint16 is
      use Uint8_Access;

      High : Object_Pointer;
      Low  : Object_Pointer;
   begin
      if Buffer.Size <= 1 then
         Log.Error ("Not enough data to get a uint16");
         raise Buffer_Underflow_Error;
      end if;
      if Buffer.Endian = LITTLE_ENDIAN then
         Low  := To_Pointer (Buffer.Current);
         High := To_Pointer (Buffer.Current + System.Storage_Elements.Storage_Offset (1));
      else
         High := To_Pointer (Buffer.Current);
         Low  := To_Pointer (Buffer.Current + System.Storage_Elements.Storage_Offset (1));
      end if;
      Buffer.Size := Buffer.Size - 2;
      Buffer.Current := Buffer.Current + System.Storage_Elements.Storage_Offset (2);
      return MAT.Types.Uint16 (High.all) * 256 + MAT.Types.Uint16 (Low.all);
   end Get_Uint16;

   --  ------------------------------
   --  Get a 32-bit value either from big-endian or little endian.
   --  ------------------------------
   function Get_Uint32 (Buffer : in Buffer_Ptr) return MAT.Types.Uint32 is
      use Uint32_Access;

      Low, High : MAT.Types.Uint16;
   begin
      if Buffer.Size < 4 then
         Log.Error ("Not enough data to get a uint32");
         raise Buffer_Underflow_Error;
      end if;
      if Buffer.Endian = LITTLE_ENDIAN then
         Low  := Get_Uint16 (Buffer);
         High := Get_Uint16 (Buffer);
      else
         High := Get_Uint16 (Buffer);
         Low  := Get_Uint16 (Buffer);
      end if;
      return Interfaces.Shift_Left (MAT.Types.Uint32 (High), 16) + MAT.Types.Uint32 (Low);
   end Get_Uint32;

   --  ------------------------------
   --  Get a 64-bit value either from big-endian or little endian.
   --  ------------------------------
   function Get_Uint64 (Buffer : in Buffer_Ptr) return MAT.Types.Uint64 is
      Low : MAT.Types.Uint32;
      High : MAT.Types.Uint32;
   begin
      if Buffer.Endian = LITTLE_ENDIAN then
         Low := Get_Uint32 (Buffer);
         High := Get_Uint32 (Buffer);
      else
         High := Get_Uint32 (Buffer);
         Low  := Get_Uint32 (Buffer);
      end if;
      return Interfaces.Shift_Left (MAT.Types.Uint64 (High), 32) + MAT.Types.Uint64 (Low);
   end Get_Uint64;

   function Get_Target_Value (Msg  : in Message_Type;
                              Kind : in MAT.Events.Attribute_Type) return Target_Type is
   begin
      case Kind is
         when MAT.Events.T_UINT8 =>
            return Target_Type (Get_Uint8 (Msg.Buffer));

         when MAT.Events.T_UINT16 =>
            return Target_Type (Get_Uint16 (Msg.Buffer));

         when MAT.Events.T_UINT32 =>
            return Target_Type (Get_Uint32 (Msg.Buffer));

         when MAT.Events.T_UINT64 =>
            return Target_Type (Get_Uint64 (Msg.Buffer));

         when others =>
            Log.Error ("Invalid attribute type {0}",
                       MAT.Events.Attribute_Type'Image (Kind));
            return 0;
      end case;
   end Get_Target_Value;

   --  ------------------------------
   --  Extract a string from the buffer.  The string starts with a byte that
   --  indicates the string length.
   --  ------------------------------
   function Get_String (Buffer : in Message_Type) return String is
      Len    : constant MAT.Types.Uint16 := Get_Uint16 (Buffer.Buffer);
      Result : String (1 .. Natural (Len));
   begin
      for I in Result'Range loop
         Result (I) := Character'Val (Get_Uint8 (Buffer.Buffer));
      end loop;
      return Result;
   end Get_String;

   --  ------------------------------
   --  Extract a string from the buffer.  The string starts with a byte that
   --  indicates the string length.
   --  ------------------------------
   function Get_String (Msg : in Message_Type) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return Ada.Strings.Unbounded.To_Unbounded_String (Get_String (Msg));
   end Get_String;

   --  ------------------------------
   --  Skip the given number of bytes from the message.
   --  ------------------------------
   procedure Skip (Buffer : in Message_Type;
                   Size   : in Natural) is
   begin
      Buffer.Buffer.Size := Buffer.Buffer.Size - Size;
      Buffer.Buffer.Current := Buffer.Buffer.Current + System.Storage_Elements.Storage_Offset (Size);
   end Skip;

   function Get_Target_Size (Msg  : in Message_Type;
                             Kind : in MAT.Events.Attribute_Type) return MAT.Types.Target_Size is
         function Get_Value is new Get_Target_Value (MAT.Types.Target_Size);
   begin
      return Get_Value (Msg, Kind);
   end Get_Target_Size;

   function Get_Target_Addr (Msg  : in Message_Type;
                             Kind : in MAT.Events.Attribute_Type) return MAT.Types.Target_Addr is
         function Get_Value is new Get_Target_Value (MAT.Types.Target_Addr);
   begin
      return Get_Value (Msg, Kind);
   end Get_Target_Addr;

   function Get_Target_Uint32 (Msg  : in Message_Type;
                               Kind : in MAT.Events.Attribute_Type) return MAT.Types.Uint32 is
      function Get_Value is new Get_Target_Value (MAT.Types.Target_Addr);
   begin
      return Get_Value (Msg, Kind);
   end Get_Target_Uint32;

end MAT.Readers.Marshaller;

-----------------------------------------------------------------------
--  mat-readers-marshaller -- Marshalling of data in communication buffer
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Interfaces;
with System;
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
with Util.Log.Loggers;
package body MAT.Readers.Marshaller is

   use type System.Storage_Elements.Storage_Offset;
   use type Interfaces.Unsigned_32;
   use type Interfaces.Unsigned_64;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Marshaller");

   package Uint8_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint8);

   package Uint32_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint32);

   --  ------------------------------
   --  Get an 8-bit value from the buffer.
   --  ------------------------------
   function Get_Uint8 (Buffer : in Buffer_Ptr) return MAT.Types.Uint8 is
      use Uint8_Access;

      P : constant Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size = 0 then
         Log.Error ("Not enough data to get a uint8");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 1;
      Buffer.Current := Buffer.Current + System.Storage_Elements.Storage_Offset (1);
      return P.all;
   end Get_Uint8;

   --  ------------------------------
   --  Get a 16-bit value either from big-endian or little endian.
   --  ------------------------------
   function Get_Uint16 (Buffer : in Buffer_Ptr) return MAT.Types.Uint16 is
      use Uint8_Access;
      use type Interfaces.Unsigned_16;

      High : Object_Pointer;
      Low  : Object_Pointer;
   begin
      if Buffer.Size <= 1 then
         Log.Error ("Not enough data to get a uint16");
         raise Buffer_Underflow_Error;
      end if;
      if Buffer.Endian = LITTLE_ENDIAN then
         Low  := To_Pointer (Buffer.Current);
         High := To_Pointer (Buffer.Current + System.Storage_Elements.Storage_Offset (1));
      else
         High := To_Pointer (Buffer.Current);
         Low  := To_Pointer (Buffer.Current + System.Storage_Elements.Storage_Offset (1));
      end if;
      Buffer.Size := Buffer.Size - 2;
      Buffer.Current := Buffer.Current + System.Storage_Elements.Storage_Offset (2);
      return MAT.Types.Uint16 (High.all) * 256 + MAT.Types.Uint16 (Low.all);
   end Get_Uint16;

   --  ------------------------------
   --  Get a 32-bit value either from big-endian or little endian.
   --  ------------------------------
   function Get_Uint32 (Buffer : in Buffer_Ptr) return MAT.Types.Uint32 is
      use Uint32_Access;

      Low, High : MAT.Types.Uint16;
   begin
      if Buffer.Size < 4 then
         Log.Error ("Not enough data to get a uint32");
         raise Buffer_Underflow_Error;
      end if;
      if Buffer.Endian = LITTLE_ENDIAN then
         Low  := Get_Uint16 (Buffer);
         High := Get_Uint16 (Buffer);
      else
         High := Get_Uint16 (Buffer);
         Low  := Get_Uint16 (Buffer);
      end if;
      return Interfaces.Shift_Left (MAT.Types.Uint32 (High), 16) + MAT.Types.Uint32 (Low);
   end Get_Uint32;

   --  ------------------------------
   --  Get a 64-bit value either from big-endian or little endian.
   --  ------------------------------
   function Get_Uint64 (Buffer : in Buffer_Ptr) return MAT.Types.Uint64 is
      Low : MAT.Types.Uint32;
      High : MAT.Types.Uint32;
   begin
      if Buffer.Endian = LITTLE_ENDIAN then
         Low := Get_Uint32 (Buffer);
         High := Get_Uint32 (Buffer);
      else
         High := Get_Uint32 (Buffer);
         Low  := Get_Uint32 (Buffer);
      end if;
      return Interfaces.Shift_Left (MAT.Types.Uint64 (High), 32) + MAT.Types.Uint64 (Low);
   end Get_Uint64;

   function Get_Target_Value (Msg  : in Message_Type;
                              Kind : in MAT.Events.Attribute_Type) return Target_Type is
   begin
      case Kind is
         when MAT.Events.T_UINT8 =>
            return Target_Type (Get_Uint8 (Msg.Buffer));

         when MAT.Events.T_UINT16 =>
            return Target_Type (Get_Uint16 (Msg.Buffer));

         when MAT.Events.T_UINT32 =>
            return Target_Type (Get_Uint32 (Msg.Buffer));

         when MAT.Events.T_UINT64 =>
            return Target_Type (Get_Uint64 (Msg.Buffer));

         when others =>
            Log.Error ("Invalid attribute type {0}",
                       MAT.Events.Attribute_Type'Image (Kind));
            return 0;
      end case;
   end Get_Target_Value;

   --  ------------------------------
   --  Extract a string from the buffer.  The string starts with a byte that
   --  indicates the string length.
   --  ------------------------------
   function Get_String (Buffer : in Message_Type) return String is
      Len    : constant MAT.Types.Uint16 := Get_Uint16 (Buffer.Buffer);
      Result : String (1 .. Natural (Len));
   begin
      for I in Result'Range loop
         Result (I) := Character'Val (Get_Uint8 (Buffer.Buffer));
      end loop;
      return Result;
   end Get_String;

   --  ------------------------------
   --  Extract a string from the buffer.  The string starts with a byte that
   --  indicates the string length.
   --  ------------------------------
   function Get_String (Msg : in Message_Type) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return Ada.Strings.Unbounded.To_Unbounded_String (Get_String (Msg));
   end Get_String;

   --  ------------------------------
   --  Skip the given number of bytes from the message.
   --  ------------------------------
   procedure Skip (Buffer : in Message_Type;
                   Size   : in Natural) is
   begin
      Buffer.Buffer.Size := Buffer.Buffer.Size - Size;
      Buffer.Buffer.Current := Buffer.Buffer.Current + System.Storage_Elements.Storage_Offset (Size);
   end Skip;

   function Get_Target_Size (Msg  : in Message_Type;
                             Kind : in MAT.Events.Attribute_Type) return MAT.Types.Target_Size is
         function Get_Value is new Get_Target_Value (MAT.Types.Target_Size);
   begin
      return Get_Value (Msg, Kind);
   end Get_Target_Size;

   function Get_Target_Addr (Msg  : in Message_Type;
                             Kind : in MAT.Events.Attribute_Type) return MAT.Types.Target_Addr is
         function Get_Value is new Get_Target_Value (MAT.Types.Target_Addr);
   begin
      return Get_Value (Msg, Kind);
   end Get_Target_Addr;

   function Get_Target_Uint32 (Msg  : in Message_Type;
                               Kind : in MAT.Events.Attribute_Type) return MAT.Types.Uint32 is
      function Get_Value is new Get_Target_Value (MAT.Types.Target_Addr);
   begin
      return Get_Value (Msg, Kind);
   end Get_Target_Uint32;

end MAT.Readers.Marshaller;

Fix compilation

Fix compilation


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

with Util.Tests;
with AWA.Tests;
with ADO;

package AWA.Wikis.Modules.Tests is

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

   type Test is new AWA.Tests.Test with record
      Manager    : AWA.Wikis.Modules.Wiki_Module_Access;
      Wiki_Id    : ADO.Identifier := ADO.NO_IDENTIFIER;
      Public_Id  : ADO.Identifier := ADO.NO_IDENTIFIER;
      Private_Id : ADO.Identifier := ADO.NO_IDENTIFIER;
   end record;

   --  Test creation of a wiki space.
   procedure Test_Create_Wiki_Space (T : in out Test);

   --  Test creation of a wiki page.
   procedure Test_Create_Wiki_Page (T : in out Test);

   --  Test creation of a wiki page content.
   procedure Test_Create_Wiki_Content (T : in out Test);

   procedure Test_Wiki_Page (T : in out Test);

end AWA.Wikis.Modules.Tests;

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

with Util.Tests;
with AWA.Tests;
with ADO;

package AWA.Wikis.Modules.Tests is

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

   type Test is new AWA.Tests.Test with record
      Manager    : AWA.Wikis.Modules.Wiki_Module_Access;
      Wiki_Id    : ADO.Identifier := ADO.NO_IDENTIFIER;
      Public_Id  : ADO.Identifier := ADO.NO_IDENTIFIER;
      Private_Id : ADO.Identifier := ADO.NO_IDENTIFIER;
   end record;

   --  Test creation of a wiki space.
   procedure Test_Create_Wiki_Space (T : in out Test);

   --  Test creation of a wiki page.
   procedure Test_Create_Wiki_Page (T : in out Test);

   --  Test creation of a wiki page content.
   procedure Test_Create_Wiki_Content (T : in out Test);

   --  Test getting the wiki page as well as info, history pages.
   procedure Test_Wiki_Page (T : in out Test);

end AWA.Wikis.Modules.Tests;

Add some documentation

Add some documentation


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

with Gen.Configs;
with Gen.Utils;
with Gen.Model.Tables;
with Gen.Model.Queries;
with Gen.Model.Mappings;
with Gen.Model.Operations;

with Util.Log.Loggers;
with Util.Encoders.HMAC.SHA1;

--  The Gen.Artifacts.Query package is an artifact for the generation of
--  data structures returned by queries.
package body Gen.Artifacts.Query is

   use Ada.Strings.Unbounded;
   use Gen.Model;
   use Gen.Model.Tables;
   use Gen.Model.Queries;
   use Gen.Configs;

   use type DOM.Core.Node;
   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Artifacts.Query");

   --  ------------------------------
   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   --  ------------------------------
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class) is

      procedure Register_Sort (Query  : in out Query_Definition;
                               Node   : in DOM.Core.Node);

      procedure Register_Sorts (Query : in out Query_Definition;
                                Node  : in DOM.Core.Node);

      procedure Register_Column (Table  : in out Query_Definition;
                                 Column : in DOM.Core.Node);

      procedure Register_Columns (Table : in out Query_Definition;
                                  Node  : in DOM.Core.Node);

      procedure Register_Operation (Table : in out Query_Definition;
                                    Node  : in DOM.Core.Node);

      procedure Register_Operations (Table : in out Query_Definition;
                                     Node  : in DOM.Core.Node);

      procedure Register_Mapping (Query : in out Gen.Model.Queries.Query_File_Definition;
                                  Node  : in DOM.Core.Node);

      procedure Register_Mapping (Model : in out Gen.Model.Packages.Model_Definition;
                                  Node  : in DOM.Core.Node);

      procedure Register_Query (Query : in out Gen.Model.Queries.Query_File_Definition;
                                Node  : in DOM.Core.Node);

      Hash : Unbounded_String;

      --  ------------------------------
      --  Register the method definition in the table
      --  ------------------------------
      procedure Register_Operation (Table  : in out Query_Definition;
                                    Node   : in DOM.Core.Node) is
         Name      : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "name");
         Operation : Gen.Model.Operations.Operation_Definition_Access;
      begin
         Table.Add_Operation (Name, Operation);
      end Register_Operation;

      --  ------------------------------
      --  Register all the operations defined in the table
      --  ------------------------------
      procedure Register_Operations (Table : in out Query_Definition;
                                     Node  : in DOM.Core.Node) is
         procedure Iterate is new Gen.Utils.Iterate_Nodes (T       => Query_Definition,
                                                           Process => Register_Operation);
      begin
         Log.Debug ("Register operations from bean {0}", Table.Name);

         Iterate (Table, Node, "method");
      end Register_Operations;

      --  ------------------------------
      --  Register the column definition in the table
      --  ------------------------------
      procedure Register_Column (Table  : in out Query_Definition;
                                 Column : in DOM.Core.Node) is
         Name  : constant Unbounded_String := Gen.Utils.Get_Attribute (Column, "name");
         C     : Column_Definition_Access;
      begin
         Table.Add_Column (Name, C);
         C.Initialize (Name, Column);

         C.Type_Name := To_Unbounded_String (Gen.Utils.Get_Normalized_Type (Column, "type"));

         C.Is_Inserted := False;
         C.Is_Updated  := Gen.Utils.Get_Attribute (Column, "update", True);
         C.Not_Null    := Gen.Utils.Get_Attribute (Column, "not-null", False);
         C.Unique      := False;

         --  Construct the hash for this column mapping.
         Append (Hash, ",type=");
         Append (Hash, C.Type_Name);
         Append (Hash, ",name=");
         Append (Hash, Name);
      end Register_Column;

      --  ------------------------------
      --  Register all the columns defined in the table
      --  ------------------------------
      procedure Register_Columns (Table : in out Query_Definition;
                                  Node  : in DOM.Core.Node) is
         procedure Iterate is new Gen.Utils.Iterate_Nodes (T       => Query_Definition,
                                                           Process => Register_Column);
      begin
         Log.Debug ("Register columns from query {0}", Table.Name);

         Iterate (Table, Node, "property");
      end Register_Columns;

      --  ------------------------------
      --  Register the sort definition in the query
      --  ------------------------------
      procedure Register_Sort (Query  : in out Query_Definition;
                               Node   : in DOM.Core.Node) is
         Name : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "name");
         Sql  : constant String := Gen.Utils.Get_Data_Content (Node);
      begin
         Query.Add_Sort (Name, To_Unbounded_String (Sql));
      end Register_Sort;

      --  ------------------------------
      --  Register all the sort modes defined in the query
      --  ------------------------------
      procedure Register_Sorts (Query : in out Query_Definition;
                                Node  : in DOM.Core.Node) is
         procedure Iterate is new Gen.Utils.Iterate_Nodes (T       => Query_Definition,
                                                           Process => Register_Sort);
      begin
         Log.Debug ("Register sorts from query {0}", Query.Name);

         Iterate (Query, Node, "order");
      end Register_Sorts;

      --  ------------------------------
      --  Register a new class definition in the model.
      --  ------------------------------
      procedure Register_Mapping (Query : in out Gen.Model.Queries.Query_File_Definition;
                                  Node  : in DOM.Core.Node) is
         Name  : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "name");
      begin
         Query.Initialize (Name, Node);
         Query.Set_Table_Name (To_String (Name));

         if Name /= "" then
            Query.Name := Name;
         else
            Query.Name := To_Unbounded_String (Gen.Utils.Get_Query_Name (Path));
         end if;

         --  Construct the hash for this column mapping.
         Append (Hash, "class=");
         Append (Hash, Query.Name);

         Log.Debug ("Register query {0} with type {1}", Query.Name, Query.Type_Name);
         Register_Columns (Query_Definition (Query), Node);
         Register_Operations (Query_Definition (Query), Node);
      end Register_Mapping;

      --  ------------------------------
      --  Register a new query.
      --  ------------------------------
      procedure Register_Query (Query : in out Gen.Model.Queries.Query_File_Definition;
                                Node  : in DOM.Core.Node) is
         Name : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "name");
         C    : Gen.Model.Queries.Query_Definition_Access;
      begin
         Query.Add_Query (Name, C);
         Register_Sorts (Query_Definition (C.all), Node);
      end Register_Query;

      --  ------------------------------
      --  Register a model mapping
      --  ------------------------------
      procedure Register_Mapping (Model : in out Gen.Model.Packages.Model_Definition;
                                  Node  : in DOM.Core.Node) is
         procedure Iterate_Mapping is
           new Gen.Utils.Iterate_Nodes (T => Gen.Model.Queries.Query_File_Definition,
                                        Process => Register_Mapping);
         procedure Iterate_Query is
           new Gen.Utils.Iterate_Nodes (T => Gen.Model.Queries.Query_File_Definition,
                                        Process => Register_Query);

         Table : constant Query_File_Definition_Access := new Query_File_Definition;
         Pkg   : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "package");
         Name  : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "table");
      begin
         Table.Initialize (Name, Node);
         Table.File_Name := To_Unbounded_String (Ada.Directories.Simple_Name (Path));
         Table.Pkg_Name  := Pkg;
         Iterate_Mapping (Query_File_Definition (Table.all), Node, "class");
         Iterate_Query (Query_File_Definition (Table.all), Node, "query");
         if Length (Table.Pkg_Name) = 0 then
            Context.Error ("Missing or empty package attribute");
         else
            Model.Register_Query (Table);
         end if;

         Log.Info ("Query hash for {0} is {1}", Path, To_String (Hash));
         Table.Sha1 := Util.Encoders.HMAC.SHA1.Sign (Key  => "ADO.Queries",
                                                     Data => To_String (Hash));
      end Register_Mapping;

      procedure Iterate is new Gen.Utils.Iterate_Nodes (T => Gen.Model.Packages.Model_Definition,
                                                        Process => Register_Mapping);

   begin
      Log.Debug ("Initializing query artifact for the configuration");

      Gen.Artifacts.Artifact (Handler).Initialize (Path, Node, Model, Context);
      Iterate (Gen.Model.Packages.Model_Definition (Model), Node, "query-mapping");
   end Initialize;

   --  ------------------------------
   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   --  ------------------------------
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class) is
      pragma Unreferenced (Handler);
   begin
      Log.Debug ("Preparing the model for query");

      if Model.Has_Packages then
         Context.Add_Generation (Name => GEN_PACKAGE_SPEC, Mode => ITERATION_PACKAGE,
                                 Mapping => Gen.Model.Mappings.ADA_MAPPING);
         Context.Add_Generation (Name => GEN_PACKAGE_BODY, Mode => ITERATION_PACKAGE,
                                 Mapping => Gen.Model.Mappings.ADA_MAPPING);
      end if;
   end Prepare;

end Gen.Artifacts.Query;

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

with Gen.Configs;
with Gen.Utils;
with Gen.Model.Tables;
with Gen.Model.Queries;
with Gen.Model.Mappings;
with Gen.Model.Operations;

with Util.Log.Loggers;
with Util.Encoders.HMAC.SHA1;

--  The Gen.Artifacts.Query package is an artifact for the generation of
--  data structures returned by queries.
package body Gen.Artifacts.Query is

   use Ada.Strings.Unbounded;
   use Gen.Model;
   use Gen.Model.Tables;
   use Gen.Model.Queries;
   use Gen.Configs;

   use type DOM.Core.Node;
   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Artifacts.Query");

   --  ------------------------------
   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   --  ------------------------------
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class) is

      procedure Register_Sort (Query  : in out Query_Definition;
                               Node   : in DOM.Core.Node);

      procedure Register_Sorts (Query : in out Query_Definition;
                                Node  : in DOM.Core.Node);

      procedure Register_Column (Table  : in out Query_Definition;
                                 Column : in DOM.Core.Node);

      procedure Register_Columns (Table : in out Query_Definition;
                                  Node  : in DOM.Core.Node);

      procedure Register_Operation (Table : in out Query_Definition;
                                    Node  : in DOM.Core.Node);

      procedure Register_Operations (Table : in out Query_Definition;
                                     Node  : in DOM.Core.Node);

      procedure Register_Mapping (Query : in out Gen.Model.Queries.Query_File_Definition;
                                  Node  : in DOM.Core.Node);

      procedure Register_Mapping (Model : in out Gen.Model.Packages.Model_Definition;
                                  Node  : in DOM.Core.Node);

      procedure Register_Query (Query : in out Gen.Model.Queries.Query_File_Definition;
                                Node  : in DOM.Core.Node);

      Hash : Unbounded_String;

      --  ------------------------------
      --  Register the method definition in the table
      --  ------------------------------
      procedure Register_Operation (Table  : in out Query_Definition;
                                    Node   : in DOM.Core.Node) is
         Name      : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "name");
         Operation : Gen.Model.Operations.Operation_Definition_Access;
      begin
         Table.Add_Operation (Name, Operation);
      end Register_Operation;

      --  ------------------------------
      --  Register all the operations defined in the table
      --  ------------------------------
      procedure Register_Operations (Table : in out Query_Definition;
                                     Node  : in DOM.Core.Node) is
         procedure Iterate is new Gen.Utils.Iterate_Nodes (T       => Query_Definition,
                                                           Process => Register_Operation);
      begin
         Log.Debug ("Register operations from bean {0}", Table.Name);

         Iterate (Table, Node, "method");
      end Register_Operations;

      --  ------------------------------
      --  Register the column definition in the table
      --  ------------------------------
      procedure Register_Column (Table  : in out Query_Definition;
                                 Column : in DOM.Core.Node) is
         Name  : constant Unbounded_String := Gen.Utils.Get_Attribute (Column, "name");
         C     : Column_Definition_Access;
      begin
         Table.Add_Column (Name, C);
         C.Initialize (Name, Column);

         C.Type_Name := To_Unbounded_String (Gen.Utils.Get_Normalized_Type (Column, "type"));

         C.Is_Inserted := False;
         C.Is_Updated  := Gen.Utils.Get_Attribute (Column, "update", True);
         C.Not_Null    := Gen.Utils.Get_Attribute (Column, "not-null", True);
         C.Unique      := False;

         --  Construct the hash for this column mapping.
         Append (Hash, ",type=");
         Append (Hash, C.Type_Name);
         Append (Hash, ",name=");
         Append (Hash, Name);
      end Register_Column;

      --  ------------------------------
      --  Register all the columns defined in the table
      --  ------------------------------
      procedure Register_Columns (Table : in out Query_Definition;
                                  Node  : in DOM.Core.Node) is
         procedure Iterate is new Gen.Utils.Iterate_Nodes (T       => Query_Definition,
                                                           Process => Register_Column);
      begin
         Log.Debug ("Register columns from query {0}", Table.Name);

         Iterate (Table, Node, "property");
      end Register_Columns;

      --  ------------------------------
      --  Register the sort definition in the query
      --  ------------------------------
      procedure Register_Sort (Query  : in out Query_Definition;
                               Node   : in DOM.Core.Node) is
         Name : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "name");
         Sql  : constant String := Gen.Utils.Get_Data_Content (Node);
      begin
         Query.Add_Sort (Name, To_Unbounded_String (Sql));
      end Register_Sort;

      --  ------------------------------
      --  Register all the sort modes defined in the query
      --  ------------------------------
      procedure Register_Sorts (Query : in out Query_Definition;
                                Node  : in DOM.Core.Node) is
         procedure Iterate is new Gen.Utils.Iterate_Nodes (T       => Query_Definition,
                                                           Process => Register_Sort);
      begin
         Log.Debug ("Register sorts from query {0}", Query.Name);

         Iterate (Query, Node, "order");
      end Register_Sorts;

      --  ------------------------------
      --  Register a new class definition in the model.
      --  ------------------------------
      procedure Register_Mapping (Query : in out Gen.Model.Queries.Query_File_Definition;
                                  Node  : in DOM.Core.Node) is
         Name  : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "name");
      begin
         Query.Initialize (Name, Node);
         Query.Set_Table_Name (To_String (Name));

         if Name /= "" then
            Query.Name := Name;
         else
            Query.Name := To_Unbounded_String (Gen.Utils.Get_Query_Name (Path));
         end if;

         --  Construct the hash for this column mapping.
         Append (Hash, "class=");
         Append (Hash, Query.Name);

         Log.Debug ("Register query {0} with type {1}", Query.Name, Query.Type_Name);
         Register_Columns (Query_Definition (Query), Node);
         Register_Operations (Query_Definition (Query), Node);
      end Register_Mapping;

      --  ------------------------------
      --  Register a new query.
      --  ------------------------------
      procedure Register_Query (Query : in out Gen.Model.Queries.Query_File_Definition;
                                Node  : in DOM.Core.Node) is
         Name : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "name");
         C    : Gen.Model.Queries.Query_Definition_Access;
      begin
         Query.Add_Query (Name, C);
         Register_Sorts (Query_Definition (C.all), Node);
      end Register_Query;

      --  ------------------------------
      --  Register a model mapping
      --  ------------------------------
      procedure Register_Mapping (Model : in out Gen.Model.Packages.Model_Definition;
                                  Node  : in DOM.Core.Node) is
         procedure Iterate_Mapping is
           new Gen.Utils.Iterate_Nodes (T => Gen.Model.Queries.Query_File_Definition,
                                        Process => Register_Mapping);
         procedure Iterate_Query is
           new Gen.Utils.Iterate_Nodes (T => Gen.Model.Queries.Query_File_Definition,
                                        Process => Register_Query);

         Table : constant Query_File_Definition_Access := new Query_File_Definition;
         Pkg   : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "package");
         Name  : constant Unbounded_String := Gen.Utils.Get_Attribute (Node, "table");
      begin
         Table.Initialize (Name, Node);
         Table.File_Name := To_Unbounded_String (Ada.Directories.Simple_Name (Path));
         Table.Pkg_Name  := Pkg;
         Iterate_Mapping (Query_File_Definition (Table.all), Node, "class");
         Iterate_Query (Query_File_Definition (Table.all), Node, "query");
         if Length (Table.Pkg_Name) = 0 then
            Context.Error ("Missing or empty package attribute");
         else
            Model.Register_Query (Table);
         end if;

         Log.Info ("Query hash for {0} is {1}", Path, To_String (Hash));
         Table.Sha1 := Util.Encoders.HMAC.SHA1.Sign (Key  => "ADO.Queries",
                                                     Data => To_String (Hash));
      end Register_Mapping;

      procedure Iterate is new Gen.Utils.Iterate_Nodes (T => Gen.Model.Packages.Model_Definition,
                                                        Process => Register_Mapping);

   begin
      Log.Debug ("Initializing query artifact for the configuration");

      Gen.Artifacts.Artifact (Handler).Initialize (Path, Node, Model, Context);
      Iterate (Gen.Model.Packages.Model_Definition (Model), Node, "query-mapping");
   end Initialize;

   --  ------------------------------
   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   --  ------------------------------
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class) is
      pragma Unreferenced (Handler);
   begin
      Log.Debug ("Preparing the model for query");

      if Model.Has_Packages then
         Context.Add_Generation (Name => GEN_PACKAGE_SPEC, Mode => ITERATION_PACKAGE,
                                 Mapping => Gen.Model.Mappings.ADA_MAPPING);
         Context.Add_Generation (Name => GEN_PACKAGE_BODY, Mode => ITERATION_PACKAGE,
                                 Mapping => Gen.Model.Mappings.ADA_MAPPING);
      end if;
   end Prepare;

end Gen.Artifacts.Query;

Fix the default configuration for the not-null query column type


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

with GNAT.Sockets;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Events.Targets;
with MAT.Events.Probes;
with MAT.Readers;
with MAT.Readers.Streams;
with MAT.Readers.Streams.Sockets;
with MAT.Consoles;
package MAT.Targets is

   pragma Preelaborate_Body;

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      --  Enable and enter in the interactive TTY console mode.
      Interactive  : Boolean := True;

      --  Try to load the symbol file automatically when a new process is received.
      Load_Symbols : Boolean := True;

      --  Enable the graphical mode (when available).
      Graphical    : Boolean := False;

      --  Print the events as they are received.
      Print_Events : Boolean := False;

      --  Define the server listening address.
      Address      : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   type Target_Process_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols_Ref;
      Events  : MAT.Events.Targets.Target_Events_Access;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Set the console instance.
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access);

   --  Get the current process instance.
   function Process (Target : in Target_Type) return Target_Process_Type_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   overriding
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class));

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out Target_Type);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type);

   --  Start the server to listen to MAT event socket streams.
   procedure Start (Target : in out Target_Type);

   --  Stop the server thread.
   procedure Stop (Target : in out Target_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with record
      Current   : Target_Process_Type_Access;
      Processes : Process_Map;
      Console   : MAT.Consoles.Console_Access;
      Options   : Options_Type;
      Server    : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   end record;

end MAT.Targets;

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

with GNAT.Sockets;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Events.Targets;
with MAT.Events.Probes;
with MAT.Readers;
with MAT.Readers.Streams;
with MAT.Readers.Streams.Sockets;
with MAT.Consoles;
package MAT.Targets is

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      --  Enable and enter in the interactive TTY console mode.
      Interactive  : Boolean := True;

      --  Try to load the symbol file automatically when a new process is received.
      Load_Symbols : Boolean := True;

      --  Enable the graphical mode (when available).
      Graphical    : Boolean := False;

      --  Print the events as they are received.
      Print_Events : Boolean := False;

      --  Define the server listening address.
      Address      : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   type Target_Process_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Endian  : MAT.Readers.Endian_Type := MAT.Readers.LITTLE_ENDIAN;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols_Ref;
      Events  : MAT.Events.Targets.Target_Events_Access;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Set the console instance.
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access);

   --  Get the current process instance.
   function Process (Target : in Target_Type) return Target_Process_Type_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   overriding
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class));

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out Target_Type);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type);

   --  Start the server to listen to MAT event socket streams.
   procedure Start (Target : in out Target_Type);

   --  Stop the server thread.
   procedure Stop (Target : in out Target_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with record
      Current   : Target_Process_Type_Access;
      Processes : Process_Map;
      Console   : MAT.Consoles.Console_Access;
      Options   : Options_Type;
      Server    : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   end record;

end MAT.Targets;

Add the Endian member in the Target_Process_Type


-----------------------------------------------------------------------
--  ado-utils -- Utility operations for ADO
--  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.
-----------------------------------------------------------------------

package body ADO.Utils is

   --  ------------------------------
   --  Build a bean object from the identifier.
   --  ------------------------------
   function To_Object (Id : in ADO.Identifier) return Util.Beans.Objects.Object is
   begin
      if Id = ADO.NO_IDENTIFIER then
         return Util.Beans.Objects.Null_Object;
      else
         return Util.Beans.Objects.To_Object (Long_Long_Integer (Id));
      end if;
   end To_Object;

   --  ------------------------------
   --  Build the identifier from the bean object.
   --  ------------------------------
   function To_Identifier (Value : in Util.Beans.Objects.Object) return ADO.Identifier is
   begin
      if Util.Beans.Objects.Is_Null (Value) then
         return ADO.NO_IDENTIFIER;
      else
         return ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Value));
      end if;
   end To_Identifier;

end ADO.Utils;

-----------------------------------------------------------------------
--  ado-utils -- Utility operations for ADO
--  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.
-----------------------------------------------------------------------

package body ADO.Utils is

   --  ------------------------------
   --  Build a bean object from the identifier.
   --  ------------------------------
   function To_Object (Id : in ADO.Identifier) return Util.Beans.Objects.Object is
   begin
      if Id = ADO.NO_IDENTIFIER then
         return Util.Beans.Objects.Null_Object;
      else
         return Util.Beans.Objects.To_Object (Long_Long_Integer (Id));
      end if;
   end To_Object;

   --  ------------------------------
   --  Build the identifier from the bean object.
   --  ------------------------------
   function To_Identifier (Value : in Util.Beans.Objects.Object) return ADO.Identifier is
   begin
      if Util.Beans.Objects.Is_Null (Value) then
         return ADO.NO_IDENTIFIER;
      else
         return ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Value));
      end if;
   end To_Identifier;

   --  ------------------------------
   --  Compute the hash of the identifier.
   --  ------------------------------
   function Hash (Key : in ADO.Identifier) return Ada.Containers.Hash_Type is
      use Ada.Containers;
   begin

      if Key < 0 then
         return Hash_Type (-Key);
      else
         return Hash_Type (Key);
      end if;
   end Hash;

end ADO.Utils;

Implement the Hash operation

Implement the Hash operation


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

with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;

with Util.Refs;
with Util.Strings;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

--  == URL Security Policy ==
--  The <tt>Security.Policies.Urls</tt> implements a security policy intended to be used
--  in web servers.
--
--  === Policy creation ===
--  An instance of the <tt>URL_Policy</tt> must be created and registered in the policy manager.
--  Get or declare the following variables:
--
--    Manager : Security.Policies.Policy_Manager;
--    Policy  : Security.Policies.Urls.URL_Policy_Access;
--
--  Create the URL policy and register it in the policy manager as follows:
--
--    Policy := new URL_Policy;
--    Manager.Add_Policy (Policy.all'Access);
--
--  === Policy Configuration ===
--  Once the URL policy is registered, the policy manager can read and process the following
--  XML configuration:
--
--    <policy-rules>
--      <url-policy id='1'>
--        <permission>create-workspace</permission>
--        <permission>admin</permission>
--        <url-pattern>/workspace/create</url-pattern>
--        <url-pattern>/workspace/setup/*</url-pattern>
--      </url-policy>
--      ...
--    </policy-rules>
--
--  This policy gives access to the URL that match one of the URL pattern if the
--  security context has the permission create-workspace or admin.
--  These two permissions are checked according to another security policy.
--  The XML configuration can define several <tt>url-policy</tt>.  They are checked in
--  the order defined in the XML.  In other words, the first <tt>url-policy</tt> that matches
--  the URL is used to verify the permission.
--
--  The <tt>url-policy</tt> definition can contain several <tt>permission</tt>.
--
--  === Checking for permission ===
--  To check a URL permission, you must declare a <tt>URI_Permission</tt> object with the URL.
--
--     URI    : constant String := ...;
--     Perm   : constant Policies.URLs.URI_Permission (URI'Length)
--               := URI_Permission '(Len => URI'Length, URI => URI);
--
--  Then, we can check the permission:
--
--     Result : Boolean := Security.Contexts.Has_Permission (Perm);
--
package Security.Policies.Urls is

   NAME : constant String := "URL-Policy";

   package P_URL is new Security.Permissions.Definition ("url");

   --  ------------------------------
   --  URI Permission
   --  ------------------------------
   --  Represents a permission to access a given URI.
   type URI_Permission (Len : Natural) is new Permissions.Permission (P_URL.Permission) with record
      URI : String (1 .. Len);
   end record;

   --  ------------------------------
   --  URL policy
   --  ------------------------------
   type URL_Policy is new Policy with private;
   type URL_Policy_Access is access all URL_Policy'Class;

   Invalid_Name : exception;

   --  Get the policy name.
   overriding
   function Get_Name (From : in URL_Policy) return String;

   --  Returns True if the user has the permission to access the given URI permission.
   function Has_Permission (Manager    : in URL_Policy;
                            Context    : in Security_Context_Access;
                            Permission : in URI_Permission'Class) return Boolean;

   --  Grant the permission to access to the given URI to users having the To
   --  permissions.
   procedure Grant_URI_Permission (Manager : in out URL_Policy;
                                   URI     : in String;
                                   To      : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out URL_Policy);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out URL_Policy);

   --  Setup the XML parser to read the policy description.
   overriding
   procedure Prepare_Config (Policy : in out URL_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser);

   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   overriding
   procedure Finish_Config (Into    : in out URL_Policy;
                            Reader  : in out Util.Serialize.IO.XML.Parser);

   --  Get the URL policy associated with the given policy manager.
   --  Returns the URL policy instance or null if it was not registered in the policy manager.
   function Get_URL_Policy (Manager : in Security.Policies.Policy_Manager'Class)
                            return URL_Policy_Access;

private

   use Util.Strings;

   --  The Access_Rule represents a list of permissions to verify to grant
   --  access to the resource.  To make it simple, the user must have one of the
   --  permission from the list.  Each permission will refer to a specific permission
   --  controller.
   type Access_Rule (Count : Natural) is new Util.Refs.Ref_Entity with record
      Permissions : Permission_Index_Array (1 .. Count);
   end record;
   type Access_Rule_Access is access all Access_Rule;

   package Access_Rule_Refs is
     new Util.Refs.Indefinite_References (Element_Type   => Access_Rule,
                                          Element_Access => Access_Rule_Access);
   subtype Access_Rule_Ref is Access_Rule_Refs.Ref;

   --  Find the access rule of the policy that matches the given URI.
   --  Returns the No_Rule value (disable access) if no rule is found.
   function Find_Access_Rule (Manager : in URL_Policy;
                              URI     : in String) return Access_Rule_Ref;

   --  The Policy defines the access rules that are applied on a given
   --  URL, set of URLs or files.
   type Policy is record
      Id      : Natural;
      Pattern : GNAT.Regexp.Regexp;
      Rule    : Access_Rule_Ref;
   end record;

   --  The Policy_Vector represents the whole permission policy.  The order of
   --  policy in the list is important as policies can override each other.
   package Policy_Vector is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Policy);

   package Rules_Maps is new Ada.Containers.Hashed_Maps (Key_Type        => String_Ref,
                                                         Element_Type    => Access_Rule_Ref,
                                                         Hash            => Hash,
                                                         Equivalent_Keys => Equivalent_Keys,
                                                         "="             => Access_Rule_Refs."=");

   type Rules is new Util.Refs.Ref_Entity with record
      Map : Rules_Maps.Map;
   end record;
   type Rules_Access is access all Rules;

   package Rules_Ref is new Util.Refs.References (Rules, Rules_Access);

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type URL_Policy is new Security.Policies.Policy with record
      Cache        : Rules_Ref_Access;
      Policies     : Policy_Vector.Vector;
      Id           : Natural := 0;
      Permissions  : Util.Beans.Objects.Vectors.Vector;
      Patterns     : Util.Beans.Objects.Vectors.Vector;
   end record;

end Security.Policies.Urls;

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

with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;

with Util.Refs;
with Util.Strings;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

--  == URL Security Policy ==
--  The <tt>Security.Policies.Urls</tt> implements a security policy intended to be used
--  in web servers.
--
--  === Policy creation ===
--  An instance of the <tt>URL_Policy</tt> must be created and registered in the policy manager.
--  Get or declare the following variables:
--
--    Manager : Security.Policies.Policy_Manager;
--    Policy  : Security.Policies.Urls.URL_Policy_Access;
--
--  Create the URL policy and register it in the policy manager as follows:
--
--    Policy := new URL_Policy;
--    Manager.Add_Policy (Policy.all'Access);
--
--  === Policy Configuration ===
--  Once the URL policy is registered, the policy manager can read and process the following
--  XML configuration:
--
--    <policy-rules>
--      <url-policy id='1'>
--        <permission>create-workspace</permission>
--        <permission>admin</permission>
--        <url-pattern>/workspace/create</url-pattern>
--        <url-pattern>/workspace/setup/*</url-pattern>
--      </url-policy>
--      ...
--    </policy-rules>
--
--  This policy gives access to the URL that match one of the URL pattern if the
--  security context has the permission create-workspace or admin.
--  These two permissions are checked according to another security policy.
--  The XML configuration can define several <tt>url-policy</tt>.  They are checked in
--  the order defined in the XML.  In other words, the first <tt>url-policy</tt> that matches
--  the URL is used to verify the permission.
--
--  The <tt>url-policy</tt> definition can contain several <tt>permission</tt>.
--
--  === Checking for permission ===
--  To check a URL permission, you must declare a <tt>URI_Permission</tt> object with the URL.
--
--     URI    : constant String := ...;
--     Perm   : constant Policies.URLs.URI_Permission (URI'Length)
--               := URI_Permission '(Len => URI'Length, URI => URI);
--
--  Then, we can check the permission:
--
--     Result : Boolean := Security.Contexts.Has_Permission (Perm);
--
package Security.Policies.Urls is

   NAME : constant String := "URL-Policy";

   package P_URL is new Security.Permissions.Definition ("url");

   --  ------------------------------
   --  URI Permission
   --  ------------------------------
   --  Represents a permission to access a given URI.
   type URI_Permission (Len : Natural) is new Permissions.Permission (P_URL.Permission) with record
      URI : String (1 .. Len);
   end record;

   --  ------------------------------
   --  URL policy
   --  ------------------------------
   type URL_Policy is new Policy with private;
   type URL_Policy_Access is access all URL_Policy'Class;

   Invalid_Name : exception;

   --  Get the policy name.
   overriding
   function Get_Name (From : in URL_Policy) return String;

   --  Returns True if the user has the permission to access the given URI permission.
   function Has_Permission (Manager    : in URL_Policy;
                            Context    : in Security_Context_Access;
                            Permission : in URI_Permission'Class) return Boolean;

   --  Grant the permission to access to the given URI to users having the To
   --  permissions.
   procedure Grant_URI_Permission (Manager : in out URL_Policy;
                                   URI     : in String;
                                   To      : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out URL_Policy);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out URL_Policy);

   --  Setup the XML parser to read the policy description.
   overriding
   procedure Prepare_Config (Policy : in out URL_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser);

   --  Get the URL policy associated with the given policy manager.
   --  Returns the URL policy instance or null if it was not registered in the policy manager.
   function Get_URL_Policy (Manager : in Security.Policies.Policy_Manager'Class)
                            return URL_Policy_Access;

private

   use Util.Strings;

   --  The Access_Rule represents a list of permissions to verify to grant
   --  access to the resource.  To make it simple, the user must have one of the
   --  permission from the list.  Each permission will refer to a specific permission
   --  controller.
   type Access_Rule (Count : Natural) is new Util.Refs.Ref_Entity with record
      Permissions : Permission_Index_Array (1 .. Count);
   end record;
   type Access_Rule_Access is access all Access_Rule;

   package Access_Rule_Refs is
     new Util.Refs.Indefinite_References (Element_Type   => Access_Rule,
                                          Element_Access => Access_Rule_Access);
   subtype Access_Rule_Ref is Access_Rule_Refs.Ref;

   --  Find the access rule of the policy that matches the given URI.
   --  Returns the No_Rule value (disable access) if no rule is found.
   function Find_Access_Rule (Manager : in URL_Policy;
                              URI     : in String) return Access_Rule_Ref;

   --  The Policy defines the access rules that are applied on a given
   --  URL, set of URLs or files.
   type Policy is record
      Id      : Natural;
      Pattern : GNAT.Regexp.Regexp;
      Rule    : Access_Rule_Ref;
   end record;

   --  The Policy_Vector represents the whole permission policy.  The order of
   --  policy in the list is important as policies can override each other.
   package Policy_Vector is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Policy);

   package Rules_Maps is new Ada.Containers.Hashed_Maps (Key_Type        => String_Ref,
                                                         Element_Type    => Access_Rule_Ref,
                                                         Hash            => Hash,
                                                         Equivalent_Keys => Equivalent_Keys,
                                                         "="             => Access_Rule_Refs."=");

   type Rules is new Util.Refs.Ref_Entity with record
      Map : Rules_Maps.Map;
   end record;
   type Rules_Access is access all Rules;

   package Rules_Ref is new Util.Refs.References (Rules, Rules_Access);

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type URL_Policy is new Security.Policies.Policy with record
      Cache        : Rules_Ref_Access;
      Policies     : Policy_Vector.Vector;
      Id           : Natural := 0;
      Permissions  : Util.Beans.Objects.Vectors.Vector;
      Patterns     : Util.Beans.Objects.Vectors.Vector;
   end record;

end Security.Policies.Urls;

Remove Finish_Config which is not necessary


-----------------------------------------------------------------------
--  wiki-parsers-common -- Common operations with several wiki parsers
--  Copyright (C) 2011 - 2022 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.
-----------------------------------------------------------------------
private package Wiki.Parsers.Common is

   pragma Preelaborate;

   subtype Parser_Type is Parser;

   --  Check if this is a list item composed of '*' and '#'
   --  and terminated by a space.
   function Is_List (Text : in Wiki.Buffers.Buffer_Access;
                     From : in Positive) return Boolean;

   procedure Skip_Spaces (Text : in out Wiki.Buffers.Buffer_Access;
                          From : in out Positive);

   procedure Append (Into : in out Wiki.Strings.BString;
                     Text : in Wiki.Buffers.Buffer_Access;
                     From : in Positive);

   procedure Parse_Token (Text        : in out Wiki.Buffers.Buffer_Access;
                          From        : in out Positive;
                          Escape_Char : in Wiki.Strings.WChar;
                          Marker1     : in Wiki.Strings.WChar;
                          Marker2     : in Wiki.Strings.WChar;
                          Into        : in out Wiki.Strings.BString);

   --  Parse a single text character and add it to the text buffer.
   procedure Parse_Text (Parser : in out Parser_Type;
                         Text   : in out Wiki.Buffers.Buffer_Access;
                         From   : in out Positive;
                         Count  : in Positive := 1);

   procedure Parse_Paragraph (Parser : in out Parser_Type;
                              Text   : in out Wiki.Buffers.Buffer_Access;
                              From   : in out Positive);

   procedure Parse_Horizontal_Rule (Parser : in out Parser_Type;
                                    Text   : in out Wiki.Buffers.Buffer_Access;
                                    From   : in out Positive;
                                    Marker : in Wiki.Strings.WChar);

   --  Parse a preformatted header block.
   --  Example:
   --    ///
   --    ///html
   --    ///[Ada]
   --    {{{
   --    ```
   procedure Parse_Preformatted (Parser : in out Parser_Type;
                                 Text   : in out Wiki.Buffers.Buffer_Access;
                                 From   : in out Positive;
                                 Marker : in Wiki.Strings.WChar);

   --  Parse a wiki heading.  The heading could start with '=' or '!'.
   --  The trailing equals are ignored.
   --  Example:
   --    ==== Level 4       Creole
   --    == Level 2 ==      MediaWiki
   --    !!! Level 3        Dotclear
   procedure Parse_Header (Parser : in out Parser_Type;
                           Text   : in out Wiki.Buffers.Buffer_Access;
                           From   : in Positive;
                           Marker : in Wiki.Strings.WChar);

   --  Parse a template with parameters.
   --  Example:
   --    {{Name|param|...}}           MediaWiki
   --    {{Name|param=value|...}}     MediaWiki
   --    <<Name param=value ...>>     Creole
   --    [{Name param=value ...}]     JSPWiki
   procedure Parse_Template (Parser  : in out Parser_Type;
                             Text    : in out Wiki.Buffers.Buffer_Access;
                             From    : in out Positive;
                             Token   : in Wiki.Strings.WChar);

   procedure Parse_Entity (Parser : in out Parser_Type;
                           Text   : in out Wiki.Buffers.Buffer_Access;
                           From   : in out Positive;
                           Status : out Wiki.Html_Parser.Entity_State_Type;
                           Entity : out Wiki.Strings.WChar);

   procedure Parse_Entity (Parser : in out Parser_Type;
                           Text   : in out Wiki.Buffers.Buffer_Access;
                           From   : in out Positive);

   --  Parse a quote.
   --  Example:
   --    {{name}}
   --    {{name|language}}
   --    {{name|language|url}}
   --    ??citation??
   procedure Parse_Quote (Parser  : in out Parser_Type;
                          Text    : in out Wiki.Buffers.Buffer_Access;
                          From    : in out Positive;
                          Marker  : in Wiki.Strings.WChar);

   procedure Parse_Html_Element (Parser : in out Parser_Type;
                                 Text   : in out Wiki.Buffers.Buffer_Access;
                                 From   : in out Positive;
                                 Start  : in Boolean);

   procedure Parse_Html_Preformatted (Parser  : in out Parser_Type;
                                      Text    : in out Wiki.Buffers.Buffer_Access;
                                      From    : in out Positive);

   --  Parse a link.
   --  Example:
   --    [name]
   --    [name|url]
   --    [name|url|language]
   --    [name|url|language|title]
   --    [[link]]
   --    [[link|name]]
   procedure Parse_Link (Parser  : in out Parser_Type;
                         Text    : in out Wiki.Buffers.Buffer_Access;
                         From    : in out Positive);

   procedure Parse_List (Parser  : in out Parser_Type;
                         Text    : in out Wiki.Buffers.Buffer_Access;
                         From    : in out Positive);

   --  Parse a list definition that starts with ';':
   --    ;item 1
   --    : definition 1
   procedure Parse_Definition (Parser  : in out Parser_Type;
                               Text    : in out Wiki.Buffers.Buffer_Access;
                               From    : in out Positive);

end Wiki.Parsers.Common;

-----------------------------------------------------------------------
--  wiki-parsers-common -- Common operations with several wiki parsers
--  Copyright (C) 2011 - 2022 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.
-----------------------------------------------------------------------
private package Wiki.Parsers.Common is

   pragma Preelaborate;

   subtype Parser_Type is Parser;

   --  Check if this is a list item composed of '*' and '#'
   --  and terminated by a space.
   function Is_List (Text : in Wiki.Buffers.Buffer_Access;
                     From : in Positive) return Boolean;

   procedure Skip_Spaces (Text  : in out Wiki.Buffers.Buffer_Access;
                          From  : in out Positive;
                          Count : out Natural);

   procedure Append (Into : in out Wiki.Strings.BString;
                     Text : in Wiki.Buffers.Buffer_Access;
                     From : in Positive);

   procedure Parse_Token (Text        : in out Wiki.Buffers.Buffer_Access;
                          From        : in out Positive;
                          Escape_Char : in Wiki.Strings.WChar;
                          Marker1     : in Wiki.Strings.WChar;
                          Marker2     : in Wiki.Strings.WChar;
                          Into        : in out Wiki.Strings.BString);

   --  Parse a single text character and add it to the text buffer.
   procedure Parse_Text (Parser : in out Parser_Type;
                         Text   : in out Wiki.Buffers.Buffer_Access;
                         From   : in out Positive;
                         Count  : in Positive := 1);

   procedure Parse_Paragraph (Parser : in out Parser_Type;
                              Text   : in out Wiki.Buffers.Buffer_Access;
                              From   : in out Positive);

   procedure Parse_Horizontal_Rule (Parser : in out Parser_Type;
                                    Text   : in out Wiki.Buffers.Buffer_Access;
                                    From   : in out Positive;
                                    Marker : in Wiki.Strings.WChar);

   --  Parse a preformatted header block.
   --  Example:
   --    ///
   --    ///html
   --    ///[Ada]
   --    {{{
   --    ```
   procedure Parse_Preformatted (Parser : in out Parser_Type;
                                 Text   : in out Wiki.Buffers.Buffer_Access;
                                 From   : in out Positive;
                                 Marker : in Wiki.Strings.WChar;
                                 Keep_Block : in Boolean := False);

   --  Parse a wiki heading.  The heading could start with '=' or '!'.
   --  The trailing equals are ignored.
   --  Example:
   --    ==== Level 4       Creole
   --    == Level 2 ==      MediaWiki
   --    !!! Level 3        Dotclear
   procedure Parse_Header (Parser : in out Parser_Type;
                           Text   : in out Wiki.Buffers.Buffer_Access;
                           From   : in Positive;
                           Marker : in Wiki.Strings.WChar);

   --  Parse a template with parameters.
   --  Example:
   --    {{Name|param|...}}           MediaWiki
   --    {{Name|param=value|...}}     MediaWiki
   --    <<Name param=value ...>>     Creole
   --    [{Name param=value ...}]     JSPWiki
   procedure Parse_Template (Parser  : in out Parser_Type;
                             Text    : in out Wiki.Buffers.Buffer_Access;
                             From    : in out Positive;
                             Token   : in Wiki.Strings.WChar);

   procedure Parse_Entity (Parser : in out Parser_Type;
                           Text   : in out Wiki.Buffers.Buffer_Access;
                           From   : in out Positive;
                           Status : out Wiki.Html_Parser.Entity_State_Type;
                           Entity : out Wiki.Strings.WChar);

   procedure Parse_Entity (Parser : in out Parser_Type;
                           Text   : in out Wiki.Buffers.Buffer_Access;
                           From   : in out Positive);

   --  Parse a quote.
   --  Example:
   --    {{name}}
   --    {{name|language}}
   --    {{name|language|url}}
   --    ??citation??
   procedure Parse_Quote (Parser  : in out Parser_Type;
                          Text    : in out Wiki.Buffers.Buffer_Access;
                          From    : in out Positive;
                          Marker  : in Wiki.Strings.WChar);

   procedure Parse_Html_Element (Parser : in out Parser_Type;
                                 Text   : in out Wiki.Buffers.Buffer_Access;
                                 From   : in out Positive;
                                 Start  : in Boolean);

   procedure Parse_Html_Preformatted (Parser  : in out Parser_Type;
                                      Text    : in out Wiki.Buffers.Buffer_Access;
                                      From    : in out Positive);

   --  Parse a link.
   --  Example:
   --    [name]
   --    [name|url]
   --    [name|url|language]
   --    [name|url|language|title]
   --    [[link]]
   --    [[link|name]]
   procedure Parse_Link (Parser  : in out Parser_Type;
                         Text    : in out Wiki.Buffers.Buffer_Access;
                         From    : in out Positive);

   procedure Parse_List (Parser  : in out Parser_Type;
                         Text    : in out Wiki.Buffers.Buffer_Access;
                         From    : in out Positive);

   --  Parse a list definition that starts with ';':
   --    ;item 1
   --    : definition 1
   procedure Parse_Definition (Parser  : in out Parser_Type;
                               Text    : in out Wiki.Buffers.Buffer_Access;
                               From    : in out Positive);

end Wiki.Parsers.Common;

Update Skip_Spaces to get a count of skipped spaces and update Parse_Preformatted to keep the block