fix new rel tests for older DBIC
[dbsrgits/DBIx-Class-Schema-Loader.git] / t / lib / dbixcsl_common_tests.pm
index c7a78de..059979d 100644 (file)
@@ -30,7 +30,7 @@ sub new {
     # Only MySQL uses this
     $self->{innodb} ||= '';
 
-    # DB2 doesn't support this
+    # DB2 and Firebird don't support 'field type NULL'
     $self->{null} = 'NULL' unless defined $self->{null};
     
     $self->{verbose} = $ENV{TEST_VERBOSE} || 0;
@@ -38,6 +38,12 @@ sub new {
     # Optional extra tables and tests
     $self->{extra} ||= {};
 
+    $self->{date_datatype} ||= 'DATE';
+
+    # Not all DBS do SQL-standard CURRENT_TIMESTAMP
+    $self->{default_function} ||= "CURRENT_TIMESTAMP";
+    $self->{default_function_def} ||= "TIMESTAMP DEFAULT $self->{default_function}";
+
     return bless $self => $class;
 }
 
@@ -53,10 +59,33 @@ sub _monikerize {
     return undef;
 }
 
+sub _custom_column_info {
+    my ( $table_name, $column_name, $column_info ) = @_;
+
+    $table_name = lc ( $table_name );
+    $column_name = lc ( $column_name );
+
+    if ( $table_name eq 'loader_test35' 
+        and $column_name eq 'an_int' 
+    ){
+        return { is_numeric => 1 }
+    }
+    # Set inflate_datetime or  inflate_date to check 
+    #   datetime_timezone and datetime_locale
+    if ( $table_name eq 'loader_test36' ){
+        return { inflate_datetime => 1 } if 
+            ( $column_name eq 'b_char_as_data' );
+        return { inflate_date => 1 } if 
+            ( $column_name eq 'c_char_as_data' );
+    }
+
+    return;
+}
+
 sub run_tests {
     my $self = shift;
 
-    plan tests => 139 + ($self->{extra}->{count} || 0);
+    plan tests => 159 + ($self->{extra}->{count} || 0);
 
     $self->create();
 
@@ -70,7 +99,6 @@ sub run_tests {
     # First, with in-memory classes
     my $schema_class = $self->setup_schema(@connect_info);
     $self->test_schema($schema_class);
-    $self->drop_tables;
 }
 
 # defined in sub create
@@ -88,7 +116,7 @@ sub setup_schema {
 
     my %loader_opts = (
         constraint              =>
-           qr/^(?:\S+\.)?(?:$self->{vendor}_)?loader_test[0-9]+(?!.*_)/i,
+           qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)_)?loader_test[0-9]+(?!.*_)/i,
         relationships           => 1,
         additional_classes      => 'TestAdditional',
         additional_base_classes => 'TestAdditionalBase',
@@ -98,12 +126,19 @@ sub setup_schema {
         inflect_plural          => { loader_test4 => 'loader_test4zes' },
         inflect_singular        => { fkid => 'fkid_singular' },
         moniker_map             => \&_monikerize,
+        custom_column_info      => \&_custom_column_info,
         debug                   => $debug,
+        use_namespaces          => 0,
         dump_directory          => $DUMP_DIR,
+        datetime_timezone       => 'Europe/Berlin',
+        datetime_locale         => 'de_DE',
+        %{ $self->{loader_options} || {} },
     );
 
     $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema};
 
+    my $file_count;
+    my $expected_count = 36;
     {
        my @loader_warnings;
        local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
@@ -117,26 +152,33 @@ sub setup_schema {
 
        ok(!$@, "Loader initialization") or diag $@;
 
-       my $file_count;
        find sub { return if -d; $file_count++ }, $DUMP_DIR;
 
-       my $expected_count = 34;
-
-       $expected_count += @{ $self->{extra}{drop} || [] };
+       $expected_count += grep /CREATE (?:TABLE|VIEW)/i,
+           @{ $self->{extra}{create} || [] };
 
        $expected_count -= grep /CREATE TABLE/, @statements_inline_rels
-           if $self->{no_inline_rels};
+           if $self->{skip_rels} || $self->{no_inline_rels};
 
        $expected_count -= grep /CREATE TABLE/, @statements_implicit_rels
-           if $self->{no_implicit_rels};
+           if $self->{skip_rels} || $self->{no_implicit_rels};
 
-       is $file_count, $expected_count, 'correct number of files generated';
+       $expected_count -= grep /CREATE TABLE/, ($self->{vendor} =~ /sqlite/ ? @statements_advanced_sqlite : @statements_advanced), @statements_reltests
+           if $self->{skip_rels};
 
-       exit if $file_count != $expected_count;
+       is $file_count, $expected_count, 'correct number of files generated';
 
        my $warn_count = 2;
        $warn_count++ if grep /ResultSetManager/, @loader_warnings;
 
+       $warn_count++ for grep /^Bad table or view/, @loader_warnings;
+
+       $warn_count++ for grep /renaming \S+ relation/, @loader_warnings;
+
+       my $vendor = $self->{vendor};
+       $warn_count++ for grep /${vendor}_\S+ has no primary key/,
+           @loader_warnings;
+
         if($self->{skip_rels}) {
             SKIP: {
                 is(scalar(@loader_warnings), $warn_count, "No loader warnings")
@@ -148,11 +190,13 @@ sub setup_schema {
            $warn_count++;
             is(scalar(@loader_warnings), $warn_count, "Expected loader warning")
                 or diag @loader_warnings;
-            is(grep(/loader_test9 has no primary key/, @loader_warnings), 1,
+            is(grep(/loader_test9 has no primary key/i, @loader_warnings), 1,
                  "Missing PK warning");
         }
     }
-    
+
+    exit if $file_count != $expected_count;
+   
     return $schema_class;
 }
 
@@ -161,12 +205,22 @@ sub test_schema {
     my $schema_class = shift;
 
     my $conn = $schema_class->clone;
+
+    ($self->{before_tests_run} || sub {})->($conn);
+
     my $monikers = {};
     my $classes = {};
     foreach my $source_name ($schema_class->sources) {
         my $table_name = $schema_class->source($source_name)->from;
+
+        $table_name = $$table_name if ref $table_name;
+
         $monikers->{$table_name} = $source_name;
         $classes->{$table_name} = $schema_class . q{::} . $source_name;
+
+        # some DBs (Firebird) uppercase everything
+        $monikers->{lc $table_name} = $source_name;
+        $classes->{lc $table_name} = $schema_class . q{::} . $source_name;
     }
 
     my $moniker1 = $monikers->{loader_test1s};
@@ -179,18 +233,23 @@ sub test_schema {
     my $rsobj2   = $conn->resultset($moniker2);
     check_no_duplicate_unique_constraints($class2);
 
-    my $moniker23 = $monikers->{LOADER_TEST23};
-    my $class23   = $classes->{LOADER_TEST23};
+    my $moniker23 = $monikers->{LOADER_TEST23} || $monikers->{loader_test23};
+    my $class23   = $classes->{LOADER_TEST23}  || $classes->{loader_test23};
     my $rsobj23   = $conn->resultset($moniker1);
 
-    my $moniker24 = $monikers->{LoAdEr_test24};
-    my $class24   = $classes->{LoAdEr_test24};
+    my $moniker24 = $monikers->{LoAdEr_test24} || $monikers->{loader_test24};
+    my $class24   = $classes->{LoAdEr_test24}  || $classes->{loader_test24};
     my $rsobj24   = $conn->resultset($moniker2);
 
+    my $moniker35 = $monikers->{loader_test35};
+    my $class35   = $classes->{loader_test35};
+    my $rsobj35   = $conn->resultset($moniker35);
+
     isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
     isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
     isa_ok( $rsobj23, "DBIx::Class::ResultSet" );
     isa_ok( $rsobj24, "DBIx::Class::ResultSet" );
+    isa_ok( $rsobj35, "DBIx::Class::ResultSet" );
 
     my @columns_lt2 = $class2->columns;
     is_deeply( \@columns_lt2, [ qw/id dat dat2/ ], "Column Ordering" );
@@ -273,7 +332,7 @@ sub test_schema {
         is( $rsobj1->loader_test1_rsmeth, 'all is still well', 'Result set method' );
     }
     
-    ok( $class1->column_info('id')->{is_auto_increment}, 'is_auto_incrment detection' );
+    ok( $class1->column_info('id')->{is_auto_increment}, 'is_auto_increment detection' );
 
     my $obj    = $rsobj1->find(1);
     is( $obj->id,  1, "Find got the right row" );
@@ -294,8 +353,31 @@ sub test_schema {
     my ($obj2) = $rsobj2->search({ dat => 'bbb' })->first;
     is( $obj2->id, 2 );
 
+    is(
+        $class35->column_info('a_varchar')->{default_value}, 'foo',
+        'constant character default',
+    );
+
+    is(
+        $class35->column_info('an_int')->{default_value}, 42,
+        'constant integer default',
+    );
+
+    is(
+        $class35->column_info('a_double')->{default_value}, 10.555,
+        'constant numeric default',
+    );
+
+    my $function_default = $class35->column_info('a_function')->{default_value};
+
+    isa_ok( $function_default, 'SCALAR', 'default_value for function default' );
+    is_deeply(
+        $function_default, \$self->{default_function},
+        'default_value for function default is correct'
+    );
+
     SKIP: {
-        skip $self->{skip_rels}, 96 if $self->{skip_rels};
+        skip $self->{skip_rels}, 101 if $self->{skip_rels};
 
         my $moniker3 = $monikers->{loader_test3};
         my $class3   = $classes->{loader_test3};
@@ -389,6 +471,10 @@ sub test_schema {
         my $class34   = $classes->{loader_test34};
         my $rsobj34   = $conn->resultset($moniker34);
 
+        my $moniker36 = $monikers->{loader_test36};
+        my $class36   = $classes->{loader_test36};
+        my $rsobj36   = $conn->resultset($moniker36);
+        
         isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
         isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
         isa_ok( $rsobj5, "DBIx::Class::ResultSet" );
@@ -412,6 +498,7 @@ sub test_schema {
         isa_ok( $rsobj32, "DBIx::Class::ResultSet" );
         isa_ok( $rsobj33, "DBIx::Class::ResultSet" );
         isa_ok( $rsobj34, "DBIx::Class::ResultSet" );
+        isa_ok( $rsobj36, "DBIx::Class::ResultSet" );
 
         # basic rel test
         my $obj4 = $rsobj4->find(123);
@@ -423,6 +510,13 @@ sub test_schema {
         my $rs_rel4 = $obj3->search_related('loader_test4zes');
         isa_ok( $rs_rel4->first, $class4);
 
+        # check rel naming with prepositions
+        ok ($rsobj4->result_source->has_relationship('loader_test5s_to'),
+            "rel with preposition 'to' pluralized correctly");
+
+        ok ($rsobj4->result_source->has_relationship('loader_test5s_from'),
+            "rel with preposition 'from' pluralized correctly");
+
         # find on multi-col pk
         my $obj5 = 
            eval { $rsobj5->find({id1 => 1, iD2 => 1}) } ||
@@ -516,40 +610,33 @@ sub test_schema {
         is($obj27->loader_test29, undef, "Undef for missing one-to-one row");
 
         # test outer join for nullable referring columns:
-        SKIP: {
-          skip "unreliable column info from db driver",11 unless 
-            ($class32->column_info('rel2')->{is_nullable});
-
-          ok($class32->column_info('rel1')->{is_foreign_key}, 'Foreign key detected');
-          ok($class32->column_info('rel2')->{is_foreign_key}, 'Foreign key detected');
-          
-          my $obj32 = $rsobj32->find(1,{prefetch=>[qw/rel1 rel2/]});
-          my $obj34 = $rsobj34->find(
-            1,{prefetch=>[qw/loader_test33_id_rel1 loader_test33_id_rel2/]}
-          );
-          my $skip_outerjoin;
-          isa_ok($obj32,$class32) or $skip_outerjoin = 1;
-          isa_ok($obj34,$class34) or $skip_outerjoin = 1;
-
-          ok($class34->column_info('id')->{is_foreign_key}, 'Foreign key detected');
-          ok($class34->column_info('rel1')->{is_foreign_key}, 'Foreign key detected');
-          ok($class34->column_info('rel2')->{is_foreign_key}, 'Foreign key detected');
-
-          SKIP: {
-            skip "Pre-requisite test failed", 4 if $skip_outerjoin;
-            my $rs_rel31_one = $obj32->rel1;
-            my $rs_rel31_two = $obj32->rel2;
-            isa_ok($rs_rel31_one, $class31);
-            is($rs_rel31_two, undef);
-
-            my $rs_rel33_one = $obj34->loader_test33_id_rel1;
-            my $rs_rel33_two = $obj34->loader_test33_id_rel2;
-
-            isa_ok($rs_rel33_one,$class33);
-            is($rs_rel33_two, undef);
-
-          }
-        }
+        is $class32->column_info('rel2')->{is_nullable}, 1,
+          'is_nullable detection';
+
+        ok($class32->column_info('rel1')->{is_foreign_key}, 'Foreign key detected');
+        ok($class32->column_info('rel2')->{is_foreign_key}, 'Foreign key detected');
+        
+        my $obj32 = $rsobj32->find(1,{prefetch=>[qw/rel1 rel2/]});
+        my $obj34 = $rsobj34->find(
+          1,{prefetch=>[qw/loader_test33_id_rel1 loader_test33_id_rel2/]}
+        );
+        isa_ok($obj32,$class32);
+        isa_ok($obj34,$class34);
+
+        ok($class34->column_info('id')->{is_foreign_key}, 'Foreign key detected');
+        ok($class34->column_info('rel1')->{is_foreign_key}, 'Foreign key detected');
+        ok($class34->column_info('rel2')->{is_foreign_key}, 'Foreign key detected');
+
+        my $rs_rel31_one = $obj32->rel1;
+        my $rs_rel31_two = $obj32->rel2;
+        isa_ok($rs_rel31_one, $class31);
+        is($rs_rel31_two, undef);
+
+        my $rs_rel33_one = $obj34->loader_test33_id_rel1;
+        my $rs_rel33_two = $obj34->loader_test33_id_rel2;
+
+        isa_ok($rs_rel33_one,$class33);
+        is($rs_rel33_two, undef);
 
         # from Chisel's tests...
         my $moniker10 = $monikers->{loader_test10};
@@ -560,7 +647,7 @@ sub test_schema {
         my $class11   = $classes->{loader_test11};
         my $rsobj11   = $conn->resultset($moniker11);
 
-        isa_ok( $rsobj10, "DBIx::Class::ResultSet" ); 
+        isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
         isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
 
         ok($class10->column_info('loader_test11')->{is_foreign_key}, 'Foreign key detected');
@@ -577,9 +664,9 @@ sub test_schema {
 
         eval {
             my $obj10_2 = $obj11->loader_test10;
-            $obj10_2->loader_test11( $obj11->id11() );
-            $obj10_2->update();
+            $obj10_2->update({ loader_test11 => $obj11->id11 });
         };
+        diag $@ if $@;
         ok(!$@, "Setting up circular relationship");
 
         SKIP: {
@@ -595,7 +682,7 @@ sub test_schema {
         }
 
         SKIP: {
-            skip 'This vendor cannot do inline relationship definitions', 8
+            skip 'This vendor cannot do inline relationship definitions', 9
                 if $self->{no_inline_rels};
 
             my $moniker12 = $monikers->{loader_test12};
@@ -617,6 +704,9 @@ sub test_schema {
             isa_ok( $obj13->id, $class12 );
             isa_ok( $obj13->loader_test12, $class12);
             isa_ok( $obj13->dat, $class12);
+
+            my $obj12 = $rsobj12->find(1);
+            isa_ok( $obj12->loader_test13, $class13 );
         }
 
         SKIP: {
@@ -640,6 +730,25 @@ sub test_schema {
         }
     }
 
+    # test custom_column_info and datetime_timezone/datetime_locale
+    {
+        my $class35 = $classes->{loader_test35};
+        my $class36 = $classes->{loader_test36};
+
+        ok($class35->column_info('an_int')->{is_numeric}, 'custom_column_info');
+
+        is($class36->column_info('a_date')->{locale},'de_DE','datetime_locale');
+        is($class36->column_info('a_date')->{timezone},'Europe/Berlin','datetime_timezone');
+
+        ok($class36->column_info('b_char_as_data')->{inflate_datetime},'custom_column_info');
+        is($class36->column_info('b_char_as_data')->{locale},'de_DE','datetime_locale');
+        is($class36->column_info('b_char_as_data')->{timezone},'Europe/Berlin','datetime_timezone');
+
+        ok($class36->column_info('c_char_as_data')->{inflate_date},'custom_column_info');
+        is($class36->column_info('c_char_as_data')->{locale},'de_DE','datetime_locale');
+        is($class36->column_info('c_char_as_data')->{timezone},'Europe/Berlin','datetime_timezone');
+    }
+
     # rescan and norewrite test
     SKIP: {
         my @statements_rescan = (
@@ -683,6 +792,7 @@ sub test_schema {
         }
 
         $dbh->disconnect;
+        $conn->storage->disconnect; # needed for Firebird
 
         sleep 1;
 
@@ -713,6 +823,8 @@ sub test_schema {
     }
 
     $self->{extra}->{run}->($conn, $monikers, $classes) if $self->{extra}->{run};
+
+    $conn->storage->disconnect;
 }
 
 sub check_no_duplicate_unique_constraints {
@@ -731,17 +843,25 @@ sub check_no_duplicate_unique_constraints {
 sub dbconnect {
     my ($self, $complain) = @_;
 
-    my $dbh = DBI->connect(
-         $self->{dsn}, $self->{user},
-         $self->{password},
-         {
-             RaiseError => $complain,
-             PrintError => $complain,
-             AutoCommit => 1,
-         }
-    );
+    require DBIx::Class::Storage::DBI;
+    my $storage = DBIx::Class::Storage::DBI->new;
 
-    die "Failed to connect to database: $DBI::errstr" if !$dbh;
+    $complain = defined $complain ? $complain : 1;
+
+    $storage->connect_info([
+        @{ $self }{qw/dsn user password/},
+        {
+            unsafe => 1,
+            RaiseError => $complain,
+            ShowErrorStatement => $complain,
+            PrintError => 0,
+        },
+    ]);
+
+    my $dbh = eval { $storage->dbh };
+    die "Failed to connect to database: $@" if !$dbh;
+
+    $self->{storage} = $storage; # storage DESTROY disconnects
 
     return $dbh;
 }
@@ -793,6 +913,25 @@ sub create {
                 DaT VARCHAR(32) NOT NULL UNIQUE
             ) $self->{innodb}
         },
+
+        qq{
+            CREATE TABLE loader_test35 (
+                id INTEGER NOT NULL PRIMARY KEY,
+                a_varchar VARCHAR(100) DEFAULT 'foo',
+                an_int INTEGER DEFAULT 42,
+                a_double DOUBLE PRECISION DEFAULT 10.555,
+                a_function $self->{default_function_def}
+            ) $self->{innodb}
+        },
+
+        qq{
+            CREATE TABLE loader_test36 (
+                id INTEGER NOT NULL PRIMARY KEY,
+                a_date $self->{date_datatype},
+                b_char_as_data VARCHAR(100),
+                c_char_as_data VARCHAR(100)
+            ) $self->{innodb}
+        },
     );
 
     @statements_reltests = (
@@ -827,7 +966,11 @@ sub create {
                 id1 INTEGER NOT NULL,
                 iD2 INTEGER NOT NULL,
                 dat VARCHAR(8),
-                PRIMARY KEY (id1,iD2)
+                from_id INTEGER,
+                to_id INTEGER,
+                PRIMARY KEY (id1,iD2),
+                FOREIGN KEY (from_id) REFERENCES loader_test4 (id),
+                FOREIGN KEY (to_id) REFERENCES loader_test4 (id)
             ) $self->{innodb}
         },
 
@@ -1067,7 +1210,7 @@ sub create {
         qq{
             CREATE TABLE loader_test11 (
                 id11 $self->{auto_inc_pk},
-                message VARCHAR(8) DEFAULT 'foo',
+                a_message VARCHAR(8) DEFAULT 'foo',
                 loader_test10 INTEGER $self->{null},
                 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
             ) $self->{innodb}
@@ -1091,7 +1234,7 @@ sub create {
         qq{
             CREATE TABLE loader_test11 (
                 id11 $self->{auto_inc_pk},
-                message VARCHAR(8) DEFAULT 'foo',
+                a_message VARCHAR(8) DEFAULT 'foo',
                 loader_test10 INTEGER $self->{null},
                 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
             ) $self->{innodb}
@@ -1189,6 +1332,8 @@ sub drop_tables {
         loader_test2
         LOADER_TEST23
         LoAdEr_test24
+        loader_test35
+        loader_test36
     /;
     
     my @tables_auto_inc = (
@@ -1252,7 +1397,8 @@ sub drop_tables {
 
     my $dbh = $self->dbconnect(0);
 
-    $dbh->do("DROP TABLE $_") for @{ $self->{extra}->{drop} || [] };
+    $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] };
+    $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] };
 
     my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {};
 
@@ -1264,8 +1410,8 @@ sub drop_tables {
         else {
             $dbh->do($drop_fk);
         }
-        $dbh->do("DROP TABLE $_") for (@tables_advanced);
         $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc;
+        $dbh->do("DROP TABLE $_") for (@tables_advanced);
 
         unless($self->{no_inline_rels}) {
             $dbh->do("DROP TABLE $_") for (@tables_inline_rels);
@@ -1273,10 +1419,14 @@ sub drop_tables {
         unless($self->{no_implicit_rels}) {
             $dbh->do("DROP TABLE $_") for (@tables_implicit_rels);
         }
-        $dbh->do("DROP TABLE $_") for (@tables_rescan);
     }
-    $dbh->do("DROP TABLE $_") for (@tables);
     $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc;
+    $dbh->do("DROP TABLE $_") for (@tables, @tables_rescan);
+    $dbh->disconnect;
+
+# fixup for Firebird
+    $dbh = $self->dbconnect(0);
+    $dbh->do('DROP TABLE loader_test2');
     $dbh->disconnect;
 }