lib/SQL/Translator/Parser/DBI/Dialect.pm

   1 package SQL::Translator::Parser::DBI::Dialect;
   2 use Moose::Role;
   3 use MooseX::Types::Moose qw(Str);
   4 use SQL::Translator::Types qw(DBIHandle);
   5 use SQL::Translator::Object::Column;
   6 use SQL::Translator::Object::Table;
   7 use SQL::Translator::Object::Schema;
   8
   9 has 'dbh' => (
  10   is => 'rw',
  11   isa => DBIHandle,
  12   required => 1
  13 );
  14
  15 has 'quoter' => (
  16   is => 'rw',
  17   isa => Str,
  18   requried => 1,
  19   lazy => 1,
  20   default => sub { shift->dbh->get_info(29) || q{"} }
  21 );
  22
  23 has 'namesep' => (
  24   is => 'rw',
  25   isa => Str,
  26   required => 1,
  27   lazy => 1,
  28   default => sub { shift->dbh->get_info(41) || '.' }
  29 );
  30
  31 sub BUILD {
  32 }
  33
  34 sub _tables_list {
  35     my $self = shift;
  36
  37     my $dbh = $self->dbh;
  38     my $quoter = $self->quoter;
  39     my $namesep = $self->namesep;
  40
  41     my @tables = $dbh->tables(undef, $self->schema->name, '%', '%');
  42
  43     s/\Q$quoter\E//g for @tables;
  44     s/^.*\Q$namesep\E// for @tables;
  45
  46     my %retval;
  47     map { $retval{$_} = SQL::Translator::Object::Table->new({ name => $_, schema => $self->schema }) } @tables;
  48
  49     return \%retval;
  50 }
  51
  52 sub _table_columns {
  53     my ($self, $table) = @_;
  54
  55     my $dbh = $self->dbh;
  56
  57     if($self->schema->name) {
  58         $table = $self->schema->name . $self->namesep . $table;
  59     }
  60
  61     my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1 = 0");
  62     $sth->execute;
  63
  64     my $retval = \@{$sth->{NAME_lc}};
  65     $sth->finish;
  66
  67     $retval;
  68 }
  69
  70 sub _table_pk_info {
  71     my ($self, $table) = @_;
  72
  73     my $dbh = $self->dbh;
  74     my $quoter = $self->quoter;
  75
  76     my @primary = map { lc } $dbh->primary_key('', $self->schema->name, $table);
  77     s/\Q$quoter\E//g for @primary;
  78
  79     my $sth = $dbh->primary_key_info('', $self->schema->name, $table);
  80     use Data::Dumper;
  81     while ( my $info = $sth->fetchrow_hashref() ) {
  82 #        my $column = SQL::Translator::Object::Column->new( { name => $info->{COLUMN_NAME}, size => undef, data_type => $info->{
  83         print Dumper($info);
  84     }
  85
  86     return \@primary;
  87 }
  88
  89 sub _table_fk_info {
  90     my ($self, $table) = @_;
  91
  92     my $dbh = $self->dbh;
  93     my $quoter = $self->quoter;
  94     my $sth = $dbh->foreign_key_info( '', $self->schema, '',
  95                                       '', $self->schema, $table );
  96     return [] if !$sth;
  97
  98     my %rels;
  99
 100     my $i = 1; # for unnamed rels, which hopefully have only 1 column ...
 101     while(my $raw_rel = $sth->fetchrow_arrayref) {
 102         my $uk_tbl  = $raw_rel->[2];
 103         my $uk_col  = lc $raw_rel->[3];
 104         my $fk_col  = lc $raw_rel->[7];
 105         my $relid   = ($raw_rel->[11] || ( "__dcsld__" . $i++ ));
 106         $uk_tbl =~ s/\Q$quoter\E//g;
 107         $uk_col =~ s/\Q$quoter\E//g;
 108         $fk_col =~ s/\Q$quoter\E//g;
 109         $relid  =~ s/\Q$quoter\E//g;
 110         $rels{$relid}->{tbl} = $uk_tbl;
 111         $rels{$relid}->{cols}->{$uk_col} = $fk_col;
 112     }
 113     $sth->finish;
 114
 115     my @rels;
 116     foreach my $relid (keys %rels) {
 117         push(@rels, {
 118             remote_columns => [ keys   %{$rels{$relid}->{cols}} ],
 119             local_columns  => [ values %{$rels{$relid}->{cols}} ],
 120             remote_table   => $rels{$relid}->{tbl},
 121         });
 122     }
 123
 124     return \@rels;
 125 }
 126
 127 sub _table_uniq_info {
 128     my ($self, $table) = @_;
 129
 130     my $dbh = $self->dbh;
 131     if(!$dbh->can('statistics_info')) {
 132         warn "No UNIQUE constraint information can be gathered for this vendor";
 133         return [];
 134     }
 135
 136     my %indices;
 137     my $sth = $dbh->statistics_info(undef, $self->schema->name, $table, 1, 1);
 138     while(my $row = $sth->fetchrow_hashref) {
 139         # skip table-level stats, conditional indexes, and any index missing
 140         #  critical fields
 141         next if $row->{TYPE} eq 'table'
 142             || defined $row->{FILTER_CONDITION}
 143             || !$row->{INDEX_NAME}
 144             || !defined $row->{ORDINAL_POSITION}
 145             || !$row->{COLUMN_NAME};
 146
 147         $indices{$row->{INDEX_NAME}}->{$row->{ORDINAL_POSITION}} = $row->{COLUMN_NAME};
 148     }
 149     $sth->finish;
 150
 151     my @retval;
 152     foreach my $index_name (keys %indices) {
 153         my $index = $indices{$index_name};
 154         push(@retval, [ $index_name => [
 155             map { $index->{$_} }
 156                 sort keys %$index
 157         ]]);
 158     }
 159
 160     return \@retval;
 161 }
 162
 163 sub _columns_info_for {
 164     my ($self, $table) = @_;
 165
 166     my $dbh = $self->dbh;
 167
 168     if ($dbh->can('column_info')) {
 169         my %result;
 170         eval {
 171             my $sth = $dbh->column_info( undef, $self->schema->name, $table, '%' );
 172             while ( my $info = $sth->fetchrow_hashref() ) {
 173                 my (%column_info, $col_name);
 174                 $column_info{data_type}     = $info->{TYPE_NAME};
 175                 $column_info{size}          = $info->{COLUMN_SIZE};
 176                 $column_info{is_nullable}   = $info->{NULLABLE} ? 1 : 0;
 177                 $column_info{default_value} = $info->{COLUMN_DEF};
 178                 $column_info{index}         = $info->{ORDINAL_POSITION};
 179                 $column_info{remarks}       = $info->{REMARKS};
 180                 $col_name                   = $info->{COLUMN_NAME};
 181                 $col_name =~ s/^\"(.*)\"$/$1/;
 182                 $column_info{name} = $col_name;
 183
 184                 my $extra_info = $self->_extra_column_info($info) || {};
 185                 my $column = SQL::Translator::Object::Column->new(%column_info);
 186
 187 #                $result{$col_name} = { %column_info, %$extra_info };
 188                 $result{$col_name} = $column;
 189             }
 190             $sth->finish;
 191         };
 192       return \%result if !$@ && scalar keys %result;
 193       print "OH NOES, $@\n";
 194     }
 195
 196     if($self->schema->name) {
 197         $table = $self->schema->name . $self->namesep . $table;
 198     }
 199     my %result;
 200     my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1 = 0");
 201     $sth->execute;
 202     my @columns = @{$sth->{NAME_lc}};
 203     for my $i ( 0 .. $#columns ) {
 204         my %column_info;
 205         $column_info{data_type}   = $sth->{TYPE}->[$i];
 206         $column_info{size}        = $sth->{PRECISION}->[$i];
 207         $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
 208         $column_info{index} = $i;
 209
 210         if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
 211             $column_info{data_type} = $1;
 212             $column_info{size}      = $2;
 213         }
 214
 215         my $extra_info = $self->_extra_column_info($table, $columns[$i], $sth, $i) || {};
 216
 217 #        $result{$columns[$i]} = { %column_info, %$extra_info };
 218         $column_info{name} = $columns[$i];
 219         my $column = SQL::Translator::Object::Column->new(%column_info);
 220         $result{$columns[$i]} = $column;
 221
 222     }
 223     $sth->finish;
 224
 225     foreach my $col (keys %result) {
 226         my $colinfo = $result{$col};
 227         my $type_num = $colinfo->{data_type};
 228         my $type_name;
 229         if (defined $type_num && $dbh->can('type_info')) {
 230             my $type_info = $dbh->type_info($type_num);
 231             $type_name = $type_info->{TYPE_NAME} if $type_info;
 232             $colinfo->{data_type} = $type_name if $type_name;
 233         }
 234     }
 235
 236     return \%result;
 237 }
 238
 239 sub _extra_column_info { }
 240
 241 1;