1. -- Changes 
  2.  -- 
  3.  -- 11 - Nov - 2009 (GdM) : Unbounded_Stream.Write and .Set_Index are buffered 
  4.  -- 18 - Jan - 2009 (GdM) : Fixed Read (Stream, Item .. .) which read 
  5.  --                      only 1st element of Item 
  6.  
  7.  -- with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; 
  8.  -- with Ada.Text_IO; -- use Ada.Text_IO; 
  9. with Zip; 
  10. package body Zip_Streams is 
  11.  
  12.    procedure Set_Name (S : access Root_Zipstream_Type; Stream_Name : String) is 
  13.  
  14.    begin 
  15.       S.all.Name := To_Unbounded_String (Stream_Name); 
  16.    end Set_Name; 
  17.  
  18.    function Get_Name (S : access Root_Zipstream_Type) return String is (To_String (S.all.Name)); 
  19.  
  20.    procedure Set_Time (S : access Root_Zipstream_Type; Modification_Time : Time) is 
  21.  
  22.    begin 
  23.       S.all.Modification_Time := Modification_Time; 
  24.    end Set_Time; 
  25.  
  26.    function Get_Time (S : access Root_Zipstream_Type) return Time is (S.all.Modification_Time); 
  27.  
  28.    procedure Set_Time (S                 : Zipstream_Class; 
  29.                        Modification_Time : Ada.Calendar.Time) is 
  30.  
  31.    begin 
  32.      Set_Time (S, Calendar.Convert (Modification_Time)); 
  33.    end Set_Time; 
  34.  
  35.    function Get_Time (S : Zipstream_Class) return Ada.Calendar.Time is (Calendar.Convert (Get_Time (S))); 
  36.  
  37.    procedure Set_Unicode_Name_Flag (S     : access Root_Zipstream_Type; 
  38.                                     Value :        Boolean) is 
  39.  
  40.    begin 
  41.      S.all.Is_Unicode_Name := Value; 
  42.    end Set_Unicode_Name_Flag; 
  43.  
  44.    function Is_Unicode_Name (S : access Root_Zipstream_Type) return Boolean is (S.all.Is_Unicode_Name); 
  45.  
  46.    --------------------------------------------------------------------- 
  47.    -- Unbounded_Stream : stream based on an in - memory Unbounded_String -- 
  48.    --------------------------------------------------------------------- 
  49.  
  50.    procedure Get (Str  : Memory_Zipstream; Unb  : out Unbounded_String) is 
  51.  
  52.    begin 
  53.       Unb := Str.Unb; 
  54.    end Get; 
  55.  
  56.    procedure Set (Str  : in out Memory_Zipstream; Unb  : Unbounded_String) is 
  57.  
  58.    begin 
  59.       Str.Unb := Null_Unbounded_String; -- clear the content of the stream 
  60.       Str.Unb := Unb; 
  61.       Str.Loc := 1; 
  62.    end Set; 
  63.  
  64.    overriding procedure Read (Zip_Stream : in out Memory_Zipstream; 
  65.                               Item       :    out Stream_Element_Array; 
  66.                               Last       :    out Stream_Element_Offset) is 
  67.  
  68.    begin 
  69.       -- Item is read from the stream. If (and only if) the stream is 
  70.       -- exhausted, Last will be < Item'Last. In that case, T'Read will 
  71.       -- raise an End_Error exception. 
  72.       -- 
  73.       -- Cf : RM 13.13.1 (8), RM 13.13.1 (11), RM 13.13.2 (37) and 
  74.       -- explanations by Tucker Taft 
  75.       -- 
  76.       Last := Item'First - 1; 
  77.       -- if Item is empty, the following loop is skipped; if Stream.Loc 
  78.       -- is already indexing out of Stream.Unb, that value is also appropriate 
  79.       for i in Item'Range loop 
  80.          Item (i) := Character'Pos (Element (Zip_Stream.Unb, Zip_Stream.Loc)); 
  81.          Zip_Stream.Loc := Zip_Stream.Loc + 1; 
  82.          Last := i; 
  83.       end loop; 
  84.    exception 
  85.       when Ada.Strings.Index_Error => 
  86.          null; -- what could be read has been read; T'Read will raise End_Error 
  87.    end Read; 
  88.  
  89.    max_chunk_size : constant := 16 * 1024; 
  90.  
  91.    overriding procedure Write (Zip_Stream : in out Memory_Zipstream; 
  92.                                Item       :        Stream_Element_Array) is 
  93.  
  94.      I : Stream_Element_Offset := Item'First; 
  95.      chunk_size : Integer; 
  96.      tmp : String (1 .. max_chunk_size); 
  97.  
  98.    begin 
  99.      while I <= Item'Last loop 
  100.        chunk_size := Integer'Min (Integer (Item'Last - I + 1), max_chunk_size); 
  101.        if Zip_Stream.Loc > Length (Zip_Stream.Unb) then 
  102.          -- . .. we are off the string's bounds, we need to extend it. 
  103.          for J in 1 .. chunk_size loop 
  104.            tmp (J) := Character'Val (Item (I)); 
  105.            I := I + 1; 
  106.          end loop; 
  107.          Append (Zip_Stream.Unb, tmp (1 .. chunk_size)); 
  108.        else 
  109.          -- . .. we can work (at least for a part) within the string's bounds. 
  110.          chunk_size := Integer'Min (chunk_size, Length (Zip_Stream.Unb) - Zip_Stream.Loc + 1); 
  111.          for J in 0 .. chunk_size - 1 loop 
  112.            Replace_Element (Zip_Stream.Unb, Zip_Stream.Loc + J, Character'Val (Item (I))); 
  113.            -- GNAT 2008's Replace_Slice does something very general 
  114.            -- even in the trivial case where one can make: 
  115.            -- Source.Reference (Low .. High) := By; 
  116.            -- - > still faster with elem by elem replacement 
  117.            -- Anyway, this place is not critical for zipping : only the 
  118.            -- local header before compressed data is rewritten after 
  119.            -- compression. So usually, we are off bounds. 
  120.            I := I + 1; 
  121.          end loop; 
  122.        end if; 
  123.        Zip_Stream.Loc := Zip_Stream.Loc + chunk_size; 
  124.      end loop; 
  125.    end Write; 
  126.  
  127.    overriding procedure Set_Index (S  : access Memory_Zipstream; To  : Positive) is 
  128.  
  129.      I, chunk_size : Integer; 
  130.  
  131.    begin 
  132.      if To > Length (S.all.Unb) then 
  133.        -- . .. we are off the string's bounds, we need to extend it. 
  134.        I := Length (S.all.Unb) + 1; 
  135.        while I <= To loop 
  136.          chunk_size := Integer'Min (To - I + 1, max_chunk_size); 
  137.          Append (S.all.Unb, (1 .. chunk_size => ASCII.NUL)); 
  138.          I := I + chunk_size; 
  139.        end loop; 
  140.      end if; 
  141.      S.all.Loc := To; 
  142.    end Set_Index; 
  143.  
  144.    overriding function Size (S : access Memory_Zipstream) return Integer is (Length (S.all.Unb)); 
  145.  
  146.    overriding function Index (S : access Memory_Zipstream) return Integer is (S.all.Loc); 
  147.  
  148.    overriding function End_Of_Stream (S : access Memory_Zipstream) return Boolean is 
  149.  
  150.    begin 
  151.       if Size (S) < Index (S) then 
  152.          return True; 
  153.       else 
  154.          return False; 
  155.       end if; 
  156.    end End_Of_Stream; 
  157.  
  158.    -------------------------------------------- 
  159.    -- File_Zipstream : stream based on a file -- 
  160.    -------------------------------------------- 
  161.  
  162.    procedure Open (Str  : in out File_Zipstream; Zipfile_Mode  : File_Mode) is 
  163.  
  164.    begin 
  165.       Ada.Streams.Stream_IO.Open (Str.File, Zipfile_Mode, To_String (Str.Name), 
  166.                                  Form => To_String (Zip.Form_For_IO_Open_N_Create)); 
  167.    end Open; 
  168.  
  169.    procedure Create (Str  : in out File_Zipstream; Zipfile_Mode  : File_Mode) is 
  170.  
  171.    begin 
  172.       Ada.Streams.Stream_IO.Create (Str.File, Zipfile_Mode, To_String (Str.Name), 
  173.                                  Form => To_String (Zip.Form_For_IO_Open_N_Create)); 
  174.    end Create; 
  175.  
  176.    procedure Close (Str  : in out File_Zipstream) is 
  177.  
  178.    begin 
  179.       Ada.Streams.Stream_IO.Close (Str.File); 
  180.    end Close; 
  181.  
  182.    overriding procedure Read (Zip_Stream : in out File_Zipstream; 
  183.                               Item       :    out Stream_Element_Array; 
  184.                               Last       :    out Stream_Element_Offset) is 
  185.  
  186.    begin 
  187.       Ada.Streams.Stream_IO.Read (Zip_Stream.File, Item, Last); 
  188.    end Read; 
  189.  
  190.    overriding procedure Write (Zip_Stream : in out File_Zipstream; 
  191.                                Item       :        Stream_Element_Array) is 
  192.  
  193.    begin 
  194.       Ada.Streams.Stream_IO.Write (Zip_Stream.File, Item); 
  195.    end Write; 
  196.  
  197.    overriding procedure Set_Index (S : access File_Zipstream; To : Positive) is 
  198.  
  199.    begin 
  200.       Ada.Streams.Stream_IO.Set_Index (S.all.File, Positive_Count (To)); 
  201.    end Set_Index; 
  202.  
  203.    overriding function Size (S : access File_Zipstream) return Integer is (Integer (Ada.Streams.Stream_IO.Size (S.all.File))); 
  204.  
  205.    overriding function Index (S : access File_Zipstream) return Integer is (Integer (Ada.Streams.Stream_IO.Index (S.all.File))); 
  206.  
  207.    overriding function End_Of_Stream (S  : access File_Zipstream) return Boolean is (Ada.Streams.Stream_IO.End_Of_File (S.all.File)); 
  208.  
  209.    package body Calendar is 
  210.  
  211.       ----------------------------------------------- 
  212.       -- Time = DOS Time. Valid through Year 2107. -- 
  213.       ----------------------------------------------- 
  214.  
  215.       procedure Split (Date          : Time; 
  216.                        Year_Num      : out Year_Number; 
  217.                        Month_Num     : out Month_Number; 
  218.                        Day_Num       : out Day_Number; 
  219.                        No_of_Seconds : out Day_Duration) is 
  220.  
  221.          d_date  : constant Integer := Integer (Date  /  65536); 
  222.          d_time  : constant Integer := Integer (Date and 65535); 
  223.          use Interfaces; 
  224.          hours        : Integer; 
  225.          minutes      : Integer; 
  226.          seconds_only : Integer; 
  227.       begin 
  228.          Year_Num := 1980 + d_date / 512; 
  229.          Month_Num := (d_date / 32) mod 16; 
  230.          Day_Num  := d_date mod 32; 
  231.          hours   := d_time / 2048; 
  232.          minutes := (d_time / 32) mod 64; 
  233.          seconds_only := 2 * (d_time mod 32); 
  234.          No_of_Seconds := Day_Duration (hours * 3600 + minutes * 60 + seconds_only); 
  235.       end Split; 
  236.       -- 
  237.       function Time_Of (Year_Num      : Year_Number; 
  238.                         Month_Num     : Month_Number; 
  239.                         Day_Num       : Day_Number; 
  240.                         No_of_Seconds : Day_Duration := 0.0) return Time is 
  241.  
  242.          year_2           : Integer := Year_Num; 
  243.          use Interfaces; 
  244.          hours            : Unsigned_32; 
  245.          minutes          : Unsigned_32; 
  246.          seconds_only     : Unsigned_32; 
  247.          seconds_day      : Unsigned_32; 
  248.          result : Unsigned_32; 
  249.       begin 
  250.  
  251.          if year_2 < 1980 then -- avoid invalid DOS date 
  252.            year_2 := 1980; 
  253.          end if; 
  254.          seconds_day := Unsigned_32 (No_of_Seconds); 
  255.          hours := seconds_day / 3600; 
  256.          minutes :=  (seconds_day / 60) mod 60; 
  257.          seconds_only := seconds_day mod 60; 
  258.          result := 
  259.            -- MSDN formula for encoding: 
  260.              Unsigned_32 ((year_2 - 1980) * 512 + Month_Num * 32 + Day_Num) * 65536 -- Date 
  261.            + 
  262.              hours * 2048 + minutes * 32 + seconds_only / 2; -- Time 
  263.          return Time (result); 
  264.       end Time_Of; 
  265.  
  266.       function Convert (date : Ada.Calendar.Time) return Time is 
  267.  
  268.          year_num         : Year_Number; 
  269.          month_num        : Month_Number; 
  270.          day_num          : Day_Number; 
  271.          seconds_day_dur  : Day_Duration; 
  272.  
  273.       begin 
  274.          Split (date, year_num, month_num, day_num, seconds_day_dur); 
  275.          return Time_Of (year_num, month_num, day_num, seconds_day_dur); 
  276.       end Convert; 
  277.  
  278.       function Convert (date : Time) return Ada.Calendar.Time is 
  279.  
  280.          year_num         : Year_Number; 
  281.          month_num        : Month_Number; 
  282.          day_num          : Day_Number; 
  283.          seconds_day_dur  : Day_Duration; 
  284.  
  285.       begin 
  286.          Split (date, year_num, month_num, day_num, seconds_day_dur); 
  287.          return Time_Of (year_num, month_num, day_num, seconds_day_dur); 
  288.       end Convert; 
  289.  
  290.       function Convert (date : DOS_Time) return Time is (Time (date));     -- currently a trivial conversion 
  291.  
  292.       function Convert (date : Time) return DOS_Time is (DOS_Time (date)); -- currently a trivial conversion 
  293.  
  294.    end Calendar; 
  295.  
  296. end Zip_Streams;