Commit | Line | Data |
a78e3fed |
1 | package DBIx::Class::Loader::DB2; |
2 | |
3 | use strict; |
4 | use base 'DBIx::Class::Loader::Generic'; |
5 | use DBI; |
6 | use Carp; |
7 | |
8 | =head1 NAME |
9 | |
10 | DBIx::Class::Loader::DB2 - DBIx::Class::Loader DB2 Implementation. |
11 | |
12 | =head1 SYNOPSIS |
13 | |
14 | use DBIx::Class::Loader; |
15 | |
16 | # $loader is a DBIx::Class::Loader::DB2 |
17 | my $loader = DBIx::Class::Loader->new( |
18 | dsn => "dbi:DB2:dbname", |
19 | user => "myuser", |
20 | password => "", |
21 | namespace => "Data", |
22 | schema => "MYSCHEMA", |
23 | dropschema => 0, |
24 | ); |
25 | my $class = $loader->find_class('film'); # $class => Data::Film |
26 | my $obj = $class->retrieve(1); |
27 | |
28 | =head1 DESCRIPTION |
29 | |
30 | See L<DBIx::Class::Loader>. |
31 | |
32 | =cut |
33 | |
34 | sub _db_classes { |
35 | return (); |
36 | } |
37 | |
38 | sub _tables { |
39 | my $self = shift; |
40 | my %args = @_; |
af6c2665 |
41 | my $db_schema = uc ($args{db_schema} || ''); |
42 | my $dbh = $self->{_storage}->dbh; |
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? |
51 | s/\"//g for @tables; |
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 | |
57 | sub _table_info { |
58 | my ( $self, $table ) = @_; |
59 | # $|=1; |
60 | # print "_table_info($table)\n"; |
af6c2665 |
61 | my ($db_schema, $tabname) = split /\./, $table, 2; |
62 | # print "DB_Schema: $db_schema, Table: $tabname\n"; |
a78e3fed |
63 | |
64 | # FIXME: Horribly inefficient and just plain evil. (JMM) |
af6c2665 |
65 | my $dbh = $self->{_storage}->dbh; |
a78e3fed |
66 | $dbh->{RaiseError} = 1; |
67 | |
68 | my $sth = $dbh->prepare(<<'SQL') or die; |
69 | SELECT c.COLNAME |
70 | FROM SYSCAT.COLUMNS as c |
71 | WHERE c.TABSCHEMA = ? and c.TABNAME = ? |
72 | SQL |
73 | |
af6c2665 |
74 | $sth->execute($db_schema, $tabname) or die; |
a78e3fed |
75 | my @cols = map { @$_ } @{$sth->fetchall_arrayref}; |
76 | |
77 | $sth = $dbh->prepare(<<'SQL') or die; |
78 | SELECT kcu.COLNAME |
79 | FROM SYSCAT.TABCONST as tc |
80 | JOIN SYSCAT.KEYCOLUSE as kcu ON tc.constname = kcu.constname |
81 | WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'P' |
82 | SQL |
83 | |
af6c2665 |
84 | $sth->execute($db_schema, $tabname) or die; |
a78e3fed |
85 | |
86 | my @pri = map { @$_ } @{$sth->fetchall_arrayref}; |
87 | |
88 | return ( \@cols, \@pri ); |
89 | } |
90 | |
91 | =head1 SEE ALSO |
92 | |
93 | L<DBIx::Class::Loader> |
94 | |
95 | =cut |
96 | |
97 | 1; |