# vim: set ts=2 sts=2 sw=2 expandtab smarttab: use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TLDBH; my ($commit, $begun); my $dbh = TLDBH->new; $INC{'DBI.pm'} = __FILE__; sub DBI::SQL_LONGVARCHAR { ':-P' } my $mod = 'DBIx::TableLoader'; eval "require $mod" or die $@; my $loader; foreach my $args ( [], [{columns => []}], ){ is(eval { $loader = $mod->new(@$args) }, undef, 'useless without columns'); like($@, qr/columns/, 'Died without columns'); } my %def_args = ( default_column_type => 'foo', dbh => $dbh, ); # NOTE: determine_column_types is not specifically tested # but it sets the values returned from columns() and column_names() foreach my $args ( [{columns => [qw(d b i)] , %def_args}], [{data => [[qw(d b i)]], %def_args}], ){ $loader = new_ok($mod, $args); is_deeply($loader->columns, [[qw(d foo)], [qw(b foo)], [qw(i foo)]], 'string columns'); is_deeply($loader->column_names, [qw(d b i)], 'string columns (names)'); is_deeply($loader->quoted_column_names, [qw("d" "b" "i")], 'string columns (names) (quoted)'); } $loader = new_ok($mod, [{columns => [[a => 'bar'], ['b'], 'c'], %def_args}]); is_deeply($loader->columns, [[qw(a bar)], [qw(b foo)], [qw(c foo)]], 'mixed columns'); is_deeply($loader->column_names, [qw(a b c)], 'mixed columns (names)'); is_deeply($loader->quoted_column_names, [qw("a" "b" "c")], 'mixed columns (names) (quoted)'); $loader = new_ok($mod, [{columns => [[a => 'bar foo'], ['b', 'gri zz ly'], 'c'], %def_args}]); is_deeply($loader->columns, [['a', 'bar foo'], ['b', 'gri zz ly'], [qw(c foo)]], 'multi-word data types'); is_deeply($loader->column_names, [qw(a b c)], 'multi-word data types (names)'); is_deeply($loader->quoted_column_names, [qw("a" "b" "c")], 'multi-word data types (names) (quoted)'); { # column type my $args = [dbh => $dbh, columns => ['foo']]; # create new instance for each test to avoid internal caching $dbh->{driver_type} = 'boo'; is(new_ok($mod, $args)->default_column_type, 'boo', 'column type from dbh'); $dbh->{driver_type} = ''; is(new_ok($mod, $args)->default_column_type, 'text', 'default column type'); $dbh->{driver_type} = 'no matter'; is(new_ok($mod, [@$args, default_column_type => 'bear'])->default_column_type, 'bear', 'default column type'); # sql data type is(new_ok($mod, $args)->default_sql_data_type, ':-P', 'default sql data type'); } # get_row my $get_row_override_data = {cat => [qw(meow string)], dog => [qw(bark squirrel)], bear => [qw(grr picnicbasket)]}; foreach my $test ( # normal behavior [ simple => {}, [ [1, 2, 3], [qw(a b c)], [0, 0, 0], ]], # modify each row [ map_rows => {map_rows => sub { [map { $_ . $_ } @{ $_[0] }] }}, [ [qw(11 22 33)], [qw(aa bb cc)], [qw(00 00 00)], ]], # example from POD (using $_) [ uppercase_example => {map_rows => sub { [ map { uc $_ } @$_ ] }}, [ [qw(1 2 3)], [qw(A B C)], [qw(0 0 0)], ]], # stupid example of alternate get_row... not useful, but it works # (map_rows would more appropriately do the same thing) # NOTE: columns are reversed because we're using get_row rather than map_rows [ get_row => {get_row => sub { [reverse @{ shift @{ $_[0]->{data} } || return undef }] }}, [ [3, 2, 1], [qw(c b a)], [0, 0, 0], ], [qw(c b a)]], # example of both [ get_row_map_rows => { get_row => sub { [reverse @{ shift @{ $_[0]->{data} } || return undef }] }, map_rows => sub { [map { join('', ($_) x 3) } @{ $_[0] }] }}, [ [qw(333 222 111)], [qw(ccc bbb aaa)], [qw(000 000 000)], ], [qw(c b a)]], # more useful get_row... using an alternate input data format [ alt_get_row => { data => undef, columns => [qw(animal says chases)], get_row => sub { my ($an, $ar) = each %$get_row_override_data; $ar && [$an x 2, @$ar] }}, [ # map keys() so that the data comes out in the same order map { [$_ x 2, @{$$get_row_override_data{$_}}] } keys %$get_row_override_data, ]], # filter some out [ grep_rows => {grep_rows => sub { $_->[1] =~ /^\d+$/ }}, [ [qw(1 2 3)], [qw(0 0 0)], ]], # grep then map [ grep_map_rows => { grep_rows => sub { $_->[1] }, map_rows => sub { [map { ord($_) } @$_] }}, [ [qw(49 50 51)], [qw(97 98 99)], ]], # let validator alter rows to fit [ validate => { handle_invalid_row => sub { [ @{$_[2]}[0,1] ] }, # declare that we only want 2 columns columns => [qw(d e)], }, [ # input data has 4 rows, just use the first two columns of each [qw(a b)], [qw(1 2)], [qw(a b)], [qw(0 0)], ], ], ){ my ($title, $over, $exp, $columns) = @$test; $columns ||= $over->{columns} || [qw(a b c)]; my $args = [dbh => $dbh, data => [ [qw(a b c)], [1, 2, 3], [qw(a b c)], [0, 0, 0], ]]; my $loader = new_ok($mod, [@$args, %$over]); is_deeply($loader->column_names, $columns, "$title: column names"); is_deeply($loader->get_row, $_, "$title: get_row") foreach @$exp; is($loader->get_row, undef, "$title: no more rows"); } # name foreach my $test ( [ [], 'data' ], [ [name_prefix => 'pre_'], 'pre_data' ], [ [name_prefix => 'pre', name_suffix => 'post'], 'predatapost' ], [ [name => 'tab', name_suffix => ' grr'], 'tab grr' ], ){ my ($attr, $exp) = @$test; my $loader = new_ok($mod, [columns => ['goo'], dbh => $dbh, @$attr]); is($loader->name, $exp, 'expected name'); is($loader->quoted_name, qq{"$exp"}, 'expected quoted name'); } # transaction { my $args = [data => [[qw(a b)], [1, 2]], dbh => $dbh]; my $loader = new_ok($mod, [@$args]); $dbh->reset; $loader->load; is($dbh->{begin}, 1, 'transaction'); is($dbh->{commit}, 1, 'transaction'); $loader = new_ok($mod, [@$args, transaction => 0]); $dbh->reset; $loader->load; is($dbh->{begin}, 0, 'no transaction'); is($dbh->{commit}, 0, 'no transaction'); } done_testing;