Bump Sub::Uplevel dep - too much breaks on <= 0.18
[dbsrgits/DBIx-Class-Historic.git] / xt / extra / dbicadmin.t
CommitLineData
cb551b07 1BEGIN {
2 # just in case the user env has stuff in it
3 delete $ENV{JSON_ANY_ORDER};
da9346a0 4 delete $ENV{DBICTEST_VERSION_WARNS_INDISCRIMINATELY};
c0329273 5
6 do "./t/lib/ANFANG.pm" or die ( $@ || $! )
cb551b07 7}
8
c0329273 9use strict;
10use warnings;
11
12use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_admin_script';
13
70350518 14use Test::More;
73fbf6bd 15use Config;
c0329273 16
70350518 17use DBICTest;
d8d6276a 18
f3ec358e 19$ENV{PATH} = '';
20$ENV{PERL5LIB} = join ($Config{path_sep}, @INC);
21
be855469 22my @json_backends = qw(DWIW PP JSON CPANEL XS);
099f10d1 23
24# test the script is setting @INC properly
7b71391b 25test_exec (qw|-It/lib/testinclude --schema=DBICTestAdminInc --connect=[] --insert|);
1c4391f3 26cmp_ok ( $? >> 8, '==', 70, 'Correct exit code from connecting a custom INC schema' );
099f10d1 27
7b71391b 28# test that config works properly
29{
30 no warnings 'qw';
31 test_exec(qw|-It/lib/testinclude --schema=DBICTestConfig --create --connect=["klaatu","barada","nikto"]|);
32 cmp_ok( $? >> 8, '==', 71, 'Correct schema loaded via config' ) || exit;
33}
34
35# test that config-file works properly
36test_exec(qw|-It/lib/testinclude --schema=DBICTestConfig --config=t/lib/admincfgtest.json --config-stanza=Model::Gort --deploy|);
37cmp_ok ($? >> 8, '==', 71, 'Correct schema loaded via testconfig');
38
16120b22 39for my $js (@json_backends) {
1405206e 40
16120b22 41 SKIP: {
de895f09 42 eval {JSON::Any->import ($js); 1 }
43 or skip ("JSON backend $js is not available, skip testing", 1);
a0361822 44
16120b22 45 local $ENV{JSON_ANY_ORDER} = $js;
46 eval { test_dbicadmin () };
47 diag $@ if $@;
48 }
d1b1377b 49}
50
7b71391b 51done_testing();
52
d1b1377b 53sub test_dbicadmin {
54 my $schema = DBICTest->init_schema( sqlite_use_file => 1 ); # reinit a fresh db for every run
d8d6276a 55
d1b1377b 56 my $employees = $schema->resultset('Employee');
d8d6276a 57
20c48bc4 58 test_exec( default_args(), qw|--op=insert --set={"name":"Matt"}| );
e1e87a42 59 ok( ($employees->count()==1), "$ENV{JSON_ANY_ORDER}: insert count" );
d8d6276a 60
d1b1377b 61 my $employee = $employees->find(1);
e1e87a42 62 ok( ($employee->name() eq 'Matt'), "$ENV{JSON_ANY_ORDER}: insert valid" );
d8d6276a 63
20c48bc4 64 test_exec( default_args(), qw|--op=update --set={"name":"Trout"}| );
d1b1377b 65 $employee = $employees->find(1);
e1e87a42 66 ok( ($employee->name() eq 'Trout'), "$ENV{JSON_ANY_ORDER}: update" );
1405206e 67
20c48bc4 68 test_exec( default_args(), qw|--op=insert --set={"name":"Aran"}| );
70350518 69
1f2e0cb9 70 SKIP: {
16120b22 71 skip ("MSWin32 doesn't support -|", 1) if $^O eq 'MSWin32';
1f2e0cb9 72
f3ec358e 73 my ($perl) = $^X =~ /(.*)/;
74
c0329273 75 open(my $fh, "-|", ( $perl, '-MANFANG', 'script/dbicadmin', default_args(), qw|--op=select --attrs={"order_by":"name"}| ) ) or die $!;
1f2e0cb9 76 my $data = do { local $/; <$fh> };
77 close($fh);
fd27648a 78 if (!ok( ($data=~/Aran.*Trout/s), "$ENV{JSON_ANY_ORDER}: select with attrs" )) {
dafa32f9 79 diag ("data from select is $data")
80 };
1f2e0cb9 81 }
d8d6276a 82
20c48bc4 83 test_exec( default_args(), qw|--op=delete --where={"name":"Trout"}| );
e1e87a42 84 ok( ($employees->count()==1), "$ENV{JSON_ANY_ORDER}: delete" );
85}
86
20c48bc4 87sub default_args {
16120b22 88 my $dsn = JSON::Any->encode([
89 'dbi:SQLite:dbname=' . DBICTest->_sqlite_dbfilename,
90 '',
91 '',
92 { AutoCommit => 1 },
93 ]);
94
20c48bc4 95 return (
96 qw|--quiet --schema=DBICTest::Schema --class=Employee|,
16120b22 97 qq|--connect=$dsn|,
099f10d1 98 qw|--force -I testincludenoniterference|,
20c48bc4 99 );
100}
101
20c48bc4 102sub test_exec {
f3ec358e 103 my ($perl) = $^X =~ /(.*)/;
20c48bc4 104
aff5e9c1 105 my @args = ($perl, '-MANFANG', 'script/dbicadmin', @_);
20c48bc4 106
a0361822 107 if ($^O eq 'MSWin32') {
108 require Win32::ShellQuote; # included in test optdeps
109 @args = Win32::ShellQuote::quote_system_list(@args);
20c48bc4 110 }
e1e87a42 111
a0361822 112 system @args;
d1b1377b 113}