1###############################################################################
2#
3#   Package: NaturalDocs::BinaryFile
4#
5###############################################################################
6#
7#   A package to manage Natural Docs' binary data files.
8#
9#   Usage:
10#
11#       - Only one data file can be managed with this package at a time.  You must close the file before opening another
12#         one.
13#
14###############################################################################
15
16# This file is part of Natural Docs, which is Copyright � 2003-2010 Greg Valure
17# Natural Docs is licensed under version 3 of the GNU Affero General Public License (AGPL)
18# Refer to License.txt for the complete details
19
20use strict;
21use integer;
22
23package NaturalDocs::BinaryFile;
24
25use vars qw(@EXPORT @ISA);
26require Exporter;
27@ISA = qw(Exporter);
28
29@EXPORT = ('BINARY_FORMAT');
30
31use Encode qw(encode_utf8 decode_utf8);
32
33
34###############################################################################
35# Group: Format
36
37#
38#   Topic: Standard Header
39#
40#   > [UInt8: BINARY_FORMAT]
41#   > [VersionInt: app version]
42#
43#   The first byte is <BINARY_FORMAT>, which distinguishes binary configuration files from text ones, since Natural Docs
44#   used to use text data files with the same name.
45#
46#   The next section is the version of Natural Docs that wrote the file, as defined by <NaturalDocs::Settings->AppVersion>
47#   and written by <NaturalDocs::Version->ToBinaryFile()>.
48#
49
50#
51#   Topic: Data Types
52#
53#   All the integer data types are written most significant byte first, aka big endian.
54#
55#   An AString16 is a UInt16 followed by that many 8-bit ASCII characters.  It doesn't include a null character at the end.  Undef
56#   strings are represented by a zero for the UInt16 and nothing following it.
57#
58#   A UString16 is a UInt16 followed by that many UTF-8 encoded bytes.  It doesn't include a null character at the end.  Undef
59#   strings are represented by a zero for the UInt16 and nothing following it.
60#
61
62#
63#   Constant: BINARY_FORMAT
64#
65#   An 8-bit constant that's used as the first byte of binary data files.  This is used so that you can easily distinguish between
66#   binary and old-style text data files.  It's not a character that would appear in plain text files.
67#
68use constant BINARY_FORMAT => pack('C', 0x06);
69# Which is ACK or acknowledge in ASCII.  Is the cool spade character in DOS displays.
70
71
72###############################################################################
73# Group: Variables
74
75#
76#   handle: FH_BINARYDATAFILE
77#
78#   The file handle used for the data file.
79#
80
81
82#
83#   string: currentFile
84#
85#   The <FileName> for the current configuration file being parsed.
86#
87my $currentFile;
88
89
90
91###############################################################################
92# Group: File Functions
93
94
95#
96#   Function: OpenForReading
97#
98#   Opens a binary file for reading.
99#
100#   Parameters:
101#
102#       minimumVersion - The minimum version of the file format that is acceptible.  May be undef.
103#
104#   Returns:
105#
106#       The format <VersionInt> or undef if it failed.  It could fail for any of the following reasons.
107#
108#       - The file doesn't exist.
109#       - The file couldn't be opened.
110#       - The file didn't have the proper header.
111#       - Either the application or the file was from a development release, and they're not the exact same development release.
112#       - The file's format was less than the minimum version, if one was defined.
113#       - The file was from a later application version than the current.
114#
115sub OpenForReading #(FileName file, optional VersionInt minimumVersion) => VersionInt
116    {
117    my ($self, $file, $minimumVersion) = @_;
118
119    if (defined $currentFile)
120        {  die "Tried to open binary file " . $file . " for reading when " . $currentFile . " was already open.";  };
121
122    $currentFile = $file;
123
124    if (open(FH_BINARYDATAFILE, '<' . $currentFile))
125        {
126        # See if it's binary.
127        binmode(FH_BINARYDATAFILE);
128
129        my $firstChar;
130        read(FH_BINARYDATAFILE, $firstChar, 1);
131
132        if ($firstChar == ::BINARY_FORMAT())
133            {
134            my $version = NaturalDocs::Version->FromBinaryFile(\*FH_BINARYDATAFILE);
135
136            if (NaturalDocs::Version->CheckFileFormat($version, $minimumVersion))
137                {  return $version;  };
138            };
139
140        close(FH_BINARYDATAFILE);
141        };
142
143    $currentFile = undef;
144    return undef;
145    };
146
147
148#
149#   Function: OpenForWriting
150#
151#   Opens a binary file for writing and writes the standard header.  Dies if the file cannot be opened.
152#
153sub OpenForWriting #(FileName file)
154    {
155    my ($self, $file) = @_;
156
157    if (defined $currentFile)
158        {  die "Tried to open binary file " . $file . " for writing when " . $currentFile . " was already open.";  };
159
160    $currentFile = $file;
161
162    open (FH_BINARYDATAFILE, '>' . $currentFile)
163        or die "Couldn't save " . $file . ".\n";
164
165    binmode(FH_BINARYDATAFILE);
166
167    print FH_BINARYDATAFILE '' . ::BINARY_FORMAT();
168    NaturalDocs::Version->ToBinaryFile(\*FH_BINARYDATAFILE, NaturalDocs::Settings->AppVersion());
169    };
170
171
172#
173#   Function: Close
174#
175#   Closes the current configuration file.
176#
177sub Close
178    {
179    my $self = shift;
180
181    if (!$currentFile)
182        {  die "Tried to close a binary file when one wasn't open.";  };
183
184    close(FH_BINARYDATAFILE);
185    $currentFile = undef;
186    };
187
188
189
190###############################################################################
191# Group: Reading Functions
192
193
194#
195#   Function: GetUInt8
196#   Reads and returns a UInt8 from the open file.
197#
198sub GetUInt8 # => UInt8
199    {
200    my $raw;
201    read(FH_BINARYDATAFILE, $raw, 1);
202
203    return unpack('C', $raw);
204    };
205
206#
207#   Function: GetUInt16
208#   Reads and returns a UInt16 from the open file.
209#
210sub GetUInt16 # => UInt16
211    {
212    my $raw;
213    read(FH_BINARYDATAFILE, $raw, 2);
214
215    return unpack('n', $raw);
216    };
217
218#
219#   Function: GetUInt32
220#   Reads and returns a UInt32 from the open file.
221#
222sub GetUInt32 # => UInt32
223    {
224    my $raw;
225    read(FH_BINARYDATAFILE, $raw, 4);
226
227    return unpack('N', $raw);
228    };
229
230#
231#   Function: GetAString16
232#   Reads and returns an AString16 from the open file.  Supports undef strings.
233#
234sub GetAString16 # => string
235    {
236    my $rawLength;
237    read(FH_BINARYDATAFILE, $rawLength, 2);
238    my $length = unpack('n', $rawLength);
239
240    if (!$length)
241        {  return undef;  };
242
243    my $string;
244    read(FH_BINARYDATAFILE, $string, $length);
245
246    return $string;
247    };
248
249#
250#   Function: GetUString16
251#   Reads and returns a UString16 from the open file.  Supports undef strings.
252#
253sub GetUString16 # => string
254    {
255    my $rawLength;
256    read(FH_BINARYDATAFILE, $rawLength, 2);
257    my $length = unpack('n', $rawLength);
258
259    if (!$length)
260        {  return undef;  };
261
262    my $string;
263    read(FH_BINARYDATAFILE, $string, $length);
264	$string = decode_utf8($string);
265
266    return $string;
267    };
268
269
270
271###############################################################################
272# Group: Writing Functions
273
274
275#
276#   Function: WriteUInt8
277#   Writes a UInt8 to the open file.
278#
279sub WriteUInt8 #(UInt8 value)
280    {
281    my ($self, $value) = @_;
282    print FH_BINARYDATAFILE pack('C', $value);
283    };
284
285#
286#   Function: WriteUInt16
287#   Writes a UInt32 to the open file.
288#
289sub WriteUInt16 #(UInt16 value)
290    {
291    my ($self, $value) = @_;
292    print FH_BINARYDATAFILE pack('n', $value);
293    };
294
295#
296#   Function: WriteUInt32
297#   Writes a UInt32 to the open file.
298#
299sub WriteUInt32 #(UInt32 value)
300    {
301    my ($self, $value) = @_;
302    print FH_BINARYDATAFILE pack('N', $value);
303    };
304
305#
306#   Function: WriteAString16
307#   Writes an AString16 to the open file.  Supports undef strings.
308#
309sub WriteAString16 #(string value)
310    {
311    my ($self, $string) = @_;
312
313    if (length($string))
314        {  print FH_BINARYDATAFILE pack('nA*', length($string), $string);  }
315    else
316        {  print FH_BINARYDATAFILE pack('n', 0);  };
317    };
318
319#
320#   Function: WriteUString16
321#   Writes an UString16 to the open file.  Supports undef strings.
322#
323sub WriteUString16 #(string value)
324    {
325    my ($self, $string) = @_;
326
327    if (length($string))
328        {
329        $string = encode_utf8($string);
330        print FH_BINARYDATAFILE pack('na*', length($string), $string);
331        }
332    else
333        {  print FH_BINARYDATAFILE pack('n', 0);  };
334    };
335
336
3371;
338