Initial Commit

database/perl/vendor/lib/DBM/Deep/Sector/DBI.pm

@@ -0,0 +1,55 @@
+package DBM::Deep::Sector::DBI;
+
+use 5.008_004;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Sector );
+
+use DBM::Deep::Sector::DBI::Reference ();
+use DBM::Deep::Sector::DBI::Scalar ();
+
+sub free {
+    my $self = shift;
+
+    $self->engine->storage->delete_from(
+        $self->table, $self->offset,
+    );
+}
+
+sub reload {
+    my $self = shift;
+    $self->_init;
+}
+
+sub load {
+    my $self = shift;
+    my ($engine, $offset, $type) = @_;
+
+    if ( !defined $type || $type eq 'refs' ) {
+        return DBM::Deep::Sector::DBI::Reference->new({
+            engine => $engine,
+            offset => $offset,
+        });
+    }
+    elsif ( $type eq 'datas' ) {
+        my $sector = DBM::Deep::Sector::DBI::Scalar->new({
+            engine => $engine,
+            offset => $offset,
+        });
+
+        if ( $sector->{data_type} eq 'R' ) {
+            return $self->load(
+                $engine, $sector->{value}, 'refs',
+            );
+        }
+
+        return $sector;
+    }
+
+    DBM::Deep->_throw_error( "'$offset': Don't know what to do with type '$type'" );
+}
+
+1;
+__END__

database/perl/vendor/lib/DBM/Deep/Sector/DBI/Reference.pm

@@ -0,0 +1,238 @@
+package DBM::Deep::Sector::DBI::Reference;
+
+use 5.008_004;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base 'DBM::Deep::Sector::DBI';
+
+use Scalar::Util;
+
+sub table { 'refs' }
+
+sub _init {
+    my $self = shift;
+
+    my $e = $self->engine;
+
+    unless ( $self->offset ) {
+        my $classname = Scalar::Util::blessed( delete $self->{data} );
+        $self->{offset} = $self->engine->storage->write_to(
+            refs => undef,
+            ref_type  => $self->type,
+            classname => $classname,
+        );
+    }
+    else {
+        my ($rows) = $self->engine->storage->read_from(
+            refs => $self->offset,
+            qw( ref_type ),
+        );
+
+        $self->{type} = $rows->[0]{ref_type};
+    }
+
+    return;
+}
+
+sub get_data_for {
+    my $self = shift;
+    my ($args) = @_;
+
+    my ($rows) = $self->engine->storage->read_from(
+        datas => { ref_id => $self->offset, key => $args->{key} },
+        qw( id ),
+    );
+
+    return unless $rows->[0]{id};
+
+    $self->load(
+        $self->engine,
+        $rows->[0]{id},
+        'datas',
+    );
+}
+
+sub write_data {
+    my $self = shift;
+    my ($args) = @_;
+
+    if ( ( $args->{value}->type || 'S' ) eq 'S' ) {
+        $args->{value}{offset} = $self->engine->storage->write_to(
+            datas => $args->{value}{offset},
+            ref_id    => $self->offset,
+            data_type => 'S',
+            key       => $args->{key},
+            value     => $args->{value}{data},
+        );
+
+        $args->{value}->reload;
+    }
+    else {
+        # Write the Scalar of the Reference
+        $self->engine->storage->write_to(
+            datas => undef,
+            ref_id    => $self->offset,
+            data_type => 'R',
+            key       => $args->{key},
+            value     => $args->{value}{offset},
+        );
+    }
+}
+
+sub delete_key {
+    my $self = shift;
+    my ($args) = @_;
+
+    my $old_value = $self->get_data_for({
+        key => $args->{key},
+    });
+
+    my $data;
+    if ( $old_value ) {
+        $data = $old_value->data({ export => 1 });
+
+        $self->engine->storage->delete_from(
+            'datas',
+             { ref_id => $self->offset,
+               key => $args->{key},  },
+        );
+        $old_value->free;
+    }
+
+    return $data;
+}
+
+sub get_classname {
+    my $self = shift;
+    my ($rows) = $self->engine->storage->read_from(
+        'refs', $self->offset,
+        qw( classname ),
+    );
+    return unless @$rows;
+    return $rows->[0]{classname};
+}
+
+# Look to hoist this method into a ::Reference trait
+sub data {
+    my $self = shift;
+    my ($args) = @_;
+    $args ||= {};
+
+    my $engine = $self->engine;
+    my $cache = $engine->cache;
+    my $off = $self->offset;
+    my $obj;
+    if ( !defined $cache->{ $off } ) {
+        $obj = DBM::Deep->new({
+            type        => $self->type,
+            base_offset => $self->offset,
+            storage     => $engine->storage,
+            engine      => $engine,
+        });
+
+        $cache->{$off} = $obj;
+        Scalar::Util::weaken($cache->{$off});
+    }
+    else {
+        $obj = $cache->{$off};
+    }
+
+    # We're not exporting, so just return.
+    unless ( $args->{export} ) {
+        if ( $engine->storage->{autobless} ) {
+            my $classname = $self->get_classname;
+            if ( defined $classname ) {
+                bless $obj, $classname;
+            }
+        }
+
+        return $obj;
+    }
+
+    # We shouldn't export if this is still referred to.
+    if ( $self->get_refcount > 1 ) {
+        return $obj;
+    }
+
+    return $obj->export;
+}
+
+sub free {
+    my $self = shift;
+
+    # We're not ready to be removed yet.
+    return if $self->decrement_refcount > 0;
+
+    # Rebless the object into DBM::Deep::Null.
+    # In external_refs mode, this will already have been removed from
+    # the cache, so we can skip this.
+    my $e  = $self->engine;
+    if(!$e->{external_refs}) {
+        eval { %{ $e->cache->{ $self->offset } } = (); };
+        eval { @{ $e->cache->{ $self->offset } } = (); };
+        bless $e->cache->{ $self->offset }, 'DBM::Deep::Null';
+        delete $e->cache->{ $self->offset };
+    }
+
+    $e->storage->delete_from(
+        'datas', { ref_id => $self->offset },
+    );
+
+    $e->storage->delete_from(
+        'datas', { value => $self->offset, data_type => 'R' },
+    );
+
+    $self->SUPER::free( @_ );
+}
+
+sub increment_refcount {
+    my $self = shift;
+    my $refcount = $self->get_refcount;
+    $refcount++;
+    $self->write_refcount( $refcount );
+    return $refcount;
+}
+
+sub decrement_refcount {
+    my $self = shift;
+    my $refcount = $self->get_refcount;
+    $refcount--;
+    $self->write_refcount( $refcount );
+    return $refcount;
+}
+
+sub get_refcount {
+    my $self = shift;
+    my ($rows) = $self->engine->storage->read_from(
+        'refs', $self->offset,
+        qw( refcount ),
+    );
+    return $rows->[0]{refcount};
+}
+
+sub write_refcount {
+    my $self = shift;
+    my ($num) = @_;
+    $self->engine->storage->{dbh}->do(
+        "UPDATE refs SET refcount = ? WHERE id = ?", undef,
+        $num, $self->offset,
+    );
+}
+
+sub clear {
+    my $self = shift;
+
+    DBM::Deep->new({
+        type        => $self->type,
+        base_offset => $self->offset,
+        storage     => $self->engine->storage,
+        engine      => $self->engine,
+    })->_clear;
+
+    return;
+}
+
+1;
+__END__

database/perl/vendor/lib/DBM/Deep/Sector/DBI/Scalar.pm

@@ -0,0 +1,31 @@
+package DBM::Deep::Sector::DBI::Scalar;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Sector::DBI );
+
+sub table { 'datas' }
+
+sub _init {
+    my $self = shift;
+
+    if ( $self->offset ) {
+        my ($rows) = $self->engine->storage->read_from(
+            datas => $self->offset,
+            qw( id data_type key value ),
+        );
+
+        $self->{$_} = $rows->[0]{$_} for qw( data_type key value );
+    }
+
+    return;
+}
+
+sub data {
+    my $self = shift;
+    $self->{value};
+}
+
+1;
+__END__

database/perl/vendor/lib/DBM/Deep/Sector/File.pm

@@ -0,0 +1,104 @@
+package DBM::Deep::Sector::File;
+
+use 5.008_004;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Sector );
+
+use DBM::Deep::Sector::File::BucketList ();
+use DBM::Deep::Sector::File::Index ();
+use DBM::Deep::Sector::File::Null ();
+use DBM::Deep::Sector::File::Reference ();
+use DBM::Deep::Sector::File::Scalar ();
+
+my $STALE_SIZE = 2;
+
+sub base_size {
+    my $self = shift;
+    return $self->engine->SIG_SIZE + $STALE_SIZE;
+}
+
+sub free_meth { die "free_meth must be implemented in a child class" }
+
+sub free {
+    my $self = shift;
+
+    my $e = $self->engine;
+
+    $e->storage->print_at( $self->offset, $e->SIG_FREE );
+    # Skip staleness counter
+    $e->storage->print_at( $self->offset + $self->base_size,
+        chr(0) x ($self->size - $self->base_size),
+    );
+
+    my $free_meth = $self->free_meth;
+    $e->$free_meth( $self->offset, $self->size );
+
+    return;
+}
+
+#=head2 load( $offset )
+#
+#This will instantiate and return the sector object that represents the data
+#found at $offset.
+#
+#=cut
+
+sub load {
+    my $self = shift;
+    my ($engine, $offset) = @_;
+
+    # Add a catch for offset of 0 or 1
+    return if !$offset || $offset <= 1;
+
+    my $type = $engine->storage->read_at( $offset, 1 );
+    return if $type eq chr(0);
+
+    if ( $type eq $engine->SIG_ARRAY || $type eq $engine->SIG_HASH ) {
+        return DBM::Deep::Sector::File::Reference->new({
+            engine => $engine,
+            type   => $type,
+            offset => $offset,
+        });
+    }
+    # XXX Don't we need key_md5 here?
+    elsif ( $type eq $engine->SIG_BLIST ) {
+        return DBM::Deep::Sector::File::BucketList->new({
+            engine => $engine,
+            type   => $type,
+            offset => $offset,
+        });
+    }
+    elsif ( $type eq $engine->SIG_INDEX ) {
+        return DBM::Deep::Sector::File::Index->new({
+            engine => $engine,
+            type   => $type,
+            offset => $offset,
+        });
+    }
+    elsif ( $type eq $engine->SIG_NULL ) {
+        return DBM::Deep::Sector::File::Null->new({
+            engine => $engine,
+            type   => $type,
+            offset => $offset,
+        });
+    }
+    elsif ( $type eq $engine->SIG_DATA || $type eq $engine->SIG_UNIDATA ) {
+        return DBM::Deep::Sector::File::Scalar->new({
+            engine => $engine,
+            type   => $type,
+            offset => $offset,
+        });
+    }
+    # This was deleted from under us, so just return and let the caller figure it out.
+    elsif ( $type eq $engine->SIG_FREE ) {
+        return;
+    }
+
+    DBM::Deep->_throw_error( "'$offset': Don't know what to do with type '$type'" );
+}
+
+1;
+__END__

database/perl/vendor/lib/DBM/Deep/Sector/File/BucketList.pm

@@ -0,0 +1,376 @@
+package DBM::Deep::Sector::File::BucketList;
+
+use 5.008_004;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Sector::File );
+
+my $STALE_SIZE = 2;
+
+# Please refer to the pack() documentation for further information
+my %StP = (
+    1 => 'C', # Unsigned char value (no order needed as it's just one byte)
+    2 => 'n', # Unsigned short in "network" (big-endian) order
+    4 => 'N', # Unsigned long in "network" (big-endian) order
+    8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
+);
+
+sub _init {
+    my $self = shift;
+
+    my $engine = $self->engine;
+
+    unless ( $self->offset ) {
+        my $leftover = $self->size - $self->base_size;
+
+        $self->{offset} = $engine->_request_blist_sector( $self->size );
+        $engine->storage->print_at( $self->offset, $engine->SIG_BLIST ); # Sector type
+        # Skip staleness counter
+        $engine->storage->print_at( $self->offset + $self->base_size,
+            chr(0) x $leftover, # Zero-fill the data
+        );
+    }
+
+    if ( $self->{key_md5} ) {
+        $self->find_md5;
+    }
+
+    return $self;
+}
+
+sub wipe {
+    my $self = shift;
+    $self->engine->storage->print_at( $self->offset + $self->base_size,
+        chr(0) x ($self->size - $self->base_size), # Zero-fill the data
+    );
+}
+
+sub size {
+    my $self = shift;
+    unless ( $self->{size} ) {
+        my $e = $self->engine;
+        # Base + numbuckets * bucketsize
+        $self->{size} = $self->base_size + $e->max_buckets * $self->bucket_size;
+    }
+    return $self->{size};
+}
+
+sub free_meth { '_add_free_blist_sector' }
+
+sub free {
+    my $self = shift;
+
+    my $e = $self->engine;
+    foreach my $bucket ( $self->chopped_up ) {
+        my $rest = $bucket->[-1];
+
+        # Delete the keysector
+        my $l = unpack( $StP{$e->byte_size}, substr( $rest, $e->hash_size, $e->byte_size ) );
+        my $s = $e->load_sector( $l ); $s->free if $s;
+
+        # Delete the HEAD sector
+        $l = unpack( $StP{$e->byte_size},
+            substr( $rest,
+                $e->hash_size + $e->byte_size,
+                $e->byte_size,
+            ),
+        );
+        $s = $e->load_sector( $l ); $s->free if $s;
+
+        foreach my $txn ( 0 .. $e->num_txns - 2 ) {
+            my $l = unpack( $StP{$e->byte_size},
+                substr( $rest,
+                    $e->hash_size + 2 * $e->byte_size + $txn * ($e->byte_size + $STALE_SIZE),
+                    $e->byte_size,
+                ),
+            );
+            my $s = $e->load_sector( $l ); $s->free if $s;
+        }
+    }
+
+    $self->SUPER::free();
+}
+
+sub bucket_size {
+    my $self = shift;
+    unless ( $self->{bucket_size} ) {
+        my $e = $self->engine;
+        # Key + head (location) + transactions (location + staleness-counter)
+        my $location_size = $e->byte_size + $e->byte_size + ($e->num_txns - 1) * ($e->byte_size + $STALE_SIZE);
+        $self->{bucket_size} = $e->hash_size + $location_size;
+    }
+    return $self->{bucket_size};
+}
+
+# XXX This is such a poor hack. I need to rethink this code.
+sub chopped_up {
+    my $self = shift;
+
+    my $e = $self->engine;
+
+    my @buckets;
+    foreach my $idx ( 0 .. $e->max_buckets - 1 ) {
+        my $spot = $self->offset + $self->base_size + $idx * $self->bucket_size;
+        my $md5 = $e->storage->read_at( $spot, $e->hash_size );
+
+        #XXX If we're chopping, why would we ever have the blank_md5?
+        last if $md5 eq $e->blank_md5;
+
+        my $rest = $e->storage->read_at( undef, $self->bucket_size - $e->hash_size );
+        push @buckets, [ $spot, $md5 . $rest ];
+    }
+
+    return @buckets;
+}
+
+sub write_at_next_open {
+    my $self = shift;
+    my ($entry) = @_;
+
+    #XXX This is such a hack!
+    $self->{_next_open} = 0 unless exists $self->{_next_open};
+
+    my $spot = $self->offset + $self->base_size + $self->{_next_open}++ * $self->bucket_size;
+    $self->engine->storage->print_at( $spot, $entry );
+
+    return $spot;
+}
+
+sub has_md5 {
+    my $self = shift;
+    unless ( exists $self->{found} ) {
+        $self->find_md5;
+    }
+    return $self->{found};
+}
+
+sub find_md5 {
+    my $self = shift;
+
+    $self->{found} = undef;
+    $self->{idx}   = -1;
+
+    if ( @_ ) {
+        $self->{key_md5} = shift;
+    }
+
+    # If we don't have an MD5, then what are we supposed to do?
+    unless ( exists $self->{key_md5} ) {
+        DBM::Deep->_throw_error( "Cannot find_md5 without a key_md5 set" );
+    }
+
+    my $e = $self->engine;
+    foreach my $idx ( 0 .. $e->max_buckets - 1 ) {
+        my $potential = $e->storage->read_at(
+            $self->offset + $self->base_size + $idx * $self->bucket_size, $e->hash_size,
+        );
+
+        if ( $potential eq $e->blank_md5 ) {
+            $self->{idx} = $idx;
+            return;
+        }
+
+        if ( $potential eq $self->{key_md5} ) {
+            $self->{found} = 1;
+            $self->{idx} = $idx;
+            return;
+        }
+    }
+
+    return;
+}
+
+sub write_md5 {
+    my $self = shift;
+    my ($args) = @_;
+
+    DBM::Deep->_throw_error( "write_md5: no key" ) unless exists $args->{key};
+    DBM::Deep->_throw_error( "write_md5: no key_md5" ) unless exists $args->{key_md5};
+    DBM::Deep->_throw_error( "write_md5: no value" ) unless exists $args->{value};
+
+    my $engine = $self->engine;
+
+    $args->{trans_id} = $engine->trans_id unless exists $args->{trans_id};
+
+    my $spot = $self->offset + $self->base_size + $self->{idx} * $self->bucket_size;
+    $engine->add_entry( $args->{trans_id}, $spot );
+
+    unless ($self->{found}) {
+        my $key_sector = DBM::Deep::Sector::File::Scalar->new({
+            engine => $engine,
+            data   => $args->{key},
+        });
+
+        $engine->storage->print_at( $spot,
+            $args->{key_md5},
+            pack( $StP{$engine->byte_size}, $key_sector->offset ),
+        );
+    }
+
+    my $loc = $spot
+      + $engine->hash_size
+      + $engine->byte_size;
+
+    if ( $args->{trans_id} ) {
+        $loc += $engine->byte_size + ($args->{trans_id} - 1) * ( $engine->byte_size + $STALE_SIZE );
+
+        $engine->storage->print_at( $loc,
+            pack( $StP{$engine->byte_size}, $args->{value}->offset ),
+            pack( $StP{$STALE_SIZE}, $engine->get_txn_staleness_counter( $args->{trans_id} ) ),
+        );
+    }
+    else {
+        $engine->storage->print_at( $loc,
+            pack( $StP{$engine->byte_size}, $args->{value}->offset ),
+        );
+    }
+}
+
+sub mark_deleted {
+    my $self = shift;
+    my ($args) = @_;
+    $args ||= {};
+
+    my $engine = $self->engine;
+
+    $args->{trans_id} = $engine->trans_id unless exists $args->{trans_id};
+
+    my $spot = $self->offset + $self->base_size + $self->{idx} * $self->bucket_size;
+    $engine->add_entry( $args->{trans_id}, $spot );
+
+    my $loc = $spot
+      + $engine->hash_size
+      + $engine->byte_size;
+
+    if ( $args->{trans_id} ) {
+        $loc += $engine->byte_size + ($args->{trans_id} - 1) * ( $engine->byte_size + $STALE_SIZE );
+
+        $engine->storage->print_at( $loc,
+            pack( $StP{$engine->byte_size}, 1 ), # 1 is the marker for deleted
+            pack( $StP{$STALE_SIZE}, $engine->get_txn_staleness_counter( $args->{trans_id} ) ),
+        );
+    }
+    else {
+        $engine->storage->print_at( $loc,
+            pack( $StP{$engine->byte_size}, 1 ), # 1 is the marker for deleted
+        );
+    }
+}
+
+sub delete_md5 {
+    my $self = shift;
+    my ($args) = @_;
+
+    my $engine = $self->engine;
+    return undef unless $self->{found};
+
+    # Save the location so that we can free the data
+    my $location = $self->get_data_location_for({
+        allow_head => 0,
+    });
+    my $key_sector = $self->get_key_for;
+
+    my $spot = $self->offset + $self->base_size + $self->{idx} * $self->bucket_size;
+    $engine->storage->print_at( $spot,
+        $engine->storage->read_at(
+            $spot + $self->bucket_size,
+            $self->bucket_size * ( $engine->max_buckets - $self->{idx} - 1 ),
+        ),
+        chr(0) x $self->bucket_size,
+    );
+
+    $key_sector->free;
+
+    my $data_sector = $self->engine->load_sector( $location );
+    my $data = $data_sector->data({ export => 1 });
+    $data_sector->free;
+
+    return $data;
+}
+
+sub get_data_location_for {
+    my $self = shift;
+    my ($args) = @_;
+    $args ||= {};
+
+    $args->{allow_head} = 0 unless exists $args->{allow_head};
+    $args->{trans_id}   = $self->engine->trans_id unless exists $args->{trans_id};
+    $args->{idx}        = $self->{idx} unless exists $args->{idx};
+
+    my $e = $self->engine;
+
+    my $spot = $self->offset + $self->base_size
+      + $args->{idx} * $self->bucket_size
+      + $e->hash_size
+      + $e->byte_size;
+
+    if ( $args->{trans_id} ) {
+        $spot += $e->byte_size + ($args->{trans_id} - 1) * ( $e->byte_size + $STALE_SIZE );
+    }
+
+    my $buffer = $e->storage->read_at(
+        $spot,
+        $e->byte_size + $STALE_SIZE,
+    );
+    my ($loc, $staleness) = unpack( $StP{$e->byte_size} . ' ' . $StP{$STALE_SIZE}, $buffer );
+
+    # XXX Merge the two if-clauses below
+    if ( $args->{trans_id} ) {
+        # We have found an entry that is old, so get rid of it
+        if ( $staleness != (my $s = $e->get_txn_staleness_counter( $args->{trans_id} ) ) ) {
+            $e->storage->print_at(
+                $spot,
+                pack( $StP{$e->byte_size} . ' ' . $StP{$STALE_SIZE}, (0) x 2 ), 
+            );
+            $loc = 0;
+        }
+    }
+
+    # If we're in a transaction and we never wrote to this location, try the
+    # HEAD instead.
+    if ( $args->{trans_id} && !$loc && $args->{allow_head} ) {
+        return $self->get_data_location_for({
+            trans_id   => 0,
+            allow_head => 1,
+            idx        => $args->{idx},
+        });
+    }
+
+    return $loc <= 1 ? 0 : $loc;
+}
+
+sub get_data_for {
+    my $self = shift;
+    my ($args) = @_;
+    $args ||= {};
+
+    return unless $self->{found};
+    my $location = $self->get_data_location_for({
+        allow_head => $args->{allow_head},
+    });
+    return $self->engine->load_sector( $location );
+}
+
+sub get_key_for {
+    my $self = shift;
+    my ($idx) = @_;
+    $idx = $self->{idx} unless defined $idx;
+
+    if ( $idx >= $self->engine->max_buckets ) {
+        DBM::Deep->_throw_error( "get_key_for(): Attempting to retrieve $idx" );
+    }
+
+    my $location = $self->engine->storage->read_at(
+        $self->offset + $self->base_size + $idx * $self->bucket_size + $self->engine->hash_size,
+        $self->engine->byte_size,
+    );
+    $location = unpack( $StP{$self->engine->byte_size}, $location );
+    DBM::Deep->_throw_error( "get_key_for: No location?" ) unless $location;
+
+    return $self->engine->load_sector( $location );
+}
+
+1;
+__END__

database/perl/vendor/lib/DBM/Deep/Sector/File/Data.pm

@@ -0,0 +1,15 @@
+package DBM::Deep::Sector::File::Data;
+
+use 5.008_004;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Sector::File );
+
+# This is in bytes
+sub size { $_[0]{engine}->data_sector_size }
+sub free_meth { return '_add_free_data_sector' }
+
+1;
+__END__

database/perl/vendor/lib/DBM/Deep/Sector/File/Index.pm

@@ -0,0 +1,98 @@
+package DBM::Deep::Sector::File::Index;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Sector::File );
+
+my $STALE_SIZE = 2;
+
+# Please refer to the pack() documentation for further information
+my %StP = (
+    1 => 'C', # Unsigned char value (no order needed as it's just one byte)
+    2 => 'n', # Unsigned short in "network" (big-endian) order
+    4 => 'N', # Unsigned long in "network" (big-endian) order
+    8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
+);
+
+sub _init {
+    my $self = shift;
+
+    my $engine = $self->engine;
+
+    unless ( $self->offset ) {
+        my $leftover = $self->size - $self->base_size;
+
+        $self->{offset} = $engine->_request_index_sector( $self->size );
+        $engine->storage->print_at( $self->offset, $engine->SIG_INDEX ); # Sector type
+        # Skip staleness counter
+        $engine->storage->print_at( $self->offset + $self->base_size,
+            chr(0) x $leftover, # Zero-fill the rest
+        );
+    }
+
+    return $self;
+}
+
+#XXX Change here
+sub size {
+    my $self = shift;
+    unless ( $self->{size} ) {
+        my $e = $self->engine;
+        $self->{size} = $self->base_size + $e->byte_size * $e->hash_chars;
+    }
+    return $self->{size};
+}
+
+sub free_meth { return '_add_free_index_sector' }
+
+sub free {
+    my $self = shift;
+    my $e = $self->engine;
+
+    for my $i ( 0 .. $e->hash_chars - 1 ) {
+        my $l = $self->get_entry( $i ) or next;
+        $e->load_sector( $l )->free;
+    }
+
+    $self->SUPER::free();
+}
+
+sub _loc_for {
+    my $self = shift;
+    my ($idx) = @_;
+    return $self->offset + $self->base_size + $idx * $self->engine->byte_size;
+}
+
+sub get_entry {
+    my $self = shift;
+    my ($idx) = @_;
+
+    my $e = $self->engine;
+
+    DBM::Deep->_throw_error( "get_entry: Out of range ($idx)" )
+        if $idx < 0 || $idx >= $e->hash_chars;
+
+    return unpack(
+        $StP{$e->byte_size},
+        $e->storage->read_at( $self->_loc_for( $idx ), $e->byte_size ),
+    );
+}
+
+sub set_entry {
+    my $self = shift;
+    my ($idx, $loc) = @_;
+
+    my $e = $self->engine;
+
+    DBM::Deep->_throw_error( "set_entry: Out of range ($idx)" )
+        if $idx < 0 || $idx >= $e->hash_chars;
+
+    $self->engine->storage->print_at(
+        $self->_loc_for( $idx ),
+        pack( $StP{$e->byte_size}, $loc ),
+    );
+}
+
+1;
+__END__

