[Bast-commits] r6813 - in branches/DBIx-Class-Schema-Loader/mssql_tweaks: lib/DBIx/Class/Schema/Loader t

[caelum at dev.catalyst.perl.org]

Author: caelum
Date: 2009-06-28 06:52:09 +0000 (Sun, 28 Jun 2009)
New Revision: 6813

Added:
   branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/17mssql_odbc_dot_in_table_name.t
Modified:
   branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI.pm
Log:
result class is generated for table with dot in name, but doesn't work yet

Modified: branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI.pm	2009-06-28 04:11:08 UTC (rev 6812)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI.pm	2009-06-28 06:52:09 UTC (rev 6813)
@@ -90,9 +90,15 @@
     my $dbh = $self->schema->storage->dbh;
     my @tables = $dbh->tables(undef, $self->db_schema, $table, $type);
 
-    s/\Q$self->{_quoter}\E//g    for @tables;
-    s/^.*\Q$self->{_namesep}\E// for @tables;
+    my $qt = qr/\Q$self->{_quoter}\E/;
 
+    if ($self->{_quoter} && $tables[0] =~ /$qt/) {
+        s/.* $qt (?= .* $qt)//xg for @tables;
+    } else {
+        s/^.*\Q$self->{_namesep}\E// for @tables;
+    }
+    s/$qt//g for @tables;
+
     return @tables;
 }
 
@@ -110,6 +116,18 @@
     $self->next::method(@_);
 }
 
+sub _quote_table_name {
+    my ($self, $table) = @_;
+
+    my $qt = $self->schema->storage->sql_maker->quote_char;
+
+    if (ref $qt) {
+        return $qt->[0] . $table . $qt->[1];
+    }
+
+    return $qt . $table . $qt;
+}
+
 # Returns an arrayref of column names
 sub _table_columns {
     my ($self, $table) = @_;
@@ -117,10 +135,13 @@
     my $dbh = $self->schema->storage->dbh;
 
     if($self->{db_schema}) {
-        $table = $self->{db_schema} . $self->{_namesep} . $table;
+        $table = $self->{db_schema} . $self->{_namesep} .
+            $self->_quote_table_name($table);
+    } else {
+        $table = $self->_quote_table_name($table);
     }
 
-    my $sth = $dbh->prepare($self->schema->storage->sql_maker->select($table, undef, \'1 = 0'));
+    my $sth = $dbh->prepare($self->schema->storage->sql_maker->select(\$table, undef, \'1 = 0'));
     $sth->execute;
     my $retval = \@{$sth->{NAME_lc}};
     $sth->finish;

Added: branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/17mssql_odbc_dot_in_table_name.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/17mssql_odbc_dot_in_table_name.t	                        (rev 0)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/17mssql_odbc_dot_in_table_name.t	2009-06-28 06:52:09 UTC (rev 6813)
@@ -0,0 +1,68 @@
+use strict;
+use lib qw(t/lib);
+use Test::More;
+use DBI;
+
+my $DUMP_DIR;
+BEGIN { 
+    $DUMP_DIR = './t/_common_dump';
+}
+
+use lib $DUMP_DIR;
+use DBIx::Class::Schema::Loader 'make_schema_at', "dump_to_dir:$DUMP_DIR";
+use File::Path;
+
+my $dsn      = $ENV{DBICTEST_MSSQL_ODBC_DSN} || '';
+my $user     = $ENV{DBICTEST_MSSQL_ODBC_USER} || '';
+my $password = $ENV{DBICTEST_MSSQL_ODBC_PASS} || '';
+
+if( !$dsn || !$user ) {
+    plan skip_all => 'You need to set the DBICTEST_MSSQL_ODBC_DSN, _USER, and _PASS environment variables';
+    exit;
+}
+
+plan tests => 3;
+
+my $dbh = DBI->connect($dsn, $user, $password, {
+    RaiseError => 1, PrintError => 0
+});
+
+eval { $dbh->do('DROP TABLE [test.dot]') };
+$dbh->do(q{
+    CREATE TABLE [test.dot] (
+        id INT IDENTITY NOT NULL PRIMARY KEY,
+        dat VARCHAR(8)
+    )
+});
+
+rmtree $DUMP_DIR;
+
+eval {
+    make_schema_at(
+        'TestSL::Schema', 
+        { use_namespaces => 1 },
+        [ $dsn, $user, $password, { quote_char => [qw/[ ]/], name_sep => '.' }]
+    );
+};
+
+ok !$@, 'table name with . parsed correctly';
+diag $@ if $@;
+
+eval 'use TestSL::Schema';
+ok !$@, 'loaded schema';
+diag $@ if $@;
+
+## this doesn't work either
+#system qq{$^X -pi -e 's/"test\.dot"/\\\\"test.dot"/' t/_common_dump/TestSL/Schema/Result/TestDot.pm};
+
+#diag do { local ($/, @ARGV) = (undef, "t/_common_dump/TestSL/Schema/Result/TestDot.pm"); <> };
+
+eval {
+    TestSL::Schema->resultset('TestDot')->create({ dat => 'foo' });
+};
+ok !$@, 'used table from DBIC succeessfully';
+diag $@ if $@;
+
+rmtree $DUMP_DIR;
+
+$dbh->do('DROP TABLE [test.dot]');