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

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