Added missing space in error message
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / DB2.pm
CommitLineData
18fca96a 1package DBIx::Class::Schema::Loader::DB2;
a78e3fed 2
3use strict;
3980d69c 4use warnings;
18fca96a 5use base 'DBIx::Class::Schema::Loader::Generic';
457eb8a6 6use Class::C3;
a78e3fed 7
8=head1 NAME
9
18fca96a 10DBIx::Class::Schema::Loader::DB2 - DBIx::Class::Schema::Loader DB2 Implementation.
a78e3fed 11
12=head1 SYNOPSIS
13
457eb8a6 14 package My::Schema;
15 use base qw/DBIx::Class::Schema::Loader/;
a78e3fed 16
457eb8a6 17 __PACKAGE__->load_from_connection(
38348090 18 dsn => "dbi:DB2:dbname",
19 user => "myuser",
20 password => "",
21 db_schema => "MYSCHEMA",
22 drop_schema => 1,
a78e3fed 23 );
a78e3fed 24
457eb8a6 25 1;
26
a78e3fed 27=head1 DESCRIPTION
28
18fca96a 29See L<DBIx::Class::Schema::Loader>.
a78e3fed 30
31=cut
32
3980d69c 33sub _db_classes {
9fa99683 34 return qw/PK::Auto::DB2/;
a78e3fed 35}
36
ac5ad557 37sub _tables_list {
3980d69c 38 my $self = shift;
a78e3fed 39 my %args = @_;
3980d69c 40 my $db_schema = uc $self->db_schema;
41 my $dbh = $self->schema->storage->dbh;
b005807a 42 my $quoter = $dbh->get_info(29) || q{"};
a78e3fed 43
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' } )
48 : $dbh->tables;
a78e3fed 49 # People who use table or schema names that aren't identifiers deserve
50 # what they get. Still, FIXME?
b005807a 51 s/$quoter//g for @tables;
a78e3fed 52 @tables = grep {!/^SYSIBM\./ and !/^SYSCAT\./ and !/^SYSSTAT\./} @tables;
af6c2665 53 @tables = grep {/^$db_schema\./} @tables if($db_schema);
a78e3fed 54 return @tables;
55}
56
3980d69c 57sub _table_info {
58 my ( $self, $table ) = @_;
a78e3fed 59# $|=1;
3980d69c 60# print "_table_info($table)\n";
ac5ad557 61 my $db_schema = $self->db_schema;
a78e3fed 62
63 # FIXME: Horribly inefficient and just plain evil. (JMM)
3980d69c 64 my $dbh = $self->schema->storage->dbh;
a78e3fed 65 $dbh->{RaiseError} = 1;
66
67 my $sth = $dbh->prepare(<<'SQL') or die;
68SELECT c.COLNAME
69FROM SYSCAT.COLUMNS as c
70WHERE c.TABSCHEMA = ? and c.TABNAME = ?
71SQL
72
ac5ad557 73 $sth->execute($db_schema, $table) or die;
af96f52e 74 my @cols = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
75
66742793 76 undef $sth;
a78e3fed 77
78 $sth = $dbh->prepare(<<'SQL') or die;
79SELECT kcu.COLNAME
80FROM SYSCAT.TABCONST as tc
81JOIN SYSCAT.KEYCOLUSE as kcu ON tc.constname = kcu.constname
82WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'P'
83SQL
84
ac5ad557 85 $sth->execute($db_schema, $table) or die;
a78e3fed 86
af96f52e 87 my @pri = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
88
a78e3fed 89 return ( \@cols, \@pri );
90}
91
af96f52e 92# Find and setup relationships
3980d69c 93sub _load_relationships {
94 my $self = shift;
af96f52e 95
3980d69c 96 my $dbh = $self->schema->storage->dbh;
af96f52e 97
98 my $sth = $dbh->prepare(<<'SQL') or die;
99SELECT SR.COLCOUNT, SR.REFTBNAME, SR.PKCOLNAMES, SR.FKCOLNAMES
100FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ?
101SQL
102
ac5ad557 103 my $db_schema = $self->db_schema;
3980d69c 104 foreach my $table ( $self->tables ) {
ac5ad557 105 $table =~ s/^$db_schema\.//;
106 next if ! $sth->execute($table);
66742793 107 while(my $res = $sth->fetchrow_arrayref()) {
ac5ad557 108 my ($colcount, $other, $other_column, $column) = @$res;
66742793 109
ac5ad557 110 my @self_cols = map { lc } split(' ',$column);
111 my @other_cols = map { lc } split(' ',$other_column);
66742793 112 if(@self_cols != $colcount || @other_cols != $colcount) {
113 die "Column count discrepancy while getting rel info";
af96f52e 114 }
66742793 115
116 my %cond;
117 for(my $i = 0; $i < @self_cols; $i++) {
118 $cond{$other_cols[$i]} = $self_cols[$i];
119 }
120
3980d69c 121 eval { $self->_make_cond_rel ($table, $other, \%cond); };
66742793 122 warn qq/\# belongs_to_many failed "$@"\n\n/
3980d69c 123 if $@ && $self->debug;
af96f52e 124 }
125 }
126
127 $sth->finish;
128 $dbh->disconnect;
129}
130
a78e3fed 131=head1 SEE ALSO
132
18fca96a 133L<DBIx::Class::Schema::Loader>
a78e3fed 134
135=cut
136
1371;