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(\@rows, \@key_columns, \%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(",", @{$row}{@$key_columns});
+ if ($index->{$key}) {
+ push(@{$index->{$key}}, $row);
+ }
+ else {
+ $index->{$key} = [ $row ];
+ }
+ }
+ }
+ &App::sub_exit($index) if ($App::trace);
+ return($index);
+}
+
+# $self->get_unique_index(\@rows, \@key_columns, \%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(",", @{$row}{@$key_columns});
+ $unique_index->{$key} = $row;
+ }
+ }
+ &App::sub_exit($unique_index) if ($App::trace);
+ return($unique_index);
+}
+
+# $self->get_column_values(\@rows, $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");
}
lmpx.com only provides a reader for public news (NNTP) servers. It is not
affiliated with the servers or forums shown here and is not responsible for
the content of articles, which is written by their respective authors.