view release on metacpan or  search on metacpan

t/004_mysql.t  view on Meta::CPAN

#!perl
BEGIN
{
	use strict;
	use warnings;
    use Test::More qw( no_plan );
    select(($|=1,select(STDERR),$|=1)[1]);
    use JSON;
    use Module::Generic::File qw( file );
	our $DEBUG = exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
};

SKIP:
{
    eval
    {
        require DBD::mysql;
    };
    if( $@ )
    {
        skip( "DBD::mysql is not installed", 22 );
    }
    else
    {
        use_ok( 'DB::Object::Mysql' );
        use_ok( "DB::Object::Mysql::Query" );
        use_ok( "DB::Object::Mysql::Statement" );
        use_ok( "DB::Object::Mysql::Tables" );
    }
    
    ## Connection parameters are taken from environment variables (DB_NAME, DB_LOGIN, DB_PASSWD, DB_DRIVER, DB_SCHEMA), or from file (DB_CON_FILE) or from uri (DB_CON_URI)
    ## DB_CON_URI=http://localhost:5432?database=mysql&login=jack&
    $DB::Object::Mysql::DEBUG = $DEBUG; # REMOVE ME
    my $con_params =
    {
        db      => 'mysql',
        host    => ( $ENV{DB_HOST} || 'localhost' ),
        driver  => 'mysql',
        debug   => $DEBUG,
    };
    if( $^O eq 'MSWin32' )
    {
        $con_params->{login} = ( $ENV{DB_LOGIN} || getlogin ) if( !$ENV{DB_CON_FILE} );
    }
    else
    {
        $con_params->{login} = ( $ENV{DB_LOGIN} || getlogin || (getpwuid( $> ))[0] ) if( !$ENV{DB_CON_FILE} );
    }
    my $dbh1 = DB::Object->connect( $con_params );
    if( !defined( $dbh1 ) )
    {
        skip( "Database connection failed, cancelling other tests: $DB::Object::ERROR", 1 );
    }
    
    ok( $dbh1, "Getting DB::Object::Mysql object" );
    isa_ok( $dbh1, 'DB::Object::Mysql', "Checking class of object" );
    $ENV{DB_HOST} ||= 'localhost';
    my @db = $dbh1->databases;
    ok( @db, "Checking available databases" );
    fiag( printf( "Found the databases: %s", join( ", ", @db ) ) );
    if( grep( /^mysql$/, @db ) )
    {
        pass( "mysql database found" );
    }
    else
    {
        fail( "mysql database not found" );
    }

    our $test_db = 'db_object_mysql_test';
    if( scalar( grep( /^$test_db$/, @db ) ) )
    {
        diag( "Switching database to mysql to drop the old test database $test_db" );
        if( !$dbh1->use( 'mysql' ) )
        {
            fail( "Could not switch to database mysql" )
        }
        else
        {
            my $rv = $dbh1->do( "DROP DATABASE $test_db" );
            ok( $rv, "Dropping leftover test database $test_db" );
        }
    }
    else
    {
        pass( "No leftover test database $test_db" );
    }

    our $dbh = $dbh1->create_db( $test_db );
    ok( $dbh, "Creating database $test_db" );
    BAIL_OUT( "Unable to create database $test_db: " . $dbh1->error ) if( !$dbh );

    my $schemaFile = file($0)->parent->child( 'mysql.sql' );
    my $fh = $schemaFile->open( '<', { binmode => 'utf-8' } ) ||
        BAIL_OUT( "Unable to read the mysql schema \"$schemaFile\": $1" );
    my $queries = [];
    my $def = {};
    my $sql = '';
    while( defined( my $l = $fh->getline ) )
    {
        if( $l =~ /^\-{2}[[:blank:]]+(\d+)[[:blank:]]+(.*?)$/ )
        {
            if( length( $sql ) )
            {
                push( @$queries, { id => $def->{id}, comment => $def->{comment}, query => $sql } );
            }
            @$def{qw(id comment)} = ( $1, $2 );