File : adagio-folder.adb


------------------------------------------------------------------------------

--                         ADAGIO - ADALID - AENEA.                         --

--                                                                          --

--                            Copyright (C) 2003                            --

--                                 A. Mosteo.                               --

--                                                                          --

--  Authors: A. Mosteo. (adagio@mosteo.com)                                 --

--                                                                          --

--  If you have any questions in regard to this software, please address    --

--  them to the above email.                                                --

--                                                                          --

--  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 2 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 library; if not, write to the Free Software Foundation, --

--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --

--                                                                          --

--  You are not allowed to use any part of this code to develop a program   --

--  whose output would be used to harass or prosecute other users of the    --

--  networks Adagio connects with. All data collected with Adagio or a tool --

--  containing Adagio code about other network users must remain            --

--  confidential and cannot be made public by any mean, nor be used to      --

--  harass or legally prosecute these users.                                --

------------------------------------------------------------------------------

--  $Id: adagio-folder.adb,v 1.7 2004/01/21 21:05:28 Jano Exp $


with Adagio.Trace;
with Dynamic_vector;

with Gnat.Directory_operations;
with Gnat.Os_lib;

use Gnat;

package body Adagio.Folder is

   use type File_list.Iterator_type;

   package GDO renames Gnat.Directory_operations;

   package Folder_vector is new Dynamic_vector (Object);
   package File_vector is new Dynamic_vector (File.Object);

   -- Quick access

   function V (this : in Object) return Folder_access is
   begin
      return Safe_folder.Value (Safe_folder.Object (this));
   end V;

   -- Full qualified name for folder:

   function Path (this : in Object) return String is
   begin
      return S (V (this).Path);
   end Path;

   -- Creation:

   procedure Create (
      this   : out Object;
      Path   : in  String;
      Shared : in  Boolean := true;
      Rescan : in Duration:= Duration'Last) is

      F : Folder_access;
   begin
      if Path'Length > MAX_LENGTH then
         raise Constraint_error;
      end if;
      F := new Folder_object;
      Safe_folder.Bind (Safe_folder.Object (this), F);

      F.Path   := U (GDO.Format_pathname (Path, GDO.Unix));
      F.Shared := Shared;
      F.Rescan_period := Rescan;
      -- Timestamp:

      begin
         F.Timestamp := Os_lib.File_time_stamp (Path);
      exception
         when E: others =>
            Trace.Log("Folder.Create " & Path & " searching timestamp: " &
            Trace.Report(E));
      end;
   end Create;

   -- Real existence. Says if it really matchs a existing folder

   function Exists (this : in Object) return boolean is
   begin
      return Os_lib.Is_directory (Path (this));
   end Exists;

   -- Sharing:

   procedure Share (this: in out Object; Shared : in Boolean := true) is
   begin
      V (this).Shared := Shared;
   end Share;

   -- Refresh all contents

   -- Files changed will lost its sha1

   procedure Refresh (this : in out Object) is

      Dir  : GDO.Dir_type;
      Name : String (1 .. MAX_LENGTH);
      Last : Natural;
      New_file : File.Object;

   begin
      -- Check files already known:

      declare
         I : File_list.Iterator_type := File_list.First (V (this).Files);
         J : File_list.Iterator_type;
      begin
         while I /= File_list.Back (V (this).Files) loop
            if not Os_lib.Is_regular_file (File.Path (File_list.Element (I)))
            then
               -- Remove a non-existent file:

               J := File_list.Succ (I);
               File_list.Delete (V (this).Files, I);
               I := J;
            else
               I := File_list.Succ (I);
            end if;
         end loop;
      end;

      -- Check files in physical path:

      GDO.Open (Dir, Path (this));
      loop
         GDO.Read (Dir, Name, Last);
         exit when Last = 0;
         declare
            N : String := Name (Name'First .. Last);
         begin
            delay 0.001;
            if N /= "." and then N /= ".." then
               if Os_lib.Is_directory (Path (this) & N) then
                  null; -- For the moment, we do nothing with it

               else
                  -- Regular file, process it:

                  if Contains (this, Path (this) & N) then
                     -- Changed timestamp?

                     declare
                        Old_file : File.Object := Get_file (
                           this, Path (this) & N);
                        use type Os_lib.Os_time;
                     begin
                        if Os_lib.File_time_stamp (Path (this) & N) /=
                           File.Timestamp (Old_file) then
                           -- Reset sha1

                           File.Reset (Old_file);
                        end if;
                     exception
                        when E : others =>
                           -- If any error, remove the file:

                           Trace.Log ("Folder.Refresh: Removed " & N &
                              " because: " & Trace.Report (E));
                           Remove_file (this, Old_file);
                     end;
                  else
                     -- Simply add it:

                     New_file := File.Create (Path (this) & N);
                     File.Refresh (New_file);
                     Add_file (this, New_file);
                  end if;
               end if;
            end if;
         exception
            when E : others =>
               Trace.Log ("Folder.Refresh: " & Trace.Report (E));
         end;
      end loop;
      GDO.Close (Dir);
   end Refresh;

   -- Has files this folder?

   function Has_files (this : in Object) return boolean is
   begin
      return not File_list.Is_empty (V (this).Files);
   end Has_files;

   -- Files:

   function Files (this : in Object) return File.Object_array is
      Result : File_vector.Object (1);
      I      : File_list.Iterator_type := File_list.First (V (this).Files);
   begin
      while I /= File_list.Back (V (this).Files) loop
         File_vector.Append (Result, File_list.Element (I));
         I := File_list.Succ (I);
      end loop;

      return
         File.Object_array (Result.Vector (1 .. File_vector.Last (Result)));
   end Files;

   -- Folders

   function Folders (this : in Object) return Folder.Object_array is
      Result : Folder_vector.Object (1);
      Dir    : GDO.Dir_type;
      Name   : String (1 .. MAX_LENGTH);
      Last   : Integer;
      New_dir: Object;
   begin
      GDO.Open (Dir, Path (this));
      loop
         GDO.Read (Dir, Name, Last);
         exit when Last = 0;
         begin
            if Name (1 .. Last) /= "." and then
               Name (1 .. Last) /= ".." and then
               Os_lib.Is_directory (Path (this) & Name (1 .. Last))
            then
               Create (New_dir, Path (this) & Name (1 .. Last));
               Folder_vector.Append (Result, New_dir);
            end if;
         exception
            when E : others =>
               Trace.Log ("Folder.Folders: " & Trace.Report (E),
                  Trace.Warning);
         end;
      end loop;
      GDO.Close (Dir);
      return Object_array (Result.Vector (1 .. Folder_vector.Last (Result)));
   end Folders;

   -- Iterate over files/folders. Return the corresponding null object

   --    when end reached.

   procedure Open_files   (This : in out Object) is
      F : Folder_access renames V (This);
   begin
      F.File_pos := File_list.First (F.Files);
   end Open_files;

   procedure Open_folders (This : in out Object) is
   begin
      GDO.Open (V (This).Folder_pos, Path (this));
   end Open_folders;

   -- Close will be automatically called when end reached

   function  Next_file   (This : in Object) return File.Object is
      F : Folder_access renames V (This);
      use File_list;
      result : File.Object;
   begin
      if F.File_pos /= Back (F.Files) then
         Result     := Element (F.File_pos);
         F.File_pos := Succ (F.File_pos);
         return Result;
      else
         return File.Null_file;
      end if;
   end Next_file;

   function  Next_folder (This : in Object) return Folder.Object is
      Name   : String (1 .. MAX_LENGTH);
      Last   : Integer;
      F      : Folder_access renames V (This);
   begin
      loop -- Will break when ok file found.

         GDO.Read (F.Folder_pos, Name, Last);
         if Last = 0 then
            GDO.Close (V (This).Folder_pos);
            return Null_folder;
         else
            declare
               Result : Object;
            begin
               if Name (1 .. Last) /= "." and then
                  Name (1 .. Last) /= ".." and then
                  Os_lib.Is_directory (Path (this) & Name (1 .. Last))
               then
                  Create (Result, Path (this) & Name (1 .. Last));
                  return Result;
               else
                  -- Must check next entry since this isn't a folder.

                  null;
               end if;
            exception
               when E : others =>
                  Trace.Log ("Folder.Folders: " & Trace.Report (E),
                     Trace.Warning);
                  GDO.Close (V (This).Folder_pos);
                  raise;
            end;
         end if;
      end loop;
   end Next_folder;

   -- For closing if not full listing done:

   procedure Close_files   (This : in out Object) is
      pragma Unreferenced (This);
   begin
      null;
   end Close_files;

   procedure Close_folders (This : in out Object) is
   begin
      GDO.Close (V (This).Folder_pos);
   end Close_folders;

   -- Add a file

   procedure Add_file(this: in out Object; New_file : in File.Object) is
   begin
      File_list.Insert (V (this).Files, File.Path (New_file), New_file);
   end Add_file;

   -- Remove

   procedure Remove_file(this : in out Object; Old_file : File.Object) is
   begin
      File_list.Delete (V (this).Files, File.Path (Old_file));
   end Remove_file;

    -- Check for membership:

   function Contains(this : in Object; Name : in String) return boolean is
   begin
      return File_list.Is_in (Name, V (this).Files);
   end Contains;

   -- Get a file (exception if not found):

   function Get_file(this : in Object; Name : in String) return File.Object is
   begin
      return File_list.Element (File_list.Find (V (this).Files, Name));
   end Get_file;

   -- Serialize to stream:

   procedure Serialize
     (this   : in Object;
      Stream : in out Ada.Streams.Root_stream_type'Class) is

      I : File_list.Iterator_type := File_list.First (V (this).Files);

   begin
      String'Output         (Stream'access, Path (this));
      Boolean'Output        (Stream'access, V (this).Shared);
      Os_lib.Os_time'Output (Stream'access, V (this).Timestamp);
      -- Files

      Integer'Write (Stream'access, File_list.Length (V (this).Files));
      while I /= File_list.Back (V (this).Files) loop
         File.Serialize (File_list.Element (I), Stream);
         I := File_list.Succ (I);
      end loop;
   end Serialize;

   procedure Restore (
      this   : out Object;
      Stream : in out Ada.Streams.Root_stream_type'Class) is

      Num      : Integer;
      New_file : File.Object;
   begin
      declare
         S : String := String'Input          (Stream'Access);
      begin
         Create (this, S);
      end;
      V (this).Shared    := Boolean'Input        (Stream'Access);
      V (this).Timestamp := Os_lib.Os_time'Input (Stream'Access);
      -- Files

      File_list.Clear (V (this).Files);
      Integer'Read    (Stream'Access, Num);
      for I in 1 .. Num loop
         -- Read file

         File.Restore (New_file, Stream);
         -- Insert into list

         File_list.Insert (V (this).Files, File.Path (New_file), New_file);
      end loop;
   end Restore;

   -- Finalization

   -- Let's delete the file list

   procedure Finalize(this : in out Folder_object) is
   begin
      File_list.Clear (this.Files);
   end Finalize;

   -- Get refresh time:

   function Rescan_period (this : in Object) return Duration is
   begin
      return V (this).Rescan_period;
   end Rescan_period;

   procedure Set_rescan_period (
      this : in out Object; Rescan_period : Duration) is
   begin
      V (this).Rescan_period := Rescan_period;
   end Set_rescan_period;

   function Last_scan (this : in Object) return Time is
   begin
      return V (this).Last_scan;
   end Last_scan;

   procedure Mark_scan (this : in out Object) is
   begin
      V (this).Last_scan := Clock;
   end Mark_scan;

end Adagio.Folder;