Extend Your Moose Tests

Its extended test Day here in the Moose-Pen

Now that I have what I think is 99.95% of my API set and both Database::Accessor and Driver::DBI are code-complete and passing all test cases, I think is is time to do some practical tests on my system.

By piratical I mead testing on a 'real' SQL db. So far I have been testing with the very limited 'dbi:ExampleP' DBD, and little less limited 'dbi:DBM' and only in two test cases. All the other thests cases I really just check the generated SQL so I have know idea, but a good assumption, that the code will work on a real SQL DB.

Some of you might remember my foray into Dist::Zilla one of the more useful parts that I found was support for extended and release only tests. At this point in time I would like to provide the end users the option of running a set of tests to check Driver::DBI against their DB to see if it works.

What I want is to add in the next set of tests in the 'xt' folder for 'eXtended Tests where the end user has the option of running them or not.

I start with a copy of the 00_load.t test case and add in;

use Test::More tests => 3;

++my $connect = $ENV{DAD_TEST_CONNECT_STR} || “"; 
++my $uid     = $ENV{DAD_TEST_UID} || "";
++my $pw      = $ENV{DAD_TEST_PW} || "";
++my $opts    = $ENV{DAD_TEST_OPTS} || {};
Now my end user can set up his own DB for testing, either by setting the above environment vars or by editing the test case directly. The rest of the test case is much the same;

    require_ok('Database::Accessor') || print "Bail out!";
    require_ok('DBI')                || print "Bail out!";
my $in_hash = { da_compose_only=>1,
                            view                    => { name  => 'name' },
                             elements            => [ { name => 'last_name', },
                                                              { name => 'first_name', }, ]};

my $da      = Database::Accessor->new($in_hash);

--my $return  = {};
--my $dbh     = DBI->connect("dbi:ExampleP:", '', '');
++my $dbh = DBI->connect( $connect, $uid, $pw, $opts );

--eval { $da->retrieve( $dbh, $return); };
++eval { $da->retrieve( $dbh); };

if ($@) {
    fail("Can not load Database::Accessor::Driver::DBI error=$@");
else {
    pass("Database::Accessor::Driver::DBI Loaded");
Now all I have done in the above is take out that '$return' as that is no longer part of the API, will have to fix that in the other 00_load.t test case as well, and I have swapped in my values for the DBI connection and then just do the the next test.

I do not fail here if I get an error on the '$dbh' as that would not be a problem with Driver::DBI or Database::Accessor but with the end users connection string.

I set this up to run with my local Oracle DB and I get;

ok 1 - require Database::Accessor;
ok 2 - require DBI;
ok 3 - Database::Accessor::Driver::DBI Loaded
Which is nice but I think I will improve that a little;

–  pass("Database::Accessor::Driver::DBI Loaded");
++   pass("Database::Accessor::Driver::DBI Loaded for DBD $connect");
You will notice that I actually never get to the db via Driver::DBI with the above test as I have the 'da_compose_only' flag set, because of this my next test will be;

$da = Database::Accessor->new($in_hash);
$da->retrieve( $dbh );
if ($da->result->is_error()) {
    pass("Got an error from the DB $connect");
else {
    fail("Did not get an error on DB $connect");
What I am testing here is this little bit of code in DBI.pm

    local $dbh->{RaiseError} = 1
      unless ( $self->da_raise_error_off );
which should be caught later on when I try to 'prepare'->'bind'->'execute' my SQL. Hopefully the db doe not have a table called '12@@###'. When I run it I get;

ok 2 - require DBI;
ok 3 - Database::Accessor::Driver::DBI Loaded for DBD DBI:Oracle:
DBD::Oracle::db prepare failed: ORA-00923: FROM keyword not found where expected (DBD ERROR: error possibly near <*> indicator at char 9 in 'SELECT 12<*>@@###.last_name, 12@@###.first_name FROM 12@@###') [for Statement "SELECT 12@@###.last_name, 12@@###.first_name FROM 12@@###"] at D:\GitHub\database-accessor-driver-dbi\lib/Database/Accessor/Driver/DBI.pm line 108.
ok 4 - Got an error from the DB DBI:Oracle:
Opps I am getting a warning in there I do not really want. This is the DBI again as I think 'PrintError' is always true. I think I can suppress that like this;

sub execute {
    my $self = shift;
    my ( $result, $action, $dbh, $container, $opt ) = @_;
++    local $dbh->{PrintError} = 0;
    local $dbh->{RaiseError} = 1
      unless ( $self->da_raise_error_off );
and on the run I get;

ok 3 - Database::Accessor::Driver::DBI Loaded for DBD DBI:Oracle:
ok 4 - Got an error from the DB DBI:Oracle:
so that is nice.

Now for the final test today I want to check that my Driver::DBI does not muck with the original values of those two $dbh attributes. What I have to do first is adjust the 'DAD_TEST_OPTS' environment var so it turns 'RaiseError' off

Next my two tests;

ok(!$dbh->{RaiseError},'RaiseError still off');
ok($dbh->{PrintError},'PrintError still on');
After that I now get;

ok 5 - RaiseError still off
ok 6 - PrintError still on
and tomorrow off to do something else;


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