CS计算机代考程序代写 compiler Hive ada with Zip.Headers;

with Zip.Headers;

with Ada.Characters.Handling;
with Ada.Unchecked_Deallocation;
with Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Strings.Fixed;

package body Zip is

use Interfaces;

procedure Dispose is new Ada.Unchecked_Deallocation (Dir_node, p_Dir_node);
procedure Dispose is new Ada.Unchecked_Deallocation (String, p_String);

package Binary_tree_rebalancing is
procedure Rebalance (root : in out p_Dir_node);
end Binary_tree_rebalancing;

package body Binary_tree_rebalancing is

——————————————————————-
— Tree Rebalancing in Optimal Time and Space —
— QUENTIN F. STOUT and BETTE L. WARREN —
— Communications of the ACM September 1986 Volume 29 Number 9 —
——————————————————————-
— http://www.eecs.umich.edu/~qstout/pap/CACM86.pdf

— Translated by (New) P2Ada v. 15 – Nov – 2006

procedure Tree_to_vine (root : p_Dir_node; size : out Integer) is
— transform the tree with pseudo – root
— “root^” into a vine with pseudo – root
— node “root^”, and store the number of
— nodes in “size”

vine_tail, remainder, temp : p_Dir_node;

begin
vine_tail := root;
remainder := vine_tail.all.right;
size := 0;
while remainder /= null loop
if remainder.all.left = null then
— move vine – tail down one:
vine_tail := remainder;
remainder := remainder.all.right;
size := size + 1;
else
— rotate:
temp := remainder.all.left;
remainder.all.left := temp.all.right;
temp.all.right := remainder;
remainder := temp;
vine_tail.all.right := temp;
end if;
end loop;
end Tree_to_vine;

procedure Vine_to_tree (root : p_Dir_node; size_given : Integer) is
— convert the vine with “size” nodes and pseudo – root
— node “root^” into a balanced tree
leaf_count : Integer;
size : Integer := size_given;

procedure Compression (Dir_Root : p_Dir_node; count : Integer) is
— compress “count” spine nodes in the tree with pseudo – root “root^”
scanner, child : p_Dir_node;
begin
scanner := Dir_Root;
for i in 1 .. count loop
child := scanner.all.right;
scanner.all.right := child.all.right;
scanner := scanner.all.right;
child.all.right := scanner.all.left;
scanner.all.left := child;
end loop;
end Compression;

— Returns n – 2 ** Integer (Float’Floor (log (Float (n)) / log (2.0)))
— without Float – Point calculation and rounding errors with too short floats
function Remove_leading_binary_1 (n : Integer) return Integer is
x : Integer := 2**16; — supposed maximum
begin
if n < 1 then return n; end if; while n mod x = n loop x := x / 2; end loop; return n mod x; end Remove_leading_binary_1; begin -- Vine_to_tree leaf_count := Remove_leading_binary_1 (size + 1); Compression (root, leaf_count); -- create deepest leaves -- use Perfect_leaves instead for a perfectly balanced tree size := size - leaf_count; while size > 1 loop
Compression (root, size / 2);
size := size / 2;
end loop;
end Vine_to_tree;

procedure Rebalance (root : in out p_Dir_node) is
— Rebalance the binary search tree with root “root.all”,
— with the result also rooted at “root.all”.
— Uses the Tree_to_vine and Vine_to_tree procedures.
pseudo_root : p_Dir_node;
size : Integer;
begin
pseudo_root := new Dir_node (name_len => 0);
pseudo_root.all.right := root;
Tree_to_vine (pseudo_root, size);
Vine_to_tree (pseudo_root, size);
root := pseudo_root.all.right;
Dispose (pseudo_root);
end Rebalance;

end Binary_tree_rebalancing;

— 19 – Jun – 2001 : Enhanced file name identification
— a) when case insensitive – > all UPPER (current)
— b) ‘\’ and ‘/’ identified – > all ‘/’ (new)

function Normalize (s : String; case_sensitive : Boolean) return String is
sn : String (s’Range);
begin
if case_sensitive then
sn := s;
else
sn := Ada.Characters.Handling.To_Upper (s);
end if;
for i in sn’Range loop
if sn (i) = ‘\’ then
sn (i) := ‘/’;
end if;
end loop;
return sn;
end Normalize;

————————————————————-
— Load Zip_info from a stream containing the .zip archive —
————————————————————-

procedure Load (info : out Zip_info;
from : Zip_Streams.Zipstream_Class;
case_sensitive : Boolean := False) is

