1. --   (c) Copyright, Real-Time Innovations, 2025. 
  2. --   All rights reserved. 
  3. --   No duplications, whole or partial, manual or electronic, may be made 
  4. --   without express written permission.  Any such copies, or 
  5. --   revisions thereof, must display this notice unaltered. 
  6. --   This code contains trade secrets of Real-Time Innovations, Inc. 
  7.  
  8.  
  9. --  SPDX-FileCopyrightText: 2023 Per Sandberg <per.s.sandberg@bahnhof.se> 
  10. --  SPDX-License-Identifier: Apache-2.0 
  11. with Ada.Streams; 
  12. with DDS.Logger.LoggerDevice; 
  13.  
  14. private with GNAT.Semaphores; 
  15. private with Ada.Unchecked_Deallocation; 
  16. private with DDS.String_Vectors; 
  17.  
  18. package DDS.Logger.Bufferd_Logger is 
  19.    type Ref is new DDS.Logger.LoggerDevice.Ref with private; 
  20.  
  21.    overriding procedure Write (Self : not null access Ref; 
  22.                                Text  : Standard.String; 
  23.                                Level : DDS.LogVerbosity); 
  24.  
  25.    overriding procedure Close (Self : not null access Ref); 
  26.    not overriding procedure Reset (Self : not null access Ref); 
  27.  
  28.    not overriding procedure Save (Self : not null access Ref; To : access Ada.Streams.Root_Stream_Type'Class); 
  29.    not overriding procedure Save (Self : not null access Ref; To : Standard.String); 
  30.    not overriding procedure Dump (Self : not null access Ref); 
  31.  
  32.    not overriding function Contins (Self : not null access  Ref; Item : Standard.String) return Boolean; 
  33.  
  34.    not overriding function Image (Self : not null access Ref) return Standard.String; 
  35.  
  36. private 
  37.  
  38.    type Vector_Access is access all String_Vectors.Vector; 
  39.    type Semaphore_Access is access all GNAT.Semaphores.Binary_Semaphore; 
  40.  
  41.    type Ref is new DDS.Logger.LoggerDevice.Ref with record 
  42.       Buffer : Vector_Access := new String_Vectors.Vector; 
  43.       Lock   : Semaphore_Access := 
  44.                  new GNAT.Semaphores.Binary_Semaphore 
  45.                    (True, GNAT.Semaphores.Default_Ceiling); 
  46.    end record; 
  47.  
  48.    procedure Finalize (Self : in out Ref); 
  49.    procedure Free is new Ada.Unchecked_Deallocation (String_Vectors.Vector, Vector_Access); 
  50.    procedure Free is new Ada.Unchecked_Deallocation (GNAT.Semaphores.Binary_Semaphore, Semaphore_Access); 
  51.  
  52.    type Key (Lock : not null access GNAT.Semaphores.Binary_Semaphore) is new 
  53.      Ada.Finalization.Limited_Controlled with null record with 
  54.        Unreferenced_Objects => True; 
  55.  
  56.    procedure Initialize (Object : in out Key); 
  57.    procedure Finalize   (Object : in out Key); 
  58.  
  59. end DDS.Logger.Bufferd_Logger;