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 DBI;
   6 use Carp;
   7
   8 =head1 NAME
   9
  10 DBIx::Class::Schema::Loader::DB2 - DBIx::Class::Schema::Loader DB2 Implementation.
  11
  12 =head1 SYNOPSIS
  13
  14   use DBIx::Schema::Class::Loader;
  15
  16   # $loader is a DBIx::Class::Schema::Loader::DB2
  17   my $loader = DBIx::Class::Schema::Loader->new(
  18     dsn       => "dbi:DB2:dbname",
  19     user      => "myuser",
  20     password  => "",
  21     namespace => "Data",
  22     schema    => "MYSCHEMA",
  23     dropschema  => 0,
  24   );
  25
  26 =head1 DESCRIPTION
  27
  28 See L<DBIx::Class::Schema::Loader>.
  29
  30 =cut
  31
  32 sub _db_classes {
  33    return ();
  34 }
  35
  36 sub _tables {
  37     my $self = shift;
  38     my %args = @_;
  39     my $db_schema = uc ($args{db_schema} || '');
  40     my $dbh = $self->{_storage}->dbh;
  41
  42     # this is split out to avoid version parsing errors...
  43     my $is_dbd_db2_gte_114 = ( $DBD::DB2::VERSION >= 1.14 );
  44     my @tables = $is_dbd_db2_gte_114 ?
  45     $dbh->tables( { TABLE_SCHEM => '%', TABLE_TYPE => 'TABLE,VIEW' } )
  46         : $dbh->tables;
  47     # People who use table or schema names that aren't identifiers deserve
  48     # what they get.  Still, FIXME?
  49     s/\"//g for @tables;
  50     @tables = grep {!/^SYSIBM\./ and !/^SYSCAT\./ and !/^SYSSTAT\./} @tables;
  51     @tables = grep {/^$db_schema\./} @tables if($db_schema);
  52     return @tables;
  53 }
  54
  55 sub _table_info {
  56     my ( $self, $table ) = @_;
  57 #    $|=1;
  58 #    print "_table_info($table)\n";
  59     my ($db_schema, $tabname) = split /\./, $table, 2;
  60     # print "DB_Schema: $db_schema, Table: $tabname\n";
  61
  62     # FIXME: Horribly inefficient and just plain evil. (JMM)
  63     my $dbh = $self->{_storage}->dbh;
  64     $dbh->{RaiseError} = 1;
  65
  66     my $sth = $dbh->prepare(<<'SQL') or die;
  67 SELECT c.COLNAME
  68 FROM SYSCAT.COLUMNS as c
  69 WHERE c.TABSCHEMA = ? and c.TABNAME = ?
  70 SQL
  71
  72     $sth->execute($db_schema, $tabname) or die;
  73     my @cols = map { @$_ } @{$sth->fetchall_arrayref};
  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 { @$_ } @{$sth->fetchall_arrayref};
  85
  86     return ( \@cols, \@pri );
  87 }
  88
  89 =head1 SEE ALSO
  90
  91 L<DBIx::Class::Schema::Loader>
  92
  93 =cut
  94
  95 1;