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') { }
and then I stumbled on it 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.

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