264 lines
9.8 KiB
Ada
264 lines
9.8 KiB
Ada
-------------------------------------------------------------------------------
|
|
-- --
|
|
-- 0MQ Ada-binding --
|
|
-- --
|
|
-- Z M Q . M E S S A G E S --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2020-2030, per.s.sandberg@bahnhof.se --
|
|
-- --
|
|
-- Permission is hereby granted, free of charge, to any person obtaining a --
|
|
-- copy of this software and associated documentation files --
|
|
-- (the "Software"), to deal in the Software without restriction, including --
|
|
-- without limitation the rights to use, copy, modify, merge, publish, --
|
|
-- distribute, sublicense, and / or sell copies of the Software, and to --
|
|
-- permit persons to whom the Software is furnished to do so, subject to --
|
|
-- the following conditions : --
|
|
-- --
|
|
-- The above copyright notice and this permission notice shall be included --
|
|
-- in all copies or substantial portions of the Software. --
|
|
-- --
|
|
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
|
|
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
|
|
-- MERCHANTABILITY, --
|
|
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL --
|
|
-- THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR --
|
|
-- OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, --
|
|
-- ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR --
|
|
-- OTHER DEALINGS IN THE SOFTWARE. --
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
with Interfaces.C;
|
|
with GNAT.OS_Lib;
|
|
with GNAT.Source_Info;
|
|
with Ada.Unchecked_Conversion;
|
|
with System.Address_To_Access_Conversions;
|
|
package body ZMQ.Messages is
|
|
use Interfaces.C;
|
|
|
|
|
|
-- ========================================================================
|
|
-- Initialize with size
|
|
-- ========================================================================
|
|
|
|
procedure Initialize (Self : in out Message; Size : Natural) is
|
|
Ret : int;
|
|
begin
|
|
if Size > 0 then
|
|
Ret := Low_Level.zmq_msg_init_size (Self.Msg'Access, size_t (Size));
|
|
else
|
|
Ret := Low_Level.zmq_msg_init (Self.Msg'Access);
|
|
end if;
|
|
if Ret /= 0 then
|
|
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
|
|
GNAT.Source_Info.Enclosing_Entity;
|
|
end if;
|
|
end Initialize;
|
|
|
|
-- ========================================================================
|
|
-- Initialize with data
|
|
-- ========================================================================
|
|
procedure Initialize (Self : in out Message;
|
|
Data : System.Address;
|
|
Size : Natural) is
|
|
type Data_Type is new String (1 .. Size);
|
|
package Conv is new System.Address_To_Access_Conversions (Data_Type);
|
|
begin
|
|
Self.Initialize (Size);
|
|
Conv.To_Pointer ((Self.GetData)).all := Conv.To_Pointer (Data).all;
|
|
end Initialize;
|
|
|
|
procedure Initialize (Self : in out Message; Data : String) is
|
|
begin
|
|
Self.Initialize (Data'Address, Data'Length);
|
|
end Initialize;
|
|
|
|
procedure Initialize
|
|
(Self : in out Message;
|
|
Data : Ada.Streams.Stream_Element_Array) is
|
|
begin
|
|
Self.Initialize (Data'Address, Data'Length);
|
|
end Initialize;
|
|
|
|
-- ========================================================================
|
|
-- Initialize with data ref and free
|
|
-- ========================================================================
|
|
procedure Initialize
|
|
(Self : in out Message;
|
|
Message : System.Address;
|
|
Size : Natural;
|
|
Free : Free_Proc;
|
|
Hint : System.Address := System.Null_Address)
|
|
is
|
|
Ret : int;
|
|
begin
|
|
Ret := Low_Level.zmq_msg_init_data (Self.Msg'Access,
|
|
Message,
|
|
size_t (Size),
|
|
Free,
|
|
Hint);
|
|
if Ret /= 0 then
|
|
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
|
|
GNAT.Source_Info.Enclosing_Entity;
|
|
end if;
|
|
end Initialize;
|
|
|
|
|
|
------------------------
|
|
-- Initialize_Generic --
|
|
------------------------
|
|
|
|
procedure Initialize_Generic
|
|
(Self : in out Message;
|
|
Data : Element_Access)
|
|
is
|
|
function Conv is new
|
|
Ada.Unchecked_Conversion (Source => System.Address,
|
|
Target => Element_Access);
|
|
procedure Internal_Free (Data : System.Address; Hint : System.Address);
|
|
procedure Internal_Free (Data : System.Address; Hint : System.Address) is
|
|
pragma Unreferenced (Hint);
|
|
Temp : Element_Access := Conv (Data);
|
|
begin
|
|
Free (Temp);
|
|
end Internal_Free;
|
|
begin
|
|
Self.Initialize (Data.all'Address,
|
|
Data.all'Size / 8,
|
|
Internal_Free'Unrestricted_Access);
|
|
end Initialize_Generic;
|
|
|
|
----------------------------------
|
|
-- Initialize_Generic_With_Hint --
|
|
----------------------------------
|
|
|
|
procedure Initialize_Generic_With_Hint
|
|
(Self : in out Message;
|
|
Data : Element_Access;
|
|
Hint : Hint_Access)
|
|
is
|
|
function ConvHint is new
|
|
Ada.Unchecked_Conversion (Source => System.Address,
|
|
Target => Hint_Access);
|
|
function Conv is new
|
|
Ada.Unchecked_Conversion (Source => System.Address,
|
|
Target => Element_Access);
|
|
|
|
procedure Internal_Free (Data : System.Address; Hint : System.Address);
|
|
procedure Internal_Free (Data : System.Address; Hint : System.Address) is
|
|
Temp_Data : Element_Access := Conv (Data);
|
|
Temp_Hint : constant Hint_Access := ConvHint (Hint);
|
|
begin
|
|
Free (Temp_Data, Temp_Hint);
|
|
end Internal_Free;
|
|
begin
|
|
Self.Initialize (Data.all'Address,
|
|
Data.all'Size / 8,
|
|
Internal_Free'Unrestricted_Access,
|
|
Hint.all'Address);
|
|
end Initialize_Generic_With_Hint;
|
|
|
|
|
|
-- ========================================================================
|
|
-- GetData / GetSize
|
|
-- ========================================================================
|
|
|
|
---------------
|
|
-- getData --
|
|
---------------
|
|
function GetData (Self : Message) return System.Address is
|
|
begin
|
|
return Low_Level.zmq_msg_data (Self.Msg'Unrestricted_Access);
|
|
end GetData;
|
|
|
|
|
|
---------------
|
|
-- getData --
|
|
---------------
|
|
function GetData (Self : Message) return String is
|
|
type Data_Type is new String (1 .. Self.GetSize);
|
|
package Conv is new System.Address_To_Access_Conversions (Data_Type);
|
|
begin
|
|
return String (Conv.To_Pointer (Self.GetData).all);
|
|
end GetData;
|
|
|
|
---------------
|
|
-- getData --
|
|
---------------
|
|
function GetData (Self : Message)
|
|
return Ada.Streams.Stream_Element_Array is
|
|
type Data_Type is new Ada.Streams.Stream_Element_Array
|
|
(1 .. Ada.Streams.Stream_Element_Offset (Self.GetSize));
|
|
package Conv is new System.Address_To_Access_Conversions (Data_Type);
|
|
begin
|
|
return Ada.Streams.Stream_Element_Array
|
|
(Conv.To_Pointer (Self.GetData).all);
|
|
end GetData;
|
|
|
|
---------------
|
|
-- getData --
|
|
---------------
|
|
function GetData (Self : Message)
|
|
return Ada.Strings.Unbounded.Unbounded_String is
|
|
type Data_Type is new String (1 .. Self.GetSize);
|
|
package Conv is new System.Address_To_Access_Conversions (Data_Type);
|
|
begin
|
|
return Ada.Strings.Unbounded.To_Unbounded_String
|
|
(String (Conv.To_Pointer (Self.GetData).all));
|
|
end GetData;
|
|
|
|
-----------------------
|
|
-- getData_Generic --
|
|
-----------------------
|
|
function GetData_Generic (Self : Message)
|
|
return Element is
|
|
package Conv is new System.Address_To_Access_Conversions (Element);
|
|
begin
|
|
return Conv.To_Pointer (Self.GetData).all;
|
|
end GetData_Generic;
|
|
|
|
|
|
---------------
|
|
-- getSize --
|
|
---------------
|
|
function GetSize (Self : Message) return Natural is
|
|
begin
|
|
return Natural (Low_Level.zmq_msg_size (Self.Msg'Unrestricted_Access));
|
|
end GetSize;
|
|
|
|
|
|
--------------
|
|
-- Finalize --
|
|
--------------
|
|
|
|
procedure Finalize (Self : in out Message) is
|
|
Ret : int;
|
|
begin
|
|
Ret := Low_Level.zmq_msg_close (Self.Msg'Access);
|
|
if Ret /= 0 then
|
|
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
|
|
GNAT.Source_Info.Enclosing_Entity;
|
|
end if;
|
|
end Finalize;
|
|
|
|
-------------
|
|
-- getImpl --
|
|
-------------
|
|
|
|
function GetImpl (Self : Message) return not null Zmq_Msg_T_Access is
|
|
begin
|
|
return Self.Msg'Unrestricted_Access;
|
|
end GetImpl;
|
|
|
|
procedure Process_Data_Generic
|
|
(Self : Message;
|
|
Handle : access procedure (Item : Element)) is
|
|
package Conv is new System.Address_To_Access_Conversions (Element);
|
|
begin
|
|
Handle (Conv.To_Pointer (Self.GetData).all);
|
|
end Process_Data_Generic;
|
|
|
|
end ZMQ.Messages;
|