[Bast-commits] r6932 - in
branches/DBIx-Class-Schema-Loader/mssql_tweaks:
lib/DBIx/Class/Schema/Loader lib/DBIx/Class/Schema/Loader/DBI
lib/DBIx/Class/Schema/Loader/DBI/Sybase t/lib
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Thu Jul 2 06:24:46 GMT 2009
Author: caelum
Date: 2009-07-02 06:24:46 +0000 (Thu, 02 Jul 2009)
New Revision: 6932
Added:
branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase/
branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm
Modified:
branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/Base.pm
branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/lib/dbixcsl_common_tests.pm
Log:
making some progress on Sybase
Modified: branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/Base.pm 2009-07-02 06:08:33 UTC (rev 6931)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/Base.pm 2009-07-02 06:24:46 UTC (rev 6932)
@@ -688,7 +688,15 @@
$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} }) {
Modified: branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm 2009-07-02 06:08:33 UTC (rev 6931)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm 2009-07-02 06:24:46 UTC (rev 6932)
@@ -2,7 +2,10 @@
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 @@
=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;
Added: branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm 2009-07-02 06:24:46 UTC (rev 6932)
@@ -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 at cpan.org>
+
+=cut
+
+1;
Modified: branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm 2009-07-02 06:08:33 UTC (rev 6931)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm 2009-07-02 06:24:46 UTC (rev 6932)
@@ -2,7 +2,10 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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;
}
}
Modified: branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/lib/dbixcsl_common_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/lib/dbixcsl_common_tests.pm 2009-07-02 06:08:33 UTC (rev 6931)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/lib/dbixcsl_common_tests.pm 2009-07-02 06:24:46 UTC (rev 6932)
@@ -754,11 +754,11 @@
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 @@
) $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{
More information about the Bast-commits
mailing list