lib/DBIx/Class/Loader/DB2.pm

   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 $db_schema = uc ($args{db_schema} || '');
  42     my $dbh = $self->{_storage}->dbh;
  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     # 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;
  53     @tables = grep {/^$db_schema\./} @tables if($db_schema);
  54     return @tables;
  55 }
  56
  57 sub _table_info {
  58     my ( $self, $table ) = @_;
  59 #    $|=1;
  60 #    print "_table_info($table)\n";
  61     my ($db_schema, $tabname) = split /\./, $table, 2;
  62     # print "DB_Schema: $db_schema, Table: $tabname\n";
  63
  64     # FIXME: Horribly inefficient and just plain evil. (JMM)
  65     my $dbh = $self->{_storage}->dbh;
  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
  74     $sth->execute($db_schema, $tabname) or die;
  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
  84     $sth->execute($db_schema, $tabname) or die;
  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;