Back to...

   1  ------------------------------------------------------------------------------
   2  --  File:            UnZipAda.adb
   3  --  Description:     A minimal standalone command-line unzipping tool
   4  --                     using the Zip-Ada library.
   5  --  Author:          Gautier de Montmollin
   6  ------------------------------------------------------------------------------
   7  
   8  with Ada.Characters.Handling,
   9       Ada.Command_Line,
  10       Ada.Calendar,
  11       Ada.Directories,
  12       Ada.Text_IO,
  13       Ada.Float_Text_IO;
  14  
  15  with Interfaces;
  16  
  17  with Zip, UnZip;
  18  
  19  --  Pure Ada Text_IO-fashion feedback; should work on every
  20  --  computer having a screen [and some text console too] :
  21  
  22  with Zip_Console_IO;
  23  with Show_License;
  24  
  25  procedure UnZipAda is
  26  
  27    procedure Set_Modification_Time_B (Name : in String;
  28                                       To   : in Ada.Calendar.Time) is
  29    begin
  30      null;  --  If you want the time stamps, uncomment the following and the "with" above.
  31      --  Set_Modification_Time_GNAT (Name, To);
  32    exception
  33      when others =>
  34        null; -- !! utf-8 or ascii names with characters > pos 127 fail
  35    end Set_Modification_Time_B;
  36    pragma Unreferenced (Set_Modification_Time_B);
  37  
  38    Set_Time_Stamp : UnZip.Set_Time_Stamp_Proc :=
  39      --    If you want the time stamps, uncomment the following
  40      --    and look into Set_Modification_Time_B above.
  41      --
  42      --  Set_Modification_Time_B'Unrestricted_Access;
  43      null;
  44  
  45    z_options        : UnZip.Option_Set := UnZip.no_option;
  46    quiet            : Boolean := False;
  47    lower_case_match : Boolean := False;
  48    comment          : Boolean := False;
  49  
  50    use UnZip;
  51  
  52    fda :          Zip.Feedback_Proc     := Zip_Console_IO.My_feedback'Access;
  53    rca :          Resolve_Conflict_Proc := Zip_Console_IO.My_resolve_conflict'Access;
  54    tda :          Tell_Data_Proc        := Zip_Console_IO.My_tell_data'Access;
  55    gpw : constant Get_Password_Proc     := Zip_Console_IO.My_get_password'Access;
  56  
  57    last_option : Natural := 0;
  58  
  59    password, exdir : String (1 .. 1024);
  60    pass_len, exdir_len : Natural := 0;
  61  
  62    Directory_Separator : constant Character := '/';
  63    --  '/' is also accepted by Windows
  64  
  65    function Add_extract_directory (File_Name : String) return String is
  66      --  OK for UNIX & Windows, but VMS has "[x.y.z]filename.ext"
  67    begin
  68      if exdir_len = 0 then
  69        return File_Name;
  70      elsif exdir (exdir_len) = '\' or exdir (exdir_len) = '/' then
  71        return exdir (1 .. exdir_len) & File_Name;
  72      else
  73        return exdir (1 .. exdir_len) & Directory_Separator & File_Name;
  74      end if;
  75    end Add_extract_directory;
  76  
  77    function Compose_File_Name (
  78      File_Name     : String;
  79      Name_encoding : Zip.Zip_Name_Encoding
  80    )
  81    return String
  82    is
  83    pragma Unreferenced (Name_encoding);
  84      fn1 : String := File_Name;
  85    begin
  86      if lower_case_match then
  87        fn1 := Ada.Characters.Handling.To_Lower (fn1);
  88      end if;
  89      return Add_extract_directory (fn1);
  90    end Compose_File_Name;
  91  
  92    My_FS_routines : constant FS_Routines_Type :=
  93      (Create_Path         => Ada.Directories.Create_Path'Access,  --  Ada 2005
  94       Set_Time_Stamp      => Set_Time_Stamp,
  95       Compose_File_Name   => Compose_File_Name'Unrestricted_Access,
  96       others              => null
  97      );
  98  
  99    use Ada.Calendar, Ada.Text_IO, Ada.Float_Text_IO;
 100  
 101    T0, T1 : Time;
 102    seconds_elapsed : Duration;
 103  
 104    package IIO is new Integer_IO (Integer);
 105    package MIO is new Modular_IO (Zip.Zip_64_Data_Size_Type);
 106  
 107    procedure Blurb is
 108    begin
 109      Put_Line ("UnZipAda * minimal standalone unzipping tool");
 110      Put_Line ("Demo for the Zip-Ada library, by G. de Montmollin");
 111      Put_Line ("Library version " & Zip.version & " dated " & Zip.reference);
 112      Put_Line ("URL: " & Zip.web);
 113      Show_License (Current_Output, "zip.ads");
 114    end Blurb;
 115  
 116    procedure Help is
 117    begin
 118      Blurb;
 119      Put_Line ("Usage: unzipada [options] zipfile[.zip] [files...]");
 120      New_Line;
 121      Put_Line ("options:  -t     : test .zip file integrity, no write");
 122      Put_Line ("          -j     : junk archived directory structure");
 123      Put_Line ("          -d dir : extract to ""dir"" instead of current");
 124      Put_Line ("          -c     : case sensitive name matching");
 125      Put_Line ("          -l     : force lower case on stored names");
 126      Put_Line ("          -a     : output as text file, with native line endings");
 127      Put_Line ("          -z     : display .zip archive comment only");
 128      Put_Line ("          -p Pwd : define a password for decryption (e.g. ""Pwd"")");
 129      Put_Line ("          -q     : quiet mode");
 130      New_Line;
 131      Put ("Press Return");
 132      Skip_Line;
 133    end Help;
 134  
 135    zi : Zip.Zip_Info;
 136    use Zip_Console_IO;
 137    use Ada.Command_Line;
 138    use Interfaces;
 139  
 140  begin
 141    if Argument_Count = 0 then
 142      Help;
 143      return;
 144    end if;
 145    Set_Time_Stamp := null;
 146    for i in 1 .. Argument_Count loop
 147      if Argument (i)(1) = '-' or else Argument (i)(1) = '/' then
 148        if last_option = i then
 149          null; -- was in fact an argument for previous option (e.g. "-s")
 150        else
 151          last_option := i;
 152          if Argument (i)'Length = 1 then
 153            Help;
 154            return;
 155          end if;
 156          case Ada.Characters.Handling.To_Lower (Argument (i)(2)) is
 157            when 't' =>
 158              z_options (test_only) := True;
 159            when 'j' =>
 160              z_options (junk_directories) := True;
 161            when 'd' =>
 162              if i = Argument_Count then
 163                Help;
 164                return;  --  "-d" without the directory or anything ?!
 165              end if;
 166              declare
 167                arg_exdir : constant String := Argument (i + 1);
 168              begin
 169                exdir (1 .. arg_exdir'Length) := arg_exdir;
 170                exdir_len := arg_exdir'Length;
 171              end;
 172              last_option := i + 1;
 173            when 'c' =>
 174              z_options (case_sensitive_match) := True;
 175            when 'l' =>
 176              lower_case_match := True;
 177            when 'a' =>
 178              z_options (extract_as_text) := True;
 179            when 'p' | 's' =>  --  The "-s" variant is kept for compatibility.
 180              if i = Argument_Count then
 181                Help;
 182                return; -- "-s" without the password or anything ?!
 183              end if;
 184              declare
 185                arg_pass : constant String := Argument (i + 1);
 186              begin
 187                password (1 .. arg_pass'Length) := arg_pass;
 188                pass_len := arg_pass'Length;
 189              end;
 190              last_option := i + 1;
 191            when 'q' =>
 192              quiet := True;
 193            when 'z' =>
 194              comment := True;
 195            when others  =>
 196              Help;
 197              return;
 198          end case;
 199        end if;
 200      end if;
 201    end loop;
 202  
 203    current_user_attitude := yes;
 204  
 205    if quiet then
 206      fda := null;
 207      rca := null;
 208      tda := null;
 209    end if;
 210  
 211    Zip_Console_IO.Summary.Reset;
 212  
 213    if Argument_Count = last_option then -- options only ?!
 214      Help;
 215      return;
 216    end if;
 217    declare
 218      archive_given : constant String := Argument (last_option + 1);
 219      zip_ext : Boolean := False;
 220      extract_all : Boolean;
 221      --
 222      function Archive return String is
 223      begin
 224        if zip_ext then
 225          return archive_given & ".zip";
 226        else
 227          return archive_given;
 228        end if;
 229      end Archive;
 230      --
 231    begin
 232      if not Zip.Exists (Archive) then
 233        zip_ext := True;
 234        if not Zip.Exists (Archive) then
 235          Put_Line ("Archive file '" & archive_given &
 236                    "' or '" & Archive & "' not found");
 237          return;
 238        end if;
 239      end if;
 240      extract_all := Argument_Count = last_option + 1;
 241      --  options and zipfile only
 242  
 243      if not quiet then
 244        Blurb;
 245      end if;
 246      if not (quiet or comment) then
 247        if z_options (test_only) then
 248          Put ("Testing");
 249        else
 250          if Set_Time_Stamp = null then
 251            Put_Line (" Warning: time stamps and attributes of files" &
 252                      " in archive are not reproduced !");
 253            New_Line;
 254          end if;
 255          Put ("Extracting");
 256        end if;
 257        if not extract_all then
 258          Put (" some file(s) from");
 259        end if;
 260        Put_Line (" archive " & Archive);
 261      end if;
 262  
 263      T0 := Clock;
 264      if comment then  --  Option: -z , display comment only
 265        Zip.Load (zi, Archive);
 266        Zip.Put_Multi_Line (Standard_Output, Zip.Zip_Comment (zi));
 267      elsif extract_all then
 268        Extract (
 269          Archive,
 270          fda, rca, tda, gpw,
 271          z_options,
 272          password (1 .. pass_len),
 273          My_FS_routines
 274        );
 275      else
 276        Zip.Load (zi, Archive);
 277        for i in last_option + 2 .. Argument_Count loop
 278          Extract (zi, Argument (i),
 279            fda, rca, tda, gpw,
 280            z_options,
 281            password (1 .. pass_len),
 282            My_FS_routines
 283          );
 284        end loop;
 285      end if;
 286      T1 := Clock;
 287    end;
 288  
 289    seconds_elapsed := T1 - T0;
 290  
 291    if not (quiet or comment) then
 292      New_Line (2);
 293      IIO.Put (Summary.total_entries, 7);
 294      Put (" entries  ------ Total ------ ");
 295      MIO.Put (Summary.total_compressed, 10);
 296      if Summary.total_uncompressed = 0 then
 297        Put (" :         ");
 298      else
 299        Put (" :");
 300        IIO.Put (
 301          Natural (
 302            (100.0 * Long_Float (Summary.total_compressed)) /
 303            Long_Float (Summary.total_uncompressed)
 304          ), 4);
 305        Put ("% of ");
 306      end if;
 307      MIO.Put (Summary.total_uncompressed, 10);
 308      New_Line (2);
 309  
 310      if z_options (test_only) then
 311        Put_Line ("Test: no error found");
 312        New_Line;
 313        Put_Line ("Statistics per Zip sub-format (""method""):");
 314        for m in Summary.files_per_method'Range loop
 315          if Summary.files_per_method (m) > 0 then
 316            Put ("  " & Summary.Nice_image (m) & "... ");
 317            IIO.Put (Summary.files_per_method (m), 5);
 318            Put (" files");
 319            if Summary.uncompressed_per_method (m) > 0 then
 320              Put (",");
 321              IIO.Put (
 322                Natural (
 323                  (100.0 * Long_Float (Summary.uncompressed_per_method (m))) /
 324                  Long_Float (Summary.total_uncompressed)
 325                ), 4
 326              );
 327              Put ("% of all data; compr.-to-decompr. ratio: ");
 328              IIO.Put (
 329                Natural (
 330                  (100.0 * Long_Float (Summary.compressed_per_method (m))) /
 331                  Long_Float (Summary.uncompressed_per_method (m))
 332                ), 4
 333              );
 334              Put ('%');
 335            end if;
 336            New_Line;
 337          end if;
 338        end loop;
 339        New_Line;
 340      end if;
 341  
 342      Put ("Time elapsed : ");
 343      Put (Float (seconds_elapsed), 4, 2, 0);
 344      Put_Line (" sec");
 345  
 346      Put_Line ("Archive successfully processed (or empty archive, or no archive!)");
 347    end if;
 348  
 349  end UnZipAda;