Converted STORE to use find_bucket_list by adding an optional create option
[dbsrgits/DBM-Deep.git] / lib / DBM / Deep.pm
CommitLineData
ffed8b01 1package DBM::Deep;
2
3##
4# DBM::Deep
5#
6# Description:
d0b74c17 7# Multi-level database module for storing hash trees, arrays and simple
8# key/value pairs into FTP-able, cross-platform binary database files.
ffed8b01 9#
d0b74c17 10# Type `perldoc DBM::Deep` for complete documentation.
ffed8b01 11#
12# Usage Examples:
d0b74c17 13# my %db;
14# tie %db, 'DBM::Deep', 'my_database.db'; # standard tie() method
ffed8b01 15#
d0b74c17 16# my $db = new DBM::Deep( 'my_database.db' ); # preferred OO method
17#
18# $db->{my_scalar} = 'hello world';
19# $db->{my_hash} = { larry => 'genius', hashes => 'fast' };
20# $db->{my_array} = [ 1, 2, 3, time() ];
21# $db->{my_complex} = [ 'hello', { perl => 'rules' }, 42, 99 ];
22# push @{$db->{my_array}}, 'another value';
23# my @key_list = keys %{$db->{my_hash}};
24# print "This module " . $db->{my_complex}->[1]->{perl} . "!\n";
ffed8b01 25#
26# Copyright:
d0b74c17 27# (c) 2002-2006 Joseph Huckaby. All Rights Reserved.
28# This program is free software; you can redistribute it and/or
29# modify it under the same terms as Perl itself.
ffed8b01 30##
31
32use strict;
8b957036 33
596e9574 34use Fcntl qw( :DEFAULT :flock :seek );
ffed8b01 35use Digest::MD5 ();
36use Scalar::Util ();
ffed8b01 37
95967a5e 38use DBM::Deep::Engine;
39
596e9574 40use vars qw( $VERSION );
3a7a0dce 41$VERSION = q(0.99_01);
ffed8b01 42
ffed8b01 43
44##
45# Setup file and tag signatures. These should never change.
46##
81d3d316 47sub SIG_FILE () { 'DPDB' }
48sub SIG_HASH () { 'H' }
49sub SIG_ARRAY () { 'A' }
50sub SIG_SCALAR () { 'S' }
51sub SIG_NULL () { 'N' }
52sub SIG_DATA () { 'D' }
53sub SIG_INDEX () { 'I' }
54sub SIG_BLIST () { 'B' }
55sub SIG_SIZE () { 1 }
ffed8b01 56
57##
58# Setup constants for users to pass to new()
59##
4d35d856 60sub TYPE_HASH () { SIG_HASH }
61sub TYPE_ARRAY () { SIG_ARRAY }
62sub TYPE_SCALAR () { SIG_SCALAR }
ffed8b01 63
0ca7ea98 64sub _get_args {
65 my $proto = shift;
66
67 my $args;
68 if (scalar(@_) > 1) {
69 if ( @_ % 2 ) {
70 $proto->_throw_error( "Odd number of parameters to " . (caller(1))[2] );
71 }
72 $args = {@_};
73 }
d0b74c17 74 elsif ( ref $_[0] ) {
4d35d856 75 unless ( eval { local $SIG{'__DIE__'}; %{$_[0]} || 1 } ) {
0ca7ea98 76 $proto->_throw_error( "Not a hashref in args to " . (caller(1))[2] );
77 }
78 $args = $_[0];
79 }
d0b74c17 80 else {
0ca7ea98 81 $args = { file => shift };
82 }
83
84 return $args;
85}
86
ffed8b01 87sub new {
d0b74c17 88 ##
89 # Class constructor method for Perl OO interface.
90 # Calls tie() and returns blessed reference to tied hash or array,
91 # providing a hybrid OO/tie interface.
92 ##
93 my $class = shift;
94 my $args = $class->_get_args( @_ );
95
96 ##
97 # Check if we want a tied hash or array.
98 ##
99 my $self;
100 if (defined($args->{type}) && $args->{type} eq TYPE_ARRAY) {
6fe26b29 101 $class = 'DBM::Deep::Array';
102 require DBM::Deep::Array;
d0b74c17 103 tie @$self, $class, %$args;
104 }
105 else {
6fe26b29 106 $class = 'DBM::Deep::Hash';
107 require DBM::Deep::Hash;
d0b74c17 108 tie %$self, $class, %$args;
109 }
ffed8b01 110
d0b74c17 111 return bless $self, $class;
ffed8b01 112}
113
0795f290 114sub _init {
115 ##
116 # Setup $self and bless into this class.
117 ##
118 my $class = shift;
119 my $args = shift;
120
121 # These are the defaults to be optionally overridden below
122 my $self = bless {
95967a5e 123 type => TYPE_HASH,
0795f290 124 base_offset => length(SIG_FILE),
612969fb 125 engine => DBM::Deep::Engine->new,
0795f290 126 }, $class;
127
128 foreach my $param ( keys %$self ) {
129 next unless exists $args->{$param};
130 $self->{$param} = delete $args->{$param}
ffed8b01 131 }
d0b74c17 132
37c5bcf0 133 # locking implicitly enables autoflush
134 if ($args->{locking}) { $args->{autoflush} = 1; }
d0b74c17 135
0795f290 136 $self->{root} = exists $args->{root}
137 ? $args->{root}
138 : DBM::Deep::_::Root->new( $args );
139
70b55428 140 $self->{engine}->setup_fh( $self );
0795f290 141
142 return $self;
ffed8b01 143}
144
ffed8b01 145sub TIEHASH {
6fe26b29 146 shift;
147 require DBM::Deep::Hash;
148 return DBM::Deep::Hash->TIEHASH( @_ );
ffed8b01 149}
150
151sub TIEARRAY {
6fe26b29 152 shift;
153 require DBM::Deep::Array;
154 return DBM::Deep::Array->TIEARRAY( @_ );
ffed8b01 155}
156
cc4bef86 157#XXX Unneeded now ...
158#sub DESTROY {
159#}
ffed8b01 160
ffed8b01 161sub lock {
d0b74c17 162 ##
163 # If db locking is set, flock() the db file. If called multiple
164 # times before unlock(), then the same number of unlocks() must
165 # be called before the lock is released.
166 ##
2ac02042 167 my $self = $_[0]->_get_self;
d0b74c17 168 my $type = $_[1];
ffed8b01 169 $type = LOCK_EX unless defined $type;
d0b74c17 170
171 if (!defined($self->_fh)) { return; }
172
173 if ($self->_root->{locking}) {
174 if (!$self->_root->{locked}) {
175 flock($self->_fh, $type);
176
177 # refresh end counter in case file has changed size
178 my @stats = stat($self->_root->{file});
179 $self->_root->{end} = $stats[7];
180
181 # double-check file inode, in case another process
182 # has optimize()d our file while we were waiting.
183 if ($stats[1] != $self->_root->{inode}) {
3d1b8be9 184 $self->{engine}->close_fh( $self );
70b55428 185 $self->{engine}->setup_fh( $self );
d0b74c17 186 flock($self->_fh, $type); # re-lock
70b55428 187
188 # This may not be necessary after re-opening
d0b74c17 189 $self->_root->{end} = (stat($self->_fh))[7]; # re-end
190 }
191 }
192 $self->_root->{locked}++;
b4522594 193
194 return 1;
d0b74c17 195 }
b4522594 196
197 return;
ffed8b01 198}
199
200sub unlock {
d0b74c17 201 ##
202 # If db locking is set, unlock the db file. See note in lock()
203 # regarding calling lock() multiple times.
204 ##
2ac02042 205 my $self = $_[0]->_get_self;
7f441181 206
d0b74c17 207 if (!defined($self->_fh)) { return; }
208
209 if ($self->_root->{locking} && $self->_root->{locked} > 0) {
210 $self->_root->{locked}--;
211 if (!$self->_root->{locked}) { flock($self->_fh, LOCK_UN); }
b4522594 212
213 return 1;
d0b74c17 214 }
b4522594 215
216 return;
ffed8b01 217}
218
906c8e01 219sub _copy_value {
220 my $self = shift->_get_self;
221 my ($spot, $value) = @_;
222
223 if ( !ref $value ) {
224 ${$spot} = $value;
225 }
226 elsif ( eval { local $SIG{__DIE__}; $value->isa( 'DBM::Deep' ) } ) {
227 my $type = $value->_type;
228 ${$spot} = $type eq TYPE_HASH ? {} : [];
229 $value->_copy_node( ${$spot} );
230 }
231 else {
232 my $r = Scalar::Util::reftype( $value );
233 my $c = Scalar::Util::blessed( $value );
234 if ( $r eq 'ARRAY' ) {
235 ${$spot} = [ @{$value} ];
236 }
237 else {
238 ${$spot} = { %{$value} };
239 }
95bbd935 240 ${$spot} = bless ${$spot}, $c
906c8e01 241 if defined $c;
242 }
243
244 return 1;
245}
246
261d1296 247sub _copy_node {
d0b74c17 248 ##
249 # Copy single level of keys or elements to new DB handle.
250 # Recurse for nested structures
251 ##
906c8e01 252 my $self = shift->_get_self;
d0b74c17 253 my ($db_temp) = @_;
b8b48a59 254
d0b74c17 255 if ($self->_type eq TYPE_HASH) {
256 my $key = $self->first_key();
257 while ($key) {
258 my $value = $self->get($key);
906c8e01 259 $self->_copy_value( \$db_temp->{$key}, $value );
d0b74c17 260 $key = $self->next_key($key);
261 }
262 }
263 else {
264 my $length = $self->length();
265 for (my $index = 0; $index < $length; $index++) {
266 my $value = $self->get($index);
906c8e01 267 $self->_copy_value( \$db_temp->[$index], $value );
d0b74c17 268 }
269 }
906c8e01 270
271 return 1;
ffed8b01 272}
273
274sub export {
d0b74c17 275 ##
276 # Recursively export into standard Perl hashes and arrays.
277 ##
2ac02042 278 my $self = $_[0]->_get_self;
d0b74c17 279
280 my $temp;
281 if ($self->_type eq TYPE_HASH) { $temp = {}; }
282 elsif ($self->_type eq TYPE_ARRAY) { $temp = []; }
283
284 $self->lock();
285 $self->_copy_node( $temp );
286 $self->unlock();
287
288 return $temp;
ffed8b01 289}
290
291sub import {
d0b74c17 292 ##
293 # Recursively import Perl hash/array structure
294 ##
ffed8b01 295 #XXX This use of ref() seems to be ok
d0b74c17 296 if (!ref($_[0])) { return; } # Perl calls import() on use -- ignore
297
2ac02042 298 my $self = $_[0]->_get_self;
d0b74c17 299 my $struct = $_[1];
300
ffed8b01 301 #XXX This use of ref() seems to be ok
d0b74c17 302 if (!ref($struct)) {
303 ##
304 # struct is not a reference, so just import based on our type
305 ##
306 shift @_;
307
308 if ($self->_type eq TYPE_HASH) { $struct = {@_}; }
309 elsif ($self->_type eq TYPE_ARRAY) { $struct = [@_]; }
310 }
311
ffed8b01 312 my $r = Scalar::Util::reftype($struct) || '';
d0b74c17 313 if ($r eq "HASH" && $self->_type eq TYPE_HASH) {
314 foreach my $key (keys %$struct) { $self->put($key, $struct->{$key}); }
315 }
316 elsif ($r eq "ARRAY" && $self->_type eq TYPE_ARRAY) {
317 $self->push( @$struct );
318 }
319 else {
320 return $self->_throw_error("Cannot import: type mismatch");
321 }
322
323 return 1;
ffed8b01 324}
325
326sub optimize {
d0b74c17 327 ##
328 # Rebuild entire database into new file, then move
329 # it back on top of original.
330 ##
2ac02042 331 my $self = $_[0]->_get_self;
cc4bef86 332
333#XXX Need to create a new test for this
d0b74c17 334# if ($self->_root->{links} > 1) {
335# return $self->_throw_error("Cannot optimize: reference count is greater than 1");
336# }
337
338 my $db_temp = DBM::Deep->new(
339 file => $self->_root->{file} . '.tmp',
340 type => $self->_type
341 );
342 if (!$db_temp) {
343 return $self->_throw_error("Cannot optimize: failed to open temp file: $!");
344 }
345
346 $self->lock();
347 $self->_copy_node( $db_temp );
348 undef $db_temp;
349
350 ##
351 # Attempt to copy user, group and permissions over to new file
352 ##
353 my @stats = stat($self->_fh);
354 my $perms = $stats[2] & 07777;
355 my $uid = $stats[4];
356 my $gid = $stats[5];
357 chown( $uid, $gid, $self->_root->{file} . '.tmp' );
358 chmod( $perms, $self->_root->{file} . '.tmp' );
359
ffed8b01 360 # q.v. perlport for more information on this variable
90f93b43 361 if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) {
d0b74c17 362 ##
363 # Potential race condition when optmizing on Win32 with locking.
364 # The Windows filesystem requires that the filehandle be closed
365 # before it is overwritten with rename(). This could be redone
366 # with a soft copy.
367 ##
368 $self->unlock();
369 $self->{engine}->close_fh( $self );
370 }
371
372 if (!rename $self->_root->{file} . '.tmp', $self->_root->{file}) {
373 unlink $self->_root->{file} . '.tmp';
374 $self->unlock();
375 return $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!");
376 }
377
378 $self->unlock();
379 $self->{engine}->close_fh( $self );
70b55428 380 $self->{engine}->setup_fh( $self );
381
d0b74c17 382 return 1;
ffed8b01 383}
384
385sub clone {
d0b74c17 386 ##
387 # Make copy of object and return
388 ##
2ac02042 389 my $self = $_[0]->_get_self;
d0b74c17 390
391 return DBM::Deep->new(
392 type => $self->_type,
393 base_offset => $self->_base_offset,
394 root => $self->_root
395 );
ffed8b01 396}
397
398{
399 my %is_legal_filter = map {
400 $_ => ~~1,
401 } qw(
402 store_key store_value
403 fetch_key fetch_value
404 );
405
406 sub set_filter {
407 ##
408 # Setup filter function for storing or fetching the key or value
409 ##
2ac02042 410 my $self = $_[0]->_get_self;
ffed8b01 411 my $type = lc $_[1];
412 my $func = $_[2] ? $_[2] : undef;
d0b74c17 413
ffed8b01 414 if ( $is_legal_filter{$type} ) {
4d35d856 415 $self->_root->{"filter_$type"} = $func;
ffed8b01 416 return 1;
417 }
418
419 return;
420 }
421}
422
423##
424# Accessor methods
425##
426
4d35d856 427sub _root {
d0b74c17 428 ##
429 # Get access to the root structure
430 ##
2ac02042 431 my $self = $_[0]->_get_self;
d0b74c17 432 return $self->{root};
ffed8b01 433}
434
4d35d856 435sub _fh {
d0b74c17 436 ##
437 # Get access to the raw fh
438 ##
b8b48a59 439 #XXX It will be useful, though, when we split out HASH and ARRAY
2ac02042 440 my $self = $_[0]->_get_self;
d0b74c17 441 return $self->_root->{fh};
ffed8b01 442}
443
4d35d856 444sub _type {
d0b74c17 445 ##
446 # Get type of current node (TYPE_HASH or TYPE_ARRAY)
447 ##
2ac02042 448 my $self = $_[0]->_get_self;
d0b74c17 449 return $self->{type};
ffed8b01 450}
451
4d35d856 452sub _base_offset {
d0b74c17 453 ##
454 # Get base_offset of current node (TYPE_HASH or TYPE_ARRAY)
455 ##
2ac02042 456 my $self = $_[0]->_get_self;
d0b74c17 457 return $self->{base_offset};
ffed8b01 458}
459
ffed8b01 460##
461# Utility methods
462##
463
261d1296 464sub _throw_error {
95967a5e 465 die "DBM::Deep: $_[1]\n";
ffed8b01 466}
467
acd4faf2 468sub _is_writable {
469 my $fh = shift;
470 (O_WRONLY | O_RDWR) & fcntl( $fh, F_GETFL, my $slush = 0);
471}
472
9be51a89 473#sub _is_readable {
474# my $fh = shift;
475# (O_RDONLY | O_RDWR) & fcntl( $fh, F_GETFL, my $slush = 0);
476#}
acd4faf2 477
ffed8b01 478##
479# tie() methods (hashes and arrays)
480##
481
482sub STORE {
d0b74c17 483 ##
484 # Store single hash key/value or array element in database.
485 ##
486 my $self = shift->_get_self;
487 my ($key, $value) = @_;
81d3d316 488
acd4faf2 489 unless ( _is_writable( $self->_fh ) ) {
490 $self->_throw_error( 'Cannot write to a readonly filehandle' );
491 }
d0b74c17 492
493 ##
494 # Request exclusive lock for writing
495 ##
496 $self->lock( LOCK_EX );
497
498 my $md5 = $self->{engine}{digest}->($key);
499
500 my $tag = $self->{engine}->find_bucket_list( $self, $md5, { create => 1 } );
501
502 # User may be storing a hash, in which case we do not want it run
503 # through the filtering system
504 if ( !ref($value) && $self->_root->{filter_store_value} ) {
505 $value = $self->_root->{filter_store_value}->( $value );
506 }
507
508 ##
509 # Add key/value to bucket list
510 ##
511 my $result = $self->{engine}->add_bucket( $self, $tag, $md5, $key, $value );
512
513 $self->unlock();
514
515 return $result;
ffed8b01 516}
517
518sub FETCH {
d0b74c17 519 ##
520 # Fetch single value or element given plain key or array index
521 ##
cb79ec85 522 my $self = shift->_get_self;
523 my $key = shift;
ffed8b01 524
d0b74c17 525 my $md5 = $self->{engine}{digest}->($key);
526
527 ##
528 # Request shared lock for reading
529 ##
530 $self->lock( LOCK_SH );
531
532 my $tag = $self->{engine}->find_bucket_list( $self, $md5 );
533 if (!$tag) {
534 $self->unlock();
535 return;
536 }
537
538 ##
539 # Get value from bucket list
540 ##
541 my $result = $self->{engine}->get_bucket_value( $self, $tag, $md5 );
542
543 $self->unlock();
544
ffed8b01 545 #XXX What is ref() checking here?
aeeb5497 546 #YYY Filters only apply on scalar values, so the ref check is making
547 #YYY sure the fetched bucket is a scalar, not a child hash or array.
d0b74c17 548 return ($result && !ref($result) && $self->_root->{filter_fetch_value})
4d35d856 549 ? $self->_root->{filter_fetch_value}->($result)
cb79ec85 550 : $result;
ffed8b01 551}
552
553sub DELETE {
d0b74c17 554 ##
555 # Delete single key/value pair or element given plain key or array index
556 ##
2ac02042 557 my $self = $_[0]->_get_self;
d0b74c17 558 my $key = $_[1];
559
560 my $md5 = $self->{engine}{digest}->($key);
561
562 ##
563 # Request exclusive lock for writing
564 ##
565 $self->lock( LOCK_EX );
566
567 my $tag = $self->{engine}->find_bucket_list( $self, $md5 );
568 if (!$tag) {
569 $self->unlock();
570 return;
571 }
572
573 ##
574 # Delete bucket
575 ##
9020ee8c 576 my $value = $self->{engine}->get_bucket_value($self, $tag, $md5 );
d0b74c17 577 if ($value && !ref($value) && $self->_root->{filter_fetch_value}) {
4d35d856 578 $value = $self->_root->{filter_fetch_value}->($value);
3b6a5056 579 }
580
d0b74c17 581 my $result = $self->{engine}->delete_bucket( $self, $tag, $md5 );
582
583 ##
584 # If this object is an array and the key deleted was on the end of the stack,
585 # decrement the length variable.
586 ##
587
588 $self->unlock();
589
590 return $value;
ffed8b01 591}
592
593sub EXISTS {
d0b74c17 594 ##
595 # Check if a single key or element exists given plain key or array index
596 ##
2ac02042 597 my $self = $_[0]->_get_self;
d0b74c17 598 my $key = $_[1];
599
600 my $md5 = $self->{engine}{digest}->($key);
601
602 ##
603 # Request shared lock for reading
604 ##
605 $self->lock( LOCK_SH );
606
607 my $tag = $self->{engine}->find_bucket_list( $self, $md5 );
608 if (!$tag) {
609 $self->unlock();
610
611 ##
612 # For some reason, the built-in exists() function returns '' for false
613 ##
614 return '';
615 }
616
617 ##
618 # Check if bucket exists and return 1 or ''
619 ##
620 my $result = $self->{engine}->bucket_exists( $self, $tag, $md5 ) || '';
621
622 $self->unlock();
623
624 return $result;
ffed8b01 625}
626
627sub CLEAR {
d0b74c17 628 ##
629 # Clear all keys from hash, or all elements from array.
630 ##
2ac02042 631 my $self = $_[0]->_get_self;
ffed8b01 632
d0b74c17 633 ##
634 # Request exclusive lock for writing
635 ##
636 $self->lock( LOCK_EX );
637
4d35d856 638 my $fh = $self->_fh;
629df3a3 639
d0b74c17 640 seek($fh, $self->_base_offset + $self->_root->{file_offset}, SEEK_SET);
641 if (eof $fh) {
642 $self->unlock();
643 return;
644 }
645
646 $self->{engine}->create_tag($self, $self->_base_offset, $self->_type, chr(0) x $self->{engine}{index_size});
647
648 $self->unlock();
649
650 return 1;
ffed8b01 651}
652
ffed8b01 653##
654# Public method aliases
655##
7f441181 656sub put { (shift)->STORE( @_ ) }
657sub store { (shift)->STORE( @_ ) }
658sub get { (shift)->FETCH( @_ ) }
659sub fetch { (shift)->FETCH( @_ ) }
baa27ab6 660sub delete { (shift)->DELETE( @_ ) }
661sub exists { (shift)->EXISTS( @_ ) }
662sub clear { (shift)->CLEAR( @_ ) }
ffed8b01 663
cc4bef86 664package DBM::Deep::_::Root;
665
666sub new {
667 my $class = shift;
668 my ($args) = @_;
669
670 my $self = bless {
f5be9b03 671 file => undef,
672 fh => undef,
673 file_offset => 0,
674 end => 0,
675 autoflush => undef,
676 locking => undef,
677 locked => 0,
678 filter_store_key => undef,
cc4bef86 679 filter_store_value => undef,
f5be9b03 680 filter_fetch_key => undef,
cc4bef86 681 filter_fetch_value => undef,
f5be9b03 682 autobless => undef,
cc4bef86 683 %$args,
684 }, $class;
685
714618f0 686 if ( $self->{fh} && !$self->{file_offset} ) {
687 $self->{file_offset} = tell( $self->{fh} );
688 }
689
cc4bef86 690 return $self;
691}
692
693sub DESTROY {
694 my $self = shift;
695 return unless $self;
696
697 close $self->{fh} if $self->{fh};
698
699 return;
700}
701
ffed8b01 7021;
703
704__END__
705
706=head1 NAME
707
708DBM::Deep - A pure perl multi-level hash/array DBM
709
710=head1 SYNOPSIS
711
712 use DBM::Deep;
713 my $db = DBM::Deep->new( "foo.db" );
d0b74c17 714
ffed8b01 715 $db->{key} = 'value'; # tie() style
716 print $db->{key};
d0b74c17 717
cbaa107d 718 $db->put('key' => 'value'); # OO style
ffed8b01 719 print $db->get('key');
d0b74c17 720
ffed8b01 721 # true multi-level support
722 $db->{my_complex} = [
d0b74c17 723 'hello', { perl => 'rules' },
724 42, 99,
90f93b43 725 ];
ffed8b01 726
727=head1 DESCRIPTION
728
d0b74c17 729A unique flat-file database module, written in pure perl. True
730multi-level hash/array support (unlike MLDBM, which is faked), hybrid
731OO / tie() interface, cross-platform FTPable files, and quite fast. Can
732handle millions of keys and unlimited hash levels without significant
733slow-down. Written from the ground-up in pure perl -- this is NOT a
734wrapper around a C-based DBM. Out-of-the-box compatibility with Unix,
ffed8b01 735Mac OS X and Windows.
736
737=head1 INSTALLATION
738
90f93b43 739Hopefully you are using Perl's excellent CPAN module, which will download
d0b74c17 740and install the module for you. If not, get the tarball, and run these
ffed8b01 741commands:
742
d0b74c17 743 tar zxf DBM-Deep-*
744 cd DBM-Deep-*
745 perl Makefile.PL
746 make
747 make test
748 make install
ffed8b01 749
750=head1 SETUP
751
d0b74c17 752Construction can be done OO-style (which is the recommended way), or using
ffed8b01 753Perl's tie() function. Both are examined here.
754
755=head2 OO CONSTRUCTION
756
757The recommended way to construct a DBM::Deep object is to use the new()
758method, which gets you a blessed, tied hash or array reference.
759
d0b74c17 760 my $db = DBM::Deep->new( "foo.db" );
ffed8b01 761
762This opens a new database handle, mapped to the file "foo.db". If this
d0b74c17 763file does not exist, it will automatically be created. DB files are
ffed8b01 764opened in "r+" (read/write) mode, and the type of object returned is a
765hash, unless otherwise specified (see L<OPTIONS> below).
766
ffed8b01 767You can pass a number of options to the constructor to specify things like
768locking, autoflush, etc. This is done by passing an inline hash:
769
d0b74c17 770 my $db = DBM::Deep->new(
771 file => "foo.db",
772 locking => 1,
773 autoflush => 1
774 );
ffed8b01 775
776Notice that the filename is now specified I<inside> the hash with
d0b74c17 777the "file" parameter, as opposed to being the sole argument to the
ffed8b01 778constructor. This is required if any options are specified.
779See L<OPTIONS> below for the complete list.
780
781
782
783You can also start with an array instead of a hash. For this, you must
784specify the C<type> parameter:
785
d0b74c17 786 my $db = DBM::Deep->new(
787 file => "foo.db",
788 type => DBM::Deep->TYPE_ARRAY
789 );
ffed8b01 790
791B<Note:> Specifing the C<type> parameter only takes effect when beginning
792a new DB file. If you create a DBM::Deep object with an existing file, the
90f93b43 793C<type> will be loaded from the file header, and an error will be thrown if
794the wrong type is passed in.
ffed8b01 795
796=head2 TIE CONSTRUCTION
797
90f93b43 798Alternately, you can create a DBM::Deep handle by using Perl's built-in
799tie() function. The object returned from tie() can be used to call methods,
800such as lock() and unlock(), but cannot be used to assign to the DBM::Deep
801file (as expected with most tie'd objects).
ffed8b01 802
d0b74c17 803 my %hash;
804 my $db = tie %hash, "DBM::Deep", "foo.db";
805
806 my @array;
807 my $db = tie @array, "DBM::Deep", "bar.db";
ffed8b01 808
809As with the OO constructor, you can replace the DB filename parameter with
810a hash containing one or more options (see L<OPTIONS> just below for the
811complete list).
812
d0b74c17 813 tie %hash, "DBM::Deep", {
814 file => "foo.db",
815 locking => 1,
816 autoflush => 1
817 };
ffed8b01 818
819=head2 OPTIONS
820
821There are a number of options that can be passed in when constructing your
822DBM::Deep objects. These apply to both the OO- and tie- based approaches.
823
824=over
825
826=item * file
827
828Filename of the DB file to link the handle to. You can pass a full absolute
d0b74c17 829filesystem path, partial path, or a plain filename if the file is in the
714618f0 830current working directory. This is a required parameter (though q.v. fh).
831
832=item * fh
833
834If you want, you can pass in the fh instead of the file. This is most useful for doing
835something like:
836
837 my $db = DBM::Deep->new( { fh => \*DATA } );
838
839You are responsible for making sure that the fh has been opened appropriately for your
840needs. If you open it read-only and attempt to write, an exception will be thrown. If you
841open it write-only or append-only, an exception will be thrown immediately as DBM::Deep
842needs to read from the fh.
843
844=item * file_offset
845
846This is the offset within the file that the DBM::Deep db starts. Most of the time, you will
847not need to set this. However, it's there if you want it.
848
849If you pass in fh and do not set this, it will be set appropriately.
ffed8b01 850
ffed8b01 851=item * type
852
853This parameter specifies what type of object to create, a hash or array. Use
854one of these two constants: C<DBM::Deep-E<gt>TYPE_HASH> or C<DBM::Deep-E<gt>TYPE_ARRAY>.
d0b74c17 855This only takes effect when beginning a new file. This is an optional
ffed8b01 856parameter, and defaults to C<DBM::Deep-E<gt>TYPE_HASH>.
857
858=item * locking
859
860Specifies whether locking is to be enabled. DBM::Deep uses Perl's Fnctl flock()
861function to lock the database in exclusive mode for writes, and shared mode for
d0b74c17 862reads. Pass any true value to enable. This affects the base DB handle I<and
863any child hashes or arrays> that use the same DB file. This is an optional
ffed8b01 864parameter, and defaults to 0 (disabled). See L<LOCKING> below for more.
865
866=item * autoflush
867
d0b74c17 868Specifies whether autoflush is to be enabled on the underlying filehandle.
869This obviously slows down write operations, but is required if you may have
870multiple processes accessing the same DB file (also consider enable I<locking>).
871Pass any true value to enable. This is an optional parameter, and defaults to 0
ffed8b01 872(disabled).
873
874=item * autobless
875
876If I<autobless> mode is enabled, DBM::Deep will preserve blessed hashes, and
877restore them when fetched. This is an B<experimental> feature, and does have
878side-effects. Basically, when hashes are re-blessed into their original
879classes, they are no longer blessed into the DBM::Deep class! So you won't be
880able to call any DBM::Deep methods on them. You have been warned.
881This is an optional parameter, and defaults to 0 (disabled).
882
883=item * filter_*
884
885See L<FILTERS> below.
886
ffed8b01 887=back
888
889=head1 TIE INTERFACE
890
891With DBM::Deep you can access your databases using Perl's standard hash/array
90f93b43 892syntax. Because all DBM::Deep objects are I<tied> to hashes or arrays, you can
893treat them as such. DBM::Deep will intercept all reads/writes and direct them
894to the right place -- the DB file. This has nothing to do with the
895L<TIE CONSTRUCTION> section above. This simply tells you how to use DBM::Deep
896using regular hashes and arrays, rather than calling functions like C<get()>
897and C<put()> (although those work too). It is entirely up to you how to want
898to access your databases.
ffed8b01 899
900=head2 HASHES
901
902You can treat any DBM::Deep object like a normal Perl hash reference. Add keys,
903or even nested hashes (or arrays) using standard Perl syntax:
904
d0b74c17 905 my $db = DBM::Deep->new( "foo.db" );
906
907 $db->{mykey} = "myvalue";
908 $db->{myhash} = {};
909 $db->{myhash}->{subkey} = "subvalue";
ffed8b01 910
d0b74c17 911 print $db->{myhash}->{subkey} . "\n";
ffed8b01 912
913You can even step through hash keys using the normal Perl C<keys()> function:
914
d0b74c17 915 foreach my $key (keys %$db) {
916 print "$key: " . $db->{$key} . "\n";
917 }
ffed8b01 918
919Remember that Perl's C<keys()> function extracts I<every> key from the hash and
d0b74c17 920pushes them onto an array, all before the loop even begins. If you have an
921extra large hash, this may exhaust Perl's memory. Instead, consider using
922Perl's C<each()> function, which pulls keys/values one at a time, using very
ffed8b01 923little memory:
924
d0b74c17 925 while (my ($key, $value) = each %$db) {
926 print "$key: $value\n";
927 }
ffed8b01 928
929Please note that when using C<each()>, you should always pass a direct
930hash reference, not a lookup. Meaning, you should B<never> do this:
931
d0b74c17 932 # NEVER DO THIS
933 while (my ($key, $value) = each %{$db->{foo}}) { # BAD
ffed8b01 934
935This causes an infinite loop, because for each iteration, Perl is calling
936FETCH() on the $db handle, resulting in a "new" hash for foo every time, so
d0b74c17 937it effectively keeps returning the first key over and over again. Instead,
ffed8b01 938assign a temporary variable to C<$db->{foo}>, then pass that to each().
939
940=head2 ARRAYS
941
942As with hashes, you can treat any DBM::Deep object like a normal Perl array
d0b74c17 943reference. This includes inserting, removing and manipulating elements,
ffed8b01 944and the C<push()>, C<pop()>, C<shift()>, C<unshift()> and C<splice()> functions.
d0b74c17 945The object must have first been created using type C<DBM::Deep-E<gt>TYPE_ARRAY>,
ffed8b01 946or simply be a nested array reference inside a hash. Example:
947
d0b74c17 948 my $db = DBM::Deep->new(
949 file => "foo-array.db",
950 type => DBM::Deep->TYPE_ARRAY
951 );
952
953 $db->[0] = "foo";
954 push @$db, "bar", "baz";
955 unshift @$db, "bah";
956
957 my $last_elem = pop @$db; # baz
958 my $first_elem = shift @$db; # bah
959 my $second_elem = $db->[1]; # bar
960
961 my $num_elements = scalar @$db;
ffed8b01 962
963=head1 OO INTERFACE
964
965In addition to the I<tie()> interface, you can also use a standard OO interface
966to manipulate all aspects of DBM::Deep databases. Each type of object (hash or
d0b74c17 967array) has its own methods, but both types share the following common methods:
ffed8b01 968C<put()>, C<get()>, C<exists()>, C<delete()> and C<clear()>.
969
970=over
971
4d35d856 972=item * new() / clone()
973
974These are the constructor and copy-functions.
975
90f93b43 976=item * put() / store()
ffed8b01 977
978Stores a new hash key/value pair, or sets an array element value. Takes two
979arguments, the hash key or array index, and the new value. The value can be
980a scalar, hash ref or array ref. Returns true on success, false on failure.
981
d0b74c17 982 $db->put("foo", "bar"); # for hashes
983 $db->put(1, "bar"); # for arrays
ffed8b01 984
90f93b43 985=item * get() / fetch()
ffed8b01 986
987Fetches the value of a hash key or array element. Takes one argument: the hash
d0b74c17 988key or array index. Returns a scalar, hash ref or array ref, depending on the
ffed8b01 989data type stored.
990
d0b74c17 991 my $value = $db->get("foo"); # for hashes
992 my $value = $db->get(1); # for arrays
ffed8b01 993
994=item * exists()
995
d0b74c17 996Checks if a hash key or array index exists. Takes one argument: the hash key
ffed8b01 997or array index. Returns true if it exists, false if not.
998
d0b74c17 999 if ($db->exists("foo")) { print "yay!\n"; } # for hashes
1000 if ($db->exists(1)) { print "yay!\n"; } # for arrays
ffed8b01 1001
1002=item * delete()
1003
1004Deletes one hash key/value pair or array element. Takes one argument: the hash
1005key or array index. Returns true on success, false if not found. For arrays,
1006the remaining elements located after the deleted element are NOT moved over.
1007The deleted element is essentially just undefined, which is exactly how Perl's
d0b74c17 1008internal arrays work. Please note that the space occupied by the deleted
1009key/value or element is B<not> reused again -- see L<UNUSED SPACE RECOVERY>
ffed8b01 1010below for details and workarounds.
1011
d0b74c17 1012 $db->delete("foo"); # for hashes
1013 $db->delete(1); # for arrays
ffed8b01 1014
1015=item * clear()
1016
d0b74c17 1017Deletes B<all> hash keys or array elements. Takes no arguments. No return
1018value. Please note that the space occupied by the deleted keys/values or
1019elements is B<not> reused again -- see L<UNUSED SPACE RECOVERY> below for
ffed8b01 1020details and workarounds.
1021
d0b74c17 1022 $db->clear(); # hashes or arrays
ffed8b01 1023
4d35d856 1024=item * lock() / unlock()
1025
1026q.v. Locking.
1027
1028=item * optimize()
1029
1030Recover lost disk space.
1031
1032=item * import() / export()
1033
1034Data going in and out.
1035
1036=item * set_digest() / set_pack() / set_filter()
1037
1038q.v. adjusting the interal parameters.
1039
ffed8b01 1040=back
1041
1042=head2 HASHES
1043
d0b74c17 1044For hashes, DBM::Deep supports all the common methods described above, and the
ffed8b01 1045following additional methods: C<first_key()> and C<next_key()>.
1046
1047=over
1048
1049=item * first_key()
1050
d0b74c17 1051Returns the "first" key in the hash. As with built-in Perl hashes, keys are
1052fetched in an undefined order (which appears random). Takes no arguments,
ffed8b01 1053returns the key as a scalar value.
1054
d0b74c17 1055 my $key = $db->first_key();
ffed8b01 1056
1057=item * next_key()
1058
1059Returns the "next" key in the hash, given the previous one as the sole argument.
1060Returns undef if there are no more keys to be fetched.
1061
d0b74c17 1062 $key = $db->next_key($key);
ffed8b01 1063
1064=back
1065
1066Here are some examples of using hashes:
1067
d0b74c17 1068 my $db = DBM::Deep->new( "foo.db" );
1069
1070 $db->put("foo", "bar");
1071 print "foo: " . $db->get("foo") . "\n";
1072
1073 $db->put("baz", {}); # new child hash ref
1074 $db->get("baz")->put("buz", "biz");
1075 print "buz: " . $db->get("baz")->get("buz") . "\n";
1076
1077 my $key = $db->first_key();
1078 while ($key) {
1079 print "$key: " . $db->get($key) . "\n";
1080 $key = $db->next_key($key);
1081 }
1082
1083 if ($db->exists("foo")) { $db->delete("foo"); }
ffed8b01 1084
1085=head2 ARRAYS
1086
d0b74c17 1087For arrays, DBM::Deep supports all the common methods described above, and the
1088following additional methods: C<length()>, C<push()>, C<pop()>, C<shift()>,
ffed8b01 1089C<unshift()> and C<splice()>.
1090
1091=over
1092
1093=item * length()
1094
1095Returns the number of elements in the array. Takes no arguments.
1096
d0b74c17 1097 my $len = $db->length();
ffed8b01 1098
1099=item * push()
1100
d0b74c17 1101Adds one or more elements onto the end of the array. Accepts scalars, hash
ffed8b01 1102refs or array refs. No return value.
1103
d0b74c17 1104 $db->push("foo", "bar", {});
ffed8b01 1105
1106=item * pop()
1107
1108Fetches the last element in the array, and deletes it. Takes no arguments.
1109Returns undef if array is empty. Returns the element value.
1110
d0b74c17 1111 my $elem = $db->pop();
ffed8b01 1112
1113=item * shift()
1114
d0b74c17 1115Fetches the first element in the array, deletes it, then shifts all the
1116remaining elements over to take up the space. Returns the element value. This
1117method is not recommended with large arrays -- see L<LARGE ARRAYS> below for
ffed8b01 1118details.
1119
d0b74c17 1120 my $elem = $db->shift();
ffed8b01 1121
1122=item * unshift()
1123
d0b74c17 1124Inserts one or more elements onto the beginning of the array, shifting all
1125existing elements over to make room. Accepts scalars, hash refs or array refs.
1126No return value. This method is not recommended with large arrays -- see
ffed8b01 1127<LARGE ARRAYS> below for details.
1128
d0b74c17 1129 $db->unshift("foo", "bar", {});
ffed8b01 1130
1131=item * splice()
1132
d0b74c17 1133Performs exactly like Perl's built-in function of the same name. See L<perldoc
ffed8b01 1134-f splice> for usage -- it is too complicated to document here. This method is
1135not recommended with large arrays -- see L<LARGE ARRAYS> below for details.
1136
1137=back
1138
1139Here are some examples of using arrays:
1140
d0b74c17 1141 my $db = DBM::Deep->new(
1142 file => "foo.db",
1143 type => DBM::Deep->TYPE_ARRAY
1144 );
1145
1146 $db->push("bar", "baz");
1147 $db->unshift("foo");
1148 $db->put(3, "buz");
1149
1150 my $len = $db->length();
1151 print "length: $len\n"; # 4
1152
1153 for (my $k=0; $k<$len; $k++) {
1154 print "$k: " . $db->get($k) . "\n";
1155 }
1156
1157 $db->splice(1, 2, "biz", "baf");
1158
1159 while (my $elem = shift @$db) {
1160 print "shifted: $elem\n";
1161 }
ffed8b01 1162
1163=head1 LOCKING
1164
d0b74c17 1165Enable automatic file locking by passing a true value to the C<locking>
ffed8b01 1166parameter when constructing your DBM::Deep object (see L<SETUP> above).
1167
d0b74c17 1168 my $db = DBM::Deep->new(
1169 file => "foo.db",
1170 locking => 1
1171 );
ffed8b01 1172
d0b74c17 1173This causes DBM::Deep to C<flock()> the underlying filehandle with exclusive
1174mode for writes, and shared mode for reads. This is required if you have
1175multiple processes accessing the same database file, to avoid file corruption.
1176Please note that C<flock()> does NOT work for files over NFS. See L<DB OVER
ffed8b01 1177NFS> below for more.
1178
1179=head2 EXPLICIT LOCKING
1180
d0b74c17 1181You can explicitly lock a database, so it remains locked for multiple
1182transactions. This is done by calling the C<lock()> method, and passing an
90f93b43 1183optional lock mode argument (defaults to exclusive mode). This is particularly
d0b74c17 1184useful for things like counters, where the current value needs to be fetched,
ffed8b01 1185then incremented, then stored again.
1186
d0b74c17 1187 $db->lock();
1188 my $counter = $db->get("counter");
1189 $counter++;
1190 $db->put("counter", $counter);
1191 $db->unlock();
1192
1193 # or...
ffed8b01 1194
d0b74c17 1195 $db->lock();
1196 $db->{counter}++;
1197 $db->unlock();
ffed8b01 1198
1199You can pass C<lock()> an optional argument, which specifies which mode to use
d0b74c17 1200(exclusive or shared). Use one of these two constants: C<DBM::Deep-E<gt>LOCK_EX>
1201or C<DBM::Deep-E<gt>LOCK_SH>. These are passed directly to C<flock()>, and are the
ffed8b01 1202same as the constants defined in Perl's C<Fcntl> module.
1203
d0b74c17 1204 $db->lock( DBM::Deep->LOCK_SH );
1205 # something here
1206 $db->unlock();
ffed8b01 1207
ffed8b01 1208=head1 IMPORTING/EXPORTING
1209
1210You can import existing complex structures by calling the C<import()> method,
1211and export an entire database into an in-memory structure using the C<export()>
1212method. Both are examined here.
1213
1214=head2 IMPORTING
1215
1216Say you have an existing hash with nested hashes/arrays inside it. Instead of
d0b74c17 1217walking the structure and adding keys/elements to the database as you go,
1218simply pass a reference to the C<import()> method. This recursively adds
ffed8b01 1219everything to an existing DBM::Deep object for you. Here is an example:
1220
d0b74c17 1221 my $struct = {
1222 key1 => "value1",
1223 key2 => "value2",
1224 array1 => [ "elem0", "elem1", "elem2" ],
1225 hash1 => {
1226 subkey1 => "subvalue1",
1227 subkey2 => "subvalue2"
1228 }
1229 };
1230
1231 my $db = DBM::Deep->new( "foo.db" );
1232 $db->import( $struct );
1233
1234 print $db->{key1} . "\n"; # prints "value1"
1235
1236This recursively imports the entire C<$struct> object into C<$db>, including
ffed8b01 1237all nested hashes and arrays. If the DBM::Deep object contains exsiting data,
d0b74c17 1238keys are merged with the existing ones, replacing if they already exist.
1239The C<import()> method can be called on any database level (not just the base
ffed8b01 1240level), and works with both hash and array DB types.
1241
ffed8b01 1242B<Note:> Make sure your existing structure has no circular references in it.
1243These will cause an infinite loop when importing.
1244
1245=head2 EXPORTING
1246
d0b74c17 1247Calling the C<export()> method on an existing DBM::Deep object will return
1248a reference to a new in-memory copy of the database. The export is done
ffed8b01 1249recursively, so all nested hashes/arrays are all exported to standard Perl
1250objects. Here is an example:
1251
d0b74c17 1252 my $db = DBM::Deep->new( "foo.db" );
1253
1254 $db->{key1} = "value1";
1255 $db->{key2} = "value2";
1256 $db->{hash1} = {};
1257 $db->{hash1}->{subkey1} = "subvalue1";
1258 $db->{hash1}->{subkey2} = "subvalue2";
1259
1260 my $struct = $db->export();
1261
1262 print $struct->{key1} . "\n"; # prints "value1"
ffed8b01 1263
1264This makes a complete copy of the database in memory, and returns a reference
d0b74c17 1265to it. The C<export()> method can be called on any database level (not just
1266the base level), and works with both hash and array DB types. Be careful of
1267large databases -- you can store a lot more data in a DBM::Deep object than an
ffed8b01 1268in-memory Perl structure.
1269
ffed8b01 1270B<Note:> Make sure your database has no circular references in it.
1271These will cause an infinite loop when exporting.
1272
1273=head1 FILTERS
1274
1275DBM::Deep has a number of hooks where you can specify your own Perl function
1276to perform filtering on incoming or outgoing data. This is a perfect
1277way to extend the engine, and implement things like real-time compression or
d0b74c17 1278encryption. Filtering applies to the base DB level, and all child hashes /
1279arrays. Filter hooks can be specified when your DBM::Deep object is first
1280constructed, or by calling the C<set_filter()> method at any time. There are
ffed8b01 1281four available filter hooks, described below:
1282
1283=over
1284
1285=item * filter_store_key
1286
d0b74c17 1287This filter is called whenever a hash key is stored. It
ffed8b01 1288is passed the incoming key, and expected to return a transformed key.
1289
1290=item * filter_store_value
1291
d0b74c17 1292This filter is called whenever a hash key or array element is stored. It
ffed8b01 1293is passed the incoming value, and expected to return a transformed value.
1294
1295=item * filter_fetch_key
1296
d0b74c17 1297This filter is called whenever a hash key is fetched (i.e. via
ffed8b01 1298C<first_key()> or C<next_key()>). It is passed the transformed key,
1299and expected to return the plain key.
1300
1301=item * filter_fetch_value
1302
d0b74c17 1303This filter is called whenever a hash key or array element is fetched.
ffed8b01 1304It is passed the transformed value, and expected to return the plain value.
1305
1306=back
1307
1308Here are the two ways to setup a filter hook:
1309
d0b74c17 1310 my $db = DBM::Deep->new(
1311 file => "foo.db",
1312 filter_store_value => \&my_filter_store,
1313 filter_fetch_value => \&my_filter_fetch
1314 );
1315
1316 # or...
1317
1318 $db->set_filter( "filter_store_value", \&my_filter_store );
1319 $db->set_filter( "filter_fetch_value", \&my_filter_fetch );
ffed8b01 1320
1321Your filter function will be called only when dealing with SCALAR keys or
1322values. When nested hashes and arrays are being stored/fetched, filtering
d0b74c17 1323is bypassed. Filters are called as static functions, passed a single SCALAR
ffed8b01 1324argument, and expected to return a single SCALAR value. If you want to
1325remove a filter, set the function reference to C<undef>:
1326
d0b74c17 1327 $db->set_filter( "filter_store_value", undef );
ffed8b01 1328
1329=head2 REAL-TIME ENCRYPTION EXAMPLE
1330
d0b74c17 1331Here is a working example that uses the I<Crypt::Blowfish> module to
ffed8b01 1332do real-time encryption / decryption of keys & values with DBM::Deep Filters.
d0b74c17 1333Please visit L<http://search.cpan.org/search?module=Crypt::Blowfish> for more
ffed8b01 1334on I<Crypt::Blowfish>. You'll also need the I<Crypt::CBC> module.
1335
d0b74c17 1336 use DBM::Deep;
1337 use Crypt::Blowfish;
1338 use Crypt::CBC;
1339
1340 my $cipher = Crypt::CBC->new({
1341 'key' => 'my secret key',
1342 'cipher' => 'Blowfish',
1343 'iv' => '$KJh#(}q',
1344 'regenerate_key' => 0,
1345 'padding' => 'space',
1346 'prepend_iv' => 0
1347 });
1348
1349 my $db = DBM::Deep->new(
1350 file => "foo-encrypt.db",
1351 filter_store_key => \&my_encrypt,
1352 filter_store_value => \&my_encrypt,
1353 filter_fetch_key => \&my_decrypt,
1354 filter_fetch_value => \&my_decrypt,
1355 );
1356
1357 $db->{key1} = "value1";
1358 $db->{key2} = "value2";
1359 print "key1: " . $db->{key1} . "\n";
1360 print "key2: " . $db->{key2} . "\n";
1361
1362 undef $db;
1363 exit;
1364
1365 sub my_encrypt {
1366 return $cipher->encrypt( $_[0] );
1367 }
1368 sub my_decrypt {
1369 return $cipher->decrypt( $_[0] );
1370 }
ffed8b01 1371
1372=head2 REAL-TIME COMPRESSION EXAMPLE
1373
1374Here is a working example that uses the I<Compress::Zlib> module to do real-time
1375compression / decompression of keys & values with DBM::Deep Filters.
d0b74c17 1376Please visit L<http://search.cpan.org/search?module=Compress::Zlib> for
ffed8b01 1377more on I<Compress::Zlib>.
1378
d0b74c17 1379 use DBM::Deep;
1380 use Compress::Zlib;
1381
1382 my $db = DBM::Deep->new(
1383 file => "foo-compress.db",
1384 filter_store_key => \&my_compress,
1385 filter_store_value => \&my_compress,
1386 filter_fetch_key => \&my_decompress,
1387 filter_fetch_value => \&my_decompress,
1388 );
1389
1390 $db->{key1} = "value1";
1391 $db->{key2} = "value2";
1392 print "key1: " . $db->{key1} . "\n";
1393 print "key2: " . $db->{key2} . "\n";
1394
1395 undef $db;
1396 exit;
1397
1398 sub my_compress {
1399 return Compress::Zlib::memGzip( $_[0] ) ;
1400 }
1401 sub my_decompress {
1402 return Compress::Zlib::memGunzip( $_[0] ) ;
1403 }
ffed8b01 1404
1405B<Note:> Filtering of keys only applies to hashes. Array "keys" are
1406actually numerical index numbers, and are not filtered.
1407
1408=head1 ERROR HANDLING
1409
1410Most DBM::Deep methods return a true value for success, and call die() on
95967a5e 1411failure. You can wrap calls in an eval block to catch the die.
ffed8b01 1412
d0b74c17 1413 my $db = DBM::Deep->new( "foo.db" ); # create hash
1414 eval { $db->push("foo"); }; # ILLEGAL -- push is array-only call
1415
90f93b43 1416 print $@; # prints error message
429e4192 1417
ffed8b01 1418=head1 LARGEFILE SUPPORT
1419
1420If you have a 64-bit system, and your Perl is compiled with both LARGEFILE
1421and 64-bit support, you I<may> be able to create databases larger than 2 GB.
1422DBM::Deep by default uses 32-bit file offset tags, but these can be changed
1423by calling the static C<set_pack()> method before you do anything else.
1424
d0b74c17 1425 DBM::Deep::set_pack(8, 'Q');
ffed8b01 1426
d0b74c17 1427This tells DBM::Deep to pack all file offsets with 8-byte (64-bit) quad words
1428instead of 32-bit longs. After setting these values your DB files have a
ffed8b01 1429theoretical maximum size of 16 XB (exabytes).
1430
ffed8b01 1431B<Note:> Changing these values will B<NOT> work for existing database files.
d0b74c17 1432Only change this for new files, and make sure it stays set consistently
1433throughout the file's life. If you do set these values, you can no longer
1434access 32-bit DB files. You can, however, call C<set_pack(4, 'N')> to change
ffed8b01 1435back to 32-bit mode.
1436
d0b74c17 1437B<Note:> I have not personally tested files > 2 GB -- all my systems have
1438only a 32-bit Perl. However, I have received user reports that this does
ffed8b01 1439indeed work!
1440
1441=head1 LOW-LEVEL ACCESS
1442
90f93b43 1443If you require low-level access to the underlying filehandle that DBM::Deep uses,
4d35d856 1444you can call the C<_fh()> method, which returns the handle:
ffed8b01 1445
d0b74c17 1446 my $fh = $db->_fh();
ffed8b01 1447
1448This method can be called on the root level of the datbase, or any child
1449hashes or arrays. All levels share a I<root> structure, which contains things
90f93b43 1450like the filehandle, a reference counter, and all the options specified
d0b74c17 1451when you created the object. You can get access to this root structure by
ffed8b01 1452calling the C<root()> method.
1453
d0b74c17 1454 my $root = $db->_root();
ffed8b01 1455
1456This is useful for changing options after the object has already been created,
f5be9b03 1457such as enabling/disabling locking. You can also store your own temporary user
1458data in this structure (be wary of name collision), which is then accessible from
1459any child hash or array.
ffed8b01 1460
1461=head1 CUSTOM DIGEST ALGORITHM
1462
1463DBM::Deep by default uses the I<Message Digest 5> (MD5) algorithm for hashing
1464keys. However you can override this, and use another algorithm (such as SHA-256)
d0b74c17 1465or even write your own. But please note that DBM::Deep currently expects zero
ffed8b01 1466collisions, so your algorithm has to be I<perfect>, so to speak.
1467Collision detection may be introduced in a later version.
1468
1469
1470
d0b74c17 1471You can specify a custom digest algorithm by calling the static C<set_digest()>
1472function, passing a reference to a subroutine, and the length of the algorithm's
1473hashes (in bytes). This is a global static function, which affects ALL DBM::Deep
1474objects. Here is a working example that uses a 256-bit hash from the
1475I<Digest::SHA256> module. Please see
ffed8b01 1476L<http://search.cpan.org/search?module=Digest::SHA256> for more.
1477
d0b74c17 1478 use DBM::Deep;
1479 use Digest::SHA256;
1480
1481 my $context = Digest::SHA256::new(256);
1482
1483 DBM::Deep::set_digest( \&my_digest, 32 );
1484
1485 my $db = DBM::Deep->new( "foo-sha.db" );
1486
1487 $db->{key1} = "value1";
1488 $db->{key2} = "value2";
1489 print "key1: " . $db->{key1} . "\n";
1490 print "key2: " . $db->{key2} . "\n";
1491
1492 undef $db;
1493 exit;
1494
1495 sub my_digest {
1496 return substr( $context->hash($_[0]), 0, 32 );
1497 }
ffed8b01 1498
1499B<Note:> Your returned digest strings must be B<EXACTLY> the number
1500of bytes you specify in the C<set_digest()> function (in this case 32).
1501
1502=head1 CIRCULAR REFERENCES
1503
1504DBM::Deep has B<experimental> support for circular references. Meaning you
1505can have a nested hash key or array element that points to a parent object.
1506This relationship is stored in the DB file, and is preserved between sessions.
1507Here is an example:
1508
d0b74c17 1509 my $db = DBM::Deep->new( "foo.db" );
1510
1511 $db->{foo} = "bar";
1512 $db->{circle} = $db; # ref to self
1513
1514 print $db->{foo} . "\n"; # prints "foo"
1515 print $db->{circle}->{foo} . "\n"; # prints "foo" again
ffed8b01 1516
1517One catch is, passing the object to a function that recursively walks the
1518object tree (such as I<Data::Dumper> or even the built-in C<optimize()> or
d0b74c17 1519C<export()> methods) will result in an infinite loop. The other catch is,
1520if you fetch the I<key> of a circular reference (i.e. using the C<first_key()>
1521or C<next_key()> methods), you will get the I<target object's key>, not the
1522ref's key. This gets even more interesting with the above example, where
1523the I<circle> key points to the base DB object, which technically doesn't
1524have a key. So I made DBM::Deep return "[base]" as the key name in that
ffed8b01 1525special case.
1526
1527=head1 CAVEATS / ISSUES / BUGS
1528
1529This section describes all the known issues with DBM::Deep. It you have found
1530something that is not listed here, please send e-mail to L<jhuckaby@cpan.org>.
1531
1532=head2 UNUSED SPACE RECOVERY
1533
14a3acb6 1534One major caveat with DBM::Deep is that space occupied by existing keys and
ffed8b01 1535values is not recovered when they are deleted. Meaning if you keep deleting
1536and adding new keys, your file will continuously grow. I am working on this,
d0b74c17 1537but in the meantime you can call the built-in C<optimize()> method from time to
ffed8b01 1538time (perhaps in a crontab or something) to recover all your unused space.
1539
d0b74c17 1540 $db->optimize(); # returns true on success
ffed8b01 1541
1542This rebuilds the ENTIRE database into a new file, then moves it on top of
1543the original. The new file will have no unused space, thus it will take up as
d0b74c17 1544little disk space as possible. Please note that this operation can take
1545a long time for large files, and you need enough disk space to temporarily hold
15462 copies of your DB file. The temporary file is created in the same directory
1547as the original, named with a ".tmp" extension, and is deleted when the
1548operation completes. Oh, and if locking is enabled, the DB is automatically
ffed8b01 1549locked for the entire duration of the copy.
1550
d0b74c17 1551B<WARNING:> Only call optimize() on the top-level node of the database, and
1552make sure there are no child references lying around. DBM::Deep keeps a reference
ffed8b01 1553counter, and if it is greater than 1, optimize() will abort and return undef.
1554
1555=head2 AUTOVIVIFICATION
1556
d0b74c17 1557Unfortunately, autovivification doesn't work with tied hashes. This appears to
1558be a bug in Perl's tie() system, as I<Jakob Schmidt> encountered the very same
ffed8b01 1559issue with his I<DWH_FIle> module (see L<http://search.cpan.org/search?module=DWH_File>),
d0b74c17 1560and it is also mentioned in the BUGS section for the I<MLDBM> module <see
ffed8b01 1561L<http://search.cpan.org/search?module=MLDBM>). Basically, on a new db file,
1562this does not work:
1563
d0b74c17 1564 $db->{foo}->{bar} = "hello";
ffed8b01 1565
1566Since "foo" doesn't exist, you cannot add "bar" to it. You end up with "foo"
1567being an empty hash. Try this instead, which works fine:
1568
d0b74c17 1569 $db->{foo} = { bar => "hello" };
ffed8b01 1570
1571As of Perl 5.8.7, this bug still exists. I have walked very carefully through
1572the execution path, and Perl indeed passes an empty hash to the STORE() method.
1573Probably a bug in Perl.
1574
1575=head2 FILE CORRUPTION
1576
14a3acb6 1577The current level of error handling in DBM::Deep is minimal. Files I<are> checked
1578for a 32-bit signature when opened, but other corruption in files can cause
1579segmentation faults. DBM::Deep may try to seek() past the end of a file, or get
ffed8b01 1580stuck in an infinite loop depending on the level of corruption. File write
1581operations are not checked for failure (for speed), so if you happen to run
d0b74c17 1582out of disk space, DBM::Deep will probably fail in a bad way. These things will
ffed8b01 1583be addressed in a later version of DBM::Deep.
1584
1585=head2 DB OVER NFS
1586
14a3acb6 1587Beware of using DB files over NFS. DBM::Deep uses flock(), which works well on local
d0b74c17 1588filesystems, but will NOT protect you from file corruption over NFS. I've heard
1589about setting up your NFS server with a locking daemon, then using lockf() to
1590lock your files, but your mileage may vary there as well. From what I
1591understand, there is no real way to do it. However, if you need access to the
1592underlying filehandle in DBM::Deep for using some other kind of locking scheme like
ffed8b01 1593lockf(), see the L<LOW-LEVEL ACCESS> section above.
1594
1595=head2 COPYING OBJECTS
1596
d0b74c17 1597Beware of copying tied objects in Perl. Very strange things can happen.
1598Instead, use DBM::Deep's C<clone()> method which safely copies the object and
ffed8b01 1599returns a new, blessed, tied hash or array to the same level in the DB.
1600
d0b74c17 1601 my $copy = $db->clone();
ffed8b01 1602
90f93b43 1603B<Note>: Since clone() here is cloning the object, not the database location, any
1604modifications to either $db or $copy will be visible in both.
1605
ffed8b01 1606=head2 LARGE ARRAYS
1607
1608Beware of using C<shift()>, C<unshift()> or C<splice()> with large arrays.
1609These functions cause every element in the array to move, which can be murder
1610on DBM::Deep, as every element has to be fetched from disk, then stored again in
90f93b43 1611a different location. This will be addressed in the forthcoming version 1.00.
ffed8b01 1612
9be51a89 1613=head2 WRITEONLY FILES
1614
1615If you pass in a filehandle to new(), you may have opened it in either a readonly or
1616writeonly mode. STORE will verify that the filehandle is writable. However, there
1617doesn't seem to be a good way to determine if a filehandle is readable. And, if the
1618filehandle isn't readable, it's not clear what will happen. So, don't do that.
1619
ffed8b01 1620=head1 PERFORMANCE
1621
1622This section discusses DBM::Deep's speed and memory usage.
1623
1624=head2 SPEED
1625
d0b74c17 1626Obviously, DBM::Deep isn't going to be as fast as some C-based DBMs, such as
ffed8b01 1627the almighty I<BerkeleyDB>. But it makes up for it in features like true
1628multi-level hash/array support, and cross-platform FTPable files. Even so,
1629DBM::Deep is still pretty fast, and the speed stays fairly consistent, even
1630with huge databases. Here is some test data:
d0b74c17 1631
1632 Adding 1,000,000 keys to new DB file...
1633
1634 At 100 keys, avg. speed is 2,703 keys/sec
1635 At 200 keys, avg. speed is 2,642 keys/sec
1636 At 300 keys, avg. speed is 2,598 keys/sec
1637 At 400 keys, avg. speed is 2,578 keys/sec
1638 At 500 keys, avg. speed is 2,722 keys/sec
1639 At 600 keys, avg. speed is 2,628 keys/sec
1640 At 700 keys, avg. speed is 2,700 keys/sec
1641 At 800 keys, avg. speed is 2,607 keys/sec
1642 At 900 keys, avg. speed is 2,190 keys/sec
1643 At 1,000 keys, avg. speed is 2,570 keys/sec
1644 At 2,000 keys, avg. speed is 2,417 keys/sec
1645 At 3,000 keys, avg. speed is 1,982 keys/sec
1646 At 4,000 keys, avg. speed is 1,568 keys/sec
1647 At 5,000 keys, avg. speed is 1,533 keys/sec
1648 At 6,000 keys, avg. speed is 1,787 keys/sec
1649 At 7,000 keys, avg. speed is 1,977 keys/sec
1650 At 8,000 keys, avg. speed is 2,028 keys/sec
1651 At 9,000 keys, avg. speed is 2,077 keys/sec
1652 At 10,000 keys, avg. speed is 2,031 keys/sec
1653 At 20,000 keys, avg. speed is 1,970 keys/sec
1654 At 30,000 keys, avg. speed is 2,050 keys/sec
1655 At 40,000 keys, avg. speed is 2,073 keys/sec
1656 At 50,000 keys, avg. speed is 1,973 keys/sec
1657 At 60,000 keys, avg. speed is 1,914 keys/sec
1658 At 70,000 keys, avg. speed is 2,091 keys/sec
1659 At 80,000 keys, avg. speed is 2,103 keys/sec
1660 At 90,000 keys, avg. speed is 1,886 keys/sec
1661 At 100,000 keys, avg. speed is 1,970 keys/sec
1662 At 200,000 keys, avg. speed is 2,053 keys/sec
1663 At 300,000 keys, avg. speed is 1,697 keys/sec
1664 At 400,000 keys, avg. speed is 1,838 keys/sec
1665 At 500,000 keys, avg. speed is 1,941 keys/sec
1666 At 600,000 keys, avg. speed is 1,930 keys/sec
1667 At 700,000 keys, avg. speed is 1,735 keys/sec
1668 At 800,000 keys, avg. speed is 1,795 keys/sec
1669 At 900,000 keys, avg. speed is 1,221 keys/sec
1670 At 1,000,000 keys, avg. speed is 1,077 keys/sec
1671
1672This test was performed on a PowerMac G4 1gHz running Mac OS X 10.3.2 & Perl
16735.8.1, with an 80GB Ultra ATA/100 HD spinning at 7200RPM. The hash keys and
1674values were between 6 - 12 chars in length. The DB file ended up at 210MB.
ffed8b01 1675Run time was 12 min 3 sec.
1676
1677=head2 MEMORY USAGE
1678
1679One of the great things about DBM::Deep is that it uses very little memory.
1680Even with huge databases (1,000,000+ keys) you will not see much increased
14a3acb6 1681memory on your process. DBM::Deep relies solely on the filesystem for storing
ffed8b01 1682and fetching data. Here is output from I</usr/bin/top> before even opening a
1683database handle:
1684
d0b74c17 1685 PID USER PRI NI SIZE RSS SHARE STAT %CPU %MEM TIME COMMAND
1686 22831 root 11 0 2716 2716 1296 R 0.0 0.2 0:07 perl
ffed8b01 1687
d0b74c17 1688Basically the process is taking 2,716K of memory. And here is the same
ffed8b01 1689process after storing and fetching 1,000,000 keys:
1690
d0b74c17 1691 PID USER PRI NI SIZE RSS SHARE STAT %CPU %MEM TIME COMMAND
1692 22831 root 14 0 2772 2772 1328 R 0.0 0.2 13:32 perl
ffed8b01 1693
d0b74c17 1694Notice the memory usage increased by only 56K. Test was performed on a 700mHz
ffed8b01 1695x86 box running Linux RedHat 7.2 & Perl 5.6.1.
1696
1697=head1 DB FILE FORMAT
1698
1699In case you were interested in the underlying DB file format, it is documented
d0b74c17 1700here in this section. You don't need to know this to use the module, it's just
ffed8b01 1701included for reference.
1702
1703=head2 SIGNATURE
1704
1705DBM::Deep files always start with a 32-bit signature to identify the file type.
1706This is at offset 0. The signature is "DPDB" in network byte order. This is
90f93b43 1707checked for when the file is opened and an error will be thrown if it's not found.
ffed8b01 1708
1709=head2 TAG
1710
1711The DBM::Deep file is in a I<tagged format>, meaning each section of the file
d0b74c17 1712has a standard header containing the type of data, the length of data, and then
1713the data itself. The type is a single character (1 byte), the length is a
ffed8b01 171432-bit unsigned long in network byte order, and the data is, well, the data.
1715Here is how it unfolds:
1716
1717=head2 MASTER INDEX
1718
d0b74c17 1719Immediately after the 32-bit file signature is the I<Master Index> record.
1720This is a standard tag header followed by 1024 bytes (in 32-bit mode) or 2048
1721bytes (in 64-bit mode) of data. The type is I<H> for hash or I<A> for array,
ffed8b01 1722depending on how the DBM::Deep object was constructed.
1723
d0b74c17 1724The index works by looking at a I<MD5 Hash> of the hash key (or array index
1725number). The first 8-bit char of the MD5 signature is the offset into the
1726index, multipled by 4 in 32-bit mode, or 8 in 64-bit mode. The value of the
ffed8b01 1727index element is a file offset of the next tag for the key/element in question,
1728which is usually a I<Bucket List> tag (see below).
1729
ffed8b01 1730The next tag I<could> be another index, depending on how many keys/elements
1731exist. See L<RE-INDEXING> below for details.
1732
1733=head2 BUCKET LIST
1734
d0b74c17 1735A I<Bucket List> is a collection of 16 MD5 hashes for keys/elements, plus
1736file offsets to where the actual data is stored. It starts with a standard
1737tag header, with type I<B>, and a data size of 320 bytes in 32-bit mode, or
ffed8b01 1738384 bytes in 64-bit mode. Each MD5 hash is stored in full (16 bytes), plus
1739the 32-bit or 64-bit file offset for the I<Bucket> containing the actual data.
d0b74c17 1740When the list fills up, a I<Re-Index> operation is performed (See
ffed8b01 1741L<RE-INDEXING> below).
1742
1743=head2 BUCKET
1744
1745A I<Bucket> is a tag containing a key/value pair (in hash mode), or a
1746index/value pair (in array mode). It starts with a standard tag header with
1747type I<D> for scalar data (string, binary, etc.), or it could be a nested
1748hash (type I<H>) or array (type I<A>). The value comes just after the tag
1749header. The size reported in the tag header is only for the value, but then,
d0b74c17 1750just after the value is another size (32-bit unsigned long) and then the plain
1751key itself. Since the value is likely to be fetched more often than the plain
ffed8b01 1752key, I figured it would be I<slightly> faster to store the value first.
1753
ffed8b01 1754If the type is I<H> (hash) or I<A> (array), the value is another I<Master Index>
1755record for the nested structure, where the process begins all over again.
1756
1757=head2 RE-INDEXING
1758
1759After a I<Bucket List> grows to 16 records, its allocated space in the file is
d0b74c17 1760exhausted. Then, when another key/element comes in, the list is converted to a
1761new index record. However, this index will look at the next char in the MD5
1762hash, and arrange new Bucket List pointers accordingly. This process is called
1763I<Re-Indexing>. Basically, a new index tag is created at the file EOF, and all
176417 (16 + new one) keys/elements are removed from the old Bucket List and
1765inserted into the new index. Several new Bucket Lists are created in the
1766process, as a new MD5 char from the key is being examined (it is unlikely that
ffed8b01 1767the keys will all share the same next char of their MD5s).
1768
ffed8b01 1769Because of the way the I<MD5> algorithm works, it is impossible to tell exactly
d0b74c17 1770when the Bucket Lists will turn into indexes, but the first round tends to
1771happen right around 4,000 keys. You will see a I<slight> decrease in
1772performance here, but it picks back up pretty quick (see L<SPEED> above). Then
1773it takes B<a lot> more keys to exhaust the next level of Bucket Lists. It's
1774right around 900,000 keys. This process can continue nearly indefinitely --
1775right up until the point the I<MD5> signatures start colliding with each other,
1776and this is B<EXTREMELY> rare -- like winning the lottery 5 times in a row AND
1777getting struck by lightning while you are walking to cash in your tickets.
1778Theoretically, since I<MD5> hashes are 128-bit values, you I<could> have up to
1779340,282,366,921,000,000,000,000,000,000,000,000,000 keys/elements (I believe
ffed8b01 1780this is 340 unodecillion, but don't quote me).
1781
1782=head2 STORING
1783
d0b74c17 1784When a new key/element is stored, the key (or index number) is first run through
1785I<Digest::MD5> to get a 128-bit signature (example, in hex:
ffed8b01 1786b05783b0773d894396d475ced9d2f4f6). Then, the I<Master Index> record is checked
37c5bcf0 1787for the first char of the signature (in this case I<b0>). If it does not exist,
d0b74c17 1788a new I<Bucket List> is created for our key (and the next 15 future keys that
1789happen to also have I<b> as their first MD5 char). The entire MD5 is written
ffed8b01 1790to the I<Bucket List> along with the offset of the new I<Bucket> record (EOF at
d0b74c17 1791this point, unless we are replacing an existing I<Bucket>), where the actual
ffed8b01 1792data will be stored.
1793
1794=head2 FETCHING
1795
d0b74c17 1796Fetching an existing key/element involves getting a I<Digest::MD5> of the key
1797(or index number), then walking along the indexes. If there are enough
1798keys/elements in this DB level, there might be nested indexes, each linked to
1799a particular char of the MD5. Finally, a I<Bucket List> is pointed to, which
1800contains up to 16 full MD5 hashes. Each is checked for equality to the key in
1801question. If we found a match, the I<Bucket> tag is loaded, where the value and
ffed8b01 1802plain key are stored.
1803
ffed8b01 1804Fetching the plain key occurs when calling the I<first_key()> and I<next_key()>
1805methods. In this process the indexes are walked systematically, and each key
1806fetched in increasing MD5 order (which is why it appears random). Once the
d0b74c17 1807I<Bucket> is found, the value is skipped and the plain key returned instead.
1808B<Note:> Do not count on keys being fetched as if the MD5 hashes were
1809alphabetically sorted. This only happens on an index-level -- as soon as the
1810I<Bucket Lists> are hit, the keys will come out in the order they went in --
1811so it's pretty much undefined how the keys will come out -- just like Perl's
ffed8b01 1812built-in hashes.
1813
261d1296 1814=head1 CODE COVERAGE
1815
37c5bcf0 1816We use B<Devel::Cover> to test the code coverage of our tests, below is the
90f93b43 1817B<Devel::Cover> report on this module's test suite.
7910cf68 1818
37c5bcf0 1819 ---------------------------- ------ ------ ------ ------ ------ ------ ------
1820 File stmt bran cond sub pod time total
1821 ---------------------------- ------ ------ ------ ------ ------ ------ ------
251dfd0e 1822 blib/lib/DBM/Deep.pm 95.1 81.6 70.3 100.0 100.0 33.4 91.0
1823 blib/lib/DBM/Deep/Array.pm 100.0 91.1 100.0 100.0 n/a 27.8 98.0
1824 blib/lib/DBM/Deep/Engine.pm 97.8 85.6 75.0 100.0 0.0 25.8 90.8
1825 blib/lib/DBM/Deep/Hash.pm 100.0 87.5 100.0 100.0 n/a 13.0 97.2
1826 Total 97.5 85.4 76.6 100.0 46.9 100.0 92.5
37c5bcf0 1827 ---------------------------- ------ ------ ------ ------ ------ ------ ------
1828
1829=head1 MORE INFORMATION
1830
1831Check out the DBM::Deep Google Group at L<http://groups.google.com/group/DBM-Deep>
1832or send email to L<DBM-Deep@googlegroups.com>.
261d1296 1833
aeeb5497 1834=head1 AUTHORS
ffed8b01 1835
1836Joseph Huckaby, L<jhuckaby@cpan.org>
37c5bcf0 1837
aeeb5497 1838Rob Kinyon, L<rkinyon@cpan.org>
ffed8b01 1839
1840Special thanks to Adam Sah and Rich Gaushell! You know why :-)
1841
1842=head1 SEE ALSO
1843
1844perltie(1), Tie::Hash(3), Digest::MD5(3), Fcntl(3), flock(2), lockf(3), nfs(5),
1845Digest::SHA256(3), Crypt::Blowfish(3), Compress::Zlib(3)
1846
1847=head1 LICENSE
1848
aeeb5497 1849Copyright (c) 2002-2006 Joseph Huckaby. All Rights Reserved.
ffed8b01 1850This is free software, you may use it and distribute it under the
1851same terms as Perl itself.
1852
1853=cut