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
|
###############################################################################
#
# 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 2003-2010 Greg Valure
# Natural Docs is licensed under version 3 of the GNU Affero General Public License (AGPL)
# Refer to License.txt for the complete details
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;
|