schema-loader does multi-column FKs now, needs a bit of cleanup/refactor work
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / DB2.pm
1 package DBIx::Class::Schema::Loader::DB2;
2
3 use strict;
4 use base 'DBIx::Class::Schema::Loader::Generic';
5 use Carp;
6
7 =head1 NAME
8
9 DBIx::Class::Schema::Loader::DB2 - DBIx::Class::Schema::Loader DB2 Implementation.
10
11 =head1 SYNOPSIS
12
13   use DBIx::Schema::Class::Loader;
14
15   # $loader is a DBIx::Class::Schema::Loader::DB2
16   my $loader = DBIx::Class::Schema::Loader->new(
17     dsn         => "dbi:DB2:dbname",
18     user        => "myuser",
19     password    => "",
20     db_schema   => "MYSCHEMA",
21     drop_schema => 1,
22   );
23
24 =head1 DESCRIPTION
25
26 See L<DBIx::Class::Schema::Loader>.
27
28 =cut
29
30 sub _db_classes {
31     return qw/DBIx::Class::PK::Auto::DB2/;
32 }
33
34 sub _tables {
35     my $class = shift;
36     my %args = @_; 
37     my $db_schema = uc $class->loader_data->{_db_schema};
38     my $dbh = $class->storage->dbh;
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;
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;
49     @tables = grep {/^$db_schema\./} @tables if($db_schema);
50     return @tables;
51 }
52
53 sub _table_info {
54     my ( $class, $table ) = @_;
55 #    $|=1;
56 #    print "_table_info($table)\n";
57     my ($db_schema, $tabname) = split /\./, $table, 2;
58     # print "DB_Schema: $db_schema, Table: $tabname\n";
59     
60     # FIXME: Horribly inefficient and just plain evil. (JMM)
61     my $dbh = $class->storage->dbh;
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
70     $sth->execute($db_schema, $tabname) or die;
71     my @cols = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
72
73     $sth->finish;
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
82     $sth->execute($db_schema, $tabname) or die;
83
84     my @pri = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
85
86     $sth->finish;
87     
88     return ( \@cols, \@pri );
89 }
90
91 # Find and setup relationships
92 sub _relationships {
93     my $class = shift;
94
95     my $dbh = $class->storage->dbh;
96
97     my $sth = $dbh->prepare(<<'SQL') or die;
98 SELECT SR.COLCOUNT, SR.REFTBNAME, SR.PKCOLNAMES, SR.FKCOLNAMES
99 FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ?
100 SQL
101
102     foreach my $table ( $class->tables ) {
103         if ($sth->execute(uc $table)) {
104             while(my $res = $sth->fetchrow_arrayref()) {
105                 my ($colcount, $other, $other_column, $column) =
106                     map { lc } @$res;
107
108                 my @self_cols = split(' ',$column);
109                 my @other_cols = split(' ',$other_column);
110                 if(@self_cols != $colcount || @other_cols != $colcount) {
111                     die "Column count discrepancy while getting rel info";
112                 }
113
114                 my %cond;
115                 for(my $i = 0; $i < @self_cols; $i++) {
116                     $cond{$other_cols[$i]} = $self_cols[$i];
117                 }
118
119                 eval { $class->_belongs_to_many ($table, $other, \%cond); };
120                 warn qq/\# belongs_to_many failed "$@"\n\n/
121                   if $@ && $class->debug_loader;
122             }
123         }
124     }
125
126     $sth->finish;
127     $dbh->disconnect;
128 }
129
130 =head1 SEE ALSO
131
132 L<DBIx::Class::Schema::Loader>
133
134 =cut
135
136 1;