1 package DBM::Deep::Engine;
8 use Fcntl qw( :DEFAULT :flock :seek );
12 # * All the local($/,$\); are to protect read() and print() from -l.
13 # * To add to bucket_size, make sure you modify the following:
16 # - add_bucket() - where the buckets are printed
19 # Setup file and tag signatures. These should never change.
21 sub SIG_FILE () { 'DPDB' }
22 sub SIG_HEADER () { 'h' }
23 sub SIG_INTERNAL () { 'i' }
24 sub SIG_HASH () { 'H' }
25 sub SIG_ARRAY () { 'A' }
26 sub SIG_NULL () { 'N' }
27 sub SIG_DATA () { 'D' }
28 sub SIG_INDEX () { 'I' }
29 sub SIG_BLIST () { 'B' }
30 sub SIG_FREE () { 'F' }
43 digest => \&Digest::MD5::md5,
47 # Maximum number of buckets per list before another level of indexing is
48 # done. Increase this value for slightly greater speed, but larger database
49 # files. DO NOT decrease this value below 16, due to risk of recursive
58 if ( defined $args->{pack_size} ) {
59 if ( lc $args->{pack_size} eq 'small' ) {
60 $args->{long_size} = 2;
61 $args->{long_pack} = 'n';
63 elsif ( lc $args->{pack_size} eq 'medium' ) {
64 $args->{long_size} = 4;
65 $args->{long_pack} = 'N';
67 elsif ( lc $args->{pack_size} eq 'large' ) {
68 $args->{long_size} = 8;
69 $args->{long_pack} = 'Q';
72 die "Unknown pack_size value: '$args->{pack_size}'\n";
76 # Grab the parameters we want to use
77 foreach my $param ( keys %$self ) {
78 next unless exists $args->{$param};
79 $self->{$param} = $args->{$param};
81 Scalar::Util::weaken( $self->{obj} ) if $self->{obj};
83 if ( $self->{max_buckets} < 16 ) {
84 warn "Floor of max_buckets is 16. Setting it to 16 from '$self->{max_buckets}'\n";
85 $self->{max_buckets} = 16;
91 sub _fileobj { return $_[0]{fileobj} }
92 sub _fh { return $_[0]->_fileobj->{fh} }
97 #XXX Does this need to be updated with different hashing algorithms?
98 $self->{index_size} = (2**8) * $self->{long_size};
99 $self->{bucket_size} = $self->{hash_size} + $self->{long_size} * 3;
100 $self->{bucket_list_size} = $self->{max_buckets} * $self->{bucket_size};
105 sub write_file_header {
112 my $loc = $self->_request_space( length( SIG_FILE ) + 21 );
113 seek($fh, $loc + $self->_fileobj->{file_offset}, SEEK_SET);
117 pack('N', 1), # header version
118 pack('N', 12), # header size
119 pack('N', 0), # currently running transaction IDs
120 pack('n', $self->{long_size}),
121 pack('A', $self->{long_pack}),
122 pack('n', $self->{data_size}),
123 pack('A', $self->{data_pack}),
124 pack('n', $self->{max_buckets}),
127 $self->_fileobj->set_transaction_offset( 13 );
132 sub read_file_header {
139 seek($fh, 0 + $self->_fileobj->{file_offset}, SEEK_SET);
141 my $bytes_read = read( $fh, $buffer, length(SIG_FILE) + 9 );
143 return unless $bytes_read;
145 my ($file_signature, $sig_header, $header_version, $size) = unpack(
149 unless ( $file_signature eq SIG_FILE ) {
150 $self->_fileobj->close;
151 $self->_throw_error( "Signature not found -- file is not a Deep DB" );
154 unless ( $sig_header eq SIG_HEADER ) {
155 $self->_fileobj->close;
156 $self->_throw_error( "Old file version found." );
160 $bytes_read += read( $fh, $buffer2, $size );
161 my ($running_transactions, @values) = unpack( 'N n A n A n', $buffer2 );
163 $self->_fileobj->set_transaction_offset( 13 );
165 if ( @values < 5 || grep { !defined } @values ) {
166 $self->_fileobj->close;
167 $self->_throw_error("Corrupted file - bad header");
170 #XXX Add warnings if values weren't set right
171 @{$self}{qw(long_size long_pack data_size data_pack max_buckets)} = @values;
185 #XXX The duplication of calculate_sizes needs to go away
186 unless ( $obj->{base_offset} ) {
187 my $bytes_read = $self->read_file_header;
189 $self->calculate_sizes;
192 # File is empty -- write header and master index
195 $self->_fileobj->audit( "# Database created on" );
197 $self->write_file_header;
199 $obj->{base_offset} = $self->_request_space( $self->tag_size( $self->{index_size} ) );
202 $obj->_base_offset, $obj->_type,
203 chr(0)x$self->{index_size},
206 # Flush the filehandle
207 my $old_fh = select $fh;
208 my $old_af = $|; $| = 1; $| = $old_af;
212 $obj->{base_offset} = $bytes_read;
215 # Get our type from master index header
217 my $tag = $self->load_tag($obj->_base_offset);
220 $self->_throw_error("Corrupted file, no master index record");
223 unless ($obj->_type eq $tag->{signature}) {
225 $self->_throw_error("File type mismatch");
230 $self->calculate_sizes;
233 #XXX We have to make sure we don't mess up when autoflush isn't turned on
234 unless ( $self->_fileobj->{inode} ) {
235 my @stats = stat($fh);
236 $self->_fileobj->{inode} = $stats[1];
237 $self->_fileobj->{end} = $stats[7];
248 return SIG_SIZE + $self->{data_size} + $size;
253 # Given offset, signature and content, create tag and write to disk
256 my ($offset, $sig, $content) = @_;
257 my $size = length( $content );
263 if ( defined $offset ) {
264 seek($fh, $offset + $self->_fileobj->{file_offset}, SEEK_SET);
267 print( $fh $sig . pack($self->{data_pack}, $size) . $content );
269 return unless defined $offset;
274 offset => $offset + SIG_SIZE + $self->{data_size},
281 # Given offset, load single tag and return signature, size and data
288 # print join(':',map{$_||''}caller(1)), $/;
292 seek($fh, $offset + $self->_fileobj->{file_offset}, SEEK_SET);
294 #XXX I'm not sure this check will work if autoflush isn't enabled ...
298 read( $fh, $b, SIG_SIZE + $self->{data_size} );
299 my ($sig, $size) = unpack( "A $self->{data_pack}", $b );
302 read( $fh, $buffer, $size);
307 offset => $offset + SIG_SIZE + $self->{data_size},
312 sub _get_dbm_object {
317 if ($item->isa( 'DBM::Deep' )) {
324 my $r = Scalar::Util::reftype( $item ) || '';
325 if ( $r eq 'HASH' ) {
328 my $obj = tied(%$item);
329 if ($obj->isa( 'DBM::Deep' )) {
336 elsif ( $r eq 'ARRAY' ) {
339 my $obj = tied(@$item);
340 if ($obj->isa( 'DBM::Deep' )) {
353 my ($value, $key) = @_;
355 my $is_dbm_deep = eval {
356 local $SIG{'__DIE__'};
357 $value->isa( 'DBM::Deep' );
360 my $len = SIG_SIZE + $self->{data_size}
361 + $self->{data_size} + length( $key );
363 if ( $is_dbm_deep && $value->_fileobj eq $self->_fileobj ) {
364 return $len + $self->{long_size};
367 my $r = Scalar::Util::reftype( $value ) || '';
368 if ( $self->_fileobj->{autobless} ) {
369 # This is for the bit saying whether or not this thing is blessed.
373 unless ( $r eq 'HASH' || $r eq 'ARRAY' ) {
374 if ( defined $value ) {
375 $len += length( $value );
380 $len += $self->{index_size};
382 # if autobless is enabled, must also take into consideration
383 # the class name as it is stored after the key.
384 if ( $self->_fileobj->{autobless} ) {
385 my $c = Scalar::Util::blessed($value);
386 if ( defined $c && !$is_dbm_deep ) {
387 $len += $self->{data_size} + length($c);
396 # Adds one key/value pair to bucket list, given offset, MD5 digest of key,
397 # plain (undigested) key and value.
400 my ($tag, $md5, $plain_key, $value, $deleted, $orig_key) = @_;
405 # This verifies that only supported values will be stored.
407 my $r = Scalar::Util::reftype( $value );
410 last if $r eq 'HASH';
411 last if $r eq 'ARRAY';
414 "Storage of variables of type '$r' is not supported."
421 my $root = $self->_fileobj;
424 my $actual_length = $self->_length_needed( $value, $plain_key );
426 #ACID - This is a mutation. Must only find the exact transaction
427 my ($subloc, $offset, $size,$is_deleted) = $self->_find_in_buckets( $tag, $md5, 1 );
430 if ( $self->_fileobj->transaction_id == 0 ) {
431 @transactions = $self->_fileobj->current_transactions;
434 # $self->_release_space( $size, $subloc );
435 # Updating a known md5
436 #XXX This needs updating to use _release_space
440 if ($actual_length <= $size) {
444 $location = $self->_request_space( $actual_length );
447 $tag->{offset} + $offset
448 + $self->{hash_size} + $root->{file_offset},
451 print( $fh pack($self->{long_pack}, $location ) );
452 print( $fh pack($self->{long_pack}, $actual_length ) );
453 print( $fh pack('n n', $root->transaction_id, $deleted ) );
457 elsif ( defined $offset ) {
458 $location = $self->_request_space( $actual_length );
460 seek( $fh, $tag->{offset} + $offset + $root->{file_offset}, SEEK_SET );
461 print( $fh $md5 . pack($self->{long_pack}, $location ) );
462 print( $fh pack($self->{long_pack}, $actual_length ) );
463 print( $fh pack('n n', $root->transaction_id, $deleted ) );
465 for ( @transactions ) {
466 my $tag2 = $self->load_tag( $tag->{offset} - SIG_SIZE - $self->{data_size} );
467 $self->_fileobj->{transaction_id} = $_;
468 $self->add_bucket( $tag2, $md5, '', '', 1, $orig_key );
469 $self->_fileobj->{transaction_id} = 0;
472 # If bucket didn't fit into list, split into a new index level
473 # split_index() will do the _request_space() call
475 $location = $self->split_index( $md5, $tag );
478 $self->write_value( $location, $plain_key, $value, $orig_key );
485 my ($location, $key, $value, $orig_key) = @_;
490 my $root = $self->_fileobj;
492 my $dbm_deep_obj = _get_dbm_object( $value );
493 if ( $dbm_deep_obj && $dbm_deep_obj->_fileobj ne $self->_fileobj ) {
494 $self->_throw_error( "Cannot cross-reference. Use export() instead" );
497 seek($fh, $location + $root->{file_offset}, SEEK_SET);
500 # Write signature based on content type, set content length and write
503 my $r = Scalar::Util::reftype( $value ) || '';
504 if ( $dbm_deep_obj ) {
505 $self->write_tag( undef, SIG_INTERNAL,pack($self->{long_pack}, $dbm_deep_obj->_base_offset) );
507 elsif ($r eq 'HASH') {
508 if ( !$dbm_deep_obj && tied %{$value} ) {
509 $self->_throw_error( "Cannot store something that is tied" );
511 $self->write_tag( undef, SIG_HASH, chr(0)x$self->{index_size} );
513 elsif ($r eq 'ARRAY') {
514 if ( !$dbm_deep_obj && tied @{$value} ) {
515 $self->_throw_error( "Cannot store something that is tied" );
517 $self->write_tag( undef, SIG_ARRAY, chr(0)x$self->{index_size} );
519 elsif (!defined($value)) {
520 $self->write_tag( undef, SIG_NULL, '' );
523 $self->write_tag( undef, SIG_DATA, $value );
527 # Plain key is stored AFTER value, as keys are typically fetched less often.
529 print( $fh pack($self->{data_pack}, length($key)) . $key );
531 # Internal references don't care about autobless
532 return 1 if $dbm_deep_obj;
535 # If value is blessed, preserve class name
537 if ( $root->{autobless} ) {
538 my $c = Scalar::Util::blessed($value);
539 if ( defined $c && !$dbm_deep_obj ) {
541 print( $fh pack($self->{data_pack}, length($c)) . $c );
549 # Tie the passed in reference so that changes to it are reflected in the
550 # datafile. The use of $location as the base_offset will act as the
551 # the linkage between parent and child.
553 # The overall assignment is a hack around the fact that just tying doesn't
554 # store the values. This may not be the wrong thing to do.
558 tie %$value, 'DBM::Deep', {
559 base_offset => $location,
561 parent => $self->{obj},
562 parent_key => $orig_key,
566 elsif ($r eq 'ARRAY') {
568 tie @$value, 'DBM::Deep', {
569 base_offset => $location,
571 parent => $self->{obj},
572 parent_key => $orig_key,
582 my ($md5, $tag) = @_;
587 my $root = $self->_fileobj;
589 my $loc = $self->_request_space(
590 $self->tag_size( $self->{index_size} ),
593 seek($fh, $tag->{ref_loc} + $root->{file_offset}, SEEK_SET);
594 print( $fh pack($self->{long_pack}, $loc) );
596 my $index_tag = $self->write_tag(
598 chr(0)x$self->{index_size},
601 my $newtag_loc = $self->_request_space(
602 $self->tag_size( $self->{bucket_list_size} ),
605 my $keys = $tag->{content}
606 . $md5 . pack($self->{long_pack}, $newtag_loc)
607 . pack($self->{long_pack}, 0) # size
608 . pack($self->{long_pack}, 0); # transaction ID
612 for (my $i = 0; $i <= $self->{max_buckets}; $i++) {
613 my ($key, $old_subloc, $size) = $self->_get_key_subloc( $keys, $i );
615 die "[INTERNAL ERROR]: No key in split_index()\n" unless $key;
616 die "[INTERNAL ERROR]: No subloc in split_index()\n" unless $old_subloc;
618 my $num = ord(substr($key, $tag->{ch} + 1, 1));
621 seek($fh, $newloc[$num] + $root->{file_offset}, SEEK_SET);
623 read( $fh, $subkeys, $self->{bucket_list_size});
625 # This is looking for the first empty spot
626 my ($subloc, $offset, $size) = $self->_find_in_buckets(
627 { content => $subkeys }, '',
630 seek($fh, $newloc[$num] + $offset + $root->{file_offset}, SEEK_SET);
631 print( $fh $key . pack($self->{long_pack}, $old_subloc) );
636 seek($fh, $index_tag->{offset} + ($num * $self->{long_size}) + $root->{file_offset}, SEEK_SET);
638 my $loc = $self->_request_space(
639 $self->tag_size( $self->{bucket_list_size} ),
642 print( $fh pack($self->{long_pack}, $loc) );
644 my $blist_tag = $self->write_tag(
646 chr(0)x$self->{bucket_list_size},
649 seek($fh, $blist_tag->{offset} + $root->{file_offset}, SEEK_SET);
650 print( $fh $key . pack($self->{long_pack}, $old_subloc) );
652 $newloc[$num] = $blist_tag->{offset};
655 $self->_release_space(
656 $self->tag_size( $self->{bucket_list_size} ),
657 $tag->{offset} - SIG_SIZE - $self->{data_size},
665 my ($subloc, $orig_key) = @_;
672 # Found match -- seek to offset and read signature
675 seek($fh, $subloc + $self->_fileobj->{file_offset}, SEEK_SET);
676 read( $fh, $signature, SIG_SIZE);
679 # If value is a hash or array, return new DBM::Deep object with correct offset
681 if (($signature eq SIG_HASH) || ($signature eq SIG_ARRAY)) {
682 my $new_obj = DBM::Deep->new({
684 base_offset => $subloc,
685 fileobj => $self->_fileobj,
686 parent => $self->{obj},
687 parent_key => $orig_key,
690 if ($new_obj->_fileobj->{autobless}) {
692 # Skip over value and plain key to see if object needs
695 seek($fh, $self->{data_size} + $self->{index_size}, SEEK_CUR);
698 read( $fh, $size, $self->{data_size});
699 $size = unpack($self->{data_pack}, $size);
700 if ($size) { seek($fh, $size, SEEK_CUR); }
703 read( $fh, $bless_bit, 1);
704 if (ord($bless_bit)) {
706 # Yes, object needs to be re-blessed
709 read( $fh, $size, $self->{data_size});
710 $size = unpack($self->{data_pack}, $size);
711 if ($size) { read( $fh, $class_name, $size); }
712 if ($class_name) { $new_obj = bless( $new_obj, $class_name ); }
718 elsif ( $signature eq SIG_INTERNAL ) {
720 read( $fh, $size, $self->{data_size});
721 $size = unpack($self->{data_pack}, $size);
725 read( $fh, $new_loc, $size );
726 $new_loc = unpack( $self->{long_pack}, $new_loc );
728 return $self->read_from_loc( $new_loc, $orig_key );
735 # Otherwise return actual value
737 elsif ( $signature eq SIG_DATA ) {
739 read( $fh, $size, $self->{data_size});
740 $size = unpack($self->{data_pack}, $size);
743 if ($size) { read( $fh, $value, $size); }
748 # Key exists, but content is null
753 sub get_bucket_value {
755 # Fetch single value given tag and MD5 digested key.
758 my ($tag, $md5, $orig_key) = @_;
760 #ACID - This is a read. Can find exact or HEAD
761 my ($subloc, $offset, $size,$is_deleted) = $self->_find_in_buckets( $tag, $md5 );
762 if ( $subloc && !$is_deleted ) {
763 return $self->read_from_loc( $subloc, $orig_key );
770 # Delete single key/value pair given tag and MD5 digested key.
773 my ($tag, $md5, $orig_key) = @_;
777 #ACID - This is a mutation. Must only find the exact transaction
778 my ($subloc, $offset, $size) = $self->_find_in_buckets( $tag, $md5, 1 );
779 #XXX This needs _release_space()
782 seek($fh, $tag->{offset} + $offset + $self->_fileobj->{file_offset}, SEEK_SET);
783 print( $fh substr($tag->{content}, $offset + $self->{bucket_size} ) );
784 print( $fh chr(0) x $self->{bucket_size} );
793 # Check existence of single key given tag and MD5 digested key.
796 my ($tag, $md5) = @_;
798 #ACID - This is a read. Can find exact or HEAD
799 my ($subloc, $offset, $size, $is_deleted) = $self->_find_in_buckets( $tag, $md5 );
800 return ($subloc && !$is_deleted) && 1;
803 sub find_bucket_list {
805 # Locate offset for bucket list, given digested key
808 my ($offset, $md5, $args) = @_;
809 $args = {} unless $args;
814 # Locate offset for bucket list using digest index system
816 my $tag = $self->load_tag( $offset )
817 or $self->_throw_error( "INTERNAL ERROR - Cannot find tag" );
820 while ($tag->{signature} ne SIG_BLIST) {
821 my $num = ord substr($md5, $ch, 1);
823 my $ref_loc = $tag->{offset} + ($num * $self->{long_size});
824 $tag = $self->index_lookup( $tag, $num );
827 return if !$args->{create};
829 my $loc = $self->_request_space(
830 $self->tag_size( $self->{bucket_list_size} ),
834 seek($fh, $ref_loc + $self->_fileobj->{file_offset}, SEEK_SET);
835 print( $fh pack($self->{long_pack}, $loc) );
837 $tag = $self->write_tag(
839 chr(0)x$self->{bucket_list_size},
842 $tag->{ref_loc} = $ref_loc;
849 $tag->{ref_loc} = $ref_loc;
857 # Given index tag, lookup single entry in index and return .
860 my ($tag, $index) = @_;
862 my $location = unpack(
866 $index * $self->{long_size},
871 if (!$location) { return; }
873 return $self->load_tag( $location );
878 # Scan index and recursively step into deeper levels, looking for next key.
881 my ($obj, $offset, $ch, $force_return_next) = @_;
885 my $tag = $self->load_tag( $offset );
889 if ($tag->{signature} ne SIG_BLIST) {
890 my $content = $tag->{content};
891 my $start = $obj->{return_next} ? 0 : ord(substr($obj->{prev_md5}, $ch, 1));
893 for (my $idx = $start; $idx < (2**8); $idx++) {
898 $idx * $self->{long_size},
904 my $result = $self->traverse_index(
905 $obj, $subloc, $ch + 1, $force_return_next,
908 if (defined($result)) { return $result; }
912 $obj->{return_next} = 1;
916 my $keys = $tag->{content};
917 if ($force_return_next) { $obj->{return_next} = 1; }
920 # Iterate through buckets, looking for a key match
922 for (my $i = 0; $i < $self->{max_buckets}; $i++) {
923 my ($key, $subloc) = $self->_get_key_subloc( $keys, $i );
925 # End of bucket list -- return to outer loop
927 $obj->{return_next} = 1;
930 # Located previous key -- return next one found
931 elsif ($key eq $obj->{prev_md5}) {
932 $obj->{return_next} = 1;
935 # Seek to bucket location and skip over signature
936 elsif ($obj->{return_next}) {
937 seek($fh, $subloc + $self->_fileobj->{file_offset}, SEEK_SET);
939 # Skip over value to get to plain key
941 read( $fh, $sig, SIG_SIZE );
944 read( $fh, $size, $self->{data_size});
945 $size = unpack($self->{data_pack}, $size);
946 if ($size) { seek($fh, $size, SEEK_CUR); }
948 # Read in plain key and return as scalar
950 read( $fh, $size, $self->{data_size});
951 $size = unpack($self->{data_pack}, $size);
952 if ($size) { read( $fh, $plain_key, $size); }
958 $obj->{return_next} = 1;
959 } # tag is a bucket list
966 # Locate next key, given digested previous one
971 $obj->{prev_md5} = $_[1] ? $_[1] : undef;
972 $obj->{return_next} = 0;
975 # If the previous key was not specifed, start at the top and
976 # return the first one found.
978 if (!$obj->{prev_md5}) {
979 $obj->{prev_md5} = chr(0) x $self->{hash_size};
980 $obj->{return_next} = 1;
983 return $self->traverse_index( $obj, $obj->_base_offset, 0 );
988 sub _get_key_subloc {
990 my ($keys, $idx) = @_;
992 my ($key, $subloc, $size, $transaction_id, $is_deleted) = unpack(
993 # This is 'a', not 'A'. Please read the pack() documentation for the
994 # difference between the two and why it's important.
995 "a$self->{hash_size} $self->{long_pack}2 n2",
998 ($idx * $self->{bucket_size}),
999 $self->{bucket_size},
1003 return ($key, $subloc, $size, $transaction_id, $is_deleted);
1006 sub _find_in_buckets {
1008 my ($tag, $md5, $exact) = @_;
1010 my $trans_id = $self->_fileobj->transaction_id;
1015 for ( my $i = 0; $i < $self->{max_buckets}; $i++ ) {
1016 my ($key, $subloc, $size, $transaction_id, $is_deleted) = $self->_get_key_subloc(
1017 $tag->{content}, $i,
1020 my @rv = ($subloc, $i * $self->{bucket_size}, $size, $is_deleted);
1022 unless ( $subloc ) {
1023 if ( !$exact && @zero and $trans_id ) {
1024 @rv = ($zero[2], $zero[0] * $self->{bucket_size},$zero[3],$is_deleted);
1029 next BUCKET if $key ne $md5;
1031 # Save off the HEAD in case we need it.
1032 @zero = ($i,$key,$subloc,$size,$transaction_id,$is_deleted) if $transaction_id == 0;
1034 next BUCKET if $transaction_id != $trans_id;
1042 sub _request_space {
1046 my $loc = $self->_fileobj->{end};
1047 $self->_fileobj->{end} += $size;
1052 sub _release_space {
1054 my ($size, $loc) = @_;
1060 my $fh = $self->_fh;
1061 seek( $fh, $loc + $self->_fileobj->{file_offset}, SEEK_SET );
1063 . pack($self->{long_pack}, $size )
1064 . pack($self->{long_pack}, $next_loc )
1071 die "DBM::Deep: $_[1]\n";
1077 # This will be added in later, after more refactoring is done. This is an early
1078 # attempt at refactoring on the physical level instead of the virtual level.
1081 my ($spot, $amount, $unpack) = @_;
1085 my $fh = $self->_fh;
1086 seek( $fh, $spot + $self->_fileobj->{file_offset}, SEEK_SET );
1089 my $bytes_read = read( $fh, $buffer, $amount );
1092 $buffer = unpack( $unpack, $buffer );
1096 return ($buffer, $bytes_read);
1105 my ($spot, $data) = @_;
1109 my $fh = $self->_fh;
1110 seek( $fh, $spot, SEEK_SET );
1116 sub get_file_version {
1121 my $fh = $self->_fh;
1123 seek( $fh, 13 + $self->_fileobj->{file_offset}, SEEK_SET );
1125 my $bytes_read = read( $fh, $buffer, 4 );
1126 unless ( $bytes_read == 4 ) {
1127 $self->_throw_error( "Cannot read file version" );
1130 return unpack( 'N', $buffer );
1133 sub write_file_version {
1135 my ($new_version) = @_;
1139 my $fh = $self->_fh;
1141 seek( $fh, 13 + $self->_fileobj->{file_offset}, SEEK_SET );
1142 print( $fh pack( 'N', $new_version ) );