unzipada.adb

------------------------------------------------------------------------------
--  File:            UnZipAda.adb
--  Description:     A minimal standalone command-line unzipping tool
--                     using the Zip-Ada library.
--  Author:          Gautier de Montmollin
------------------------------------------------------------------------------

with Ada.Characters.Handling,
     Ada.Command_Line,
     Ada.Calendar,
     Ada.Directories,
     Ada.Text_IO,
     Ada.Float_Text_IO;

with Interfaces;

with Zip, UnZip;

--  Pure Ada Text_IO-fashion feedback; should work on every
--  computer having a screen [and some text console too] :

with Zip_Console_IO;
with Show_License;

procedure UnZipAda is

  procedure Set_Modification_Time_B (Name : in String;
                                     To   : in Ada.Calendar.Time) is
  begin
    null;  --  If you want the time stamps, uncomment the following and the "with" above.
    --  Set_Modification_Time_GNAT (Name, To);
  exception
    when others =>
      null; -- !! utf-8 or ascii names with characters > pos 127 fail
  end Set_Modification_Time_B;
  pragma Unreferenced (Set_Modification_Time_B);

  Set_Time_Stamp : UnZip.Set_Time_Stamp_Proc :=
    --    If you want the time stamps, uncomment the following
    --    and look into Set_Modification_Time_B above.
    --
    --  Set_Modification_Time_B'Unrestricted_Access;
    null;

  z_options        : UnZip.Option_Set := UnZip.no_option;
  quiet            : Boolean := False;
  lower_case_match : Boolean := False;
  comment          : Boolean := False;

  use UnZip;

  fda :          Zip.Feedback_Proc     := Zip_Console_IO.My_feedback'Access;
  rca :          Resolve_Conflict_Proc := Zip_Console_IO.My_resolve_conflict'Access;
  tda :          Tell_Data_Proc        := Zip_Console_IO.My_tell_data'Access;
  gpw : constant Get_Password_Proc     := Zip_Console_IO.My_get_password'Access;

  last_option : Natural := 0;

  password, exdir : String (1 .. 1024);
  pass_len, exdir_len : Natural := 0;

  Directory_Separator : constant Character := '/';
  --  '/' is also accepted by Windows

  function Add_extract_directory (File_Name : String) return String is
    --  OK for UNIX & Windows, but VMS has "[x.y.z]filename.ext"
  begin
    if exdir_len = 0 then
      return File_Name;
    elsif exdir (exdir_len) = '\' or exdir (exdir_len) = '/' then
      return exdir (1 .. exdir_len) & File_Name;
    else
      return exdir (1 .. exdir_len) & Directory_Separator & File_Name;
    end if;
  end Add_extract_directory;

  function Compose_File_Name (
    File_Name     : String;
    Name_encoding : Zip.Zip_Name_Encoding
  )
  return String
  is
  pragma Unreferenced (Name_encoding);
    fn1 : String := File_Name;
  begin
    if lower_case_match then
      fn1 := Ada.Characters.Handling.To_Lower (fn1);
    end if;
    return Add_extract_directory (fn1);
  end Compose_File_Name;

  My_FS_routines : constant FS_Routines_Type :=
    (Create_Path         => Ada.Directories.Create_Path'Access,  --  Ada 2005
     Set_Time_Stamp      => Set_Time_Stamp,
     Compose_File_Name   => Compose_File_Name'Unrestricted_Access,
     others              => null
    );

  use Ada.Calendar, Ada.Text_IO, Ada.Float_Text_IO;

  T0, T1 : Time;
  seconds_elapsed : Duration;

  package IIO is new Integer_IO (Integer);
  package MIO is new Modular_IO (Zip.Zip_64_Data_Size_Type);

  procedure Blurb is
  begin
    Put_Line ("UnZipAda * minimal standalone unzipping tool");
    Put_Line ("Demo for the Zip-Ada library, by G. de Montmollin");
    Put_Line ("Library version " & Zip.version & " dated " & Zip.reference);
    Put_Line ("URL: " & Zip.web);
    Show_License (Current_Output, "zip.ads");
  end Blurb;

  procedure Help is
  begin
    Blurb;
    Put_Line ("Usage: unzipada [options] zipfile[.zip] [files...]");
    New_Line;
    Put_Line ("options:  -t     : test .zip file integrity, no write");
    Put_Line ("          -j     : junk archived directory structure");
    Put_Line ("          -d dir : extract to ""dir"" instead of current");
    Put_Line ("          -c     : case sensitive name matching");
    Put_Line ("          -l     : force lower case on stored names");
    Put_Line ("          -a     : output as text file, with native line endings");
    Put_Line ("          -z     : display .zip archive comment only");
    Put_Line ("          -p Pwd : define a password for decryption (e.g. ""Pwd"")");
    Put_Line ("          -q     : quiet mode");
    New_Line;
    Put ("Press Return");
    Skip_Line;
  end Help;

  zi : Zip.Zip_Info;
  use Zip_Console_IO;
  use Ada.Command_Line;
  use Interfaces;

