Baby Moose Selection

Well if carry on as if you are normal day here in the Moose-pen

In yesterday's post I manged to get the update sub working with a real DB and today I am going to try the 'retrieve' sub which is a little more tricky.

The basic concept is much the same as for the other two and it really did not take me long to get it up and working, the only real gaff was this one

Subroutine _select redefined at

as I had a stubbed in version that I simply got rid of. Apart from that and the sact one does not spell alias as alais things when together quickly and here is what I have;

sub _select {
my $self = shift;
my ($container) = @_;
my @fields = ();
foreach my $field ( @{$self->elements()} ) {
push(@fields,join(" ",
? join(" ",
my $select_clause = join(" ",
$self->da_warn("_select","Select clause='$select_clause'")
if $self->da_warning()>=5;

my $from_clause = join(" ",
? join(" ",
: $self->view()->name
$self->da_warn("_select"," From clause='$from_clause'")
if $self->da_warning()>=5;

return join(" ",$select_clause,$from_clause);

Now the only thing to take note of in the above code is this time I am iterating directly over the 'elements' array. One of the points I make in Accessor is that a DA will always return all of the 'elements' on a 'retrieve', unless they are directly excluded at instantiation time with the 'no_retrieve' flag. I may change this at a later date though.

Next I will need to account for the fact that the DBI calling pattern for a 'select' is different from the other three (update,create,delete), in DBI after the execute on the statement handle you have a number of options on how to iterate over the records. At this point in the project like the create and update I want to keep things simple so all I am doing in this iteration is;

++  if ($action eq Database::Accessor::Constants::RETRIEVE) {
++          $sth->execute();
++         my $results = $sth->fetchall_arrayref(); 
++         $result->set($results);
++      }
++      else {
           my $rows_effected = $sth->execute();
            if ($dbh->{AutoCommit} == 0 and !$self->da_no_effect);
++      }

here I check to see if the action is a 'retrieve/select' and then I execute the and then use 'fetchall_arrayref' to suck all the records into an array reft and then pass that into my 'set' attribute on my results class. Now of course the above is not scalable and any sizable record set will slow things down but as I said earlier I do plan and adding more to this later.

Now my test is easy enough;

if ($@) {
fail("retrieve function error=$@");
else {
pass("retrieve function");
ok(scalar($user->result()->set) == 2,"Two rows returned");

and I got this the first time I ran it

DBD::DBM::db prepare failed: Bad table or column name: '.username' has chars not alphanumeric or underscore! [for Statement "SELECT .username ,.address FROM user"] at

ok what is going on here!

Somehow my table name (view) is being dropped from my field. I do remember from this post that I set up all the elements to inherit their View from the View object in the Accessor. Now that code was in the 'around BUILDARGS' and it worked and tested fine.

So it did take me a little while to track the problem down. In my Test::DB::User I over write that 'around BUILDARGS' with this block;

around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
return $class->$orig({
elements=>[{name=> 'username'},
{name=> 'address'}],

Which is not a very good thing. My end users can break things, by making an element not have a view. Well I will have to look at this a little more closely in a later post for now I just added in the view the two 'element' values above and when I re-ran my test I got

ok 3 - Update function
ok 4 - Two rows effected
ok 5 - retrieve function
not ok 6 - Two rows effected

Well some hours later I finally stumbled upon it. The root problem is with the rather simple DB I am playing with, you cannot have more than one key-pair so my global update earlier in my test whiped out the initial canned value in the table.

Oh well one must always be careful not to go to far astray when programming, in this case I wasted all sorts of time looking for a bug in Driver::DBI and that was just not there. All I was seeing was normal behaviour of the DB, this is of course one of the pitfalls of using third party software in your testing.

As I really just want to check and see if a retrieve is working all I am going to do for now is change that last test;

--ok(scalar($user->result()->set) == 2,"Two rows returned");
++ok(scalar($user->result()->set) == 1,"One row returned");

and I am at 100% pass at least for now.


Leave a comment

About byterock

user-pic Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations