GPL_bin_fullset/NaturalDocs/Modules/NaturalDocs/BinaryFile.pm

   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
  20 use strict;
  21 use integer;
  22
  23 package NaturalDocs::BinaryFile;
  24
  25 use vars qw(@EXPORT @ISA);
  26 require Exporter;
  27 @ISA = qw(Exporter);
  28
  29 @EXPORT = ('BINARY_FORMAT');
  30
  31 use 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 #
  68 use 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 #
  87 my $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 #
 115 sub 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 #
 153 sub 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 #
 177 sub 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 #
 198 sub 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 #
 210 sub 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 #
 222 sub 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 #
 234 sub 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 #
 253 sub 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 #
 279 sub 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 #
 289 sub 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 #
 299 sub 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 #
 309 sub 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 #
 323 sub 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
 337 1;