Moose Still gets a A
It is follow-up day here in the Moose-Pen
Having gotten 100% in Database::Accessor it is time now to see what my coverage level with Driver::DBI. On the first run I got;
---------------------------- ------ ------ ------ ------ ------ ------
File stmt bran cond sub pod total
---------------------------- ------ ------ ------ ------ ------ ------
.../lib/Database/Accessor.pm 90.5 55.5 66.6 90.3 0.0 85.4
...ase/Accessor/Constants.pm 100.0 n/a n/a 100.0 n/a 100.0
...atabase/Accessor/Types.pm 61.9 48.3 29.4 70.8 n/a 57.7
...se/Accessor/Driver/DBI.pm 94.9 81.6 79.6 100.0 n/a 89.8
...ccessor/Driver/DBI/SQL.pm 100.0 n/a n/a 100.0 n/a 100.0
t/00_load.t 95.4 50.0 n/a 100.0 n/a 87.8
t/10_crud_basic.t 96.1 50.0 n/a 100.0 n/a 93.6
t/15_alias.t 100.0 n/a n/a 100.0 n/a 100.0
t/20_fields.t 100.0 n/a n/a 100.0 n/a 100.0
t/22_fields_extended.t 100.0 n/a n/a 100.0 n/a 100.0
t/25_exe_array.t 100.0 n/a n/a 100.0 n/a 100.0
t/30_where_basic.t 100.0 n/a n/a 100.0 n/a 100.0
t/32_where_operators.t 100.0 n/a n/a 100.0 n/a 100.0
t/40_joins.t 100.0 n/a n/a 100.0 n/a 100.0
t/50_group_by.t 100.0 n/a n/a 100.0 n/a 100.0
t/60_order_by.t 100.0 n/a n/a 100.0 n/a 100.0
t/90_extened.t 100.0 n/a n/a 100.0 n/a 100.0
t/lib/Test/DB/User.pm 100.0 n/a n/a 100.0 0.0 93.7
t/lib/Test/User.pm 100.0 n/a n/a 100.0 n/a 100.0
t/lib/Test/Utils.pm 97.0 87.5 n/a 100.0 0.0 90.4
Total 93.1 70.8 67.5 96.4 0.0 89.6
---------------------------- ------ ------ ------ ------ ------ ------
but I see that I am getting coverage for the Database::Accessor files as well. I suppose I can write up a bunch of new tests the test for example for this sub in Accessor.pm
sub update {
my $self = shift;
my ( $conn, $container, $opt ) = @_;
confess( $self->meta->get_attribute('no_update')->description->{message} )
if ( $self->no_update() );
$self->_need_condition( Database::Accessor::Constants::UPDATE,
$self->update_requires_condition()
);
return $self->_create_or_update( Database::Accessor::Constants::UPDATE,
$conn, $container, $opt );
}
and according to 'cover' I have not test when 'no_update' is true condition. There is no reason for me to test this in the DBI::DBD as the driver writer would never get into this condition as the code will die before any DBI::DBD code it hit.
So what to do?
After a bit of looking about I found that 'cover' has a few options one of them is 'ingnore_re' which lets me use a regex to ignore some files. Therefore to remove the test files (I do not really care about these) and the files from Database/Accessor I gave this a go
cover -ignore_re \.t -ignore_re Accessor\.pm -ignore_re Types\.pm -ignore_re Constants\.pm -ignore_re User -ignore_re Utils
and my results are now
---------------------------- ------ ------ ------ ------ ------ ------
File stmt bran cond sub pod total
---------------------------- ------ ------ ------ ------ ------ ------
...se/Accessor/Driver/DBI.pm 94.9 81.6 79.6 100.0 n/a 89.8
...ccessor/Driver/DBI/SQL.pm 100.0 n/a n/a 100.0 n/a 100.0
Total 97.1 81.6 79.6 100.0 n/a 100.0 93.6
---------------------------- ------ ------ ------ ------ ------ ------
ok all good getting 89.8% which is good to start;
It looks like most of my lack of coverage is that I have no test for 'da_raise_error_off ' and 'da_warning ' when they have a value; To fix this I added in this test in the '' test case;
my $address_da = Database::Accessor->new( {view => { name => 'address' }, elements=>[{ name => 'id', view => 'address', },
{ name => 'street', view => 'address', }] } );
$address_da->add_condition({left =>{ name => 'id',
view => 'address'},
right =>{ value => 'test'}
});
$address_da->da_raise_error_off(1);
$address_da->retrieve($utils->connect());
ok($address_da->result()->is_error() == 0,"No error on error");
$address_da->reset_conditions();
$address_da->add_condition({left =>{ name => 'id',
view => 'address'},
right =>{ value => 1}
});
$address_da->da_warning(1);
$address_da->retrieve($utils->connect());
like(
warning { $address_da->retrieve($utils->connect()) },
qr/SELECT address.id, address.street FROM address WHERE address.id/,
'got a warning from dad()',
);
In these two tests I create a new DA that will error as I add condition where I compare an integer to a string. I then set 'da_raise_error_off' to 1 and then check to see that no error is found on the 'is_error()' coming back from the DAD. The next test I just set the da_warning to '1' then check for a warning.
On my next prove I now get 90.1%.
One other thing that cover showed me is this sub;
sub _predicate_clause {
my $self = shift;
my ( $clause_type, $conditions,$view ) = @_;
my $predicate_clause = "";
foreach my $condition ( @{$conditions} ) {
if ( ref($condition) eq 'Database::Accessor::Condition' ) {
foreach my $predicate ( $condition->predicates } ) {
$predicate_clause .=
$self->_predicate_sql( $condition->predicates,$view );
}
}
else {
$predicate_clause .= $self->_predicate_sql($condition,$view);
}
}
$self->da_warn( "_predicate_clause",
$clause_type . " clause='$predicate_clause'" )
if $self->da_warning() >= 5;
return $predicate_clause;
}
Might have some useless code in it ad the if on the ref($condition) eq 'Database::Accessor::Condition' is never hit so I took it out to just this;
foreach my $condition ( @{$conditions} ) {
$predicate_clause .=
$self->_predicate_sql( $condition->predicates,$view );
}
I also found a few lines of code at the bottom of the '_group_by_clause' sub that is after 'return' so I took that out as well;
That only bought me .7% so I am at '90.8' % now;
I also notice that I was missing a number of other tests that where missing. For example I was missing tests for all the da_result_set conditions where I tell the DA to return HASH, JASON or whatever. Fortunately I had created some of these in my 'xt' dir so I copied those into my '10_crud_basic.t' case
With that addition I am now up to 93.4%
The next one I found was
if ($self->is_Class() and $self->da_result_class()){
which was only hitting at 50% and looking at 'Accessor.pm' I can never get to that condition as there it a die in Accessor.pm;
confess( "Database::Accessor retrieve Error: You must supply a da_result_class when da_result_set is Class!" )
if ( $self->da_result_set() eq 'Class' and !$self->da_result_class() );
so I can take the second half off.
Looking else where I found two other spots where I had code I would never get to. I think most of this code weeded its way in before I decided to do all the sanity checks up into the Accessor.pm rather than in the DAD and with these changes I get 94.8% getting there;
I did one other tweek to my warning test;
--$address_da->da_warning(1);
++$address_da->da_warning(8);
$address_da->da_raise_error_off(0);
$address_da->retrieve($utils->connect());
like(
warning { $address_da->retrieve($utils->connect()) },
-- qr/SELECT address.id, address.street FROM address WHERE address.id/,
++ qr/ARRAY/,
'got a warning from dad()',
);
which gets me up to 95.6%
I added in this test
bless({
'address' => '1',
'username' => 'user1'
}, "Test::User" );
$user->da_result_class("Test::User");
$user->da_result_set("Class");
$user->da_key_case("Lower");
$user->retrieve($utils->connect());
my $class = $user->result()->set->[0];
ok(ref($class) eq "Test::User","Result set is correct class");
which should fix the last of the ' da_result_set' missing tests and now I am 96.4% but I was till getting only 50% with this
50 T F elsif ($predicate->operator eq 'IN' or $predicate->operator eq 'NOT IN') { }
I had
elsif ($predicate->operator eq 'IN' || $predicate->operator eq 'NOT IN') { }
Seems I need to have the 'or' in there so I swapped it for an 'or' and that got me up to 96.8% and I found out that simply changing the order of my ifs got me a little more as I moved all the two or more conditions up to the top of the if block.
I finally stop trying to get higher as a few sub like this one
$dbh->commit()
if ($dbh->{AutoCommit} == 0 and !$self->da_no_effect );
There is no way I can set 'AutoCommit' off on the build in test dbi:DBM DB but UI did get it up to 97.1%
Another good day.
Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations
Leave a comment