Revision history for Perl extension DBIx::Class::Schema::Loader
+ - rescan now reloads all tables
- minor type info improvements for all DBs
- fix erroneous default_value for MySQL NOT NULL columns (RT#57225)
- remove is_deferrable => 1 from default for belongs_to rels
- better type info for Oracle
- preliminary Informix support
- unregister dropped sources on rescan
- - added 'preserve_case' option with support for SQLite, mysql, MSSQL,
- SQLAnywhere and Firebird/InterBase; removed the MSSQL
- 'case_sensitive_collation' and the Firebird/InterBase 'unquoted_ddl'
- options in favor of it.
+ - added 'preserve_case' option with support for all DBs where it makes
+ sense; removed the MSSQL 'case_sensitive_collation' and the
+ Firebird/InterBase 'unquoted_ddl' options in favor of it.
- support CamelCase table names and column names (in case-preserving
mode) at the v7 naming level
- rewrite datetime default functions as \'CURRENT_TIMESTAMP' where
- introspect views and make proper ResultSource::View classes with defining SQL
- encode loader options in Schema.pm
- introspect on_update/on_delete/is_deferrable
- - preserve_case mode for remaining backends
- Low Priority
- support multiple/all schemas, instead of just one
- support pk/uk/fk info on views, possibly (materialized views?)
- add hashref form of generate_pod to control which POD is generated
- add hashref form of components to control which components are added to
which classes
- - add common tests for preserve_case option where it must be exclusive
- (Oracle, Firebird)
- check rel accessors for method conflicts
- add an option to add extra code to Result classes
- redo in-memory schema as an @INC coderef rather than temp files
- table/column comments
- introspect on_update/on_delete/is_deferrable
- introspect view SQL
- - preserve_case mode
- domains
- Oracle
- table/column comments
- introspect on_update/on_delete/is_deferrable
- introspect view SQL
- - preserve_case mode
- domains
- Sybase ASE
- table/column comments
- domains
- Informix
- data_type tests
- - preserve_case mode
- table/column comments
- introspect on_update/on_delete/is_deferrable
- introspect view SQL
}
if ($old_real_inc_path) {
- open(my $fh, '<', $old_real_inc_path)
- or croak "Failed to open '$old_real_inc_path' for reading: $!";
+ my $code = slurp $old_real_inc_path;
+
$self->_ext_stmt($class, <<"EOF");
# These lines were loaded from '$old_real_inc_path',
# upgrade. See skip_load_external to disable this feature.
EOF
- my $code = slurp $old_real_inc_path;
$code = $self->_rewrite_old_classnames($code);
if ($self->dynamic) {
Arguments: schema
-Rescan the database for newly added tables. Does
-not process drops or changes. Returns a list of
-the newly added table monikers.
+Rescan the database for changes. Returns a list of the newly added table
+monikers.
-The schema argument should be the schema class
-or object to be affected. It should probably
-be derived from the original schema_class used
-during L</load>.
+The schema argument should be the schema class or object to be affected. It
+should probably be derived from the original schema_class used during L</load>.
=cut
}
}
- my $loaded = $self->_load_tables(@created);
+ delete $self->{_dump_storage};
+ delete $self->{_relations_started};
+
+ my $loaded = $self->_load_tables(@current);
- return map { $self->monikers->{$_} } @$loaded;
+ return map { $self->monikers->{$_} } @created;
}
sub _relbuilder {
if (not defined $self->preserve_case) {
$self->preserve_case(0);
}
+ elsif ($self->preserve_case) {
+ $self->schema->storage->sql_maker->quote_char('"');
+ $self->schema->storage->sql_maker->name_sep('.');
+ }
}
sub _table_uniq_info {
WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'U'}
) or die $DBI::errstr;
- $sth->execute($self->db_schema, uc $table) or die $DBI::errstr;
+ $sth->execute($self->db_schema, $self->_uc($table)) or die $DBI::errstr;
my %keydata;
while(my $row = $sth->fetchrow_arrayref) {
my ($col, $constname, $seq) = @$row;
- push(@{$keydata{$constname}}, [ $seq, lc $col ]);
+ push(@{$keydata{$constname}}, [ $seq, $self->_lc($col) ]);
}
foreach my $keyname (keys %keydata) {
my @ordered_cols = map { $_->[1] } sort { $a->[0] <=> $b->[0] }
my ($self, $opts) = @_;
my $dbh = $self->schema->storage->dbh;
- my @tables = map { lc } $dbh->tables(
+ my @tables = map $self->_lc($_), $dbh->tables(
$self->db_schema ? { TABLE_SCHEM => $self->db_schema } : undef
);
s/\Q$self->{_quoter}\E//g for @tables;
sub _table_pk_info {
my ($self, $table) = @_;
- return $self->next::method(uc $table);
+ return $self->next::method($self->_uc($table));
}
sub _table_fk_info {
my ($self, $table) = @_;
- my $rels = $self->next::method(uc $table);
+ my $rels = $self->next::method($self->_uc($table));
foreach my $rel (@$rels) {
- $rel->{remote_table} = lc $rel->{remote_table};
+ $rel->{remote_table} = $self->_lc($rel->{remote_table});
}
return $rels;
my $self = shift;
my ($table) = @_;
- my $result = $self->next::method(uc $table);
+ my $result = $self->next::method($self->_uc($table));
my $dbh = $self->schema->storage->dbh;
AND identity = 'Y' AND generated != ''
},
{}, 1);
- $sth->execute($self->db_schema, uc $table, uc $col);
+ $sth->execute($self->db_schema, $self->_uc($table), $self->_uc($col));
if ($sth->fetchrow_array) {
$info->{is_auto_increment} = 1;
}
if (not defined $self->preserve_case) {
$self->preserve_case(0);
}
+ elsif ($self->preserve_case) {
+ $self->schema->storage->sql_maker->quote_char('"');
+ $self->schema->storage->sql_maker->name_sep('.');
+ }
}
sub _tables_list {
=head1 COLUMN NAME CASE ISSUES
-By default column names from unquoted DDL will be generated in uppercase, as
-that is the only way they will work with quoting on.
+By default column names from unquoted DDL will be generated in lowercase, for
+consistency with other backends.
-See the L<preserve_case|DBIx::Class::Schema::Loader::Base/preserve_case> option
-to false if you would like to have lowercase column names.
+Set the L<preserve_case|DBIx::Class::Schema::Loader::Base/preserve_case> option
+to true if you would like to have column names in the internal case, which is
+uppercase for DDL that uses unquoted identifiers.
-Setting this option is a good idea if your DDL uses unquoted identifiers and
-you will not use quoting (the
-L<quote_char|DBIx::Class::Storage::DBI/quote_char> option in
-L<connect_info|DBIx::Class::Storage::DBI/connect_info>.)
+Do not use quoting (the L<quote_char|DBIx::Class::Storage::DBI/quote_char>
+option in L<connect_info|DBIx::Class::Storage::DBI/connect_info> when in the
+default C<< preserve_case => 0 >> mode.
Be careful to also not use any SQL reserved words in your DDL.
Mixed-case table and column names will be ignored when this option is on and
will not work with quoting turned off.
-B<NOTE:> This option used to be called C<unquoted_ddl> but has been removed in
-favor of the more generic option.
-
=cut
sub _setup {
if (not defined $self->preserve_case) {
warn <<'EOF';
-WARNING: Assuming mixed-case Firebird DDL, see
+WARNING: Assuming unquoted Firebird DDL, see
perldoc DBIx::Class::Schema::Loader::DBI::InterBase
and the 'preserve_case' option in
perldoc DBIx::Class::Schema::Loader::Base
for more information.
EOF
- $self->preserve_case(1);
+ $self->preserve_case(0);
}
if ($self->preserve_case) {
my $sth = $dbh->column_info(undef, $self->db_schema, $self->_uc($table), '%');
- return [ map lc($_->{COLUMN_NAME}), @{ $sth->fetchall_arrayref({ COLUMN_NAME => 1 }) || [] } ];
+ return [ map $self->_lc($_->{COLUMN_NAME}), @{ $sth->fetchall_arrayref({ COLUMN_NAME => 1 }) || [] } ];
}
sub _table_uniq_info {
user => $user,
password => $password,
null => '',
+ preserve_case_mode_is_exclusive => 1,
+ quote_char => '"',
data_types => {
'timestamp DEFAULT CURRENT TIMESTAMP' => { data_type => 'timestamp', default_value => \'current_timestamp',
original => { default_value => \'current timestamp' } },
my ($table, $col) = @_;
return qq{ DROP SEQUENCE ${table}_${col}_seq };
},
- quote_char => '"',
+ preserve_case_mode_is_exclusive => 1,
+ quote_char => '"',
dsn => $dsn,
user => $user,
password => $password,
);
},
null => '',
- loader_options => { preserve_case => 0 },
+ preserve_case_mode_is_exclusive => 1,
+ quote_char => '"',
+ warnings => [ qr/'preserve_case' option/ ],
connect_info => [ ($dbd_interbase_dsn ? {
dsn => $dbd_interbase_dsn,
user => $dbd_interbase_user,
=> { data_type => 'blob sub_type text' },
},
extra => {
- count => 7,
+ count => 6,
run => sub {
$schema = shift;
my $guard = Scope::Guard->new(\&cleanup_extra);
- delete $schema->_loader->{preserve_case};
-
- my $warning;
- {
- local $SIG{__WARN__} = sub { $warning = shift };
- $schema->_loader->_setup;
- }
- like $warning, qr/'preserve_case' option/,
- 'warning mentions preserve_case option';
+ local $schema->_loader->{preserve_case} = 1;
+ $schema->_loader->_setup;
{
local $SIG{__WARN__} = sub {};
use lib qw(t/lib);
use dbixcsl_common_tests;
+# to support " quoted identifiers
+BEGIN { $ENV{DELIMIDENT} = 'y' }
+
# This test doesn't run over a shared memory connection, because of the single connection limit.
my $dsn = $ENV{DBICTEST_INFORMIX_DSN} || '';
dsn => $dsn,
user => $user,
password => $password,
+ loader_options => { preserve_case => 1 },
+ quote_char => '"',
);
if( !$dsn ) {
my $extra_count = $self->{extra}{count} || 0;
- plan tests => @connect_info * (178 + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+ plan tests => @connect_info * (179 + $extra_count + ($self->{data_type_tests}{test_count} || 0));
foreach my $info_idx (0..$#connect_info) {
my $info = $connect_info[$info_idx];
my %loader_opts = (
constraint =>
- qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)_)?loader_test[0-9]+(?!.*_)/i,
+ qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)_?)?loader_?test[0-9]+(?!.*_)/i,
relationships => 1,
additional_classes => 'TestAdditional',
additional_base_classes => 'TestAdditionalBase',
$warn_count++ for grep /\b(?!loader_test9)\w+ has no primary key/i, @loader_warnings;
+ $warn_count++ for grep { my $w = $_; grep $w =~ $_, @{ $self->{warnings} || [] } } @loader_warnings;
+
if ($standard_sources) {
if($self->{skip_rels}) {
SKIP: {
my $find_cb = sub {
return if -d;
- return if $_ eq 'LoaderTest30.pm';
+ return if /^(?:LoaderTest30|LoaderTest1|LoaderTest2X)\.pm\z/;
open my $fh, '<', $_ or die "Could not open $_ for reading: $!";
binmode $fh;
find $find_cb, $DUMP_DIR;
+# system "rm -f /tmp/before_rescan/* /tmp/after_rescan/*";
+# system "cp t/_common_dump/DBIXCSL_Test/Schema/*.pm /tmp/before_rescan";
+
my $before_digest = $digest->digest;
$conn->storage->disconnect; # needed for Firebird and Informix
};
is_deeply(\@new, [ qw/LoaderTest30/ ], "Rescan");
+# system "cp t/_common_dump/DBIXCSL_Test/Schema/*.pm /tmp/after_rescan";
+
$digest = Digest::MD5->new;
find $find_cb, $DUMP_DIR;
my $after_digest = $digest->digest;
# run extra tests
$self->{extra}{run}->($conn, $monikers, $classes) if $self->{extra}{run};
+ $self->test_preserve_case($conn);
+
$self->drop_tables unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
$conn->storage->disconnect;
}
}
+sub test_preserve_case {
+ my ($self, $conn) = @_;
+
+ my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1); # open quote, close quote
+
+ my $dbh = $conn->storage->dbh;
+
+ {
+ # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
+ local $SIG{__WARN__} = sub {
+ my $msg = shift;
+ warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
+ };
+
+ $dbh->do($_) for (
+qq|
+ CREATE TABLE ${oqt}LoaderTest40${cqt} (
+ ${oqt}Id${cqt} INTEGER NOT NULL PRIMARY KEY,
+ ${oqt}Foo3Bar${cqt} VARCHAR(100) NOT NULL
+ ) $self->{innodb}
+|,
+qq|
+ CREATE TABLE ${oqt}LoaderTest41${cqt} (
+ ${oqt}Id${cqt} INTEGER NOT NULL PRIMARY KEY,
+ ${oqt}LoaderTest40Id${cqt} INTEGER,
+ FOREIGN KEY (${oqt}LoaderTest40Id${cqt}) REFERENCES ${oqt}LoaderTest40${cqt} (${oqt}Id${cqt})
+ ) $self->{innodb}
+|,
+qq| INSERT INTO ${oqt}LoaderTest40${cqt} VALUES (1, 'foo') |,
+qq| INSERT INTO ${oqt}LoaderTest41${cqt} VALUES (1, 1) |,
+ );
+ }
+ $conn->storage->disconnect;
+
+ local $conn->_loader->{preserve_case} = 1;
+ $conn->_loader->_setup;
+
+ {
+ local $SIG{__WARN__} = sub {};
+ $conn->rescan;
+ }
+
+ if (not $self->{skip_rels}) {
+ is $conn->resultset('LoaderTest41')->find(1)->loader_test40->foo3_bar, 'foo',
+ 'rel and accessor for mixed-case column name in mixed case table';
+ }
+ else {
+ is $conn->resultset('LoaderTest40')->find(1)->foo3_bar, 'foo',
+ 'accessor for mixed-case column name in mixed case table';
+ }
+}
+
sub monikers_and_classes {
my ($self, $schema_class) = @_;
my ($monikers, $classes);
return $dbh;
}
+sub get_oqt_cqt {
+ my $self = shift;
+ my %opts = @_;
+
+ if ((not $opts{always}) && $self->{preserve_case_mode_is_exclusive}) {
+ return ('', '');
+ }
+
+ # XXX should get quote_char from the storage of an initialized loader.
+ my ($oqt, $cqt); # open quote, close quote
+ if (ref $self->{quote_char}) {
+ ($oqt, $cqt) = @{ $self->{quote_char} };
+ }
+ else {
+ $oqt = $cqt = $self->{quote_char} || '';
+ }
+
+ return ($oqt, $cqt);
+}
+
sub create {
my $self = shift;
);
# some DBs require mixed case identifiers to be quoted
- # XXX should get quote_char from the storage of an initialized loader.
- my ($oqt, $cqt); # open quote, close quote
- if (ref $self->{quote_char}) {
- ($oqt, $cqt) = @{ $self->{quote_char} };
- }
- else {
- $oqt = $cqt = $self->{quote_char} || '';
- }
+ my ($oqt, $cqt) = $self->get_oqt_cqt;
@statements_reltests = (
qq{
$dbh->do($_) foreach (@statements);
- $dbh->do($_) foreach (@{ $self->{data_type_tests}{ddl} || {} });
+ $dbh->do($_) foreach (@{ $self->{data_type_tests}{ddl} || [] });
unless($self->{skip_rels}) {
# hack for now, since DB2 doesn't like inline comments, and we need
my @tables_rescan = qw/ loader_test30 /;
+ my @tables_preserve_case_tests = qw/ LoaderTest41 LoaderTest40 /;
+
my $drop_fk_mysql =
q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk};
unless($self->{skip_rels}) {
$dbh->do("DROP TABLE $_") for (@tables_reltests);
+ $dbh->do("DROP TABLE $_") for (@tables_reltests);
if($self->{vendor} =~ /mysql/i) {
$dbh->do($drop_fk_mysql);
}
$dbh->do("DROP TABLE $data_type_table");
}
+ my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1);
+
+ $dbh->do("DROP TABLE ${oqt}${_}${cqt}") for @tables_preserve_case_tests;
+
$dbh->disconnect;
# fixup for Firebird
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff