X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI.pm;h=f27413d3d51d125d36e8d1153ae4d17c1cf22711;hb=41ef22da3417549e4b5eedd025cca17278bd1d72;hp=943c34f7c0b55f55d98ea05ffedda8a17d3489c5;hpb=fa994d3c6ada53f4610e6384fe924d4bf8163a68;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 943c34f..f27413d 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI.pm @@ -2,11 +2,13 @@ package DBIx::Class::Schema::Loader::DBI; use strict; use warnings; -use base qw/DBIx::Class::Schema::Loader::Base Class::Accessor::Fast/; +use base qw/DBIx::Class::Schema::Loader::Base/; use Class::C3; use Carp::Clan qw/^DBIx::Class/; use UNIVERSAL::require; +our $VERSION = '0.04999_06'; + =head1 NAME DBIx::Class::Schema::Loader::DBI - DBIx::Class::Schema::Loader DBI Implementation. @@ -43,7 +45,7 @@ sub new { croak "Failed to require $subclass: $@"; } elsif(!$@) { - bless $self, "DBIx::Class::Schema::Loader::DBI::${driver}"; + bless $self, $subclass unless $self->isa($subclass); } # Set up the default quoting character and name seperators @@ -81,6 +83,20 @@ sub _tables_list { return @tables; } +=head2 load + +We override L here to hook in our localized settings for C<$dbh> error handling. + +=cut + +sub load { + my $self = shift; + + local $self->schema->storage->dbh->{RaiseError} = 1; + local $self->schema->storage->dbh->{PrintError} = 0; + $self->next::method(@_); +} + # Returns an arrayref of column names sub _table_columns { my ($self, $table) = @_; @@ -91,14 +107,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; @@ -108,10 +127,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 @@ -119,8 +169,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; @@ -138,6 +188,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) { @@ -151,6 +202,76 @@ sub _table_fk_info { return \@rels; } +# ported in from DBIx::Class::Storage::DBI: +sub _columns_info_for { + my ($self, $table) = @_; + + my $dbh = $self->schema->storage->dbh; + + if ($dbh->can('column_info')) { + my %result; + eval { + my $sth = $dbh->column_info( undef, $self->db_schema, $table, '%' ); + while ( my $info = $sth->fetchrow_hashref() ){ + my %column_info; + $column_info{data_type} = $info->{TYPE_NAME}; + $column_info{size} = $info->{COLUMN_SIZE}; + $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0; + $column_info{default_value} = $info->{COLUMN_DEF}; + my $col_name = $info->{COLUMN_NAME}; + $col_name =~ s/^\"(.*)\"$/$1/; + + my $extra_info = $self->_extra_column_info($info) || {}; + + $result{$col_name} = { %column_info, %$extra_info }; + } + $sth->finish; + }; + return \%result if !$@ && scalar keys %result; + } + + if($self->db_schema) { + $table = $self->db_schema . $self->{_namesep} . $table; + } + my %result; + 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; + $column_info{data_type} = $sth->{TYPE}->[$i]; + $column_info{size} = $sth->{PRECISION}->[$i]; + $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0; + + if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) { + $column_info{data_type} = $1; + $column_info{size} = $2; + } + + 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 L