1. -- Contributed by ITEC - NXP Semiconductors 
  2.  -- June 2008 
  3.  -- 
  4.  -- The Zip_Streams package defines an abstract stream 
  5.  -- type, Root_Zipstream_Type, with name, time and an index for random access. 
  6.  -- In addition, this package provides two ready - to - use derivations: 
  7.  -- 
  8.  --   - Memory_Zipstream, for using in - memory streaming 
  9.  -- 
  10.  --   - File_Zipstream, for accessing files 
  11.  -- 
  12.  -- Change log: 
  13.  -- ========== 
  14.  -- 
  15.  -- 20 - Jul - 2011 : GdM/JH : - Underscore in Get_Name, Set_Name, Get_Time, Set_Time 
  16.  --                      - The 4 methods above are not anymore abstract 
  17.  --                      - Name and Modification_Time fields moved to Root_Zipstream_Type 
  18.  --                      - Unbounded_Stream becomes Memory_Zipstream 
  19.  --                      - ZipFile_Stream becomes File_Zipstream 
  20.  -- 17 - Jul - 2011 : JH  : Added Set_Unicode_Name_Flag, Is_Unicode_Name 
  21.  -- 25 - Nov - 2009 : GdM : Added an own time type - > it is possible to bypass Ada.Calendar 
  22.  -- 18 - Jan - 2009 : GdM : Fixed Zip_Streams.Read which did read 
  23.  --                     only Item's first element 
  24.  
  25. with Ada.Streams;           use Ada.Streams; 
  26. with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 
  27. with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; 
  28.  
  29. with Ada.Calendar, Interfaces; 
  30.  
  31. package Zip_Streams is 
  32.  
  33.    type Time is private; 
  34.    -- ^ we define an own Time (Ada.Calendar's body can be very time - consuming!) 
  35.    -- See subpackage Calendar below for own Split, Time_Of and Convert from/to 
  36.    -- Ada.Calendar.Time. 
  37.  
  38.    ---------------------------------------------------- 
  39.    -- Root_Zipstream_Type : root abstract stream type -- 
  40.    ---------------------------------------------------- 
  41.  
  42.    type Root_Zipstream_Type is abstract new Ada.Streams.Root_Stream_Type with private; 
  43.    type Zipstream_Class is access all Root_Zipstream_Type'Class; 
  44.  
  45.    -- Set the index on the stream 
  46.    procedure Set_Index (S  : access Root_Zipstream_Type; 
  47.                         To  : Positive) is abstract; 
  48.  
  49.    -- returns the index of the stream 
  50.    function Index (S  : access Root_Zipstream_Type) return Integer is abstract; 
  51.  
  52.    -- returns the Size of the stream 
  53.    function Size (S  : access Root_Zipstream_Type) return Integer is abstract; 
  54.  
  55.    -- this procedure sets the name of the stream 
  56.    procedure Set_Name (S : access Root_Zipstream_Type; Stream_Name : String); 
  57.  
  58.    procedure SetName (S : access Root_Zipstream_Type; Stream_Name : String) renames Set_Name; 
  59.    pragma Obsolescent (SetName); 
  60.  
  61.    -- this procedure returns the name of the stream 
  62.    function Get_Name (S : access Root_Zipstream_Type) return String; 
  63.  
  64.    function GetName (S : access Root_Zipstream_Type) return String renames Get_Name; 
  65.    pragma Obsolescent (GetName); 
  66.  
  67.    procedure Set_Unicode_Name_Flag (S      : access Root_Zipstream_Type; 
  68.                                     Value  :        Boolean); 
  69.    function Is_Unicode_Name (S  : access Root_Zipstream_Type) 
  70.                             return Boolean; 
  71.  
  72.    -- this procedure sets the Modification_Time of the stream 
  73.    procedure Set_Time (S  : access Root_Zipstream_Type; 
  74.                       Modification_Time  : Time); 
  75.  
  76.    procedure SetTime (S  : access Root_Zipstream_Type; 
  77.                       Modification_Time  : Time) renames Set_Time; 
  78.    pragma Obsolescent (SetTime); 
  79.  
  80.    -- same, with the standard Time type 
  81.    procedure Set_Time (S  : Zipstream_Class; 
  82.                       Modification_Time  : Ada.Calendar.Time); 
  83.  
  84.    procedure SetTime (S  : Zipstream_Class; 
  85.                       Modification_Time  : Ada.Calendar.Time) renames Set_Time; 
  86.    pragma Obsolescent (SetTime); 
  87.  
  88.    -- this procedure returns the ModificationTime of the stream 
  89.    function Get_Time (S  : access Root_Zipstream_Type) 
  90.                      return Time; 
  91.  
  92.    function GetTime (S  : access Root_Zipstream_Type) 
  93.                     return Time renames Get_Time; 
  94.    pragma Obsolescent (GetTime); 
  95.  
  96.    -- same, with the standard Time type 
  97.    function Get_Time (S  : Zipstream_Class) 
  98.                      return Ada.Calendar.Time; 
  99.  
  100.    function GetTime (S  : Zipstream_Class) 
  101.                     return Ada.Calendar.Time renames Get_Time; 
  102.    pragma Obsolescent (GetTime); 
  103.  
  104.    -- returns true if the index is at the end of the stream, else false 
  105.    function End_Of_Stream (S  : access Root_Zipstream_Type) 
  106.       return Boolean is abstract; 
  107.  
  108.    --------------------------------------------------------------------- 
  109.    -- Unbounded_Stream : stream based on an in - memory Unbounded_String -- 
  110.    --------------------------------------------------------------------- 
  111.    type Memory_Zipstream is new Root_Zipstream_Type with private; 
  112.    subtype Unbounded_Stream is Memory_Zipstream; 
  113.    pragma Obsolescent (Unbounded_Stream); 
  114.  
  115.    -- Get the complete value of the stream 
  116.    procedure Get (Str  : Memory_Zipstream; Unb  : out Unbounded_String); 
  117.  
  118.    -- Set a value in the stream, the index will be set 
  119.    -- to null and old data in the stream will be lost. 
  120.    procedure Set (Str  : in out Memory_Zipstream; Unb  : Unbounded_String); 
  121.  
  122.    -------------------------------------------- 
  123.    -- File_Zipstream : stream based on a file -- 
  124.    -------------------------------------------- 
  125.    type File_Zipstream is new Root_Zipstream_Type with private; 
  126.    subtype ZipFile_Stream is File_Zipstream; 
  127.    pragma Obsolescent (ZipFile_Stream); 
  128.  
  129.    -- Open the File_Zipstream 
  130.    -- PRE : Str.Name must be set 
  131.    procedure Open (Str  : in out File_Zipstream; Zipfile_Mode  : File_Mode); 
  132.  
  133.    -- Creates a file on the disk 
  134.    -- PRE : Str.Name must be set 
  135.    procedure Create (Str  : in out File_Zipstream; Zipfile_Mode  : File_Mode); 
  136.  
  137.    -- Close the File_Zipstream 
  138.    procedure Close (Str  : in out File_Zipstream); 
  139.  
  140.    -------------------------- 
  141.    -- Routines around Time -- 
  142.    -------------------------- 
  143.  
  144.    package Calendar is 
  145.       -- 
  146.       function Convert (date : Ada.Calendar.Time) return Time; 
  147.       function Convert (date : Time) return Ada.Calendar.Time; 
  148.       -- 
  149.       subtype DOS_Time is Interfaces.Unsigned_32; 
  150.       function Convert (date : DOS_Time) return Time; 
  151.       function Convert (date : Time) return DOS_Time; 
  152.       -- 
  153.       use Ada.Calendar; 
  154.       -- 
  155.       procedure Split (Date          : Time; 
  156.                        Year_Num      : out Year_Number; 
  157.                        Month_Num     : out Month_Number; 
  158.                        Day_Num       : out Day_Number; 
  159.                        No_of_Seconds : out Day_Duration); 
  160.       -- 
  161.       function Time_Of (Year_Num      : Year_Number; 
  162.                         Month_Num     : Month_Number; 
  163.                         Day_Num       : Day_Number; 
  164.                         No_of_Seconds : Day_Duration := 0.0) return Time; 
  165.       -- 
  166.    end Calendar; 
  167.  
  168. private 
  169.  
  170.    type Time is new Interfaces.Unsigned_32; 
  171.    -- Currently : DOS format (pkzip appnote.txt : part V., J.), as stored 
  172.    -- in zip archives. Subject to change, this is why this type is private. 
  173.  
  174.    some_time : constant Time := 16789 * 65536; 
  175.  
  176.    type Root_Zipstream_Type is abstract new Ada.Streams.Root_Stream_Type with 
  177.       record 
  178.          Name               : Unbounded_String; 
  179.          Modification_Time  : Time := some_time; 
  180.          Is_Unicode_Name    : Boolean := False; 
  181.       end record; 
  182.  
  183.    -- Memory_Zipstream spec 
  184.    type Memory_Zipstream is new Root_Zipstream_Type with 
  185.       record 
  186.          Unb  : Unbounded_String; 
  187.          Loc  : Integer := 1; 
  188.       end record; 
  189.    -- Read data from the stream. 
  190.    overriding procedure Read (Zip_Stream : in out Memory_Zipstream; 
  191.                               Item       :    out Stream_Element_Array; 
  192.                               Last       :    out Stream_Element_Offset); 
  193.  
  194.    -- write data to the stream, starting from the current index. 
  195.    -- Data will be overwritten from index is already available. 
  196.    overriding procedure Write (Zip_Stream : in out Memory_Zipstream; 
  197.                                Item       :        Stream_Element_Array); 
  198.  
  199.    -- Set the index on the stream 
  200.    overriding procedure Set_Index (S  : access Memory_Zipstream; To  : Positive); 
  201.  
  202.    -- returns the index of the stream 
  203.    overriding function Index (S  : access Memory_Zipstream) return Integer; 
  204.  
  205.    -- returns the Size of the stream 
  206.    overriding function Size (S  : access Memory_Zipstream) return Integer; 
  207.  
  208.    -- returns true if the index is at the end of the stream 
  209.    overriding function End_Of_Stream (S  : access Memory_Zipstream) return Boolean; 
  210.  
  211.    -- File_Zipstream spec 
  212.    type File_Zipstream is new Root_Zipstream_Type with 
  213.       record 
  214.          File  : File_Type; 
  215.       end record; 
  216.    -- Read data from the stream. 
  217.    overriding procedure Read 
  218.      (Zip_Stream  : in out File_Zipstream; 
  219.       Item    : out Stream_Element_Array; 
  220.       Last    : out Stream_Element_Offset); 
  221.  
  222.    -- write data to the stream, starting from the current index. 
  223.    -- Data will be overwritten from index is already available. 
  224.    overriding procedure Write 
  225.      (Zip_Stream  : in out File_Zipstream; 
  226.       Item    : Stream_Element_Array); 
  227.  
  228.    -- Set the index on the stream 
  229.    overriding procedure Set_Index (S  : access File_Zipstream; To  : Positive); 
  230.  
  231.    -- returns the index of the stream 
  232.    overriding function Index (S  : access File_Zipstream) return Integer; 
  233.  
  234.    -- returns the Size of the stream 
  235.    overriding function Size (S  : access File_Zipstream) return Integer; 
  236.  
  237.    -- returns true if the index is at the end of the stream 
  238.    overriding function End_Of_Stream (S  : access File_Zipstream) return Boolean; 
  239.  
  240. end Zip_Streams;