Initial Commit

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

@@ -0,0 +1,37 @@
+package DBM::Deep::Iterator::DBI;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Iterator );
+
+sub reset {
+    my $self = shift;
+
+    eval { $self->{sth}->finish; };
+    delete $self->{sth};
+
+    return;
+}
+
+sub get_next_key {
+    my $self = shift;
+    my ($obj) = @_;
+
+    unless ( exists $self->{sth} ) {
+        # For mysql, this needs to be RAND()
+        # For sqlite, this needs to be random()
+        my $storage = $self->{engine}->storage;
+        $self->{sth} = $storage->{dbh}->prepare(
+            "SELECT `key` FROM datas WHERE ref_id = ? ORDER BY "
+          . $storage->rand_function,
+        );
+        $self->{sth}->execute( $self->{base_offset} );
+    }
+
+    my ($key) = $self->{sth}->fetchrow_array;
+    return $key;
+}
+
+1;
+__END__

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

@@ -0,0 +1,104 @@
+package DBM::Deep::Iterator::File;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Iterator );
+
+use DBM::Deep::Iterator::File::BucketList ();
+use DBM::Deep::Iterator::File::Index ();
+
+sub reset { $_[0]{breadcrumbs} = []; return }
+
+sub get_sector_iterator {
+    my $self = shift;
+    my ($loc) = @_;
+
+    my $sector = $self->{engine}->load_sector( $loc )
+        or return;
+
+    if ( $sector->isa( 'DBM::Deep::Sector::File::Index' ) ) {
+        return DBM::Deep::Iterator::File::Index->new({
+            iterator => $self,
+            sector   => $sector,
+        });
+    }
+    elsif ( $sector->isa( 'DBM::Deep::Sector::File::BucketList' ) ) {
+        return DBM::Deep::Iterator::File::BucketList->new({
+            iterator => $self,
+            sector   => $sector,
+        });
+    }
+
+    DBM::Deep->_throw_error( "get_sector_iterator(): Why did $loc make a $sector?" );
+}
+
+sub get_next_key {
+    my $self = shift;
+    my ($obj) = @_;
+
+    my $crumbs = $self->{breadcrumbs};
+    my $e = $self->{engine};
+
+    unless ( @$crumbs ) {
+        # This will be a Reference sector
+        my $sector = $e->load_sector( $self->{base_offset} )
+            # If no sector is found, this must have been deleted from under us.
+            or return;
+
+        if ( $sector->staleness != $obj->_staleness ) {
+            return;
+        }
+
+        my $loc = $sector->get_blist_loc
+            or return;
+
+        push @$crumbs, $self->get_sector_iterator( $loc );
+    }
+
+    FIND_NEXT_KEY: {
+        # We're at the end.
+        unless ( @$crumbs ) {
+            $self->reset;
+            return;
+        }
+
+        my $iterator = $crumbs->[-1];
+
+        # This level is done.
+        if ( $iterator->at_end ) {
+            pop @$crumbs;
+            redo FIND_NEXT_KEY;
+        }
+
+        if ( $iterator->isa( 'DBM::Deep::Iterator::File::Index' ) ) {
+            # If we don't have any more, it will be caught at the
+            # prior check.
+            if ( my $next = $iterator->get_next_iterator ) {
+                push @$crumbs, $next;
+            }
+            redo FIND_NEXT_KEY;
+        }
+
+        unless ( $iterator->isa( 'DBM::Deep::Iterator::File::BucketList' ) ) {
+            DBM::Deep->_throw_error(
+                "Should have a bucketlist iterator here - instead have $iterator"
+            );
+        }
+
+        # At this point, we have a BucketList iterator
+        my $key = $iterator->get_next_key;
+        if ( defined $key ) {
+            return $key;
+        }
+        #XXX else { $iterator->set_to_end() } ?
+
+        # We hit the end of the bucketlist iterator, so redo
+        redo FIND_NEXT_KEY;
+    }
+
+    DBM::Deep->_throw_error( "get_next_key(): How did we get here?" );
+}
+
+1;
+__END__

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

