Extend that Moose

Still extending my Moose tests here in the Moose pen today.

For my next extended tests I will need to have some tables on the target tests database. This of course poses some problems as the DDL (Data Definition Language) of each SQL db is slightly different;

Take dropping a table. You very basic SQL works fine

DROP TABLE people;
however this;

DROP TABLE IF EXISTS;
will not work on Oracle and some versions of Infomix and this is just one small example. I need to write a test suite that can handle these differing flavours of SQL and good old MooseX come to my rescue again.

I have had chance to use 'MooseX::Object::Pluggable' the odd time before usually when we had to make an install script that my need to run on one or more configurations and this is the same sort of application here.

As the name suggests this MooseX allow you to create plug ins for for you package. Now I do not want to get too sidetracked on how it works I really just loads and applies a role to a class in a more convenient manner. To start I created a base class called ' Xtest::DB::Users'

use Moose;
with 'MooseX::Object::Pluggable';

has create_sql => (
    is      => 'ro',
    isa     => 'ArrayRef',
    builder => "_create_sql",
    lazy    => 1,
);

has drop_sql => (
    is      => 'ro',
    isa     => 'ArrayRef',
    builder => "_drop_sql",
    lazy    => 1,
);
In the above you see that I created with the Pluggable MooseX and two attribues 'create_sql' and 'drop_sql' both of wich are 'lazy', meaning they are only created when the are called, and both have builders. Now comes the plugin part. I started with Oracle and called it 'Xtest::DB::Users::Plugin::Oracle' and all it has in it is

package Xtest::DB::Users::Plugin::Oracle;
use Moose::Role;

sub _create_sql {
    my $self = shift;
    return ['CREATE TABLE  PEOPLE
   ( ID NUMBER, 
     LAST_NAME VARCHAR2(200),
     FIRST_NAME VARCHAR2(200), 
     ADDRESS_ID NUMBER, 
     USER_ID CHAR(8), 
     CONSTRAINT PEOPLE_PK PRIMARY KEY ("ID") ENABLE
   )',
...
}

sub _drop_sql {
    my $self = shift;
    return [
        "BEGIN
   EXECUTE IMMEDIATE 'DROP TABLE PEOPLE';
EXCEPTION
   WHEN OTHERS THEN
      IF SQLCODE != -942 THEN
         RAISE;
      END IF;
END;",
  ...
}
1;
I simple define it as a Moose Role and add in the two builder subs that simply return an array of the SQL commands that are to be run. Obviously I will create a few more like this such as Xtest::DB::Users::Plugin::MySQL' and Xtest::DB::Users::Plugin::Pg' just substituting out for the correct SQL code.

Now back to my  'Xtest::DB::Users' class where I add in two more attributes;
has dbh => (
    is  => 'rw',
    isa => 'Object'
);

has driver_name => (
    is  => 'rw',
    isa => 'Str'
);
and this sub;

sub connect {
    my $self    = shift;
    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} || { };
    my $dbh     = DBI->connect( $connect, $uid, $pw, $opts );
    $self->driver_name($dbh->{Driver}->{Name} );
    $self->load_plugin( $self->driver_name() );
    return $dbh;
}
where I do the real work. In the above I get a $dbh handle using my ENV vars, I set the driver name and then us the 'load_plugin' call to load in the those builder scripts. Finally I add in a way to create and delete the table I use;

sub create_db {
    my $self = shift;
    my $dbh = $self->dbh()||$self->connect;
    $self->remove_db();
    foreach my $sql (@{$self->create_sql()}){
        $dbh->do($sql);
    } 
}

sub remove_db {
    my $self = shift;
    my $dbh = $self->dbh()||$self->connect;
        foreach my $sql (@{$self->drop_sql()}){
        $dbh->do($sql);
    } 
}
Now how to use the above? I created a new test case called '10_crud_basic.'t under the 'xt' dir and in it I do this;

#!perl
use Test::More  tests => 17;
use lib ('xt\lib');
use DBI;
use Xtest::DB::Users;

my $users = Xtest::DB::Users->new();
$users->crerate_db();

and after I run it I see my new tables on my Oracle DB. Now I am ready to test but I will leave that till the morrow.

DSC04067a.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