Genezzo::Index::btHash - btree Hash tied hash class. Makes a persistent

Genezzo documentation Contained in the Genezzo distribution.

Index

Code Index:

NAME

Top

Genezzo::Index::btHash - btree Hash tied hash class. Makes a persistent btree based upon Genezzo::Block::RDBlock look like a conventional hash.

SYNOPSIS

Top

 use Genezzo::Index::btHash;

 my %tied_hash = ();

 my $tie_val = 
     tie %tied_hash, 'Genezzo::Index::btHash';

DESCRIPTION

Top

btHash is a wrapper for Genezzo::Index::bt2, a btree class based upon Genezzo::Block::RDBlock. The tied hash is functionally complete, but not particularly efficient in some cases due to the "impedance mismatch" between the hash, btree and underlying RDBlock implementation.

FUNCTIONS

Top

EXPORT

TODO

Top

figure out whether should be a pushhash, hash, or rowsource
SQLPrepare/Execute/Fetch: clean up. Shouldn't need to manage a distinction between using btHash as a row source and the old bt2 api. bt2 is wrong - should only have one Fetch style. Should be able to use the index start/stop key vs filtering.
NEXTKEY: broken in "dump tsidx" for case where create 2 tables, insert some rows, then drop the first table (and don't COMMIT) and call dump tsidx. Loops in NEXTKEY - never terminates for allfileused index.
Add ReadOnly mode so can view indexes, but not insert/update/delete.

AUTHOR

Top

Jeffrey I. Cohen, jcohen@genezzo.com

SEE ALSO

Top

perl(1).

Copyright (c) 2003, 2004 Jeffrey I Cohen. All rights reserved.

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

Address bug reports and comments to: jcohen@genezzo.com

For more information, please visit the Genezzo homepage at http://www.genezzo.com

Genezzo documentation Contained in the Genezzo distribution. 
#!/usr/bin/perl
#
# $Header: /Users/claude/fuzz/lib/Genezzo/Index/RCS/btHash.pm,v 7.1 2005/07/19 07:49:03 claude Exp claude $
#
# copyright (c) 2003, 2004 Jeffrey I Cohen, all rights reserved, worldwide
#
#
use strict;
use warnings;

package Genezzo::Index::btHash;

use Genezzo::Util;
use Genezzo::Index::bt2;
#use Genezzo::PushHash::PushHash;
use Tie::Hash;
use Carp;
use warnings::register;

our @ISA = qw(Tie::Hash) ;
#our @ISA = qw(Genezzo::PushHash::PushHash) ;

sub _init
{
    #whoami;
    #greet @_;
    my $self = shift;
    my %optional = (BT_Index_Class => "Genezzo::Index::bt2",
                    BT_Fetch_Fix   => 0
                    );
    my %args = (%optional,
                @_);

    my $index_class = $args{BT_Index_Class};
    unless (   ($index_class eq "Genezzo::Index::bt2")
            || (eval "require $index_class"))
    {
        carp "no such package - $index_class"
            if warnings::enabled();

        # XXX XXX XXX: need to check if subclass of bt2...

        return undef;
    }

    $self->{bt} = $index_class->new(@_);
    $self->{fetch_fix} = $args{BT_Fetch_Fix};
    if (exists($args{key_type}))
    {
        $self->{key_type}  = $args{key_type};
    }

    return 1;
}

sub TIEHASH
{ #sub new 
#    greet @_;
    my $invocant = shift;
    my $class = ref($invocant) || $invocant ; 
    my $self = { };

    my %args = (@_);

    return undef
        unless (_init($self,%args));

    return bless $self, $class;

} # end new


# count estimation
sub FirstCount 
{
    whoami;
    my $self = shift;

    my $key = $self->{bt}->hkeyFIRSTKEY();

    my @outi;
    push @outi, $key;

#    greet @outi;
    return $self->NextCount(@outi); 

} # FirstCount

# count estimation
sub NextCount
{
    whoami;
    my ($self, $prevkey, $esttot, $sum, $sumsq, $chunkcount, $totchunk) = @_;

    return undef
        unless (defined($prevkey));

    # XXX XXX: fake it - just return hcount

    if (defined($esttot))
    {
        $prevkey = undef;
        $sum = $self->HCount();
        $chunkcount = 1;
    }
    else
    {
        $sum = 0;
        $chunkcount = 0;
    }

    $esttot = $sum;
    $sumsq = $sum * $sum;

    $totchunk = 1;

    my @outi = ($prevkey, $esttot, $sum, $sumsq, $chunkcount, $totchunk);
#    greet @outi;

    return @outi;
} # nextcount


# some private and pushhash-style methods
sub _get_bt
{
    my $self = shift;
    return ($self->{bt});
}

sub HPush
{
    return undef;
}

sub HCount
{
    my $self = shift;
    return ($self->{bt}->HCount());
}

# standard hash methods follow
sub STORE
{
    my ($self, $place, $value) = @_;

    my $oldval;
    if ($self->EXISTS($place))
    {
        $oldval = $self->FETCH($place);
        whisper "update $place";
        $self->DELETE($place);
    }
    my $stat = $self->{bt}->insert($place, $value);

    unless ($stat)
    {   # restore the old value if the insert failed...
        $self->{bt}->insert($place, $oldval)
            if (defined($oldval));
        return undef;
    }

    return ($place);
}
 
sub FETCH    
{
    my ($self, $place) = @_;

    my @outi = $self->{bt}->search($place);

    return undef
        unless (scalar(@outi) > 1);

    shift @outi; # key 
    my $outval = shift @outi; 

    return $outval;
}


sub search
{
    my $self = shift;
    return $self->{bt}->search(@_);
}

# iterate fast using the underlying RDBlock hash keys directly
sub hkeyFIRSTKEY
{
    return $_[0]->{bt}->hkeyFIRSTKEY();
}
sub hkeyNEXTKEY
{
    return $_[0]->{bt}->hkeyNEXTKEY($_[1]);
}
sub hkeyLASTKEY
{
    return $_[0]->{bt}->hkeyLASTKEY();
}
sub hkeyPREVKEY
{
    return $_[0]->{bt}->hkeyPREVKEY($_[1]);
}
sub hkeyFETCH
{
    return $_[0]->{bt}->hkeyFETCH($_[1]);
}

# iterate by key value -- expensive, because requires a search to get
# the nextkey
sub FIRSTKEY 
{ 
#    whoami;
    my $self = shift;

    my $place = $self->{bt}->hkeyFIRSTKEY();

    return undef
        unless (defined($place));

    my @row = $self->{bt}->hkeyFETCH($place);

    return undef
        unless (scalar(@row) > 1);

    return $row[0]; # key portion of index row
}


sub NEXTKEY  
{
#    whoami;
    my ($self, $prevkey) = @_;

    my @outi = $self->{bt}->search($prevkey);

    my @row = $self->_searchNEXTKEY(@outi);

    return undef
        unless (scalar(@row) > 1);

    return $row[0]; # key portion of index row

}

sub _searchNEXTKEY  # make private - use bt2::SQLFetch instead
{
#    whoami;
    return undef
        unless (scalar(@_) > 4);

    my ($self, $key, $val, $currnode, $offset, $ieq, $k2) = @_;

    my $place = 
        $self->{bt}->offsetNEXTKEY(
                                   $self->{bt}->_joinplace("A",
                                                           $currnode, 
                                                           $offset));

    return undef
        unless (defined($place));

    my @row = $self->{bt}->offsetFETCH($place, 1);

    return undef
        unless (scalar(@row) > 1);

    return @row
        unless (defined($ieq));

    # if we have an equality function, (and a match key), make sure
    # the next row matches
    $k2 = $key
        unless (defined($k2));

    return @row
        if (&$ieq ($k2, $row[0]));

    return undef;
} # end searchnextkey

sub EXISTS   
{
    my ($self, $place) = @_;

    my @retval = $self->{bt}->search($place);

    return 0
        unless (scalar(@retval) > 1);

    return 1;
}

sub DELETE   
{
    my ($self, $place) = @_;

    return $self->{bt}->delete($place);
}

sub CLEAR    
{
    my $self = shift;

    return $self->{bt}->btCLEAR();
}

sub SQLPrepare
{
#    whoami;
    my $self = shift;
    my %args = @_;
    $args{bt} = $self->{bt};
    $args{BT_Fetch_Fix} = $self->{fetch_fix};
    if (exists($self->{key_type}))
    {
        $args{key_type} = $self->{key_type}; 
    }

    my $sth = Genezzo::SQL_btHash->new(%args);

#                                    pkey_type => $self->{pkey_type},
#                                    bt        => $self->{bt});
                                    #filter    => $filter);

    return $sth;
}

package Genezzo::SQL_btHash;
use strict;
use warnings;
use Genezzo::Util;

sub _init
{
    my $self = shift;
    my %args = (@_);

#    whoami;

    return 0
        unless (defined($args{bt}));
    $self->{bt}        = $args{bt};
    if (exists($args{key_type}))
    {
        $self->{key_type}  = $args{key_type};
    }

    $self->{fetch_fix} = $args{BT_Fetch_Fix};

    my %nargs;
    $nargs{BT_Fetch_Fix} =  $args{BT_Fetch_Fix};
    my ($got_startkey, $got_stopkey) = (0,0);

    if (exists($args{start_key}))
    {
        $nargs{start_key} = $args{start_key};
        $got_startkey = 1;
    }
    if (exists($args{stop_key}))
    {
        $nargs{stop_key} = $args{stop_key};
        $got_stopkey = 1;
    }

    if (defined($args{filter}))
    {
        $self->{SQLFilter} = $args{filter};
        greet $args{filter};
        my $ff = $args{filter};

        my @both_keys = Genezzo::Util::GetIndexKeys($ff);
        
        greet @both_keys;

        if (scalar(@both_keys)
            && (exists($self->{key_type}))
            && ($self->{fetch_fix}))
        {
            my @startkey = @{$both_keys[0]};
            my @stopkey  = @{$both_keys[1]};

            # need a start or stop key
            unless ($got_startkey)
            {
                my $bad_key = 0;
                if (scalar(@startkey) == scalar(@{$self->{key_type}}))
                {
                    for my $kkey (@startkey)
                    {
                        unless (defined($kkey))
                        {
                            $bad_key = 1;
                            last;
                        }
                    }
                    $nargs{start_key} = \@startkey
                        unless ($bad_key);
                }
            }
            unless ($got_stopkey)
            {
                my $bad_key = 0;
                if (scalar(@stopkey) == scalar(@{$self->{key_type}}))
                {
                    for my $kkey (@stopkey)
                    {
                        unless (defined($kkey))
                        {
                            $bad_key = 1;
                            last;
                        }
                    }
                    $nargs{stop_key} = \@stopkey
                        unless ($bad_key);
                }
            }

            greet %nargs;

        } # end if got both keys
    } # end if filter

    my $searchhandle = 
        $self->{bt}->SQLPrepare(%nargs);

    return 0
        unless (defined($searchhandle));

    $self->{IndexSth} = $searchhandle;

    return 1;
}

sub new
{
 #   whoami;
    my $invocant = shift;
    my $class = ref($invocant) || $invocant ; 
    my $self = { };

    my %args = (@_);
    return undef
        unless (_init($self,%args));

    return bless $self, $class;

} # end new


# SQL-style execute and fetch functions
sub SQLExecute
{
#    whoami;
    my ($self, $filter) = @_;

    return 0
        unless (exists($self->{IndexSth}));

    $self->{SQLFetchKey} = 1;
    return $self->{IndexSth}->SQLExecute();
}

# XXX XXX XXX XXX: create a separate dynamic package to hold the fetch
# state, vs keeping the fetch state in the base pushhash.  Then can
# maintain multiple independent SQLFetches open on same btHash object.

# combine NEXTKEY and FETCH in a single operation
sub SQLFetch
{
#    whoami;
    my ($self, $key) = @_;
    my $fullfilter = $self->{SQLFilter};
    my $filter = (defined($fullfilter)) ? $fullfilter->{filter} : undef;

    # use explicit key if necessary
#    $self->{SQLFetchKey} = $key
#        if (defined($key));

    while (defined($self->{SQLFetchKey}))
    {
        my @row;     
        my $currkey;

        if (exists($self->{IndexSth}))
        {
#            greet "index fetch";

            @row = $self->{IndexSth}->SQLFetch();

#            greet @row;

            unless (scalar(@row) > 1)
            {
                $self->{SQLFetchKey} = undef;
                return undef;
            }

#            $currkey = shift @row;
        }
        else
        {
            greet "oops!";
        }

 
        # NOTE: just return non-fixed rows...
       return @row
            unless ($self->{fetch_fix});

        my $vv = pop @row; # get the value array
        push @row, @{$vv}; # and flatten it into the a single row
        my $rid = shift @row;
        my $outarr  = \@row;
#        my $rid = $outarr->[0];

        # Note: always return the rid
        return ($rid, $outarr)
            unless (defined($filter) &&
                    !(&$filter($self, $rid, $outarr)));
    }

    return undef;
}


sub AUTOLOAD 
{
    my $self = shift;
    my $bt = $self->{bt};

    our $AUTOLOAD;
    my $newfunc = $AUTOLOAD;
    $newfunc =~ s/.*:://;
    return if $newfunc eq 'DESTROY';

#    greet $newfunc;
    return ($bt->$newfunc(@_));
}



END {

}


1;

__END__
# Below is stub documentation for your module. You better edit it!