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