save_modif.hac

--  #!/usr/bin/env hac

--  This HAC script detects changes between two commits and
--  saves the repository's modified files into a Zip-ball.
--
--  Version Control Systems supported:
--  git, hg (mercurial), svn (subversion)

with HAT;

procedure Save_Modif is

  use HAT;

  function Nice_Date (with_intraday : Boolean) return VString is
    t1 : constant Time := Clock;
    day_secs, day_mins : Integer;
    just_day : VString;
    --
    function Two_Digits (x : Integer) return VString is
    begin
      if x < 10 then
        return "0" & Image (x);
      else
        return Image (x);
      end if;
    end Two_Digits;
    --
  begin
    day_secs := Integer (Seconds (t1));
    day_mins := day_secs / 60;
    just_day := +"" &  --  VString concatenation
      Year (t1)  & '-' &
      Two_Digits (Month (t1)) & '-' &
      Two_Digits (Day (t1));
    if with_intraday then
      return just_day & "--" &
      Two_Digits (day_mins / 60) & '-' &
      Two_Digits (day_mins mod 60) & '-' &
      Two_Digits (day_secs mod 60);
    else
      return just_day;
    end if;
  end Nice_Date;

  line, nd, root, mod_zip, files : VString;
  f : File_Type;

  log_name : constant VString := +"modif.log";
  sep : constant Character := Directory_Separator;

  type VCS_Type is (None, Git, Mercurial, Subversion);

  function Detect_VCS return VCS_Type is
  begin
    if Directory_Exists (".git") then
      return Git;
    elsif Directory_Exists (".hg") then
      return Mercurial;
    elsif Directory_Exists (".svn") then
      return Subversion;
    end if;
    return None;
  end Detect_VCS;

  function Abbreviation (vcs : VCS_Type) return VString is
  begin
    case vcs is
      when Git        => return +"git";
      when Mercurial  => return +"hg";
      when Subversion => return +"svn";
      when None       => return +"";
    end case;
  end Abbreviation;

  vcs : constant VCS_Type := Detect_VCS;
  col_name : Integer;
  add_line : Boolean;

begin
  Put_Line ("Save date: " & Nice_Date (True));
  Put_Line ("Version Control System: " & VCS_Type'Image (vcs));
  Put_Line ("-----");
  root := Tail_After_Match (Current_Directory, sep);
  files := root & sep & log_name;

  case vcs is
    when Git        => Shell_Execute (+"git status -s -uno >" & log_name); col_name := 4;
    when Mercurial  => Shell_Execute (+"hg  status    -q   >" & log_name); col_name := 3;
    when Subversion => Shell_Execute (+"svn status    -q   >" & log_name); col_name := 9;
    when None       => return;
  end case;

  Open (f, log_name);
  while not End_Of_File (f) loop
    Get_Line (f, line);
    if Length (line) > 3 and then not Ends_With (line, ".out") then
      add_line := False;
      for col_tag in 1 .. 2 loop  --  Git tags are on two columns
        case Element (line, col_tag) is
          when ' ' | 'D' | 'R' | '!' =>
            --  Ignore extra lines, or missing items, or items to be Deleted / Removed
            null;
          when others =>
            add_line := True;
        end case;
      end loop;
      if add_line then
        line := root & sep & Slice (line, col_name, Length (line));
        Put_Line (line);
        files := files & ' ' & line;
      end if;
    end if;
  end loop;
  Close (f);
  Put_Line ("-----");
  New_Line;

  --  Shell_Execute ("echo . >>" & log_name);
  --  Shell_Execute ("echo --- SVN Info --- >>" & log_name);
  --  Shell_Execute ("svn info >>" & log_name);

  nd := Nice_Date (True);

  mod_zip := root & sep & root & "-modif-" & Abbreviation (vcs) & '-' & nd & ".zip";

  Set_Directory ("..");
  Shell_Execute ("zipada -ep2 " & mod_zip & ' ' & files);
  Set_Directory (root);
  --  Delete_File (log_name);

  Put ("Press Return ");
  Skip_Line;
end Save_Modif;