--  dh_ada_library, helper for Ada libraries Debian maintainers
--
--  Copyright (C) 2012-2020 Nicolas Boulenguez <nicolas@debian.org>
--
--  This program is free software: you can redistribute it and/or
--  modify it under the terms of the GNU General Public License as
--  published by the Free Software Foundation, either version 3 of the
--  License, or (at your option) any later version.
--  This program is distributed in the hope that it will be useful, but
--  WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--  General Public License for more details.
--  You should have received a copy of the GNU General Public License
--  along with this program. If not, see <http://www.gnu.org/licenses/>.
--
with Ada.Strings.Fixed;
with Ada.Text_IO;

with GNAT.Regpat;

package body Misc is

   function A_Line_Matches
     (File_Name : in String;
      Pattern   : in String)
     return Boolean
   is
      use Ada.Text_IO;
      use GNAT.Regpat;
      Matcher : constant Pattern_Matcher := Compile (Pattern);
      File : File_Type;
      Found : Boolean := False;
   begin
      Open (File, In_File, File_Name);
      while not End_Of_File (File) loop
         Found := Match (Matcher, Get_Line (File));
         exit when Found;
      end loop;
      Close (File);
      return Found;
   exception
      when others =>
         if Is_Open (File) then Close (File); end if;
         raise;
   end A_Line_Matches;

   procedure Capture_Output
     (Program_Name : in     String;
      Args         : in     GNAT.OS_Lib.Argument_List;
      Temp_File    :    out GNAT.OS_Lib.String_Access;
      Return_Code  :    out Integer)
   is
      use GNAT.OS_Lib;
      Fd       : File_Descriptor;
      Close_Ok : Boolean;
   begin
      Create_Temp_Output_File (Fd, Temp_File);
      if Fd = Invalid_FD then
         raise Subprocess_Error with "GNAT.OS_Lib.Create_Temp_Output_File";
      end if;
      Spawn (Program_Name, Args, Fd, Return_Code, Err_To_Out => False);
      Close (Fd, Close_Ok);
      if not Close_Ok then
         raise Subprocess_Error with "GNAT.OS_Lib.Close";
      end if;
   exception
      when others =>
         if Temp_File /= null then
            Ada.Directories.Delete_File (Temp_File.all);
            Free (Temp_File);
         end if;
         raise;
   end Capture_Output;

   procedure Capture_Output
     (Program_Name : in     String;
      Args         : in     GNAT.OS_Lib.Argument_List;
      Temp_File    :    out GNAT.OS_Lib.String_Access)
   is
      Return_Code : Integer;
   begin
      Capture_Output (Program_Name, Args, Temp_File, Return_Code);
      if Return_Code /= 0 then
         Raise_Subprocess_Error (Program_Name, Args, Return_Code);
      end if;
   end Capture_Output;

   function Output_Of
     (Program_Name : in String;
      Args         : in GNAT.OS_Lib.Argument_List)
     return String
   is
      use Ada.Text_IO;
      use GNAT.OS_Lib;
      Temp_File   : String_Access;
      Return_Code : Integer;
      File        : File_Type;
   begin
      Capture_Output (Program_Name, Args, Temp_File, Return_Code);
      if Return_Code /= 0 then
         raise Subprocess_Error with
           Program_Name & " returned " & Integer'Image (Return_Code);
      end if;
      Open (File, In_File, Temp_File.all);
      return Result : constant String := Get_Line (File) do
         if not End_Of_File (File) then
            raise Multiline_Output with
              Program_Name & " did output many lines";
         end if;
         Close (File);
         Ada.Directories.Delete_File (Temp_File.all);
         Free (Temp_File);
      end return;
   exception
      when others =>
         if Is_Open (File) then
            Close (File);
         end if;
         if Temp_File /= null then
            Ada.Directories.Delete_File (Temp_File.all);
            Free (Temp_File);
         end if;
         raise;
   end Output_Of;

   procedure Raise_Subprocess_Error
     (Program_Name : in String;
      Args         : in GNAT.OS_Lib.Argument_List;
      Return_Code  : in Integer)
   is
      use Ada.Text_IO;
   begin
      New_Line (Standard_Error);
      Put (Standard_Error, Program_Name);
      for Arg of Args loop
         Put (Standard_Error, ' ');
         Put (Standard_Error, Arg.all);
      end loop;
      Put (Standard_Error, " returned ");
      Put_Line (Standard_Error, Integer'Image (Return_Code));
      raise Subprocess_Error;
   end Raise_Subprocess_Error;

   function Relative_Path
     (Target           : in String;
      Source_Directory : in String := Ada.Directories.Current_Directory)
     return String
   is
      use Ada.Strings.Fixed;
      S : constant String := Ada.Directories.Full_Name (Source_Directory);
      T : constant String := Ada.Directories.Full_Name (Target);
      S_I        : Integer range S'First .. S'Last + 1 := S'First;
      T_I        : Integer range T'First .. T'Last + 1 := T'First;
      Last_Slash : Integer range T'First - 1 .. T'Last := T'First - 1;
   begin
      loop
         pragma Assert (S (S'First .. S_I - 1) = T (T'First .. T_I - 1));
         if T_I = T'Last + 1 then
            if S_I = S'Last + 1 then    --  S = T
               return ".";
            elsif S (S_I) = '/' then    --  S contains T
               return ".." & Count (S (S_I + 1 .. S'Last), "/") * "/..";
            end if;
            exit;
         elsif T (T_I) = '/' then
            if S_I = S'Last + 1 then    --  T contains S
               return T (T_I + 1 .. T'Last);
            end if;
            exit when S (S_I) /= '/';
            Last_Slash := T_I;
         else
            exit when S_I = S'Last + 1 or else S (S_I) /= T (T_I);
         end if;
         S_I := S_I + 1;
         T_I := T_I + 1;
      end loop;
      return (1 + Count (S (S_I .. S'Last), "/")) * "../"
        & T (Last_Slash + 1 .. T'Last);
   end Relative_Path;

end Misc;
