view release on metacpan or  search on metacpan

lib/CHI/Driver/HandlerSocket.pm  view on Meta::CPAN

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

has 'dbh' => ( is => 'rw', ); #  isa => 'DBI::db',

sub get_dbh {
    my $self = shift;
    my $dbh = $self->dbh or die "no dbh!";
    return $dbh->dbh if eval { $dbh->ISA('DBIx::Connector'); };
    return $dbh->() if eval { ref $dbh eq 'CODE' };  # tell me again what's wrong with UNIVERSAL::ISA.
    # warn "dbh isn't a DBI::db; it's a " . ref $dbh unless eval { $dbh->ISA('DBI::db'); }; # "dbh isn't a DBI::db; it's a DBI::db"
    return $dbh;
}

has 'table_prefix' => ( is => 'rw', isa => 'Str', default => 'chi_', );

has 'host' => ( is => 'ro', default => 'localhost', );

has 'read_port' => ( is => 'ro', default => 9998, );

has 'write_port' => ( is => 'ro', default => 9999, );

has 'read_index' => ( is => 'ro', default => 1, );

has 'write_index' => ( is => 'ro', default => 1, );

has 'read_hs' => ( is => 'rw', isa => 'Net::HandlerSocket', );

has 'write_hs' => ( is => 'rw', isa => 'Net::HandlerSocket', );

has 'mysql_thread_stack' => ( is => 'rw', isa => 'Num', ); # HandlerSocket uses the stack to buffer writes; remember how large the stack is

__PACKAGE__->meta->make_immutable;

sub BUILD {
    my ( $self, $args ) = @_;
    
    my $dbh = $self->get_dbh;

    my $table   = $self->_table; # don't quote it
    
    my $database_name = do { 
        my $sth = $dbh->prepare( qq{ SELECT database() AS dbname } ) or die $dbh->errstr;
        $sth->execute or die $sth->errstr;
        my @row = $sth->fetchrow_array or die "couldn't figure out the name of the database";
        $sth->finish;
        $row[0];
    };

    # HandlerSocket uses the stack to buffer writes; remember how large the stack is

    $self->mysql_thread_stack(do {
        my $sth = $dbh->prepare( qq{ SHOW global variables WHERE Variable_name = 'thread_stack' } ) or die $dbh->errstr;
        $sth->execute or die $sth->errstr;
        my @row = $sth->fetchrow_array || do { 
            # every time you use a magic number in code, a devil gets his horns; seriously though, this is this 
            # particular MySQL releases default thread stack size
            warn "couldn't figure out the thread_stack size; oh well, guessing"; 
            (131072); 
        }; 
        $sth->finish;
        # 5824 is the amount of data my MySQL version/install said had already been used of the stack before the 
        # unaccomodatable request came in; 2 is a fudge factor
        # if this is less than 0 for some reason, then all writes will go to DBI, which is probably necessary in that case
        $row[0] - 5824 * 2;  
    });

    # warn "host: @{[ $self->host ]} port: @{[ $self->read_port ]} database_name: $database_name table: $table read_index: @{[ $self->read_index ]} write_index: @{[ $self->write_index ]} thread_stack: @{[ $self->mysql_thread_stack ]}";

    #    CREATE TABLE IF NOT EXISTS $table ( `key` VARCHAR( 600 ), `value` BLOB, PRIMARY KEY ( `key` ) ) CHARSET=ASCII # fails 30 tests right now
    #    CREATE TABLE IF NOT EXISTS $table ( `key` VARCHAR( 300 ), `value` TEXT, PRIMARY KEY ( `key` ) ) CHARSET=utf8 # fails 220 tests

    $dbh->do( qq{
        CREATE TABLE IF NOT EXISTS $table ( `key` VARCHAR( 600 ), `value` BLOB, PRIMARY KEY ( `key` ) ) CHARSET=ASCII
    } ) or croak $dbh->errstr;

    # from https://github.com/ahiguti/HandlerSocket-Plugin-for-MySQL/blob/master/docs-en/perl-client.en.txt:

    # The first argument for open_index is an integer value which is
    # used to identify an open table, which is only valid within the
    # same Net::HandlerSocket object. The 4th argument is the name of
    # index to open. If 'PRIMARY' is specified, the primary index is
    # open. The 5th argument is a comma-separated list of column names.

    my $read_hs = Net::HandlerSocket->new({ host => $self->host, port => $self->read_port, }) or die;
    $read_hs->open_index($self->read_index, $database_name, $table, 'PRIMARY', 'value') and die $read_hs->get_error;
    $self->read_hs($read_hs);

    my $write_hs = Net::HandlerSocket->new({ host => $self->host, port => $self->write_port, });
    $write_hs->open_index($self->write_index, $database_name, $table, 'PRIMARY', 'key,value') and die $write_hs->get_error;
    $self->write_hs($write_hs);

    return;
}
 
sub _table {
    my $self = shift;
    return $self->table_prefix() . $self->namespace();
}

sub fetch {
    my ( $self, $key, ) = @_;

    my $index = $self->read_index;
    my $hs = $self->read_hs;

    # from https://github.com/ahiguti/HandlerSocket-Plugin-for-MySQL/blob/master/docs-en/perl-client.en.txt:

    # The first argument must be an integer which has specified as the
    # first argument for open_index on the same Net::HandlerSocket
    # object. The second argument specifies the search operation. The
    # current version of handlersocket supports '=', '>=', '<=', '>',
    # and '<'. The 3rd argument specifies the key to find, which must
    # an arrayref whose length is equal to or smaller than the number
    # of key columns of the index. The 4th and the 5th arguments
    # specify the maximum number of records to be retrieved, and the
    # number of records skipped before retrieving records. The columns
    # to be retrieved are specified by the 5th argument for the