use base qw/DBIx::Class::Schema::Loader::Base/;
use mro 'c3';
use Try::Tiny;
-use List::MoreUtils 'any';
+use List::Util 'any';
use Carp::Clan qw/^DBIx::Class/;
use namespace::clean;
use DBIx::Class::Schema::Loader::Table ();
-our $VERSION = '0.07036_03';
+our $VERSION = '0.07049';
__PACKAGE__->mk_group_accessors('simple', qw/
_disable_pk_detection
my $self = shift;
my $quote_char = $self->dbh->get_info(29)
- || $self->schema->storage->sql_maker->quote_char
- || q{"};
+ || $self->schema->storage->sql_maker->quote_char
+ || q{"};
# For our usage as regex matches, concatenating multiple quote_char
# values works fine (e.g. s/[\Q<>\E]// if quote_char was [ '<', '>' ])
sub _build_name_sep {
my $self = shift;
return $self->dbh->get_info(41)
- || $self->schema->storage->sql_maker->name_sep
- || '.';
+ || $self->schema->storage->sql_maker->name_sep
+ || '.';
}
# Override this in vendor modules to do things at the end of ->new()
}
sub _dbh_tables {
- my ($self, $schema) = (shift, shift);
-
- my ($table_pattern, $table_type_pattern) = @_ ? @_ : ('%', '%');
+ my $self = shift;
- return $self->dbh->tables(undef, $schema, $table_pattern, $table_type_pattern);
+ return $self->dbh->tables(undef, @_);
}
# default to be overridden in subclasses if necessary
# Returns an array of table objects
sub _tables_list {
- my ($self, $opts) = (shift, shift);
+ my ($self) = @_;
my @tables;
my $nns = qr/[^\Q$self->{name_sep}\E]/;
foreach my $schema (@{ $self->db_schema || [undef] }) {
- my @raw_table_names = $self->_dbh_tables($schema, @_);
+ my @raw_table_names = $self->_dbh_tables($schema);
TABLE: foreach my $raw_table_name (@raw_table_names) {
my $quoted = $raw_table_name =~ /^$qt/;
if (ref $system_schema) {
$matches = 1
if $schema_name =~ $system_schema
- && $schema !~ $system_schema;
+ && $schema !~ $system_schema;
}
else {
$matches = 1
}
}
- return $self->_filter_tables(\@tables, $opts);
+ return $self->_filter_tables(\@tables);
}
sub _recurse_constraint {
# apply constraint/exclude and ignore bad tables and views
sub _filter_tables {
- my ($self, $tables, $opts) = @_;
+ my ($self, $tables) = @_;
my @tables = @$tables;
my @filtered_tables;
- $opts ||= {};
- @tables = _check_constraint(1, $opts->{constraint}, @tables);
- @tables = _check_constraint(0, $opts->{exclude}, @tables);
+ @tables = _check_constraint(1, $self->constraint, @tables);
+ @tables = _check_constraint(0, $self->exclude, @tables);
TABLE: for my $table (@tables) {
try {
local $self->dbh->{PrintError} = 0;
$self->next::method(@_);
-
- $self->schema->storage->disconnect unless $self->dynamic;
}
sub _sth_for {
my ($self, $table, $fields, $where) = @_;
my $sth = $self->dbh->prepare($self->schema->storage->sql_maker
- ->select(\$table->sql_name, $fields, $where));
+ ->select(\$table->sql_name, $fields || \'*', $where));
return $sth;
}
next if $row->{TYPE} eq 'table'
|| defined $row->{FILTER_CONDITION}
|| !$row->{INDEX_NAME}
- || !defined $row->{ORDINAL_POSITION}
- || !$row->{COLUMN_NAME};
+ || !defined $row->{ORDINAL_POSITION};
- $indices{$row->{INDEX_NAME}}[$row->{ORDINAL_POSITION}] = $self->_lc($row->{COLUMN_NAME});
+ $indices{$row->{INDEX_NAME}}[$row->{ORDINAL_POSITION}] = $self->_lc($row->{COLUMN_NAME} || '');
}
$sth->finish;
my @retval;
- foreach my $index_name (keys %indices) {
- my $index = $indices{$index_name};
- push(@retval, [ $index_name => [ @$index[1..$#$index] ] ]);
+ foreach my $index_name (sort keys %indices) {
+ my (undef, @cols) = @{$indices{$index_name}};
+ # skip indexes with missing column names (e.g. expression indexes)
+ next unless @cols == grep $_, @cols;
+ push(@retval, [ $index_name => \@cols ]);
}
return \@retval;
EOF
# Failback: try the REMARKS column on table_info
- if (!$comment && $dbh->can('table_info')) {
- my $sth = $self->_dbh_table_info( $dbh, undef, $table->schema, $table->name );
- my $info = $sth->fetchrow_hashref();
- $comment = $info->{REMARKS};
+ if (!$comment) {
+ my $info = $self->_dbh_table_info( $dbh, $table );
+ $comment = $info->{REMARKS} if $info;
}
return $comment;
my $dbh = $self->schema->storage->dbh;
my %result;
+ my %raw_result;
if (my $sth = try { $self->_dbh_column_info($dbh, undef, $table->schema, $table->name, '%' ) }) {
COL_INFO: while (my $info = try { $sth->fetchrow_hashref } catch { +{} }) {
) || {};
$column_info = { %$column_info, %$extra_info };
+ $raw_result{$col_name} = $info;
$result{$col_name} = $column_info;
}
$sth->finish;
%result = %lc_result;
}
- return \%result;
+ return wantarray ? (\%result, \%raw_result) : \%result;
}
# Need to override this for the buggy Firebird ODBC driver.
# override to mask warnings if needed
sub _dbh_table_info {
- my ($self, $dbh) = (shift, shift);
+ my ($self, $dbh, $table) = (shift, shift, shift);
+
+ return undef if !$dbh->can('table_info');
+ my $sth = $dbh->table_info(undef, $table->schema, $table->name);
+ while (my $info = $sth->fetchrow_hashref) {
+ next if !$self->_table_info_matches($table, $info);
+ return $info;
+ }
+ return undef;
+}
+
+sub _table_info_matches {
+ my ($self, $table, $info) = @_;
- return $dbh->table_info(@_);
+ no warnings 'uninitialized';
+ return $info->{TABLE_SCHEM} eq $table->schema
+ && $info->{TABLE_NAME} eq $table->name;
}
# override to mask warnings if needed (see mysql)
return $self->schema->storage->dbh;
}
+sub _table_is_view {
+ my ($self, $table) = @_;
+
+ my $info = $self->_dbh_table_info($self->dbh, $table)
+ or return 0;
+ return $info->{TABLE_TYPE} eq 'VIEW';
+}
+
=head1 SEE ALSO
L<DBIx::Class::Schema::Loader>
-=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