X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI.pm;h=a7d6ddfaaf39aa07c4d99698475774e8495db569;hb=6ae3f335e1b67e8fdcb7b9a52cca64fd8c01af29;hp=3c19ca5994340d4490f71fb0916bd5c005365e40;hpb=12af3806fe7c49ea43e3589a8eb70cc881cd84fd;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm index 3c19ca5..a7d6ddf 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI.pm @@ -5,9 +5,8 @@ use warnings; use base qw/DBIx::Class::Schema::Loader::Base/; use Class::C3; use Carp::Clan qw/^DBIx::Class/; -use UNIVERSAL::require; -our $VERSION = '0.03999_01'; +our $VERSION = '0.04999_07'; =head1 NAME @@ -39,13 +38,13 @@ sub new { # rebless to vendor-specific class if it exists and loads my $dbh = $self->schema->storage->dbh; my $driver = $dbh->{Driver}->{Name}; + my $subclass = 'DBIx::Class::Schema::Loader::DBI::' . $driver; - $subclass->require; - if($@ && $@ !~ /^Can't locate /) { - croak "Failed to require $subclass: $@"; - } - elsif(!$@) { - bless $self, "DBIx::Class::Schema::Loader::DBI::${driver}"; + if ($self->ensure_class_found($subclass)) { + eval { $self->ensure_class_loaded($subclass) }; + croak "Failed to load $subclass: $@" if $@; + bless $self, $subclass unless $self->isa($subclass); + $self->_rebless(); } # Set up the default quoting character and name seperators @@ -71,6 +70,9 @@ sub new { # Override this in vendor modules to do things at the end of ->new() sub _setup { } +# Override this in vendor module to load a subclass if necessary +sub _rebless { } + # Returns an array of table names sub _tables_list { my $self = shift; @@ -107,14 +109,17 @@ sub _table_columns { $table = $self->{db_schema} . $self->{_namesep} . $table; } - my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0"); + my $sth = $dbh->prepare($self->schema->storage->sql_maker->select($table, undef, \'1 = 0')); $sth->execute; - return \@{$sth->{NAME_lc}}; + my $retval = \@{$sth->{NAME_lc}}; + $sth->finish; + + $retval; } # Returns arrayref of pk col names sub _table_pk_info { - my ( $self, $table ) = @_; + my ($self, $table) = @_; my $dbh = $self->schema->storage->dbh; @@ -124,10 +129,41 @@ sub _table_pk_info { return \@primary; } -# Override this for uniq info +# Override this for vendor-specific uniq info sub _table_uniq_info { - warn "No UNIQUE constraint information can be gathered for this vendor"; - return []; + my ($self, $table) = @_; + + my $dbh = $self->schema->storage->dbh; + if(!$dbh->can('statistics_info')) { + warn "No UNIQUE constraint information can be gathered for this vendor"; + return []; + } + + my %indices; + my $sth = $dbh->statistics_info(undef, $self->db_schema, $table, 1, 1); + while(my $row = $sth->fetchrow_hashref) { + # skip table-level stats, conditional indexes, and any index missing + # critical fields + next if $row->{TYPE} eq 'table' + || defined $row->{FILTER_CONDITION} + || !$row->{INDEX_NAME} + || !defined $row->{ORDINAL_POSITION} + || !$row->{COLUMN_NAME}; + + $indices{$row->{INDEX_NAME}}->{$row->{ORDINAL_POSITION}} = $row->{COLUMN_NAME}; + } + $sth->finish; + + my @retval; + foreach my $index_name (keys %indices) { + my $index = $indices{$index_name}; + push(@retval, [ $index_name => [ + map { $index->{$_} } + sort keys %$index + ]]); + } + + return \@retval; } # Find relationships @@ -135,8 +171,8 @@ sub _table_fk_info { my ($self, $table) = @_; my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->foreign_key_info( '', '', '', '', - $self->db_schema, $table ); + my $sth = $dbh->foreign_key_info( '', $self->db_schema, '', + '', $self->db_schema, $table ); return [] if !$sth; my %rels; @@ -154,6 +190,7 @@ sub _table_fk_info { $rels{$relid}->{tbl} = $uk_tbl; $rels{$relid}->{cols}->{$uk_col} = $fk_col; } + $sth->finish; my @rels; foreach my $relid (keys %rels) { @@ -177,7 +214,6 @@ sub _columns_info_for { my %result; eval { my $sth = $dbh->column_info( undef, $self->db_schema, $table, '%' ); - $sth->execute(); while ( my $info = $sth->fetchrow_hashref() ){ my %column_info; $column_info{data_type} = $info->{TYPE_NAME}; @@ -187,8 +223,11 @@ sub _columns_info_for { my $col_name = $info->{COLUMN_NAME}; $col_name =~ s/^\"(.*)\"$/$1/; - $result{$col_name} = \%column_info; + my $extra_info = $self->_extra_column_info($info) || {}; + + $result{$col_name} = { %column_info, %$extra_info }; } + $sth->finish; }; return \%result if !$@ && scalar keys %result; } @@ -197,18 +236,12 @@ sub _columns_info_for { $table = $self->db_schema . $self->{_namesep} . $table; } my %result; - my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0"); + my $sth = $dbh->prepare($self->schema->storage->sql_maker->select($table, undef, \'1 = 0')); $sth->execute; my @columns = @{$sth->{NAME_lc}}; for my $i ( 0 .. $#columns ){ my %column_info; - my $type_num = $sth->{TYPE}->[$i]; - my $type_name; - if(defined $type_num && $dbh->can('type_info')) { - my $type_info = $dbh->type_info($type_num); - $type_name = $type_info->{TYPE_NAME} if $type_info; - } - $column_info{data_type} = $type_name ? $type_name : $type_num; + $column_info{data_type} = $sth->{TYPE}->[$i]; $column_info{size} = $sth->{PRECISION}->[$i]; $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0; @@ -217,12 +250,29 @@ sub _columns_info_for { $column_info{size} = $2; } - $result{$columns[$i]} = \%column_info; + my $extra_info = $self->_extra_column_info($table, $columns[$i], $sth, $i) || {}; + + $result{$columns[$i]} = { %column_info, %$extra_info }; + } + $sth->finish; + + foreach my $col (keys %result) { + my $colinfo = $result{$col}; + my $type_num = $colinfo->{data_type}; + my $type_name; + if(defined $type_num && $dbh->can('type_info')) { + my $type_info = $dbh->type_info($type_num); + $type_name = $type_info->{TYPE_NAME} if $type_info; + $colinfo->{data_type} = $type_name if $type_name; + } } return \%result; } +# Override this in vendor class to return any additional column +# attributes +sub _extra_column_info {} =head1 SEE ALSO