Back to...

--  Contributed by ITEC - NXP Semiconductors
--  June 2008
--
--  The Zip_Streams package defines an abstract stream
--  type, Root_Zipstream_Type, with name, time and an index for random access.
--
--  In addition, this package provides two ready-to-use derivations:
--
--    - Memory_Zipstream, for using in-memory streaming
--    - File_Zipstream, for accessing files
--
--  The Zip_Streams package can be used as such, independently
--  of the Zip-Ada library.
--
--  Pure Ada 95+ code, 100% portable: OS-, CPU- and compiler- independent.

--  Legal licensing note:

--  Copyright (c) 2008 .. 2023 Gautier de Montmollin (maintainer)
--  SWITZERLAND

--  Permission is hereby granted, free of charge, to any person obtaining a copy
--  of this software and associated documentation files (the "Software"), to deal
--  in the Software without restriction, including without limitation the rights
--  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
--  copies of the Software, and to permit persons to whom the Software is
--  furnished to do so, subject to the following conditions:

--  The above copyright notice and this permission notice shall be included in
--  all copies or substantial portions of the Software.

--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
--  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
--  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
--  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
--  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
--  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
--  THE SOFTWARE.

--  NB: this is the MIT License, as found 21-Aug-2016 on the site
--  http://www.opensource.org/licenses/mit-license.php

--  Change log:
--  ==========
--
--   8-Sep-2018: GdM: ZS_Size_Type is now 64-bit signed, enabling Zip.Create
--                    to capture archive size overflows.
--   5-Jul-2013: GdM: Added proper types for stream sizes and index
--  20-Nov-2012: GdM: Added Is_Open method for File_Zipstream
--  30-Oct-2012: GdM/NB: - Removed method profiles with 'access' as
--                           overriding some methods with 'access' and some without
--                           at different inheritance levels may be dangerous
--                       - renamed Zipstream_Class Zipstream_Class_Access
--                           (the right name for it)
--  25-Oct-2012: GdM: All methods also with pointer-free profiles
--                     (no more anonymous 'access', nor access types needed)
--  20-Jul-2011: GdM/JH: - Underscore in Get_Name, Set_Name, Get_Time, Set_Time
--                       - The 4 methods above are not anymore abstract
--                       - Name and Modification_Time fields moved to Root_Zipstream_Type
--                       - Unbounded_Stream becomes Memory_Zipstream
--                       - ZipFile_Stream becomes File_Zipstream
--  17-Jul-2011: JH : Added Set_Unicode_Name_Flag, Is_Unicode_Name
--  25-Nov-2009: GdM: Added an own time type -> it is possible to bypass Ada.Calendar
--  18-Jan-2009: GdM: Fixed Zip_Streams.Read which did read
--                      only Item's first element

with Ada.Calendar,
     Ada.Streams.Stream_IO,
     Ada.Strings.Unbounded;

with Interfaces;

