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 = @_; |
41 | my $schema = uc ($args{schema} || ''); |
42 | my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr); |
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; |
49 | $dbh->disconnect; |
50 | # People who use table or schema names that aren't identifiers deserve |
51 | # what they get. Still, FIXME? |
52 | s/\"//g for @tables; |
53 | @tables = grep {!/^SYSIBM\./ and !/^SYSCAT\./ and !/^SYSSTAT\./} @tables; |
54 | @tables = grep {/^$schema\./} @tables if($schema); |
55 | return @tables; |
56 | } |
57 | |
58 | sub _table_info { |
59 | my ( $self, $table ) = @_; |
60 | # $|=1; |
61 | # print "_table_info($table)\n"; |
62 | my ($schema, $tabname) = split /\./, $table, 2; |
63 | # print "Schema: $schema, Table: $tabname\n"; |
64 | |
65 | # FIXME: Horribly inefficient and just plain evil. (JMM) |
66 | my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr); |
67 | $dbh->{RaiseError} = 1; |
68 | |
69 | my $sth = $dbh->prepare(<<'SQL') or die; |
70 | SELECT c.COLNAME |
71 | FROM SYSCAT.COLUMNS as c |
72 | WHERE c.TABSCHEMA = ? and c.TABNAME = ? |
73 | SQL |
74 | |
75 | $sth->execute($schema, $tabname) or die; |
76 | my @cols = map { @$_ } @{$sth->fetchall_arrayref}; |
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 | |
85 | $sth->execute($schema, $tabname) or die; |
86 | $dbh->disconnect; |
87 | |
88 | my @pri = map { @$_ } @{$sth->fetchall_arrayref}; |
89 | |
90 | return ( \@cols, \@pri ); |
91 | } |
92 | |
93 | =head1 SEE ALSO |
94 | |
95 | L<DBIx::Class::Loader> |
96 | |
97 | =cut |
98 | |
99 | 1; |