Commit | Line | Data |
18fca96a |
1 | package DBIx::Class::Schema::Loader::DB2; |
a78e3fed |
2 | |
3 | use strict; |
3980d69c |
4 | use warnings; |
18fca96a |
5 | use base 'DBIx::Class::Schema::Loader::Generic'; |
457eb8a6 |
6 | use Class::C3; |
a78e3fed |
7 | |
8 | =head1 NAME |
9 | |
18fca96a |
10 | DBIx::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 |
29 | See L<DBIx::Class::Schema::Loader>. |
a78e3fed |
30 | |
31 | =cut |
32 | |
3980d69c |
33 | sub _db_classes { |
9fa99683 |
34 | return qw/PK::Auto::DB2/; |
a78e3fed |
35 | } |
36 | |
ac5ad557 |
37 | sub _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 |
57 | sub _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; |
68 | SELECT c.COLNAME |
69 | FROM SYSCAT.COLUMNS as c |
70 | WHERE c.TABSCHEMA = ? and c.TABNAME = ? |
71 | SQL |
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; |
79 | SELECT kcu.COLNAME |
80 | FROM SYSCAT.TABCONST as tc |
81 | JOIN SYSCAT.KEYCOLUSE as kcu ON tc.constname = kcu.constname |
82 | WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'P' |
83 | SQL |
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 |
93 | sub _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; |
99 | SELECT SR.COLCOUNT, SR.REFTBNAME, SR.PKCOLNAMES, SR.FKCOLNAMES |
100 | FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ? |
101 | SQL |
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 |
133 | L<DBIx::Class::Schema::Loader> |
a78e3fed |
134 | |
135 | =cut |
136 | |
137 | 1; |