[Dbix-class] create without setting a nullable foreign key, then accessing relationship

[Adam Sjøgren]

  Hi.

If I create a new row in the database, in a table that has an optional
foreign key, which isn't filled in in the create-call, and then call the
belongs_to relationship accessor on the resulting object, I get an
object back for the foreign key, when I use DBIx::Class 0.08008; I
didn't in 0.08007.

I am wondering whether this is expected behaviour?

Abbreviated example:

  # fleet_id not filled in when calling create:
  my $car2=$schema->resultset('CarDB::Car')->create({
                                                     id=>2,
                                                     plate=>'BBB 202',
                                                    });

  my $fleet2=$car2->fleet; # Searches fleet table with no WHERE clause
  print defined $fleet2 ? "Fleet returned, car2\n" : "No fleet returned, car2\n";

prints "Fleet returned, car2" (full example below).

I have bisected my way to r3804 introducing this change, but I am not
exactly sure what the correct cure is, if it is indeed wrong.


This has been discussed on the mailinglist before, Damon Snyder asked
about it in:
 <http://article.gmane.org/gmane.comp.lang.perl.modules.dbix-class/5331>
and mike provided a test-patch in:
 <http://article.gmane.org/gmane.comp.lang.perl.modules.dbix-class/5443>. 
The test-patch broke some other patches, so I posted an updated patch
that doesn't:
 <http://article.gmane.org/gmane.comp.lang.perl.modules.dbix-class/5653>
It probably went unnoticed because of the age of the thread.


Here is the output of the full example included below with different
versions of DBIx::Class:

 0.08007
 Fleet returned, car1
 No fleet returned, car2

What I expected.

 0.08008
 Fleet returned, car1
 Fleet returned, car2

Not what I expected. Finally, latest svn 0.08/trunk:

 0.0809902
 Fleet returned, car1
 DBIx::Class::Relationship::Accessor::__ANON__(): Query returned more than one row.  SQL that returns multiple rows is DEPRECATED for ->find and ->single at test.pl line 26
 Fleet returned, car2

Now with a warning.


Example files:

test.pl:
--------

#!/usr/bin/perl

use warnings;
use strict;

use CarDB;

print $DBIx::Class::VERSION . "\n";

my $schema=CarDB->connect('dbi:Pg:dbname=cardb', 'adsj', 'adsj', { AutoCommit=>1 });

my $car1=$schema->resultset('CarDB::Car')->create({
                                                   id=>1,
                                                   plate=>'AAA 101',
                                                   fleet_id=>1,
                                                  });

my $fleet1=$car1->fleet;
print defined $fleet1 ? "Fleet returned, car1\n" : "No fleet returned, car1\n";

my $car2=$schema->resultset('CarDB::Car')->create({
                                                   id=>2,
                                                   plate=>'BBB 202',
                                                  });

my $fleet2=$car2->fleet;
print defined $fleet2 ? "Fleet returned, car2\n" : "No fleet returned, car2\n";


run (I am using PostgreSQL):
----------------------------

#!/bin/sh

dropdb -U adsj cardb 2> /dev/null
createdb -U adsj cardb  2> /dev/null
psql -U adsj cardb < init.sql 2> /dev/null > /dev/null
perl test.pl


init.sql:
---------

CREATE TABLE fleet (
  id integer NOT NULL,
  company text NOT NULL,
  PRIMARY KEY (id)
);

CREATE TABLE car (
  id integer NOT NULL,
  plate text NOT NULL,
  fleet_id integer REFERENCES fleet, -- optional foreign key
  PRIMARY KEY (id)
);

INSERT INTO fleet (id, company) VALUES (1, 'Hertz');
INSERT INTO fleet (id, company) VALUES (2, 'Avis');


CarDB.pm:
---------

package CarDB;

use strict;
use warnings;

use base qw(DBIx::Class::Schema);

__PACKAGE__->load_classes();

1;


CarDB/Car.pm:
-------------

package CarDB::Car;

use strict;
use warnings;

use base qw(DBIx::Class);

__PACKAGE__->load_components('PK::Auto', 'Core');
__PACKAGE__->table('car');
__PACKAGE__->add_columns(qw(id plate fleet_id));
__PACKAGE__->set_primary_key('id');

# fleet_id may be NULL (car does not belong to any fleet, yet):
__PACKAGE__->belongs_to(fleet=>'CarDB::Fleet', 'fleet_id');

1;


CarDB/Fleet.pm:
---------------

package CarDB::Fleet;

use strict;
use warnings;

use base qw(DBIx::Class);

__PACKAGE__->load_components('PK::Auto', 'Core');
__PACKAGE__->table('fleet');
__PACKAGE__->add_columns(qw(id company));
__PACKAGE__->set_primary_key('id');

__PACKAGE__->has_many(cars=>'CarDB::Car', 'fleet_id');

1;


  Best regards,

     Adam

-- 
                                                          Adam Sjøgren
                                                    adsj at novozymes.com