procedure Insert (dico_name : String; — UPPER if case – insensitive search
file_name : String;
file_index : Ada.Streams.Stream_IO.Positive_Count;
comp_size,
uncomp_size : File_size_type;
crc_32 : Unsigned_32;
date_time : Time;
method : PKZip_method;
unicode_file_name : Boolean;
node : in out p_Dir_node) is

begin
if node = null then
node := new Dir_node’
((name_len => file_name’Length,
left => null,
right => null,
dico_name => dico_name,
file_name => file_name,
file_index => file_index,
comp_size => comp_size,
uncomp_size => uncomp_size,
crc_32 => crc_32,
date_time => date_time,
method => method,
unicode_file_name => unicode_file_name
)
);
elsif dico_name > node.all.dico_name then
Insert (dico_name, file_name, file_index, comp_size, uncomp_size, crc_32, date_time, method, unicode_file_name, node.all.right);
elsif dico_name < node.all.dico_name then Insert (dico_name, file_name, file_index, comp_size, uncomp_size, crc_32, date_time, method, unicode_file_name, node.all.left); else raise Duplicate_name; end if; end Insert; the_end : Zip.Headers.End_of_Central_Dir; header : Zip.Headers.Central_File_Header; p : p_Dir_node := null; zip_info_already_loaded : exception; main_comment : p_String; use Ada.Streams, Ada.Streams.Stream_IO; begin -- Load Zip_info if info.loaded then raise zip_info_already_loaded; end if; -- 15 - Apr - 2002 Zip.Headers.Load (from, the_end); -- We take the opportunity to read the main comment, which is right -- after the end - of - central - directory block. main_comment := new String (1 .. Integer (the_end.main_comment_length)); String'Read (from, main_comment.all); -- Process central directory: Zip_Streams.Set_Index ( from, Positive ( 1 + the_end.offset_shifting + the_end.central_dir_offset ) ); for i in 1 .. the_end.total_entries loop Zip.Headers.Read_and_check (from, header); declare this_name : String (1 .. Natural (header.short_info.filename_length)); begin String'Read (from, this_name); -- Skip extra field and entry comment. Zip_Streams.Set_Index ( from, Positive ( Ada.Streams.Stream_IO.Count (Zip_Streams.Index (from)) + Ada.Streams.Stream_IO.Count ( header.short_info.extra_field_length + header.comment_length )) ); -- Now the whole i_th central directory entry is behind Insert (dico_name => Normalize (this_name, case_sensitive),
file_name => Normalize (this_name, True),
file_index => Ada.Streams.Stream_IO.Count
(1 + header.local_header_offset + the_end.offset_shifting),
comp_size => header.short_info.dd.compressed_size,
uncomp_size => header.short_info.dd.uncompressed_size,
crc_32 => header.short_info.dd.crc_32,
date_time => header.short_info.file_timedate,
method => Method_from_code (header.short_info.zip_type),
unicode_file_name =>
(header.short_info.bit_flag and
Zip.Headers.Language_Encoding_Flag_Bit) /= 0,
node => p);
— Since the files are usually well ordered, the tree as inserted
— is very unbalanced; we need to rebalance it from time to time
— during loading, otherwise the insertion slows down dramatically
— for zip files with plenty of files – converges to
— O (total_entries ** 2) .. .
if i mod 256 = 0 then
Binary_tree_rebalancing.Rebalance (p);
end if;
end;
end loop;
Binary_tree_rebalancing.Rebalance (p);
info := (loaded => True,
zip_file_name => new String'(“This is a stream, no direct file!”),
zip_input_stream => from,
dir_binary_tree => p,
total_entries => Integer (the_end.total_entries),
zip_file_comment => main_comment
);
end Load;

———————————————————–
— Load Zip_info from a file containing the .zip archive —
———————————————————–

procedure Load (info : out Zip_info;
from : String; — Zip file name
case_sensitive : Boolean := False) is

use Zip_Streams;

MyStream : aliased File_Zipstream;
StreamFile : constant Zipstream_Class := MyStream’Unchecked_Access;

begin
Set_Name (StreamFile, from);
begin
Open (MyStream, Ada.Streams.Stream_IO.In_File);
exception
when others =>
Ada.Exceptions.Raise_Exception
(Zip_file_open_Error’Identity, “Archive : [” & from & ‘]’);
end;
— Call the stream version of Load ( .. .)
Load (
info,
StreamFile,
case_sensitive
);
Close (MyStream);
Dispose (info.zip_file_name);
info.zip_file_name := new String'(from);
info.zip_input_stream := null; — forget about the stream!
end Load;

