use strict;
use warnings;
-use mro 'c3';
use base qw/DBIx::Class::Schema::Loader::DBI/;
+use mro 'c3';
use Carp::Clan qw/^DBIx::Class/;
use List::Util 'first';
use namespace::clean;
+use DBIx::Class::Schema::Loader::Table ();
+
+our $VERSION = '0.07047';
-our $VERSION = '0.07005';
+sub _supports_db_schema { 0 }
=head1 NAME
=head1 COLUMN NAME CASE ISSUES
By default column names from unquoted DDL will be generated in lowercase, for
-consistency with other backends.
+consistency with other backends.
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
$self->next::method(@_);
if (not defined $self->preserve_case) {
- warn <<'EOF';
-
-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(0);
}
-
- if ($self->preserve_case) {
+ elsif ($self->preserve_case) {
$self->schema->storage->sql_maker->quote_char('"');
$self->schema->storage->sql_maker->name_sep('.');
}
- else {
- $self->schema->storage->sql_maker->quote_char(undef);
- $self->schema->storage->sql_maker->name_sep(undef);
+
+ if ($self->db_schema) {
+ carp "db_schema is not supported on Firebird";
+
+ if ($self->db_schema->[0] eq '%') {
+ $self->db_schema(undef);
+ }
}
}
sub _table_pk_info {
my ($self, $table) = @_;
- my $dbh = $self->schema->storage->dbh;
- my $sth = $dbh->prepare(<<'EOF');
+ my $sth = $self->dbh->prepare(<<'EOF');
SELECT iseg.rdb$field_name
FROM rdb$relation_constraints rc
JOIN rdb$index_segments iseg ON rc.rdb$index_name = iseg.rdb$index_name
WHERE rc.rdb$constraint_type = 'PRIMARY KEY' and rc.rdb$relation_name = ?
ORDER BY iseg.rdb$field_position
EOF
- $sth->execute($table);
+ $sth->execute($table->name);
my @keydata;
my ($self, $table) = @_;
my ($local_cols, $remote_cols, $remote_table, @rels);
- my $dbh = $self->schema->storage->dbh;
- my $sth = $dbh->prepare(<<'EOF');
+ my $sth = $self->dbh->prepare(<<'EOF');
SELECT rc.rdb$constraint_name fk, iseg.rdb$field_name local_col, ri.rdb$relation_name remote_tab, riseg.rdb$field_name remote_col
FROM rdb$relation_constraints rc
JOIN rdb$index_segments iseg ON rc.rdb$index_name = iseg.rdb$index_name
WHERE rc.rdb$constraint_type = 'FOREIGN KEY' and rc.rdb$relation_name = ?
ORDER BY iseg.rdb$field_position
EOF
- $sth->execute($table);
+ $sth->execute($table->name);
while (my ($fk, $local_col, $remote_tab, $remote_col) = $sth->fetchrow_array) {
s/^\s+//, s/\s+\z// for $fk, $local_col, $remote_tab, $remote_col;
push @{$local_cols->{$fk}}, $self->_lc($local_col);
push @{$remote_cols->{$fk}}, $self->_lc($remote_col);
- $remote_table->{$fk} = $remote_tab;
+ $remote_table->{$fk} = DBIx::Class::Schema::Loader::Table->new(
+ loader => $self,
+ name => $remote_tab,
+ ($self->db_schema ? (
+ schema => $self->db_schema->[0],
+ ignore_schema => 1,
+ ) : ()),
+ );
}
- foreach my $fk (keys %$remote_table) {
+ foreach my $fk (sort keys %$remote_table) {
push @rels, {
local_columns => $local_cols->{$fk},
remote_columns => $remote_cols->{$fk},
sub _table_uniq_info {
my ($self, $table) = @_;
- my $dbh = $self->schema->storage->dbh;
- my $sth = $dbh->prepare(<<'EOF');
+ my $sth = $self->dbh->prepare(<<'EOF');
SELECT rc.rdb$constraint_name, iseg.rdb$field_name
FROM rdb$relation_constraints rc
JOIN rdb$index_segments iseg ON rc.rdb$index_name = iseg.rdb$index_name
WHERE rc.rdb$constraint_type = 'UNIQUE' and rc.rdb$relation_name = ?
ORDER BY iseg.rdb$field_position
EOF
- $sth->execute($table);
+ $sth->execute($table->name);
my $constraints;
while (my ($constraint_name, $column) = $sth->fetchrow_array) {
push @{$constraints->{$constraint_name}}, $self->_lc($column);
}
- my @uniqs = map { [ $_ => $constraints->{$_} ] } keys %$constraints;
- return \@uniqs;
+ return [ map { [ $_ => $constraints->{$_} ] } sort keys %$constraints ];
}
sub _columns_info_for {
my $result = $self->next::method(@_);
- my $dbh = $self->schema->storage->dbh;
-
- local $dbh->{LongReadLen} = 100000;
- local $dbh->{LongTruncOk} = 1;
+ local $self->dbh->{LongReadLen} = 100000;
+ local $self->dbh->{LongTruncOk} = 1;
while (my ($column, $info) = each %$result) {
- my $sth = $dbh->prepare(<<'EOF');
+ my $data_type = $info->{data_type};
+
+ my $sth = $self->dbh->prepare(<<'EOF');
SELECT t.rdb$trigger_source
FROM rdb$triggers t
WHERE t.rdb$relation_name = ?
AND t.rdb$system_flag = 0 -- user defined
AND t.rdb$trigger_type = 1 -- BEFORE INSERT
EOF
- $sth->execute($table);
+ $sth->execute($table->name);
while (my ($trigger) = $sth->fetchrow_array) {
my @trig_cols = map { /^"([^"]+)/ ? $1 : uc($_) } $trigger =~ /new\.("?\w+"?)/ig;
}
# fix up types
- $sth = $dbh->prepare(<<'EOF');
-SELECT f.rdb$field_precision, f.rdb$field_scale, f.rdb$field_type, f.rdb$field_sub_type, t.rdb$type_name, st.rdb$type_name
+ $sth = $self->dbh->prepare(<<'EOF');
+SELECT f.rdb$field_precision, f.rdb$field_scale, f.rdb$field_type, f.rdb$field_sub_type, f.rdb$character_set_id, f.rdb$character_length, t.rdb$type_name, st.rdb$type_name
FROM rdb$fields f
JOIN rdb$relation_fields rf ON rf.rdb$field_source = f.rdb$field_name
LEFT JOIN rdb$types t ON f.rdb$field_type = t.rdb$type AND t.rdb$field_name = 'RDB$FIELD_TYPE'
WHERE rf.rdb$relation_name = ?
AND rf.rdb$field_name = ?
EOF
- $sth->execute($table, $self->_uc($column));
- my ($precision, $scale, $type_num, $sub_type_num, $type_name, $sub_type_name) = $sth->fetchrow_array;
+ $sth->execute($table->name, $self->_uc($column));
+ my ($precision, $scale, $type_num, $sub_type_num, $char_set_id, $char_length, $type_name, $sub_type_name) = $sth->fetchrow_array;
$scale = -$scale if $scale && $scale < 0;
if ($type_name && $sub_type_name) {
s/\s+\z// for $type_name, $sub_type_name;
# fixups primarily for DBD::InterBase
- if ($info->{data_type} =~ /^(?:integer|int|smallint|bigint|-9581)\z/) {
+ if ($data_type =~ /^(?:integer|int|smallint|bigint|-9581)\z/) {
if ($precision && $type_name =~ /^(?:LONG|INT64)\z/ && $sub_type_name eq 'BLR') {
$info->{data_type} = 'decimal';
}
$info->{data_type} = 'blob';
}
elsif ($sub_type_name eq 'TEXT') {
- $info->{data_type} = 'blob sub_type text';
+ if (defined $char_set_id && $char_set_id == 3) {
+ $info->{data_type} = 'blob sub_type text character set unicode_fss';
+ }
+ else {
+ $info->{data_type} = 'blob sub_type text';
+ }
}
}
}
- if ($info->{data_type} =~ /^(?:decimal|numeric)\z/ && defined $precision && defined $scale) {
+ $data_type = $info->{data_type};
+
+ if ($data_type =~ /^(?:decimal|numeric)\z/ && defined $precision && defined $scale) {
if ($precision == 9 && $scale == 0) {
delete $info->{size};
}
}
}
- if ($info->{data_type} eq '11') {
+ if ($data_type eq '11') {
$info->{data_type} = 'timestamp';
}
- elsif ($info->{data_type} eq '10') {
+ elsif ($data_type eq '10') {
$info->{data_type} = 'time';
}
- elsif ($info->{data_type} eq '9') {
+ elsif ($data_type eq '9') {
$info->{data_type} = 'date';
}
- elsif ($info->{data_type} eq 'character varying') {
+ elsif ($data_type eq 'character varying') {
$info->{data_type} = 'varchar';
}
- elsif ($info->{data_type} eq 'character') {
+ elsif ($data_type eq 'character') {
$info->{data_type} = 'char';
}
- elsif ($info->{data_type} eq 'float') {
+ elsif ($data_type eq 'float') {
$info->{data_type} = 'real';
}
- elsif ($info->{data_type} eq 'int64' || $info->{data_type} eq '-9581') {
+ elsif ($data_type eq 'int64' || $data_type eq '-9581') {
# the constant is just in case, the query should pick up the type
$info->{data_type} = 'bigint';
}
- # DBD::InterBase sets scale to '0' for some reason for char types
- if ($info->{data_type} =~ /^(?:char|varchar)\z/ && ref($info->{size}) eq 'ARRAY') {
- $info->{size} = $info->{size}[0];
+ $data_type = $info->{data_type};
+
+ if ($data_type =~ /^(?:char|varchar)\z/) {
+ $info->{size} = $char_length;
+
+ if (defined $char_set_id && $char_set_id == 3) {
+ $info->{data_type} .= '(x) character set unicode_fss';
+ }
}
- elsif ($info->{data_type} !~ /^(?:char|varchar|numeric|decimal)\z/) {
+ elsif ($data_type !~ /^(?:numeric|decimal)\z/) {
delete $info->{size};
}
# get default
delete $info->{default_value} if $info->{default_value} && $info->{default_value} eq 'NULL';
- $sth = $dbh->prepare(<<'EOF');
+ $sth = $self->dbh->prepare(<<'EOF');
SELECT rf.rdb$default_source
FROM rdb$relation_fields rf
WHERE rf.rdb$relation_name = ?
AND rf.rdb$field_name = ?
EOF
- $sth->execute($table, $self->_uc($column));
+ $sth->execute($table->name, $self->_uc($column));
my ($default_src) = $sth->fetchrow_array;
if ($default_src && (my ($def) = $default_src =~ /^DEFAULT \s+ (\S+)/ix)) {
return $result;
}
+sub _view_definition {
+ my ($self, $view) = @_;
+
+ return scalar $self->schema->storage->dbh->selectrow_array(<<'EOF', {}, $view->name);
+SELECT rdb$view_source
+FROM rdb$relations
+WHERE rdb$relation_name = ?
+EOF
+}
+
=head1 SEE ALSO
L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
L<DBIx::Class::Schema::Loader::DBI>
-=head1 AUTHOR
+=head1 AUTHORS
-See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHORS>.
=head1 LICENSE
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff