Back to...

   1  --  Console I/O for ZipAda, UnZipAda and ReZip tools
   2  --  It's not nice code (global variables), so please don't use it elsewhere.
   3  
   4  with Ada.Text_IO;
   5  
   6  package body Zip_Console_IO is
   7  
   8    package body Summary is
   9  
  10      procedure Reset is
  11      begin
  12        total_uncompressed      := 0;
  13        total_compressed        := 0;
  14        total_entries           := 0;
  15        files_per_method        := (others => 0);
  16        uncompressed_per_method := (others => 0);
  17        compressed_per_method   := (others => 0);
  18      end Reset;
  19  
  20      function Nice_image (format : Zip.PKZip_method) return String is
  21        img_stuffed : String (1 .. Zip.PKZip_method'Width) := (others => ' ');
  22        img : constant String := Zip.Image (format);
  23      begin
  24        img_stuffed (1 .. img'Length) := img;
  25        return img_stuffed;
  26      end Nice_image;
  27  
  28    end Summary;
  29  
  30    dots : constant := 8;
  31    done_dots : Natural := 0;
  32  
  33    procedure My_feedback
  34     (percents_done :  in Natural;
  35      entry_skipped :  in Boolean;
  36      user_abort    : out Boolean)
  37    is
  38      new_done_dots : constant Natural := (dots * percents_done) / 100;
  39      use Ada.Text_IO;
  40    begin
  41      if entry_skipped then
  42        Put ("-skipped-");
  43      else
  44        for i in done_dots + 1 .. new_done_dots loop
  45          if i = 1 then
  46            Put ('[');
  47          end if;
  48          Put ('.');
  49          if i = dots then
  50            Put (']');
  51          end if;
  52        end loop;
  53        done_dots := new_done_dots;
  54      end if;
  55      user_abort := False; -- pointless in this command-line version (Ctrl-C is ok)
  56    end My_feedback;
  57  
  58    procedure My_tell_data
  59     (file_name          : String;
  60      compressed_bytes   : Zip.Zip_64_Data_Size_Type;
  61      uncompressed_bytes : Zip.Zip_64_Data_Size_Type;
  62      method             : Zip.PKZip_method)
  63    is
  64      use Ada.Text_IO;
  65  
  66      package MIO is new Modular_IO (Zip.Zip_64_Data_Size_Type);
  67  
  68      function Cut_name (n : String; l : Natural) return String is
  69        three_dots : constant String := "...";
  70      begin
  71        if n'Length > l then
  72          return three_dots & n (n'Last - (l - 1) + three_dots'Length .. n'Last);
  73        else
  74          return n;
  75        end if;
  76      end Cut_name;
  77  
  78      use type Zip.Zip_64_Data_Size_Type;
  79  
  80    begin
  81      New_Line;
  82      if Summary.total_entries = 0 then
  83        Put_Line (" Name                      Method    Compressed size      Uncompressed size");
  84        Put_Line (" ------------------------- --------- ---------------      -----------------");
  85      end if;
  86      Put (' ');
  87      done_dots := 0;
  88      declare
  89        maxlen : constant := 24;
  90        cut : constant String := Cut_name (file_name, maxlen);
  91      begin
  92        Put (cut);
  93        for l in cut'Length .. maxlen loop
  94          Put (' ');
  95        end loop;
  96      end;
  97      Put (' ' & Summary.Nice_image (method));
  98      MIO.Put (compressed_bytes, 10);
  99      if uncompressed_bytes = 0 then
 100        Put (" :         ");
 101      else
 102        Put (" :");
 103        MIO.Put (
 104          Zip.Zip_64_Data_Size_Type (
 105            (100.0 * Long_Float (compressed_bytes)) / Long_Float (uncompressed_bytes)
 106          ), 4);
 107        Put ("% of ");
 108      end if;
 109      MIO.Put (uncompressed_bytes, 10);
 110      Put (' ');
 111      --  We summarize here the length of processed files
 112      Summary.total_uncompressed :=
 113        Summary.total_uncompressed + uncompressed_bytes;
 114      Summary.total_compressed :=
 115        Summary.total_compressed   + compressed_bytes;
 116      Summary.total_entries := Summary.total_entries + 1;
 117      --  Per-method statistics:
 118      Summary.files_per_method (method) := Summary.files_per_method (method) + 1;
 119      Summary.uncompressed_per_method (method) := Summary.uncompressed_per_method (method) + uncompressed_bytes;
 120      Summary.compressed_per_method (method) := Summary.compressed_per_method (method) + compressed_bytes;
 121    end My_tell_data;
 122  
 123    procedure My_resolve_conflict
 124     (file_name       :  in String;
 125      name_encoding   :  in Zip.Zip_Name_Encoding;
 126      action          : out UnZip.Name_Conflict_Intervention;
 127      new_name        : out String;
 128      new_name_length : out Natural)
 129    is
 130      pragma Unreferenced (name_encoding);
 131      c : Character;
 132      use Ada.Text_IO, UnZip;
 133    begin
 134      loop
 135        New_Line;
 136        Put_Line ("File " & file_name & " already exists.");
 137        Put (" Overwrite ?  (y)es / (n)o / (A)ll / (N)one / (r)ename / (q)uit ");
 138        Get_Immediate (c);
 139        Put_Line ("-> " & c);
 140        exit when c = 'y' or c = 'n' or c = 'A' or c = 'N' or c = 'r' or c = 'q';
 141      end loop;
 142      case c is
 143        when 'y'       => action := yes;
 144        when 'n'       => action := no;
 145        when 'A'       => action := yes_to_all;
 146        when 'N'       => action := none;
 147        when 'q'       => action := abort_now;
 148        when 'r'       => action := rename_it; Put ("New name: ");
 149                          Get_Line (new_name, new_name_length);
 150        when others    => null;
 151      end case;
 152  
 153      --  Cosmetic : position for the [.....]
 154      Put ("                                                                    ");
 155    end My_resolve_conflict;
 156  
 157    procedure My_get_password
 158     (password : out Ada.Strings.Unbounded.Unbounded_String)
 159    is
 160      c : Character;
 161      use Ada.Strings.Unbounded, Ada.Text_IO;
 162    begin
 163      New_Line;
 164      Put_Line (" Current password is incorrect.");
 165      Put (" Password please : ");
 166      --  Fake "Get_line( password );" without echo.
 167      --  We use Get_Immediate that has no echo on GNAT/Windows - no mention
 168      --  of that feature in the (A)RM95, so no warranty about it!
 169  
 170      password := To_Unbounded_String ("");
 171  
 172      loop
 173        Get_Immediate (c);
 174        exit when c = ASCII.CR;
 175        Put ('*');
 176        password := password & c;
 177      end loop;
 178  
 179      New_Line;
 180  
 181      --  Cosmetic : position for the [.....]
 182      Put ("                                                                    ");
 183    end My_get_password;
 184  
 185  end Zip_Console_IO;