Author: spadkins
Date: Tue Sep 11 11:04:00 2007
New Revision: 9934
Modified:
p5ee/trunk/App-Repository/lib/App/Repository.pm
p5ee/trunk/App-Repository/lib/App/SessionObject/RepositoryObjectDomain.pm
p5ee/trunk/App-Repository/lib/App/SessionObject/RepositoryObjectSet.pm
p5ee/trunk/App-Repository/t/DBI-repobjectdom.t
p5ee/trunk/App-Repository/t/DBI-repobjectset.t
Log:
added support for temporary objects sets and object domains
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 Tue Sep 11 11:04:00 2007
@@ -1375,6 +1375,125 @@
return($hash_of_hashes);
}
+###########################################################################
+# Indexes
+###########################################################################
+
+# $self->get_index([EMAIL PROTECTED], [EMAIL PROTECTED], \%options);
+sub get_index {
+ &App::sub_entry if ($App::trace);
+ my ($self, $rows, $key_columns, $options) = @_;
+
+ my ($key);
+ my $index = {};
+ my $is_array_of_arrays = ($#$rows > -1 && ref($rows->[0]) eq "ARRAY") ? 1
: 0;
+ if ($is_array_of_arrays) {
+ # TBD
+ }
+ else {
+ foreach my $row (@$rows) {
+ $key = join(",", @[EMAIL PROTECTED]);
+ if ($index->{$key}) {
+ push(@{$index->{$key}}, $row);
+ }
+ else {
+ $index->{$key} = [ $row ];
+ }
+ }
+ }
+ &App::sub_exit($index) if ($App::trace);
+ return($index);
+}
+
+# $self->get_unique_index([EMAIL PROTECTED], [EMAIL PROTECTED], \%options);
+sub get_unique_index {
+ &App::sub_entry if ($App::trace);
+ my ($self, $rows, $key_columns, $options) = @_;
+
+ my ($key);
+ my $unique_index = {};
+ my $is_array_of_arrays = ($#$rows > -1 && ref($rows->[0]) eq "ARRAY") ? 1
: 0;
+ if ($is_array_of_arrays) {
+ # TBD
+ }
+ else {
+ foreach my $row (@$rows) {
+ $key = join(",", @[EMAIL PROTECTED]);
+ $unique_index->{$key} = $row;
+ }
+ }
+ &App::sub_exit($unique_index) if ($App::trace);
+ return($unique_index);
+}
+
+# $self->get_column_values([EMAIL PROTECTED], $key_column, \%options);
+sub get_column_values {
+ &App::sub_entry if ($App::trace);
+ my ($self, $rows, $key_column, $options) = @_;
+
+ my $values = [];
+ my (%value_seen, $value);
+ my $is_array_of_arrays = ($#$rows > -1 && ref($rows->[0]) eq "ARRAY") ? 1
: 0;
+ if ($is_array_of_arrays) {
+ # TBD
+ }
+ else {
+ foreach my $row (@$rows) {
+ $value = $row->{$key_column};
+ if (!defined $value_seen{$value}) {
+ $value_seen{$value} = 1;
+ push(@$values, $value);
+ }
+ }
+ }
+ &App::sub_exit($values) if ($App::trace);
+ return($values);
+}
+
+sub create_temporary_object_domain {
+ &App::sub_entry if ($App::trace);
+ my ($self, $params, $objects_by_table, $class) = @_;
+ $params ||= {};
+ $objects_by_table ||= {};
+ $class ||= "App::SessionObject::RepositoryObjectDomain";
+ my @args = (
+ class => $class,
+ params => $params,
+ temporary => 1,
+ );
+ my $context = $self->{context};
+ my $object_domain = $context->session_object("temporary", @args);
+ my ($object_set, $objects);
+ foreach my $table (keys %$objects_by_table) {
+ $object_set = $object_domain->get_object_set($table);
+ $objects = $objects_by_table->{$table};
+ $object_set->set_objects($objects_by_table->{$table});
+ }
+ &App::sub_exit($object_domain) if ($App::trace);
+ return($object_domain);
+}
+
+sub create_temporary_object_set {
+ &App::sub_entry if ($App::trace);
+ my ($self, $table, $params, $columns, $objects, $class) = @_;
+ if (!$columns && $#$objects > -1) {
+ $columns = [ sort keys %{$objects->[0]} ];
+ }
+ $class ||= "App::SessionObject::RepositoryObjectSet";
+ my @args = (
+ class => $class,
+ table => $table,
+ columns => $columns,
+ temporary => 1,
+ );
+ my $context = $self->{context};
+ my $object_set = $context->session_object("temporary", @args);
+ $object_set->set_params($params);
+ $object_set->{objects} = $objects;
+ &App::sub_exit($object_set) if ($App::trace);
+ return($object_set);
+}
+
#############################################################################
# set_hash()
#############################################################################
Modified:
p5ee/trunk/App-Repository/lib/App/SessionObject/RepositoryObjectDomain.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/SessionObject/RepositoryObjectDomain.pm
(original)
+++ p5ee/trunk/App-Repository/lib/App/SessionObject/RepositoryObjectDomain.pm
Tue Sep 11 11:04:00 2007
@@ -43,27 +43,29 @@
sub _clear_cache {
&App::sub_entry if ($App::trace);
my ($self, $table) = @_;
- my (@tables);
- if ($table) {
- @tables = ($table);
- }
- else {
- my $object_set_def = $self->{table};
- if (ref($object_set_def) eq "HASH") {
- foreach my $table (keys %$object_set_def) {
- if ($object_set_def->{$table}{gotten}) {
- delete $object_set_def->{$table}{gotten};
- push(@tables, $table);
+ if (!$self->{temporary}) {
+ my (@tables);
+ if ($table) {
+ @tables = ($table);
+ }
+ else {
+ my $object_set_def = $self->{table};
+ if (ref($object_set_def) eq "HASH") {
+ foreach my $table (keys %$object_set_def) {
+ if ($object_set_def->{$table}{gotten}) {
+ delete $object_set_def->{$table}{gotten};
+ push(@tables, $table);
+ }
}
}
}
- }
- my $context = $self->{context};
- my ($object_set_name, $object_set);
- foreach my $table (@tables) {
- $object_set_name = $self->{table}{$table}{name} ||
"$self->{name}-$table";
- $object_set = $context->session_object($object_set_name);
- $object_set->_clear_cache();
+ my $context = $self->{context};
+ my ($object_set_name, $object_set);
+ foreach my $table (@tables) {
+ $object_set_name = $self->{table}{$table}{name} ||
"$self->{name}-$table";
+ $object_set = $context->session_object($object_set_name);
+ $object_set->_clear_cache();
+ }
}
&App::sub_exit() if ($App::trace);
}
@@ -90,25 +92,36 @@
$self->{table}{$table} = $tabledef;
}
- # object-sets can be named something other than the default name.
- my $object_set_name = $tabledef->{name} || "$self->{name}-$table";
+ my $object_set = $tabledef->{object_set};
+ if (!$object_set) {
+ my $new_args = $tabledef->{new_args} || {};
+ my ($object_set_name);
+ if ($self->{temporary}) {
+ $object_set_name = $tabledef->{name} || "temporary";
+ $new_args->{temporary} = 1;
+ }
+ else {
+ # object-sets can be named something other than the default name.
+ $object_set_name = $tabledef->{name} || "$self->{name}-$table";
+ }
- # object-sets can have special arguments passed to them on initial
construction
- my $new_args = $tabledef->{new_args} || {};
- if (!$new_args->{class}) {
- $new_args->{class} = "App::SessionObject::RepositoryObjectSet";
- }
- # object-sets can refer to physical tables which are different from the
object-set name.
- if (!$new_args->{table}) {
- $new_args->{table} = $tabledef->{table} || $table;
- }
- # object-sets can have a select set of parameters (i.e. a subset of all
known to the object-domain)
- if (!$new_args->{params}) {
- my $new_params = $tabledef->{params} || $domain_params || {};
- $new_args->{params} = { %$new_params };
+ # object-sets can have special arguments passed to them on initial
construction
+ if (!$new_args->{class}) {
+ $new_args->{class} = "App::SessionObject::RepositoryObjectSet";
+ }
+ # object-sets can refer to physical tables which are different from
the object-set name.
+ if (!$new_args->{table}) {
+ $new_args->{table} = $tabledef->{table} || $table;
+ }
+ # object-sets can have a select set of parameters (i.e. a subset of
all known to the object-domain)
+ if (!$new_args->{params}) {
+ my $new_params = $tabledef->{params} || $domain_params || {};
+ $new_args->{params} = { %$new_params };
+ }
+ $object_set = $context->session_object($object_set_name, %$new_args);
+ $tabledef->{object_set} = $object_set;
+ $tabledef->{gotten} = 1;
}
- my $object_set = $context->session_object($object_set_name, %$new_args);
- $tabledef->{gotten} = 1;
if ($tabledef->{params}) {
my (%object_set_param_values, $domain_param);
@@ -123,6 +136,7 @@
else {
$object_set->set_params($domain_params);
}
+
&App::sub_exit($object_set) if ($App::trace);
return($object_set);
}
Modified: p5ee/trunk/App-Repository/lib/App/SessionObject/RepositoryObjectSet.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/SessionObject/RepositoryObjectSet.pm
(original)
+++ p5ee/trunk/App-Repository/lib/App/SessionObject/RepositoryObjectSet.pm
Tue Sep 11 11:04:00 2007
@@ -54,7 +54,7 @@
my $table = $self->{table} || die "table not defined";
$self->_clear_cache_if_auto_params_changed() if ($self->{auto_params});
# sets params from auto_params
$self->_clear_cache_if_auto_columns_changed() if ($self->{auto_columns});
# sets columns from auto_columns
- if (!$self->{columns}) {
+ if (!$self->{columns} && !$self->{temporary}) {
my $context = $self->{context};
my $repname = $self->{repository};
my $rep = $context->repository($repname);
@@ -63,16 +63,44 @@
&App::sub_exit() if ($App::trace);
}
+# This should only be relevant for temporary
+sub set_objects {
+ &App::sub_entry if ($App::trace);
+ my ($self, $objects, $columns) = @_;
+ if ($self->{temporary}) {
+ $self->{objects} = $objects;
+ delete $self->{index};
+ delete $self->{unique_index};
+ delete $self->{column_values};
+ delete $self->{max_age_time};
+ delete $self->{ext_summary};
+ delete $self->{summary};
+ if ($columns) {
+ $self->{columns} = $columns;
+ }
+ elsif (!$self->{columns} && $#$objects > -1) {
+ $columns = [ sort keys %{$objects->[0]} ];
+ $self->{columns} = $columns;
+ }
+ }
+ else {
+ die "set_objects() is not allowed on a non-temporary object set";
+ }
+ &App::sub_exit() if ($App::trace);
+}
+
sub _clear_cache {
&App::sub_entry if ($App::trace);
my ($self) = @_;
- delete $self->{objects};
- delete $self->{index};
- delete $self->{unique_index};
- delete $self->{column_values};
- delete $self->{max_age_time};
- delete $self->{ext_summary};
- delete $self->{summary};
+ if (!$self->{temporary}) {
+ delete $self->{objects};
+ delete $self->{index};
+ delete $self->{unique_index};
+ delete $self->{column_values};
+ delete $self->{max_age_time};
+ delete $self->{ext_summary};
+ delete $self->{summary};
+ }
&App::sub_exit() if ($App::trace);
}
@@ -137,17 +165,6 @@
&App::sub_exit() if ($App::trace);
}
-# The RepositoryObjectSet should know its table at construction time.
-# It should never allow the table to be set afterwards.
-#sub set_table {
-# &App::sub_entry if ($App::trace);
-# my ($self, $table, $repository) = @_;
-# $self->{repository} = $repository || "default";
-# $self->{table} = $table;
-# $self->_clear_cache();
-# &App::sub_exit() if ($App::trace);
-#}
-
sub set_params {
&App::sub_entry if ($App::trace);
my ($self, $params) = @_;
@@ -207,16 +224,23 @@
my ($self) = @_;
my $objects = $self->{objects};
if (!$objects) {
- my $context = $self->{context};
- my $repname = $self->{repository};
- my $rep = $context->repository($repname);
- my $table = $self->{table} || die "table not defined";
- my $params = $self->{params} || {};
- my $columns = $self->{columns};
- $params = {%$params};
- $objects = $rep->get_objects($table, $params, $columns,
{extend_columns => 1});
- $self->{objects} = $objects;
- $self->{max_age_time} = time();
+ if ($self->{temporary}) {
+ $objects = [];
+ }
+ else {
+ my $context = $self->{context};
+ my $repname = $self->{repository};
+ my $rep = $context->repository($repname);
+ my $table = $self->{table} || die "table not defined";
+ my $params = $self->{params} || {};
+ my $columns = $self->{columns};
+ # Make a copy of $params so that if $db->get_objects() changes
them,
+ # it does not affect the cacheing aspects of the object set.
+ $params = {%$params};
+ $objects = $rep->get_objects($table, $params, $columns,
{extend_columns => 1});
+ $self->{objects} = $objects;
+ $self->{max_age_time} = time();
+ }
}
&App::sub_exit($objects) if ($App::trace);
return($objects);
Modified: p5ee/trunk/App-Repository/t/DBI-repobjectdom.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-repobjectdom.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-repobjectdom.t Tue Sep 11 11:04:00 2007
@@ -158,9 +158,101 @@
$objset->get_unique_index(["first_name"]);
my $object = $objset->get_object("stephen",["first_name"]);
ok($object->{age} == 39, "got stephen object (age 39)");
+
+ $rep->_disconnect();
+ my $hashes = [
+ { person_id => 1, age => 39, name => "stephen", gender => "M", state
=> "GA", num_kids => 3, },
+ { person_id => 2, age => 37, name => "susan", gender => "F", state
=> "GA", num_kids => 3, },
+ { person_id => 3, age => 6, name => "maryalice", gender => "F", state
=> "GA", num_kids => 0, },
+ { person_id => 4, age => 3, name => "paul", gender => "M", state
=> "GA", num_kids => 0, },
+ { person_id => 5, age => 1, name => "christine", gender => "F", state
=> "GA", num_kids => undef, },
+ { person_id => 6, age => 45, name => "tim", gender => "M", state
=> "GA", num_kids => 2, },
+ { person_id => 7, age => 39, name => "keith", gender => "M", state
=> "GA", num_kids => 4, },
+ ];
+
+ #$App::trace = 1;
+
+ my $new_object_domain = $rep->create_temporary_object_domain({fee =>
1,fie => 2,foe => "fum"},{test_person => $hashes,test_person2 => $hashes});
+ my $new_object_domain2 = $rep->create_temporary_object_domain({fee =>
1,fie => 2,foe => "fum"},{test_person => $hashes,test_person2 => $hashes});
+ is(ref($new_object_domain), "App::SessionObject::RepositoryObjectDomain",
"Correct class (RepositoryObjectDomain)");
+ $new_object_domain2->{foo} = "bar";
+ ok(! defined $new_object_domain->{foo}, "new_object_domain()s (temporary)
don't share storage");
+ ok($new_object_domain->{temporary}, "new_object_domain (temporary) has
{temporary} attribute set");
+
+ my $new_object_set = $new_object_domain->get_object_set("test_person2");
+ my $new_object_set2 = $new_object_domain->get_object_set("test_person");
+ #my $new_object_set3 = $new_object_domain->get_object_set("test_person3");
+ is(ref($new_object_set), "App::SessionObject::RepositoryObjectSet",
"Correct class (RepositoryObjectSet)");
+
+ $new_object_set->{foo} = "bar";
+ ok(! defined $new_object_set2->{foo}, "new_object_set()s (temporary) don't
share storage");
+ my $hashes2 = $new_object_set->get_objects();
+ is($hashes2, $hashes, "Got same exact reference to set of objects");
+ is($#$hashes2, $#$hashes, "Got same exact number of objects");
+ is($rep, $new_object_set->get_repository(), "Got same exact reference to a
repository");
+ is("test_person2", $new_object_set->get_table(), "Got same exact table");
+ my $columns = $new_object_set->get_columns();
+ is($#$columns, 5, "Got 6 columns");
+ is($columns->[0], "age", "Got 1st column as age");
+
+ $index = $new_object_set->get_index(["gender"]);
+ my $females = $index->{F};
+ is($#$females, 2, "Got 3 females");
+ is($females->[0]{name}, "susan", "Got susan as 1st female");
+
+ $index = $new_object_set->get_index(["state"]);
+ my $georgians = $index->{GA};
+ is($#$georgians, 6, "Got 7 georgians");
+ is($georgians->[3]{name}, "paul", "Got paul as 4th georgian");
+
+ $index = $new_object_set->get_index(["gender","age"]);
+ my $m39s = $index->{"M,39"};
+ is($#$m39s, 1, "Got 2 m39s");
+ is($m39s->[1]{name}, "keith", "Got keith as 2nd m39");
+
+ $index = $new_object_set->get_unique_index(["gender","age"]);
+ my $m39 = $index->{"M,39"};
+ ok($m39, "Got an m39");
+ is($m39->{name}, "keith", "Got keith as the last (assumed unique) m39");
+
+ my $summaries = $new_object_set->get_summary([]);
+ is(ref($summaries), "HASH", "Got summary hash");
+ is($summaries->{""}{num_kids}, 12, "Got 12 total kids");
+
+ my $ext_summary = $new_object_set->get_ext_summary([]);
+ is(ref($ext_summary), "HASH", "Got summary hash");
+ is($ext_summary->{""}{num_kids}{sum}, 12, "Got sum 12 kids");
+ is($ext_summary->{""}{num_kids}{average}, 2, "Got average 2 kids");
+ is($ext_summary->{""}{num_kids}{count}, 6, "Got count 6 kids");
+ is(ref($ext_summary->{""}{num_kids}{distinct}), "HASH", "Got distinct
hashref");
+ my $distinct_values = [ keys %{$ext_summary->{""}{num_kids}{distinct}} ];
+ is($#$distinct_values, 3, "Got distinct 4 kids");
+ is($ext_summary->{""}{num_kids}{min}, 0, "Got min 2 kids");
+ is($ext_summary->{""}{num_kids}{max}, 4, "Got max 2 kids");
+ is($ext_summary->{""}{num_kids}{sum_sq}, 38, "Got sum_sq 2 kids");
+ is($ext_summary->{""}{num_kids}{median}, 2.5, "Got median 2 kids");
+ ok($ext_summary->{""}{num_kids}{stddev} >= 1.6733200 &&
$ext_summary->{""}{num_kids}{stddev} <= 1.6733201, "Got stddev 1.673320 kids");
+ is($ext_summary->{""}{num_kids}{mode}, 2, "Got mode 2 kids");
+
+ my $column_values = $new_object_set->get_column_values("gender");
+ is($#$column_values, 1, "Got 2 column_values for gender");
+ is($column_values->[0], "M", "Got M as first gender value");
+ is($column_values->[1], "F", "Got F as second gender value");
+
+ $object = $new_object_set->get_object(1, ["person_id"]);
+ is($object->{name}, "stephen", "Got stephen as person_id 1");
+ $object = $new_object_set->get_object("39,keith", ["age","name"]);
+ is($object->{name}, "keith", "Got keith as person_id named keith age 39");
+
+ $females = $new_object_set->get_objects("F",["gender"]);
+ is($#$females, 2, "Got 3 females (without explicit use of an index)");
+ is($females->[0]{name}, "susan", "Got susan as 1st female (without
explicit use of an index)");
+
+ ok(! defined $rep->{dbh}, "Never reconnected to the database");
}
{
+ $rep->_connect();
my $dbh = $rep->{dbh};
$dbh->do("drop table test_person");
}
Modified: p5ee/trunk/App-Repository/t/DBI-repobjectset.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-repobjectset.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-repobjectset.t Tue Sep 11 11:04:00 2007
@@ -167,9 +167,93 @@
is($objects->[0]{age}, 40, "max_age: no refresh by overriding small
max_age on objset with large max_age");
$objects = $objset->get_objects(); # NOTE: we get the
update.
is($objects->[0]{age}, 41, "max_age: refresh with max_age on objset");
+
+ $rep->_disconnect();
+ my $hashes = [
+ { person_id => 1, age => 39, name => "stephen", gender => "M", state
=> "GA", num_kids => 3, },
+ { person_id => 2, age => 37, name => "susan", gender => "F", state
=> "GA", num_kids => 3, },
+ { person_id => 3, age => 6, name => "maryalice", gender => "F", state
=> "GA", num_kids => 0, },
+ { person_id => 4, age => 3, name => "paul", gender => "M", state
=> "GA", num_kids => 0, },
+ { person_id => 5, age => 1, name => "christine", gender => "F", state
=> "GA", num_kids => undef, },
+ { person_id => 6, age => 45, name => "tim", gender => "M", state
=> "GA", num_kids => 2, },
+ { person_id => 7, age => 39, name => "keith", gender => "M", state
=> "GA", num_kids => 4, },
+ ];
+ my $new_object_set = $rep->create_temporary_object_set("test_person",
{fee => 1, fie => 2, foe => "fum"}, undef, $hashes);
+ my $new_object_set2 = $rep->create_temporary_object_set("test_person",
{fee => 1, fie => 2, foe => "fum"}, undef, $hashes);
+ is(ref($new_object_set), "App::SessionObject::RepositoryObjectSet",
"Correct class (RepositoryObjectSet)");
+ ok($new_object_set->{temporary}, "new_object_set (temporary) has
{temporary} attribute set");
+
+ #$App::trace = 1;
+
+ $new_object_set->{foo} = "bar";
+ ok(! defined $new_object_set2->{foo}, "new_object_set()s (temporary) don't
share storage");
+ my $hashes2 = $new_object_set->get_objects();
+ is($hashes2, $hashes, "Got same exact reference to set of objects");
+ is($#$hashes2, $#$hashes, "Got same exact number of objects");
+ is($rep, $new_object_set->get_repository(), "Got same exact reference to a
repository");
+ is("test_person", $new_object_set->get_table(), "Got same exact table");
+ my $columns = $new_object_set->get_columns();
+ is($#$columns, 5, "Got 6 columns");
+ is($columns->[0], "age", "Got 1st column as age");
+
+ $index = $new_object_set->get_index(["gender"]);
+ my $females = $index->{F};
+ is($#$females, 2, "Got 3 females");
+ is($females->[0]{name}, "susan", "Got susan as 1st female");
+
+ $index = $new_object_set->get_index(["state"]);
+ my $georgians = $index->{GA};
+ is($#$georgians, 6, "Got 7 georgians");
+ is($georgians->[3]{name}, "paul", "Got paul as 4th georgian");
+
+ $index = $new_object_set->get_index(["gender","age"]);
+ my $m39s = $index->{"M,39"};
+ is($#$m39s, 1, "Got 2 m39s");
+ is($m39s->[1]{name}, "keith", "Got keith as 2nd m39");
+
+ $index = $new_object_set->get_unique_index(["gender","age"]);
+ my $m39 = $index->{"M,39"};
+ ok($m39, "Got an m39");
+ is($m39->{name}, "keith", "Got keith as the last (assumed unique) m39");
+
+ my $summaries = $new_object_set->get_summary([]);
+ is(ref($summaries), "HASH", "Got summary hash");
+ is($summaries->{""}{num_kids}, 12, "Got 12 total kids");
+
+ my $ext_summary = $new_object_set->get_ext_summary([]);
+ is(ref($ext_summary), "HASH", "Got summary hash");
+ is($ext_summary->{""}{num_kids}{sum}, 12, "Got sum 12 kids");
+ is($ext_summary->{""}{num_kids}{average}, 2, "Got average 2 kids");
+ is($ext_summary->{""}{num_kids}{count}, 6, "Got count 6 kids");
+ is(ref($ext_summary->{""}{num_kids}{distinct}), "HASH", "Got distinct
hashref");
+ my $distinct_values = [ keys %{$ext_summary->{""}{num_kids}{distinct}} ];
+ is($#$distinct_values, 3, "Got distinct 4 kids");
+ is($ext_summary->{""}{num_kids}{min}, 0, "Got min 2 kids");
+ is($ext_summary->{""}{num_kids}{max}, 4, "Got max 2 kids");
+ is($ext_summary->{""}{num_kids}{sum_sq}, 38, "Got sum_sq 2 kids");
+ is($ext_summary->{""}{num_kids}{median}, 2.5, "Got median 2 kids");
+ ok($ext_summary->{""}{num_kids}{stddev} >= 1.6733200 &&
$ext_summary->{""}{num_kids}{stddev} <= 1.6733201, "Got stddev 1.673320 kids");
+ is($ext_summary->{""}{num_kids}{mode}, 2, "Got mode 2 kids");
+
+ my $column_values = $new_object_set->get_column_values("gender");
+ is($#$column_values, 1, "Got 2 column_values for gender");
+ is($column_values->[0], "M", "Got M as first gender value");
+ is($column_values->[1], "F", "Got F as second gender value");
+
+ $object = $new_object_set->get_object(1, ["person_id"]);
+ is($object->{name}, "stephen", "Got stephen as person_id 1");
+ $object = $new_object_set->get_object("39,keith", ["age","name"]);
+ is($object->{name}, "keith", "Got keith as person_id named keith age 39");
+
+ $females = $new_object_set->get_objects("F",["gender"]);
+ is($#$females, 2, "Got 3 females (without explicit use of an index)");
+ is($females->[0]{name}, "susan", "Got susan as 1st female (without
explicit use of an index)");
+
+ ok(! defined $rep->{dbh}, "Never reconnected to the database");
}
{
+ $rep->_connect();
my $dbh = $rep->{dbh};
$dbh->do("drop table test_person");
}
