Release 0.07043
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / DBI.pm
CommitLineData
996be9ee 1package DBIx::Class::Schema::Loader::DBI;
2
3use strict;
4use warnings;
abaf2c66 5use base qw/DBIx::Class::Schema::Loader::Base/;
942bd5e0 6use mro 'c3';
61d1cca1 7use Try::Tiny;
ecf22f0a 8use List::Util 'any';
116431d6 9use Carp::Clan qw/^DBIx::Class/;
61d1cca1 10use namespace::clean;
c4a69b87 11use DBIx::Class::Schema::Loader::Table ();
996be9ee 12
6bef6696 13our $VERSION = '0.07043';
32f784fc 14
3b17d988 15__PACKAGE__->mk_group_accessors('simple', qw/
16 _disable_pk_detection
17 _disable_uniq_detection
18 _disable_fk_detection
19 _passwords
c4a69b87 20 quote_char
21 name_sep
3b17d988 22/);
23
996be9ee 24=head1 NAME
25
26DBIx::Class::Schema::Loader::DBI - DBIx::Class::Schema::Loader DBI Implementation.
27
28=head1 SYNOPSIS
29
30See L<DBIx::Class::Schema::Loader::Base>
31
32=head1 DESCRIPTION
33
34This is the base class for L<DBIx::Class::Schema::Loader::Base> classes for
35DBI-based storage backends, and implements the common functionality between them.
36
37See L<DBIx::Class::Schema::Loader::Base> for the available options.
38
39=head1 METHODS
40
41=head2 new
42
43Overlays L<DBIx::Class::Schema::Loader::Base/new> to do some DBI-specific
44things.
45
46=cut
47
48sub new {
49 my $self = shift->next::method(@_);
50
71a6e88a 51 # rebless to vendor-specific class if it exists and loads and we're not in a
52 # custom class.
53 if (not $self->loader_class) {
c4a69b87 54 my $driver = $self->dbh->{Driver}->{Name};
71a6e88a 55
56 my $subclass = 'DBIx::Class::Schema::Loader::DBI::' . $driver;
383bd2a8 57 if ((not $self->isa($subclass)) && $self->load_optional_class($subclass)) {
58 bless $self, $subclass;
71a6e88a 59 $self->_rebless;
383bd2a8 60 Class::C3::reinitialize() if $] < 5.009005;
71a6e88a 61 }
996be9ee 62 }
63
dee01f3b 64 # Set up the default quoting character and name separators
c4a69b87 65 $self->quote_char($self->_build_quote_char);
66 $self->name_sep($self->_build_name_sep);
996be9ee 67
68 $self->_setup;
69
383bd2a8 70 return $self;
996be9ee 71}
72
c4a69b87 73sub _build_quote_char {
77d3753e 74 my $self = shift;
c4a69b87 75
76 my $quote_char = $self->dbh->get_info(29)
77d3753e 77 || $self->schema->storage->sql_maker->quote_char
78 || q{"};
c4a69b87 79
80 # For our usage as regex matches, concatenating multiple quote_char
81 # values works fine (e.g. s/[\Q<>\E]// if quote_char was [ '<', '>' ])
82 if (ref $quote_char eq 'ARRAY') {
83 $quote_char = join '', @$quote_char;
84 }
85
86 return $quote_char;
77d3753e 87}
88
c4a69b87 89sub _build_name_sep {
77d3753e 90 my $self = shift;
c4a69b87 91 return $self->dbh->get_info(41)
77d3753e 92 || $self->schema->storage->sql_maker->name_sep
c4a69b87 93 || '.';
77d3753e 94}
95
996be9ee 96# Override this in vendor modules to do things at the end of ->new()
97sub _setup { }
98
6ae3f335 99# Override this in vendor module to load a subclass if necessary
100sub _rebless { }
101
c4a69b87 102sub _system_schemas {
103 return ('information_schema');
104}
105
106sub _system_tables {
107 return ();
108}
109
110sub _dbh_tables {
36c8c37c 111 my $self = shift;
c4a69b87 112
36c8c37c 113 return $self->dbh->tables(undef, @_);
c4a69b87 114}
115
116# default to be overridden in subclasses if necessary
117sub _supports_db_schema { 1 }
118
119# Returns an array of table objects
a40434df 120sub _tables_list {
bfb43060 121 my ($self, $opts) = (shift, shift);
996be9ee 122
c4a69b87 123 my @tables;
124
125 my $qt = qr/[\Q$self->{quote_char}\E"'`\[\]]/;
126 my $nqt = qr/[^\Q$self->{quote_char}\E"'`\[\]]/;
127 my $ns = qr/[\Q$self->{name_sep}\E]/;
128 my $nns = qr/[^\Q$self->{name_sep}\E]/;
129
130 foreach my $schema (@{ $self->db_schema || [undef] }) {
131 my @raw_table_names = $self->_dbh_tables($schema, @_);
132
133 TABLE: foreach my $raw_table_name (@raw_table_names) {
134 my $quoted = $raw_table_name =~ /^$qt/;
135
136 # These regexes are not entirely correct, but hopefully they will work
137 # in most cases. RT reports welcome.
138 my ($schema_name, $table_name1, $table_name2) = $quoted ?
139 $raw_table_name =~ /^(?:${qt}(${nqt}+?)${qt}${ns})?(?:${qt}(.+?)${qt}|(${nns}+))\z/
140 :
141 $raw_table_name =~ /^(?:(${nns}+?)${ns})?(?:${qt}(.+?)${qt}|(${nns}+))\z/;
142
143 my $table_name = $table_name1 || $table_name2;
144
145 foreach my $system_schema ($self->_system_schemas) {
146 if ($schema_name) {
147 my $matches = 0;
148
149 if (ref $system_schema) {
150 $matches = 1
151 if $schema_name =~ $system_schema
152 && $schema !~ $system_schema;
153 }
154 else {
155 $matches = 1
156 if $schema_name eq $system_schema
157 && $schema ne $system_schema;
158 }
159
160 next TABLE if $matches;
161 }
162 }
163
164 foreach my $system_table ($self->_system_tables) {
165 my $matches = 0;
e57fd726 166
c4a69b87 167 if (ref $system_table) {
168 $matches = 1 if $table_name =~ $system_table;
169 }
170 else {
171 $matches = 1 if $table_name eq $system_table
172 }
77d3753e 173
c4a69b87 174 next TABLE if $matches;
175 }
176
177 $schema_name ||= $schema;
385c593b 178
c4a69b87 179 my $table = DBIx::Class::Schema::Loader::Table->new(
180 loader => $self,
181 name => $table_name,
182 schema => $schema_name,
183 ($self->_supports_db_schema ? () : (
184 ignore_schema => 1
185 )),
186 );
c5ff1f26 187
c4a69b87 188 push @tables, $table;
189 }
385c593b 190 }
996be9ee 191
bfb43060 192 return $self->_filter_tables(\@tables, $opts);
075aff97 193}
194
b187901e 195sub _recurse_constraint {
196 my ($constraint, @parts) = @_;
197
198 my $name = shift @parts;
199
200 # If there are any parts left, the constraint must be an arrayref
201 croak "depth of constraint/exclude array does not match length of moniker_parts"
202 unless !!@parts == !!(ref $constraint eq 'ARRAY');
203
204 # if ths is the last part, use the constraint directly
205 return $name =~ $constraint unless @parts;
206
207 # recurse into the first matching subconstraint
208 foreach (@{$constraint}) {
209 my ($re, $sub) = @{$_};
210 return _recurse_constraint($sub, @parts)
211 if $name =~ $re;
212 }
213 return 0;
214}
215
216sub _check_constraint {
217 my ($include, $constraint, @tables) = @_;
218
219 return @tables unless defined $constraint;
220
221 return grep { !$include xor _recurse_constraint($constraint, @{$_}) } @tables
222 if ref $constraint eq 'ARRAY';
223
224 return grep { !$include xor /$constraint/ } @tables;
225}
226
227
228
bfb43060 229# apply constraint/exclude and ignore bad tables and views
075aff97 230sub _filter_tables {
bfb43060 231 my ($self, $tables, $opts) = @_;
075aff97 232
bfb43060 233 my @tables = @$tables;
075aff97 234 my @filtered_tables;
235
bfb43060 236 $opts ||= {};
b187901e 237 @tables = _check_constraint(1, $opts->{constraint}, @tables);
238 @tables = _check_constraint(0, $opts->{exclude}, @tables);
bfb43060 239
c4a69b87 240 TABLE: for my $table (@tables) {
61d1cca1 241 try {
afcd3c32 242 local $^W = 0; # for ADO
805dbe0a 243 my $sth = $self->_sth_for($table, undef, \'1 = 0');
244 $sth->execute;
c4a69b87 245 1;
075aff97 246 }
61d1cca1 247 catch {
248 warn "Bad table or view '$table', ignoring: $_\n";
c4a69b87 249 0;
250 } or next TABLE;
61d1cca1 251
252 push @filtered_tables, $table;
075aff97 253 }
254
255 return @filtered_tables;
996be9ee 256}
257
12af3806 258=head2 load
259
260We override L<DBIx::Class::Schema::Loader::Base/load> here to hook in our localized settings for C<$dbh> error handling.
261
262=cut
263
264sub load {
265 my $self = shift;
266
c4a69b87 267 local $self->dbh->{RaiseError} = 1;
268 local $self->dbh->{PrintError} = 0;
12b86f07 269
c4a69b87 270 $self->next::method(@_);
075aff97 271}
272
273sub _sth_for {
274 my ($self, $table, $fields, $where) = @_;
275
c4a69b87 276 my $sth = $self->dbh->prepare($self->schema->storage->sql_maker
277 ->select(\$table->sql_name, $fields, $where));
075aff97 278
279 return $sth;
280}
281
282# Returns an arrayref of column names
283sub _table_columns {
284 my ($self, $table) = @_;
285
286 my $sth = $self->_sth_for($table, undef, \'1 = 0');
996be9ee 287 $sth->execute;
1af21646 288
289 my $retval = [ map $self->_lc($_), @{$sth->{NAME}} ];
290
3b7f80f9 291 $sth->finish;
292
1af21646 293 return $retval;
996be9ee 294}
295
296# Returns arrayref of pk col names
a40434df 297sub _table_pk_info {
fd589700 298 my ($self, $table) = @_;
996be9ee 299
3b17d988 300 return [] if $self->_disable_pk_detection;
301
3b17d988 302 my @primary = try {
c4a69b87 303 $self->dbh->primary_key('', $table->schema, $table->name);
3b17d988 304 }
305 catch {
306 warn "Cannot find primary keys for this driver: $_";
307 $self->_disable_pk_detection(1);
308 return ();
309 };
310
311 return [] if not @primary;
312
313 @primary = map { $self->_lc($_) } @primary;
c4a69b87 314 s/[\Q$self->{quote_char}\E]//g for @primary;
996be9ee 315
316 return \@primary;
317}
318
fd589700 319# Override this for vendor-specific uniq info
996be9ee 320sub _table_uniq_info {
fd589700 321 my ($self, $table) = @_;
322
3b17d988 323 return [] if $self->_disable_uniq_detection;
324
c4a69b87 325 if (not $self->dbh->can('statistics_info')) {
3b17d988 326 warn "No UNIQUE constraint information can be gathered for this driver";
327 $self->_disable_uniq_detection(1);
fd589700 328 return [];
329 }
330
331 my %indices;
c4a69b87 332 my $sth = $self->dbh->statistics_info(undef, $table->schema, $table->name, 1, 1);
fd589700 333 while(my $row = $sth->fetchrow_hashref) {
334 # skip table-level stats, conditional indexes, and any index missing
335 # critical fields
336 next if $row->{TYPE} eq 'table'
337 || defined $row->{FILTER_CONDITION}
338 || !$row->{INDEX_NAME}
b32f8189 339 || !defined $row->{ORDINAL_POSITION};
fd589700 340
b32f8189 341 $indices{$row->{INDEX_NAME}}[$row->{ORDINAL_POSITION}] = $self->_lc($row->{COLUMN_NAME} || '');
fd589700 342 }
3b7f80f9 343 $sth->finish;
fd589700 344
345 my @retval;
6c4f5a4a 346 foreach my $index_name (sort keys %indices) {
b32f8189 347 my (undef, @cols) = @{$indices{$index_name}};
348 # skip indexes with missing column names (e.g. expression indexes)
349 next unless @cols == grep $_, @cols;
350 push(@retval, [ $index_name => \@cols ]);
fd589700 351 }
352
353 return \@retval;
996be9ee 354}
355
c4a69b87 356sub _table_comment {
357 my ($self, $table) = @_;
7732645c 358 my $dbh = $self->dbh;
5c06aa08 359
b21abfca 360 my $comments_table = $table->clone;
361 $comments_table->name($self->table_comments_table);
5c06aa08 362
07307014 363 my ($comment) =
364 (exists $self->_tables->{$comments_table->sql_name} || undef)
365 && try { $dbh->selectrow_array(<<"EOF") };
c4a69b87 366SELECT comment_text
b21abfca 367FROM @{[ $comments_table->sql_name ]}
7732645c 368WHERE table_name = @{[ $dbh->quote($table->name) ]}
c4a69b87 369EOF
5c06aa08 370
5ffed88c 371 # Failback: try the REMARKS column on table_info
68c6c83f 372 if (!$comment) {
373 my $info = $self->_dbh_table_info( $dbh, $table );
374 $comment = $info->{REMARKS} if $info;
5ffed88c 375 }
376
c4a69b87 377 return $comment;
5c06aa08 378}
379
380sub _column_comment {
b21abfca 381 my ($self, $table, $column_number, $column_name) = @_;
7732645c 382 my $dbh = $self->dbh;
c4a69b87 383
b21abfca 384 my $comments_table = $table->clone;
385 $comments_table->name($self->column_comments_table);
c4a69b87 386
07307014 387 my ($comment) =
388 (exists $self->_tables->{$comments_table->sql_name} || undef)
389 && try { $dbh->selectrow_array(<<"EOF") };
c4a69b87 390SELECT comment_text
b21abfca 391FROM @{[ $comments_table->sql_name ]}
7732645c 392WHERE table_name = @{[ $dbh->quote($table->name) ]}
393AND column_name = @{[ $dbh->quote($column_name) ]}
c4a69b87 394EOF
5ffed88c 395
396 # Failback: try the REMARKS column on column_info
5ffed88c 397 if (!$comment && $dbh->can('column_info')) {
1af21646 398 if (my $sth = try { $self->_dbh_column_info( $dbh, undef, $table->schema, $table->name, $column_name ) }) {
399 my $info = $sth->fetchrow_hashref();
400 $comment = $info->{REMARKS};
401 }
5ffed88c 402 }
403
c4a69b87 404 return $comment;
5c06aa08 405}
406
996be9ee 407# Find relationships
408sub _table_fk_info {
409 my ($self, $table) = @_;
410
3b17d988 411 return [] if $self->_disable_fk_detection;
412
3b17d988 413 my $sth = try {
c4a69b87 414 $self->dbh->foreign_key_info( '', '', '',
415 '', ($table->schema || ''), $table->name );
3b17d988 416 }
417 catch {
418 warn "Cannot introspect relationships for this driver: $_";
419 $self->_disable_fk_detection(1);
420 return undef;
421 };
422
996be9ee 423 return [] if !$sth;
424
425 my %rels;
426
a40434df 427 my @rules = (
428 'CASCADE',
429 'RESTRICT',
430 'SET NULL',
431 'NO ACTION',
432 'SET DEFAULT',
433 );
434
996be9ee 435 my $i = 1; # for unnamed rels, which hopefully have only 1 column ...
c4a69b87 436 REL: while(my $raw_rel = $sth->fetchrow_arrayref) {
437 my $uk_scm = $raw_rel->[1];
996be9ee 438 my $uk_tbl = $raw_rel->[2];
c930f78b 439 my $uk_col = $self->_lc($raw_rel->[3]);
c4a69b87 440 my $fk_scm = $raw_rel->[5];
c930f78b 441 my $fk_col = $self->_lc($raw_rel->[7]);
a273b50c 442 my $key_seq = $raw_rel->[8] - 1;
996be9ee 443 my $relid = ($raw_rel->[11] || ( "__dcsld__" . $i++ ));
c4a69b87 444
a40434df 445 my $update_rule = $raw_rel->[9];
446 my $delete_rule = $raw_rel->[10];
447
448 $update_rule = $rules[$update_rule] if defined $update_rule;
449 $delete_rule = $rules[$delete_rule] if defined $delete_rule;
450
451 my $is_deferrable = $raw_rel->[13];
452
453 ($is_deferrable = $is_deferrable == 7 ? 0 : 1)
454 if defined $is_deferrable;
455
c4a69b87 456 foreach my $var ($uk_scm, $uk_tbl, $uk_col, $fk_scm, $fk_col, $relid) {
ba9954e0 457 $var =~ s/[\Q$self->{quote_char}\E]//g if defined $var;
c4a69b87 458 }
459
460 if ($self->db_schema && $self->db_schema->[0] ne '%'
461 && (not any { $_ eq $uk_scm } @{ $self->db_schema })) {
462
463 next REL;
464 }
465
a40434df 466 $rels{$relid}{tbl} ||= DBIx::Class::Schema::Loader::Table->new(
c4a69b87 467 loader => $self,
468 name => $uk_tbl,
469 schema => $uk_scm,
470 ($self->_supports_db_schema ? () : (
471 ignore_schema => 1
472 )),
473 );
a40434df 474
475 $rels{$relid}{attrs}{on_delete} = $delete_rule if $delete_rule;
476 $rels{$relid}{attrs}{on_update} = $update_rule if $update_rule;
477 $rels{$relid}{attrs}{is_deferrable} = $is_deferrable if defined $is_deferrable;
478
a273b50c 479 # Add this data IN ORDER
480 $rels{$relid}{rcols}[$key_seq] = $uk_col;
481 $rels{$relid}{lcols}[$key_seq] = $fk_col;
996be9ee 482 }
3b7f80f9 483 $sth->finish;
996be9ee 484
485 my @rels;
486 foreach my $relid (keys %rels) {
487 push(@rels, {
79137580 488 remote_columns => [ grep defined, @{ $rels{$relid}{rcols} } ],
489 local_columns => [ grep defined, @{ $rels{$relid}{lcols} } ],
996be9ee 490 remote_table => $rels{$relid}->{tbl},
a40434df 491 (exists $rels{$relid}{attrs} ?
492 (attrs => $rels{$relid}{attrs})
493 :
494 ()
495 ),
496 _constraint_name => $relid,
996be9ee 497 });
498 }
499
500 return \@rels;
501}
502
12af3806 503# ported in from DBIx::Class::Storage::DBI:
504sub _columns_info_for {
505 my ($self, $table) = @_;
506
507 my $dbh = $self->schema->storage->dbh;
508
61d1cca1 509 my %result;
510
1af21646 511 if (my $sth = try { $self->_dbh_column_info($dbh, undef, $table->schema, $table->name, '%' ) }) {
512 COL_INFO: while (my $info = try { $sth->fetchrow_hashref } catch { +{} }) {
513 next COL_INFO unless %$info;
514
61d1cca1 515 my $column_info = {};
516 $column_info->{data_type} = lc $info->{TYPE_NAME};
517
518 my $size = $info->{COLUMN_SIZE};
519
520 if (defined $size && defined $info->{DECIMAL_DIGITS}) {
521 $column_info->{size} = [$size, $info->{DECIMAL_DIGITS}];
12af3806 522 }
61d1cca1 523 elsif (defined $size) {
524 $column_info->{size} = $size;
525 }
526
527 $column_info->{is_nullable} = $info->{NULLABLE} ? 1 : 0;
528 $column_info->{default_value} = $info->{COLUMN_DEF} if defined $info->{COLUMN_DEF};
529 my $col_name = $info->{COLUMN_NAME};
530 $col_name =~ s/^\"(.*)\"$/$1/;
531
61d1cca1 532 my $extra_info = $self->_extra_column_info(
533 $table, $col_name, $column_info, $info
534 ) || {};
535 $column_info = { %$column_info, %$extra_info };
536
537 $result{$col_name} = $column_info;
538 }
539 $sth->finish;
12af3806 540 }
541
075aff97 542 my $sth = $self->_sth_for($table, undef, \'1 = 0');
12af3806 543 $sth->execute;
61d1cca1 544
ed18888f 545 my @columns = @{ $sth->{NAME} };
61d1cca1 546
1af21646 547 COL: for my $i (0 .. $#columns) {
22f91663 548 next COL if %{ $result{ $columns[$i] }||{} };
1af21646 549
23d1f36b 550 my $column_info = {};
57a9fc92 551 $column_info->{data_type} = lc $sth->{TYPE}[$i];
26334ec1 552
553 my $size = $sth->{PRECISION}[$i];
554
555 if (defined $size && defined $sth->{SCALE}[$i]) {
556 $column_info->{size} = [$size, $sth->{SCALE}[$i]];
557 }
558 elsif (defined $size) {
559 $column_info->{size} = $size;
560 }
561
57a9fc92 562 $column_info->{is_nullable} = $sth->{NULLABLE}[$i] ? 1 : 0;
23d1f36b 563
564 if ($column_info->{data_type} =~ m/^(.*?)\((.*?)\)$/) {
565 $column_info->{data_type} = $1;
566 $column_info->{size} = $2;
12af3806 567 }
568
698c11d8 569 my $extra_info = $self->_extra_column_info($table, $columns[$i], $column_info, $sth) || {};
23d1f36b 570 $column_info = { %$column_info, %$extra_info };
571
116431d6 572 $result{ $columns[$i] } = $column_info;
12af3806 573 }
6ce0bcc3 574 $sth->finish;
575
576 foreach my $col (keys %result) {
577 my $colinfo = $result{$col};
578 my $type_num = $colinfo->{data_type};
579 my $type_name;
afcd3c32 580 if (defined $type_num && $type_num =~ /^-?\d+\z/ && $dbh->can('type_info')) {
5111e5d0 581 my $type_name = $self->_dbh_type_info_type_name($type_num);
cf0ba25b 582 $colinfo->{data_type} = lc $type_name if $type_name;
6ce0bcc3 583 }
584 }
12af3806 585
116431d6 586 # check for instances of the same column name with different case in preserve_case=0 mode
587 if (not $self->preserve_case) {
588 my %lc_colnames;
589
590 foreach my $col (keys %result) {
591 push @{ $lc_colnames{lc $col} }, $col;
592 }
593
594 if (keys %lc_colnames != keys %result) {
595 my @offending_colnames = map @$_, grep @$_ > 1, values %lc_colnames;
596
597 my $offending_colnames = join ", ", map "'$_'", @offending_colnames;
598
599 croak "columns $offending_colnames in table @{[ $table->sql_name ]} collide in preserve_case=0 mode. preserve_case=1 mode required";
600 }
601
602 # apply lowercasing
603 my %lc_result;
604
605 while (my ($col, $info) = each %result) {
606 $lc_result{ $self->_lc($col) } = $info;
607 }
608
609 %result = %lc_result;
610 }
611
12af3806 612 return \%result;
613}
614
23024b3f 615# Need to override this for the buggy Firebird ODBC driver.
5111e5d0 616sub _dbh_type_info_type_name {
23024b3f 617 my ($self, $type_num) = @_;
618
354b6942 619 # We wrap it in a try block for MSSQL+DBD::Sybase, which can have issues.
620 # TODO investigate further
621 my $type_info = try { $self->dbh->type_info($type_num) };
a40434df 622
5111e5d0 623 return $type_info ? $type_info->{TYPE_NAME} : undef;
23024b3f 624}
625
db9c411a 626# do not use this, override _columns_info_for instead
a8df0345 627sub _extra_column_info {}
c5baf131 628
5ffed88c 629# override to mask warnings if needed
630sub _dbh_table_info {
68c6c83f 631 my ($self, $dbh, $table) = (shift, shift, shift);
632
633 return undef if !$dbh->can('table_info');
634 my $sth = $dbh->table_info(undef, $table->schema, $table->name);
635 while (my $info = $sth->fetchrow_hashref) {
636 next if !$self->_table_info_matches($table, $info);
637 return $info;
638 }
639 return undef;
640}
641
642sub _table_info_matches {
643 my ($self, $table, $info) = @_;
5ffed88c 644
68c6c83f 645 no warnings 'uninitialized';
646 return $info->{TABLE_SCHEM} eq $table->schema
647 && $info->{TABLE_NAME} eq $table->name;
5ffed88c 648}
649
db9c411a 650# override to mask warnings if needed (see mysql)
651sub _dbh_column_info {
652 my ($self, $dbh) = (shift, shift);
653
654 return $dbh->column_info(@_);
655}
656
3b17d988 657# If a coderef uses DBI->connect, this should get its connect info.
658sub _try_infer_connect_info_from_coderef {
659 my ($self, $code) = @_;
660
661 my ($dsn, $user, $pass, $params);
662
663 no warnings 'redefine';
664
665 local *DBI::connect = sub {
666 (undef, $dsn, $user, $pass, $params) = @_;
667 };
668
669 $code->();
670
671 return ($dsn, $user, $pass, $params);
672}
673
c4a69b87 674sub dbh {
675 my $self = shift;
676
677 return $self->schema->storage->dbh;
678}
679
ce2f102a 680sub _table_is_view {
681 my ($self, $table) = @_;
682
683 my $info = $self->_dbh_table_info($self->dbh, $table)
684 or return 0;
685 return $info->{TABLE_TYPE} eq 'VIEW';
686}
687
996be9ee 688=head1 SEE ALSO
689
690L<DBIx::Class::Schema::Loader>
691
be80bba7 692=head1 AUTHOR
693
9cc8e7e1 694See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
be80bba7 695
696=head1 LICENSE
697
698This library is free software; you can redistribute it and/or modify it under
699the same terms as Perl itself.
700
996be9ee 701=cut
702
7031;
26334ec1 704# vim:et sts=4 sw=4 tw=0: