X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI.pm;h=6229cf8b505132000f3830cb18c5952404bbdc29;hb=refs%2Ftags%2F0.05003;hp=14474a85d1c00e6e931ff006ff3a422cca1effe2;hpb=457c3335f7fba02629f65407ad3bf515fe90887a;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 14474a8..6229cf8 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.04999_07'; +our $VERSION = '0.05003'; =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(!$@) { + 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,79 @@ 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"'`\[\]]/; + + my $all_tables_quoted = (grep /$qt/, @tables) == @tables; - return @tables; + if ($self->{_quoter} && $all_tables_quoted) { + s/.* $qt (?= .* $qt)//xg for @tables; + } else { + s/^.*\Q$self->{_namesep}\E// for @tables; + } + s/$qt//g for @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 +148,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; @@ -213,44 +282,43 @@ sub _columns_info_for { 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 $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) || {}; + $column_info = { %$column_info, %$extra_info }; - $result{$col_name} = { %column_info, %$extra_info }; + $result{$col_name} = $column_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 ){ - 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 $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) || {}; + $column_info = { %$column_info, %$extra_info }; - $result{$columns[$i]} = { %column_info, %$extra_info }; + $result{$columns[$i]} = $column_info; } $sth->finish; @@ -276,6 +344,15 @@ sub _extra_column_info {} 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;