Possible imrovement to Class::DBI::retrieve

[prev] [thread] [next] [Date index for 2005/06/10]

I'm fairly new to using C::DBI (though that hasnt stopped me from being a C::DBI hoplite for the Kwalitee effort), so I may be using it incorrectly.

I need to spend a little time explaining what I am doing first.

I am modelling two tables, one is Item, the other is Box. A Box contains Items. I do this with a FK constraint on Item, stating it references Box(Id). Items and Boxes also have an 'Area' property, indicating they are designated to be used in Victoria or NSW (states in Australia). Items for a particular Area can only go in a Box with the same area. So the Item and Box packages kinda look like

package Item;
...
use base qw(Project::DBI);

__PACKAGE__->table('Item');
__PACKAGE__->columns(All => qw(Id Area Box...));
__PACKAGE__->has_a(Box => 'Project::Box');
__PACKAGE__->add_constraint('CheckArea', Area => \&check_area);
...
sub check_area {
  # check that the Item Area == Box Area
  my ($area, $self, $column, $others) = @_;
  ...
  my $box = $self->_retrieve_box($others);
  return $area == $box->Area() ? 1 : 0;
}

sub _retrieve_box {
  my ($self, $others) = @_;

  my $box;

  if (ref($self)) { # changing an existing Item
    if (defined $self->Box()) {
      $box = Box->retrieve($self->Box());
    }
  } else { # creating a new tag
    if (exists $others->{box}) { # a Box was specified in the create
      $box = Box->retrieve($others->{box});
    }
  }

  return $box;
}

package Box;
...
use base qw(Project::DBI);

__PACKAGE__->table('Box');
__PACKAGE__->columns(All => qw(Id Area ...));
__PACKAGE__->has_many(Items => 'Project::Item');
...
1;

Now because I'm a good little vegemite, I have written a test harness to make sure everyting operates as I expect, and here's where my problem begins.

In Item.t, I create a Box first, then I try to create an Item to go in that Box.

So that test code kinda looks like this

#!/usr/bin/perl -w
use strict;
use Test::More qw(no_plan);
BEGIN {
 use_ok('Item');
}
use Box;
my $box = Box->create({Id=>1, Area=>'Vic'});
$box->update()->dbi_commit();

my $item = Item->create({Id=>1, Area=>'Vic', Box=>$box}); #$box->isa('Box'), not a simple scalar
...

This code fails in Class::DBI::retrieve (v0.96) 

sub retrieve {
        my $class           = shift;
        my @primary_columns = $class->primary_columns
                or return $class->_croak(
                "Can't retrieve unless primary columns are defined");
        my %key_value;
        if (@_ == 1 && @primary_columns == 1) {
                my $id = shift;
                return unless defined $id;
                ********FAILS HERE***********
                return $class->_croak("Can't retrieve a reference") if ref($id);
                ********FAILS HERE***********
                $key_value{ $primary_columns[0] } = $id;
 
Now because I call retrieve with $box, and ref($box) is 'Box', I get the 'Cant't retrieve a reference' message.

My workaround is to do this in _retrieve_box

$box += 0;

which 'scalarises' $box, so it is no longer a reference. I guess I could also stringify it too, but in my case the Id is an integer in the DB.

My thoughts are that C::DBI::retrieve shouldnt fail if $id is a reference, only if it isnt a Class::DBI reference. So I'd change the code from 

... if ref($id)
to

if (ref($id)) {
  return $class->_croak("Can't retrieve a reference") if not $id->isa('Class::DBI');
  $key_value{ $primary_columns[0] } = "$id"; # call overloaded '""' operator
}
...

That way we can retrieve() based on Class::DBI objects and scalars - I guess that boils down to retrieving ourselves...
my $box = Box->create({Id=>1, Area=>'Vic'});
...
my $same_box = Box->retrieve($box);

Does what I propose sound reasonable ?

Leif