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