=cut
-sub _db_classes {
+sub _loader_db_classes {
return qw/DBIx::Class::PK::Auto::DB2/;
}
-sub _tables {
+sub _loader_tables {
my $class = shift;
my %args = @_;
- my $db_schema = uc $class->loader_data->{_db_schema};
+ my $db_schema = uc $class->_loader_db_schema;
my $dbh = $class->storage->dbh;
+ my $quoter = $dbh->get_info(29) || q{"};
# this is split out to avoid version parsing errors...
my $is_dbd_db2_gte_114 = ( $DBD::DB2::VERSION >= 1.14 );
: $dbh->tables;
# People who use table or schema names that aren't identifiers deserve
# what they get. Still, FIXME?
- s/\"//g for @tables;
+ s/$quoter//g for @tables;
@tables = grep {!/^SYSIBM\./ and !/^SYSCAT\./ and !/^SYSSTAT\./} @tables;
@tables = grep {/^$db_schema\./} @tables if($db_schema);
return @tables;
}
-sub _table_info {
+sub _loader_table_info {
my ( $class, $table ) = @_;
# $|=1;
-# print "_table_info($table)\n";
+# print "_loader_table_info($table)\n";
my ($db_schema, $tabname) = split /\./, $table, 2;
# print "DB_Schema: $db_schema, Table: $tabname\n";
$sth->execute($db_schema, $tabname) or die;
my @cols = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
- $sth->finish;
+ undef $sth;
$sth = $dbh->prepare(<<'SQL') or die;
SELECT kcu.COLNAME
my @pri = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
- $sth->finish;
-
return ( \@cols, \@pri );
}
# Find and setup relationships
-sub _relationships {
+sub _loader_relationships {
my $class = shift;
my $dbh = $class->storage->dbh;
SQL
foreach my $table ( $class->tables ) {
- if ($sth->execute(uc $table)) {
- while(my $res = $sth->fetchrow_arrayref()) {
- my ($colcount, $other, $other_column, $column) =
- map { $_=lc; s/^\s+//; s/\s+$//; $_; } @$res;
- next if $colcount != 1; # XXX no multi-col FK support yet
- eval { $class->_belongs_to_many( $table, $column, $other,
- $other_column ) };
- warn qq/\# belongs_to_many failed "$@"\n\n/
- if $@ && $class->debug_loader;
+ next if ! $sth->execute(uc $table);
+ while(my $res = $sth->fetchrow_arrayref()) {
+ my ($colcount, $other, $other_column, $column) =
+ map { lc } @$res;
+
+ my @self_cols = split(' ',$column);
+ my @other_cols = split(' ',$other_column);
+ if(@self_cols != $colcount || @other_cols != $colcount) {
+ die "Column count discrepancy while getting rel info";
}
+
+ my %cond;
+ for(my $i = 0; $i < @self_cols; $i++) {
+ $cond{$other_cols[$i]} = $self_cols[$i];
+ }
+
+ eval { $class->_loader_make_relations ($table, $other, \%cond); };
+ warn qq/\# belongs_to_many failed "$@"\n\n/
+ if $@ && $class->_loader_debug;
}
}