database/perl/vendor/lib/DBM/Deep/Sector/File/Null.pm

@@ -0,0 +1,46 @@
+package DBM::Deep::Sector::File::Null;
+
+use 5.008_004;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Sector::File::Data );
+
+my $STALE_SIZE = 2;
+
+# Please refer to the pack() documentation for further information
+my %StP = (
+    1 => 'C', # Unsigned char value (no order needed as it's just one byte)
+    2 => 'n', # Unsigned short in "network" (big-endian) order
+    4 => 'N', # Unsigned long in "network" (big-endian) order
+    8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
+);
+
+sub type { $_[0]{engine}->SIG_NULL }
+sub data_length { 0 }
+sub data { return }
+
+sub _init {
+    my $self = shift;
+
+    my $engine = $self->engine;
+
+    unless ( $self->offset ) {
+        my $leftover = $self->size - $self->base_size - 1 * $engine->byte_size - 1;
+
+        $self->{offset} = $engine->_request_data_sector( $self->size );
+        $engine->storage->print_at( $self->offset, $self->type ); # Sector type
+        # Skip staleness counter
+        $engine->storage->print_at( $self->offset + $self->base_size,
+            pack( $StP{$engine->byte_size}, 0 ),  # Chain loc
+            pack( $StP{1}, $self->data_length ),  # Data length
+            chr(0) x $leftover,                   # Zero-fill the rest
+        );
+
+        return;
+    }
+}
+
+1;
+__END__

database/perl/vendor/lib/DBM/Deep/Sector/File/Reference.pm

