X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI.pm;h=29122472b7f5aadf6026713c09e69b98e845217c;hb=d073740eae0165b8e07ac95d481feb1b2be36ee0;hp=9d6d0eab037a7aa213c518525b92f96807d2a8e6;hpb=a168c1c4a411941fd0e9d1cbf8cfc24761f71b20;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 9d6d0ea..2912247 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.04004'; +our $VERSION = '0.04999_13'; =head1 NAME @@ -39,24 +38,16 @@ 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->load_optional_class($subclass)) { + bless $self, $subclass unless $self->isa($subclass); + $self->_rebless; } # Set up the default quoting character and name seperators - $self->{_quoter} = $self->schema->storage->sql_maker->quote_char - || $dbh->get_info(29) - || q{"}; - - $self->{_namesep} = $self->schema->storage->sql_maker->name_sep - || $dbh->get_info(41) - || q{.}; - + $self->{_quoter} = $self->_build_quoter; + $self->{_namesep} = $self->_build_namesep; # For our usage as regex matches, concatenating multiple quoter # values works fine (e.g. s/\Q<>\E// if quoter was [ '<', '>' ]) if( ref $self->{_quoter} eq 'ARRAY') { @@ -68,19 +59,77 @@ sub new { $self; } +sub _build_quoter { + my $self = shift; + my $dbh = $self->schema->storage->dbh; + return $dbh->get_info(29) + || $self->schema->storage->sql_maker->quote_char + || q{"}; +} + +sub _build_namesep { + my $self = shift; + my $dbh = $self->schema->storage->dbh; + return $dbh->get_info(41) + || $self->schema->storage->sql_maker->name_sep + || q{.}; +} + # 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; + my ($table, $type) = @_ ? @_ : ('%', '%'); + my $dbh = $self->schema->storage->dbh; - my @tables = $dbh->tables(undef, $self->db_schema, '%', '%'); - s/\Q$self->{_quoter}\E//g for @tables; - s/^.*\Q$self->{_namesep}\E// for @tables; + my @tables = $dbh->tables(undef, $self->db_schema, $table, $type); + + my $qt = qr/\Q$self->{_quoter}\E/; + + if ($self->{_quoter} && $tables[0] =~ /$qt/) { + s/.* $qt (?= .* $qt)//xg for @tables; + } else { + s/^.*\Q$self->{_namesep}\E// for @tables; + } + s/$qt//g for @tables; - return @tables; + return $self->_filter_tables(@tables); +} + +# ignore bad tables and views +sub _filter_tables { + my ($self, @tables) = @_; + + my @filtered_tables; + + for my $table (@tables) { + eval { + my $sth = $self->_sth_for($table, undef, \'1 = 0'); + $sth->execute; + }; + if (not $@) { + push @filtered_tables, $table; + } + else { + warn "Bad table or view '$table', ignoring: $@\n"; + local $@; + eval { + my $schema = $self->schema; + # in older DBIC it's a private method + my $unregister = $schema->can('unregister_source') + || $schema->can('_unregister_source'); + $schema->$unregister($self->_table2moniker($table)); + }; + } + } + + return @filtered_tables; } =head2 load @@ -97,17 +146,35 @@ sub load { $self->next::method(@_); } -# Returns an arrayref of column names -sub _table_columns { +sub _table_as_sql { my ($self, $table) = @_; - my $dbh = $self->schema->storage->dbh; - if($self->{db_schema}) { - $table = $self->{db_schema} . $self->{_namesep} . $table; + $table = $self->{db_schema} . $self->{_namesep} . + $self->_quote_table_name($table); + } else { + $table = $self->_quote_table_name($table); } - my $sth = $dbh->prepare($self->schema->storage->sql_maker->select($table, undef, \'1 = 0')); + return $table; +} + +sub _sth_for { + my ($self, $table, $fields, $where) = @_; + + my $dbh = $self->schema->storage->dbh; + + my $sth = $dbh->prepare($self->schema->storage->sql_maker + ->select(\$self->_table_as_sql($table), $fields, $where)); + + return $sth; +} + +# Returns an arrayref of column names +sub _table_columns { + my ($self, $table) = @_; + + my $sth = $self->_sth_for($table, undef, \'1 = 0'); $sth->execute; my $retval = \@{$sth->{NAME_lc}}; $sth->finish; @@ -212,7 +279,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}; @@ -222,18 +288,17 @@ 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; } - 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')); + my $sth = $self->_sth_for($table, undef, \'1 = 0'); $sth->execute; my @columns = @{$sth->{NAME_lc}}; for my $i ( 0 .. $#columns ){ @@ -247,7 +312,9 @@ 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; @@ -265,10 +332,23 @@ sub _columns_info_for { return \%result; } +# Override this in vendor class to return any additional column +# attributes +sub _extra_column_info {} + =head1 SEE ALSO L +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + =cut 1;