Author: spadkins
Date: Fri Feb 22 12:48:06 2008
New Revision: 10819
Added:
p5ee/trunk/App-Repository/lib/App/SharedDatastore/
p5ee/trunk/App-Repository/lib/App/SharedDatastore/Repository.pm
p5ee/trunk/App-Repository/t/DBI-getset-cache.t (contents, props
changed)
p5ee/trunk/App-Repository/t/SharedDatastore.t (contents, props
changed)
Modified:
p5ee/trunk/App-Repository/CHANGES
p5ee/trunk/App-Repository/bin/dbget
p5ee/trunk/App-Repository/lib/App/Repository.pm
p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm
p5ee/trunk/App-Repository/t/DBI-metadata.t
Log:
add query caching and support for a Repository-based shared_datastore
Modified: p5ee/trunk/App-Repository/CHANGES
==============================================================================
--- p5ee/trunk/App-Repository/CHANGES (original)
+++ p5ee/trunk/App-Repository/CHANGES Fri Feb 22 12:48:06 2008
@[EMAIL PROTECTED]
-3,6 +3,7 @[EMAIL PROTECTED]
#########################################
0.966 (not yet released)
+ x App::Repository::get_rows()/get_row(): use query caching if turned on
for the table ({cache_name} => "name_of_shared_datastore")
x App::Repository::create_temporary_object_set(): can create a temporary
object set with data, not bound to the database
x App::Repository::create_temporary_object_domain(): can create a
temporary object domain with data, not bound to the database
x App::Repository::evaluate_expression(): can now supply defaults for
null columns
Modified: p5ee/trunk/App-Repository/bin/dbget
==============================================================================
--- p5ee/trunk/App-Repository/bin/dbget (original)
+++ p5ee/trunk/App-Repository/bin/dbget Fri Feb 22 12:48:06 2008
@[EMAIL PROTECTED]
-3,7 +3,8 @[EMAIL PROTECTED]
use Date::Format;
use App::Options (
- options => [ qw(dbhost dbname dbuser dbpass repository table params
columns headings compact decimals subtotal_columns totals verbose) ],
+ options => [ qw(dbhost dbname dbuser dbpass repository table params
columns headings compact decimals subtotal_columns totals
+ cache_skip cache_refresh verbose) ],
option => {
repository => {
default => "default",
@[EMAIL PROTECTED]
-36,6 +37,12 @[EMAIL PROTECTED]
totals => {
description => "Print totals at the end",
},
+ cache_skip => {
+ description => "Skip any cached values for the table",
+ },
+ cache_refresh => {
+ description => "Skip any cached values for the table but save
the results in the cache",
+ },
verbose => {
default => 1,
description => "Verbose level",
@[EMAIL PROTECTED]
-62,7 +69,10 @[EMAIL PROTECTED]
my $params = { split(/[=>\|]+/, $App::options{params}) };
my $headings = $App::options{headings} ? [ split(/,/,
$App::options{headings}) ] : [];
my $verbose = $App::options{verbose};
- my $rows = $db->get_rows($table, $params, $columns,
{extend_columns => 1});
+ my $get_options = { extend_columns => 1 };
+ $get_options->{cache_skip} = 1 if ($App::options{cache_skip});
+ $get_options->{cache_refresh} = 1 if ($App::options{cache_refresh});
+ my $rows = $db->get_rows($table, $params, $columns,
$get_options);
my ($subtotal_rows, $total_rows);
if ($App::options{subtotal_columns}) {
my $subtotal_columns = [ split(/,/,
$App::options{subtotal_columns}) ];
Modified: p5ee/trunk/App-Repository/lib/App/Repository.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/Repository.pm (original)
+++ p5ee/trunk/App-Repository/lib/App/Repository.pm Fri Feb 22 12:48:06
2008
@[EMAIL PROTECTED]
-613,6 +613,7 @[EMAIL PROTECTED]
}
else {
$self->_load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
+
if (!defined $cols) {
$cols = $self->_get_default_columns($table);
}
@[EMAIL PROTECTED]
-624,33 +625,80 @[EMAIL PROTECTED]
@[EMAIL PROTECTED]
= @[EMAIL PROTECTED]
}
- my ($col, $contains_expr);
- my $column_defs = $self->{table}{$table}{column};
- for (my $i = 0; $i <= $#$cols; $i++) {
- $col = $cols->[$i];
- $contains_expr = 1 if ($column_defs->{$col}{expr});
- # TO BE IMPLEMENTED: Automatically follow relationships for
column defs
- # TO BE IMPLEMENTED: Delegated get_rows() and merge on
another table
- #for ($rel = 0; $rel <= $#rel_prefix; $rel++) {
- # $rel_prefix = $rel_prefix[$rel];
- # $rel_cols = $rel_cols[$rel];
- # $rel_col_idx = $rel_col_idx[$rel];
- # if ($col =~ /^${rel_prefix}_(.+)$/) {
- # $col2 = $1;
- # push(@[EMAIL PROTECTED]
$col2);
- # $rel_col_idx->[$#$rel_cols] = $i;
- # last;
- # }
- #}
- }
- if ($contains_expr) {
- $cols = $self->extend_columns($table, $cols);
- }
-
- $row = $self->_get_row($table, $params, $cols, $options);
+ my $tabledef = $self->{table}{$table};
+ my ($sds, $hashkey, @[EMAIL PROTECTED]
);
+ if ($tabledef->{cache_name} && !$options->{cache_skip}) {
+ my $context = $self->{context};
+ my $cache_minimum_columns =
$tabledef->{cache_minimum_columns};
+ if ($cache_minimum_columns) {
+ my (%colidx, $col);
+ my $cache_columns = [ @[EMAIL PROTECTED]
];
+ for (my $i = 0; $i <= $#$cache_minimum_columns; $i++) {
+ $col = $cache_minimum_columns->[$i];
+ $colidx{$col} = $i;
+ }
+ foreach $col (sort @[EMAIL PROTECTED]
) {
+ if (! defined $colidx{$col}) {
+ push(@[EMAIL PROTECTED]
$col);
+ $colidx{$col} = $#$cache_columns;
+ }
+ }
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ $col = $cols->[$i];
+ $cache_colidx_map[$i] = $colidx{$col};
+ }
+ $cols = $cache_columns;
+ }
+ $sds = $context->shared_datastore($tabledef->{cache_name});
+ my ($hash_options);
+ if (defined $options) {
+ $hash_options = { %$options };
+ delete $hash_options->{cache_skip};
+ delete $hash_options->{cache_refresh};
+ $hash_options = undef if (! %$hash_options);
+ }
+ $hashkey = $sds->hashkey([$table, $params, $cols,
$hash_options, "row"]);
+ if (!$options->{cache_refresh}) {
+ $row = $sds->get_ref($hashkey);
+ }
+ }
+
+ if (! defined $row) {
+ my ($col, $contains_expr);
+ my $column_defs = $self->{table}{$table}{column};
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ $col = $cols->[$i];
+ $contains_expr = 1 if ($column_defs->{$col}{expr});
+ # TO BE IMPLEMENTED: Automatically follow relationships
for column defs
+ # TO BE IMPLEMENTED: Delegated get_rows() and merge on
another table
+ #for ($rel = 0; $rel <= $#rel_prefix; $rel++) {
+ # $rel_prefix = $rel_prefix[$rel];
+ # $rel_cols = $rel_cols[$rel];
+ # $rel_col_idx = $rel_col_idx[$rel];
+ # if ($col =~ /^${rel_prefix}_(.+)$/) {
+ # $col2 = $1;
+ # push(@[EMAIL PROTECTED]
$col2);
+ # $rel_col_idx->[$#$rel_cols] = $i;
+ # last;
+ # }
+ #}
+ }
+ if ($contains_expr) {
+ $cols = $self->extend_columns($table, $cols);
+ }
+
+ $row = $self->_get_row($table, $params, $cols, $options);
+
+ if ($contains_expr) {
+ $self->evaluate_expressions($table, $params, $cols,
[$row], $options);
+ }
- if ($contains_expr) {
- $self->evaluate_expressions($table, $params, $cols, [$row],
$options);
+ if ($sds) {
+ $sds->set_ref($hashkey, $row);
+ }
+ }
+ if ($sds && $tabledef->{cache_minimum_columns} && $row) {
+ $row = [ @[EMAIL PROTECTED]
];
}
}
&App::sub_exit($row) if ($App::trace);
@[EMAIL PROTECTED]
-849,6 +897,7 @[EMAIL PROTECTED]
}
else {
$self->_load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
+
if (!defined $cols) {
$cols = $self->_get_default_columns($table);
}
@[EMAIL PROTECTED]
-860,38 +909,88 @[EMAIL PROTECTED]
@[EMAIL PROTECTED]
= @[EMAIL PROTECTED]
}
- my ($col, $contains_expr);
- my $column_defs = $self->{table}{$table}{column};
- for (my $i = 0; $i <= $#$cols; $i++) {
- $col = $cols->[$i];
- $contains_expr = 1 if ($column_defs->{$col}{expr});
- # TO BE IMPLEMENTED: Automatically follow relationships for
column defs
- # TO BE IMPLEMENTED: Delegated get_rows() and merge on
another table
- #for ($rel = 0; $rel <= $#rel_prefix; $rel++) {
- # $rel_prefix = $rel_prefix[$rel];
- # $rel_cols = $rel_cols[$rel];
- # $rel_col_idx = $rel_col_idx[$rel];
- # if ($col =~ /^${rel_prefix}_(.+)$/) {
- # $col2 = $1;
- # push(@[EMAIL PROTECTED]
$col2);
- # $rel_col_idx->[$#$rel_cols] = $i;
- # last;
- # }
- #}
- }
- if ($contains_expr) {
- my $new_cols = $self->extend_columns($table, $cols);
- # the caller wanted his column list extended
- if ($#$new_cols > $#$cols && $options->{extend_columns}) {
- @[EMAIL PROTECTED]
= @[EMAIL PROTECTED]
# so copy the columns
+ my $tabledef = $self->{table}{$table};
+ my ($sds, $hashkey, @[EMAIL PROTECTED]
);
+ if ($tabledef->{cache_name} && !$options->{cache_skip}) {
+ my $context = $self->{context};
+ my $cache_minimum_columns =
$tabledef->{cache_minimum_columns};
+ if ($cache_minimum_columns) {
+ my (%colidx, $col);
+ my $cache_columns = [ @[EMAIL PROTECTED]
];
+ for (my $i = 0; $i <= $#$cache_minimum_columns; $i++) {
+ $col = $cache_minimum_columns->[$i];
+ $colidx{$col} = $i;
+ }
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ $col = $cols->[$i];
+ if (! defined $colidx{$col}) {
+ push(@[EMAIL PROTECTED]
$col);
+ $colidx{$col} = $#$cache_columns;
+ }
+ $cache_colidx_map[$i] = $colidx{$col};
+ }
+ $cols = $cache_columns;
+ }
+ $sds = $context->shared_datastore($tabledef->{cache_name});
+ my ($hash_options);
+ if (defined $options) {
+ $hash_options = { %$options };
+ delete $hash_options->{cache_skip};
+ delete $hash_options->{cache_refresh};
+ $hash_options = undef if (! %$hash_options);
+ }
+ $hashkey = $sds->hashkey([$table, $params, $cols,
$hash_options, "row"]);
+ if (!$options->{cache_refresh}) {
+ $rows = $sds->get_ref($hashkey);
+ }
+ }
+
+ if (! defined $rows) {
+
+ my ($col, $contains_expr);
+ my $column_defs = $self->{table}{$table}{column};
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ $col = $cols->[$i];
+ $contains_expr = 1 if ($column_defs->{$col}{expr});
+ # TO BE IMPLEMENTED: Automatically follow relationships
for column defs
+ # TO BE IMPLEMENTED: Delegated get_rows() and merge on
another table
+ #for ($rel = 0; $rel <= $#rel_prefix; $rel++) {
+ # $rel_prefix = $rel_prefix[$rel];
+ # $rel_cols = $rel_cols[$rel];
+ # $rel_col_idx = $rel_col_idx[$rel];
+ # if ($col =~ /^${rel_prefix}_(.+)$/) {
+ # $col2 = $1;
+ # push(@[EMAIL PROTECTED]
$col2);
+ # $rel_col_idx->[$#$rel_cols] = $i;
+ # last;
+ # }
+ #}
+ }
+ if ($contains_expr) {
+ my $new_cols = $self->extend_columns($table, $cols);
+ # the caller wanted his column list extended
+ if ($#$new_cols > $#$cols && $options->{extend_columns})
{
+ @[EMAIL PROTECTED]
= @[EMAIL PROTECTED]
# so copy the columns
+ }
+ $cols = $new_cols; # then point to the new columns
regardless
+ }
+
+ $rows = $self->_get_rows($table, $params, $cols, $options);
+
+ if ($contains_expr) {
+ $self->evaluate_expressions($table, $params, $cols,
$rows, $options);
}
- $cols = $new_cols; # then point to the new columns
regardless
- }
-
- $rows = $self->_get_rows($table, $params, $cols, $options);
- if ($contains_expr) {
- $self->evaluate_expressions($table, $params, $cols, $rows,
$options);
+ if ($sds) {
+ $sds->set_ref($hashkey, $rows);
+ }
+ }
+ if ($sds && $tabledef->{cache_minimum_columns}) {
+ my $requested_rows = [];
+ foreach my $row (@[EMAIL PROTECTED]
) {
+ push(@[EMAIL PROTECTED]
[ @[EMAIL PROTECTED]
]);
+ }
+ $rows = $requested_rows;
}
}
&App::sub_exit($rows) if ($App::trace);
Modified: p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm (original)
+++ p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm Fri Feb 22
12:48:06 2008
@[EMAIL PROTECTED]
-2818,7 +2818,8 @[EMAIL PROTECTED]
# get a list of the physical tables from the database
# in MySQL 4.0.13, the table names are surrounded by backticks
(!?!)
# so for safe measure, get rid of all quotes
- @[EMAIL PROTECTED]
= grep(s/['"`]//g, $dbh->tables(undef, undef, undef,
"TABLE"));
+ # Also, get rid of prepended schema names.
+ @[EMAIL PROTECTED]
= grep(s/^[^.]+\.//, grep(s/['"`]//g, $dbh->tables(undef,
undef, undef, "TABLE")));
# REMOVE ALL DEPENDENCE ON DBIx::Compat
# if the DBI method doesn't work, try the DBIx method...
Added: p5ee/trunk/App-Repository/lib/App/SharedDatastore/Repository.pm
==============================================================================
--- (empty file)
+++ p5ee/trunk/App-Repository/lib/App/SharedDatastore/Repository.pm Fri
Feb 22 12:48:06 2008
@[EMAIL PROTECTED]
-0,0 +1,257 @[EMAIL PROTECTED]
$Id: Repository.pm 6783 2006-08-11 17:43:28Z spadkins $
+#############################################################################
+
+package App::SharedDatastore::Repository;
+$VERSION = (q$Revision: 6783 $ =~ /(\d[\d\.]*)/)[0]; # VERSION numbers
generated by svn
+
+use App;
+use App::SharedDatastore;
+@[EMAIL PROTECTED]
= ( "App::SharedDatastore" );
+
+use strict;
+
+use Storable qw(nfreeze thaw);
+use Digest::SHA qw(sha1_hex);
+use Date::Format;
+
+$Storable::canonical = 1; # this will cause hashes to be serialized the
same way every time
+
+=head1 NAME
+
+App::SharedDatastore - Interface for sharing data between processes
+
+=head1 SYNOPSIS
+
+ use App;
+
+ $context = App->context();
+ $sds = $context->service("SharedDatastore");
+ $sds = $context->shared_datastore();
+
+=head1 DESCRIPTION
+
+A SharedDatastore service represents a single hash in which scalars or
+deep references may be stored (basically an MLDBM).
+
+=cut
+
+#############################################################################
+# CLASS GROUP
+#############################################################################
+
+=head1 Class Group: SharedDatastore
+
+The following classes might be a part of the SharedDatastore Class Group.
+
+=over
+
+=item * Class: App::SharedDatastore
+
+=item * Class: App::SharedDatastore::Repository
+
+=item * Class: App::SharedDatastore::IPCMM
+
+=item * Class: App::SharedDatastore::DBI
+
+=item * Class: App::SharedDatastore::MLDBM
+
+=item * Class: App::SharedDatastore::ApacheSession
+
+=item * Class: App::SharedDatastore::IPCShareLite
+
+=item * Class: App::SharedDatastore::IPCShareable
+
+=back
+
+=cut
+
+#############################################################################
+# CLASS
+#############################################################################
+
+=head1 Class: App::SharedDatastore::Repository
+
+A SharedDatastore service represents a single hash in which scalars or
+deep references may be stored. (They are automatically serialized
+for storage.)
+
+A sample configuration for an App::SharedDatastore::Repository is the
following.
+
+ SharedDatastore => {
+ default => {
+ class =>
"App::SharedDatastore::Repository",
+ compress => 1,
+ repository => "default",
+ table => "app_cache",
+ cache_type => "dbquery",
+ cache_type_column => "cache_type",
+ cache_key_column => "cache_key",
+ data_column => "data",
+ generate_dttm_column => "generate_dttm",
+ serializer_column => "serializer",
+ serialization_args_column => "serialization_args",
+ },
+
+=cut
+
+#############################################################################
+# CONSTRUCTOR METHODS
+#############################################################################
+
+=head1 Constructor Methods:
+
+=cut
+
+#############################################################################
+# new()
+#############################################################################
+
+=head2 new()
+
+The constructor is inherited from
+L<C<App::Service>|App::Service/"new()">.
+
+=cut
+
+#############################################################################
+# _init()
+#############################################################################
+
+=head2 _init()
+
+=cut
+
+sub _init {
+ &App::sub_entry if ($App::trace);
+ my ($self) = @[EMAIL PROTECTED]
$self->SUPER::_init();
+ &App::sub_exit() if ($App::trace);
+}
+
+#############################################################################
+# PUBLIC METHODS
+#############################################################################
+
+=head1 Public Methods:
+
+=cut
+
+#############################################################################
+# set()
+#############################################################################
+
+=head2 set()
+
+ * Signature: $sds->set($key, $value);
+ * Signature: $sds->set($key, $value, $options);
+ * Param: $key scalar
+ * Param: $value scalar
+ * Param: $options HASH (optional)
+ * Return: void
+
+ $sds->set($key,$value);
+ $options = {
+ info_columns => [ "col1", "col2" ],
+ info_values => [ "value1", "value2" ],
+ };
+ $sds->set($key, $value, $options);
+
+=cut
+
+sub set {
+ &App::sub_entry if ($App::trace);
+ my ($self, $key, $value, $options) = @[EMAIL PROTECTED]
my $context = $self->{context};
+ my $rep =
$context->repository($self->{repository});
+ my $table = $self->{table} ||
"app_cache";
+ my $cache_type = $self->{cache_type} ||
"default";
+ my $cache_type_column = $self->{cache_type_column} ||
"cache_type";
+ my $cache_key_column = $self->{cache_key_column} ||
"cache_key";
+ my $data_column = $self->{data_column} ||
"data";
+
+ my @[EMAIL PROTECTED]
= ($cache_type_column, $cache_key_column, $data_column);
+ my @[EMAIL PROTECTED]
= ($cache_type, $key, $value);
+ my %update_columns = ( $data_column => 1 );
+
+ my $generate_dttm_column = $self->{generate_dttm_column};
+ if ($generate_dttm_column) {
+ push(@[EMAIL PROTECTED]
$generate_dttm_column);
+ push(@[EMAIL PROTECTED]
time2str("%Y-%m-%d %H:%M:%S", time()));
+ $update_columns{$generate_dttm_column} = 1;
+ }
+
+ my $serializer_column = $self->{serializer_column};
+ if ($serializer_column) {
+ push(@[EMAIL PROTECTED]
$serializer_column);
+ push(@[EMAIL PROTECTED]
"internal");
+ $update_columns{$serializer_column} = 1;
+ }
+
+ my $serialization_args_column = $self->{serialization_args_column};
+ if ($serialization_args_column) {
+ push(@[EMAIL PROTECTED]
$serialization_args_column);
+ my $serialization_args = "";
+ $serialization_args = "compress" if ($self->{compress});
+ if ($self->{base64}) {
+ $serialization_args .= "," if ($serialization_args);
+ $serialization_args .= "base64";
+ }
+ push(@[EMAIL PROTECTED]
$serialization_args);
+ $update_columns{$serialization_args_column} = 1;
+ }
+
+ $rep->insert($table, \@[EMAIL PROTECTED]
\@[EMAIL PROTECTED]
{ update => \%update_columns
});
+
+ &App::sub_exit() if ($App::trace);
+}
+
+#############################################################################
+# get()
+#############################################################################
+
+=head2 get()
+
+ * Signature: $value = $sds->get($key);
+ * Param: $key scalar
+ * Return: $value scalar
+
+ $value = $sds->get($key);
+
+=cut
+
+sub get {
+ &App::sub_entry if ($App::trace);
+ my ($self, $key) = @[EMAIL PROTECTED]
my $context = $self->{context};
+ my $rep =
$context->repository($self->{repository});
+ my $table = $self->{table} ||
"app_cache";
+ my $cache_type = $self->{cache_type} ||
"default";
+ my $cache_type_column = $self->{cache_type_column} ||
"cache_type";
+ my $cache_key_column = $self->{cache_key_column} ||
"cache_key";
+ my $data_column = $self->{data_column} ||
"data";
+
+ my $value = $rep->get($table, { $cache_type_column => $cache_type,
$cache_key_column => $key }, $data_column);
+
+ &App::sub_exit("<binary>") if ($App::trace);
+ return($value);
+}
+
+=head1 ACKNOWLEDGEMENTS
+
+ * Author: Stephen Adkins <spadkins@[EMAIL PROTECTED]
>
+ * License: This is free software. It is licensed under the same terms as
Perl itself.
+
+=head1 SEE ALSO
+
+L<C<App::Context>|App::Context>,
+L<C<App::Service>|App::Service>
+L<C<App::SharedDatastore>|App::SharedDatastore>
+
+=cut
+
+1;
+
Added: p5ee/trunk/App-Repository/t/DBI-getset-cache.t
==============================================================================
--- (empty file)
+++ p5ee/trunk/App-Repository/t/DBI-getset-cache.t Fri Feb 22 12:48:06
2008
@[EMAIL PROTECTED]
-0,0 +1,215 @[EMAIL PROTECTED]
-w
+
+use App::Options (
+ options => [qw(dbdriver dbclass dbhost dbname dbuser dbpass)],
+ option => {
+ dbclass => { default => "App::Repository::MySQL", },
+ dbdriver => { default => "mysql", },
+ dbhost => { default => "localhost", },
+ dbname => { default => "test", },
+ dbuser => { default => "", },
+ dbpass => { default => "", },
+ },
+);
+
+use Test::More qw(no_plan);
+use lib "../App-Context/lib";
+use lib "../../App-Context/lib";
+use lib "lib";
+use lib "../lib";
+
+use App;
+use App::Repository;
+use strict;
+
+if (!$App::options{dbuser}) {
+ ok(1, "No dbuser given. Tests assumed OK. (add dbuser=xxx and
dbpass=yyy to app.conf in 't' directory)");
+ exit(0);
+}
+
+my $context = App->context(
+ conf_file => "",
+ conf => {
+ Repository => {
+ default => {
+ class => $App::options{dbclass},
+ dbdriver => $App::options{dbdriver},
+ dbhost => $App::options{dbhost},
+ dbname => $App::options{dbname},
+ dbuser => $App::options{dbuser},
+ dbpass => $App::options{dbpass},
+ table => {
+ test_person => {
+ primary_key => ["person_id"],
+ cache_name => "test_cache",
+ cache_minimum_columns => [ "person_id", "age",
"first_name", "gender", ],
+ },
+ },
+ },
+ },
+ SharedDatastore => {
+ test_cache => {
+ class =>
"App::SharedDatastore::Repository",
+ compress => 1,
+ repository => "default",
+ table => "app_cache",
+ cache_type => "dbquery",
+ cache_type_column => "cache_type",
+ cache_key_column => "cache_key",
+ data_column => "data",
+ generate_dttm_column => "generate_dttm",
+ serializer_column => "serializer",
+ serialization_args_column => "serialization_args",
+ },
+ },
+ },
+ debug_sql => $App::options{debug_sql},
+);
+
+my $rep = $context->repository();
+
+{
+ #cheating... I know its a DBI, but I have to set up the test somehow
+ my $dbh = $rep->{dbh};
+ eval { $dbh->do("drop table test_person"); };
+
+ my $ddl = <<EOF;
+create table test_person (
+ person_id integer not null auto_increment primary key,
+ first_name varchar(99) null,
+ last_name varchar(99) null,
+ address varchar(99) null,
+ city varchar(99) null,
+ state varchar(99) null,
+ zip varchar(10) null,
+ country char(2) null,
+ home_phone varchar(99) null,
+ work_phone varchar(99) null,
+ email_address varchar(99) null,
+ gender char(1) null,
+ birth_dt date null,
+ age integer null,
+ index person_ie1 (last_name, first_name)
+)
+EOF
+ $dbh->do($ddl);
+
+ eval { $dbh->do("drop table if exists app_cache"); };
+ $ddl = <<EOF;
+create table app_cache (
+ cache_type varchar(16) not null,
+ cache_key varchar(40) not null,
+ generate_dttm datetime default null,
+ serializer varchar(12) default null,
+ serialization_args varchar(64) default null,
+ data longblob,
+ modify_dttm timestamp not null default CURRENT_TIMESTAMP on
update CURRENT_TIMESTAMP,
+ PRIMARY KEY (cache_type,cache_key),
+ KEY app_cache_ie1 (modify_dttm)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1
+EOF
+ $dbh->do($ddl);
+
+ $dbh->do("insert into test_person
(person_id,age,first_name,gender,state) values (1,39,'stephen',
'M','GA')");
+ $dbh->do("insert into test_person
(person_id,age,first_name,gender,state) values (2,37,'susan',
'F','GA')");
+ $dbh->do("insert into test_person
(person_id,age,first_name,gender,state) values (3,
6,'maryalice','F','GA')");
+ $dbh->do("insert into test_person
(person_id,age,first_name,gender,state) values (4, 3,'paul',
'M','GA')");
+ $dbh->do("insert into test_person
(person_id,age,first_name,gender,state) values (5,
1,'christine','F','GA')");
+ $dbh->do("insert into test_person
(person_id,age,first_name,gender,state) values (6,45,'tim',
'M','FL')");
+ $dbh->do("insert into test_person
(person_id,age,first_name,gender,state) values (7,39,'keith',
'M','GA')");
+}
+
+###########################################################################
+# DATA ACCESS TESTS
+###########################################################################
+my ($person_id, $first_name, $last_name, $address, $city, $state, $zip,
$country);
+my ($home_phone, $work_phone, $email_address, $gender, $birth_dt, $age);
+
+my $columns = [ "person_id", "age", "first_name", "gender", "state" ];
+my $rows = [
+ [ 1, 39, "stephen", "M", "GA", ],
+ [ 2, 37, "susan", "F", "GA", ],
+ [ 3, 6, "maryalice", "F", "GA", ],
+ [ 4, 3, "paul", "M", "GA", ],
+ [ 5, 1, "christine", "F", "GA", ],
+ [ 6, 45, "tim", "M", "FL", ],
+ [ 7, 39, "keith", "M", "GA", ],
+];
+
+my ($row, $data_rows, $data_rows2, $nrows);
+
+#####################################################################
+# $value = $rep->get ($table, $key, $col, \%options);
+# $rep->set($table, $key, $col, $value, \%options);
+#####################################################################
+$data_rows = $rep->get_rows("test_person", {}, ["state"],
{order_by=>["person_id"]});
+$first_name = $rep->get("test_person", 1, "first_name");
+is($first_name, "stephen", "get() first_name [$first_name]");
+is($rep->set("test_person", 1, "first_name", "steve"),1,"set() first name
[steve]");
+$first_name = $rep->get("test_person", 1, "first_name");
+is($first_name, "stephen", "get() modified first_name [$first_name] got
cache instead");
+$first_name = $rep->get("test_person", {person_id => 1}, "first_name");
+is($first_name, "steve", "get() modified first_name [$first_name]");
+$age = $rep->get("test_person", 1, "age");
+is($age, 39, "get() age");
+
+ok($rep->set("test_person", 2, ["first_name","age"], ["sue",38]), "set()
2 values");
+($first_name, $age) = $rep->get("test_person", 2, ["first_name","age"]);
+is($first_name, "sue", "get() 2 values (checking 1 of 2)");
+is($age, 38, "get() 2 values (checking 2 of 2)");
+
+ok($rep->set_row("test_person", 3, ["age", "state"], [7,
"CA"]),"set_row() 2 values");
+$row = $rep->get_row("test_person", 4, ["age", "gender"]);
+($age, $gender) = @[EMAIL PROTECTED]
($age, 3, "get_row() 2 values (checking 1 of 2)");
+is($gender, "M", "get_row() 2 values (checking 2 of 2)");
+
+ok($rep->set_row("test_person", {first_name=>'paul'}, ["age", "state"],
[5, "CA"]),"set_row() 2 values w/ %crit");
+$row = $rep->get_row("test_person", {first_name=>'paul'}, ["age",
"state","person_id"]);
+($age, $state, $person_id) = @[EMAIL PROTECTED]
($age, 5, "get_row() 3 values w/ %crit (checking 1 of 3)
age=$age");
+is($state, "CA", "get_row() 3 values w/ %crit (checking 2 of 3)
state=$state");
+is($person_id, 4, "get_row() 3 values w/ %crit (checking 3 of 3)
person_id=$person_id");
+
+ok($rep->set_row("test_person", {first_name=>'paul'}, ["age", "state"],
{age=>6, state=>"GA", person_id=>99}),
+ "set_row() 2 values w/ %crit and values in hash");
+
+$row = $rep->get_row("test_person", {first_name=>'paul'}, ["age",
"state","person_id"]);
+($age, $state, $person_id) = @[EMAIL PROTECTED]
($age, 5, "get_row() 3 values w/ %crit (checking 1 of 3)
age=$age got cache instead");
+is($state, "CA", "get_row() 3 values w/ %crit (checking 2 of 3)
state=$state got cache instead");
+is($person_id, 4, "get_row() 3 values w/ %crit (checking 3 of 3)
person_id=$person_id");
+
+$data_rows = $rep->get_rows("test_person", {first_name=>'paul', x=>1},
["age", "state","person_id"]);
+$row = $data_rows->[0];
+($age, $state, $person_id) = @[EMAIL PROTECTED]
($age, 6, "get_row() 3 values w/ %crit (checking 1 of 3)
age=$age");
+is($state, "GA", "get_row() 3 values w/ %crit (checking 2 of 3)
state=$state");
+is($person_id, 4, "get_row() 3 values w/ %crit (checking 3 of 3)
person_id=$person_id");
+
+$data_rows = $rep->get_rows("test_person", {}, [ "person_id", "age",
"first_name", "gender", "state" ], {order_by=>["person_id"]});
+is_deeply($data_rows, $rows, "get_rows() got original cached data thanks
to cache_minimum_rows");
+
+$data_rows2 = $rep->{dbh}->selectall_arrayref("select person_id, age,
first_name, gender, state from test_person order by person_id");
+$data_rows = $rep->get_rows("test_person", {}, [ "person_id", "age",
"first_name", "gender", "state" ], {order_by=>["person_id"], cache_skip =>
1});
+is_deeply($data_rows, $data_rows2, "get_rows() skipped cached data thanks
to cache_skip");
+$first_name = $rep->get("test_person", 1, "first_name", { cache_skip => 1
});
+is($first_name, "steve", "get() modified first_name [$first_name] by
skipping the cache");
+
+$data_rows = $rep->get_rows("test_person", {}, [ "person_id", "age",
"first_name", "gender", "state" ], {order_by=>["person_id"], cache_refresh
=> 1});
+is_deeply($data_rows, $data_rows2, "get_rows() refreshed cached data
thanks to cache_refresh");
+$first_name = $rep->get("test_person", 1, "first_name", { cache_refresh
=> 1 });
+is($first_name, "steve", "get() modified first_name [$first_name] by
refreshing the cache");
+
+$data_rows = $rep->get_rows("test_person", {}, [ "person_id", "age",
"first_name", "gender", "state" ], {order_by=>["person_id"]});
+is_deeply($data_rows, $data_rows2, "get_rows() confirmed that the cache
was refreshed");
+$first_name = $rep->get("test_person", 1, "first_name");
+is($first_name, "steve", "get() modified first_name [$first_name]
confirming that the cache was refreshed");
+
+{
+ my $dbh = $rep->{dbh};
+ $dbh->do("drop table test_person");
+}
+
+exit 0;
+
Modified: p5ee/trunk/App-Repository/t/DBI-metadata.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-metadata.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-metadata.t Fri Feb 22 12:48:06 2008
@[EMAIL PROTECTED]
-59,6 +59,7 @[EMAIL PROTECTED]
{
#cheating... I know its a DBI, but I have to set up the test somehow
my $dbh = $db->{dbh};
+ eval { $dbh->do("drop table if exists app_cache"); };
eval { $dbh->do("drop table test_person"); };
my $ddl = <<EOF;
create table test_person (
@[EMAIL PROTECTED]
-87,7 +88,7 @[EMAIL PROTECTED]
# METADATA TESTS
###########################################################################
my $table_names = $db->get_table_names();
-#print "tables=[@[EMAIL PROTECTED]
";
+print "tables=[@[EMAIL PROTECTED]
";
my %tables = ( map { $_ => 1 } @[EMAIL PROTECTED]
);
ok(defined $tables{test_person}, "get_table_names()");
$db->_load_rep_metadata();
Added: p5ee/trunk/App-Repository/t/SharedDatastore.t
==============================================================================
--- (empty file)
+++ p5ee/trunk/App-Repository/t/SharedDatastore.t Fri Feb 22 12:48:06 2008
@[EMAIL PROTECTED]
-0,0 +1,154 @[EMAIL PROTECTED]
-w
+
+use strict;
+
+use App::Options (
+ options => [qw(dbdriver dbclass dbhost dbname dbuser dbpass)],
+ option => {
+ dbclass => { default => "App::Repository::MySQL", },
+ dbdriver => { default => "mysql", },
+ dbhost => { default => "localhost", },
+ dbname => { default => "test", },
+ dbuser => { default => "", },
+ dbpass => { default => "", },
+ },
+);
+
+use Test::More qw(no_plan);
+use lib "../App-Context/lib";
+use lib "../../App-Context/lib";
+use lib "lib";
+use lib "../lib";
+
+if (!$App::options{dbuser}) {
+ ok(1, "No dbuser given. Tests assumed OK. (add dbuser=xxx and
dbpass=yyy to app.conf in 't' directory)");
+ exit(0);
+}
+
+BEGIN {
+ use_ok("App");
+}
+
+my $context = App->context(
+ %App::options,
+ conf_file => "",
+ conf => {
+ Repository => {
+ default => {
+ class => $App::options{dbclass},
+ dbdriver => $App::options{dbdriver},
+ dbhost => $App::options{dbhost},
+ dbname => $App::options{dbname},
+ dbuser => $App::options{dbuser},
+ dbpass => $App::options{dbpass},
+ table => {
+ test_person => {
+ primary_key => ["person_id"],
+ column => {
+ data => {
+ dbexpr =>
"ifnull(uncompress(data),data)",
+ dbexpr_update => "compress(%s)",
+ },
+ },
+ },
+ },
+ },
+ },
+ SharedDatastore => {
+ default => {
+ class =>
"App::SharedDatastore::Repository",
+ compress => 1,
+ repository => "default",
+ table => "app_cache",
+ cache_type => "dbquery",
+ cache_type_column => "cache_type",
+ cache_key_column => "cache_key",
+ data_column => "data",
+ generate_dttm_column => "generate_dttm",
+ serializer_column => "serializer",
+ serialization_args_column => "serialization_args",
+ },
+ },
+ },
+);
+
+{
+ &initialize_tests();
+
+ my ($sds, $key, $value, $keyref, $valueref, $valueref2, $hashkey,
$serialized_value);
+
+ foreach my $name ("default") {
+ $sds = $context->service("SharedDatastore", $name);
+ ok(defined $sds, "[$name] constructor ok");
+
+ isa_ok($sds, "App::SharedDatastore", "[$name] right class");
+ is($sds->service_type(), "SharedDatastore", "[$name] right
service type");
+
+ my $dump = $sds->dump();
+ ok($dump =~ /^\$SharedDatastore__$name = /, "[$name] dump");
+
+ $sds->set("pi", 3.1416);
+ $value = $sds->get("pi");
+ is($value, 3.1416, "[$name] set()/get() works (for pi=$value)");
+
+ $keyref = [ "person",
+ { "age.ge" => 21, last_name => "Adkins" },
+ [ "person_id", "last_name", "first_name", "age", "eye_color"
],
+ { numrows => 20, cache => {}, },
+ ];
+ $valueref = [
+ [ 1, "Adkins", "Stephen", 40, "Blue", ],
+ [ 2, "Adkins", "Susan (Little)", 40, "Brown", ],
+ [ 3, "Adkins", "Bill", 43, "Brown", ],
+ [ 4, "Adkins", "Susan", 44, "Brown", ],
+ [ 5, "Adkins", "Marybeth", 47, "Blue", ],
+ ];
+
+ $sds->set_ref($keyref, $valueref);
+ $valueref2 = $sds->get_ref($keyref);
+ is_deeply($valueref, $valueref2, "[$name] set_ref()/get_ref()
works");
+
+ $hashkey = $sds->hashkey($keyref);
+ $valueref2 = $sds->get_ref($hashkey);
+ is_deeply($valueref, $valueref2, "[$name]
set_ref()/get_ref(hashkey) works (hashkey=$hashkey)");
+
+ $serialized_value = $sds->serialize($valueref);
+ $value = $sds->get($hashkey);
+ is($value, $serialized_value, "[$name] set_ref()/get(hashkey)
works");
+
+ $valueref2 = $sds->deserialize($serialized_value);
+ is_deeply($valueref, $valueref2, "[$name]
serialize()/deserialize() works");
+
+ $value = $sds->get("foo");
+ is($value, undef, "[$name] get(foo) is undef");
+
+ $valueref2 = $sds->get_ref("foo");
+ is($valueref2, undef, "[$name] get_ref(foo) is undef");
+
+ $sds->set_ref("foo", undef);
+ $value = $sds->get_ref("foo");
+ is($value, undef, "[$name] get_ref(foo) is undef after set to
undef");
+ }
+}
+
+sub initialize_tests {
+ my $rep = $context->repository("default");
+ $rep->_do("drop table if exists app_cache");
+ my $ddl = <<EOF;
+CREATE TABLE app_cache (
+ cache_type varchar(16) NOT NULL,
+ cache_key varchar(40) NOT NULL,
+ generate_dttm datetime default NULL,
+ serializer varchar(12) default NULL,
+ serialization_args varchar(64) default NULL,
+ data longblob,
+ modify_dttm timestamp NOT NULL default CURRENT_TIMESTAMP on update
CURRENT_TIMESTAMP,
+ PRIMARY KEY (cache_type,cache_key),
+ KEY app_cache_ie1 (modify_dttm)
+) ENGINE=InnoDB DEFAULT CHARSET=latin1
+EOF
+ $rep->_do($ddl);
+}
+
+exit 0;
+
|
