DBIx-Class-Loader/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 $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;