t/05testapp.t

   1 use strict;
   2 use Test::More;
   3 use FindBin;
   4 use File::Spec::Functions qw/catfile catdir/;
   5 use File::Find;
   6 use Config;
   7 use DBI;
   8 use IPC::Open3 'open3';
   9
  10 plan skip_all => 'Enable this optional test with $ENV{C_M_DBIC_SCHEMA_TESTAPP}'
  11     unless $ENV{C_M_DBIC_SCHEMA_TESTAPP};
  12
  13 my $test_params = [
  14     [ 'TestSchema', 'DBIC::Schema', '' ],
  15     [ 'TestSchemaDSN', 'DBIC::Schema', qw/fakedsn fakeuser fakepass/, '{ AutoCommit => 1 }' ],
  16     [ 'TestSchemaDSN', 'DBIC::Schema', 'create=static', 'traits=Caching', q|moniker_map={ roles => 'ROLE' }|, 'constraint=^users\z', 'dbi:SQLite:testdb.db' ],
  17     [ 'TestSchemaDSN', 'DBIC::Schema', 'create=static', 'traits=Caching', q|moniker_map={ roles => 'ROLE' }|, 'constraint=^users\z', 'dbi:SQLite:testdb.db', '', '', q|on_connect_do=['select 1', 'select 2']| ],
  18     [ 'TestSchemaDSN', 'DBIC::Schema', 'create=static', 'traits=Caching', q|moniker_map={ roles => 'ROLE' }|, 'dbi:SQLite:testdb.db', q|on_connect_do=['select 1', 'select 2']| ],
  19     [ 'TestSchemaDSN', 'DBIC::Schema', 'create=static', 'traits=Caching', 'inflect_singular=sub { $_[0] =~ /\A(.+?)(_id)?\z/; $1 }', q{moniker_map=sub { return join('', map ucfirst, split(/[\W_]+/, lc $_[0])); }}, 'dbi:SQLite:testdb.db' ],
  20 ];
  21
  22 my $test_dir   = $FindBin::Bin;
  23 my $blib_dir   = catdir ($test_dir, '..', 'blib', 'lib');
  24 my $cat_dir    = catdir ($test_dir, 'TestApp');
  25 my $catlib_dir = catdir ($cat_dir, 'lib');
  26 my $schema_dir = catdir ($catlib_dir, 'TestSchemaDSN');
  27 my $creator    = catfile($cat_dir, 'script', 'testapp_create.pl');
  28 my $model_dir  = catdir ($catlib_dir, 'TestApp', 'Model');
  29 my $db         = catfile($cat_dir, 'testdb.db');
  30
  31 my $catalyst_pl;
  32
  33 foreach my $bin (split /(?:$Config{path_sep}|:)/, $ENV{PATH}) {
  34    my $file = catfile($bin, 'catalyst.pl');
  35    if (-f $file) {
  36       $catalyst_pl = $file;
  37       last;
  38    }
  39 }
  40
  41 plan skip_all => 'catalyst.pl not found' unless $catalyst_pl;
  42
  43 chdir($test_dir);
  44 silent_exec("$^X $catalyst_pl TestApp");
  45 chdir($cat_dir);
  46
  47 # create test db
  48 my $dbh = DBI->connect("dbi:SQLite:$db", '', '', {
  49    RaiseError => 1, PrintError => 0
  50 });
  51 $dbh->do(<<'EOF');
  52 CREATE TABLE users (
  53         id            INTEGER PRIMARY KEY,
  54         username      TEXT,
  55         password      TEXT,
  56         email_address TEXT,
  57         first_name    TEXT,
  58         last_name     TEXT,
  59         active        INTEGER
  60 );
  61 EOF
  62 $dbh->do(<<'EOF');
  63 CREATE TABLE roles (
  64         id   INTEGER PRIMARY KEY,
  65         role TEXT
  66 );
  67 EOF
  68 $dbh->disconnect;
  69
  70 foreach my $tparam (@$test_params) {
  71    my ($model, $helper, @args) = @$tparam;
  72
  73    cleanup_schema();
  74
  75    silent_exec($^X, "-I$blib_dir", $creator, 'model', $model, $helper, $model, @args);
  76
  77    my $model_path = catfile($model_dir, $model . '.pm');
  78    ok( -f $model_path, "$model_path is a file" );
  79    my $compile_rv = silent_exec($^X, "-I$blib_dir", "-I$catlib_dir", "-c", $model_path);
  80    ok($compile_rv == 0, "perl -c $model_path");
  81
  82    if (grep /create=static/, @args) {
  83       my @result_files = result_files();
  84
  85       if (grep /constraint/, @args) {
  86          is scalar @result_files, 1, 'constraint works';
  87       } else {
  88          is scalar @result_files, 2, 'correct number of tables';
  89       }
  90
  91       for my $file (@result_files) {
  92          my $code = code_for($file);
  93
  94          like $code, qr/use Moose;\n/, 'use_moose enabled';
  95          like $code, qr/__PACKAGE__->meta->make_immutable;\n/, 'use_moose enabled';
  96       }
  97    }
  98 }
  99
 100 # Test that use_moose=1 is not applied to existing non-moose schemas (RT#60558)
 101 {
 102    cleanup_schema();
 103
 104    silent_exec($^X, "-I$blib_dir", $creator, 'model',
 105       'TestSchemaDSN', 'DBIC::Schema', 'TestSchemaDSN',
 106       'create=static', 'use_moose=0', 'dbi:SQLite:testdb.db'
 107    );
 108
 109    my @result_files = result_files();
 110
 111    for my $file (@result_files) {
 112       my $code = code_for($file);
 113
 114       unlike $code, qr/use Moose;\n/, 'non use_moose=1 schema';
 115       unlike $code, qr/__PACKAGE__->meta->make_immutable;\n/, 'non use_moose=1 schema';
 116    }
 117
 118    silent_exec($^X, "-I$blib_dir", $creator, 'model',
 119       'TestSchemaDSN', 'DBIC::Schema', 'TestSchemaDSN',
 120       'create=static', 'dbi:SQLite:testdb.db'
 121    );
 122
 123    for my $file (@result_files) {
 124       my $code = code_for($file);
 125
 126       unlike $code, qr/use Moose;\n/,
 127          'non use_moose=1 schema not upgraded to use_moose=1';
 128       unlike $code, qr/__PACKAGE__->meta->make_immutable;\n/,
 129          'non use_moose=1 schema not upgraded to use_moose=1';
 130    }
 131 }
 132
 133 # Test that a moose schema is not detected as a non-moose schema due to an
 134 # errant file.
 135 {
 136    cleanup_schema();
 137
 138    silent_exec($^X, "-I$blib_dir", $creator, 'model',
 139       'TestSchemaDSN', 'DBIC::Schema', 'TestSchemaDSN',
 140       'create=static', 'dbi:SQLite:testdb.db'
 141    );
 142
 143    mkdir "$schema_dir/.svn";
 144    open my $fh, '>', "$schema_dir/.svn/foo"
 145       or die "Could not open $schema_dir/.svn/foo for writing: $!";
 146    print $fh "gargle\n";
 147    close $fh;
 148
 149    mkdir "$schema_dir/Result/.svn";
 150    open $fh, '>', "$schema_dir/Result/.svn/foo"
 151       or die "Could not open $schema_dir/Result/.svn/foo for writing: $!";
 152    print $fh "hlagh\n";
 153    close $fh;
 154
 155    silent_exec($^X, "-I$blib_dir", $creator, 'model',
 156       'TestSchemaDSN', 'DBIC::Schema', 'TestSchemaDSN',
 157       'create=static', 'dbi:SQLite:testdb.db'
 158    );
 159
 160    for my $file (result_files()) {
 161       my $code = code_for($file);
 162
 163       like $code, qr/use Moose;\n/,
 164          'use_moose detection not confused by version control files';
 165       like $code, qr/__PACKAGE__->meta->make_immutable;\n/,
 166          'use_moose detection not confused by version control files';
 167    }
 168 }
 169
 170 done_testing;
 171
 172 sub rm_rf {
 173     my $name = $File::Find::name;
 174     if(-d $name) { rmdir $name or warn "Cannot rmdir $name: $!" }
 175     else { unlink $name or die "Cannot unlink $name: $!" }
 176 }
 177
 178 sub cleanup_schema {
 179    return unless -d $schema_dir;
 180    finddepth({ wanted => \&rm_rf, no_chdir => 1 }, $schema_dir);
 181    unlink "${schema_dir}.pm";
 182 }
 183
 184 sub code_for {
 185    my $file = shift;
 186
 187    open my $fh, '<', $file;
 188    my $code = do { local $/; <$fh> };
 189    close $fh;
 190
 191    return $code;
 192 }
 193
 194 sub result_files {
 195    my $result_dir = catfile($schema_dir, 'Result');
 196
 197    my @results;
 198
 199    opendir my $dir, $result_dir
 200       or die "Could not open $result_dir: $!";
 201
 202    while (my $file = readdir $dir) {
 203       next unless $file =~ /\.pm\z/;
 204
 205       push @results, catfile($result_dir, $file);
 206    }
 207
 208    closedir $dir;
 209
 210    return @results;
 211 }
 212
 213 sub silent_exec {
 214    local *NULL;
 215    open NULL, '+<', File::Spec->devnull;
 216
 217    my $pid = open3('<&NULL', '>&NULL', '>&NULL', @_);
 218
 219    waitpid $pid, 0;
 220
 221    return $?;
 222 }
 223
 224 END {
 225     if ($ENV{C_M_DBIC_SCHEMA_TESTAPP}) {
 226         chdir($test_dir);
 227         finddepth({ wanted => \&rm_rf, no_chdir => 1 }, $cat_dir);
 228     }
 229 }
 230
 231 # vim:sts=3 sw=3 et tw=80: