100% Moose

Its add a little new day here in the Moose-Pen

I left off yesterday with the problem of the little build in test DB that comes with DBI not working correctly with SQL where the table names are added to the field names. So this SQL would work;


UPDATE user SET address = ? WHERE user.username = ?

but this would not

SELECT user.username FROM user WHERE user.username = ?

Now I am either faces with drooping the '10_crud_basic.t' test case which I would like to keep or changing my code to accommodate this little DB and any others that may not like table names on the fields.

I guess my best bet would be to expand the API a little with yet another option but this time I was thinking best place for this option was at the Driver level and is not at the Database::Accessor. Howeve a quick look a the code and I remembede that my Drivers are highly isolated and I can only access them from the Database::Acessor level. Oh well not much time wasted on that.

Thr first this I had to do was add in the new in the Database::Accessor::Roles::Common role;


has [
qw(da_compose_only
da_no_effect
da_raise_error_off
++ da_suppress_view_name
)
] => (
is => 'rw',
isa => 'Bool',
default => 0,
traits => ['ENV'],
);

and then make sure I pass that value down to my Driver::DBI when I call the '_execute' sub in Database::Accessor;

da_warning => $self->da_warning,
da_raise_error_off => $self->da_raise_error_off,
++ da_suppress_view_name=> $self->da_suppress_view_name

}
);

Now I just have to adjust the Driver::DBI '_field_sql' sub code a little;

else {
my $sql = $element->name;

$sql = $element->view
."."
.$element->name
-- if ($use_view);
++ if ($use_view and !$self->da_suppress_view_name);
return $sql;
}

and after that I have to adjust the 'Test::DB::User' code to use this new flag;

sub da {
my $self = shift;
my $da = Database::Accessor->new({
++ da_suppress_view_name=>1,
view=>{name=>$self->table},
elements=>$self->fields,
update_requires_condition=>0,
delete_requires_condition=>0});

}

and that should do it and is does at I get 17 passes but I still am getting this at the very end

DBD::DBM::st execute failed: No such column 'user.username' at
Dwimperl/perl/site/lib/DBI/DBD/SqlEngine.pm line 1271
[for Statement "SELECT user.username FROM user WHERE user.username = ?"]

So not out of the woods yet.

It is the final test that is not running and this is it;


use Database::Accessor;
my $other_user = Database::Accessor->new({view=>{name=>'user'},
elements=>[{name=>'username'}],
conditions=>{left =>{ name => 'username',
view => 'user'},
right =>{ value => 'Bill'}}});
$user->da_compose_only(1);
$user->reset_conditions();
$user->add_condition({left =>{ name => 'username',
view => 'user'},
right =>{ value => $other_user}
});
ok($user->retrieve($utils->connect()),"retrieve function");

What I am doing here is sending down a new Database::Accessor '$other_user' as the 'right' param on a condition. So that is where the;

SELECT user.username FROM user WHERE user.username = ?

SQL is coming from so I need to do is add in the new 'da_suppress_view_name ' flag in that DA as well;

my $other_user = Database::Accessor->new({
++ da_suppress_view_name =>1,
view=>{name=>'user'},

and now I get a 100% pass.

For kicks I ran the rest of my Driver::DBI test cases and got 100% and to be doubly sure I re-ran all my test cases for Database::Accessor and only ran into one little glitch in the '20_dad_laod.t' test case where my test count is now off and I get one error


..
not ok 18 - Role DAD attribute: da_suppress_view_name is Read Only


The test count is off because I have automated the testing of the various DAD attributes by using the Moose meta object. The reason for the fail is made this attribute a ReadWrite so I havde to add it to an exception list as part of the test;

my %read_write = (da_compose_only=>1,
da_no_effect=>1,
da_raise_error_off=>1,
da_warning=>1,
++ da_suppress_view_name=>1);

and now I get 100% pass on that one and a full pass for Database::Accessor and Driver::DBI.

Time to move along to more code me thinks;

DSC04911a.jpg

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