Back to...

   1  ------------------------------------------------------------------------------
   2  --  File:            Find_Zip.adb
   3  --  Description:     Search a text string in files packed in a zip archive.
   4  --  Author:          Gautier de Montmollin
   5  ------------------------------------------------------------------------------
   6  
   7  with Ada.Calendar,
   8       Ada.Characters.Handling,
   9       Ada.Command_Line,
  10       Ada.Integer_Text_IO,
  11       Ada.Streams,
  12       Ada.Strings.Fixed,
  13       Ada.Text_IO;
  14  
  15  with Zip;
  16  with UnZip.Streams;
  17  with Show_License;
  18  
  19  procedure Find_Zip is
  20  
  21    max : constant := 2**10;   --  1024
  22    str : String (1 .. max);   --  str(1..stl) = string to search
  23    stl : Natural;  --  string length
  24    l : Character;  --  last character of the search string
  25  
  26    z : Zip.Zip_Info;
  27  
  28    ignore_case : constant Boolean := True;
  29  
  30    use Ada.Characters.Handling, Ada.Integer_Text_IO, Ada.Text_IO;
  31    use UnZip.Streams;
  32  
  33    procedure Search_1_file_using_output_stream (file_name : String) is
  34      occ : Natural := 0;
  35      --  Define a circular buffer
  36      siz : constant := max;
  37      type Buffer_range is mod siz;
  38      buf : array (Buffer_range) of Character := (others => ' ');
  39      bup : Buffer_range := 0;
  40      --
  41      --  We define a local, ad-hoc stream type.
  42      --
  43      type Search_stream is new Ada.Streams.Root_Stream_Type with null record;
  44      --
  45      overriding procedure Read
  46        (Self   : in out Search_stream;
  47         Item   :    out Ada.Streams.Stream_Element_Array;
  48         Last   :    out Ada.Streams.Stream_Element_Offset) is null;  --  Not used.
  49  
  50      overriding procedure Write
  51        (Self   : in out Search_stream;
  52         Item   : in     Ada.Streams.Stream_Element_Array);
  53  
  54      --  Implementation of Write:
  55      overriding procedure Write
  56        (Self   : in out Search_stream;
  57         Item   : in     Ada.Streams.Stream_Element_Array)
  58      is
  59        pragma Unreferenced (Self);
  60        c : Character;
  61        i : Buffer_range := 0;
  62        j : Natural;
  63      begin
  64        for sei in Item'Range loop
  65          c := Character'Val (Item (sei));
  66          if ignore_case then
  67            c := To_Upper (c);
  68          end if;
  69          if c = l then  --  last character do match, search further...
  70            i := bup;
  71            j := stl;
  72            match : loop
  73              i := i - 1;  --  this loops modulo max: 3, 2, 1, 0, max-1, max-2, ...
  74              j := j - 1;
  75              if j = 0 then  --  we survived the whole search string
  76                occ := occ + 1;
  77                exit match;
  78              end if;
  79              exit match when str (j) /= buf (i);
  80            end loop match;
  81          end if;
  82          buf (bup) := c;
  83          bup := bup + 1;
  84        end loop;
  85      end Write;
  86  
  87      sst : Search_stream;
  88  
  89    begin
  90      Extract (
  91        Destination      => sst,
  92        Archive_Info     => z,
  93        Entry_Name       => file_name,
  94        Ignore_Directory => False
  95      );
  96      if occ > 0 then
  97        Put (occ, 5);
  98        Put_Line (" in [" & To_Lower (file_name) & "]'s contents");
  99      end if;
 100    end Search_1_file_using_output_stream;
 101  
 102    --  Old variant using an input stream (memory footprint is uncompressed
 103    --  size plus fixed amounts: can be large!)
 104  
 105    procedure Search_1_file_using_input_stream (file_name : String) is
 106      f : Zipped_File_Type;
 107      s : Stream_Access;
 108      c : Character;
 109      occ : Natural := 0;
 110      --  Define a circular buffer
 111      siz : constant := max;
 112      type Buffer_range is mod siz;
 113      buf : array (Buffer_range) of Character := (others => ' ');
 114      i, bup : Buffer_range := 0;
 115      j : Natural;
 116    begin
 117      Open (f, z, file_name);
 118      s := Stream (f);
 119      while not End_Of_File (f) loop
 120        Character'Read (s, c);
 121        if ignore_case then
 122          c := To_Upper (c);
 123        end if;
 124        if c = l then  --  last character do match, search further...
 125          i := bup;
 126          j := stl;
 127          match : loop
 128            i := i - 1;  --  this loops modulo max: 3, 2, 1, 0, max-1, max-2, ...
 129            j := j - 1;
 130            if j = 0 then  --  we survived the whole search string
 131              occ := occ + 1;
 132              exit match;
 133            end if;
 134            exit match when str (j) /= buf (i);
 135          end loop match;
 136        end if;
 137        buf (bup) := c;
 138        bup := bup + 1;
 139      end loop;
 140      Close (f);
 141      if occ > 0 then
 142        Put (occ, 5);
 143        Put_Line (" in [" & To_Lower (file_name) & "] (inward stream method)");
 144      end if;
 145    end Search_1_file_using_input_stream;
 146    pragma Unreferenced (Search_1_file_using_input_stream);
 147  
 148    procedure Search_all_files is new Zip.Traverse (Search_1_file_using_output_stream);
 149  
 150    procedure Search_in_entry_name (file_name : String) is
 151      un : String := file_name;
 152    begin
 153      if ignore_case then
 154        un := To_Upper (un);
 155      end if;
 156      if Ada.Strings.Fixed.Index (un, str (1 .. stl)) > 0 then
 157        Put_Line (" Found in [" & To_Lower (file_name) & "]'s entry name");
 158      end if;
 159    end Search_in_entry_name;
 160  
 161    procedure Search_all_file_names is new Zip.Traverse (Search_in_entry_name);
 162  
 163    function Try_with_zip (file_name : String) return String is
 164    begin
 165      if Zip.Exists (file_name) then
 166        return file_name;
 167      else
 168        return file_name & ".zip";
 169        --  Maybe the file doesn't exist, but we tried our best...
 170      end if;
 171    end Try_with_zip;
 172  
 173    use Ada.Command_Line;
 174  
 175    procedure Load_Archive_Catalogue is
 176      n : constant String := Try_with_zip (Argument (1));
 177    begin
 178      Zip.Load (z, n);
 179    exception
 180      when Zip.Archive_open_error =>
 181        Put ("Can't open archive [" & n & ']'); raise;
 182      when UnZip.Wrong_password      =>
 183        Put ("Archive has a password"); raise;
 184    end Load_Archive_Catalogue;
 185  
 186    procedure Prepare_Search_String is
 187      s : String := Argument (2);
 188    begin
 189      Put_Line ("Searching string [" & s & "]");
 190      if ignore_case then
 191        s := To_Upper (s);
 192      end if;
 193      stl := s'Length;
 194      if stl > str'Length then
 195        raise Constraint_Error;
 196      end if;
 197      str (1 .. stl) := s;
 198      l := str (stl);
 199    end Prepare_Search_String;
 200  
 201    procedure Blurb is
 202    begin
 203      Put_Line ("Find_Zip * Search a text string in files packed in a zip archive.");
 204      Put_Line ("Demo for the Zip-Ada library, by G. de Montmollin");
 205      Put_Line ("Library version " & Zip.version & " dated " & Zip.reference);
 206      Put_Line ("URL: " & Zip.web);
 207      Show_License (Current_Output, "zip.ads");
 208      Put_Line ("Usage: find_zip archive[.zip] [""]text[""]");
 209      New_Line;
 210      Put ("Press Return");
 211      Skip_Line;
 212    end Blurb;
 213  
 214    T0, T1, T2 : Ada.Calendar.Time;
 215    use Ada.Calendar;
 216  
 217  begin
 218    if Argument_Count < 2 then
 219      Blurb;
 220      return;
 221    end if;
 222    T0 := Clock;
 223    Load_Archive_Catalogue;
 224    Prepare_Search_String;
 225    T1 := Clock;
 226    Search_all_files (z);
 227    Search_all_file_names (z);
 228    T2 := Clock;
 229    Put_Line
 230      ("Time elapsed :" & Duration'Image (T2 - T0) &
 231       " seconds (loading catalogue: " & Duration'Image (T1 - T0) & ").");
 232  end Find_Zip;