Back to...

   1  ------------------------------------------------------------------------------
   2  --  File:            Comp_Zip_Prc.adb
   3  --  Description:     A Zip comparison tool using Zip-Ada lib.
   4  --                   Demonstrates the Zip.Traverse procedure.
   5  --                   See Comp_Zip for a command-line tool using it.
   6  --  Author:          Gautier de Montmollin
   7  ------------------------------------------------------------------------------
   8  
   9  with Ada.Characters.Handling,
  10       Ada.Integer_Text_IO,
  11       Ada.Text_IO;
  12  
  13  with Interfaces;
  14  
  15  with Zip;
  16  with UnZip.Streams;
  17  
  18  procedure Comp_Zip_Prc (
  19    z1, z2            :     Zip.Zip_Info;
  20    quiet             :     Natural;
  21    password          :     String := "";
  22    total_differences : out Natural
  23  )
  24  is
  25    use Interfaces;
  26    z : array (1 .. 2) of Zip.Zip_Info;
  27    total_1,
  28    total_2,
  29    common,
  30    size_failures,
  31    compare_failures,
  32    missing_1_in_2,
  33    just_a_directory,
  34    missing_2_in_1 : Natural := 0;
  35    total_bytes : Integer_64 := 0;
  36  
  37    first_item : Boolean := True;
  38  
  39    use Ada.Text_IO;
  40  
  41    procedure Compare_1_file (file_name : String) is
  42      use UnZip.Streams;
  43  
  44      f : array (1 .. 2) of Zipped_File_Type;
  45      s : array (1 .. 2) of Stream_Access;
  46      c : array (1 .. 2) of Character;
  47      p : Integer_64 := 1;
  48  
  49      function Cut_name (n : String; l : Natural) return String is
  50        dots : constant String := "...";
  51      begin
  52        if n'Length > l then
  53          return dots & n (n'Last - (l - 1) + dots'Length .. n'Last);
  54        else
  55          return n;
  56        end if;
  57      end Cut_name;
  58  
  59      l : constant := 40;
  60      mininame : constant String := Ada.Characters.Handling.To_Lower (Cut_name (file_name, l));
  61      stuffing : constant String (1 .. l - mininame'Length + 1) := (others => ' ');
  62  
  63    begin
  64      if quiet = 0 then
  65        if first_item then
  66          New_Line;
  67          first_item := False;
  68        end if;
  69        Put ("   [" & stuffing & mininame & "] ");
  70      end if;
  71      for i in 1 .. 2 loop
  72        begin
  73          Open (f (i), z (i), file_name, password);
  74          if i = 1 then
  75            total_1 := total_1 + 1;
  76          end if;
  77        exception
  78          when Zip.Entry_name_not_found =>
  79            if quiet = 0 then
  80              Put ("   # Not found in archive [" & Zip.Zip_Name (z (i)) & ']');
  81            end if;
  82            if i = 1 then
  83              Put_Line ("-- internal error!");
  84            else
  85              Close (f (1));
  86            end if;
  87            if file_name (file_name'Last) = '/' or file_name (file_name'Last) = '\' then
  88              just_a_directory := just_a_directory + 1;
  89              if quiet = 0 then
  90                Put_Line (" (just a dir.)");
  91              end if;
  92            else
  93              if quiet = 0 then
  94                New_Line;
  95              end if;
  96            end if;
  97            missing_1_in_2 := missing_1_in_2 + 1;
  98            return;
  99        end;
 100        s (i) := Stream (f (i));
 101      end loop;
 102      --  File found, now the comparison:
 103      while not End_Of_File (f (1)) loop
 104        if End_Of_File (f (2)) then
 105          if quiet = 0 then
 106            Put_Line ("   # Shorter in [" & Zip.Zip_Name (z (2)) & "] at position" &
 107                      Integer_64'Image (p));
 108          end if;
 109          Close (f (1));
 110          Close (f (2));
 111          size_failures := size_failures + 1;
 112          return;
 113        end if;
 114        --  Read one character in each stream
 115        for i in 1 .. 2 loop
 116          Character'Read (s (i), c (i));
 117        end loop;
 118        if c (1) /= c (2) then
 119          if quiet = 0 then
 120            Put_Line ("   # Difference at position" & Integer_64'Image (p));
 121          end if;
 122          Close (f (1));
 123          Close (f (2));
 124          compare_failures := compare_failures + 1;
 125          return;
 126        end if;
 127        p := p + 1;
 128      end loop;
 129      if not End_Of_File (f (2)) then
 130        if quiet = 0 then
 131          Put_Line ("   # Longer in [" & Zip.Zip_Name (z (2)) & "]");
 132        end if;
 133        Close (f (1));
 134        Close (f (2));
 135        size_failures := size_failures + 1;
 136        return;
 137      end if;
 138      Close (f (1));
 139      Close (f (2));
 140      if quiet = 0 then
 141        Put_Line ("OK -" & Integer_64'Image (p - 1) & " bytes compared");
 142      end if;
 143      total_bytes := total_bytes + (p - 1);
 144    end Compare_1_file;
 145  
 146    procedure Compare_all_files is new Zip.Traverse (Compare_1_file);
 147  
 148    err_str : String (1 .. 5);
 149  
 150    use Ada.Integer_Text_IO;
 151  
 152  begin
 153    z (1) := z1;
 154    z (2) := z2;
 155    if quiet <= 3 then
 156      Put ("* Comparing [" & Zip.Zip_Name (z (1)) & "] and [" & Zip.Zip_Name (z (2)) & ']');
 157    end if;
 158    Compare_all_files (z (1));
 159    total_2 := Zip.Entries (z (2));
 160    common := total_1 - missing_1_in_2;
 161    if quiet < 2 then
 162      Put_Line ("* === Results ===");
 163      Put_Line ("  1st archive: [" & Zip.Zip_Name (z (1)) & "], total files:" & Natural'Image (total_1));
 164      Put_Line ("  2nd archive: [" & Zip.Zip_Name (z (2)) & "], total files:" & Natural'Image (total_2));
 165      Put_Line ("  Total files compared: " & Natural'Image (common));
 166      Put_Line ("  Total of correct bytes: " & Integer_64'Image (total_bytes));
 167    end if;
 168    missing_2_in_1 := total_2 - common;
 169    --  t2 - m21 = t1 - m12 = # common files
 170    total_differences :=
 171       size_failures + compare_failures +
 172       missing_1_in_2 + missing_2_in_1;
 173    case quiet is
 174      when 0 .. 2 =>
 175        New_Line;
 176        Put_Line ("* === Comparison summary ===");
 177        Put (err_str, size_failures);
 178        Put_Line ("    Size failures . . . . . . . . . . . :" & err_str);
 179        Put (err_str, compare_failures);
 180        Put_Line ("    Content comparison failures . . . . :" & err_str);
 181        Put (err_str, missing_1_in_2);
 182        Put ("    Files of 1st archive missing in 2nd :" & err_str);
 183        --
 184        if just_a_directory > 0 then
 185          Put_Line (" (" & Integer'Image (just_a_directory) & " useless dir. names)");
 186        else
 187          New_Line;
 188        end if;
 189        --
 190        Put (err_str, missing_2_in_1);
 191        for i in err_str'Range loop
 192          if err_str (i) = ' ' then err_str (i) := '_'; end if;
 193        end loop;
 194        Put_Line ("  __Files of 2nd archive missing in 1st :" & err_str & "__");
 195        --
 196        Put (err_str, total_differences);
 197        Put_Line ("  Total of errors . . . . . . . . . . . :" & err_str);
 198      when 3 =>
 199        if total_differences = 0 then
 200          Put_Line (" OK");
 201        else
 202          Put (err_str, total_differences);
 203          Put_Line (" Differences:" & err_str);
 204        end if;
 205      when others =>
 206        null;
 207    end case;
 208  end Comp_Zip_Prc;