The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
use strict;
use warnings;
use lib qw(t);

use Test::More;
use TestLib qw(connect prove_reqs show_reqs test_dir default_recommended);

my ( $required, $recommended ) = prove_reqs( { default_recommended(), ( MLDBM => 0 ) } );
my ( undef, $extra_recommended ) = prove_reqs( { 'DBD::SQLite' => 0, } );
show_reqs( $required, { %$recommended, %$extra_recommended } );
my @test_dbds = ( 'SQL::Statement', grep { /^dbd:/i } keys %{$recommended} );
my $testdir = test_dir();

my @external_dbds = ( keys %$extra_recommended, grep { /^dbd::(?:dbm|csv)/i } keys %{$recommended} );

foreach my $test_dbd (@test_dbds)
{
    my $dbh;
    diag("Running tests for $test_dbd");
    my $temp = "";
    # XXX
    # my $test_dbd_tbl = "${test_dbd}::Table";
    # $test_dbd_tbl->can("fetch") or $temp = "$temp";
    $test_dbd eq "DBD::File"      and $temp = "TEMP";
    $test_dbd eq "SQL::Statement" and $temp = "TEMP";

    my %extra_args;
    if ( $test_dbd eq "DBD::DBM" and $recommended->{MLDBM} )
    {
        $extra_args{dbm_mldbm} = "Storable";
    }
    $dbh = connect(
                    $test_dbd,
                    {
                       PrintError => 0,
                       RaiseError => 0,
                       f_dir      => $testdir,
                       %extra_args,
                    }
                  );

    my $external_dsn;
    if (%$extra_recommended)
    {
        if ( $extra_recommended->{'DBD::SQLite'} )
        {
            $external_dsn = "DBI:SQLite:dbname=" . File::Spec->catfile( $testdir, 'sqlite.db' );
        }
    }
    elsif (@external_dbds)
    {
        if ( $test_dbd eq $external_dbds[0] and @external_dbds > 1 )
        {
            $external_dsn = $external_dbds[1];
        }
        else
        {
            $external_dsn = $external_dbds[0];
        }
        $external_dsn =~ s/^dbd::(\w+)$/dbi:$1:/i;
        my @valid_dsns = DBI->data_sources( $external_dsn, { f_dir => $testdir } );
        $external_dsn = $valid_dsns[0];
    }

    my ( $sth, $str );

    ####################
    # IMPORT($AoA)
    ####################
    $sth = $dbh->prepare("SELECT word FROM IMPORT(?) ORDER BY id DESC");
    my $AoA = [
                [qw( id word    )], [qw( 4  Just    )], [qw( 3  Another )], [qw( 2  Perl    )],
                [qw( 1  Hacker  )],
              ];

    $sth->execute($AoA);
    $str = '';
    while ( my $r = $sth->fetch_row() ) { $str .= "@$r^"; }
    cmp_ok( $str, 'eq', 'Just^Another^Perl^Hacker^', 'IMPORT($AoA)' );

    #######################
    # IMPORT($AoH)
    #######################
    my $aoh = [
                {
                   c1 => 1,
                   c2 => 9
                },
                {
                   c1 => 2,
                   c2 => 8
                }
              ];
    $sth = $dbh->prepare("SELECT C1,c2 FROM IMPORT(?)");
    $sth->execute($aoh);
    $str = '';
    while ( my $r = $sth->fetch_row() ) { $str .= "@$r^"; }
    cmp_ok( $str, 'eq', '1 9^2 8^', 'IMPORT($AoH)' );

    #######################
    # IMPORT($internal_sth)
    #######################
  SKIP:
    {
        skip( "Need DBI statement handle - can't use when executing direct", 7 )
          if ( $dbh->isa('TestLib::Direct') );

        ok( $dbh->do( "CREATE $temp TABLE aoh AS IMPORT(?)", {}, $aoh ), 'CREATE AS IMPORT($aoh)' )
          or diag( $dbh->errstr() );
        $sth = $dbh->prepare("SELECT C1,c2 FROM aoh");
        $sth->execute();
        $str = '';
        while ( my $r = $sth->fetch_row() ) { $str .= "@$r^"; }
        cmp_ok( $str, 'eq', '1 9^2 8^', 'SELECT FROM IMPORTED($AoH)' );

        ok( $dbh->do( "CREATE $temp TABLE aoa AS IMPORT(?)", {}, $AoA ), 'CREATE AS IMPORT($aoa)' )
          or diag( $dbh->errstr() );
        $sth = $dbh->prepare("SELECT word FROM aoa ORDER BY id DESC");
        $sth->execute();
        $str = '';
        while ( my $r = $sth->fetch_row() ) { $str .= "@$r^"; }
        cmp_ok( $str, 'eq', 'Just^Another^Perl^Hacker^', 'SELECT FROM IMPORTED($AoA)' );

        ok( $dbh->do("CREATE $temp TABLE tbl_copy AS SELECT * FROM aoa"), 'CREATE AS SELECT *' )
          or diag( $dbh->errstr() );
        $sth = $dbh->prepare("SELECT * FROM tbl_copy ORDER BY id ASC");
        $sth->execute();
        $str = '';
        while ( my $r = $sth->fetch_row() ) { $str .= "@$r^"; }
        cmp_ok( $str, 'eq', '1 Hacker^2 Perl^3 Another^4 Just^', 'SELECT FROM "SELECTED(*)"' );

        $dbh->do($_) for split /\n/, <<"";
        CREATE $temp TABLE tmp (id INTEGER, xphrase VARCHAR(30))
        INSERT INTO tmp VALUES(1,'foo')

        my $internal_sth = $dbh->prepare('SELECT * FROM tmp')->{sth};    # XXX breaks abstraction
        $internal_sth->execute();
        $sth = $dbh->prepare('SELECT * FROM IMPORT(?)');
        $sth->execute($internal_sth);
        $str = '';
        while ( my $r = $sth->fetch_row() ) { $str .= "@$r^"; }
        cmp_ok( $str, 'eq', '1 foo^', 'IMPORT($internal_sth)' );
    }

    #######################
    # IMPORT($external_sth)
    #######################
  SKIP:
    {
        skip( 'No external usable data source installed', 2 ) unless ($external_dsn);

        my $xb_dbh = DBI->connect($external_dsn);
        $xb_dbh->do($_) for split /\n/, <<"";
    CREATE TABLE xb (id INTEGER, xphrase VARCHAR(30))
    INSERT INTO xb VALUES(1,'foo')

        my $xb_sth = $xb_dbh->prepare('SELECT * FROM xb');
        $xb_sth->execute();

        $sth = $dbh->prepare('SELECT * FROM IMPORT(?)');
        $sth->execute($xb_sth);
        $str = '';
        while ( my $r = $sth->fetch_row() ) { $str .= "@$r^"; }
        cmp_ok( $str, 'eq', '1 foo^', 'SELECT IMPORT($external_sth)' );

      SKIP:
        {
            skip( "Need DBI statement handle - can't use when executing direct", 2 )
              if ( $dbh->isa('TestLib::Direct') );

            $xb_sth = $xb_dbh->prepare('SELECT * FROM xb');
            $xb_sth->execute();

            ok( $dbh->do( "CREATE $temp TABLE xbi AS IMPORT(?)", {}, $xb_sth ),
                'CREATE AS IMPORT($sth)' )
              or diag( $dbh->errstr() );
            $sth = $dbh->prepare('SELECT * FROM xbi');
            $sth->execute();
            $str = '';
            while ( my $r = $sth->fetch_row() ) { $str .= "@$r^"; }
            cmp_ok( $str, 'eq', '1 foo^', 'SELECT FROM IMPORTED ($external_sth)' );
        }

        $xb_dbh->do("DROP TABLE xb");
    }
}

done_testing();