package Zip_Streams is

   use Interfaces;

   --  We define an own Time (Ada.Calendar's body can be very time-consuming!)
   --  See subpackage Calendar below for own Split, Time_Of and Convert from/to
   --  Ada.Calendar.Time.
   type Time is private;

   default_time   : constant Time;  --  some default time
   special_time_1 : constant Time;  --  special time code (for users of Zip_Streams)
   special_time_2 : constant Time;  --  special time code (for users of Zip_Streams)

   ------------------------------------------------------
   --  Root_Zipstream_Type: root abstract stream type  --
   ------------------------------------------------------

   type Root_Zipstream_Type is abstract new Ada.Streams.Root_Stream_Type with private;
   type Zipstream_Class_Access is access all Root_Zipstream_Type'Class;

   subtype ZS_Size_Type is Integer_64 range 0 .. Integer_64'Last;
   subtype ZS_Index_Type is ZS_Size_Type range 1 .. ZS_Size_Type'Last;

   --  Set the index on the stream
   procedure Set_Index (S : in out Root_Zipstream_Type;
                        To : ZS_Index_Type) is abstract;

   --  Returns the index of the stream
   function Index (S : in Root_Zipstream_Type) return ZS_Index_Type is abstract;

   --  Returns the Size of the stream
   function Size (S : in Root_Zipstream_Type) return ZS_Size_Type is abstract;

   --  This procedure sets the name of the stream
   procedure Set_Name (S : in out Root_Zipstream_Type; Name : String);

   --  This procedure returns the name of the stream
   function Get_Name (S : in Root_Zipstream_Type) return String;

   procedure Set_Unicode_Name_Flag (S     : out Root_Zipstream_Type;
                                    Value : in Boolean);
   function Is_Unicode_Name (S : in Root_Zipstream_Type)
                             return Boolean;

   procedure Set_Read_Only_Flag (S     : out Root_Zipstream_Type;
                                 Value : in Boolean);
   function Is_Read_Only (S : in Root_Zipstream_Type)
                          return Boolean;

   --  This procedure sets the Modification_Time of the stream
   procedure Set_Time (S : in out Root_Zipstream_Type;
                       Modification_Time : Time);

   --  Set_Time again, but with the standard Ada Time type.
   --  Overriding is useless and potentially harmful, so we prevent it with
   --  a class-wide profile.
   procedure Set_Time (S : in out Root_Zipstream_Type'Class;
                       Modification_Time : Ada.Calendar.Time);

   --  This procedure returns the ModificationTime of the stream
   function Get_Time (S : in Root_Zipstream_Type)
                      return Time;

   --  Get_Time again, but with the standard Ada Time type.
   --  Overriding is useless and potentially harmful, so we prevent it with
   --  a class-wide profile.
   function Get_Time (S : in Root_Zipstream_Type'Class)
                      return Ada.Calendar.Time;

   --  Returns true if the index is at the end of the stream, else false
   function End_Of_Stream (S : in Root_Zipstream_Type)
      return Boolean is abstract;

   -----------------------------------------------------------------------
   --  Memory_Zipstream: stream based on an in-memory Unbounded_String  --
   -----------------------------------------------------------------------
   type Memory_Zipstream is new Root_Zipstream_Type with private;

   --  Get the complete value (contents) of the stream
   procedure Get (Str : Memory_Zipstream; Unb : out Ada.Strings.Unbounded.Unbounded_String);

   --  Set a value in the stream, the index will be set
   --  to null and old data in the stream will be lost.
   procedure Set (Str : in out Memory_Zipstream; Unb : Ada.Strings.Unbounded.Unbounded_String);

   ----------------------------------------------
   --  File_Zipstream: stream based on a file  --
   ----------------------------------------------
   type File_Zipstream is new Root_Zipstream_Type with private;

   type File_Mode is new Ada.Streams.Stream_IO.File_Mode;

   --  Open the File_Zipstream
   --  PRE: Str.Name must be set
   procedure Open (Str : in out File_Zipstream; Mode : File_Mode);

   --  Creates a file on the disk
   --  PRE: Str.Name must be set
   procedure Create (Str : in out File_Zipstream; Mode : File_Mode);

   --  Close the File_Zipstream
   procedure Close (Str : in out File_Zipstream);

   --  Is the File_Zipstream open ?
   function Is_Open (Str : in File_Zipstream) return Boolean;

   ----------------------------
   --  Routines around Time  --
   ----------------------------

   package Calendar is
      --
      function Convert (Date : in Ada.Calendar.Time) return Time;
      function Convert (Date : in Time) return Ada.Calendar.Time;
      --
      subtype DOS_Time is Interfaces.Unsigned_32;
      function Convert (Date : in DOS_Time) return Time;
      function Convert (Date : in Time) return DOS_Time;
      --
      Time_Error : exception;
      --
      procedure Split
        (Date       : Time;
         To_Year    : out Ada.Calendar.Year_Number;
         To_Month   : out Ada.Calendar.Month_Number;
         To_Day     : out Ada.Calendar.Day_Number;
         To_Seconds : out Ada.Calendar.Day_Duration);
      --
      function Time_Of
        (From_Year    : Ada.Calendar.Year_Number;
         From_Month   : Ada.Calendar.Month_Number;
         From_Day     : Ada.Calendar.Day_Number;
         From_Seconds : Ada.Calendar.Day_Duration := 0.0) return Time;
      --
      function ">" (Left, Right : Time) return Boolean;
   end Calendar;

  --  Parameter Form added to *_IO.[Open|Create]
  --  See RM A.8.2: File Management
  --  Example: "encoding=8bits", "encoding=utf8"
  --
  Form_For_IO_Open_and_Create : Ada.Strings.Unbounded.Unbounded_String
    := Ada.Strings.Unbounded.Null_Unbounded_String;

private

   --  Time. Currently, DOS format (pkzip appnote.txt: part V., J.), as stored
   --  in Zip archives. Subject to change, this is why this type is private.
   type Time is new Interfaces.Unsigned_32;

   default_time   : constant Time := 16789 * 65536;
   special_time_1 : constant Time := default_time + 1;
   special_time_2 : constant Time := default_time + 2;

   type Root_Zipstream_Type is abstract new Ada.Streams.Root_Stream_Type with
      record
         Name              : Ada.Strings.Unbounded.Unbounded_String;
         Modification_Time : Time := default_time;
         Is_Unicode_Name   : Boolean := False;
         Is_Read_Only      : Boolean := False;  --  only indicative
      end record;

   --  Memory_Zipstream spec
   type Memory_Zipstream is new Root_Zipstream_Type with
      record
         Unb : Ada.Strings.Unbounded.Unbounded_String;
         Loc : Integer := 1;
      end record;
   --  Read data from the stream.
   overriding procedure Read
     (Stream : in out Memory_Zipstream;
      Item   :    out Ada.Streams.Stream_Element_Array;
      Last   :    out Ada.Streams.Stream_Element_Offset);

   --  Write data to the stream, starting from the current index.
   --  Data will be overwritten from index if already available.
   overriding procedure Write
     (Stream : in out Memory_Zipstream;
      Item   :        Ada.Streams.Stream_Element_Array);

   --  Set the index on the stream
   overriding procedure Set_Index (S : in out Memory_Zipstream; To : ZS_Index_Type);

   --  Returns the index of the stream
   overriding function Index (S : in Memory_Zipstream) return ZS_Index_Type;

   --  Returns the Size of the stream
   overriding function Size (S : in Memory_Zipstream) return ZS_Size_Type;

   --  Returns true if the index is at the end of the stream
   overriding function End_Of_Stream (S : in Memory_Zipstream) return Boolean;

   --  File_Zipstream spec
   type File_Zipstream is new Root_Zipstream_Type with
      record
         File : Ada.Streams.Stream_IO.File_Type;
      end record;
   --  Read data from the stream.
   overriding procedure Read
     (Stream : in out File_Zipstream;
      Item   :    out Ada.Streams.Stream_Element_Array;
      Last   :    out Ada.Streams.Stream_Element_Offset);

   --  Write data to the stream, starting from the current index.
   --  Data will be overwritten from index if already available.
   overriding procedure Write
     (Stream : in out File_Zipstream;
      Item   :        Ada.Streams.Stream_Element_Array);

   --  Set the index on the stream
   overriding procedure Set_Index (S : in out File_Zipstream; To : ZS_Index_Type);

   --  Returns the index of the stream
   overriding function Index (S : in File_Zipstream) return ZS_Index_Type;

   --  Returns the Size of the stream
   overriding function Size (S : in File_Zipstream) return ZS_Size_Type;

   --  Returns true if the index is at the end of the stream
   overriding function End_Of_Stream (S : in File_Zipstream) return Boolean;

end Zip_Streams;