The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*-perl-*-

# lib.pl is the file where database specific things should live,
# whereever possible. For example, you define certain constants
# here and the like.

use strict;
use warnings;

use vars qw($test_dsn $test_user $test_pass $test_pass $test_attr $dbh $short_dsn $PK $dir);

use Carp;
use Cwd;
use File::Path;
use File::Spec;

my %v;
my @req = qw(DBI Template Template::Plugin::DBI);
my @eval = map { qq{require $_;\n\$v{"$_"} = $_->VERSION ()} } @req;
$@ = undef;
eval $_ for @eval;

if ($@)
{
    my @missing = grep { !exists $v{$_} } qw( DBI Template );
    print STDERR "\n\nYOU ARE MISSING REQUIRED MODULES: [ @missing ]\n\n";
    exit 0;
}

# Start each test clean
$dir = File::Spec->catdir( getcwd(), 'test_output' );
rmtree $dir;
END { rmtree $dir }
mkpath $dir;

$test_dsn  = $ENV{DBI_DSN}  || "dbi:DBM(RaiseError=0,PrintError=1,ChopBlanks=1):f_dir=$dir;dbm_mldbm=Storable";
$test_user = $ENV{DBI_USER} || "";
$test_pass = $ENV{DBI_PASS} || "";
$test_attr = {};

# new feature in DBI plugin v2.30+ is to allow user to drop initial 'dbi:'
( $short_dsn = $test_dsn ) =~ s/^dbi://i;

# another hack: if we want to test Tie::DBI updates then we have to build
# database with primary keys to force uniqueness.  However, different database
# have different ways of defining primary keys, so we're only going to test
# it on mysql
$PK = ( $short_dsn =~ /^mysql/i ) ? 'PRIMARY KEY' : '';

eval "use Tie::DBI";
my $tiedbi = $@ ? 0 : 1;

sub BAIL_OUT($)
{
    carp $_[0];
    ntests(1);
    ok(0);
    exit(0);
}

sub get_tt_test_vars
{
    my $vars = {
                 dbh    => $dbh,
                 dsn    => $test_dsn,
                 user   => $test_user,
                 pass   => $test_pass,
                 attr   => $test_attr,
                 short  => $short_dsn,
                 mysql  => $PK ? 1 : 0,
                 tiedbi => $tiedbi,
               };
    return $vars;
}

sub connect_database
{
    $dbh = DBI->connect( $test_dsn, $test_user, $test_pass );
}

#------------------------------------------------------------------------
# init_database
#------------------------------------------------------------------------

sub init_database
{
    my $dbh = shift;

    # ensure tables don't already exist (in case previous test run failed).
    sql_query( $dbh, 'DROP TABLE IF EXISTS usr', 1 );
    sql_query( $dbh, 'DROP TABLE IF EXISTS grp', 1 );

    # create some tables
    sql_query(
        $dbh, "CREATE TABLE grp ( 
                         id Char(16) $PK, 
                         name Char(32) 
                     )"
             );

    sql_query(
        $dbh, "CREATE TABLE usr  ( 
                         id Char(16) $PK, 
                         name Char(32),
                         grp Char(16)
                     )"
             );

    # add some records to the 'grp' table
    sql_query(
        $dbh, "INSERT INTO grp 
                     VALUES ('foo', 'The Foo Group')" );
    sql_query(
        $dbh, "INSERT INTO grp 
                     VALUES ('bar', 'The Bar Group')" );
    sql_query(
        $dbh, "INSERT INTO grp 
                     VALUES ('baz', 'The Baz Group')" );

    # add some records to the 'usr' table
    sql_query(
        $dbh, "INSERT INTO usr 
		     VALUES ('abw', 'Andy Wardley', 'foo')" );
    sql_query(
        $dbh, "INSERT INTO usr 
		     VALUES ('sam', 'Simon Matthews', 'foo')" );

    sql_query(
        $dbh, "INSERT INTO usr 
		     VALUES ('hans', 'Hans von Lengerke', 'bar')" );
    sql_query(
        $dbh, "INSERT INTO usr 
		     VALUES ('mrp', 'Martin Portman', 'bar')" );

    sql_query(
        $dbh, "INSERT INTO usr 
		     VALUES ('craig', 'Craig Barratt', 'baz')" );

}

#------------------------------------------------------------------------
# sql_query($dbh, $sql, $quiet)
#------------------------------------------------------------------------

sub sql_query
{
    my ( $dbh, $sql, $quiet ) = @_;

    my $sth = $dbh->prepare($sql)
      || warn "prepare() failed: $DBI::errstr\n";

    $sth->execute()
      || $quiet
      || warn "execute() failed: $DBI::errstr\n";

    $sth->finish();
}

#------------------------------------------------------------------------
# cleanup_database($dsn, $user, $pass)
#------------------------------------------------------------------------

sub cleanup_database
{
    my $dbh = shift;

    sql_query( $dbh, 'DROP TABLE usr' );
    sql_query( $dbh, 'DROP TABLE grp' );
}

1;