From: Earl Cahill Date: Thu, 9 Mar 2006 19:24:32 +0000 (+0000) Subject: initial adds for the oracle dbi parser and a simple test to make sure the use works X-Git-Tag: v0.11008~462 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bef2169c7cb2cb710e0d638c0e3749131f02e914;p=dbsrgits%2FSQL-Translator.git initial adds for the oracle dbi parser and a simple test to make sure the use works --- diff --git a/lib/SQL/Translator/Parser/DBI/Oracle.pm b/lib/SQL/Translator/Parser/DBI/Oracle.pm new file mode 100644 index 0000000..f2d4148 --- /dev/null +++ b/lib/SQL/Translator/Parser/DBI/Oracle.pm @@ -0,0 +1,163 @@ +package SQL::Translator::Parser::DBI::Oracle; + +use O::Is; +# ------------------------------------------------------------------- +# $Id: Oracle.pm,v 1.1 2006-03-09 19:24:32 cahille Exp $ +# ------------------------------------------------------------------- +# Copyright (C) 2006 SQLFairy Authors +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=head1 NAME + +SQL::Translator::Parser::DBI::Oracle - parser for DBD::Oracle + +=head1 SYNOPSIS + +See SQL::Translator::Parser::DBI. + +=head1 DESCRIPTION + +Uses DBI introspection methods to determine schema details. + +=cut + +use strict; +use warnings; +use DBI; +use SQL::Translator::Schema::Constants; +use SQL::Translator::Schema::Table; +use SQL::Translator::Schema::Field; +use SQL::Translator::Schema::Constraint; + +our $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; + +# ------------------------------------------------------------------- +sub parse { + my ( $tr, $dbh ) = @_; + + my $schema = $tr->schema; + + my $sth = $dbh->table_info(); + + while(my $table_info = $sth->fetchrow_hashref('NAME_uc')) { + next unless ($table_info->{TABLE_TYPE} eq 'TABLE'); + next if ($table_info->{TABLE_NAME} =~ /\$/); + + # create the table + + my $table = $schema->add_table( + name => $table_info->{TABLE_NAME}, + type => $table_info->{TABLE_TYPE}, + ); + + # add the fields (columns) for this table + + my $sth; + + $sth = $dbh->column_info( + undef, + $table_info->{TABLE_SCHEM}, + $table_info->{TABLE_NAME}, + '%' + ); + + while(my $column = $sth->fetchrow_hashref('NAME_uc')) { + my $f = $table->add_field( + name => $column->{COLUMN_NAME}, + default_value => $column->{COLUMN_DEF}, + data_type => $column->{TYPE_NAME}, + order => $column->{ORDINAL_POSITION}, + size => $column->{COLUMN_SIZE}, + ) || die $table->error; + + $f->is_nullable( $column->{NULLABLE} == 1 ); + } + + # add the primary key info + + $sth = $dbh->primary_key_info( + undef, + $table_info->{TABLE_SCHEM}, + $table_info->{TABLE_NAME}, + ); + + while(my $primary_key = $sth->fetchrow_hashref('NAME_uc')) { + my $f = $table->get_field( $primary_key->{COLUMN_NAME} ); + $f->is_primary_key(1); + } + + # add the foreign key info (constraints) + + $sth = $dbh->foreign_key_info( + undef, + undef, + undef, + undef, + $table_info->{TABLE_SCHEM}, + $table_info->{TABLE_NAME}, + ); + + my $cons = {}; + while(my $foreign_key = $sth->fetchrow_hashref('NAME_uc')) { + my $name = $foreign_key->{FK_NAME}; + $cons->{$name}->{reference_table} = $foreign_key->{UK_TABLE_NAME}; + push @{ $cons->{$name}->{fields} }, + $foreign_key->{FK_COLUMN_NAME}; + push @{ $cons->{$name}->{reference_fields} }, + $foreign_key->{UK_COLUMN_NAME}; + } + + for my $name ( keys %$cons ) { + my $c = $table->add_constraint( + type => FOREIGN_KEY, + name => $name, + fields => $cons->{$name}->{fields}, + reference_fields => $cons->{$name}->{reference_fields}, + reference_table => $cons->{$name}->{reference_table}, + ) || die $table->error; + } + } + + return 1; +} + +1; + +=pod + +=head1 AUTHOR + +Earl Cahill Ecpan@spack.netE. + +=head1 ACKNOWLEDGEMENT + +Initial revision of this module came almost entirely from work done by +Todd Hepler Ethepler@freeshell.orgE. My changes were +quite minor (ensuring NAME_uc, changing a couple variable names, +skipping tables with a $ in them). + +Todd claimed his work to be an almost verbatim copy of +SQL::Translator::Parser::DBI::PostgreSQL revision 1.7 + +For me, the real work happens in DBD::Oracle and DBI, which, also +for me, that is the beauty of having introspection methods in DBI. + +=head1 SEE ALSO + +SQL::Translator, DBD::Oracle. + +=cut diff --git a/t/40oracle-parser-dbi.t b/t/40oracle-parser-dbi.t new file mode 100755 index 0000000..1c94dd8 --- /dev/null +++ b/t/40oracle-parser-dbi.t @@ -0,0 +1,20 @@ +#!/usr/bin/perl +# vim: set ft=perl ts=4 et: +# + +# $Source: /home/faga/work/sqlfairy_svn/sqlfairy-cvsbackup/sqlfairy/t/40oracle-parser-dbi.t,v $ +# $Id: 40oracle-parser-dbi.t,v 1.1 2006-03-09 19:24:32 cahille Exp $ + +use strict; +use Test::More; +use Test::SQL::Translator qw(maybe_plan); + +BEGIN { + maybe_plan(1, + 'SQL::Translator::Parser::DBI::Oracle', + ); +} + +use_ok('SQL::Translator::Parser::DBI::Oracle'); + +1;