From: Rafael Kitover <rkitover@cpan.org>
Date: Thu, 2 Jul 2009 06:24:46 +0000 (+0000)
Subject: making some progress on Sybase
X-Git-Tag: 0.04999_08~2^2~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c9373b79cecb2bde4c0f07f4068ca38b1646fe34;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

making some progress on Sybase
---

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index fe6c2cf..d79618d 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -688,7 +688,15 @@ sub _setup_src_meta {
         $self->_dbic_stmt($table_class,'add_columns',@$cols);
     }
     else {
-        my %col_info_lc = map { lc($_), $col_info->{$_} } keys %$col_info;
+        my %col_info_lc;
+        for my $col (keys %$col_info) {
+            my $lc_col = lc $col;
+            $col_info_lc{$lc_col} = $col_info->{$_};
+
+            $col_info_lc{$lc_col}->{accessor} = $lc_col
+                if $col ne $lc_col;
+        }
+
         my $fks = $self->_table_fk_info($table);
         for my $fkdef (@$fks) {
             for my $col (@{ $fkdef->{local_columns} }) {
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
index 5ef2905..8d11c21 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
@@ -2,7 +2,10 @@ package DBIx::Class::Schema::Loader::DBI::MSSQL;
 
 use strict;
 use warnings;
-use base 'DBIx::Class::Schema::Loader::DBI';
+use base qw/
+    DBIx::Class::Schema::Loader::DBI
+    DBIx::Class::Schema::Loader::DBI::Sybase::Common
+/;
 use Carp::Clan qw/^DBIx::Class/;
 use Class::C3;
 
@@ -27,59 +30,14 @@ See L<DBIx::Class::Schema::Loader::Base>.
 
 =cut
 
-sub _rebless {
-    my $self = shift;
-
-    $self->schema->storage->sql_maker->quote_char([qw/[ ]/])
-        unless $self->schema->storage->sql_maker->quote_char;
-
-    $self->schema->storage->sql_maker->name_sep('.')
-        unless $self->schema->storage->sql_maker->name_sep;
-}
-
 sub _setup {
     my $self = shift;
 
     $self->next::method(@_);
-
     $self->{db_schema} ||= $self->_build_db_schema;
+    $self->_set_quote_char_and_name_sep;
 }
 
-sub _build_db_schema {
-    my $self = shift;
-    my $dbh  = $self->schema->storage->dbh;
-    
-    my $test_table = "_loader_test_$$";
-
-    my $db_schema = 'dbo'; # default
-
-    eval {
-        $dbh->do("create table $test_table (id integer)");
-        my $sth = $dbh->prepare('sp_tables');
-        $sth->execute;
-        while (my $row = $sth->fetchrow_hashref) {
-            next unless $row->{TABLE_NAME} eq $test_table;
-
-            $db_schema = $row->{TABLE_OWNER};
-            last;
-        }
-        $sth->finish;
-        $dbh->do("drop table $test_table");
-    };
-    my $exception = $@;
-    eval { $dbh->do("drop table $test_table") };
-    carp "Could not determine db_schema, defaulting to $db_schema : $exception"
-        if $exception;
-
-    return $db_schema;
-}
-
-
-# DBD::Sybase doesn't implement get_info properly
-#sub _build_quoter  { [qw/[ ]/] }
-sub _build_quoter  { '"' }
-sub _build_namesep { '.' }
-
 sub _table_pk_info {
     my ($self, $table) = @_;
     my $dbh = $self->schema->storage->dbh;
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
index 995c561..d5111e7 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
@@ -2,7 +2,10 @@ package DBIx::Class::Schema::Loader::DBI::Sybase;
 
 use strict;
 use warnings;
-use base 'DBIx::Class::Schema::Loader::DBI';
+use base qw/
+    DBIx::Class::Schema::Loader::DBI
+    DBIx::Class::Schema::Loader::DBI::Sybase::Common
+/;
 use Carp::Clan qw/^DBIx::Class/;
 use Class::C3;
 
@@ -31,7 +34,8 @@ sub _setup {
     my $self = shift;
 
     $self->next::method(@_);
-    $self->{db_schema} ||= 'dbo';
+    $self->{db_schema} ||= $self->_build_db_schema;
+    $self->_set_quote_char_and_name_sep;
 }
 
 sub _rebless {
@@ -45,12 +49,6 @@ sub _rebless {
             bless $self, $subclass;
             $self->_rebless;
       }
-    } else {
-        $self->schema->storage->sql_maker->quote_char([qw/[ ]/])
-            unless $self->schema->storage->sql_maker->quote_char;
-
-        $self->schema->storage->sql_maker->name_sep('.')
-            unless $self->schema->storage->sql_maker->name_sep;
     }
 }
 
@@ -73,7 +71,7 @@ sub _table_pk_info {
     my @keydata;
 
     while (my $row = $sth->fetchrow_hashref) {
-        push @keydata, lc $row->{column_name};
+        push @keydata, $row->{column_name};
     }
 
     return \@keydata;
@@ -92,8 +90,8 @@ sub _table_fk_info {
     while (my $row = $sth->fetchrow_hashref) {
         next unless $row->{FK_NAME};
         my $fk = $row->{FK_NAME};
-        push @{$local_cols->{$fk}}, lc $row->{FKCOLUMN_NAME};
-        push @{$remote_cols->{$fk}}, lc $row->{PKCOLUMN_NAME};
+        push @{$local_cols->{$fk}}, $row->{FKCOLUMN_NAME};
+        push @{$remote_cols->{$fk}}, $row->{PKCOLUMN_NAME};
         $remote_table->{$fk} = $row->{PKTABLE_NAME};
     }
 
@@ -120,17 +118,17 @@ sub _table_uniq_info {
         if (exists $row->{constraint_type}) {
             my $type = $row->{constraint_type} || '';
             if ($type =~ /^unique/i) {
-                my $name = lc $row->{constraint_name};
+                my $name = $row->{constraint_name};
                 push @{$constraints->{$name}},
-                    ( split /,/, lc $row->{constraint_keys} );
+                    ( split /,/, $row->{constraint_keys} );
             }
         } else {
             my $def = $row->{definition} || next;
             next unless $def =~ /^unique/i;
-            my $name = lc $row->{name};
+            my $name = $row->{name};
             my ($keys) = $def =~ /\((.*)\)/;
             $keys =~ s/\s*//g;
-            my @keys = map lc, split /,/ => $keys;
+            my @keys = split /,/ => $keys;
             push @{$constraints->{$name}}, @keys;
         }
     }
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm b/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm
new file mode 100644
index 0000000..c8c7a88
--- /dev/null
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm
@@ -0,0 +1,79 @@
+package DBIx::Class::Schema::Loader::DBI::Sybase::Common;
+
+use strict;
+use warnings;
+use Carp::Clan qw/^DBIx::Class/;
+use Class::C3;
+
+our $VERSION = '0.04999_06';
+
+=head1 NAME
+
+DBIx::Class::Schema::Loader::DBI::Sybase::Common - Common functions for Sybase
+and MSSQL
+
+=head1 DESCRIPTION
+
+See L<DBIx::Class::Schema::Loader::Base>.
+
+=cut
+
+# DBD::Sybase doesn't implement get_info properly
+sub _build_quoter  { '"' }
+sub _build_namesep { '.' }
+
+sub _set_quote_char_and_name_sep {
+    my $self = shift;
+
+    $self->schema->storage->sql_maker->quote_char([qw/[ ]/])
+        unless $self->schema->storage->sql_maker->quote_char;
+
+    $self->schema->storage->sql_maker->name_sep('.')
+        unless $self->schema->storage->sql_maker->name_sep;
+}
+
+sub _build_db_schema {
+    my $self = shift;
+    my $dbh  = $self->schema->storage->dbh;
+
+    local $dbh->{FetchHashKeyName} = 'NAME_lc';
+    
+    my $test_table = "_loader_test_$$";
+
+    my $db_schema = 'dbo'; # default
+
+    eval {
+        $dbh->do("create table $test_table (id integer)");
+        my $sth = $dbh->prepare('sp_tables');
+        $sth->execute;
+        while (my $row = $sth->fetchrow_hashref) {
+            next unless $row->{table_name} eq $test_table;
+
+            $db_schema = $row->{table_owner};
+            last;
+        }
+        $sth->finish;
+        $dbh->do("drop table $test_table");
+    };
+    my $exception = $@;
+    eval { $dbh->do("drop table $test_table") };
+    carp "Could not determine db_schema, defaulting to $db_schema : $exception"
+        if $exception;
+
+    return $db_schema;
+}
+
+=head1 SEE ALSO
+
+L<DBIx::Class::Schema::Loader::DBI::Sybase>,
+L<DBIx::Class::Schema::Loader::DBI::MSSQL>,
+L<DBIx::Class::Schema::Loader::DBI>
+L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
+
+=head1 AUTHOR
+
+Rafael Kitover <rkitover@cpan.org>
+
+=cut
+
+1;
diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index 6000c54..f1e924f 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -754,11 +754,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 +771,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{