1 package DBIx::Class::Schema::Loader::DB2;
5 use base 'DBIx::Class::Schema::Loader::Generic';
10 DBIx::Class::Schema::Loader::DB2 - DBIx::Class::Schema::Loader DB2 Implementation.
15 use base qw/DBIx::Class::Schema::Loader/;
17 __PACKAGE__->load_from_connection(
18 dsn => "dbi:DB2:dbname",
21 db_schema => "MYSCHEMA",
29 See L<DBIx::Class::Schema::Loader>.
34 return qw/DBIx::Class::PK::Auto::DB2/;
40 my $db_schema = uc $self->db_schema;
41 my $dbh = $self->schema->storage->dbh;
42 my $quoter = $dbh->get_info(29) || q{"};
44 # this is split out to avoid version parsing errors...
45 my $is_dbd_db2_gte_114 = ( $DBD::DB2::VERSION >= 1.14 );
46 my @tables = $is_dbd_db2_gte_114 ?
47 $dbh->tables( { TABLE_SCHEM => '%', TABLE_TYPE => 'TABLE,VIEW' } )
49 # People who use table or schema names that aren't identifiers deserve
50 # what they get. Still, FIXME?
51 s/$quoter//g for @tables;
52 @tables = grep {!/^SYSIBM\./ and !/^SYSCAT\./ and !/^SYSSTAT\./} @tables;
53 @tables = grep {/^$db_schema\./} @tables if($db_schema);
58 my ( $self, $table ) = @_;
60 # print "_table_info($table)\n";
61 my ($db_schema, $tabname) = split /\./, $table, 2;
62 # print "DB_Schema: $db_schema, Table: $tabname\n";
64 # FIXME: Horribly inefficient and just plain evil. (JMM)
65 my $dbh = $self->schema->storage->dbh;
66 $dbh->{RaiseError} = 1;
68 my $sth = $dbh->prepare(<<'SQL') or die;
70 FROM SYSCAT.COLUMNS as c
71 WHERE c.TABSCHEMA = ? and c.TABNAME = ?
74 $sth->execute($db_schema, $tabname) or die;
75 my @cols = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
79 $sth = $dbh->prepare(<<'SQL') or die;
81 FROM SYSCAT.TABCONST as tc
82 JOIN SYSCAT.KEYCOLUSE as kcu ON tc.constname = kcu.constname
83 WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'P'
86 $sth->execute($db_schema, $tabname) or die;
88 my @pri = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
90 return ( \@cols, \@pri );
93 # Find and setup relationships
94 sub _load_relationships {
97 my $dbh = $self->schema->storage->dbh;
99 my $sth = $dbh->prepare(<<'SQL') or die;
100 SELECT SR.COLCOUNT, SR.REFTBNAME, SR.PKCOLNAMES, SR.FKCOLNAMES
101 FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ?
104 foreach my $table ( $self->tables ) {
105 next if ! $sth->execute(uc $table);
106 while(my $res = $sth->fetchrow_arrayref()) {
107 my ($colcount, $other, $other_column, $column) =
110 my @self_cols = split(' ',$column);
111 my @other_cols = split(' ',$other_column);
112 if(@self_cols != $colcount || @other_cols != $colcount) {
113 die "Column count discrepancy while getting rel info";
117 for(my $i = 0; $i < @self_cols; $i++) {
118 $cond{$other_cols[$i]} = $self_cols[$i];
121 eval { $self->_make_cond_rel ($table, $other, \%cond); };
122 warn qq/\# belongs_to_many failed "$@"\n\n/
123 if $@ && $self->debug;
133 L<DBIx::Class::Schema::Loader>