@@ -0,0 +1,564 @@
+package DBM::Deep::Sector::File::Reference;
+
+use 5.008_004;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Sector::File::Data );
+
+use Scalar::Util;
+
+my $STALE_SIZE = 2;
+
+# Please refer to the pack() documentation for further information
+my %StP = (
+    1 => 'C', # Unsigned char value (no order needed as it's just one byte)
+    2 => 'n', # Unsigned short in "network" (big-endian) order
+    4 => 'N', # Unsigned long in "network" (big-endian) order
+    8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
+);
+
+sub _init {
+    my $self = shift;
+
+    my $e = $self->engine;
+
+    unless ( $self->offset ) {
+        my $classname = Scalar::Util::blessed( delete $self->{data} );
+        my $leftover = $self->size - $self->base_size - 3 * $e->byte_size;
+
+        my $class_offset = 0;
+        if ( defined $classname ) {
+            my $class_sector = DBM::Deep::Sector::File::Scalar->new({
+                engine => $e,
+                data   => $classname,
+            });
+            $class_offset = $class_sector->offset;
+        }
+
+        $self->{offset} = $e->_request_data_sector( $self->size );
+        $e->storage->print_at( $self->offset, $self->type ); # Sector type
+        # Skip staleness counter
+        $e->storage->print_at( $self->offset + $self->base_size,
+            pack( $StP{$e->byte_size}, 0 ),             # Index/BList loc
+            pack( $StP{$e->byte_size}, $class_offset ), # Classname loc
+            pack( $StP{$e->byte_size}, 1 ),             # Initial refcount
+            chr(0) x $leftover,                         # Zero-fill the rest
+        );
+    }
+    else {
+        $self->{type} = $e->storage->read_at( $self->offset, 1 );
+    }
+
+    $self->{staleness} = unpack(
+        $StP{$STALE_SIZE},
+        $e->storage->read_at( $self->offset + $e->SIG_SIZE, $STALE_SIZE ),
+    );
+
+    return;
+}
+
+sub get_data_location_for {
+    my $self = shift;
+    my ($args) = @_;
+
+    # Assume that the head is not allowed unless otherwise specified.
+    $args->{allow_head} = 0 unless exists $args->{allow_head};
+
+    # Assume we don't create a new blist location unless otherwise specified.
+    $args->{create} = 0 unless exists $args->{create};
+
+    my $blist = $self->get_bucket_list({
+        key_md5 => $args->{key_md5},
+        key => $args->{key},
+        create  => $args->{create},
+    });
+    return unless $blist && $blist->{found};
+
+    # At this point, $blist knows where the md5 is. What it -doesn't- know yet
+    # is whether or not this transaction has this key. That's part of the next
+    # function call.
+    my $location = $blist->get_data_location_for({
+        allow_head => $args->{allow_head},
+    }) or return;
+
+    return $location;
+}
+
+sub get_data_for {
+    my $self = shift;
+    my ($args) = @_;
+
+    my $location = $self->get_data_location_for( $args )
+        or return;
+
+    return $self->engine->load_sector( $location );
+}
+
+sub write_data {
+    my $self = shift;
+    my ($args) = @_;
+
+    my $blist = $self->get_bucket_list({
+        key_md5 => $args->{key_md5},
+        key => $args->{key},
+        create  => 1,
+    }) or DBM::Deep->_throw_error( "How did write_data fail (no blist)?!" );
+
+    # Handle any transactional bookkeeping.
+    if ( $self->engine->trans_id ) {
+        if ( ! $blist->has_md5 ) {
+            $blist->mark_deleted({
+                trans_id => 0,
+            });
+        }
+    }
+    else {
+        my @trans_ids = $self->engine->get_running_txn_ids;
+        if ( $blist->has_md5 ) {
+            if ( @trans_ids ) {
+                my $old_value = $blist->get_data_for;
+                foreach my $other_trans_id ( @trans_ids ) {
+                    next if $blist->get_data_location_for({
+                        trans_id   => $other_trans_id,
+                        allow_head => 0,
+                    });
+                    $blist->write_md5({
+                        trans_id => $other_trans_id,
+                        key      => $args->{key},
+                        key_md5  => $args->{key_md5},
+                        value    => $old_value->clone,
+                    });
+                }
+            }
+        }
+        else {
+            if ( @trans_ids ) {
+                foreach my $other_trans_id ( @trans_ids ) {
+                    #XXX This doesn't seem to possible to ever happen . . .
+                    next if $blist->get_data_location_for({ trans_id => $other_trans_id, allow_head => 0 });
+                    $blist->mark_deleted({
+                        trans_id => $other_trans_id,
+                    });
+                }
+            }
+        }
+    }
+
+    #XXX Is this safe to do transactionally?
+    # Free the place we're about to write to.
+    if ( $blist->get_data_location_for({ allow_head => 0 }) ) {
+        $blist->get_data_for({ allow_head => 0 })->free;
+    }
+
+    $blist->write_md5({
+        key      => $args->{key},
+        key_md5  => $args->{key_md5},
+        value    => $args->{value},
+    });
+}
+
+sub delete_key {
+    my $self = shift;
+    my ($args) = @_;
+
+    # This can return nothing if we are deleting an entry in a hashref that was
+    # auto-vivified as part of the delete process. For example:
+    #     my $x = {};
+    #     delete $x->{foo}{bar};
+    my $blist = $self->get_bucket_list({
+        key_md5 => $args->{key_md5},
+    }) or return;
+
+    # Save the location so that we can free the data
+    my $location = $blist->get_data_location_for({
+        allow_head => 0,
+    });
+    my $old_value = $location && $self->engine->load_sector( $location );
+
+    my @trans_ids = $self->engine->get_running_txn_ids;
+
+    # If we're the HEAD and there are running txns, then we need to clone this
+    # value to the other transactions to preserve Isolation.
+    if ( $self->engine->trans_id == 0 ) {
+        if ( @trans_ids ) {
+            foreach my $other_trans_id ( @trans_ids ) {
+                next if $blist->get_data_location_for({ trans_id => $other_trans_id, allow_head => 0 });
+                $blist->write_md5({
+                    trans_id => $other_trans_id,
+                    key      => $args->{key},
+                    key_md5  => $args->{key_md5},
+                    value    => $old_value->clone,
+                });
+            }
+        }
+    }
+
+    my $data;
+    if ( @trans_ids ) {
+        $blist->mark_deleted( $args );
+
+        if ( $old_value ) {
+            #XXX Is this export => 1 actually doing anything?
+            $data = $old_value->data({ export => 1 });
+            $old_value->free;
+        }
+    }
+    else {
+        $data = $blist->delete_md5( $args );
+    }
+
+    return $data;
+}
+
+sub write_blist_loc {
+    my $self = shift;
+    my ($loc) = @_;
+
+    my $engine = $self->engine;
+    $engine->storage->print_at( $self->offset + $self->base_size,
+        pack( $StP{$engine->byte_size}, $loc ),
+    );
+}
+
+sub get_blist_loc {
+    my $self = shift;
+
+    my $e = $self->engine;
+    my $blist_loc = $e->storage->read_at( $self->offset + $self->base_size, $e->byte_size );
+    return unpack( $StP{$e->byte_size}, $blist_loc );
+}
+
+sub get_bucket_list {
+    my $self = shift;
+    my ($args) = @_;
+    $args ||= {};
+
+    # XXX Add in check here for recycling?
+
+    my $engine = $self->engine;
+
+    my $blist_loc = $self->get_blist_loc;
+
+    # There's no index or blist yet
+    unless ( $blist_loc ) {
+        return unless $args->{create};
+
+        my $blist = DBM::Deep::Sector::File::BucketList->new({
+            engine  => $engine,
+            key_md5 => $args->{key_md5},
+        });
+
+        $self->write_blist_loc( $blist->offset );
+#        $engine->storage->print_at( $self->offset + $self->base_size,
+#            pack( $StP{$engine->byte_size}, $blist->offset ),
+#        );
+
+        return $blist;
+    }
+
+    my $sector = $engine->load_sector( $blist_loc )
+        or DBM::Deep->_throw_error( "Cannot read sector at $blist_loc in get_bucket_list()" );
+    my $i = 0;
+    my $last_sector = undef;
+    while ( $sector->isa( 'DBM::Deep::Sector::File::Index' ) ) {
+        $blist_loc = $sector->get_entry( ord( substr( $args->{key_md5}, $i++, 1 ) ) );
+        $last_sector = $sector;
+        if ( $blist_loc ) {
+            $sector = $engine->load_sector( $blist_loc )
+                or DBM::Deep->_throw_error( "Cannot read sector at $blist_loc in get_bucket_list()" );
+        }
+        else {
+            $sector = undef;
+            last;
+        }
+    }
+
+    # This means we went through the Index sector(s) and found an empty slot
+    unless ( $sector ) {
+        return unless $args->{create};
+
+        DBM::Deep->_throw_error( "No last_sector when attempting to build a new entry" )
+            unless $last_sector;
+
+        my $blist = DBM::Deep::Sector::File::BucketList->new({
+            engine  => $engine,
+            key_md5 => $args->{key_md5},
+        });
+
+        $last_sector->set_entry( ord( substr( $args->{key_md5}, $i - 1, 1 ) ) => $blist->offset );
+
+        return $blist;
+    }
+
+    $sector->find_md5( $args->{key_md5} );
+
+    # See whether or not we need to reindex the bucketlist
+    # Yes, the double-braces are there for a reason. if() doesn't create a
+    # redo-able block, so we have to create a bare block within the if() for
+    # redo-purposes.
+    # Patch and idea submitted by sprout@cpan.org. -RobK, 2008-01-09
+    if ( !$sector->has_md5 && $args->{create} && $sector->{idx} == -1 ) {{
+        my $redo;
+
+        my $new_index = DBM::Deep::Sector::File::Index->new({
+            engine => $engine,
+        });
+
+        my %blist_cache;
+        #XXX q.v. the comments for this function.
+        foreach my $entry ( $sector->chopped_up ) {
+            my ($spot, $md5) = @{$entry};
+            my $idx = ord( substr( $md5, $i, 1 ) );
+
+            # XXX This is inefficient
+            my $blist = $blist_cache{$idx}
+                ||= DBM::Deep::Sector::File::BucketList->new({
+                    engine => $engine,
+                });
+
+            $new_index->set_entry( $idx => $blist->offset );
+
+            my $new_spot = $blist->write_at_next_open( $md5 );
+            $engine->reindex_entry( $spot => $new_spot );
+        }
+
+        # Handle the new item separately.
+        {
+            my $idx = ord( substr( $args->{key_md5}, $i, 1 ) );
+
+            # If all the previous blist's items have been thrown into one
+            # blist and the new item belongs in there too, we need
+            # another index.
+            if ( keys %blist_cache == 1 and each %blist_cache == $idx ) {
+                ++$i, ++$redo;
+            } else {
+                my $blist = $blist_cache{$idx}
+                    ||= DBM::Deep::Sector::File::BucketList->new({
+                        engine => $engine,
+                    });
+    
+                $new_index->set_entry( $idx => $blist->offset );
+    
+                #XXX THIS IS HACKY!
+                $blist->find_md5( $args->{key_md5} );
+                $blist->write_md5({
+                    key     => $args->{key},
+                    key_md5 => $args->{key_md5},
+                    value   => DBM::Deep::Sector::File::Null->new({
+                        engine => $engine,
+                        data   => undef,
+                    }),
+                });
+            }
+        }
+
+        if ( $last_sector ) {
+            $last_sector->set_entry(
+                ord( substr( $args->{key_md5}, $i - 1, 1 ) ),
+                $new_index->offset,
+            );
+        } else {
+            $engine->storage->print_at( $self->offset + $self->base_size,
+                pack( $StP{$engine->byte_size}, $new_index->offset ),
+            );
+        }
+
+        $sector->wipe;
+        $sector->free;
+
+        if ( $redo ) {
+            (undef, $sector) = %blist_cache;
+            $last_sector = $new_index;
+            redo;
+        }
+
+        $sector = $blist_cache{ ord( substr( $args->{key_md5}, $i, 1 ) ) };
+        $sector->find_md5( $args->{key_md5} );
+    }}
+
+    return $sector;
+}
+
+sub get_class_offset {
+    my $self = shift;
+
+    my $e = $self->engine;
+    return unpack(
+        $StP{$e->byte_size},
+        $e->storage->read_at(
+            $self->offset + $self->base_size + 1 * $e->byte_size, $e->byte_size,
+        ),
+    );
+}
+
+sub get_classname {
+    my $self = shift;
+
+    my $class_offset = $self->get_class_offset;
+
+    return unless $class_offset;
+
+    return $self->engine->load_sector( $class_offset )->data;
+}
+
+# Look to hoist this method into a ::Reference trait
+sub data {
+    my $self = shift;
+    my ($args) = @_;
+    $args ||= {};
+
+    my $engine = $self->engine;
+    my $cache_entry = $engine->cache->{ $self->offset } ||= {};
+    my $trans_id = $engine->trans_id;
+    my $obj;
+    if ( !defined $$cache_entry{ $trans_id } ) {
+        $obj = DBM::Deep->new({
+            type        => $self->type,
+            base_offset => $self->offset,
+            staleness   => $self->staleness,
+            storage     => $engine->storage,
+            engine      => $engine,
+        });
+
+        $$cache_entry{ $trans_id } = $obj;
+        Scalar::Util::weaken($$cache_entry{ $trans_id });
+    }
+    else {
+        $obj = $$cache_entry{ $trans_id };
+    }
+
+    # We're not exporting, so just return.
+    unless ( $args->{export} ) {
+        if ( $engine->storage->{autobless} ) {
+            my $classname = $self->get_classname;
+            if ( defined $classname ) {
+                bless $obj, $classname;
+            }
+        }
+
+        return $obj;
+    }
+
+    # We shouldn't export if this is still referred to.
+    if ( $self->get_refcount > 1 ) {
+        return $obj;
+    }
+
+    return $obj->export;
+}
+
+sub free {
+    my $self = shift;
+
+    # We're not ready to be removed yet.
+    return if $self->decrement_refcount > 0;
+
+    my $e = $self->engine;
+
+    # Rebless the object into DBM::Deep::Null.
+    # In external_refs mode, this will already have been removed from
+    # the cache, so we can skip this.
+    if(!$e->{external_refs}) {
+#    eval { %{ $e->cache->{ $self->offset }{ $e->trans_id } } = (); };
+#    eval { @{ $e->cache->{ $self->offset }{ $e->trans_id } } = (); };
+      my $cache = $e->cache;
+      my $off = $self->offset;
+      if(  exists $cache->{ $off }
+       and exists $cache->{ $off }{ my $trans_id = $e->trans_id } ) {
+        bless $cache->{ $off }{ $trans_id }, 'DBM::Deep::Null'
+         if defined $cache->{ $off }{ $trans_id };
+        delete $cache->{ $off }{ $trans_id };
+      }
+    }
+
+    my $blist_loc = $self->get_blist_loc;
+    $e->load_sector( $blist_loc )->free if $blist_loc;
+
+    my $class_loc = $self->get_class_offset;
+    $e->load_sector( $class_loc )->free if $class_loc;
+
+    $self->SUPER::free();
+}
+
+sub increment_refcount {
+    my $self = shift;
+
+    my $refcount = $self->get_refcount;
+
+    $refcount++;
+
+    $self->write_refcount( $refcount );
+
+    return $refcount;
+}
+
+sub decrement_refcount {
+    my $self = shift;
+
+    my $refcount = $self->get_refcount;
+
+    $refcount--;
+
+    $self->write_refcount( $refcount );
+
+    return $refcount;
+}
+
+sub get_refcount {
+    my $self = shift;
+
+    my $e = $self->engine;
+    return unpack(
+        $StP{$e->byte_size},
+        $e->storage->read_at(
+            $self->offset + $self->base_size + 2 * $e->byte_size, $e->byte_size,
+        ),
+    );
+}
+
+sub write_refcount {
+    my $self = shift;
+    my ($num) = @_;
+
+    my $e = $self->engine;
+    $e->storage->print_at(
+        $self->offset + $self->base_size + 2 * $e->byte_size,
+        pack( $StP{$e->byte_size}, $num ),
+    );
+}
+
+sub clear {
+    my $self = shift;
+
+    my $blist_loc = $self->get_blist_loc or return;
+
+    my $engine = $self->engine;
+
+    # This won't work with autoblessed items.
+    if ($engine->get_running_txn_ids) {
+        # ~~~ Temporary; the code below this block needs to be modified to
+        #     take transactions into account.
+        $self->data->_get_self->_clear;
+        return;
+    }
+
+    my $sector = $engine->load_sector( $blist_loc )
+        or DBM::Deep->_throw_error(
+           "Cannot read sector at $blist_loc in clear()"
+        );
+
+    # Set blist offset to 0
+    $engine->storage->print_at( $self->offset + $self->base_size,
+        pack( $StP{$engine->byte_size}, 0 ),
+    );
+
+    # Free the blist
+    $sector->free;
+
+    return;
+}
+
+1;
+__END__

