# Test case for
http://rt.cpan.org/Public/Bug/Display.html?id=17805 and MySQL.
# Tested with MySQL 4.1.14-max-log. However, the MySQL version should not be
# very important since no advanced functionality is used.
#
# Connection information should be supplied using the DBI_DSN, DBI_USER, and
# DBI_PASS environment variables.
#
# The basic problem is that insert could add the object to the object cache
# when the object's table contains an auto incrementing primary key. This is
# because this information is avialable when the row is inserted.
use warnings;
use strict;
use Test::More tests => 18;
use Class::DBI;
use Scalar::Util qw(refaddr); # used to find the memory location of CDBI objects
my $TABLE = 'test_CDBI';
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::.
package CDBI;
use base 'Class::DBI';
__PACKAGE__->table($TABLE);
__PACKAGE__->columns(Primary => qw/id/);
__PACKAGE__->columns(Essential => qw/name value/);
# use environment variables $DBI_DSN, $DBI_USER, and $DBI_PASS if avialable
__PACKAGE__->connection($ENV{DBI_DSN} || 'DBI:mysql:database=test',
$ENV{DBI_USER} || 'root',
$ENV{DBI_PASS});
package main;
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::.
sub startup {
# create a table for the test class
my $dbh = CDBI->db_Main;
$dbh->do( <<"" );
CREATE TEMPORARY TABLE $TABLE (
id int(11) NOT NULL auto_increment PRIMARY KEY,
name varchar(50),
value varchar(50)
)
}
startup();
# NOTE: unless the unique key is passed to create (id => 1 in this case),
# the identity map will not work and retrieving this object will result in
# this object being loaded into memory twice
#
# The first value of $attr represents the passing case, the second is the
# failing case.
foreach my $attr ({ id => 1, name => 'foo', value => 'bar'},
{ name => 'foo', value => 'bar'} ) {
my $obj1 = CDBI->insert($attr);
is($obj1->name, 'foo', 'correct name');
is($obj1->value, 'bar', 'correct value');
# retreive the object - expect a reference to $obj1 to be returned
my $obj2 = CDBI->retrieve( $obj1->id );
# the two objects should be equivilant in memory
# refaddr is helpful for getting the memory address since simply Class::DBI
# overloads every operation.
is(refaddr($obj1), refaddr($obj2), 'objects 1 and 2 are equivalent');
# test all of the common fields:
check_fields($obj1, $obj2, qw/id name value/);
# If the two objects are equal in memroy, updating one should update both.
# This is not the case when the unique id is not passed to insert
$obj2->value('baz');
$obj2->update;
check_fields($obj1, $obj2, qw/id name value/);
}
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::.
sub check_fields {
my ($obj1, $obj2, @fields) = @_;
foreach my $field (@fields) {
is($obj2->$field, $obj1->$field, "same field: $field = " . $obj1->$field);
}
}
