Revision history for Perl extension DBIx::Class::Schema::Loader
- - support CamelCase table names and column names (in case-sensitive
- mode)
+ - added 'preserve_case' option with support for SQLite, mysql, MSSQL and
+ Firebird/InterBase; 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
possible (except for Sybase ASE) to ease cross-deployment
- use column_info instead of select to get Oracle column list (RT#42281)
generate_pod
pod_comment_mode
pod_comment_spillover_length
+ preserve_case
/);
=head1 NAME
File in Perl format, which should return a HASH reference, from which to read
loader options.
+=head1 preserve_case
+
+Usually column names are lowercased, to make them easier to work with in
+L<DBIx::Class>. This option lets you turn this behavior off, if the driver
+supports it.
+
+Drivers for case sensitive databases like Sybase ASE or MSSQL with a
+case-sensitive collation will turn this option on unconditionally.
+
+Currently the drivers for SQLite, mysql, MSSQL and Firebird/InterBase support
+setting this option.
+
=head1 METHODS
None of these methods are intended for direct invocation by regular
my $cols = $self->_table_columns($table);
my $col_info = $self->__columns_info_for($table);
- if ($self->_is_case_sensitive) {
+ if ($self->preserve_case) {
for my $col (keys %$col_info) {
$col_info->{$col}{accessor} = lc $col
if $col ne lc($col);
return $qt . $table . $qt;
}
-sub _is_case_sensitive { 0 }
-
sub _custom_column_info {
my ( $self, $table_name, $column_name, $column_info ) = @_;
return $result;
}
+sub _lc {
+ my ($self, $name) = @_;
+
+ return $self->preserve_case ? $name : lc($name);
+}
+
+sub _uc {
+ my ($self, $name) = @_;
+
+ return $self->preserve_case ? $name : uc($name);
+}
+
# remove the dump dir from @INC on destruction
sub DESTROY {
my $self = shift;
my $sth = $self->_sth_for($table, undef, \'1 = 0');
$sth->execute;
- my $retval = $self->_is_case_sensitive ? \@{$sth->{NAME}} : \@{$sth->{NAME_lc}};
+ my $retval = $self->preserve_case ? \@{$sth->{NAME}} : \@{$sth->{NAME_lc}};
$sth->finish;
$retval;
my %result;
my $sth = $self->_sth_for($table, undef, \'1 = 0');
$sth->execute;
- my @columns = @{ $self->_is_case_sensitive ? $sth->{NAME} : $sth->{NAME_lc} };
+ my @columns = @{ $self->preserve_case ? $sth->{NAME} : $sth->{NAME_lc} };
for my $i ( 0 .. $#columns ){
my $column_info = {};
$column_info->{data_type} = lc $sth->{TYPE}->[$i];
my $dbh = $self->schema->storage->dbh;
$self->{db_schema} ||= $dbh->selectrow_array('VALUES(CURRENT_USER)', {});
+
+ if (not defined $self->preserve_case) {
+ $self->preserve_case(0);
+ }
}
sub _table_uniq_info {
use Carp::Clan qw/^DBIx::Class/;
use List::Util 'first';
-__PACKAGE__->mk_group_ro_accessors('simple', qw/
- unquoted_ddl
-/);
-
our $VERSION = '0.07000';
=head1 NAME
=head1 DESCRIPTION
-See L<DBIx::Class::Schema::Loader::Base> for available options.
+See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
+
+=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.
-See the L</unquoted_ddl> option in this driver if you would like to have
-lowercase column names.
-
-=head1 DRIVER OPTIONS
-
-=head2 unquoted_ddl
+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 this loader option if your DDL uses unquoted identifiers and you will not
-use quoting (the L<quote_char|DBIx::Class::Storage::DBI/quote_char> option in
+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>.)
+Be careful to also not use any SQL reserved words in your DDL.
+
This will generate lowercase column names (as opposed to the actual uppercase
names) in your Result classes that will only work with quoting off.
Mixed-case table and column names will be ignored when this option is on and
will not work with quoting turned off.
-=cut
-
-sub _is_case_sensitive {
- my $self = shift;
+B<NOTE:> This option used to be called C<unquoted_ddl> but has been removed in
+favor of the more generic option.
- return $self->unquoted_ddl ? 0 : 1;
-}
+=cut
sub _setup {
my $self = shift;
- $self->next::method;
+ $self->next::method(@_);
$self->schema->storage->sql_maker->name_sep('.');
- if (not defined $self->unquoted_ddl) {
+ if (not defined $self->preserve_case) {
warn <<'EOF';
-WARNING: Assuming mixed-case Firebird DDL, see the unquoted_ddl option in
+WARNING: Assuming mixed-case 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);
}
- if (not $self->unquoted_ddl) {
+ if ($self->preserve_case) {
$self->schema->storage->sql_maker->quote_char('"');
}
else {
}
}
-sub _lc {
- my ($self, $name) = @_;
-
- return $self->unquoted_ddl ? lc($name) : $name;
-}
-
-sub _uc {
- my ($self, $name) = @_;
-
- return $self->unquoted_ddl ? uc($name) : $name;
-}
-
sub _table_pk_info {
my ($self, $table) = @_;
use Carp::Clan qw/^DBIx::Class/;
use Class::C3;
-__PACKAGE__->mk_group_accessors('simple', qw/
- case_sensitive_collation
-/);
-
our $VERSION = '0.07000';
=head1 NAME
To manually control case-sensitive mode, put:
- case_sensitive_collation => 1|0
+ preserve_case => 1|0
in your Loader options.
-=cut
+See L<preserve_case|DBIx::Class::Schema::Loader::Base/preserve_case>.
-sub _is_case_sensitive {
- my $self = shift;
+B<NOTE:> this option used to be called C<case_sensitive_collation>, but has
+been renamed to a more generic option.
- return $self->case_sensitive_collation ? 1 : 0;
-}
+=cut
sub _setup {
my $self = shift;
- $self->next::method;
+ $self->next::method(@_);
- return if defined $self->case_sensitive_collation;
+ return if defined $self->preserve_case;
my $dbh = $self->schema->storage->dbh;
warn <<'EOF';
WARNING: MSSQL Collation detection failed. Defaulting to case-insensitive mode.
-Override the 'case_sensitive_collation' attribute in your Loader options if
-needed.
+Override the 'preserve_case' attribute in your Loader options if needed.
+
+See 'preserve_case' in
+perldoc DBIx::Class::Schema::Loader::Base
EOF
- $self->case_sensitive_collation(0);
+ $self->preserve_case(0);
return;
}
my $case_sensitive = $collation_name =~ /_(?:CS|BIN2?)(?:_|\z)/;
- $self->case_sensitive_collation($case_sensitive ? 1 : 0);
-}
-
-sub _lc {
- my ($self, $name) = @_;
-
- return $self->case_sensitive_collation ? $name : lc($name);
+ $self->preserve_case($case_sensitive ? 1 : 0);
}
sub _tables_list {
if (lc($self->db_schema) ne lc($current_schema)) {
$dbh->do('ALTER SESSION SET current_schema=' . $self->db_schema);
}
+
+ if (not defined $self->preserve_case) {
+ $self->preserve_case(0);
+ }
}
sub _table_as_sql {
my $self = shift;
$self->next::method(@_);
+
$self->{db_schema} ||= 'public';
-}
+ if (not defined $self->preserve_case) {
+ $self->preserve_case(0);
+ }
+}
sub _table_uniq_info {
my ($self, $table) = @_;
sub _setup {
my $self = shift;
+ $self->next::method(@_);
+
$self->{db_schema} ||=
($self->schema->storage->dbh->selectrow_array('select user'))[0];
+
+ if (not defined $self->preserve_case) {
+ $self->preserve_case(0);
+ }
}
sub _tables_list {
DBIx::Class::Schema::Loader::DBI::SQLite - DBIx::Class::Schema::Loader::DBI SQLite Implementation.
-=head1 SYNOPSIS
-
- package My::Schema;
- use base qw/DBIx::Class::Schema::Loader/;
-
- __PACKAGE__->loader_options( debug => 1 );
-
- 1;
-
=head1 DESCRIPTION
-See L<DBIx::Class::Schema::Loader::Base>.
+See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
=head1 METHODS
=head2 rescan
-SQLite will fail all further commands on a connection if the
-underlying schema has been modified. Therefore, any runtime
-changes requiring C<rescan> also require us to re-connect
-to the database. The C<rescan> method here handles that
-reconnection for you, but beware that this must occur for
-any other open sqlite connections as well.
+SQLite will fail all further commands on a connection if the underlying schema
+has been modified. Therefore, any runtime changes requiring C<rescan> also
+require us to re-connect to the database. The C<rescan> method here handles
+that reconnection for you, but beware that this must occur for any other open
+sqlite connections as well.
=cut
+sub _setup {
+ my $self = shift;
+
+ $self->next::method(@_);
+
+ if (not defined $self->preserve_case) {
+ $self->preserve_case(0);
+ }
+}
+
sub rescan {
my ($self, $schema) = @_;
my $rel = $rels[ $fk->{id} ] ||= {
local_columns => [],
remote_columns => undef,
- remote_table => lc $fk->{table}
+ remote_table => $fk->{table}
};
- push @{ $rel->{local_columns} }, lc $fk->{from};
- push @{ $rel->{remote_columns} }, lc $fk->{to} if defined $fk->{to};
+ push @{ $rel->{local_columns} }, $self->_lc($fk->{from});
+ push @{ $rel->{remote_columns} }, $self->_lc($fk->{to}) if defined $fk->{to};
warn "This is supposed to be the same rel but remote_table changed from ",
$rel->{remote_table}, " to ", $fk->{table}
- if $rel->{remote_table} ne lc $fk->{table};
+ if $rel->{remote_table} ne $fk->{table};
}
$sth->finish;
return \@rels;
$get_idx_sth->execute;
my @cols;
while (my $idx_row = $get_idx_sth->fetchrow_hashref) {
- push @cols, lc $idx_row->{name};
+ push @cols, $self->_lc($idx_row->{name});
}
$get_idx_sth->finish;
push @uniqs, [ $name => \@cols ];
=cut
-sub _is_case_sensitive { 1 }
+sub _setup {
+ my $self = shift;
+
+ $self->next::method(@_);
+
+ if (not defined $self->preserve_case) {
+ $self->preserve_case(1);
+ }
+}
sub _rebless {
my $self = shift;
=cut
+sub _setup {
+ my $self = shift;
+
+ $self->next::method(@_);
+
+ if (not defined $self->preserve_case) {
+ $self->preserve_case(0);
+ }
+}
+
sub _tables_list {
my ($self, $opts) = @_;
my $f_table = shift @reldata;
my $f_cols = shift @reldata;
- my @cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; lc $_ }
+ my @cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; $self->_lc($_) }
split(/$qt?\s*$qt?,$qt?\s*$qt?/, $cols);
- my @f_cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; lc $_ }
+ my @f_cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; $self->_lc($_) }
split(/$qt?\s*$qt?,$qt?\s*$qt?/, $f_cols);
push(@rels, {
while(my $row = $sth->fetchrow_hashref) {
next if $row->{Non_unique};
push(@{$keydata{$row->{Key_name}}},
- [ $row->{Seq_in_index}, lc $row->{Column_name} ]
+ [ $row->{Seq_in_index}, $self->_lc($row->{Column_name}) ]
);
}
foreach my $keyname (keys %keydata) {
'smallint' => { data_type => 'smallint' },
'int' => { data_type => 'int' },
'integer' => { data_type => 'integer' },
+
+ # test that type name is lowercased
+ 'INTEGER' => { data_type => 'integer' },
+
'bigint' => { data_type => 'bigint' },
'float' => { data_type => 'float' },
'double precision' =>
ok ((my $rsrc = $schema->resultset($monikers->{mssql_loader_test5})->result_source),
'got result_source');
- if ($schema->_loader->_is_case_sensitive) {
+ if ($schema->_loader->preserve_case) {
is_deeply [ $rsrc->columns ], [qw/Id FooCol BarCol/],
'column name case is preserved with case-sensitive collation';
);
},
null => '',
- loader_options => { unquoted_ddl => 1 },
+ loader_options => { preserve_case => 0 },
connect_info => [ ($dbd_interbase_dsn ? {
dsn => $dbd_interbase_dsn,
user => $dbd_interbase_user,
my $guard = Scope::Guard->new(\&cleanup_extra);
- delete $schema->_loader->{unquoted_ddl};
+ delete $schema->_loader->{preserve_case};
my $warning;
{
local $SIG{__WARN__} = sub { $warning = shift };
$schema->_loader->_setup;
}
- like $warning, qr/unquoted_ddl option/,
- 'warning mentions unquoted_ddl option';
+ like $warning, qr/'preserve_case' option/,
+ 'warning mentions preserve_case option';
{
local $SIG{__WARN__} = sub {};
my %seen_col_names;
while (my ($col_def, $expected_info) = each %$types) {
- (my $type_alias = lc($col_def)) =~ s/\( ([^)]+) \)//xg;
+ (my $type_alias = $col_def) =~ s/\( ([^)]+) \)//xg;
my $size = $1;
$size = '' unless defined $size;
$col_name .= "_sz_$size_name";
}
- $col_name .= "_$seen_col_names{$col_name}" if $seen_col_names{$col_name}++;
+ # XXX would be better to check _loader->preserve_case
+ $col_name = lc $col_name;
+
+ $col_name .= '_' . $seen_col_names{$col_name} if $seen_col_names{$col_name}++;
$ddl .= " $col_name $col_def,\n";
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff