-------------------------------------------------------------------------------
--
--  <STRONG>Copyright &copy; 2001, 2002 by Thomas Wolf.</STRONG>
--  <BLOCKQUOTE>
--    This piece of software 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. This software 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>
--  <BLOCKQUOTE>
--    As a special exception from the GPL, if other files instantiate generics
--    from this unit, or you link this unit with other files to produce an
--    executable, this unit does not by itself cause the resulting executable
--    to be covered by the GPL. This exception does not however invalidate any
--    other reasons why the executable file might be covered by the GPL.
--  </BLOCKQUOTE>
--
--  <AUTHOR>
--    Thomas Wolf  (TW) <E_MAIL>
--  </AUTHOR>
--
--  <PURPOSE>
--    Provides a generic function to unconditionally open (or create) a file.
--  </PURPOSE>
--
--  <NOT_TASK_SAFE>
--
--  <NO_STORAGE>
--
--  <HISTORY>
--    02-MAR-2002   TW  Initial version.
--  </HISTORY>
-------------------------------------------------------------------------------

pragma License (Modified_GPL);

with Ada.Exceptions;
with Ada.Finalization;
with Ada.IO_Exceptions;
with Ada.Streams.Stream_IO;
with Ada.Unchecked_Deallocation;

with Util.Pathes;

package body Util.Files is

   procedure Open_G
     (File : in out File_Type;
      Mode : in     File_Mode;
      Name : in     String;
      Form : in     String := "")
   is
   begin
      Open (File, Mode, Name, Form);
   exception
      when Ada.IO_Exceptions.Name_Error =>
         Create (File, Mode, Name, Form);
   end Open_G;

   procedure Copy_File
     (From      : in String;
      To        : in String      := "";
      Overwrite : in Boolean     := False;
      Buffer    : in Buffer_Size := Default_Buffer_Size)
   is
      use Util.Pathes;
      Source_Name : constant String := Name (From);
   begin
      if Source_Name'Length = 0 then
         raise Ada.IO_Exceptions.Use_Error;
      end if;
      if To'Length = 0 then
         Copy (From, Source_Name, Overwrite, Buffer);
      elsif Name (To)'Length = 0 then
         Copy (From, Concat (To, Source_Name), Overwrite, Buffer);
      else
         Copy (From, To, Overwrite, Buffer);
      end if;
   end Copy_File;

   type Copier
     (Src_Name  : access String;
      Tgt_Name  : access String;
      Buf_Size  : Buffer_Size;
      Overwrite : Boolean;
      Error     : access Ada.Exceptions.Exception_Occurrence)
     is new Ada.Finalization.Limited_Controlled with null record;

   type Buffer_Ptr is access Ada.Streams.Stream_Element_Array;

   procedure Free is
      new Ada.Unchecked_Deallocation
            (Ada.Streams.Stream_Element_Array, Buffer_Ptr);

   procedure Finalize
     (Copy : in out Copier)
   is
      use Ada.Streams;
      use Ada.Streams.Stream_IO;

      function Get_Buffer
        (File_Size : in Count;
         Requested : in Buffer_Size)
        return Buffer_Ptr
      is
         Min, Max : Stream_Element_Count;
      begin
         begin
            Min := Stream_Element_Count (Requested);
         exception
            when Constraint_Error =>
               Min := Stream_Element_Count'Last;
         end;
         begin
            Max := Stream_Element_Count (File_Size);
         exception
            when Constraint_Error =>
               Max := Stream_Element_Count'Last;
         end;
         Max := Stream_Element_Count'Min (Min, Max);
         --  Now get the largest possible buffer smaller than 'Max'...
         declare
            Min    : constant Stream_Element_Count := 2 ** 10;
            --  ... but at least 1k!
            Result : Buffer_Ptr;
         begin
            while Result = null loop
               begin
                  Result := new Stream_Element_Array (1 .. Max);
               exception
                  when Storage_Error =>
                     --  Try a smaller buffer size, but make sure that we
                     --  *do* try the minimum size.
                     if Max > Min and then Max < 2 * Min then
                        Max := Min;
                     else
                        Max := Max / 2;
                     end if;
                     if Max < Min then
                        raise Storage_Error;
                     end if;
                     Result := null;
               end;
            end loop;
            return Result;
         end;
      end Get_Buffer;

      Source, Target : File_Type;
      Buffer         : Buffer_Ptr;
      Length         : Count;
   begin
      --  First try to open the source file.
      Open (Source, In_File, Copy.Src_Name.all);
      --  Now try to open the target file. First with mode 'In_File'!
      begin
         Open (Target, In_File, Copy.Tgt_Name.all);
         --  Ok, the file is there.
         Close (Target);
         if not Copy.Overwrite then raise File_Exists; end if;
         Open (Target, Out_File, Copy.Tgt_Name.all);
      exception
         when Name_Error =>
            --  File doesn't exist. Try to create it.
            Create (Target, Out_File, Copy.Tgt_Name.all);
      end;
      --  Both files are open. Check for empty source.
      Length := Size (Source);
      if End_Of_File (Source) or else Length = 0 then
         Close (Source); Close (Target); return;
      end if;
      Buffer := Get_Buffer (Length, Copy.Buf_Size);
      --  Now start copying.
      Copy_Chunks :
      declare
         Last : Stream_Element_Offset;
      begin
         while not End_Of_File (Source) loop
            Read_Chunk :
            declare
               Current : constant Positive_Count := Index (Source);
            begin
               Read (Source, Buffer.all, Last);
            exception
               when End_Error =>
                  --  I don't think this should happen, but just in case it
                  --  does...
                  if Current <= Length then
                     Set_Index (Source, Current);
                     Read (Source,
                           Buffer
                             (Buffer'First ..
                              Buffer'First +
                                Stream_Element_Offset (Length  - Current)),
                           Last);
                  else
                     --  Nothing left to read or write.
                     exit;
                  end if;
            end Read_Chunk;
            Write (Target, Buffer (Buffer'First .. Last));
            exit when Last < Buffer'Last;
         end loop;
      end Copy_Chunks;
      Close (Target);
      --  Target is safe now!
      begin
         Close (Source); Free (Buffer);
      exception
         when others => null;
      end;
   exception
      when E : others =>
         --  Source
         begin
            if Is_Open (Source) then Close (Source); end if;
         exception
            when others => null;
         end;
         --  Target
         begin
            if Is_Open (Target) then
               if Mode (Target) = Out_File then
                  begin
                     Delete (Target);
                  exception
                     when others =>
                        Close (Target);
                  end;
               else
                  Close (Target);
               end if;
            end if;
         exception
            when others => null;
         end;
         --  Buffer
         begin
            Free (Buffer);
         exception
            when others => null;
         end;
         Ada.Exceptions.Save_Occurrence (Copy.Error.all, E);
   end Finalize;

   procedure Copy
     (From      : in String;
      To        : in String;
      Overwrite : in Boolean;
      Buffer    : in Buffer_Size)
   is
      Error : aliased Ada.Exceptions.Exception_Occurrence;
   begin
      declare
         Src     : aliased String := From;
         Tgt     : aliased String := To;
         Do_Copy : Copier (Src'Access, Tgt'Access,
                           Buffer,
                           Overwrite,
                           Error'Access);
         pragma Warnings (Off, Do_Copy); --  silence -gnatwa
      begin
         null;
         --  Finalization of 'Do_Copy' will copy the file.
      end;
      declare
         use Ada.Exceptions;
      begin
         if Exception_Identity (Error) = Null_Id then
            Reraise_Occurrence (Error);
         end if;
      end;
   end Copy;

end Util.Files;
