agpl_1.0.0_b5da3320/src/agpl-safe_file.adb

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
 

--  Facilities for saving/loading from a file in a way that it doesn't
--  overwrite the previous version.
--  When opening for writing, a temporary is used. After completion, the
--  original file is removed and the temporary renamed.
--  When opening for reading, regular filename is tried. If missing, a check
--  for a temporary is made, and if it exists, it is renamed to the regular
--  name and opened. If neither regular and temporary exists, error.

with Agpl.Exceptions;

with Ada.Streams.Stream_IO;
use  Ada.Streams.Stream_IO;

with Gnat.Os_lib;
use  Gnat;

package body Agpl.Safe_file is

   ------------------------------------------------------------------------
   -- Exists_for_reading                                                 --
   ------------------------------------------------------------------------
   function Exists_for_reading (Name : in String) return Boolean is
   begin
      return Os_lib.Is_regular_file (Name) or else
             Os_lib.Is_regular_file (Name & ".tmp");
   end Exists_for_reading;

   ------------------------------------------------------------------------
   -- Get_Real_Name                                                      --
   ------------------------------------------------------------------------
   --  Gets the real name found (i.e. the supplied or the backup one
   function Get_Real_Name (Name : in String) return String is
   begin
      if Os_Lib.Is_Regular_File (Name) then
         return Name;
      elsif Os_Lib.Is_Regular_File (Name & ".tmp") then
         return Name & ".tmp";
      else
         raise File_Not_Found;
      end if;
   end Get_Real_Name;

   ------------------------------------------------------------------------
   -- Open                                                               --
   ------------------------------------------------------------------------
   --  Accepts In_file and Out_file
   procedure Open (
      File : in out Stream_IO.File_type;
      Mode : in     Stream_IO.File_mode;
      Name : in     String := "";
      Form : in     String := "")
   is
      Success : Boolean;
   begin
      case Mode is
         when In_file =>
            if Os_lib.Is_regular_file (Name & ".tmp") and
               not Os_lib.Is_regular_file (Name)
            then
               Os_lib.Rename_file (Name & ".tmp", Name, Success);
               if not Success then
                  raise Storage_Error;
               end if;
            end if;
            Stream_io.Open (File, Mode, Name, Form);
         when Out_file =>
            Stream_io.Create (File, Mode, Name & ".tmp", Form);
         when Append_file =>
            raise Exceptions.Unimplemented;
      end case;
   end Open;

   ------------------------------------------------------------------------
   -- Close                                                              --
   ------------------------------------------------------------------------
   procedure Close (File : in out Stream_IO.File_type) is
      Filename : constant String := Stream_IO.Name (File);
      Success  : Boolean;
   begin
      case Mode (File) is
         when In_file =>
            Stream_IO.Close (File);
         when Out_file =>
            Stream_IO.Close (File);
            --  Delete previous, if exists:
            if Os_lib.Is_regular_file (
               Filename (Filename'First .. Filename'Last - 4))
            then
               Os_lib.Delete_file (
                  Filename (Filename'First .. Filename'Last - 4), Success);
               if not Success then
                  raise Storage_Error;
               end if;
            end if;
            --  Rename file:
            Os_lib.Rename_file (
               Filename,
               Filename (Filename'First .. Filename'Last - 4),
               Success);
            if not Success then
               raise Storage_Error;
            end if;
         when Append_file =>
            raise Exceptions.Unimplemented;
      end case;
   end Close;

end Agpl.Safe_file;