view release on metacpan or  search on metacpan

t/encoders/dbi.t  view on Meta::CPAN

#  TEST_DRSE_USER

use Test2::V0;
use Test2::Tools::AfterSubtest;

use User::pwent;
use Test::TempDir::Tiny;
use Data::Record::Serialize;
use List::Util 1.33 qw( any );
use Path::Tiny;

# for some reason during tests our new 'lib' dir does not have the
# highest priority when Data::Record::Serialize searches for encoders,
# and pre-installed versions of this module will get used.
use lib Path::Tiny->cwd->child('lib')->stringify;

eval { require DBI; 1 }
  or plan skip_all => "Need DBI to run the DBI backend tests\n";

my @DBDs;

my $DBD_SQLite_VERSION = 1.31;

use constant TABLE     => 'DRST_sttbl';  # make sure it needs quoting
use constant SQLITE_DB => 'foo/bar/test.db';

my @dsn_fields = qw(
  dbname
  host
  password
  port
  schema
  server
  table
  user
);

eval { require DBD::SQLite; 1; }
  && push @DBDs,
  {
    dbname => SQLITE_DB,
    dbd    => 'SQLite',
    table  => TABLE,
  };

if ( defined( my $driver = $ENV{TEST_DRSE_DRIVER} ) ) {
    diag( "unable to load DBD::$driver" )
      unless eval "use DBD::$driver; 1";    ## no critic (BuiltinFunctions::ProhibitStringyEval)

    my %dbd = map {
        my $envvar = 'TEST_DRSE_' . uc( $_ );
        exists $ENV{$envvar} ? ( $_ => $ENV{$envvar} ) : ();
    } @dsn_fields;
    $dbd{dbd} = $driver;
    $dbd{table} //= TABLE;

    if ( defined $dbd{dbname} ) {

    push @DBDs, \%dbd;

    $dbd{user} //= getpwuid( $< )->name;

    shift @DBDs if $ENV{TEST_DRSE_ALTERNATE_ONLY};
}
    else {
        bail_out "No dbname set; specify it via the TEST_DRSE_DBNAME env variable" ;
    }

}

@DBDs
  or plan skip_all =>
  "Need at least DBD::SQLite (>= $DBD_SQLite_VERSION) to run the DBI backend tests\n";

my @test_data = (
    { a => 1,  b => 2, c => 'nyuck nyuck' },
    { a => 3,  b => 4, c => 'niagara falls' },
    { a => 5,  b => 6, c => 'why youuu !' },
    { a => 7,  b => 8, c => 'scale that fish !' },
    { a => 9,  c => q{that's all folks} },
    { a => 11, b => undef, c => q{pronoun problems} },
);

my @expected_data = map {
    my $obj = {%$_};
    @{$obj}{ grep !defined $obj->{$_} || !length $obj->{$_}, qw[ a b c ] }
      = undef;
    $obj;
} @test_data;

# just in case we corrupt @test_data;
my $test_data_nrows = @test_data;

my $after_cb = sub { };

after_subtest( sub { $after_cb->() } );

for my $dbinfo ( @DBDs ) {

    my %dbinfo = %$dbinfo;
    my ( $dbd, $user, $password, $schema, $table )
      = delete @dbinfo{ 'dbd', 'user', 'password', 'schema', 'table' };
    $user     //= q{};
    $password //= q{};

    my $dsn              = mk_dsn( $dbd, %dbinfo );
    my %constructor_args = (
        encode            => 'dbi',
        create_table      => !!1,
        quote_identifiers => !!1,
        create_output_dir => !!1,
    );
    @constructor_args{ 'dsn', 'db_user', 'db_pass', 'schema', 'table' }
      = ( [ $dbd, \%dbinfo ], $user, $password, $schema, $table );

    my $dbf;
    if ( $dbd eq 'SQLite' ) {
        $dbf = sub { SQLITE_DB };
    }
    else {
        $dbf      = sub { $dbinfo{dbname} };