about summary refs log tree commit diff
path: root/docs/tool/Modules/NaturalDocs/BinaryFile.pm
blob: 5c1adb8d3a89e69f1c7d10f1d42333d9655760d4 (plain)
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
###############################################################################
#
#   Package: NaturalDocs::BinaryFile
#
###############################################################################
#
#   A package to manage Natural Docs' binary data files.
#
#   Usage:
#
#       - Only one data file can be managed with this package at a time.  You must close the file before opening another
#         one.
#
###############################################################################

# This file is part of Natural Docs, which is Copyright (C) 2003-2008 Greg Valure
# Natural Docs is licensed under the GPL

use strict;
use integer;

package NaturalDocs::BinaryFile;

use vars qw(@EXPORT @ISA);
require Exporter;
@ISA = qw(Exporter);

@EXPORT = ('BINARY_FORMAT');


###############################################################################
# Group: Format

#
#   Topic: Standard Header
#
#   > [UInt8: BINARY_FORMAT]
#   > [VersionInt: app version]
#
#   The first byte is <BINARY_FORMAT>, which distinguishes binary configuration files from text ones, since Natural Docs
#   used to use text data files with the same name.
#
#   The next section is the version of Natural Docs that wrote the file, as defined by <NaturalDocs::Settings->AppVersion>
#   and written by <NaturalDocs::Version->ToBinaryFile()>.
#

#
#   Topic: Data Types
#
#   All the integer data types are written most significant byte first, aka big endian.
#
#   An AString16 is a UInt16 followed by that many 8-bit ASCII characters.  It doesn't include a null character at the end.  Undef
#   strings are represented by a zero for the UInt16 and nothing following it.
#

#
#   Constant: BINARY_FORMAT
#
#   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
#   binary and old-style text data files.  It's not a character that would appear in plain text files.
#
use constant BINARY_FORMAT => pack('C', 0x06);
# Which is ACK or acknowledge in ASCII.  Is the cool spade character in DOS displays.


###############################################################################
# Group: Variables

#
#   handle: FH_BINARYDATAFILE
#
#   The file handle used for the data file.
#


#
#   string: currentFile
#
#   The <FileName> for the current configuration file being parsed.
#
my $currentFile;



###############################################################################
# Group: File Functions


#
#   Function: OpenForReading
#
#   Opens a binary file for reading.
#
#   Parameters:
#
#       minimumVersion - The minimum version of the file format that is acceptible.  May be undef.
#
#   Returns:
#
#       The format <VersionInt> or undef if it failed.  It could fail for any of the following reasons.
#
#       - The file doesn't exist.
#       - The file couldn't be opened.
#       - The file didn't have the proper header.
#       - Either the application or the file was from a development release, and they're not the exact same development release.
#       - The file's format was less than the minimum version, if one was defined.
#       - The file was from a later application version than the current.
#
sub OpenForReading #(FileName file, optional VersionInt minimumVersion) => VersionInt
    {
    my ($self, $file, $minimumVersion) = @_;

    if (defined $currentFile)
        {  die "Tried to open binary file " . $file . " for reading when " . $currentFile . " was already open.";  };

    $currentFile = $file;

    if (open(FH_BINARYDATAFILE, '<' . $currentFile))
        {
        # See if it's binary.
        binmode(FH_BINARYDATAFILE);

        my $firstChar;
        read(FH_BINARYDATAFILE, $firstChar, 1);

        if ($firstChar == ::BINARY_FORMAT())
            {
            my $version = NaturalDocs::Version->FromBinaryFile(\*FH_BINARYDATAFILE);

            if (NaturalDocs::Version->CheckFileFormat($version, $minimumVersion))
                {  return $version;  };
            };

        close(FH_BINARYDATAFILE);
        };

    $currentFile = undef;
    return undef;
    };


#
#   Function: OpenForWriting
#
#   Opens a binary file for writing and writes the standard header.  Dies if the file cannot be opened.
#
sub OpenForWriting #(FileName file)
    {
    my ($self, $file) = @_;

    if (defined $currentFile)
        {  die "Tried to open binary file " . $file . " for writing when " . $currentFile . " was already open.";  };

    $currentFile = $file;

    open (FH_BINARYDATAFILE, '>' . $currentFile)
        or die "Couldn't save " . $file . ".\n";

    binmode(FH_BINARYDATAFILE);

    print FH_BINARYDATAFILE '' . ::BINARY_FORMAT();
    NaturalDocs::Version->ToBinaryFile(\*FH_BINARYDATAFILE, NaturalDocs::Settings->AppVersion());
    };


#
#   Function: Close
#
#   Closes the current configuration file.
#
sub Close
    {
    my $self = shift;

    if (!$currentFile)
        {  die "Tried to close a binary file when one wasn't open.";  };

    close(FH_BINARYDATAFILE);
    $currentFile = undef;
    };



###############################################################################
# Group: Reading Functions


#
#   Function: GetUInt8
#   Reads and returns a UInt8 from the open file.
#
sub GetUInt8 # => UInt8
    {
    my $raw;
    read(FH_BINARYDATAFILE, $raw, 1);

    return unpack('C', $raw);
    };

#
#   Function: GetUInt16
#   Reads and returns a UInt16 from the open file.
#
sub GetUInt16 # => UInt16
    {
    my $raw;
    read(FH_BINARYDATAFILE, $raw, 2);

    return unpack('n', $raw);
    };

#
#   Function: GetUInt32
#   Reads and returns a UInt32 from the open file.
#
sub GetUInt32 # => UInt32
    {
    my $raw;
    read(FH_BINARYDATAFILE, $raw, 4);

    return unpack('N', $raw);
    };

#
#   Function: GetAString16
#   Reads and returns an AString16 from the open file.  Supports undef strings.
#
sub GetAString16 # => string
    {
    my $rawLength;
    read(FH_BINARYDATAFILE, $rawLength, 2);
    my $length = unpack('n', $rawLength);

    if (!$length)
        {  return undef;  };

    my $string;
    read(FH_BINARYDATAFILE, $string, $length);

    return $string;
    };



###############################################################################
# Group: Writing Functions


#
#   Function: WriteUInt8
#   Writes a UInt8 to the open file.
#
sub WriteUInt8 #(UInt8 value)
    {
    my ($self, $value) = @_;
    print FH_BINARYDATAFILE pack('C', $value);
    };

#
#   Function: WriteUInt16
#   Writes a UInt32 to the open file.
#
sub WriteUInt16 #(UInt16 value)
    {
    my ($self, $value) = @_;
    print FH_BINARYDATAFILE pack('n', $value);
    };

#
#   Function: WriteUInt32
#   Writes a UInt32 to the open file.
#
sub WriteUInt32 #(UInt32 value)
    {
    my ($self, $value) = @_;
    print FH_BINARYDATAFILE pack('N', $value);
    };

#
#   Function: WriteAString16
#   Writes an AString16 to the open file.  Supports undef strings.
#
sub WriteAString16 #(string value)
    {
    my ($self, $string) = @_;

    if (length($string))
        {  print FH_BINARYDATAFILE pack('nA*', length($string), $string);  }
    else
        {  print FH_BINARYDATAFILE pack('n', 0);  };
    };


1;