function Is_loaded (info : Zip_info) return Boolean is (info.loaded);

function Zip_name (info : Zip_info) return String is

begin
if not info.loaded then
raise Forgot_to_load_zip_info;
end if;
return info.zip_file_name.all;
end Zip_name;

function Zip_comment (info : Zip_info) return String is

begin
if not info.loaded then
raise Forgot_to_load_zip_info;
end if;
return info.zip_file_comment.all;
end Zip_comment;

function Zip_Stream (info : Zip_info) return Zip_Streams.Zipstream_Class is

begin
if not info.loaded then
raise Forgot_to_load_zip_info;
end if;
return info.zip_input_stream;
end Zip_Stream;

function Entries (info : Zip_info) return Natural is (info.total_entries);

————
— Delete —
————

procedure Delete (info : in out Zip_info) is

procedure Delete (p : in out p_Dir_node) is
begin
if p /= null then
Delete (p.all.left);
Delete (p.all.right);
Dispose (p);
p := null;
end if;
end Delete;

begin
if not info.loaded then
raise Forgot_to_load_zip_info;
end if;
Delete (info.dir_binary_tree);
Dispose (info.zip_file_name);
info.loaded := False; — < -- added 14 - Jan - 2002 end Delete; -- Traverse a whole Zip_info directory in sorted order, giving the -- name for each entry to an user - defined "Action" procedure. -- Added 29 - Nov - 2002 procedure Traverse (z : Zip_info) is procedure Traverse (p : p_Dir_node) is begin if p /= null then Traverse (p.all.left); Action (p.all.file_name); Traverse (p.all.right); end if; end Traverse; begin Traverse (z.dir_binary_tree); end Traverse; procedure Traverse_verbose (z : Zip_info) is procedure Traverse_verbose_recursive (p : p_Dir_node) is begin if p /= null then Traverse_verbose_recursive (p.all.left); Action (p.all.file_name, Positive (p.all.file_index), p.all.comp_size, p.all.uncomp_size, p.all.crc_32, p.all.date_time, p.all.method, p.all.unicode_file_name); Traverse_verbose_recursive (p.all.right); end if; end Traverse_verbose_recursive; begin Traverse_verbose_recursive (z.dir_binary_tree); end Traverse_verbose; procedure Tree_stat (z : Zip_info; total : out Natural; max_depth : out Natural; avg_depth : out Float) is sum_depth : Natural := 0; procedure Traverse_stat_recursive (p : p_Dir_node; depth : Natural) is begin if p /= null then total := total + 1; if depth > max_depth then
max_depth := depth;
end if;
sum_depth := sum_depth + depth;
Traverse_stat_recursive (p.all.left, depth + 1);
Traverse_stat_recursive (p.all.right, depth + 1);
end if;
end Traverse_stat_recursive;

begin
total := 0;
max_depth := 0;
Traverse_stat_recursive (z.dir_binary_tree, 0);
if total = 0 then
avg_depth := 0.0;
else
avg_depth := Float (sum_depth) / Float (total);
end if;
end Tree_stat;

— 13 – May – 2001 : Find_first_offset

— For an all – files unzipping of an appended (e.g. self – extracting) archive
— (not beginning with ZIP contents), we cannot start with
— index 1 in file.
— But the offset of first entry in ZIP directory is not valid either,
— as this excerpt of appnote.txt states:

— ” 4) The entries in the central directory may not necessarily
— be in the same order that files appear in the zipfile. ”

procedure Find_first_offset (file : Zip_Streams.Zipstream_Class;
file_index : out Positive) is

the_end : Zip.Headers.End_of_Central_Dir;
header : Zip.Headers.Central_File_Header;
min_offset : File_size_type;

— use Ada.Streams.Stream_IO, Zip_Streams;
use Zip_Streams;

begin
Zip.Headers.Load (file, the_end);
Set_Index (
file, Positive (1 + the_end.offset_shifting + the_end.central_dir_offset)
);

min_offset := the_end.central_dir_offset; — will be lowered

for i in 1 .. the_end.total_entries loop
declare
TempStream : constant Zip_Streams.Zipstream_Class := file;
begin
Zip.Headers.Read_and_check (TempStream, header);
end;

