[perl-cache commit] r550 - - Make tests skip if database connection is not available.
codesite...@google.com
Date: Mon Mar 16 22:00:50 2009
New Revision: 550
Added:
dbi-driver/lib/CHI/t/Driver/DBI.pm
Modified:
dbi-driver/lib/CHI/Driver/DBI.pm
dbi-driver/lib/CHI/t/Driver/DBI/SQLite.pm
dbi-driver/lib/CHI/t/Driver/DBI/mysql.pm
Log:
- Make tests skip if database connection is not available.
- Only create table when create_table is explicitly set.
- Update docs.
- Create base class for tests.
- Switch to using a separate table for every namespace.
- Switch to Mouse.
- Use ON DUPLICATE KEY UPDATE instead of REPLACE for MySQL.
- Fix error handling on failed INSERTs.
Modified: dbi-driver/lib/CHI/Driver/DBI.pm
==============================================================================
--- dbi-driver/lib/CHI/Driver/DBI.pm (original)
+++ dbi-driver/lib/CHI/Driver/DBI.pm Mon Mar 16 22:00:50 2009
@@ -1,11 +1,13 @@
package CHI::Driver::DBI;
-use DBI;
-use DBI::Const::GetInfoType;
-use Moose;
use strict;
use warnings;
+use DBI;
+use DBI::Const::GetInfoType;
+use Mouse;
+use Carp qw(croak);
+
our $VERSION = '0.1';
# TODO: For pg see "upsert" -
http://www.postgresql.org/docs/current/static/plpgsql-control-structures.html#PLPGSQL-UPSERT-EXAMPLE
@@ -14,7 +16,7 @@
=head1 NAME
-CHI::Driver::DBI - db cache backend
+CHI::Driver::DBI - Use DBI for cache storage
=head1 SYNOPSIS
@@ -27,23 +29,53 @@
=head1 DESCRIPTION
-This driver uses a single table to store the cache.
-The newest versions of MySQL and SQLite work are known
-to work. Other RDBMSes should work.
+This driver uses a database table to store the cache. The newest
+versions of MySQL and SQLite work are known to work. Other RDBMSes
+should work.
+
+Why cache things in a database? Isn't the database what people are
+trying to avoid with caches? This is often true, but a simple primary
+key lookup is extremely fast in many databases and this provides a
+shared cache that can be used when less reliable storage like
+memcached is not appropriate. Also, the speed of simple lookups on
+MySQL when accessed over a local socket is very hard to beat. DBI is
+fast.
-This driver may seem ironic or stupid to some. It was
-motivated by a need to have a cache that was solid.
+Note that this module is built on the Mouse framework, just like the
+main CHI modules.
=head1 ATTRIBUTES
=over
+=item namespace
+
+The namespace you pass in will be appended to the C<table_prefix> and
+used as a table name. That means that if you don't specify a
+namespace or table_prefix the cache will be stored in a table called
+C<chi_Default>.
+
+=item table_prefix
+
+This is the prefix that is used when building a table name. If you
+want to just use the namespace as a literal table name, set this to
+undef. Defaults to C<chi_>.
+
+=cut
+
+has 'table_prefix' => ( is => 'rw', isa => 'Str', default => 'chi_', );
+
=item dbh
The main, or rw, DBI handle used to communicate with the db.
If a dbh_ro handle is defined then this handle will only be used
for writing.
+This attribute can be set after object creation as well, so in a
+persistent environment like mod_perl or FastCGI you may keep an
+instance of the cache around and set the dbh on each request after
+checking it with ping().
+
=cut
has 'dbh' => ( is => 'rw', isa => 'DBI::db', required => 1, );
@@ -57,14 +89,6 @@
has 'dbh_ro' => ( is => 'rw', isa => 'DBI::db', );
-=item table
-
-The name of the cache table. Defaults to "chi_driver_dbi".
-
-=cut
-
-has 'table' => ( is => 'rw', isa => 'Str', lazy_build => 1, );
-
=item sql_strings
Hashref of SQL strings to use in the different cache operations.
@@ -84,10 +108,10 @@
=item BUILD
-Standard issue Moose BUILD method. Used to build the sql_strings
-and to create the db table. The table creation can be skipped if
-the create_table driver param is set to false. For Mysql and SQLite
-the statement is "create if not exists..." so its generally harmless.
+Standard issue Mouse BUILD method. Used to build the sql_strings. If
+the parameter C<create_table> to C<new()> was set to true, it will
+attempt to create the db table. For Mysql and SQLite the statement is
+"create if not exists..." so it's generally harmless.
=cut
@@ -96,7 +120,7 @@
$self->sql_strings;
- unless ( defined $args->{create_table} && $args->{create_table} ) {
+ if ( $args->{create_table} ) {
$self->{dbh}->do( $self->{sql_strings}->{create} )
or croak $self->{dbh}->errstr;
}
@@ -104,52 +128,45 @@
return;
}
-sub _build_table {
+sub _table {
my ( $self, ) = @_;
- return 'chi_driver_dbi';
+ return $self->table_prefix() . $self->namespace();
}
sub _build_sql_strings {
my ( $self, ) = @_;
- my $qc = $self->dbh->get_info( $GetInfoType{SQL_IDENTIFIER_QUOTE_CHAR}
);
- my $t = $self->table;
- my $db = $self->dbh->get_info( $GetInfoType{SQL_DBMS_NAME} );
+ my $table = $self->dbh->quote_identifier( $self->_table );
+ my $value = $self->dbh->quote_identifier('value');
+ my $key = $self->dbh->quote_identifier('key');
+ my $db_name = $self->dbh->get_info( $GetInfoType{SQL_DBMS_NAME} );
my $strings = {
- fetch => "select ${qc}value${qc} from $qc$t$qc"
- . " where ${qc}namespace${qc} = ? and ${qc}key${qc} = ?",
- store => "insert into $qc$t$qc"
- . " ( ${qc}value${qc}, ${qc}namespace${qc}, ${qc}key${qc} )"
- . " values ( ?, ?, ? )",
- store2 => "update $qc$t$qc"
- . " set ${qc}value${qc} = ? where ${qc}namespace${qc} = ?"
- . " and ${qc}key${qc} = ?",
- remove => "delete from $qc$t$qc"
- . " where ${qc}namespace${qc} = ? and ${qc}key${qc} = ?",
- clear => "delete from $qc$t$qc where ${qc}namespace${qc} = ?",
- get_keys => "select distinct ${qc}key${qc} from $qc$t$qc"
- . " where ${qc}namespace${qc} = ?",
- get_namespaces => "select distinct ${qc}namespace${qc} from
$qc$t$qc",
- create => "create table if not exists $qc$t$qc ("
- . " ${qc}namespace${qc} varchar( 100 ),"
- . " ${qc}key${qc} varchar( 600 ), ${qc}value${qc} text,"
- . " primary key ( ${qc}namespace${qc}, ${qc}key${qc} ) )",
+ fetch => "SELECT $value FROM $table WHERE $key = ?",
+ store => "INSERT INTO $table ( $key, $value ) VALUES ( ?, ? )",
+ store2 => "UPDATE $table SET $value = ? WHERE $key = ?",
+ remove => "DELETE FROM $table WHERE $key = ?",
+ clear => "DELETE FROM $table",
+ get_keys => "SELECT DISTINCT $key FROM $table",
+ create => "CREATE TABLE IF NOT EXISTS $table ("
+ . " $key VARCHAR( 600 ), $value TEXT,"
+ . " PRIMARY KEY ( $key ) )",
};
- if ( $db eq 'MySQL' ) {
+ if ( $db_name eq 'MySQL' ) {
$strings->{store} =
- "replace into $qc$t$qc"
- . " ( ${qc}value${qc}, ${qc}namespace${qc}, ${qc}key${qc} )"
- . " values ( ?, ?, ? )";
+ "INSERT INTO $table"
+ . " ( $key, $value )"
+ . " VALUES ( ?, ? )"
+ . " ON DUPLICATE KEY UPDATE $value=VALUES($value)";
delete $strings->{store2};
}
- elsif ( $db eq 'SQLite' ) {
+ elsif ( $db_name eq 'SQLite' ) {
$strings->{store} =
- "insert or replace into $qc$t$qc"
- . " ( ${qc}value${qc}, ${qc}namespace${qc}, ${qc}key${qc} )"
- . " values ( ?, ?, ? )";
+ "INSERT OR REPLACE INTO $table"
+ . " ( $key, $value )"
+ . " values ( ?, ? )";
delete $strings->{store2};
}
@@ -166,7 +183,7 @@
my $dbh = $self->{dbh_ro} ? $self->{dbh_ro} : $self->{dbh};
my $sth = $dbh->prepare_cached( $self->{sql_strings}->{fetch} )
or croak $dbh->errstr;
- $sth->execute( $self->{namespace}, $key ) or croak $sth->errstr;
+ $sth->execute($key) or croak $sth->errstr;
my $results = $sth->fetchall_arrayref;
return $results->[0]->[0];
@@ -180,14 +197,17 @@
my ( $self, $key, $data, ) = @_;
my $sth = $self->{dbh}->prepare_cached( $self->{sql_strings}->{store}
);
- unless ( $sth->execute( $data, $self->{namespace}, $key ) ) {
+ if ( not $sth->execute( $key, $data ) ) {
if ( $self->{sql_strings}->{store2} ) {
my $sth =
$self->{dbh}->prepare_cached( $self->{sql_strings}->{store2}
)
or croak $self->{dbh}->errstr;
- $sth->execute( $data, $self->{namespace}, $key )
+ $sth->execute( $data, $key )
or croak $sth->errstr;
}
+ else {
+ croak $sth->errstr;
+ }
}
$sth->finish;
@@ -203,7 +223,7 @@
my $sth = $self->dbh->prepare_cached( $self->{sql_strings}->{remove} )
or croak $self->{dbh}->errstr;
- $sth->execute( $self->namespace, $key ) or croak $sth->errstr;
+ $sth->execute($key) or croak $sth->errstr;
$sth->finish;
return;
@@ -218,8 +238,8 @@
my $sth = $self->{dbh}->prepare_cached( $self->{sql_strings}->{clear} )
or croak $self->{dbh}->errstr;
- $sth->execute( $self->namespace ) or croak $sth->errstr;
- $sth->finish;
+ $sth->execute() or croak $sth->errstr;
+ $sth->finish();
return;
}
@@ -234,7 +254,7 @@
my $dbh = $self->{dbh_ro} ? $self->{dbh_ro} : $self->{dbh};
my $sth = $dbh->prepare_cached( $self->{sql_strings}->{get_keys} )
or croak $dbh->errstr;
- $sth->execute( $self->namespace ) or croak $sth->errstr;
+ $sth->execute() or croak $sth->errstr;
my $results = $sth->fetchall_arrayref( [0] );
$_ = $_->[0] for @{$results};
@@ -243,26 +263,17 @@
=item get_namespaces
+Not supported at this time.
+
=back
=cut
-sub get_namespaces {
- my ( $self, ) = @_;
-
- my $dbh = $self->{dbh_ro} ? $self->{dbh_ro} : $self->{dbh};
- my $sth = $dbh->prepare_cached( $self->{sql_strings}->{get_namespaces}
)
- or croak $dbh->errstr;
- $sth->execute or croak $sth->errstr;
- my $results = $sth->fetchall_arrayref( [0] );
- $_ = $_->[0] for @{$results};
-
- return @{$results};
-}
+sub get_namespaces { croak 'not supported' }
-=head1 Author
+=head1 Authors
-Justin DeVuyst
+Original version by Justin DeVuyst. Current version and maintenance by
Perrin Harkins.
=head1 COPYRIGHT & LICENSE
Added: dbi-driver/lib/CHI/t/Driver/DBI.pm
==============================================================================
--- (empty file)
+++ dbi-driver/lib/CHI/t/Driver/DBI.pm Mon Mar 16 22:00:50 2009
@@ -0,0 +1,45 @@
+package CHI::t::Driver::DBI;
+
+use strict;
+use warnings;
+
+use DBI;
+use base qw(CHI::t::Driver);
+
+sub testing_driver_class { 'CHI::Driver::DBI' }
+sub supports_get_namespaces { 0 }
+
+sub SKIP_CLASS {
+ my $class = shift;
+
+ if ( not $class->dbh() ) {
+ return "Unable to get a database connection";
+ }
+
+ return 0;
+}
+
+sub dbh {
+ my $self = shift;
+
+ return DBI->connect(
+ $self->dsn(),
+ '', '',
+ {
+ RaiseError => 0,
+ PrintError => 0,
+ }
+ );
+}
+
+sub new_cache_options {
+ my $self = shift;
+
+ return (
+ $self->SUPER::new_cache_options(),
+ dbh => $self->dbh,
+ create_table => 1
+ );
+}
+
+1;
Modified: dbi-driver/lib/CHI/t/Driver/DBI/SQLite.pm
==============================================================================
--- dbi-driver/lib/CHI/t/Driver/DBI/SQLite.pm (original)
+++ dbi-driver/lib/CHI/t/Driver/DBI/SQLite.pm Mon Mar 16 22:00:50 2009
@@ -1,33 +1,16 @@
package CHI::t::Driver::DBI::SQLite;
+
use strict;
use warnings;
-use CHI::Test;
-use DBI;
-use base qw(CHI::t::Driver);
-
-sub testing_driver_class { 'CHI::Driver::DBI' }
-
-sub new_cache_options {
- my $self = shift;
- my $dbh = DBI->connect(
- 'dbi:SQLite:dbname=t/dbfile.db',
- '', '',
- {
- RaiseError => 0,
- PrintError => 0,
- }
- );
+use base qw(CHI::t::Driver::DBI);
- return ( $self->SUPER::new_cache_options(), dbh => $dbh );
+sub dsn {
+ return 'dbi:SQLite:dbname=t/dbfile.db';
}
sub cleanup : Tests( shutdown ) {
- my $self = shift;
-
unlink 't/dbfile.db';
-
- return;
}
1;
Modified: dbi-driver/lib/CHI/t/Driver/DBI/mysql.pm
==============================================================================
--- dbi-driver/lib/CHI/t/Driver/DBI/mysql.pm (original)
+++ dbi-driver/lib/CHI/t/Driver/DBI/mysql.pm Mon Mar 16 22:00:50 2009
@@ -2,25 +2,11 @@
use strict;
use warnings;
-use CHI::Test;
-use DBI;
-use base qw(CHI::t::Driver);
-sub testing_driver_class { 'CHI::Driver::DBI' }
+use base qw(CHI::t::Driver::DBI);
-sub new_cache_options {
- my $self = shift;
-
- my $dbh = DBI->connect(
- 'dbi:mysql:database=test',
- '', '',
- {
- RaiseError => 0,
- PrintError => 0,
- }
- );
-
- return ( $self->SUPER::new_cache_options(), dbh => $dbh );
+sub dsn {
+ return 'dbi:mysql:database=test';
}
1;