On Mon, 2005-12-19 at 00:09 -0500, John Siracusa wrote:
> Is anyone interested in adding Tangram to the Perl ORM test suite that's
> part of the Rose::DB::Object distribution? See this page (and associated
> links in it) for information on the test suite and some recent results:
>
> http://rose.sourceforge.net/wiki/index.php/RDBO/Benchmark
>
> If anyone's interested, please submit a patch against the latest CPAN
> version of Rose::DB::Object (0.58 right now). The benchmark suite is in:
>
> t/benchmarks/...
After some investigation, I'm afraid Tangram does not operate in the
manner that this test script requires. It's not really a tool for
mapping an existing database as the test expects.
Nonetheless, I've attached a quick hack at a schema that represents a
translation of the DBIx::Class classes and relational schema buried
within the bench.pl script to a cross-database compatible Tangram
schema. With a little bit of re-work, to let the test deploy the tables
itself, it may be able to fit.
I couldn't see any difference between the "complex" and "simple" cases,
apart from the use of "inflate" and "deflate", so the "Complex" schema
for the Tangram use case only uses the schema. So, it just uses a
different type (I used a Date::Manip type mapping, but any other
supported mapping works, too).
There is also the matter of how to translate code sections where the
real issue is a lack of adequate measures to represent queries. For
instance, large sections of that test suite are repeated for each type
of object being searched for or fetched. Normally, that wouldn't be
broken out into separate functions like that.
For tests like this:
SEARCH_SIMPLE_PRODUCT_AND_CATEGORY_AND_CODE_NAMES_RDBO:
{
my $printed = 0;
sub search_simple_product_and_category_and_code_name_rdbo
{
#local $Rose::DB::Object::Manager::Debug = 1;
my $ps =
MyTest::RDBO::Simple::Product::Manager->get_products(
db => $DB,
query_is_sql => 1,
prepare_cached => 1,
query =>
[
't1.name' => { like => 'Product 200%' },
],
with_objects => [ 'code_names' ],
require_objects => [ 'category' ]);
die unless(@$ps);
if($Debug && !$printed)
{
print "search_simple_product_and_category_and_code_name_rdbo GOT
", scalar(@$ps), "\n";
#$printed++;
}
foreach my $p (@$ps)
{
my $cat = $p->category;
my $n = $cat->name;
die unless($n =~ /\S/);
my $cn = $p->code_names->[0];
die unless($cn->name =~ /^CN /);
}
}
}
Is the intent just to get all the categories and codenames for products
that have a product name like "Product 200%"? Why not do it with a
single query?
sub search_simple_product_and_category_and_code_name_tangram
{
my $storage = $MyTest::Tangram::Base::GLOBALS_ARE_BAD_MKAY;
# get terms of reference.
my ($r_product, $r_category, $r_name)
= $storage->remote(qw(MyTest::Tangram::Simple::Product
MyTest::Tangram::Simple::Category
MyTest::Tangram::Simple::CodeName));
my $cursor = $storage->cursor
( undef,
filter => ( $r_product->{name}->like("Product 200%")
& ( $r_product->{category} == $r_category )
& ( $r_name->{product} == $r_product ) )
retrieve => [ $r_product->{name},
$r_category->{name},
$r_name->{name} ],
);
$cursor->execute();
while (my ($prod, $cat, $code) = $cursor->current()) {
print "Product $prod, Category $cat, code $code\n";
$cursor->next;
}
}
Obviously this new version is likely to be more efficient, depending on
the size of the data set, because a complex search could be reduced from
several queries to one.
This is one of the major reasons why I've never bothered with optimising
performance for this situation - by coding in the correct manner, the
number of very small database hits is minimised. Then it doesn't really
matter how long they take.
In my experience, the database has always been the bottleneck, apart
from for loader type scripts with large amounts of input.
>
> after expanding the module source tarball. Anyone who takes on this task
> will undoubtedly have questions. Please direct them to me, either by email
> or by posting to the RDBO mailing list:
>
> http://lists.sourceforge.net/mailman/listinfo/rose-db-object
diff -urN Rose-DB-Object-0.58.orig/t/benchmarks/lib/MyTest/Tangram/Base.pm Rose-DB-Object-0.58/t/benchmarks/lib/MyTest/Tangram/Base.pm
--- Rose-DB-Object-0.58.orig/t/benchmarks/lib/MyTest/Tangram/Base.pm 1970-01-01 12:00:00.000000000 +1200
+++ Rose-DB-Object-0.58/t/benchmarks/lib/MyTest/Tangram/Base.pm 2005-12-19 19:32:10.000000000 +1300
@@ -0,0 +1,23 @@
+package MyTest::Tangram::Base;
+
+use strict;
+
+use Rose::DB;
+
+use Tangram;
+
+our $DB;
+
+our $GLOBALS_ARE_BAD_MKAY;
+
+sub refresh
+{
+ $DB = Rose::DB->new;
+ no warnings;
+
+ $GLOBALS_ARE_BAD_MKAY = Tangram::Storage->connect
+ (__PACKAGE__->schema, $DB->dsn, $DB->username, $DB->password,
+ scalar $DB->connect_options );
+}
+
+1;
diff -urN Rose-DB-Object-0.58.orig/t/benchmarks/lib/MyTest/Tangram/Complex.pm Rose-DB-Object-0.58/t/benchmarks/lib/MyTest/Tangram/Complex.pm
--- Rose-DB-Object-0.58.orig/t/benchmarks/lib/MyTest/Tangram/Complex.pm 1970-01-01 12:00:00.000000000 +1200
+++ Rose-DB-Object-0.58/t/benchmarks/lib/MyTest/Tangram/Complex.pm 2005-12-19 20:02:51.000000000 +1300
@@ -0,0 +1,18 @@
+
+package MyTest::Tangram::Complex;
+
+use base qw(MyTest::Tangram::Simple);
+
+use Class::Tangram::Generator;
+use YAML;
+
+our $schema = $MyTest::Tangram::Simple;
+
+$schema->{classes}[7]{fields}{dmdatetime}
+ = delete $schema->{classes}[7]{fields}{rawdatetime};
+
+sub raw_schema {
+ $schema;
+}
+
+1;
diff -urN Rose-DB-Object-0.58.orig/t/benchmarks/lib/MyTest/Tangram/Simple.pm Rose-DB-Object-0.58/t/benchmarks/lib/MyTest/Tangram/Simple.pm
--- Rose-DB-Object-0.58.orig/t/benchmarks/lib/MyTest/Tangram/Simple.pm 1970-01-01 12:00:00.000000000 +1200
+++ Rose-DB-Object-0.58/t/benchmarks/lib/MyTest/Tangram/Simple.pm 2005-12-19 20:03:26.000000000 +1300
@@ -0,0 +1,70 @@
+
+package MyTest::Tangram::Simple;
+
+use Class::Tangram::Generator;
+use YAML;
+
+our $schema = Load <<YAML;
+classes:
+ - MyTest::Tangram::Simple::Category
+ - fields:
+ string:
+ name: ~
+ table: rose_db_object_test_categories
+
+ - MyTest::Tangram::Simple::CodeName
+ - fields:
+ ref:
+ product:
+ class: MyTest::Tangram::Simple::Product
+ type_col: ~
+ string:
+ name: ~
+ table: rose_db_object_test_code_names
+
+ - MyTest::Tangram::Simple::Code
+ - fields:
+ int:
+ - k1
+ - k2
+ - k3
+ string:
+ code:
+ sql: VARCHAR(32)
+ table: rose_db_object_test_codes
+
+ - MyTest::Tangram::Simple::Product
+ - fields:
+ rawdatetime:
+ - date_created
+ - last_modified
+ - published
+ ref:
+ category:
+ class: MyTest::Tangram::Simple::Category
+ type_col: ~
+ code:
+ class: MyTest::Tangram::Simple::Code
+ type_col: ~
+ string:
+ name: ~
+ status:
+ init_default: active
+ sql: VARCHAR(32)
+ table: rose_db_object_test_products
+YAML
+
+sub raw_schema {
+ $schema;
+}
+
+# just to make sure we only use it once.
+our $generator;
+
+sub schema {
+ my $pkg = shift;
+ $generator ||= Class::Tangram::Generator->new($pkg->raw_schema);
+ Tangram::Schema->new($pkg->raw_schema);
+}
+
+1;
