A++ Moose

Still in cover mode here in the Moose-Pen

I found another sub that was not being tested seem I never call 'da_warn' in my tests.

This one is a little special;

sub da_warn {
my $self = shift;
my ($package, $filename, $line) = caller();
my ($sub,$message) = @_;
warn("$package->$sub(), line:$line, $message");


it is in 'Database::Accessor::Roles::Driver' so not really part of Database::Accessor but as it is in the Accessor.pm file I think it should be tested.

I have to set it up first by adding this line into the 'Database::Accessor::Driver::Test' class;

sub execute {
my $self = shift;
my ($result, $type, $conn, $container, $opt ) = @_;

$result->query($type.' Query');
++ $self->da_warn( 'execute', "Tests DA warning sub" )
++ if ( $self->da_warning() >= 1);
return $result;

and then in good old '20_dad_load.t' I add in this test;

     warning { $da_new->retrieve(Data::Test->new()) },
    qr/Tests DA warning sub/,
    'got a warning from dad()',
The above uses 'Test::Warning' for this in the same way one uses 'Test::Fatal' a neat package that I intend to use even more.

Poking about in the rest of the code I noticed one other sub that was causing me grief 'get_element_by_name' on line 109 but I could see nothing wrong with it except it was failing 100% and when I search about in the code a little more I found a second copy of the same sub on line 475.

The first failing on was found in a role the second one (which was passing) was found in the body of the package. Normally when you redefine a sub twice in perl you will get a warning but in this instance as I was using Moose the Role just overwrote the sub. Nothing wrong with that but in this case I can just take that extra sub out of the Database::Accessor class.

When I rerun my tests and cover I get 100%, well actually 98.8% as I am still have that problem with this sub;

my $found = $self->_get_element_by_lookup(sub { if (ref($_) ne 'Database::Accessor::Element' or !defined($_->_lookup_name)) {return 0} $_->_lookup_name eq $lookup}); 
not getting to the second part of the if the '!defined($_->_lookup_name)' so not getting that 1.2% which I really want.

I did a good review of the code and that second part of that if is not really needed anymore so I took that out and now I am getting 100% end to end.

I was going to look at the other less than perfect scores for 'Accessor.pm' but after the last test run I am getting 100% in all but POD so I will move onto the next class with problems 'Database::Accessor::Types;'

The only thing I think I can fix up in that class is this portion of the '_element_coerce' sub;

 elsif ( exists( $hash->{ifs} ) ) {
        die "Attribute (ifs) does not pass the type constraint because: 
            Validation failed for 'ArrayRefofThens' with less than 2 ifs"
          if (  exists( $hash->{ifs} )
            and ref( $hash->{ifs} ) eq 'ARRAY'
            and scalar( @{ $hash->{ifs} } < 2 ) );
        $class = "Database::Accessor::If";
as I know I do not do a test for this error condition. Looking at the above I can adjust it a little as I have the exists($hash->{ifs}) twice I only need in the first if.

After taking that out and adding in one more test my coverage now stands at 95% so not bad. I might have to be satisfied with that 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