zipada_56.0.2_b3043499/zip_lib/zip_streams.ads

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
--  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 .. 2020 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.Streams;           use Ada.Streams;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Streams.Stream_IO;

with Ada.Calendar, Interfaces;
use Interfaces;

package Zip_Streams is

   --  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 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 : 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;
      --
      use Ada.Calendar;
      --
      procedure Split
        (Date       : Time;
         To_Year    : out Year_Number;
         To_Month   : out Month_Number;
         To_Day     : out Day_Number;
         To_Seconds : out Day_Duration);
      --
      function Time_Of
        (From_Year    : Year_Number;
         From_Month   : Month_Number;
         From_Day     : Day_Number;
         From_Seconds : 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              : 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 : Unbounded_String;
         Loc : Integer := 1;
      end record;
   --  Read data from the stream.
   overriding procedure Read
     (Stream : in out Memory_Zipstream;
      Item   : out Stream_Element_Array;
      Last   : out 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   : 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 Stream_Element_Array;
      Last   : out 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   : 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;