src/morzhol-vc-rcs.adb

   1 ------------------------------------------------------------------------------
   2 --                                Morzhol                                   --
   3 --                                                                          --
   4 --                           Copyright (C) 2007                             --
   5 --                      Pascal Obry - Olivier Ramonat                       --
   6 --                                                                          --
   7 --  This library is free software; you can redistribute it and/or modify    --
   8 --  it under the terms of the GNU General Public License as published by    --
   9 --  the Free Software Foundation; either version 2 of the License, or (at   --
  10 --  your option) any later version.                                         --
  11 --                                                                          --
  12 --  This library is distributed in the hope that it will be useful, but     --
  13 --  WITHOUT ANY WARRANTY; without even the implied warranty of              --
  14 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
  15 --  General Public License for more details.                                --
  16 --                                                                          --
  17 --  You should have received a copy of the GNU General Public License       --
  18 --  along with this library; if not, write to the Free Software Foundation, --
  19 --  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.       --
  20 ------------------------------------------------------------------------------
  21
  22 with Ada.Directories;
  23
  24 with GNAT.Expect;
  25 with GNAT.Regpat;
  26 with GNAT.OS_Lib;
  27
  28 with Morzhol.OS;
  29 with Morzhol.Strings;
  30
  31 package body Morzhol.VC.RCS is
  32
  33    use Ada;
  34    use GNAT;
  35
  36    use Morzhol.Strings;
  37
  38    Diff_Rev_Opt      : constant String := "-r";
  39    Ci_Author_Opt     : constant String := "-w";
  40
  41    Ci_Command        : aliased constant String := "ci";
  42    Ci_Opt            : aliased String := "-u";
  43
  44    Co_Command        : aliased constant String := "co";
  45    Co_Opt            : aliased String := "-l";
  46
  47    Log_Command       : aliased constant String := "rlog";
  48    Log_Total_Rev_Opt : aliased String := "-h";
  49
  50    Diff_Command      : aliased constant String := "rcsdiff";
  51
  52    function Commit
  53      (Engine           : in RCS;
  54       Filename         : in String;
  55       Message          : in String;
  56       Author           : in String;
  57       Initial_Revision : in Boolean) return Boolean;
  58    --  Commit or Add if Initial_Revision is True
  59
  60    -----------
  61    --  Add  --
  62    -----------
  63
  64    function Add
  65      (Engine   : in RCS;
  66       Filename : in String;
  67       Author   : in String := "") return Boolean
  68    is
  69       Local_RCS_Dir : constant String :=
  70                         Directories.Containing_Directory (Filename)
  71                         & OS.Directory_Separator & "RCS";
  72    begin
  73       if not Directories.Exists (Local_RCS_Dir) then
  74          Directories.Create_Directory (Local_RCS_Dir);
  75       end if;
  76
  77       return Commit
  78         (Engine           => Engine,
  79          Filename         => Filename,
  80          Message          => "File : " & Filename,
  81          Author           => Author,
  82          Initial_Revision => True);
  83    end Add;
  84
  85    --------------
  86    --  Commit  --
  87    --------------
  88
  89    function Commit
  90      (Engine   : in RCS;
  91       Filename : in String;
  92       Message  : in String;
  93       Author   : in String := "") return Boolean is
  94    begin
  95       return Commit
  96         (Engine           => Engine,
  97          Filename         => Filename,
  98          Message          => Message,
  99          Author           => Author,
 100          Initial_Revision => False);
 101    end Commit;
 102
 103    --------------
 104    --  Commit  --
 105    --------------
 106
 107    function Commit
 108      (Engine           : in RCS;
 109       Filename         : in String;
 110       Message          : in String;
 111       Author           : in String;
 112       Initial_Revision : in Boolean) return Boolean
 113    is
 114       pragma Unreferenced (Engine);
 115
 116       use type Expect.Expect_Match;
 117
 118       Pd          : Expect.Process_Descriptor;
 119       Result      : Expect.Expect_Match;
 120
 121       RCS_File    : aliased String := Filename;
 122       RCS_Message : OS_Lib.String_Access;
 123       RCS_Author  : OS_Lib.String_Access;
 124
 125    begin
 126       if Initial_Revision then
 127          RCS_Message := new String'("-t-" & Message);
 128       else
 129          RCS_Message := new String'("-m" & Message);
 130       end if;
 131
 132       if Author /= "" then
 133          RCS_Author := new String'(Ci_Author_Opt & Author);
 134       end if;
 135
 136       Expect.Non_Blocking_Spawn
 137         (Descriptor => Pd,
 138          Command    => Ci_Command,
 139          Args       =>
 140            OS_Lib.Argument_List'
 141            (1 => Ci_Opt'Access,
 142             2 => RCS_Author,
 143             3 => RCS_Message,
 144             4 => RCS_File'Unchecked_Access),
 145          Err_To_Out => True);
 146
 147       OS_Lib.Free (RCS_Author);
 148       OS_Lib.Free (RCS_Message);
 149
 150       Expect.Expect (Pd, Result, "done");
 151       Expect.Close (Pd);
 152
 153       return Result = 1;
 154
 155    exception
 156       when Expect.Invalid_Process | Expect.Process_Died =>
 157          OS_Lib.Free (RCS_Author);
 158          OS_Lib.Free (RCS_Message);
 159          return False;
 160    end Commit;
 161
 162    ------------
 163    --  Diff  --
 164    ------------
 165
 166    function Diff
 167      (Engine       : in RCS;
 168       Filename     : in String;
 169       From_Version : in String;
 170       To_Version   : in String)
 171      return String
 172    is
 173       pragma Unreferenced (Engine);
 174
 175       RCS_File : aliased String := Filename;
 176       Rev1     : aliased String := Diff_Rev_Opt & From_Version;
 177       Rev2     : aliased String := Diff_Rev_Opt & To_Version;
 178
 179       Status : aliased Integer;
 180       Result : Unbounded_String;
 181    begin
 182       Result := +Expect.Get_Command_Output
 183         (Command    => Diff_Command,
 184          Arguments  =>
 185            OS_Lib.Argument_List'(1 => Rev1'Unchecked_Access,
 186                                  2 => Rev2'Unchecked_Access,
 187                                  3 => RCS_File'Unchecked_Access),
 188          Input      => "",
 189          Status     => Status'Access,
 190          Err_To_Out => True);
 191
 192       return -Result;
 193    exception
 194       when Expect.Invalid_Process | Expect.Process_Died =>
 195          return -Result;
 196    end Diff;
 197
 198    ---------------
 199    --  Get_Log  --
 200    ---------------
 201
 202    function Get_Log
 203      (Engine   : in RCS;
 204       Filename : in String;
 205       Limit    : in Natural := 0) return Log
 206    is
 207       pragma Unreferenced (Engine, Limit);
 208       use type Expect.Expect_Match;
 209
 210       function Get_Revision_Number return Natural;
 211       --  Return the number of revision for that file
 212       --  or 0 if an error has occured
 213
 214       RCS_File : aliased String := Filename;
 215
 216       -------------------------
 217       -- Get_Revision_Number --
 218       -------------------------
 219
 220       function Get_Revision_Number return Natural is
 221
 222          Pd      : Expect.Process_Descriptor;
 223          Matched : Regpat.Match_Array (Regpat.Match_Count range 0 .. 1);
 224          Result  : Expect.Expect_Match;
 225       begin
 226          Expect.Non_Blocking_Spawn
 227            (Descriptor => Pd,
 228             Command    => Log_Command,
 229             Args       => OS_Lib.Argument_List'
 230               (1 => Log_Total_Rev_Opt'Access,
 231                2 => RCS_File'Unchecked_Access),
 232             Err_To_Out => True);
 233
 234          Expect.Expect
 235            (Descriptor => Pd,
 236             Result     => Result,
 237             Regexp     => "total revisions: (.*)",
 238             Matched    => Matched);
 239
 240          if Result = 1 then
 241             return Natural'Value
 242               (Expect.Expect_Out (Pd)
 243                  (Matched (1).First .. Matched (1).Last));
 244          else
 245             return 0;
 246          end if;
 247       end Get_Revision_Number;
 248
 249       Revision_Number : constant Natural := Get_Revision_Number;
 250
 251       Pd       : Expect.Process_Descriptor;
 252       File_Log : Log (1 .. Revision_Number);
 253       Current  : Positive := 1;
 254
 255    begin
 256       if Revision_Number = 0 then
 257          return File_Log;
 258       end if;
 259
 260       Expect.Non_Blocking_Spawn
 261         (Descriptor => Pd,
 262          Command    => Log_Command,
 263          Args       => OS_Lib.Argument_List'(1 => RCS_File'Unchecked_Access),
 264          Err_To_Out => True);
 265
 266       while Current <= Revision_Number loop
 267          Read_Out : declare
 268             Matched : Regpat.Match_Array (Regpat.Match_Count range 0 .. 4);
 269             Result  : Expect.Expect_Match;
 270             CL      : Commit_Log;
 271          begin
 272             Expect.Expect
 273               (Descriptor => Pd,
 274                Result     => Result,
 275                Regexp     => "\nrevision ([1-9\.]+)\ndate: (.*?);"
 276                & ".*author: (.*?);.*\n(.*)",
 277                Matched    => Matched);
 278
 279             CL.Revision :=
 280               +Expect.Expect_Out (Pd)
 281               (Matched (1).First .. Matched (1).Last);
 282             CL.Date :=
 283               +Expect.Expect_Out (Pd)
 284               (Matched (2).First .. Matched (2).Last);
 285             CL.Author :=
 286               +Expect.Expect_Out (Pd)
 287               (Matched (3).First .. Matched (3).Last);
 288             CL.Message :=
 289               +Expect.Expect_Out (Pd)
 290               (Matched (4).First .. Matched (4).Last);
 291
 292             File_Log (Current) := CL;
 293             Current := Current + 1;
 294          end Read_Out;
 295       end loop;
 296
 297       return File_Log;
 298
 299    exception
 300       when Expect.Invalid_Process | Expect.Process_Died =>
 301          return File_Log;
 302    end Get_Log;
 303
 304    ------------
 305    --  Lock  --
 306    ------------
 307
 308    function Lock
 309      (Engine : in RCS; Filename : in String) return Boolean
 310    is
 311       pragma Unreferenced (Engine);
 312       use type Expect.Expect_Match;
 313
 314       Local_RCS_Dir : constant String :=
 315                         Directories.Containing_Directory (Filename)
 316                         & OS.Directory_Separator & "RCS";
 317
 318       RCS_File  : aliased String := Filename;
 319       Pd        : Expect.Process_Descriptor;
 320       Result    : Expect.Expect_Match;
 321       Matched   : Regpat.Match_Array (Regpat.Match_Count range 0 .. 1);
 322
 323    begin
 324       if not Directories.Exists (Local_RCS_Dir) then
 325          Directories.Create_Directory (Local_RCS_Dir);
 326       end if;
 327
 328       Expect.Non_Blocking_Spawn
 329         (Descriptor => Pd,
 330          Command    => Co_Command,
 331          Args       => OS_Lib.Argument_List'(1 => Co_Opt'Access,
 332                                              2 => RCS_File'Unchecked_Access),
 333          Err_To_Out => True);
 334
 335       Expect.Expect (Pd, Result, "locked.*\n.*done.*", Matched);
 336
 337       if Result = 1 then
 338          Expect.Close (Pd);
 339          return True;
 340       end if;
 341
 342       return False;
 343    exception
 344       when Expect.Invalid_Process | Expect.Process_Died =>
 345       return False;
 346    end Lock;
 347
 348    --------------
 349    --  Remove  --
 350    --------------
 351
 352    function Remove (Engine : in RCS; Filename : in String) return Boolean is
 353       pragma Unreferenced (Engine);
 354    begin
 355       --  Nothing special to do here as RCS support only files
 356
 357       if Directories.Exists (Filename) then
 358          Directories.Delete_File (Filename);
 359          return True;
 360       end if;
 361
 362       return False;
 363    end Remove;
 364
 365 end Morzhol.VC.RCS;