@@ -0,0 +1,90 @@
+package DBM::Deep::Iterator::File::BucketList;
+
+use 5.008_004;
+
+use strict;
+use warnings FATAL => 'all';
+
+=head1 NAME
+
+DBM::Deep::Iterator::BucketList - mediate between DBM::Deep::Iterator and DBM::Deep::Engine::Sector::BucketList
+
+=head1 PURPOSE
+
+This is an internal-use-only object for L<DBM::Deep>. It acts as the mediator
+between the L<DBM::Deep::Iterator> object and a L<DBM::Deep::Engine::Sector::BucketList>
+sector.
+
+=head1 OVERVIEW
+
+This object, despite the implied class hierarchy, does B<NOT> inherit from
+L<DBM::Deep::Iterator>. Instead, it delegates to it, essentially acting as a
+facade over it. L<DBM::Deep::Iterator/get_next_key> will instantiate one of
+these objects as needed to handle an BucketList sector.
+
+=head1 METHODS
+
+=head2 new(\%params)
+
+The constructor takes a hashref of params and blesses it into the invoking class. The
+hashref is assumed to have the following elements:
+
+=over 4
+
+=item * iterator (of type L<DBM::Deep::Iterator>
+
+=item * sector (of type L<DBM::Deep::Engine::Sector::BucketList>
+
+=back
+
+=cut
+
+sub new {
+    my $self = bless $_[1] => $_[0];
+    $self->{curr_index} = 0;
+    return $self;
+}
+
+=head2 at_end()
+
+This takes no arguments.
+
+This returns true/false indicating whether this sector has any more elements that can be
+iterated over.
+
+=cut
+
+sub at_end {
+    my $self = shift;
+    return $self->{curr_index} >= $self->{iterator}{engine}->max_buckets;
+}
+
+=head2 get_next_iterator()
+
+This takes no arguments.
+
+This returns the next key pointed to by this bucketlist. This value is suitable for
+returning by FIRSTKEY or NEXTKEY().
+
+If the bucketlist is exhausted, it returns nothing.
+
+=cut
+
+sub get_next_key {
+    my $self = shift;
+
+    return if $self->at_end;
+
+    my $idx = $self->{curr_index}++;
+
+    my $data_loc = $self->{sector}->get_data_location_for({
+        allow_head => 1,
+        idx        => $idx,
+    }) or return;
+
+    #XXX Do we want to add corruption checks here?
+    return $self->{sector}->get_key_for( $idx )->data;
+}
+
+1;
+__END__

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

@@ -0,0 +1,86 @@
+package DBM::Deep::Iterator::File::Index;
+
+use 5.008_004;
+
+use strict;
+use warnings FATAL => 'all';
+
+=head1 NAME
+
+DBM::Deep::Iterator::Index - mediate between DBM::Deep::Iterator and DBM::Deep::Engine::Sector::Index
+
+=head1 PURPOSE
+
+This is an internal-use-only object for L<DBM::Deep>. It acts as the mediator
+between the L<DBM::Deep::Iterator> object and a L<DBM::Deep::Engine::Sector::Index>
+sector.
+
+=head1 OVERVIEW
+
+This object, despite the implied class hierarchy, does B<NOT> inherit from
+L<DBM::Deep::Iterator>. Instead, it delegates to it, essentially acting as a
+facade over it. L<DBM::Deep::Iterator/get_next_key> will instantiate one of
+these objects as needed to handle an Index sector.
+
+=head1 METHODS
+
+=head2 new(\%params)
+
+The constructor takes a hashref of params and blesses it into the invoking class. The
+hashref is assumed to have the following elements:
+
+=over 4
+
+=item * iterator (of type L<DBM::Deep::Iterator>
+
+=item * sector (of type L<DBM::Deep::Engine::Sector::Index>
+
+=back
+
+=cut
+
+sub new {
+    my $self = bless $_[1] => $_[0];
+    $self->{curr_index} = 0;
+    return $self;
+}
+
+=head2 at_end()
+
+This takes no arguments.
+
+This returns true/false indicating whether this sector has any more elements that can be
+iterated over.
+
+=cut
+
+sub at_end {
+    my $self = shift;
+    return $self->{curr_index} >= $self->{iterator}{engine}->hash_chars;
+}
+
+=head2 get_next_iterator()
+
+This takes no arguments.
+
+This returns an iterator (built by L<DBM::Deep::Iterator/get_sector_iterator>) based
+on the sector pointed to by the next occupied location in this index.
+
+If the sector is exhausted, it returns nothing.
+
+=cut
+
+sub get_next_iterator {
+    my $self = shift;
+
+    my $loc;
+    while ( !$loc ) {
+        return if $self->at_end;
+        $loc = $self->{sector}->get_entry( $self->{curr_index}++ );
+    }
+
+    return $self->{iterator}->get_sector_iterator( $loc );
+}
+
+1;
+__END__