Back to... Zip-Ada

Source file : rezip.adb



   1  ------------------------------------------------------------------------------
   2  --  File:            rezip.adb
   3  --  Description:     Recompression tool to make archives smaller.
   4  --  Author:          Gautier de Montmollin
   5  ------------------------------------------------------------------------------
   6  
   7  with Rezip_lib, Comp_Zip_Prc, Zip;
   8  with Show_License;
   9  
  10  with Ada.Command_Line,
  11       Ada.Characters.Handling,
  12       Ada.Strings.Unbounded,
  13       Ada.Text_IO;
  14  
  15  procedure ReZip is
  16  
  17    procedure Blurb is
  18      use Ada.Text_IO;
  19    begin
  20      Put_Line ("ReZip * Zip file recompression tool.");
  21      Put_Line ("Author: Gautier de Montmollin");
  22      Put_Line ("Library version " & Zip.version & " dated " & Zip.reference);
  23      Put_Line ("URL: " & Zip.web);
  24      Show_License (Current_Output, "zip.ads");
  25    end Blurb;
  26  
  27    procedure Usage is
  28      use Ada.Text_IO;
  29    begin
  30      Put_Line ("Usage: rezip [options] archive(s)[.zip]");
  31      New_Line;
  32      Put_Line ("Options:  -defl     : repack archive only with the Deflate");
  33      Put_Line ("                        subformat (most compatible)");
  34      Put_Line ("          -fast_dec : repack archive only with fast decompressing subformats");
  35      Put_Line ("          -int      : use internal Zip-Ada algorithms only, no external call");
  36      Put_Line ("          -touch    : set time stamps to now");
  37      Put_Line ("          -lower    : set full file names to lower case");
  38      Put_Line ("          -del_comm : delete comment");
  39      Put_Line ("          -comp     : compare original and repacked archives (paranoid mode)");
  40      Put_Line ("          -rs=n     : loop many times over a single compression approach");
  41      Put_Line ("                        having randomization, and keep optimum when its");
  42      Put_Line ("                        size is stable after n attempts in a row");
  43      Put_Line ("          -temp=x   : set alternative radix for temp files");
  44      Put_Line ("                        for instance: ""y:\ram_temp\rz_"" or ""rz_""");
  45      New_Line;
  46      Put_Line ("External programs (available for Windows and Linux) are used, except");
  47      Put_Line ("when ReZip is called with the ""-int"" option.");
  48      Put_Line ("The external programs must be callable through the ""path"".");
  49      Put_Line ("List of external programs:");
  50      New_Line;
  51      Rezip_lib.Show_external_packer_list;
  52      New_Line;
  53      Put ("Press Return");
  54      Skip_Line;
  55    end Usage;
  56  
  57    function Add_zip_ext (s : String) return String is
  58    begin
  59      if Zip.Exists (s) then
  60        return s;
  61      else
  62        return s & ".zip";
  63        --  Maybe the file doesn't exist, but we tried our best...
  64      end if;
  65    end Add_zip_ext;
  66  
  67    function Get_ext (s : String) return String is
  68      dot : Integer := s'Last;
  69    begin
  70      for i in reverse s'Range loop
  71        if s (i) = '.' then
  72          dot := i;
  73          exit;
  74        end if;
  75      end loop;
  76      if s = "" or dot = s'Last then -- no extension in all cases:
  77        return "zip";              -- "", "xxx." or "xxx"
  78      else
  79        return s (dot + 1 .. s'Last);
  80      end if;
  81    end Get_ext;
  82  
  83    function Remove_ext (s : String) return String is
  84      dot : Integer := s'Last + 1;
  85    begin
  86      if s = "" then
  87        return s;
  88      end if;
  89      for i in reverse s'Range loop
  90        if s (i) = '.' then
  91          dot := i;
  92          exit;
  93        end if;
  94      end loop;
  95      return s (s'First .. dot - 1);
  96      --  "xxx" returned in all cases: "xxx.ext", "xxx." or "xxx"
  97    end Remove_ext;
  98  
  99    use Rezip_lib;
 100  
 101    touch, lower, del_comment, compare, internal : Boolean := False;
 102    rand_stable : Positive := 1;
 103    format_choice : Zip_format_set := all_formats;
 104    total_differences : Natural;
 105  
 106    use Ada.Command_Line, Ada.Characters.Handling, Ada.Strings.Unbounded;
 107  
 108    alt_temp : Unbounded_String;
 109  
 110  begin
 111    Blurb;
 112    if Argument_Count = 0 then
 113      Usage;
 114      return;
 115    end if;
 116    for i in 1 .. Argument_Count loop
 117      declare
 118        arg       : constant String := Argument (i);
 119        arg_zip   : constant String := Add_zip_ext (arg);
 120        ext       : constant String := Get_ext (arg_zip);
 121        arg_nozip : constant String := Remove_ext (arg_zip);
 122        arg_rezip : constant String := arg_nozip & ".repacked." & ext;
 123        arg_rpt   : constant String := arg_nozip & ".ReZip.html";
 124        arg_log   : constant String := arg_nozip & ".ReZip.log";
 125        info_original_zip,
 126        info_rezipped_zip : Zip.Zip_Info;
 127      begin
 128        if arg (arg'First) = '-' or arg (arg'First) = '/' then
 129          --  Options
 130          declare
 131            opt : constant String := To_Lower (arg (arg'First + 1 .. arg'Last));
 132          begin
 133            if opt = "defl" then
 134              format_choice := deflate_or_store;
 135            elsif opt = "fast_dec" then
 136              format_choice := fast_decompression;
 137            elsif opt = "int" then
 138              internal := True;
 139            elsif opt = "comp" then
 140              compare := True;
 141            elsif opt = "touch" then
 142              touch := True;
 143            elsif opt = "lower" then
 144              lower := True;
 145            elsif opt = "del_comm" then
 146              del_comment := True;
 147            elsif opt'Length > 12 and then
 148               opt (opt'First .. opt'First + 11) = "rand_stable="  --  old / long version of this option
 149            then
 150              rand_stable := Integer'Value (opt (opt'First + 12 .. opt'Last));
 151            elsif opt'Length > 3 and then
 152               opt (opt'First .. opt'First + 2) = "rs="
 153            then
 154              rand_stable := Integer'Value (opt (opt'First + 3 .. opt'Last));
 155            elsif opt'Length > 5 and then
 156               opt (opt'First .. opt'First + 4) = "temp="
 157            then
 158              alt_temp := To_Unbounded_String (opt (opt'First + 5 .. opt'Last));
 159            end if;
 160          end;
 161        elsif Zip.Exists (arg_zip) then
 162          Rezip_lib.Rezip (
 163            from_zip_file      => arg_zip,
 164            to_zip_file        => arg_rezip,
 165            format_choice      => format_choice,
 166            touch              => touch,
 167            lower              => lower,
 168            delete_comment     => del_comment,
 169            randomized_stable  => rand_stable,
 170            log_file           => arg_log,
 171            html_report        => arg_rpt,
 172            alt_tmp_file_radix => To_String (alt_temp),
 173            internal_only      => internal
 174          );
 175          if compare then
 176            Zip.Load (info_original_zip, arg_zip);
 177            Zip.Load (info_rezipped_zip, arg_rezip);
 178            Comp_Zip_Prc (
 179              info_original_zip, info_rezipped_zip,
 180              quiet => 2,
 181              total_differences => total_differences);
 182          end if;
 183        else
 184          Ada.Text_IO.Put_Line ("  ** Error: archive not found: " & arg_zip);
 185        end if;
 186      end;
 187    end loop;
 188  exception
 189    when External_Tool_Failed => null;  --  Messages have been already issued.
 190  end ReZip;

Web view of Ada source code generated by GNATHTML, project: ALI_Parse version 1.0.
Zip-Ada: Ada library for zip archive files (.zip). Ada programming.
Some news about Zip-Ada and other Ada projects on Gautier's blog.