package DBIx::Class::Schema::Loader::DB2;
use strict;
+use warnings;
use base 'DBIx::Class::Schema::Loader::Generic';
-use Carp;
+use Class::C3;
=head1 NAME
=head1 SYNOPSIS
- use DBIx::Schema::Class::Loader;
+ package My::Schema;
+ use base qw/DBIx::Class::Schema::Loader/;
- # $loader is a DBIx::Class::Schema::Loader::DB2
- my $loader = DBIx::Class::Schema::Loader->new(
+ __PACKAGE__->load_from_connection(
dsn => "dbi:DB2:dbname",
user => "myuser",
password => "",
drop_schema => 1,
);
+ 1;
+
=head1 DESCRIPTION
See L<DBIx::Class::Schema::Loader>.
=cut
-sub _loader_db_classes {
- return qw/DBIx::Class::PK::Auto::DB2/;
+sub _db_classes {
+ return qw/PK::Auto::DB2/;
}
-sub _loader_tables {
- my $class = shift;
+sub _tables {
+ my $self = shift;
my %args = @_;
- my $db_schema = uc $class->_loader_data->{db_schema};
- my $dbh = $class->storage->dbh;
+ my $db_schema = uc $self->db_schema;
+ my $dbh = $self->schema->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 _loader_table_info {
- my ( $class, $table ) = @_;
+sub _table_info {
+ my ( $self, $table ) = @_;
# $|=1;
-# print "_loader_table_info($table)\n";
+# print "_table_info($table)\n";
my ($db_schema, $tabname) = split /\./, $table, 2;
# print "DB_Schema: $db_schema, Table: $tabname\n";
# FIXME: Horribly inefficient and just plain evil. (JMM)
- my $dbh = $class->storage->dbh;
+ my $dbh = $self->schema->storage->dbh;
$dbh->{RaiseError} = 1;
my $sth = $dbh->prepare(<<'SQL') or die;
$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 _loader_relationships {
- my $class = shift;
+sub _load_relationships {
+ my $self = shift;
- my $dbh = $class->storage->dbh;
+ my $dbh = $self->schema->storage->dbh;
my $sth = $dbh->prepare(<<'SQL') or die;
SELECT SR.COLCOUNT, SR.REFTBNAME, SR.PKCOLNAMES, SR.FKCOLNAMES
FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ?
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 } @$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;
+ foreach my $table ( $self->tables ) {
+ 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 { $self->_make_cond_rel ($table, $other, \%cond); };
+ warn qq/\# belongs_to_many failed "$@"\n\n/
+ if $@ && $self->debug;
}
}