t/admin/10script.t

   1 # vim: filetype=perl
   2 use strict;
   3 use warnings;
   4
   5 use Test::More;
   6 use Config;
   7 use lib qw(t/lib);
   8 use DBICTest;
   9
  10 BEGIN {
  11   require DBIx::Class;
  12   plan skip_all => 'Test needs ' .
  13     DBIx::Class::Optional::Dependencies->req_missing_for('test_admin_script')
  14       unless DBIx::Class::Optional::Dependencies->req_ok_for('test_admin_script');
  15 }
  16
  17 $ENV{PATH} = '';
  18 $ENV{PERL5LIB} = join ($Config{path_sep}, @INC);
  19
  20 my @json_backends = qw/XS JSON DWIW/;
  21
  22 # test the script is setting @INC properly
  23 test_exec (qw|-It/lib/testinclude --schema=DBICTestAdminInc --connect=[] --insert|);
  24 cmp_ok ( $? >> 8, '==', 70, 'Correct exit code from connecting a custom INC schema' );
  25
  26 # test that config works properly
  27 {
  28   no warnings 'qw';
  29   test_exec(qw|-It/lib/testinclude --schema=DBICTestConfig --create --connect=["klaatu","barada","nikto"]|);
  30   cmp_ok( $? >> 8, '==', 71, 'Correct schema loaded via config' ) || exit;
  31 }
  32
  33 # test that config-file works properly
  34 test_exec(qw|-It/lib/testinclude --schema=DBICTestConfig --config=t/lib/admincfgtest.json --config-stanza=Model::Gort --deploy|);
  35 cmp_ok ($? >> 8, '==', 71, 'Correct schema loaded via testconfig');
  36
  37 TODO: {
  38   local $TODO = 'these tests need to be fixed for Win32' if $^O eq 'MSWin32';
  39
  40   for my $js (@json_backends) {
  41
  42       eval {JSON::Any->import ($js) };
  43       SKIP: {
  44           skip ("JSON backend $js is not available, skip testing", 1) if $@;
  45
  46           $ENV{JSON_ANY_ORDER} = $js;
  47           eval { test_dbicadmin () };
  48           diag $@ if $@;
  49       }
  50   }
  51 }
  52
  53 done_testing();
  54
  55 sub test_dbicadmin {
  56     my $schema = DBICTest->init_schema( sqlite_use_file => 1 );  # reinit a fresh db for every run
  57
  58     my $employees = $schema->resultset('Employee');
  59
  60     test_exec( default_args(), qw|--op=insert --set={"name":"Matt"}| );
  61     ok( ($employees->count()==1), "$ENV{JSON_ANY_ORDER}: insert count" );
  62
  63     my $employee = $employees->find(1);
  64     ok( ($employee->name() eq 'Matt'), "$ENV{JSON_ANY_ORDER}: insert valid" );
  65
  66     test_exec( default_args(), qw|--op=update --set={"name":"Trout"}| );
  67     $employee = $employees->find(1);
  68     ok( ($employee->name() eq 'Trout'), "$ENV{JSON_ANY_ORDER}: update" );
  69
  70     test_exec( default_args(), qw|--op=insert --set={"name":"Aran"}| );
  71
  72     SKIP: {
  73         skip ("MSWin32 doesn't support -| either", 1) if $^O eq 'MSWin32';
  74
  75         my ($perl) = $^X =~ /(.*)/;
  76
  77         open(my $fh, "-|",  ( $perl, '-MDBICTest::RunMode', 'script/dbicadmin', default_args(), qw|--op=select --attrs={"order_by":"name"}| ) ) or die $!;
  78         my $data = do { local $/; <$fh> };
  79         close($fh);
  80         if (!ok( ($data=~/Aran.*Trout/s), "$ENV{JSON_ANY_ORDER}: select with attrs" )) {
  81           diag ("data from select is $data")
  82         };
  83     }
  84
  85     test_exec( default_args(), qw|--op=delete --where={"name":"Trout"}| );
  86     ok( ($employees->count()==1), "$ENV{JSON_ANY_ORDER}: delete" );
  87 }
  88
  89 sub default_args {
  90   my $dbname = DBICTest->_sqlite_dbfilename;
  91   return (
  92     qw|--quiet --schema=DBICTest::Schema --class=Employee|,
  93     qq|--connect=["dbi:SQLite:dbname=$dbname","","",{"AutoCommit":1}]|,
  94     qw|--force -I testincludenoniterference|,
  95   );
  96 }
  97
  98 sub test_exec {
  99   my ($perl) = $^X =~ /(.*)/;
 100
 101   my @args = ($perl, '-MDBICTest::RunMode', 'script/dbicadmin', @_);
 102
 103   if ($^O eq 'MSWin32') {
 104     require Win32::ShellQuote; # included in test optdeps
 105     @args = Win32::ShellQuote::quote_system_list(@args);
 106   }
 107
 108   system @args;
 109 }