Set_Index (file, Index (file) +
Positive
(header.short_info.filename_length +
header.short_info.extra_field_length +
header.comment_length));
— Now the whole i_th central directory entry is behind

if header.local_header_offset < min_offset then min_offset := header.local_header_offset; end if; end loop; file_index := Positive (1 + min_offset + the_end.offset_shifting); end Find_first_offset; -- Internal : find offset of a zipped file by reading sequentially the -- central directory : - ( procedure Find_offset (file : Zip_Streams.Zipstream_Class; name : String; case_sensitive : Boolean; file_index : out Positive; comp_size : out File_size_type; uncomp_size : out File_size_type) is the_end : Zip.Headers.End_of_Central_Dir; header : Zip.Headers.Central_File_Header; -- use Ada.Streams, Ada.Streams.Stream_IO, Zip_Streams; use Zip_Streams; begin Zip.Headers.Load (file, the_end); Set_Index (file, Positive (1 + the_end.central_dir_offset + the_end.offset_shifting)); for i in 1 .. the_end.total_entries loop declare TempStream : constant Zipstream_Class := file; begin Zip.Headers.Read_and_check (TempStream, header); end; declare this_name : String (1 .. Natural (header.short_info.filename_length)); begin String'Read (file, this_name); Set_Index (file, Index (file) + Natural (Ada.Streams.Stream_IO.Count (header.short_info.extra_field_length + header.comment_length))); -- Now the whole i_th central directory entry is behind if Normalize (this_name, case_sensitive) = Normalize (name, case_sensitive) then -- Name found in central directory ! file_index := Positive (1 + header.local_header_offset + the_end.offset_shifting); comp_size := File_size_type (header.short_info.dd.compressed_size); uncomp_size := File_size_type (header.short_info.dd.uncompressed_size); return; end if; end; end loop; raise File_name_not_found; end Find_offset; -- Internal : find offset of a zipped file using the zip_info tree 8 - ) procedure Find_offset (info : Zip_info; name : String; case_sensitive : Boolean; file_index : out Ada.Streams.Stream_IO.Positive_Count; comp_size : out File_size_type; uncomp_size : out File_size_type) is aux : p_Dir_node := info.dir_binary_tree; up_name : String := Normalize (name, case_sensitive); begin if not info.loaded then raise Forgot_to_load_zip_info; end if; while aux /= null loop if up_name > aux.all.dico_name then
aux := aux.all.right;
elsif up_name < aux.all.dico_name then aux := aux.all.left; else -- file found ! file_index := aux.all.file_index; comp_size := aux.all.comp_size; uncomp_size := aux.all.uncomp_size; return; end if; end loop; Ada.Exceptions.Raise_Exception ( File_name_not_found'Identity, "Archive : [" & info.zip_file_name.all & "], entry : [" & name & ']' ); end Find_offset; procedure Get_sizes (info : Zip_info; name : String; case_sensitive : Boolean; comp_size : out File_size_type; uncomp_size : out File_size_type) is dummy_file_index : Ada.Streams.Stream_IO.Positive_Count; begin Find_offset (info, name, case_sensitive, dummy_file_index, comp_size, uncomp_size); pragma Unreferenced (dummy_file_index); end Get_sizes; -- Workaround for the severe xxx'Read xxx'Write performance -- problems in the GNAT and ObjectAda compilers (as in 2009) -- This is possible if and only if Byte = Stream_Element and -- arrays types are both packed and aligned the same way. -- subtype Size_test_a is Byte_Buffer (1 .. 19); subtype Size_test_b is Ada.Streams.Stream_Element_Array (1 .. 19); workaround_possible : constant Boolean := Size_test_a'Size = Size_test_b'Size and then Size_test_a'Alignment = Size_test_b'Alignment; -- BlockRead - general - purpose procedure (nothing really specific -- to Zip / UnZip) : reads either the whole buffer from a file, or -- if the end of the file lays inbetween, a part of the buffer. procedure BlockRead (file : Ada.Streams.Stream_IO.File_Type; buffer : out Byte_Buffer; actually_read : out Natural) is use Ada.Streams, Ada.Streams.Stream_IO; SE_Buffer : Stream_Element_Array (1 .. buffer'Length); for SE_Buffer'Address use buffer'Address; pragma Import (Ada, SE_Buffer); Last_Read : Stream_Element_Offset; begin if workaround_possible then Read (Stream (file).all, SE_Buffer, Last_Read); actually_read := Natural (Last_Read); else if End_Of_File (file) then actually_read := 0; else actually_read := Integer'Min (buffer'Length, Integer (Size (file) - Index (file) + 1)); Byte_Buffer'Read ( Stream (file), buffer (buffer'First .. buffer'First + actually_read - 1) ); end if; end if; end BlockRead; procedure BlockRead (stream : Zip_Streams.Zipstream_Class; buffer : out Byte_Buffer; actually_read : out Natural) is -- use Ada.Streams, Ada.Streams.Stream_IO, Zip_Streams; use Ada.Streams, Zip_Streams; SE_Buffer : Stream_Element_Array (1 .. buffer'Length); for SE_Buffer'Address use buffer'Address; pragma Import (Ada, SE_Buffer); Last_Read : Stream_Element_Offset; begin if workaround_possible then Read (stream.all, SE_Buffer, Last_Read); actually_read := Natural (Last_Read); else if End_Of_Stream (stream) then actually_read := 0; else actually_read := Integer'Min (buffer'Length, Integer (Size (stream) - Index (stream) + 1)); Byte_Buffer'Read (stream, buffer (buffer'First .. buffer'First + actually_read - 1)); end if; end if; end BlockRead; procedure BlockRead (stream : Zip_Streams.Zipstream_Class; buffer : out Byte_Buffer) is actually_read : Natural; begin BlockRead (stream, buffer, actually_read); if actually_read < buffer'Length then raise Ada.IO_Exceptions.End_Error; end if; end BlockRead; procedure BlockWrite (stream : in out Ada.Streams.Root_Stream_Type'Class; buffer : Byte_Buffer) is use Ada.Streams; SE_Buffer : Stream_Element_Array (1 .. buffer'Length); for SE_Buffer'Address use buffer'Address; pragma Import (Ada, SE_Buffer); begin if workaround_possible then Ada.Streams.Write (stream, SE_Buffer); else Byte_Buffer'Write (stream'Access, buffer); -- ^This is 30x to 70x slower on GNAT 2009 ! end if; end BlockWrite; function Method_from_code (x : Natural) return PKZip_method is -- An enumeration clause might be more elegant, but needs -- curiously an Unchecked_Conversion .. . (RM 13.4) begin case x is when 0 => return store;
when 1 => return shrink;
when 2 => return reduce_1;
when 3 => return reduce_2;
when 4 => return reduce_3;
when 5 => return reduce_4;
when 6 => return implode;
when 7 => return tokenize;
when 8 => return deflate;
when 9 => return deflate_e;
when 12 => return bzip2;
when 14 => return lzma;
when 98 => return ppmd;
when others => return unknown;
end case;
end Method_from_code;

