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