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; Name : String); 
  57.  
  58.    procedure SetName(S : access Root_Zipstream_Type; 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 : in 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; 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; 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 : in Ada.Calendar.Time) return Time; 
  147.       function Convert(date : in Time) return Ada.Calendar.Time; 
  148.       -- 
  149.       subtype DOS_Time is Interfaces.Unsigned_32; 
  150.       function Convert(date : in DOS_Time) return Time; 
  151.       function Convert(date : in Time) return DOS_Time; 
  152.       -- 
  153.       use Ada.Calendar; 
  154.       -- 
  155.       procedure Split 
  156.         (Date    : Time; 
  157.          Year    : out Year_Number; 
  158.          Month   : out Month_Number; 
  159.          Day     : out Day_Number; 
  160.          Seconds : out Day_Duration); 
  161.       -- 
  162.       function Time_Of 
  163.         (Year    : Year_Number; 
  164.          Month   : Month_Number; 
  165.          Day     : Day_Number; 
  166.          Seconds : Day_Duration := 0.0) return Time; 
  167.       -- 
  168.    end Calendar; 
  169.  
  170. private 
  171.  
  172.    type Time is new Interfaces.Unsigned_32; 
  173.    -- Currently: DOS format (pkzip appnote.txt: part V., J.), as stored 
  174.    -- in zip archives. Subject to change, this is why this type is private. 
  175.  
  176.    some_time: constant Time:= 16789 * 65536; 
  177.  
  178.    type Root_Zipstream_Type is abstract new Ada.Streams.Root_Stream_Type with 
  179.       record 
  180.          Name              : Unbounded_String; 
  181.          Modification_Time : Time := some_time; 
  182.          Is_Unicode_Name   : Boolean := False; 
  183.       end record; 
  184.  
  185.    -- Memory_Zipstream spec 
  186.    type Memory_Zipstream is new Root_Zipstream_Type with 
  187.       record 
  188.          Unb : Unbounded_String; 
  189.          Loc : Integer := 1; 
  190.       end record; 
  191.    -- Read data from the stream. 
  192.    procedure Read 
  193.      (Stream : in out Memory_Zipstream; 
  194.       Item   : out Stream_Element_Array; 
  195.       Last   : out Stream_Element_Offset); 
  196.  
  197.    -- write data to the stream, starting from the current index. 
  198.    -- Data will be overwritten from index is already available. 
  199.    procedure Write 
  200.      (Stream : in out Memory_Zipstream; 
  201.       Item   : Stream_Element_Array); 
  202.  
  203.    -- Set the index on the stream 
  204.    procedure Set_Index (S : access Memory_Zipstream; To : Positive); 
  205.  
  206.    -- returns the index of the stream 
  207.    function Index (S : access Memory_Zipstream) return Integer; 
  208.  
  209.    -- returns the Size of the stream 
  210.    function Size (S : access Memory_Zipstream) return Integer; 
  211.  
  212.    -- returns true if the index is at the end of the stream 
  213.    function End_Of_Stream (S : access Memory_Zipstream) return Boolean; 
  214.  
  215.  
  216.    -- File_Zipstream spec 
  217.    type File_Zipstream is new Root_Zipstream_Type with 
  218.       record 
  219.          File : File_Type; 
  220.       end record; 
  221.    -- Read data from the stream. 
  222.    procedure Read 
  223.      (Stream : in out File_Zipstream; 
  224.       Item   : out Stream_Element_Array; 
  225.       Last   : out Stream_Element_Offset); 
  226.  
  227.    -- write data to the stream, starting from the current index. 
  228.    -- Data will be overwritten from index is already available. 
  229.    procedure Write 
  230.      (Stream : in out File_Zipstream; 
  231.       Item   : Stream_Element_Array); 
  232.  
  233.    -- Set the index on the stream 
  234.    procedure Set_Index (S : access File_Zipstream; To : Positive); 
  235.  
  236.    -- returns the index of the stream 
  237.    function Index (S : access File_Zipstream) return Integer; 
  238.  
  239.    -- returns the Size of the stream 
  240.    function Size (S : access File_Zipstream) return Integer; 
  241.  
  242.    -- returns true if the index is at the end of the stream 
  243.    function End_Of_Stream (S : access File_Zipstream) return Boolean; 
  244.  
  245. end Zip_Streams;