function Method_from_code (x : Interfaces.Unsigned_16) return PKZip_method is
(Method_from_code (Natural (x)));

— This does the same as Ada 2005’s Ada.Directories.Exists
— Just there as helper for Ada 95 only systems

function Exists (name : String) return Boolean is

use Ada.Text_IO, Ada.Strings.Fixed;

f : File_Type;

begin
if Index (name, “*”) > 0 then
return False;
end if;
Open (f, In_File, name, Form => Ada.Strings.Unbounded.To_String (Form_For_IO_Open_N_Create));
Close (f);
return True;

exception
when Name_Error =>
return False; — The file cannot exist !
when Use_Error =>
return True; — The file exist and is already opened !
end Exists;

procedure Put_Multi_Line (
out_file : Ada.Text_IO.File_Type;
text : String
)
is
last_char : Character := ‘ ‘;
c : Character;
begin
for i in text’Range loop
c := text (i);
case c is
when ASCII.CR =>
Ada.Text_IO.New_Line (out_file);
when ASCII.LF =>
if last_char /= ASCII.CR then
Ada.Text_IO.New_Line (out_file);
end if;
when others =>
Ada.Text_IO.Put (out_file, c);
end case;
last_char := c;
end loop;
end Put_Multi_Line;

procedure Write_as_text (out_file : Ada.Text_IO.File_Type;
buffer : Byte_Buffer;
last_char : in out Character) is — track line – ending characters across writes

c : Character;

begin
for i in buffer’Range loop
c := Character’Val (buffer (i));
case c is
when ASCII.CR =>
Ada.Text_IO.New_Line (out_file);
when ASCII.LF =>
if last_char /= ASCII.CR then
Ada.Text_IO.New_Line (out_file);
end if;
when others =>
Ada.Text_IO.Put (out_file, c);
end case;
last_char := c;
end loop;
end Write_as_text;

end Zip;