begin
  if Argument_Count = 0 then
    Help;
    return;
  end if;
  Set_Time_Stamp := null;
  for i in 1 .. Argument_Count loop
    if Argument (i)(1) = '-' or else Argument (i)(1) = '/' then
      if last_option = i then
        null; -- was in fact an argument for previous option (e.g. "-s")
      else
        last_option := i;
        if Argument (i)'Length = 1 then
          Help;
          return;
        end if;
        case Ada.Characters.Handling.To_Lower (Argument (i)(2)) is
          when 't' =>
            z_options (test_only) := True;
          when 'j' =>
            z_options (junk_directories) := True;
          when 'd' =>
            if i = Argument_Count then
              Help;
              return;  --  "-d" without the directory or anything ?!
            end if;
            declare
              arg_exdir : constant String := Argument (i + 1);
            begin
              exdir (1 .. arg_exdir'Length) := arg_exdir;
              exdir_len := arg_exdir'Length;
            end;
            last_option := i + 1;
          when 'c' =>
            z_options (case_sensitive_match) := True;
          when 'l' =>
            lower_case_match := True;
          when 'a' =>
            z_options (extract_as_text) := True;
          when 'p' | 's' =>  --  The "-s" variant is kept for compatibility.
            if i = Argument_Count then
              Help;
              return; -- "-s" without the password or anything ?!
            end if;
            declare
              arg_pass : constant String := Argument (i + 1);
            begin
              password (1 .. arg_pass'Length) := arg_pass;
              pass_len := arg_pass'Length;
            end;
            last_option := i + 1;
          when 'q' =>
            quiet := True;
          when 'z' =>
            comment := True;
          when others  =>
            Help;
            return;
        end case;
      end if;
    end if;
  end loop;

  current_user_attitude := yes;

  if quiet then
    fda := null;
    rca := null;
    tda := null;
  end if;

  Zip_Console_IO.Summary.Reset;

  if Argument_Count = last_option then -- options only ?!
    Help;
    return;
  end if;
  declare
    archive_given : constant String := Argument (last_option + 1);
    zip_ext : Boolean := False;
    extract_all : Boolean;
    --
    function Archive return String is
    begin
      if zip_ext then
        return archive_given & ".zip";
      else
        return archive_given;
      end if;
    end Archive;
    --
  begin
    if not Zip.Exists (Archive) then
      zip_ext := True;
      if not Zip.Exists (Archive) then
        Put_Line ("Archive file '" & archive_given &
                  "' or '" & Archive & "' not found");
        return;
      end if;
    end if;
    extract_all := Argument_Count = last_option + 1;
    --  options and zipfile only

    if not quiet then
      Blurb;
    end if;
    if not (quiet or comment) then
      if z_options (test_only) then
        Put ("Testing");
      else
        if Set_Time_Stamp = null then
          Put_Line (" Warning: time stamps and attributes of files" &
                    " in archive are not reproduced !");
          New_Line;
        end if;
        Put ("Extracting");
      end if;
      if not extract_all then
        Put (" some file(s) from");
      end if;
      Put_Line (" archive " & Archive);
    end if;

    T0 := Clock;
    if comment then  --  Option: -z , display comment only
      Zip.Load (zi, Archive);
      Zip.Put_Multi_Line (Standard_Output, Zip.Zip_Comment (zi));
    elsif extract_all then
      Extract (
        Archive,
        fda, rca, tda, gpw,
        z_options,
        password (1 .. pass_len),
        My_FS_routines
      );
    else
      Zip.Load (zi, Archive);
      for i in last_option + 2 .. Argument_Count loop
        Extract (zi, Argument (i),
          fda, rca, tda, gpw,
          z_options,
          password (1 .. pass_len),
          My_FS_routines
        );
      end loop;
    end if;
    T1 := Clock;
  end;

  seconds_elapsed := T1 - T0;

  if not (quiet or comment) then
    New_Line (2);
    IIO.Put (Summary.total_entries, 7);
    Put (" entries  ------ Total ------ ");
    MIO.Put (Summary.total_compressed, 10);
    if Summary.total_uncompressed = 0 then
      Put (" :         ");
    else
      Put (" :");
      IIO.Put (
        Natural (
          (100.0 * Long_Float (Summary.total_compressed)) /
          Long_Float (Summary.total_uncompressed)
        ), 4);
      Put ("% of ");
    end if;
    MIO.Put (Summary.total_uncompressed, 10);
    New_Line (2);

    if z_options (test_only) then
      Put_Line ("Test: no error found");
      New_Line;
      Put_Line ("Statistics per Zip sub-format (""method""):");
      for m in Summary.files_per_method'Range loop
        if Summary.files_per_method (m) > 0 then
          Put ("  " & Summary.Nice_image (m) & "... ");
          IIO.Put (Summary.files_per_method (m), 5);
          Put (" files");
          if Summary.uncompressed_per_method (m) > 0 then
            Put (",");
            IIO.Put (
              Natural (
                (100.0 * Long_Float (Summary.uncompressed_per_method (m))) /
                Long_Float (Summary.total_uncompressed)
              ), 4
            );
            Put ("% of all data; compr.-to-decompr. ratio: ");
            IIO.Put (
              Natural (
                (100.0 * Long_Float (Summary.compressed_per_method (m))) /
                Long_Float (Summary.uncompressed_per_method (m))
              ), 4
            );
            Put ('%');
          end if;
          New_Line;
        end if;
      end loop;
      New_Line;
    end if;

    Put ("Time elapsed : ");
    Put (Float (seconds_elapsed), 4, 2, 0);
    Put_Line (" sec");

    Put_Line ("Archive successfully processed (or empty archive, or no archive!)");
  end if;

end UnZipAda;