From: Rafael Kitover <rkitover@cpan.org>
Date: Mon, 17 Jan 2011 15:42:14 +0000 (-0500)
Subject: better _tables_list for Sybase ASE
X-Git-Tag: 0.07003~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8f65b7e515f165d4262550f025031e726f14844c;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

better _tables_list for Sybase ASE
---

diff --git a/Changes b/Changes
index 23585d9..d043869 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - better _tables_list for Sybase ASE
         - add datetime_undef_if_invalid => 1 for MySQL datetime data types
           (RT#64820) This behavior can be turned off by passing
           datetime_undef_if_invalid=0 as a loader option
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
index 6fb0521..6d163ec 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
@@ -27,6 +27,9 @@ sub _setup {
     if (not defined $self->preserve_case) {
         $self->preserve_case(1);
     }
+
+    $self->{db_schema} ||=
+        ($self->schema->storage->dbh->selectrow_array('select user_name()'))[0];
 }
 
 sub _rebless {
@@ -44,6 +47,19 @@ sub _rebless {
     }
 }
 
+sub _tables_list {
+    my ($self, $opts) = @_;
+
+    my $dbh = $self->schema->storage->dbh;
+
+    my $sth = $dbh->table_info(undef, $self->db_schema, undef, "'TABLE','VIEW'");
+
+    my @tables = grep $_ ne 'sysquerymetrics',
+              map $_->{table_name}, @{ $sth->fetchall_arrayref({ table_name => 1 }) };
+
+    return $self->_filter_tables(\@tables, $opts);
+}
+
 sub _table_columns {
     my ($self, $table) = @_;
 
diff --git a/t/15sybase_common.t b/t/15sybase_common.t
index 91f3953..1d943a5 100644
--- a/t/15sybase_common.t
+++ b/t/15sybase_common.t
@@ -76,7 +76,8 @@ my $tester = dbixcsl_common_tests->new(
         'binary(2)'    => { data_type => 'binary', size => 2 },
         'varbinary(2)' => { data_type => 'varbinary', size => 2 },
     },
-    # test that named constraints aren't picked up as tables
+    # test that named constraints aren't picked up as tables (I can't reproduce this on my machine)
+    failtrigger_warnings => [ qr/^Bad table or view 'sybase_loader_test2_ref_slt1'/ ],
     extra => {
         create => [
             q{
diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index ac62a55..2813f62 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -279,6 +279,8 @@ sub setup_schema {
 
         $warn_count++ for grep { my $w = $_; grep $w =~ $_, @{ $self->{warnings} || [] } } @loader_warnings;
 
+        $warn_count-- for grep { my $w = $_; grep $w =~ $_, @{ $self->{failtrigger_warnings} || [] } } @loader_warnings;
+
         if ($standard_sources) {
             if($self->{skip_rels}) {
                 SKIP: {