-------------------------------------------------------------------------------
--
--  This file is part of AdaBrowse.
--
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
--    AdaBrowse 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 2, or (at your option) any
--    later version. AdaBrowse is distributed in the hope that it will be
--    useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
-- </BLOCKQUOTE>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
--   Thomas Wolf  (TW)
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
--   Provides routines operating on files. Used to insulate the rest of
--   AdaBrowse from OS-specifics.</DL>
--
-- <!--
-- Revision History
--
--   04-FEB-2002   TW  Initial version for AdaBrowse 1.01.
--   07-FEB-2002   TW  Added support in 'Create_Unit' for opeions and file
--                     names with embedded white space. Correctly handles
--                     quoting of arguments now.
--   19-MAR-2002   TW  'Create_Unit' accepts now a name with a path component.
--                     New operation 'Is_Absolute_Path', and 'Path' now also
--                     returns the final directory separator.
--   08-JUN-2003   TW  Moved 'Create_Unit' to package AD.Compiler.
--   19-NOV-2003   TW  Added 'Is_Directory' and 'Last_Modified'.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Calendar;
with Ada.Streams.Stream_IO;
with Ada.Strings.Fixed;

with Util.Calendar.IO;
with Util.Pathes;
with Util.Strings;

with GAL.Support.Comparisons;
pragma Elaborate_All (GAL.Support.Comparisons);

