lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm

   1 package DBIx::Class::Schema::Loader::DBI::Oracle;
   2
   3 use strict;
   4 use warnings;
   5 use base 'DBIx::Class::Schema::Loader::DBI';
   6 use Carp::Clan qw/^DBIx::Class/;
   7 use Class::C3;
   8
   9 our $VERSION = '0.04000';
  10
  11 =head1 NAME
  12
  13 DBIx::Class::Schema::Loader::DBI::Oracle - DBIx::Class::Schema::Loader::DBI
  14 Oracle Implementation.
  15
  16 =head1 SYNOPSIS
  17
  18   package My::Schema;
  19   use base qw/DBIx::Class::Schema::Loader/;
  20
  21   __PACKAGE__->loader_options( debug => 1 );
  22
  23   1;
  24
  25 =head1 DESCRIPTION
  26
  27 See L<DBIx::Class::Schema::Loader::Base>.
  28
  29 This module is considered experimental and not well tested yet.
  30
  31 =cut
  32
  33 sub _table_columns {
  34     my ($self, $table) = @_;
  35
  36     my $dbh = $self->schema->storage->dbh;
  37
  38     my $sth = $dbh->prepare($self->schema->storage->sql_maker->select($table, undef, \'1 = 0'));
  39     $sth->execute;
  40     return \@{$sth->{NAME_lc}};
  41 }
  42
  43 sub _tables_list {
  44     my $self = shift;
  45
  46     my $dbh = $self->schema->storage->dbh;
  47
  48     my @tables;
  49     for my $table ( $dbh->tables(undef, $self->db_schema, '%', 'TABLE,VIEW') ) { #catalog, schema, table, type
  50         my $quoter = $dbh->get_info(29);
  51         $table =~ s/$quoter//g;
  52
  53         # remove "user." (schema) prefixes
  54         $table =~ s/\w+\.//;
  55
  56         next if $table eq 'PLAN_TABLE';
  57         $table = lc $table;
  58         push @tables, $1
  59           if $table =~ /\A(\w+)\z/;
  60     }
  61     return @tables;
  62 }
  63
  64 sub _table_uniq_info {
  65     my ($self, $table) = @_;
  66
  67     my @uniqs;
  68     my $dbh = $self->schema->storage->dbh;
  69
  70     my $sth = $dbh->prepare_cached(
  71         qq{SELECT constraint_name, ucc.column_name FROM user_constraints JOIN user_cons_columns ucc USING (constraint_name) WHERE ucc.table_name=? AND constraint_type='U'}
  72     ,{}, 1);
  73
  74     $sth->execute(uc $table);
  75     my %constr_names;
  76     while(my $constr = $sth->fetchrow_arrayref) {
  77         my $constr_name = $constr->[0];
  78         my $constr_def  = $constr->[1];
  79         $constr_name =~ s/\Q$self->{_quoter}\E//;
  80         $constr_def =~ s/\Q$self->{_quoter}\E//;
  81         push @{$constr_names{$constr_name}}, lc $constr_def;
  82     }
  83     map {
  84         push(@uniqs, [ lc $_ => $constr_names{$_} ]);
  85     } keys %constr_names;
  86
  87     return \@uniqs;
  88 }
  89
  90 sub _table_pk_info {
  91     my ( $self, $table ) = @_;
  92     return $self->SUPER::_table_pk_info(uc $table);
  93 }
  94
  95 sub _table_fk_info {
  96     my ($self, $table) = @_;
  97
  98     my $dbh = $self->schema->storage->dbh;
  99     my $sth = $dbh->foreign_key_info( '', '', '', '',
 100         $self->db_schema, uc $table );
 101     return [] if !$sth;
 102
 103     my %rels;
 104
 105     my $i = 1; # for unnamed rels, which hopefully have only 1 column ...
 106     while(my $raw_rel = $sth->fetchrow_arrayref) {
 107         my $uk_tbl  = lc $raw_rel->[2];
 108         my $uk_col  = lc $raw_rel->[3];
 109         my $fk_col  = lc $raw_rel->[7];
 110         my $relid   = ($raw_rel->[11] || ( "__dcsld__" . $i++ ));
 111         $uk_tbl =~ s/\Q$self->{_quoter}\E//g;
 112         $uk_col =~ s/\Q$self->{_quoter}\E//g;
 113         $fk_col =~ s/\Q$self->{_quoter}\E//g;
 114         $relid  =~ s/\Q$self->{_quoter}\E//g;
 115         $rels{$relid}->{tbl} = $uk_tbl;
 116         $rels{$relid}->{cols}->{$uk_col} = $fk_col;
 117     }
 118
 119     my @rels;
 120     foreach my $relid (keys %rels) {
 121         push(@rels, {
 122             remote_columns => [ keys   %{$rels{$relid}->{cols}} ],
 123             local_columns  => [ values %{$rels{$relid}->{cols}} ],
 124             remote_table   => $rels{$relid}->{tbl},
 125         });
 126     }
 127
 128     return \@rels;
 129 }
 130
 131 =head1 SEE ALSO
 132
 133 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
 134 L<DBIx::Class::Schema::Loader::DBI>
 135
 136 =head1 AUTHOR
 137
 138 TSUNODA Kazuya C<drk@drk7.jp>
 139
 140 =cut
 141
 142 1;