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

   1 package SQL::Translator::Parser::DBI::Oracle;
   2
   3 # -------------------------------------------------------------------
   4 # $Id$
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2006-2009 SQLFairy Authors
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =head1 NAME
  24
  25 SQL::Translator::Parser::DBI::Oracle - parser for DBD::Oracle
  26
  27 =head1 SYNOPSIS
  28
  29 See SQL::Translator::Parser::DBI.
  30
  31 =head1 DESCRIPTION
  32
  33 Uses DBI introspection methods to determine schema details.
  34
  35 =cut
  36
  37 use strict;
  38 use warnings;
  39 use DBI;
  40 use SQL::Translator::Schema::Constants;
  41 use SQL::Translator::Schema::Table;
  42 use SQL::Translator::Schema::Field;
  43 use SQL::Translator::Schema::Constraint;
  44
  45 our $VERSION = '1.99';
  46
  47 # -------------------------------------------------------------------
  48 sub parse {
  49     my ( $tr, $dbh ) = @_;
  50
  51     my $schema = $tr->schema;
  52
  53     my $sth = $dbh->table_info();
  54
  55     while(my $table_info = $sth->fetchrow_hashref('NAME_uc')) {
  56         next unless ($table_info->{TABLE_TYPE} eq 'TABLE');
  57         next if ($table_info->{TABLE_NAME} =~ /\$/);
  58
  59         # create the table
  60
  61         my $table = $schema->add_table(
  62             name => $table_info->{TABLE_NAME},
  63             type => $table_info->{TABLE_TYPE},
  64         );
  65
  66         # add the fields (columns) for this table
  67
  68         my $sth;
  69
  70         $sth = $dbh->column_info(
  71             undef,
  72             $table_info->{TABLE_SCHEM},
  73             $table_info->{TABLE_NAME},
  74             '%'
  75         );
  76
  77         while(my $column = $sth->fetchrow_hashref('NAME_uc')) {
  78             my $f = $table->add_field(
  79                 name          => $column->{COLUMN_NAME},
  80                 default_value => $column->{COLUMN_DEF},
  81                 data_type     => $column->{TYPE_NAME},
  82                 order         => $column->{ORDINAL_POSITION},
  83                 size          => $column->{COLUMN_SIZE},
  84             ) || die $table->error;
  85
  86             $f->is_nullable( $column->{NULLABLE} == 1 );
  87         }
  88
  89         # add the primary key info
  90
  91         $sth = $dbh->primary_key_info(
  92             undef,
  93             $table_info->{TABLE_SCHEM},
  94             $table_info->{TABLE_NAME},
  95         );
  96
  97         while(my $primary_key = $sth->fetchrow_hashref('NAME_uc')) {
  98             my $f = $table->get_field( $primary_key->{COLUMN_NAME} );
  99             $f->is_primary_key(1);
 100         }
 101
 102         # add the foreign key info (constraints)
 103
 104         $sth = $dbh->foreign_key_info(
 105             undef,
 106             undef,
 107             undef,
 108             undef,
 109             $table_info->{TABLE_SCHEM},
 110             $table_info->{TABLE_NAME},
 111         );
 112
 113         my $cons = {};
 114         while(my $foreign_key = $sth->fetchrow_hashref('NAME_uc')) {
 115             my $name = $foreign_key->{FK_NAME};
 116             $cons->{$name}->{reference_table} = $foreign_key->{UK_TABLE_NAME};
 117             push @{ $cons->{$name}->{fields} },
 118                 $foreign_key->{FK_COLUMN_NAME};
 119             push @{ $cons->{$name}->{reference_fields} },
 120                 $foreign_key->{UK_COLUMN_NAME};
 121         }
 122
 123         for my $name ( keys %$cons ) {
 124             my $c = $table->add_constraint(
 125                 type             => FOREIGN_KEY,
 126                 name             => $name,
 127                 fields           => $cons->{$name}->{fields},
 128                 reference_fields => $cons->{$name}->{reference_fields},
 129                 reference_table  => $cons->{$name}->{reference_table},
 130             ) || die $table->error;
 131         }
 132     }
 133
 134     return 1;
 135 }
 136
 137 1;
 138
 139 =pod
 140
 141 =head1 AUTHOR
 142
 143 Earl Cahill E<lt>cpan@spack.netE<gt>.
 144
 145 =head1 ACKNOWLEDGEMENT
 146
 147 Initial revision of this module came almost entirely from work done by
 148 Todd Hepler E<lt>thepler@freeshell.orgE<gt>.  My changes were
 149 quite minor (ensuring NAME_uc, changing a couple variable names,
 150 skipping tables with a $ in them).
 151
 152 Todd claimed his work to be an almost verbatim copy of
 153 SQL::Translator::Parser::DBI::PostgreSQL revision 1.7
 154
 155 For me, the real work happens in DBD::Oracle and DBI, which, also
 156 for me, that is the beauty of having introspection methods in DBI.
 157
 158 =head1 SEE ALSO
 159
 160 SQL::Translator, DBD::Oracle.
 161
 162 =cut