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