[CDBI] Re: construct sucks.

Ryan Tate lists at ryantate.com
Wed Aug 30 07:24:46 BST 2006

On 8/27/06, Edward J. Sabol <sabol at alderaan.gsfc.nasa.gov> wrote:
> More experimentation and a test case (if there isn't already one)
> that properly touches on the potential problem cited by Perrin above are
> needed.

Two test cases follow.

I have not re-done my patch yet.

As I indicated in the note accompanying this path in RT, I think there
is merit in the idea of checking columns to see if they have changed
in-memory without being saved back to the database.

In such cases,  it makes sense to stay compatible with existing
behavior, which is to preserve the in-memory data, however stale it
might be. Dying isn't sufficiently more correct to justify a change in
code behavior. But since this is a seriously funky situation that just
reeks of "accident about to happen" a warning should be emitted.

Of course, the preceding paragraph is just my opinion and not, in the
end, my call. It explains, however, why my second test checks to make
sure changed-but-not-persisted in-memory data is preserved even when
conflicting data (presumably from the database) is sent to

Test cases:

use strict;
use warnings;

package Project;
use base 'Class::DBI::Test::SQLite';
__PACKAGE__->columns(Primary => qw(id));
__PACKAGE__->columns(Essential => qw(title size latest_event_id));
__PACKAGE__->has_a(latest_event_id => 'Event');
__PACKAGE__->has_many(events => ['Project::Event' => 'event_id']);

sub create_sql{
  return q{
	   title VARCHAR(255),
	   size INT,
	   latest_event_id INT

		       SELECT event.id, event.title,
		       FROM event, project_event
		       WHERE event.id=project_event.event_id
		       AND project_event.project_id=?

sub events_with_project_events{
  my $self = shift;

  my $sth = $self->sql_events_with_project_events;
  my @events_with_project_events;
  while (my $row = $sth->fetchrow_arrayref) {
    my $i = 0;
    my %event = map { $_ => $row->[ $i++ ] } qw(id title);
    my %project_event = map { $_ => $row->[ $i++ ] } qw(occured_on);
    my $event = Event->construct(\%event);
    my $project_event = Project::Event->construct(\%project_event);
    push @events_with_project_events, [$event, $project_event];
  return @events_with_project_events;

package Event;
use base 'Class::DBI::Test::SQLite';
__PACKAGE__->columns(Primary => qw(id));
__PACKAGE__->columns(Essential => qw(title));
__PACKAGE__->has_many(projects => ['Project::Event' => 'project_id']);

sub create_sql{
  return q{
	   title VARCHAR(255)

package Project::Event;
use base 'Class::DBI::Test::SQLite';
__PACKAGE__->columns(Primary => qw(project_id event_id));
__PACKAGE__->columns(Essential => qw(occured_on));

sub create_sql{
  return q{
	   project_id INT,
	   event_id INT,
	   occured_on INT

package main;

use Test::More;

plan tests => 2;

Event->insert({id => 1, title => 'Conception'});
Event->insert({id => 2, title => 'Completion'});

Project->insert({id => 1, title => 'Cafe Julep',
		 size => '1000', latest_event_id => 2});

Project::Event->insert({project_id => 1, event_id => 1,
			occured_on => 1156915321});
Project::Event->insert({project_id => 1, event_id => 2,
			occured_on => 1156915322});

my $project = Project->retrieve(1);

my ($event_with_project_event) = grep { $_->[0]->id == 2 }
my ($event, $project_event) = @$event_with_project_event;

ok(($event->_attr('title'))[0] eq 'Completion', 'construct can add
data to objects in LiveObject index');

ok(($event->_attr('title'))[0] eq 'Finished', 'construct preserves
value of changed but unsaved columns of objects in LiveObject index');

More information about the ClassDBI mailing list