1 package DBIx::Class::Schema::Loader::DBI;
5 use base qw/DBIx::Class::Schema::Loader::Base Class::Accessor::Fast/;
8 use UNIVERSAL::require;
12 DBIx::Class::Schema::Loader::DBI - DBIx::Class::Schema::Loader DBI Implementation.
16 See L<DBIx::Class::Schema::Loader::Base>
20 This is the base class for L<DBIx::Class::Schema::Loader::Base> classes for
21 DBI-based storage backends, and implements the common functionality between them.
23 See L<DBIx::Class::Schema::Loader::Base> for the available options.
29 Overlays L<DBIx::Class::Schema::Loader::Base/new> to do some DBI-specific
35 my $self = shift->next::method(@_);
37 # rebless to vendor-specific class if it exists and loads
38 my $dbh = $self->schema->storage->dbh;
39 my $driver = $dbh->{Driver}->{Name};
40 my $subclass = 'DBIx::Class::Schema::Loader::DBI::' . $driver;
42 if($@ && $@ !~ /^Can't locate /) {
43 die "Failed to require $subclass: $@";
46 bless $self, "DBIx::Class::Schema::Loader::DBI::${driver}";
49 # Set up the default quoting character and name seperators
50 $self->{_quoter} = $self->schema->storage->sql_maker->quote_char
54 $self->{_namesep} = $self->schema->storage->sql_maker->name_sep
58 # For our usage as regex matches, concatenating multiple quoter
59 # values works fine (e.g. s/\Q<>\E// if quoter was [ '<', '>' ])
60 if( ref $self->{_quoter} eq 'ARRAY') {
61 $self->{_quoter} = join(q{}, @{$self->{_quoter}});
69 # Override this in vendor modules to do things at the end of ->new()
72 # Returns an array of table names
76 my $dbh = $self->schema->storage->dbh;
77 my @tables = $dbh->tables(undef, $self->db_schema, '%', '%');
78 s/\Q$self->{_quoter}\E//g for @tables;
79 s/^.*\Q$self->{_namesep}\E// for @tables;
84 # Returns an arrayref of column names
86 my ($self, $table) = @_;
88 my $dbh = $self->schema->storage->dbh;
90 if($self->{db_schema}) {
91 $table = $self->{db_schema} . $self->{_namesep} . $table;
94 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0");
96 return \@{$sth->{NAME_lc}};
99 # Returns arrayref of pk col names
101 my ( $self, $table ) = @_;
103 my $dbh = $self->schema->storage->dbh;
105 my @primary = map { lc } $dbh->primary_key('', $self->db_schema, $table);
106 s/\Q$self->{_quoter}\E//g for @primary;
111 # Override this for uniq info
112 sub _table_uniq_info {
113 warn "No UNIQUE constraint information can be gathered for this vendor";
119 my ($self, $table) = @_;
121 my $dbh = $self->schema->storage->dbh;
122 my $sth = $dbh->foreign_key_info( '', '', '', '',
123 $self->db_schema, $table );
128 my $i = 1; # for unnamed rels, which hopefully have only 1 column ...
129 while(my $raw_rel = $sth->fetchrow_arrayref) {
130 my $uk_tbl = $raw_rel->[2];
131 my $uk_col = lc $raw_rel->[3];
132 my $fk_col = lc $raw_rel->[7];
133 my $relid = ($raw_rel->[11] || ( "__dcsld__" . $i++ ));
134 $uk_tbl =~ s/\Q$self->{_quoter}\E//g;
135 $uk_col =~ s/\Q$self->{_quoter}\E//g;
136 $fk_col =~ s/\Q$self->{_quoter}\E//g;
137 $relid =~ s/\Q$self->{_quoter}\E//g;
138 $rels{$relid}->{tbl} = $uk_tbl;
139 $rels{$relid}->{cols}->{$uk_col} = $fk_col;
143 foreach my $relid (keys %rels) {
145 remote_columns => [ keys %{$rels{$relid}->{cols}} ],
146 local_columns => [ values %{$rels{$relid}->{cols}} ],
147 remote_table => $rels{$relid}->{tbl},
156 L<DBIx::Class::Schema::Loader>