code/pod cleanup
[dbsrgits/DBIx-Class-Schema-Loader.git] / t / lib / dbixcsl_common_tests.pm
index 6000c54..b134845 100644 (file)
@@ -8,6 +8,8 @@ use DBIx::Class::Schema::Loader;
 use Class::Unload;
 use File::Path;
 use DBI;
+use Digest::MD5;
+use File::Find 'find';
 
 my $DUMP_DIR = './t/_common_dump';
 rmtree $DUMP_DIR;
@@ -27,12 +29,19 @@ sub new {
 
     # Only MySQL uses this
     $self->{innodb} ||= '';
+
+    # DB2 doesn't support this
+    $self->{null} = 'NULL' unless defined $self->{null};
     
     $self->{verbose} = $ENV{TEST_VERBOSE} || 0;
 
     # Optional extra tables and tests
     $self->{extra} ||= {};
 
+    # 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;
 }
 
@@ -48,14 +57,42 @@ 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_test11' 
+        and $column_name eq 'loader_test10' 
+    ){
+        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 => 3 + 134 + ($self->{extra}->{count} || 0);
+    plan tests => 155 + ($self->{extra}->{count} || 0);
 
     $self->create();
 
-    my @connect_info = ( $self->{dsn}, $self->{user}, $self->{password} );
+    my @connect_info = (
+       $self->{dsn},
+       $self->{user},
+       $self->{password},
+       $self->{connect_info_opts},
+    );
 
     # First, with in-memory classes
     my $schema_class = $self->setup_schema(@connect_info);
@@ -63,6 +100,11 @@ sub run_tests {
     $self->drop_tables;
 }
 
+# defined in sub create
+my (@statements, @statements_reltests, @statements_advanced,
+    @statements_advanced_sqlite, @statements_inline_rels,
+    @statements_implicit_rels);
+
 sub setup_schema {
     my $self = shift;
     my @connect_info = @_;
@@ -72,7 +114,8 @@ sub setup_schema {
     my $debug = ($self->{verbose} > 1) ? 1 : 0;
 
     my %loader_opts = (
-        constraint              => qr/^(?:\S+\.)?(?:$self->{vendor}_)?loader_test[0-9]+s?$/i,
+        constraint              =>
+           qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)_)?loader_test[0-9]+(?!.*_)/i,
         relationships           => 1,
         additional_classes      => 'TestAdditional',
         additional_base_classes => 'TestAdditionalBase',
@@ -82,8 +125,12 @@ 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'
     );
 
     $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema};
@@ -99,11 +146,40 @@ sub setup_schema {
             __PACKAGE__->connection(\@connect_info);
         };
 
-        ok(!$@, "Loader initialization") or diag $@;
+       ok(!$@, "Loader initialization") or diag $@;
+
+       my $file_count;
+       find sub { return if -d; $file_count++ }, $DUMP_DIR;
+
+       my $expected_count = 36;
+
+       $expected_count += grep /CREATE (?:TABLE|VIEW)/i,
+           @{ $self->{extra}{create} || [] };
+
+       $expected_count -= grep /CREATE TABLE/, @statements_inline_rels
+           if $self->{skip_rels} || $self->{no_inline_rels};
+
+       $expected_count -= grep /CREATE TABLE/, @statements_implicit_rels
+           if $self->{skip_rels} || $self->{no_implicit_rels};
+
+       $expected_count -= grep /CREATE TABLE/, ($self->{vendor} =~ /sqlite/ ? @statements_advanced_sqlite : @statements_advanced), @statements_reltests
+           if $self->{skip_rels};
+
+       is $file_count, $expected_count, 'correct number of files generated';
+
+       exit if $file_count != $expected_count;
 
        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 /stripping trailing _id/, @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")
@@ -154,10 +230,15 @@ sub test_schema {
     my $class24   = $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" );
@@ -261,6 +342,29 @@ 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};
 
@@ -356,6 +460,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" );
@@ -379,6 +487,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);
@@ -391,7 +500,11 @@ sub test_schema {
         isa_ok( $rs_rel4->first, $class4);
 
         # find on multi-col pk
-        my $obj5 = $rsobj5->find({id1 => 1, id2 => 1});
+        my $obj5 = 
+           eval { $rsobj5->find({id1 => 1, iD2 => 1}) } ||
+           eval { $rsobj5->find({id1 => 1, id2 => 1}) };
+       die $@ if $@;
+
         is( $obj5->id2, 1, "Find on multi-col PK" );
 
         # mulit-col fk def
@@ -401,7 +514,10 @@ sub test_schema {
 
         ok($class6->column_info('loader_test2_id')->{is_foreign_key}, 'Foreign key detected');
         ok($class6->column_info('id')->{is_foreign_key}, 'Foreign key detected');
-        ok($class6->column_info('id2')->{is_foreign_key}, 'Foreign key detected');
+
+       my $id2_info = eval { $class6->column_info('id2') } ||
+                       $class6->column_info('Id2');
+        ok($id2_info->{is_foreign_key}, 'Foreign key detected');
 
         # fk that references a non-pk key (UNIQUE)
         my $obj8 = $rsobj8->find(1);
@@ -512,52 +628,60 @@ sub test_schema {
         }
 
         # from Chisel's tests...
-        SKIP: {
-            if($self->{vendor} =~ /sqlite/i) {
-                skip 'SQLite cannot do the advanced tests', 10;
-            }
+        my $moniker10 = $monikers->{loader_test10};
+        my $class10   = $classes->{loader_test10};
+        my $rsobj10   = $conn->resultset($moniker10);
 
-            my $moniker10 = $monikers->{loader_test10};
-            my $class10   = $classes->{loader_test10};
-            my $rsobj10   = $conn->resultset($moniker10);
+        my $moniker11 = $monikers->{loader_test11};
+        my $class11   = $classes->{loader_test11};
+        my $rsobj11   = $conn->resultset($moniker11);
 
-            my $moniker11 = $monikers->{loader_test11};
-            my $class11   = $classes->{loader_test11};
-            my $rsobj11   = $conn->resultset($moniker11);
+        isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
+        isa_ok( $rsobj11, "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');
+        ok($class11->column_info('loader_test10')->{is_foreign_key}, 'Foreign key detected');
 
-            ok($class10->column_info('loader_test11')->{is_foreign_key}, 'Foreign key detected');
-            ok($class11->column_info('loader_test10')->{is_foreign_key}, 'Foreign key detected');
+        # Added by custom_column_info
+        ok($class11->column_info('loader_test10')->{is_numeric}, 'custom_column_info');
 
-            my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
+        is($class36->column_info('a_date')->{locale},'de_DE','datetime_locale');
+        is($class36->column_info('a_date')->{timezone},'Europe/Berlin','datetime_timezone');
 
-            $obj10->update();
-            ok( defined $obj10, 'Create row' );
+        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');
 
-            my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() });
-            $obj11->update();
-            ok( defined $obj11, 'Create related row' );
+        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');
 
-            eval {
-                my $obj10_2 = $obj11->loader_test10;
-                $obj10_2->loader_test11( $obj11->id11() );
-                $obj10_2->update();
-            };
-            ok(!$@, "Setting up circular relationship");
+        my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
 
-            SKIP: {
-                skip 'Previous eval block failed', 3 if $@;
-        
-                my $results = $rsobj10->search({ subject => 'xyzzy' });
-                is( $results->count(), 1, 'No duplicate row created' );
+        $obj10->update();
+        ok( defined $obj10, 'Create row' );
 
-                my $obj10_3 = $results->first();
-                isa_ok( $obj10_3, $class10 );
-                is( $obj10_3->loader_test11()->id(), $obj11->id(),
-                    'Circular rel leads back to same row' );
-            }
+        my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() });
+        $obj11->update();
+        ok( defined $obj11, 'Create related row' );
+
+        eval {
+            my $obj10_2 = $obj11->loader_test10;
+            $obj10_2->loader_test11( $obj11->id11() );
+            $obj10_2->update();
+        };
+        ok(!$@, "Setting up circular relationship");
+
+        SKIP: {
+            skip 'Previous eval block failed', 3 if $@;
+    
+            my $results = $rsobj10->search({ subject => 'xyzzy' });
+            is( $results->count(), 1, 'No duplicate row created' );
+
+            my $obj10_3 = $results->first();
+            isa_ok( $obj10_3, $class10 );
+            is( $obj10_3->loader_test11()->id(), $obj11->id(),
+                'Circular rel leads back to same row' );
         }
 
         SKIP: {
@@ -606,11 +730,8 @@ sub test_schema {
         }
     }
 
-    # rescan test
+    # rescan and norewrite test
     SKIP: {
-        skip $self->{skip_rels}, 4 if $self->{skip_rels};
-        skip "Can't rescan dumped schema", 4 if $self->{dump};
-
         my @statements_rescan = (
             qq{
                 CREATE TABLE loader_test30 (
@@ -623,15 +744,57 @@ sub test_schema {
             q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(321, 2) },
         );
 
+        # get md5
+        my $digest  = Digest::MD5->new;
+
+        my $find_cb = sub {
+            return if -d;
+            return if $_ eq 'LoaderTest30.pm';
+
+            open my $fh, '<', $_ or die "Could not open $_ for reading: $!";
+            binmode $fh;
+            $digest->addfile($fh);
+        };
+
+        find $find_cb, $DUMP_DIR;
+
+        my $before_digest = $digest->digest;
+
         my $dbh = $self->dbconnect(1);
-        $dbh->do($_) for @statements_rescan;
+
+        {
+            # Silence annoying but harmless postgres "NOTICE:  CREATE TABLE..."
+            local $SIG{__WARN__} = sub {
+                my $msg = shift;
+                print STDERR $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
+            };
+
+            $dbh->do($_) for @statements_rescan;
+        }
+
         $dbh->disconnect;
 
-        my @new = $conn->rescan;
+        sleep 1;
+
+        my @new = do {
+            # kill the 'Dumping manual schema' warnings
+            local $SIG{__WARN__} = sub {};
+            $conn->rescan;
+        };
         is_deeply(\@new, [ qw/LoaderTest30/ ], "Rescan");
 
+        $digest = Digest::MD5->new;
+        find $find_cb, $DUMP_DIR;
+        my $after_digest = $digest->digest;
+
+        is $before_digest, $after_digest,
+            'dumped files are not rewritten when there is no modification';
+
         my $rsobj30   = $conn->resultset('LoaderTest30');
         isa_ok($rsobj30, 'DBIx::Class::ResultSet');
+
+        skip 'no rels', 2 if $self->{skip_rels};
+
         my $obj30 = $rsobj30->find(123);
         isa_ok( $obj30->loader_test2, $class2);
 
@@ -679,7 +842,7 @@ sub create {
     $self->{_created} = 1;
 
     my $make_auto_inc = $self->{auto_inc_cb} || sub {};
-    my @statements = (
+    @statements = (
         qq{
             CREATE TABLE loader_test1s (
                 id $self->{auto_inc_pk},
@@ -720,9 +883,28 @@ 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 DATE,
+                b_char_as_data VARCHAR(100),
+                c_char_as_data VARCHAR(100)
+            ) $self->{innodb}
+        },
     );
 
-    my @statements_reltests = (
+    @statements_reltests = (
         qq{
             CREATE TABLE loader_test3 (
                 id INTEGER NOT NULL PRIMARY KEY,
@@ -754,11 +936,11 @@ sub create {
                 id1 INTEGER NOT NULL,
                 iD2 INTEGER NOT NULL,
                 dat VARCHAR(8),
-                PRIMARY KEY (id1,id2)
+                PRIMARY KEY (id1,iD2)
             ) $self->{innodb}
         },
 
-        q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa') },
+        q{ INSERT INTO loader_test5 (id1,iD2,dat) VALUES (1,1,'aaa') },
 
         qq{
             CREATE TABLE loader_test6 (
@@ -771,7 +953,7 @@ sub create {
             ) $self->{innodb}
         },
 
-        (q{ INSERT INTO loader_test6 (id, id2,loader_test2_id,dat) } .
+        (q{ INSERT INTO loader_test6 (id, Id2,loader_test2_id,dat) } .
          q{ VALUES (1, 1,1,'aaa') }),
 
         qq{
@@ -953,7 +1135,7 @@ sub create {
           CREATE TABLE loader_test32 (
             id INTEGER NOT NULL PRIMARY KEY,
             rel1 INTEGER NOT NULL,
-            rel2 INTEGER NULL,
+            rel2 INTEGER $self->{null},
             FOREIGN KEY (rel1) REFERENCES loader_test31(id),
             FOREIGN KEY (rel2) REFERENCES loader_test31(id)
           ) $self->{innodb}
@@ -973,7 +1155,7 @@ sub create {
           CREATE TABLE loader_test34 (
             id INTEGER NOT NULL PRIMARY KEY,
             rel1 INTEGER NOT NULL,
-            rel2 INTEGER NULL,
+            rel2 INTEGER $self->{null},
             FOREIGN KEY (id,rel1) REFERENCES loader_test33(id1,id2),
             FOREIGN KEY (id,rel2) REFERENCES loader_test33(id1,id2)
           ) $self->{innodb}
@@ -981,12 +1163,12 @@ sub create {
         q{ INSERT INTO loader_test34 (id,rel1) VALUES (1,2) },
     );
 
-    my @statements_advanced = (
+    @statements_advanced = (
         qq{
             CREATE TABLE loader_test10 (
                 id10 $self->{auto_inc_pk},
                 subject VARCHAR(8),
-                loader_test11 INTEGER NULL
+                loader_test11 INTEGER $self->{null}
             ) $self->{innodb}
         },
         $make_auto_inc->(qw/loader_test10 id10/),
@@ -994,8 +1176,8 @@ sub create {
         qq{
             CREATE TABLE loader_test11 (
                 id11 $self->{auto_inc_pk},
-                message VARCHAR(8) DEFAULT 'foo',
-                loader_test10 INTEGER NULL,
+                a_message VARCHAR(8) DEFAULT 'foo',
+                loader_test10 INTEGER $self->{null},
                 FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
             ) $self->{innodb}
         },
@@ -1006,7 +1188,30 @@ sub create {
          q{ REFERENCES loader_test11 (id11) }),
     );
 
-    my @statements_inline_rels = (
+    @statements_advanced_sqlite = (
+        qq{
+            CREATE TABLE loader_test10 (
+                id10 $self->{auto_inc_pk},
+                subject VARCHAR(8)
+            ) $self->{innodb}
+        },
+        $make_auto_inc->(qw/loader_test10 id10/),
+
+        qq{
+            CREATE TABLE loader_test11 (
+                id11 $self->{auto_inc_pk},
+                a_message VARCHAR(8) DEFAULT 'foo',
+                loader_test10 INTEGER $self->{null},
+                FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
+            ) $self->{innodb}
+        },
+        $make_auto_inc->(qw/loader_test11 id11/),
+
+        (q{ ALTER TABLE loader_test10 ADD COLUMN } .
+         q{ loader_test11 INTEGER REFERENCES loader_test11 (id11) }),
+    );
+
+    @statements_inline_rels = (
         qq{
             CREATE TABLE loader_test12 (
                 id INTEGER NOT NULL PRIMARY KEY,
@@ -1030,7 +1235,7 @@ sub create {
     );
 
 
-    my @statements_implicit_rels = (
+    @statements_implicit_rels = (
         qq{
             CREATE TABLE loader_test14 (
                 id INTEGER NOT NULL PRIMARY KEY,
@@ -1067,7 +1272,10 @@ sub create {
         # to test one for mysql, which works on everyone else...
         # this all needs to be refactored anyways.
         $dbh->do($_) for (@statements_reltests);
-        unless($self->{vendor} =~ /sqlite/i) {
+        if($self->{vendor} =~ /sqlite/i) {
+            $dbh->do($_) for (@statements_advanced_sqlite);
+        }
+        else {
             $dbh->do($_) for (@statements_advanced);
         }
         unless($self->{no_inline_rels}) {
@@ -1090,6 +1298,8 @@ sub drop_tables {
         loader_test2
         LOADER_TEST23
         LoAdEr_test24
+        loader_test35
+        loader_test36
     /;
     
     my @tables_auto_inc = (
@@ -1159,34 +1369,33 @@ sub drop_tables {
 
     unless($self->{skip_rels}) {
         $dbh->do("DROP TABLE $_") for (@tables_reltests);
-        unless($self->{vendor} =~ /sqlite/i) {
-            if($self->{vendor} =~ /mysql/i) {
-                $dbh->do($drop_fk_mysql);
-            }
-            else {
-                $dbh->do($drop_fk);
-            }
-            $dbh->do("DROP TABLE $_") for (@tables_advanced);
-            $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc;
+        if($self->{vendor} =~ /mysql/i) {
+            $dbh->do($drop_fk_mysql);
+        }
+        else {
+            $dbh->do($drop_fk);
         }
+        $dbh->do("DROP TABLE $_") for (@tables_advanced);
+        $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc;
+
         unless($self->{no_inline_rels}) {
             $dbh->do("DROP TABLE $_") for (@tables_inline_rels);
         }
         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("DROP TABLE $_") for (@tables, @tables_rescan);
     $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc;
     $dbh->disconnect;
 }
 
 sub DESTROY {
     my $self = shift;
-    $self->drop_tables if $self->{_created};
-    rmtree $DUMP_DIR
-       unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
+    unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
+       $self->drop_tables if $self->{_created};
+       rmtree $DUMP_DIR
+    }
 }
 
 1;