lib/DBM/Deep/Engine/Sector/Null.pm
lib/DBM/Deep/Engine/Sector/Reference.pm
lib/DBM/Deep/Engine/Sector/Scalar.pm
-lib/DBM/Deep/File.pm
+lib/DBM/Deep/Storage/File.pm
lib/DBM/Deep/Hash.pm
lib/DBM/Deep/Internals.pod
lib/DBM/Deep/Iterator.pm
+DROP TABLE IF EXISTS `rec_array`;
CREATE TABLE `rec_array` (
`id` bigint(20) unsigned NOT NULL,
PRIMARY KEY (`id`)
);
+DROP TABLE IF EXISTS `rec_array_item`;
CREATE TABLE `rec_array_item` (
`id` bigint(20) unsigned NOT NULL AUTO_INCREMENT,
`array` bigint(20) NOT NULL,
`value_data` varchar(255) DEFAULT NULL,
`value_type` enum('array','data','hash','text','value') NOT NULL DEFAULT 'value',
PRIMARY KEY (`id`),
- UNIQUE KEY `array_2` (`array`,`pos`),
+ UNIQUE KEY `array_2` (`array`,`pos`)
);
+DROP TABLE IF EXISTS `rec_hash`;
CREATE TABLE `rec_hash` (
`id` bigint(20) unsigned NOT NULL,
PRIMARY KEY (`id`)
);
+DROP TABLE IF EXISTS `rec_hash_item`;
CREATE TABLE `rec_hash_item` (
`id` bigint(20) unsigned NOT NULL AUTO_INCREMENT,
`hash` bigint(20) NOT NULL,
`value_data` varchar(255) DEFAULT NULL,
`value_type` enum('array','data','hash','text','value') NOT NULL DEFAULT 'value',
PRIMARY KEY (`id`),
- UNIQUE KEY `hash_2` (`hash`,`key_hash`),
+ UNIQUE KEY `hash_2` (`hash`,`key_hash`)
);
+DROP TABLE IF EXISTS `rec_item`;
CREATE TABLE `rec_item` (
`id` bigint(20) NOT NULL AUTO_INCREMENT,
`item_type` enum('array','hash') NOT NULL DEFAULT 'hash',
PRIMARY KEY (`id`)
);
+DROP TABLE IF EXISTS `rec_value_data`;
CREATE TABLE `rec_value_data` (
`id` bigint(20) unsigned NOT NULL AUTO_INCREMENT,
`data` longblob NOT NULL,
PRIMARY KEY (`id`)
);
+DROP TABLE IF EXISTS `rec_value_text`;
CREATE TABLE `rec_value_text` (
`id` bigint(20) unsigned NOT NULL AUTO_INCREMENT,
`data` longtext NOT NULL,
use strict;
use warnings FATAL => 'all';
-our $VERSION = q(1.0014);
+our $VERSION = q(1.0015);
-use Data::Dumper ();
use Scalar::Util ();
-use DBM::Deep::Engine;
-use DBM::Deep::File;
+use DBM::Deep::Engine ();
use DBM::Deep::SQL::Util;
use DBM::Deep::SQL::Array;
use constant DEBUG => 0;
-##
-# Setup constants for users to pass to new()
-##
sub TYPE_HASH () { DBM::Deep::Engine->SIG_HASH }
sub TYPE_ARRAY () { DBM::Deep::Engine->SIG_ARRAY }
return $args;
}
+# Class constructor method for Perl OO interface.
+# Calls tie() and returns blessed reference to tied hash or array,
+# providing a hybrid OO/tie interface.
sub new {
- ##
- # Class constructor method for Perl OO interface.
- # Calls tie() and returns blessed reference to tied hash or array,
- # providing a hybrid OO/tie interface.
- ##
my $class = shift;
my $args = $class->_get_args( @_ );
my $self;
${$spot} = $value;
}
else {
- # This assumes hash or array only. This is a bad assumption moving forward.
- # -RobK, 2008-05-27
my $r = Scalar::Util::reftype( $value );
my $tied;
if ( $r eq 'ARRAY' ) {
$tied = tied(@$value);
}
+ # This assumes hash or array only. This is a bad assumption moving
+ # forward. -RobK, 2008-05-27
else {
$tied = tied(%$value);
}
#}
sub export {
- ##
- # Recursively export into standard Perl hashes and arrays.
- ##
my $self = shift->_get_self;
my $temp = $self->_repr;
}
sub import {
- # Perl calls import() on use -- ignore
- return if !ref $_[0];
+ return if !ref $_[0]; # Perl calls import() on use -- ignore
my $self = shift->_get_self;
my ($struct) = @_;
#XXX Need to keep track of who has a fh to this file in order to
#XXX close them all prior to optimize on Win32/cygwin
+# Rebuild entire database into new file, then move
+# it back on top of original.
sub optimize {
- ##
- # Rebuild entire database into new file, then move
- # it back on top of original.
- ##
my $self = shift->_get_self;
+ # Optimizing is only something we need to do when we're working with our
+ # own file format. Otherwise, let the other guy do the optimizations.
+# return unless $self->_engine->isa( 'DBM::Deep::Engine::File' );
+
#XXX Need to create a new test for this
# if ($self->_engine->storage->{links} > 1) {
# $self->_throw_error("Cannot optimize: reference count is greater than 1");
return $rv;
}
-##
# Accessor methods
-##
-
sub _engine {
my $self = $_[0]->_get_self;
return $self->{engine};
return $self->{staleness};
}
-##
# Utility methods
-##
-
sub _throw_error {
my $n = 0;
while( 1 ) {
}
}
+# Store single hash key/value or array element in database.
sub STORE {
- ##
- # Store single hash key/value or array element in database.
- ##
my $self = shift->_get_self;
my ($key, $value) = @_;
warn "STORE($self, '$key', '@{[defined$value?$value:'undef']}')\n" if DEBUG;
return 1;
}
+# Fetch single value or element given plain key or array index
sub FETCH {
- ##
- # Fetch single value or element given plain key or array index
- ##
my $self = shift->_get_self;
my ($key) = @_;
warn "FETCH($self, '$key')\n" if DEBUG;
: $result;
}
+# Delete single key/value pair or element given plain key or array index
sub DELETE {
- ##
- # Delete single key/value pair or element given plain key or array index
- ##
my $self = shift->_get_self;
my ($key) = @_;
warn "DELETE($self, '$key')\n" if DEBUG;
return $value;
}
+# Check if a single key or element exists given plain key or array index
sub EXISTS {
- ##
- # Check if a single key or element exists given plain key or array index
- ##
my $self = shift->_get_self;
my ($key) = @_;
warn "EXISTS($self, '$key')\n" if DEBUG;
return $result;
}
+# Clear all keys from hash, or all elements from array.
sub CLEAR {
- ##
- # Clear all keys from hash, or all elements from array.
- ##
my $self = shift->_get_self;
warn "CLEAR($self)\n" if DEBUG;
return 1;
}
-##
# Public method aliases
-##
-sub put { (shift)->STORE( @_ ) }
-sub store { (shift)->STORE( @_ ) }
-sub get { (shift)->FETCH( @_ ) }
-sub fetch { (shift)->FETCH( @_ ) }
+sub put { (shift)->STORE( @_ ) }
+sub get { (shift)->FETCH( @_ ) }
+sub store { (shift)->STORE( @_ ) }
+sub fetch { (shift)->FETCH( @_ ) }
sub delete { (shift)->DELETE( @_ ) }
sub exists { (shift)->EXISTS( @_ ) }
-sub clear { (shift)->CLEAR( @_ ) }
+sub clear { (shift)->CLEAR( @_ ) }
sub _dump_file {shift->_get_self->_engine->_dump_file;}
use 5.006_000;
use strict;
-use warnings;
-
-our $VERSION = q(1.0013);
+use warnings FATAL => 'all';
# This is to allow DBM::Deep::Array to handle negative indices on
# its own. Otherwise, Perl would intercept the call to negative
return $rv;
}
-# Now that we have a real Reference sector, we should store arrayzize there. However,
-# arraysize needs to be transactionally-aware, so a simple location to store it isn't
-# going to work.
+# Now that we have a real Reference sector, we should store arrayzize there.
+# However, arraysize needs to be transactionally-aware, so a simple location to
+# store it isn't going to work.
sub FETCHSIZE {
my $self = shift->_get_self;
# We don't need to populate it, yet.
# It will be useful, though, when we split out HASH and ARRAY
-sub EXTEND {
- ##
- # Perl will call EXTEND() when the array is likely to grow.
- # We don't care, but include it because it gets called at times.
- ##
-}
+# Perl will call EXTEND() when the array is likely to grow.
+# We don't care, but include it because it gets called at times.
+sub EXTEND {}
sub _copy_node {
my $self = shift;
return 1;
}
-##
-# Public method aliases
-##
-sub length { (shift)->FETCHSIZE(@_) }
-sub pop { (shift)->POP(@_) }
-sub push { (shift)->PUSH(@_) }
-sub unshift { (shift)->UNSHIFT(@_) }
-sub splice { (shift)->SPLICE(@_) }
+sub length { (shift)->FETCHSIZE(@_) }
+sub pop { (shift)->POP(@_) }
+sub push { (shift)->PUSH(@_) }
+sub unshift { (shift)->UNSHIFT(@_) }
+sub splice { (shift)->SPLICE(@_) }
# This must be last otherwise we have to qualify all other calls to shift
# as calls to CORE::shift
sub SIG_FREE () { 'F' }
sub SIG_SIZE () { 1 }
+use DBM::Deep::Storage::File ();
use DBM::Deep::Iterator ();
use DBM::Deep::Engine::Sector::Data ();
use DBM::Deep::Engine::Sector::BucketList ();
my $class = shift;
my ($args) = @_;
- $args->{storage} = DBM::Deep::File->new( $args )
+ $args->{storage} = DBM::Deep::Storage::File->new( $args )
unless exists $args->{storage};
my $self = bless {
sub _repr { return {} }
sub TIEHASH {
- ##
- # Tied hash constructor method, called by Perl's tie() function.
- ##
my $class = shift;
my $args = $class->_get_args( @_ );
return $self->SUPER::DELETE( $key, $_[0] );
}
+# Locate and return first key (in no particular order)
sub FIRSTKEY {
- ##
- # Locate and return first key (in no particular order)
- ##
my $self = shift->_get_self;
$self->lock_shared;
: $result;
}
+# Return next key (in no particular order), given previous one
sub NEXTKEY {
- ##
- # Return next key (in no particular order), given previous one
- ##
my $self = shift->_get_self;
my $prev_key = ($self->_engine->storage->{filter_store_key})
: $result;
}
-##
-# Public method aliases
-##
sub first_key { (shift)->FIRSTKEY(@_) }
-sub next_key { (shift)->NEXTKEY(@_) }
+sub next_key { (shift)->NEXTKEY(@_) }
sub _copy_node {
my $self = shift;
unless ( @$crumbs ) {
# This will be a Reference sector
my $sector = $e->_load_sector( $self->{base_offset} )
- # If no sector is found, thist must have been deleted from under us.
+ # If no sector is found, this must have been deleted from under us.
or return;
if ( $sector->staleness != $obj->_staleness ) {
-package DBM::Deep::File;
+package DBM::Deep::Storage::File;
use 5.006_000;
=head1 NAME
-DBM::Deep::File
+DBM::Deep::Storage::File
=head1 PURPOSE
=head1 OVERVIEW
-This class provides an abstraction to the storage mechanism so that the Engine (the
-only class that uses this class) doesn't have to worry about that.
+This class provides an abstraction to the storage mechanism so that the Engine
+(the only class that uses this class) doesn't have to worry about that.
=head1 METHODS
This will set the inode value of the underlying file object.
-This is only needed to handle some obscure Win32 bugs. It reqlly shouldn't be needed outside
-this object.
+This is only needed to handle some obscure Win32 bugs. It reqlly shouldn't be
+needed outside this object.
There is no return value.
This takes an optional offset and some data to print.
-C< $offset >, if defined, will be used to seek into the file. If file_offset is set, it will be used
-as the zero location. If it is undefined, no seeking will occur. Then, C< @data > will be printed to
-the current location.
+C< $offset >, if defined, will be used to seek into the file. If file_offset is
+set, it will be used as the zero location. If it is undefined, no seeking will
+occur. Then, C< @data > will be printed to the current location.
There is no return value.
This takes an optional offset and a length.
-C< $offset >, if defined, will be used to seek into the file. If file_offset is set, it will be used
-as the zero location. If it is undefined, no seeking will occur. Then, C< $length > bytes will be
-read from the current location.
+C< $offset >, if defined, will be used to seek into the file. If file_offset is
+set, it will be used as the zero location. If it is undefined, no seeking will
+occur. Then, C< $length > bytes will be read from the current location.
The data read will be returned.
=head2 DESTROY
-When the ::File object goes out of scope, it will be closed.
+When the ::Storage::File object goes out of scope, it will be closed.
=cut
my $after = (stat($filename))[7];
ok( $result, "optimize succeeded" );
-ok( $after < $before, "file size has shrunk" ); # make sure file shrunk
+cmp_ok( $after, '<', $before, "file size has shrunk" ); # make sure file shrunk
is( $db->{key1}, 'value1', "key1's value is still there after optimize" );
is( $db->{a}{c}, 'value2', "key2's value is still there after optimize" );
package # Hide from PAUSE
t::common;
-use 5.006_000;
-
use strict;
-use warnings;
-
-our $VERSION = '0.01';
+use warnings FATAL => 'all';
use base 'Exporter';
our @EXPORT_OK = qw(
my $parent = $ENV{WORK_DIR} || File::Spec->tmpdir;
my $dir = tempdir( CLEANUP => 1, DIR => $parent );
-#my $dir = tempdir( DIR => '.' );
sub new_fh {
my ($fh, $filename) = tempfile( 'tmpXXXX', DIR => $dir, UNLINK => 1 );
my @extra_args = (
[ file => $filename ],
);
+
+# eval { require DBD::SQLite; };
+# unless ( $@ ) {
+# push @extra_args, [
+# ];
+# }
+
+ if ( $ENV{TEST_MYSQL_DSN} ) {
+ push @extra_args, [
+ dbi => {
+ dsn => "dbi:mysql:$ENV{TEST_MYSQL_DSN}",
+ user => $ENV{TEST_MYSQL_USER},
+ password => $ENV{TEST_MYSQL_PASS},
+ },
+ ];
+ }
+
return sub {
return unless @extra_args;
my @these_args = @{ shift @extra_args };
projects / dbsrgits/DBM-Deep.git / commitdiff