Commit | Line | Data |
18fca96a |
1 | package DBIx::Class::Schema::Loader::DB2; |
a78e3fed |
2 | |
3 | use strict; |
18fca96a |
4 | use base 'DBIx::Class::Schema::Loader::Generic'; |
a78e3fed |
5 | use Carp; |
6 | |
7 | =head1 NAME |
8 | |
18fca96a |
9 | DBIx::Class::Schema::Loader::DB2 - DBIx::Class::Schema::Loader DB2 Implementation. |
a78e3fed |
10 | |
11 | =head1 SYNOPSIS |
12 | |
18fca96a |
13 | use DBIx::Schema::Class::Loader; |
a78e3fed |
14 | |
18fca96a |
15 | # $loader is a DBIx::Class::Schema::Loader::DB2 |
16 | my $loader = DBIx::Class::Schema::Loader->new( |
38348090 |
17 | dsn => "dbi:DB2:dbname", |
18 | user => "myuser", |
19 | password => "", |
20 | db_schema => "MYSCHEMA", |
21 | drop_schema => 1, |
a78e3fed |
22 | ); |
a78e3fed |
23 | |
24 | =head1 DESCRIPTION |
25 | |
18fca96a |
26 | See L<DBIx::Class::Schema::Loader>. |
a78e3fed |
27 | |
28 | =cut |
29 | |
3385ac62 |
30 | sub _loader_db_classes { |
af96f52e |
31 | return qw/DBIx::Class::PK::Auto::DB2/; |
a78e3fed |
32 | } |
33 | |
3385ac62 |
34 | sub _loader_tables { |
a4a19f3c |
35 | my $class = shift; |
a78e3fed |
36 | my %args = @_; |
3385ac62 |
37 | my $db_schema = uc $class->_loader_data->{db_schema}; |
a4a19f3c |
38 | my $dbh = $class->storage->dbh; |
a78e3fed |
39 | |
40 | # this is split out to avoid version parsing errors... |
41 | my $is_dbd_db2_gte_114 = ( $DBD::DB2::VERSION >= 1.14 ); |
42 | my @tables = $is_dbd_db2_gte_114 ? |
43 | $dbh->tables( { TABLE_SCHEM => '%', TABLE_TYPE => 'TABLE,VIEW' } ) |
44 | : $dbh->tables; |
a78e3fed |
45 | # People who use table or schema names that aren't identifiers deserve |
46 | # what they get. Still, FIXME? |
47 | s/\"//g for @tables; |
48 | @tables = grep {!/^SYSIBM\./ and !/^SYSCAT\./ and !/^SYSSTAT\./} @tables; |
af6c2665 |
49 | @tables = grep {/^$db_schema\./} @tables if($db_schema); |
a78e3fed |
50 | return @tables; |
51 | } |
52 | |
3385ac62 |
53 | sub _loader_table_info { |
a4a19f3c |
54 | my ( $class, $table ) = @_; |
a78e3fed |
55 | # $|=1; |
3385ac62 |
56 | # print "_loader_table_info($table)\n"; |
af6c2665 |
57 | my ($db_schema, $tabname) = split /\./, $table, 2; |
58 | # print "DB_Schema: $db_schema, Table: $tabname\n"; |
a78e3fed |
59 | |
60 | # FIXME: Horribly inefficient and just plain evil. (JMM) |
a4a19f3c |
61 | my $dbh = $class->storage->dbh; |
a78e3fed |
62 | $dbh->{RaiseError} = 1; |
63 | |
64 | my $sth = $dbh->prepare(<<'SQL') or die; |
65 | SELECT c.COLNAME |
66 | FROM SYSCAT.COLUMNS as c |
67 | WHERE c.TABSCHEMA = ? and c.TABNAME = ? |
68 | SQL |
69 | |
af6c2665 |
70 | $sth->execute($db_schema, $tabname) or die; |
af96f52e |
71 | my @cols = map { lc } map { @$_ } @{$sth->fetchall_arrayref}; |
72 | |
66742793 |
73 | undef $sth; |
a78e3fed |
74 | |
75 | $sth = $dbh->prepare(<<'SQL') or die; |
76 | SELECT kcu.COLNAME |
77 | FROM SYSCAT.TABCONST as tc |
78 | JOIN SYSCAT.KEYCOLUSE as kcu ON tc.constname = kcu.constname |
79 | WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'P' |
80 | SQL |
81 | |
af6c2665 |
82 | $sth->execute($db_schema, $tabname) or die; |
a78e3fed |
83 | |
af96f52e |
84 | my @pri = map { lc } map { @$_ } @{$sth->fetchall_arrayref}; |
85 | |
a78e3fed |
86 | return ( \@cols, \@pri ); |
87 | } |
88 | |
af96f52e |
89 | # Find and setup relationships |
3385ac62 |
90 | sub _loader_relationships { |
af96f52e |
91 | my $class = shift; |
92 | |
93 | my $dbh = $class->storage->dbh; |
94 | |
95 | my $sth = $dbh->prepare(<<'SQL') or die; |
96 | SELECT SR.COLCOUNT, SR.REFTBNAME, SR.PKCOLNAMES, SR.FKCOLNAMES |
97 | FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ? |
98 | SQL |
99 | |
100 | foreach my $table ( $class->tables ) { |
66742793 |
101 | next if ! $sth->execute(uc $table); |
102 | while(my $res = $sth->fetchrow_arrayref()) { |
103 | my ($colcount, $other, $other_column, $column) = |
104 | map { lc } @$res; |
105 | |
106 | my @self_cols = split(' ',$column); |
107 | my @other_cols = split(' ',$other_column); |
108 | if(@self_cols != $colcount || @other_cols != $colcount) { |
109 | die "Column count discrepancy while getting rel info"; |
af96f52e |
110 | } |
66742793 |
111 | |
112 | my %cond; |
113 | for(my $i = 0; $i < @self_cols; $i++) { |
114 | $cond{$other_cols[$i]} = $self_cols[$i]; |
115 | } |
116 | |
117 | eval { $class->_loader_make_relations ($table, $other, \%cond); }; |
118 | warn qq/\# belongs_to_many failed "$@"\n\n/ |
119 | if $@ && $class->_loader_debug; |
af96f52e |
120 | } |
121 | } |
122 | |
123 | $sth->finish; |
124 | $dbh->disconnect; |
125 | } |
126 | |
a78e3fed |
127 | =head1 SEE ALSO |
128 | |
18fca96a |
129 | L<DBIx::Class::Schema::Loader> |
a78e3fed |
130 | |
131 | =cut |
132 | |
133 | 1; |