vss_24.0.0_b4d0be7c/source/streams/implementation/vss-text_streams-file_input.adb

--
--  Copyright (C) 2022-2023, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
--

with Ada.Streams;
with Interfaces.C;

with VSS.Characters.Latin;
with VSS.Strings.Character_Iterators;
with VSS.Strings.Conversions;

package body VSS.Text_Streams.File_Input is

   use type Interfaces.C_Streams.FILEs;

   C_R_Mode : constant Interfaces.C.char_array := Interfaces.C.To_C ("r");

   -----------
   -- Close --
   -----------

   procedure Close (Self : in out File_Input_Text_Stream'Class) is
      Dummy : Interfaces.C_Streams.int;

   begin
      if Self.Stream /= Interfaces.C_Streams.NULL_Stream then
         Dummy := Interfaces.C_Streams.fclose (Self.Stream);
      end if;

      Self.Stream := Interfaces.C_Streams.NULL_Stream;
      Self.Decoder.Reset_State;
      Self.Buffer.Clear;
      Self.Error.Clear;
   end Close;

   -------------------
   -- Error_Message --
   -------------------

   overriding function Error_Message
     (Self : File_Input_Text_Stream) return VSS.Strings.Virtual_String is
   begin
      return Self.Error;
   end Error_Message;

   --------------
   -- Finalize --
   --------------

   overriding procedure Finalize (Self : in out File_Input_Text_Stream) is
   begin
      Self.Close;
   end Finalize;

   ---------
   -- Get --
   ---------

   overriding procedure Get
     (Self    : in out File_Input_Text_Stream;
      Item    : out VSS.Characters.Virtual_Character;
      Success : in out Boolean) is
   begin
      if Self.Buffer.Is_Empty then
         if Self.Stream = Interfaces.C_Streams.NULL_Stream then
            Self.Error := "File is not open";
            Item       := VSS.Characters.Latin.Nul;
            Success    := False;

            return;
         end if;

         declare
            use type Ada.Streams.Stream_Element_Offset;
            use type Interfaces.C_Streams.size_t;

            Data : Ada.Streams.Stream_Element_Array (1 .. 128);
            Size : Interfaces.C_Streams.size_t;

         begin
            Size :=
              Interfaces.C_Streams.fread
                (Data (Data'First)'Address, 0, 1, Data'Length, Self.Stream);

            if Size /= 0 then
               --  Some data has been read, decode it.

               Self.Buffer :=
                 Self.Decoder.Decode
                   (Data
                      (Data'First
                         .. Data'First
                              + Ada.Streams.Stream_Element_Offset (Size) - 1),
                    False);

            elsif Interfaces.C_Streams.feof (Self.Stream) /= 0 then
               --  End of file has been reached, let decoder know that no more
               --  data available. Decoder will return REPLACEMENT CHARACTER
               --  if some data has beed accumulated but can't be decoded.

               Self.Buffer :=
                 Self.Decoder.Decode
                   (Data (Data'First .. Data'First - 1), True);

            elsif Interfaces.C_Streams.ferror (Self.Stream) /= 0 then
               Self.Error := "File IO error";
            end if;
         end;
      end if;

      if Self.Buffer.Is_Empty then
         Item    := VSS.Characters.Latin.Nul;
         Success := False;

      else
         declare
            First_Character : constant
              VSS.Strings.Character_Iterators.Character_Iterator :=
                Self.Buffer.At_First_Character;

         begin
            Item := First_Character.Element;
            Self.Buffer := Self.Buffer.Tail_After (First_Character);
            Success := True;
         end;
      end if;
   end Get;

   ---------------
   -- Has_Error --
   ---------------

   overriding function Has_Error
     (Self : File_Input_Text_Stream) return Boolean is
   begin
      return not Self.Error.Is_Empty;
   end Has_Error;

   --------------------
   -- Is_End_Of_Data --
   --------------------

   overriding function Is_End_Of_Data
     (Self : File_Input_Text_Stream) return Boolean is
   begin
      return False;
   end Is_End_Of_Data;

   ----------------------
   -- Is_End_Of_Stream --
   ----------------------

   overriding function Is_End_Of_Stream
     (Self : File_Input_Text_Stream) return Boolean is
   begin
      return
        Self.Stream = Interfaces.C_Streams.NULL_Stream
          or else
            (Self.Buffer.Is_Empty
               and then Interfaces.C_Streams.feof (Self.Stream) /= 0);
   end Is_End_Of_Stream;

   ----------
   -- Open --
   ----------

   procedure Open
     (Self : in out File_Input_Text_Stream'Class;
      Name : VSS.Strings.Virtual_String)
   is
      C_Name : constant Interfaces.C.char_array :=
        Interfaces.C.To_C (VSS.Strings.Conversions.To_UTF_8_String (Name));

   begin
      if Self.Stream /= Interfaces.C_Streams.NULL_Stream then
         Self.Close;
      end if;

      Self.Error.Clear;

      Self.Stream :=
        Interfaces.C_Streams.fopen
          (C_Name (C_Name'First)'Address,
           C_R_Mode (C_R_Mode'First)'Address);

      if Self.Stream = Interfaces.C_Streams.NULL_Stream then
         Self.Error := "Unable to open file";

      elsif not Self.Decoder.Is_Valid then
         Self.Decoder.Initialize ("utf-8");
      end if;
   end Open;

   ----------
   -- Open --
   ----------

   procedure Open
     (Self     : in out File_Input_Text_Stream'Class;
      Name     : VSS.Strings.Virtual_String;
      Encoding : VSS.Strings.Virtual_String) is
   begin
      if Self.Stream /= Interfaces.C_Streams.NULL_Stream then
         Self.Close;
      end if;

      Self.Error.Clear;

      Self.Set_Encoding (Encoding);

      if Self.Error.Is_Empty then
         Self.Open (Name);
      end if;
   end Open;

   ------------------
   -- Set_Encoding --
   ------------------

   procedure Set_Encoding
     (Self     : in out File_Input_Text_Stream'Class;
      Encoding : VSS.Strings.Virtual_String)
   is
      use all type VSS.Strings.Converters.Converter_Flag;

   begin
      if Self.Stream = Interfaces.C_Streams.NULL_Stream then
         Self.Decoder.Initialize
           (Encoding,
            [Stateless     => False,
             Stop_On_Error => False,
             Process_BOM   => False]);

         if not Self.Decoder.Is_Valid then
            Self.Error := "Unsupported encoding";

         else
            Self.Error.Clear;
         end if;
      end if;
   end Set_Encoding;

end VSS.Text_Streams.File_Input;