package body AD.File_Ops is

   package ASF renames Ada.Strings.Fixed;
   package ASU renames Ada.Strings.Unbounded;

   use Util.Strings;

   procedure Delete (Name : in String)
   is
      use Ada.Streams.Stream_IO;
      F : File_Type;
   begin
      Open (F, In_File, Name);
      Delete (F);
   exception
      when others =>
         null;
   end Delete;

   function Exists (Name : in String)
     return Boolean
   is
      use Ada.Streams.Stream_IO;
      F : File_Type;
   begin
      Open  (F, In_File, Name);
      Close (F);
      return True;
   exception
      when others =>
         begin
            if Is_Open (F) then Close (F); end if;
         exception
            when others =>
               null;
         end;
         return False;
   end Exists;

   function Find
     (Name    : in String;
      Options : in Ada.Strings.Unbounded.Unbounded_String)
     return String
   is

      function Find_Argument
        (S     : in     String;
         After : access Natural)
        return String
      is
         I         : Natural := Index (S, '-');
         Arg_Start : Natural;
      begin --  Find_Argument
         After.all := S'Last + 1;
         if I = 0 then return ""; end if;
         Arg_Start := I; I := I + 1;
         if Arg_Start > S'First and then S (Arg_Start - 1) = '"' then
            --  It's quoted.
            while I <= S'Last loop
               exit when S (I) = '"' and then S (I - 1) /= '\';
               I := I + 1;
            end loop;
            After.all := I + 1;
            --  Now we have the contents of a quoted argument from Arg_Start
            --  to I-1. Un-escape any quotes within:
            declare
               Result  : String (1 .. I - Arg_Start);
               K       : Natural := 1;
            begin
               for J in Arg_Start .. I - 1 loop
                  if J > Arg_Start and then
                     S (J) = '"' and then S (J - 1) = '\'
                  then
                     K := K - 1;
                  end if;
                  Result (K) := S (J);
                  K := K + 1;
               end loop;
               return Result (1 .. K - 1);
            end;
         else
            --  It's not quoted: just continue until you hit a white space
            I := ASF.Index (S (I .. S'Last), Blanks);
            if I = 0 then I := S'Last + 1; end if;
            After.all := I;
            return S (Arg_Start .. I - 1);
         end if;
      end Find_Argument;

   begin --  Find;
      if Exists (Name) then return Name; end if;
      if Util.Pathes.Is_Absolute_Path (Name) then return ""; end if;
      if ASU.Length (Options) > 0 then
         declare
            Dirs : constant String  := ASU.To_String (Options);
            I    : aliased  Natural := Dirs'First;
            N    : constant String  := Util.Pathes.Name (Name);
         begin
            while I <= Dirs'Last loop
               declare
                  Arg : constant String :=
                    Find_Argument (Dirs (I .. Dirs'Last), I'Access);
               begin
                  exit when Arg'Last < Arg'First;
                  declare
                     Full_Name : constant String :=
                       Util.Pathes.Concat (Arg (Arg'First + 2 .. Arg'Last), N);
                  begin
                     if Exists (Full_Name) then
                        return Full_Name;
                     end if;
                  end;
               end;
            end loop;
         end;
      end if;
      return "";
   end Find;

   procedure Create_Unique_File
     (File      :    out Ada.Text_IO.File_Type;
      Name      :    out Ada.Strings.Unbounded.Unbounded_String;
      Base_Name : in     String;
      Extension : in     String)
   is

      function Time_Image
        (Secs : in Ada.Calendar.Day_Duration)
        return String
      is
         S : String  := Util.Calendar.IO.Image (Secs, 2);
         J : Natural := S'First;
      begin
         --  Strip out all non-digits.
         for I in S'Range loop
            if S (I) >= '0' and then S (I) <= '9' then
               S (J) := S (I); J := J + 1;
            end if;
         end loop;
         return S (S'First .. J - 1);
      end Time_Image;

   begin
      for I in 1 .. 10 loop
         declare
            Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
         begin
            Ada.Text_IO.Create
              (File, Ada.Text_IO.Out_File,
               Base_Name &
               '_' & Util.Calendar.IO.Image (Now, Separator => "") &
               '_' & Time_Image (Ada.Calendar.Seconds (Now)) &
               '.' & Extension);
            Name := ASU.To_Unbounded_String (Ada.Text_IO.Name (File));
            return;
         exception
            when Ada.Text_IO.Name_Error =>
               null;
         end;
      end loop;
      Name := ASU.Null_Unbounded_String;
   end Create_Unique_File;

   function "<" (Left, Right : in Time_Stamp) return Boolean
   is
      use GNAT.OS_Lib;

      Y0, Y1   : Year_Type;
      M0, M1   : Month_Type;
      D0, D1   : Day_Type;
      HH0, HH1 : Hour_Type;
      MM0, MM1 : Minute_Type;
      SS0, SS1 : Second_Type;
      S0, S1   : Duration;

   begin
      GM_Split (OS_Time (Left),  Y0, M0, D0, HH0, MM0, SS0);
      GM_Split (OS_Time (Right), Y1, M1, D1, HH1, MM1, SS1);
      S0 := Duration (HH0) * 3600.0 + Duration (MM0) * 60.0 + Duration (SS0);
      S1 := Duration (HH1) * 3600.0 + Duration (MM1) * 60.0 + Duration (SS1);
      return Y0 < Y1 or else
             (Y0 = Y1 and then
              (M0 < M1 or else
               (M0 = M1 and then
                (D0 < D1 or else
                 (D0 = D1 and then S0 < S1)))));
   end "<";

   package Time_Ops is
      new GAL.Support.Comparisons (Time_Stamp, "<");

   function "<=" (Left, Right : in Time_Stamp) return Boolean
     renames Time_Ops."<=";

   function ">"  (Left, Right : in Time_Stamp) return Boolean
     renames Time_Ops.">";

   function ">=" (Left, Right : in Time_Stamp) return Boolean
     renames Time_Ops.">=";

   function Is_Directory
     (Name : in String)
     return Boolean
   is
   begin
      return GNAT.OS_Lib.Is_Directory (Name);
   exception
      when others =>
         return False;
   end Is_Directory;

   function Last_Modified
     (Name : in String)
     return Time_Stamp
   is
   begin
      if not (Is_Directory (Name) or else Exists (Name)) then
         raise Name_Error;
      end if;
      return Time_Stamp (GNAT.OS_Lib.File_Time_Stamp (Name));
   end Last_Modified;

end AD.File_Ops;