- Set is_auto_increment for auto-increment columns (RT #31473)
(Only SQLite, MySQL and PostgreSQL are currently supported)
- Generate one-to-one accessors for unique foreign keys (ilmari)
+ - Add support for load_namespaces-style class layout
+ - Fix test skip count for main skip_rels block
+ - Fix auto-inc column creation for the Oracle tests
+ - Fix column ordering in unique constraints for Oracle
- Fix Win32 test skip counts for good (RT #30568, Kenichi Ishigaki)
- Default Oracle db_schema to db username (patch
from Johannes Plunien)
dump_directory
dump_overwrite
really_erase_my_files
+ use_namespaces
+ result_namespace
+ resultset_namespace
+ default_resultset_class
db_schema
_tables
C<ResultSetManager> will be automatically added to the above
C<components> list if this option is set.
+=head2 use_namespaces
+
+Generate result class names suitable for
+L<DBIx::Class::Schema/load_namespaces> and call that instead of
+L<DBIx::Class::Schema/load_classes>. When using this option you can also
+specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
+C<resultset_namespace>, C<default_resultset_class>), and they will be added
+to the call (and the generated result class names adjusted appropriately).
+
=head2 dump_directory
This option is designed to be a tool to help you transition from this
my $schema_text =
qq|package $schema_class;\n\n|
. qq|use strict;\nuse warnings;\n\n|
- . qq|use base 'DBIx::Class::Schema';\n\n|
- . qq|__PACKAGE__->load_classes;\n|;
+ . qq|use base 'DBIx::Class::Schema';\n\n|;
+
+
+ if ($self->use_namespaces) {
+ $schema_text .= qq|__PACKAGE__->load_namespaces|;
+ my $namespace_options;
+ for my $attr (qw(result_namespace
+ resultset_namespace
+ default_resultset_class)) {
+ if ($self->$attr) {
+ $namespace_options .= qq| $attr => '| . $self->$attr . qq|',\n|
+ }
+ }
+ $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
+ $schema_text .= qq|;\n|;
+ }
+ else {
+ $schema_text .= qq|__PACKAGE__->load_classes;\n|;
+
+ }
$self->_write_classfile($schema_class, $schema_text);
my $schema_class = $self->schema_class;
my $table_moniker = $self->_table2moniker($table);
- my $table_class = $schema_class . q{::} . $table_moniker;
+ my @result_namespace = ($schema_class);
+ if ($self->use_namespaces) {
+ my $result_namespace = $self->result_namespace || 'Result';
+ if ($result_namespace =~ /^\+(.*)/) {
+ # Fully qualified namespace
+ @result_namespace = ($1)
+ }
+ else {
+ # Relative namespace
+ push @result_namespace, $result_namespace;
+ }
+ }
+ my $table_class = join(q{::}, @result_namespace, $table_moniker);
my $table_normalized = lc $table;
$self->classes->{$table} = $table_class;
sub _table_uniq_info {
my ($self, $table) = @_;
- my @uniqs;
my $dbh = $self->schema->storage->dbh;
my $sth = $dbh->prepare_cached(
- qq{SELECT constraint_name, ucc.column_name FROM user_constraints JOIN user_cons_columns ucc USING (constraint_name) WHERE ucc.table_name=? AND constraint_type='U'}
- ,{}, 1);
+ q{
+ SELECT constraint_name, ucc.column_name
+ FROM user_constraints JOIN user_cons_columns ucc USING (constraint_name)
+ WHERE ucc.table_name=? AND constraint_type='U'
+ ORDER BY ucc.position
+ },
+ {}, 1);
$sth->execute(uc $table);
my %constr_names;
while(my $constr = $sth->fetchrow_arrayref) {
- my $constr_name = $constr->[0];
- my $constr_def = $constr->[1];
+ my $constr_name = lc $constr->[0];
+ my $constr_def = lc $constr->[1];
$constr_name =~ s/\Q$self->{_quoter}\E//;
$constr_def =~ s/\Q$self->{_quoter}\E//;
- push @{$constr_names{$constr_name}}, lc $constr_def;
+ push @{$constr_names{$constr_name}}, $constr_def;
}
- map {
- push(@uniqs, [ lc $_ => $constr_names{$_} ]);
- } keys %constr_names;
-
+
+ my @uniqs = map { [ $_ => $constr_names{$_} ] } keys %constr_names;
return \@uniqs;
}
sub _table_pk_info {
- my ( $self, $table ) = @_;
- return $self->SUPER::_table_pk_info(uc $table);
+ my ($self, $table) = @_;
+ return $self->next::method(uc $table);
}
sub _table_fk_info {
my ($self, $table) = @_;
- my $dbh = $self->schema->storage->dbh;
- my $sth = $dbh->foreign_key_info( '', '', '', '',
- $self->db_schema, uc $table );
- return [] if !$sth;
-
- my %rels;
-
- my $i = 1; # for unnamed rels, which hopefully have only 1 column ...
- while(my $raw_rel = $sth->fetchrow_arrayref) {
- my $uk_tbl = lc $raw_rel->[2];
- my $uk_col = lc $raw_rel->[3];
- my $fk_col = lc $raw_rel->[7];
- my $relid = ($raw_rel->[11] || ( "__dcsld__" . $i++ ));
- $uk_tbl =~ s/\Q$self->{_quoter}\E//g;
- $uk_col =~ s/\Q$self->{_quoter}\E//g;
- $fk_col =~ s/\Q$self->{_quoter}\E//g;
- $relid =~ s/\Q$self->{_quoter}\E//g;
- $rels{$relid}->{tbl} = $uk_tbl;
- $rels{$relid}->{cols}->{$uk_col} = $fk_col;
- }
+ my $rels = $self->next::method(uc $table);
- my @rels;
- foreach my $relid (keys %rels) {
- push(@rels, {
- remote_columns => [ keys %{$rels{$relid}->{cols}} ],
- local_columns => [ values %{$rels{$relid}->{cols}} ],
- remote_table => $rels{$relid}->{tbl},
- });
+ foreach my $rel (@$rels) {
+ $rel->{remote_table} = lc $rel->{remote_table};
}
- return \@rels;
+ return $rels;
+}
+
+sub _columns_info_for {
+ my ($self, $table) = @_;
+ return $self->next::method(uc $table);
}
=head1 SEE ALSO
The base DBI Loader contains generic methods that *should* work for
everything else in theory, although in practice some DBDs need to
override one or more of the other methods. The other methods one might
-likely want to override are: C<_table_pk_info>, C<_table_fk_info>, and
-C<_tables_list>. See the included DBD drivers for examples of these.
+likely want to override are: C<_table_pk_info>, C<_table_fk_info>,
+C<_tables_list> and C<_extra_column_info>. See the included DBD drivers
+for examples of these.
=cut
my $tester = dbixcsl_common_tests->new(
vendor => 'Oracle',
- auto_inc_pk => 'SERIAL NOT NULL PRIMARY KEY',
+ auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY',
+ auto_inc_cb => sub {
+ my ($table, $col) = @_;
+ return (
+ qq{ CREATE SEQUENCE ${table}_${col}_seq START WITH 1 INCREMENT BY 1},
+ qq{
+ CREATE OR REPLACE TRIGGER ${table}_${col}_trigger
+ BEFORE INSERT ON ${table}
+ FOR EACH ROW
+ BEGIN
+ SELECT ${table}_${col}_seq.nextval INTO :NEW.${col} FROM dual;
+ END;
+ }
+ );
+ },
+ auto_inc_drop_cb => sub {
+ my ($table, $col) = @_;
+ return qq{ DROP SEQUENCE ${table}_${col}_seq };
+ },
dsn => $dsn,
user => $user,
password => $password,
$^O eq 'MSWin32'
? plan(skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths")
- : plan(tests => 40);
+ : plan(tests => 82);
my $DUMP_PATH = './t/_dump';
},
);
+do_dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => { use_namespaces => 1 },
+ error => '',
+ warnings => [
+ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+ qr/Schema dump completed/,
+ ],
+ regexes => {
+ schema => [
+ qr/package DBICTest::DumpMore::1;/,
+ qr/->load_namespaces/,
+ ],
+ 'Result/Foo' => [
+ qr/package DBICTest::DumpMore::1::Result::Foo;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ 'Result/Bar' => [
+ qr/package DBICTest::DumpMore::1::Result::Bar;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ },
+);
+
+do_dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => { use_namespaces => 1,
+ result_namespace => 'Res',
+ resultset_namespace => 'RSet',
+ default_resultset_class => 'RSetBase',
+ },
+ error => '',
+ warnings => [
+ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+ qr/Schema dump completed/,
+ ],
+ regexes => {
+ schema => [
+ qr/package DBICTest::DumpMore::1;/,
+ qr/->load_namespaces/,
+ qr/result_namespace => 'Res'/,
+ qr/resultset_namespace => 'RSet'/,
+ qr/default_resultset_class => 'RSetBase'/,
+ ],
+ 'Res/Foo' => [
+ qr/package DBICTest::DumpMore::1::Res::Foo;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ 'Res/Bar' => [
+ qr/package DBICTest::DumpMore::1::Res::Bar;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ },
+);
+
+do_dump_test(
+ classname => 'DBICTest::DumpMore::1',
+ options => { use_namespaces => 1,
+ result_namespace => '+DBICTest::DumpMore::1::Res',
+ resultset_namespace => 'RSet',
+ default_resultset_class => 'RSetBase',
+ },
+ error => '',
+ warnings => [
+ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+ qr/Schema dump completed/,
+ ],
+ regexes => {
+ schema => [
+ qr/package DBICTest::DumpMore::1;/,
+ qr/->load_namespaces/,
+ qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/,
+ qr/resultset_namespace => 'RSet'/,
+ qr/default_resultset_class => 'RSetBase'/,
+ ],
+ 'Res/Foo' => [
+ qr/package DBICTest::DumpMore::1::Res::Foo;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ 'Res/Bar' => [
+ qr/package DBICTest::DumpMore::1::Res::Bar;/,
+ qr/->set_primary_key/,
+ qr/1;\n$/,
+ ],
+ },
+);
+
END { rmtree($DUMP_PATH, 1, 1); }
$self->{_created} = 1;
+ my $make_auto_inc = $self->{auto_inc_cb} || sub {};
my @statements = (
qq{
CREATE TABLE loader_test1 (
dat VARCHAR(32) NOT NULL UNIQUE
) $self->{innodb}
},
+ $make_auto_inc->(qw/loader_test1 id/),
q{ INSERT INTO loader_test1 (dat) VALUES('foo') },
q{ INSERT INTO loader_test1 (dat) VALUES('bar') },
UNIQUE (dat2, dat)
) $self->{innodb}
},
+ $make_auto_inc->(qw/loader_test2 id/),
q{ INSERT INTO loader_test2 (dat, dat2) VALUES('aaa', 'zzz') },
q{ INSERT INTO loader_test2 (dat, dat2) VALUES('bbb', 'yyy') },
loader_test11 INTEGER
) $self->{innodb}
},
+ $make_auto_inc->(qw/loader_test10 id10/),
qq{
CREATE TABLE loader_test11 (
FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
) $self->{innodb}
},
+ $make_auto_inc->(qw/loader_test11 id11/),
(q{ ALTER TABLE loader_test10 ADD CONSTRAINT } .
q{ loader_test11_fk FOREIGN KEY (loader_test11) } .
LOADER_TEST23
LoAdEr_test24
/;
+
+ my @tables_auto_inc = (
+ [ qw/loader_test1 id/ ],
+ [ qw/loader_test2 id/ ],
+ );
my @tables_reltests = qw/
loader_test4
loader_test11
loader_test10
/;
+
+ my @tables_advanced_auto_inc = (
+ [ qw/loader_test10 id10/ ],
+ [ qw/loader_test11 id11/ ],
+ );
my @tables_inline_rels = qw/
loader_test13
my @tables_rescan = qw/ loader_test30 /;
my $drop_fk_mysql =
- q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk;};
+ q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk};
my $drop_fk =
- q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk;};
+ q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk};
my $dbh = $self->dbconnect(0);
$dbh->do("DROP TABLE $_") for @{ $self->{extra}->{drop} || [] };
+ my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {};
+
unless($self->{skip_rels}) {
$dbh->do("DROP TABLE $_") for (@tables_reltests);
unless($self->{vendor} =~ /sqlite/i) {
$dbh->do($drop_fk);
}
$dbh->do("DROP TABLE $_") for (@tables_advanced);
+ $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc;
}
unless($self->{no_inline_rels}) {
$dbh->do("DROP TABLE $_") for (@tables_inline_rels);
$dbh->do("DROP TABLE $_") for (@tables_rescan);
}
$dbh->do("DROP TABLE $_") for (@tables);
+ $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc;
$dbh->disconnect;
}