[Bast-commits] r7408 - in
branches/DBIx-Class-Schema-Loader/current: .
lib/DBIx/Class/Schema/Loader lib/DBIx/Class/Schema/Loader/DBI
lib/DBIx/Class/Schema/Loader/DBI/Sybase t t/lib
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Sat Aug 29 00:55:07 GMT 2009
Author: caelum
Date: 2009-08-29 00:55:06 +0000 (Sat, 29 Aug 2009)
New Revision: 7408
Added:
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Microsoft_SQL_Server.pm
branches/DBIx-Class-Schema-Loader/current/t/16mssql_common.t
branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_mssql_extra_tests.pm
Modified:
branches/DBIx-Class-Schema-Loader/current/
branches/DBIx-Class-Schema-Loader/current/Makefile.PL
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
branches/DBIx-Class-Schema-Loader/current/t/13db2_common.t
branches/DBIx-Class-Schema-Loader/current/t/15sybase_common.t
branches/DBIx-Class-Schema-Loader/current/t/16mssql_odbc_common.t
branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm
Log:
r6812 at hlagh (orig r6811): caelum | 2009-06-28 00:08:58 -0400
new branch
r6814 at hlagh (orig r6813): caelum | 2009-06-28 02:52:09 -0400
result class is generated for table with dot in name, but doesn't work yet
r6864 at hlagh (orig r6863): caelum | 2009-06-29 20:18:30 -0400
automatically set quote_char and name_sep for mssql
r6865 at hlagh (orig r6864): caelum | 2009-06-29 20:39:46 -0400
quote table names that include name_sep
r6879 at hlagh (orig r6878): caelum | 2009-06-30 09:48:39 -0400
add constraint to dot in table name test
r6880 at hlagh (orig r6879): caelum | 2009-06-30 09:49:44 -0400
rename test
r6881 at hlagh (orig r6880): caelum | 2009-06-30 10:03:30 -0400
add a test for mssql through dbd::sybase (which fails) and make mssql_dot_in_table_name test work for either sybase or odbc
r6902 at hlagh (orig r6901): caelum | 2009-07-01 00:03:12 -0400
determine db_schema for mssql if not supplied
r6911 at hlagh (orig r6910): caelum | 2009-07-01 07:30:38 -0400
minor changes
r6912 at hlagh (orig r6911): caelum | 2009-07-01 09:06:12 -0400
make mssql test get futher with dbd::sybase
r6923 at hlagh (orig r6922): caelum | 2009-07-01 12:35:11 -0400
mssql now passes against DBD::Sybase
r6929 at hlagh (orig r6928): caelum | 2009-07-02 00:39:37 -0400
merging in sybase branch
r6933 at hlagh (orig r6932): caelum | 2009-07-02 02:24:46 -0400
making some progress on Sybase
r6958 at hlagh (orig r6957): caelum | 2009-07-02 21:29:49 -0400
rels are still fucked in sybase
r6960 at hlagh (orig r6959): caelum | 2009-07-02 23:33:07 -0400
fix pg
r6961 at hlagh (orig r6960): caelum | 2009-07-03 00:34:33 -0400
sybase rels sort of work now, more than half-way through common tests
r6979 at hlagh (orig r6978): caelum | 2009-07-03 15:35:38 -0400
almost passes sybase tests now
r7002 at hlagh (orig r7001): caelum | 2009-07-07 07:58:19 -0400
add comment about sybase DSN
r7026 at hlagh (orig r7025): caelum | 2009-07-10 16:53:09 -0400
make tests pass
r7364 at hlagh (orig r7363): caelum | 2009-08-23 03:37:54 -0400
put extra mssql tests in the proper format
r7378 at hlagh (orig r7377): caelum | 2009-08-24 11:39:56 -0400
finished cleaning up branch, all tests pass
r18687 at hlagh (orig r7406): caelum | 2009-08-28 20:45:12 -0400
add sybase and mssql as features to Makefile.PL
r18688 at hlagh (orig r7407): caelum | 2009-08-28 20:53:37 -0400
remove comment about sybase dsn (it's handled automatically now)
Property changes on: branches/DBIx-Class-Schema-Loader/current
___________________________________________________________________
Name: svk:merge
- 46bc3436-8211-0410-8564-d96f7a728040:/local/DBIx-Class-Schema-Loader/branches/common-dump:37173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/odbc-mssql:6439
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class-Schema-Loader:5726
+ 46bc3436-8211-0410-8564-d96f7a728040:/local/DBIx-Class-Schema-Loader/branches/common-dump:37173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/mssql_tweaks:7407
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-Schema-Loader/odbc-mssql:6439
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class-Schema-Loader:5726
Modified: branches/DBIx-Class-Schema-Loader/current/Makefile.PL
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/Makefile.PL 2009-08-29 00:53:37 UTC (rev 7407)
+++ branches/DBIx-Class-Schema-Loader/current/Makefile.PL 2009-08-29 00:55:06 UTC (rev 7408)
@@ -23,7 +23,7 @@
requires 'Class::C3::Componentised' => '1.0005';
requires 'Carp::Clan' => 0;
requires 'Class::Inspector' => 0;
-requires 'DBIx::Class' => '0.07006';
+requires 'DBIx::Class' => '0.08109';
requires 'Class::Unload' => 0;
install_script 'script/dbicdump';
@@ -81,6 +81,30 @@
'DBD::Oracle' => '0.19',
],
},
+ SYBASE => {
+ label => 'Sybase Support (experimental)',
+ def => $ENV{DBIC_FEATURE_SYBASE} || 0,
+ deps => [
+ 'DBI' => '1.56',
+ 'DBD::Sybase' => '1.09',
+ ],
+ },
+ MSSQL => {
+ label => 'Microsoft SQL Server Support via DBD::Sybase (experimental)',
+ def => $ENV{DBIC_FEATURE_MSSQL} || 0,
+ deps => [
+ 'DBI' => '1.56',
+ 'DBD::Sybase' => '1.09',
+ ],
+ },
+ MSSQL_ODBC => {
+ label => 'Microsoft SQL Server Support via DBD::ODBC (experimental)',
+ def => $ENV{DBIC_FEATURE_MSSQL} || 0,
+ deps => [
+ 'DBI' => '1.56',
+ 'DBD::ODBC' => '1.22',
+ ],
+ },
];
for(my $i = 0; $i <= $#$_features - 1; $i += 2) {
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2009-08-29 00:53:37 UTC (rev 7407)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2009-08-29 00:55:06 UTC (rev 7408)
@@ -672,8 +672,15 @@
my $table_class = $self->classes->{$table};
my $table_moniker = $self->monikers->{$table};
- $self->_dbic_stmt($table_class,'table',$table);
+ my $table_name = $table;
+ my $name_sep = $self->schema->storage->sql_maker->name_sep;
+ if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
+ $table_name = \ $self->_quote_table_name($table_name);
+ }
+
+ $self->_dbic_stmt($table_class,'table',$table_name);
+
my $cols = $self->_table_columns($table);
my $col_info;
eval { $col_info = $self->_columns_info_for($table) };
@@ -681,17 +688,26 @@
$self->_dbic_stmt($table_class,'add_columns',@$cols);
}
else {
- my %col_info_lc = map { lc($_), $col_info->{$_} } keys %$col_info;
+ if ($self->_is_case_sensitive) {
+ for my $col (keys %$col_info) {
+ $col_info->{$col}{accessor} = lc $col
+ if $col ne lc($col);
+ }
+ } else {
+ $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
+ }
+
my $fks = $self->_table_fk_info($table);
+
for my $fkdef (@$fks) {
for my $col (@{ $fkdef->{local_columns} }) {
- $col_info_lc{$col}->{is_foreign_key} = 1;
+ $col_info->{$col}{is_foreign_key} = 1;
}
}
$self->_dbic_stmt(
$table_class,
'add_columns',
- map { $_, ($col_info_lc{$_}||{}) } @$cols
+ map { $_, ($col_info->{$_}||{}) } @$cols
);
}
@@ -815,6 +831,22 @@
push(@{$self->{_ext_storage}->{$class}}, $stmt);
}
+sub _quote_table_name {
+ my ($self, $table) = @_;
+
+ my $qt = $self->schema->storage->sql_maker->quote_char;
+
+ return $table unless $qt;
+
+ if (ref $qt) {
+ return $qt->[0] . $table . $qt->[1];
+ }
+
+ return $qt . $table . $qt;
+}
+
+sub _is_case_sensitive { 0 }
+
=head2 monikers
Returns a hashref of loaded table to moniker mappings. There will
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm 2009-08-29 00:53:37 UTC (rev 7407)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm 2009-08-29 00:55:06 UTC (rev 7408)
@@ -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,14 +34,10 @@
my $self = shift;
$self->next::method(@_);
- $self->{db_schema} ||= 'dbo';
+ $self->{db_schema} ||= $self->_build_db_schema;
+ $self->_set_quote_char_and_name_sep;
}
-# 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;
@@ -130,6 +129,10 @@
Justin Hunter C<justin.d.hunter at gmail.com>
+=head1 CONTRIBUTORS
+
+Rafael Kitover <rkitover at cpan.org>
+
=cut
1;
Added: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Common.pm 2009-08-29 00:55:06 UTC (rev 7408)
@@ -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;
Added: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Microsoft_SQL_Server.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Microsoft_SQL_Server.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase/Microsoft_SQL_Server.pm 2009-08-29 00:55:06 UTC (rev 7408)
@@ -0,0 +1,49 @@
+package DBIx::Class::Schema::Loader::DBI::Sybase::Microsoft_SQL_Server;
+
+use strict;
+use warnings;
+use base 'DBIx::Class::Schema::Loader::DBI::MSSQL';
+use Carp::Clan qw/^DBIx::Class/;
+use Class::C3;
+
+our $VERSION = '0.04999_06';
+
+=head1 NAME
+
+DBIx::Class::Schema::Loader::DBI::Sybase::Microsoft_SQL_Server - Subclass for
+using MSSQL through DBD::Sybase
+
+=head1 DESCRIPTION
+
+See L<DBIx::Class::Schema::Loader::Base>.
+
+Subclasses L<DBIx::Class::Schema::Loader::DBI::MSSQL>.
+
+=cut
+
+# Returns an array of table names
+sub _tables_list {
+ my $self = shift;
+
+ my ($table, $type) = @_ ? @_ : ('%', '%');
+
+ my $dbh = $self->schema->storage->dbh;
+ my @tables = $dbh->tables(undef, $self->db_schema, $table, $type);
+
+ return @tables;
+}
+
+=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/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm 2009-08-29 00:53:37 UTC (rev 7407)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm 2009-08-29 00:55:06 UTC (rev 7408)
@@ -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,11 +30,14 @@
=cut
+sub _is_case_sensitive { 1 }
+
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 {
@@ -40,7 +46,8 @@
my $dbh = $self->schema->storage->dbh;
my $DBMS_VERSION = @{$dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2];
if ($DBMS_VERSION =~ /^Microsoft /i) {
- my $subclass = 'DBIx::Class::Schema::Loader::DBI::MSSQL';
+ $DBMS_VERSION =~ s/\s/_/g;
+ my $subclass = "DBIx::Class::Schema::Loader::DBI::Sybase::$DBMS_VERSION";
if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
bless $self, $subclass;
$self->_rebless;
@@ -67,7 +74,7 @@
my @keydata;
while (my $row = $sth->fetchrow_hashref) {
- push @keydata, lc $row->{column_name};
+ push @keydata, $row->{column_name};
}
return \@keydata;
@@ -76,19 +83,45 @@
sub _table_fk_info {
my ($self, $table) = @_;
+ # check if FK_NAME is supported
+
+ my $dbh = $self->schema->storage->dbh;
+ local $dbh->{FetchHashKeyName} = 'NAME_lc';
+ # hide "Object does not exist in this database." when trying to fetch fkeys
+ local $dbh->{syb_err_handler} = sub { return $_[0] == 17461 ? 0 : 1 };
+ my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = '$table'});
+ $sth->execute;
+ my $row = $sth->fetchrow_hashref;
+
+ return unless $row;
+
+ if (exists $row->{fk_name}) {
+ $sth->finish;
+ return $self->_table_fk_info_by_name($table);
+ }
+
+ $sth->finish;
+ return $self->_table_fk_info_builder($table);
+}
+
+sub _table_fk_info_by_name {
+ my ($self, $table) = @_;
my ($local_cols, $remote_cols, $remote_table, @rels);
+
my $dbh = $self->schema->storage->dbh;
+ local $dbh->{FetchHashKeyName} = 'NAME_lc';
# hide "Object does not exist in this database." when trying to fetch fkeys
- $dbh->{syb_err_handler} = sub { return 0 if $_[0] == 17461; };
- my $sth = $dbh->prepare(qq{sp_fkeys \@FKTABLE_NAME = '$table'});
+ local $dbh->{syb_err_handler} = sub { return $_[0] == 17461 ? 0 : 1 };
+ my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = '$table'});
$sth->execute;
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};
- $remote_table->{$fk} = $row->{PKTABLE_NAME};
+ my $fk = $row->{fk_name};
+ next unless defined $fk;
+
+ push @{$local_cols->{$fk}}, $row->{fkcolumn_name};
+ push @{$remote_cols->{$fk}}, $row->{pkcolumn_name};
+ $remote_table->{$fk} = $row->{pktable_name};
}
foreach my $fk (keys %$remote_table) {
@@ -102,19 +135,91 @@
return \@rels;
}
+sub _table_fk_info_builder {
+ my ($self, $table) = @_;
+
+ my $dbh = $self->schema->storage->dbh;
+ local $dbh->{FetchHashKeyName} = 'NAME_lc';
+ # hide "Object does not exist in this database." when trying to fetch fkeys
+ local $dbh->{syb_err_handler} = sub { return 0 if $_[0] == 17461; };
+ my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = '$table'});
+ $sth->execute;
+
+ my @fk_info;
+ while (my $row = $sth->fetchrow_hashref) {
+ (my $ksq = $row->{key_seq}) =~ s/\s+//g;
+
+ my @keys = qw/pktable_name pkcolumn_name fktable_name fkcolumn_name/;
+ my %ds;
+ @ds{@keys} = @{$row}{@keys};
+ $ds{key_seq} = $ksq;
+
+ push @{ $fk_info[$ksq] }, \%ds;
+ }
+
+ my $max_keys = $#fk_info;
+ my @rels;
+ for my $level (reverse 1 .. $max_keys) {
+ my @level_rels;
+ $level_rels[$level] = splice @fk_info, $level, 1;
+ my $count = @{ $level_rels[$level] };
+
+ for my $sub_level (reverse 1 .. $level-1) {
+ my $total = @{ $fk_info[$sub_level] };
+
+ $level_rels[$sub_level] = [
+ splice @{ $fk_info[$sub_level] }, $total-$count, $count
+ ];
+ }
+
+ while (1) {
+ my @rel = map shift @$_, @level_rels[1..$level];
+
+ last unless defined $rel[0];
+
+ my @local_columns = map $_->{fkcolumn_name}, @rel;
+ my @remote_columns = map $_->{pkcolumn_name}, @rel;
+ my $remote_table = $rel[0]->{pktable_name};
+
+ push @rels, {
+ local_columns => \@local_columns,
+ remote_columns => \@remote_columns,
+ remote_table => $remote_table
+ };
+ }
+ }
+
+ return \@rels;
+}
+
sub _table_uniq_info {
my ($self, $table) = @_;
+ local $SIG{__WARN__} = sub {};
+
my $dbh = $self->schema->storage->dbh;
+ local $dbh->{FetchHashKeyName} = 'NAME_lc';
my $sth = $dbh->prepare(qq{sp_helpconstraint \@objname='$table', \@nomsg='nomsg'});
- $sth->execute;
+ eval { $sth->execute };
+ return if $@;
my $constraints;
while (my $row = $sth->fetchrow_hashref) {
- my $type = $row->{constraint_type} || '';
- if ($type =~ /^unique/i) {
- my $name = lc $row->{constraint_name};
- push @{$constraints->{$name}}, ( split /,/, lc $row->{constraint_keys} );
+ if (exists $row->{constraint_type}) {
+ my $type = $row->{constraint_type} || '';
+ if ($type =~ /^unique/i) {
+ my $name = $row->{constraint_name};
+ push @{$constraints->{$name}},
+ ( split /,/, $row->{constraint_keys} );
+ }
+ } else {
+ my $def = $row->{definition} || next;
+ next unless $def =~ /^unique/i;
+ my $name = $row->{name};
+ my ($keys) = $def =~ /\((.*)\)/;
+ $keys =~ s/\s*//g;
+ my @keys = split /,/ => $keys;
+ push @{$constraints->{$name}}, @keys;
}
}
@@ -148,6 +253,10 @@
Justin Hunter C<justin.d.hunter at gmail.com>
+=head1 CONTRIBUTORS
+
+Rafael Kitover <rkitover at cpan.org>
+
=cut
1;
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm 2009-08-29 00:53:37 UTC (rev 7407)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm 2009-08-29 00:55:06 UTC (rev 7408)
@@ -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;
}
@@ -117,10 +123,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;
Modified: branches/DBIx-Class-Schema-Loader/current/t/13db2_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/13db2_common.t 2009-08-29 00:53:37 UTC (rev 7407)
+++ branches/DBIx-Class-Schema-Loader/current/t/13db2_common.t 2009-08-29 00:55:06 UTC (rev 7408)
@@ -12,6 +12,7 @@
dsn => $dsn,
user => $user,
password => $password,
+ null => '',
);
if( !$dsn || !$user ) {
Modified: branches/DBIx-Class-Schema-Loader/current/t/15sybase_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/15sybase_common.t 2009-08-29 00:53:37 UTC (rev 7407)
+++ branches/DBIx-Class-Schema-Loader/current/t/15sybase_common.t 2009-08-29 00:55:06 UTC (rev 7408)
@@ -7,12 +7,14 @@
my $password = $ENV{DBICTEST_SYBASE_PASS} || '';
my $tester = dbixcsl_common_tests->new(
- vendor => 'Sybase',
- quote_char => [qw/[ ]/],
+ vendor => 'sybase',
auto_inc_pk => 'INTEGER IDENTITY NOT NULL PRIMARY KEY',
dsn => $dsn,
user => $user,
password => $password,
+# This is necessary because there are too many cursors open for transactions on
+# insert to work.
+ connect_info_opts => { on_connect_call => 'unsafe_insert' }
);
if( !$dsn || !$user ) {
Added: branches/DBIx-Class-Schema-Loader/current/t/16mssql_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/16mssql_common.t (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/16mssql_common.t 2009-08-29 00:55:06 UTC (rev 7408)
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+# use this if you keep a copy of DBD::Sybase linked to FreeTDS somewhere else
+BEGIN {
+ if (my $lib_dirs = $ENV{DBICTEST_MSSQL_PERL5LIB}) {
+ unshift @INC, $_ for split /:/, $lib_dirs;
+ }
+}
+
+use lib qw(t/lib);
+use dbixcsl_common_tests;
+use dbixcsl_mssql_extra_tests;
+
+my $dsn = $ENV{DBICTEST_MSSQL_DSN} || '';
+my $user = $ENV{DBICTEST_MSSQL_USER} || '';
+my $password = $ENV{DBICTEST_MSSQL_PASS} || '';
+
+my $tester = dbixcsl_common_tests->new(
+ vendor => 'mssql',
+ auto_inc_pk => 'INTEGER IDENTITY NOT NULL PRIMARY KEY',
+ dsn => $dsn,
+ user => $user,
+ password => $password,
+ extra => dbixcsl_mssql_extra_tests->extra,
+);
+
+if( !$dsn || !$user ) {
+ $tester->skip_tests('You need to set the DBICTEST_MSSQL_DSN, _USER, and _PASS environment variables');
+}
+else {
+ $tester->run_tests();
+}
Modified: branches/DBIx-Class-Schema-Loader/current/t/16mssql_odbc_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/16mssql_odbc_common.t 2009-08-29 00:53:37 UTC (rev 7407)
+++ branches/DBIx-Class-Schema-Loader/current/t/16mssql_odbc_common.t 2009-08-29 00:55:06 UTC (rev 7408)
@@ -1,18 +1,19 @@
use strict;
use lib qw(t/lib);
use dbixcsl_common_tests;
+use dbixcsl_mssql_extra_tests;
my $dsn = $ENV{DBICTEST_MSSQL_ODBC_DSN} || '';
my $user = $ENV{DBICTEST_MSSQL_ODBC_USER} || '';
my $password = $ENV{DBICTEST_MSSQL_ODBC_PASS} || '';
my $tester = dbixcsl_common_tests->new(
- vendor => 'Microsoft',
- quote_char => [qw/[ ]/],
+ vendor => 'mssql',
auto_inc_pk => 'INTEGER IDENTITY NOT NULL PRIMARY KEY',
dsn => $dsn,
user => $user,
password => $password,
+ extra => dbixcsl_mssql_extra_tests->extra,
);
if( !$dsn || !$user ) {
Modified: branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm 2009-08-29 00:53:37 UTC (rev 7407)
+++ branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm 2009-08-29 00:55:06 UTC (rev 7408)
@@ -27,6 +27,9 @@
# Only MySQL uses this
$self->{innodb} ||= '';
+
+ # DB2 doesn't support this
+ $self->{null} = 'NULL' unless defined $self->{null};
$self->{verbose} = $ENV{TEST_VERBOSE} || 0;
@@ -55,7 +58,12 @@
$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);
@@ -72,7 +80,8 @@
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}_)?loader_test[0-9]+(?!.*_)/i,
relationships => 1,
additional_classes => 'TestAdditional',
additional_base_classes => 'TestAdditionalBase',
@@ -391,7 +400,11 @@
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,8 +414,11 @@
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);
isa_ok( $obj8->loader_test7, $class7);
@@ -754,11 +770,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 +787,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{
@@ -953,7 +969,7 @@
CREATE TABLE loader_test32 (
id INTEGER NOT NULL PRIMARY KEY,
rel1 INTEGER NOT NULL,
- rel2 INTEGER,
+ rel2 INTEGER $self->{null},
FOREIGN KEY (rel1) REFERENCES loader_test31(id),
FOREIGN KEY (rel2) REFERENCES loader_test31(id)
) $self->{innodb}
@@ -973,7 +989,7 @@
CREATE TABLE loader_test34 (
id INTEGER NOT NULL PRIMARY KEY,
rel1 INTEGER NOT NULL,
- rel2 INTEGER,
+ rel2 INTEGER $self->{null},
FOREIGN KEY (id,rel1) REFERENCES loader_test33(id1,id2),
FOREIGN KEY (id,rel2) REFERENCES loader_test33(id1,id2)
) $self->{innodb}
@@ -986,7 +1002,7 @@
CREATE TABLE loader_test10 (
id10 $self->{auto_inc_pk},
subject VARCHAR(8),
- loader_test11 INTEGER
+ loader_test11 INTEGER $self->{null}
) $self->{innodb}
},
$make_auto_inc->(qw/loader_test10 id10/),
@@ -995,7 +1011,7 @@
CREATE TABLE loader_test11 (
id11 $self->{auto_inc_pk},
message VARCHAR(8) DEFAULT 'foo',
- loader_test10 INTEGER,
+ loader_test10 INTEGER $self->{null},
FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
) $self->{innodb}
},
@@ -1184,8 +1200,10 @@
sub DESTROY {
my $self = shift;
- $self->drop_tables if $self->{_created};
- rmtree $DUMP_DIR;
+ unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
+ $self->drop_tables if $self->{_created};
+ rmtree $DUMP_DIR
+ }
}
1;
Added: branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_mssql_extra_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_mssql_extra_tests.pm (rev 0)
+++ branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_mssql_extra_tests.pm 2009-08-29 00:55:06 UTC (rev 7408)
@@ -0,0 +1,42 @@
+package dbixcsl_mssql_extra_tests;
+
+use Test::More;
+
+my $vendor = 'mssql';
+
+sub vendor {
+ shift;
+ $vendor = shift;
+}
+
+sub extra { +{
+ create => [
+ qq{
+ CREATE TABLE [${vendor}_loader_test1.dot] (
+ id INT IDENTITY NOT NULL PRIMARY KEY,
+ dat VARCHAR(8)
+ )
+ },
+ ],
+ drop => [ "[${vendor}_loader_test1.dot]" ],
+ count => 4,
+ run => sub {
+ my ($schema, $monikers, $classes) = @_;
+
+ my $vendor_titlecased = "\u\L$vendor";
+
+ ok((my $rs = eval {
+ $schema->resultset("${vendor_titlecased}LoaderTest1Dot") }),
+ 'got a resultset');
+
+ ok((my $from = eval { $rs->result_source->from }),
+ 'got an $rsrc->from');
+
+ is ref($from), 'SCALAR', '->table is a scalar ref';
+
+ is eval { $$from }, "[${vendor}_loader_test1.dot]",
+ '->table name is correct';
+ },
+}}
+
+1;
More information about the Bast-commits
mailing list