database/perl/vendor/lib/DBM/Deep/Sector/File/Scalar.pm

@@ -0,0 +1,143 @@
+package DBM::Deep::Sector::File::Scalar;
+
+use 5.008_004;
+
+use strict;
+use warnings FATAL => 'all';
+no warnings 'recursion';
+
+use base qw( DBM::Deep::Sector::File::Data );
+
+my $STALE_SIZE = 2;
+
+# Please refer to the pack() documentation for further information
+my %StP = (
+    1 => 'C', # Unsigned char value (no order needed as it's just one byte)
+    2 => 'n', # Unsigned short in "network" (big-endian) order
+    4 => 'N', # Unsigned long in "network" (big-endian) order
+    8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
+);
+
+sub free {
+    my $self = shift;
+
+    my $chain_loc = $self->chain_loc;
+
+    $self->SUPER::free();
+
+    if ( $chain_loc ) {
+        $self->engine->load_sector( $chain_loc )->free;
+    }
+
+    return;
+}
+
+sub _init {
+    my $self = shift;
+
+    my $engine = $self->engine;
+
+    unless ( $self->offset ) {
+        my $data_section = $self->size - $self->base_size - $engine->byte_size - 1;
+
+        $self->{offset} = $engine->_request_data_sector( $self->size );
+
+        my $data = delete $self->{data};
+        my $utf8 = do { no warnings 'utf8'; $data !~ /^[\0-\xff]*\z/ };
+        if($utf8){
+            if($engine->{v} < 4) {
+                DBM::Deep->_throw_error(
+                 "This database format version is too old for Unicode"
+                );
+            }
+            utf8::encode $data;
+            $self->{type} = $engine->SIG_UNIDATA;
+        }
+        else { $self->{type} = $engine->SIG_DATA; }
+
+        my $dlen = length $data;
+        my $continue = 1;
+        my $curr_offset = $self->offset;
+        while ( $continue ) {
+
+            my $next_offset = 0;
+
+            my ($leftover, $this_len, $chunk);
+            if ( $dlen > $data_section ) {
+                $leftover = 0;
+                $this_len = $data_section;
+                $chunk = substr( $data, 0, $this_len );
+
+                $dlen -= $data_section;
+                $next_offset = $engine->_request_data_sector( $self->size );
+                $data = substr( $data, $this_len );
+            }
+            else {
+                $leftover = $data_section - $dlen;
+                $this_len = $dlen;
+                $chunk = $data;
+
+                $continue = 0;
+            }
+
+            $engine->storage->print_at( $curr_offset, $self->type ); # Sector type
+            # Skip staleness
+            $engine->storage->print_at( $curr_offset + $self->base_size,
+                pack( $StP{$engine->byte_size}, $next_offset ),  # Chain loc
+                pack( $StP{1}, $this_len ),                      # Data length
+                $chunk,                                          # Data to be stored in this sector
+                chr(0) x $leftover,                              # Zero-fill the rest
+            );
+
+            $curr_offset = $next_offset;
+        }
+
+        return;
+    }
+}
+
+sub data_length {
+    my $self = shift;
+
+    my $buffer = $self->engine->storage->read_at(
+        $self->offset + $self->base_size + $self->engine->byte_size, 1
+    );
+
+    return unpack( $StP{1}, $buffer );
+}
+
+sub chain_loc {
+    my $self = shift;
+    return unpack(
+        $StP{$self->engine->byte_size},
+        $self->engine->storage->read_at(
+            $self->offset + $self->base_size,
+            $self->engine->byte_size,
+        ),
+    );
+}
+
+sub data {
+    my $self = shift;
+    my $engine = $self->engine;
+
+    my $data;
+    while ( 1 ) {
+        my $chain_loc = $self->chain_loc;
+
+        $data .= $engine->storage->read_at(
+            $self->offset + $self->base_size + $engine->byte_size + 1, $self->data_length,
+        );
+
+        last unless $chain_loc;
+
+        $self = $engine->load_sector( $chain_loc );
+    }
+
+    utf8::decode $data  if $self->type eq $engine->SIG_UNIDATA;
+
+    return $data;
+}
+
+1;
+__END__