943 lines
26 KiB
Perl
943 lines
26 KiB
Perl
package Ora2Pg;
|
|
#------------------------------------------------------------------------------
|
|
# Project : Oracle to PostgreSQL database schema converter
|
|
# Name : Ora2Pg.pm
|
|
# Language : 5.006 built for i686-linux
|
|
# OS : linux RedHat 6.2 kernel 2.2.14-5
|
|
# Authors : Gilles Darold, gilles@darold.net
|
|
# Copyright: Copyright (c) 2000 : Gilles Darold - All rights reserved -
|
|
# Function : Main module used to export Oracle database schema to PostgreSQL
|
|
# Usage : See documentation in this file with perldoc.
|
|
#------------------------------------------------------------------------------
|
|
# This program is free software; you can redistribute it and/or modify it under
|
|
# the same terms as Perl itself.
|
|
#------------------------------------------------------------------------------
|
|
|
|
use strict;
|
|
use vars qw($VERSION);
|
|
use Carp qw(confess);
|
|
use DBI;
|
|
|
|
$VERSION = "1.2";
|
|
|
|
|
|
=head1 NAME
|
|
|
|
Ora2Pg - Oracle to PostgreSQL database schema converter
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
BEGIN {
|
|
$ENV{ORACLE_HOME} = '/usr/local/oracle/oracle816';
|
|
}
|
|
|
|
use strict;
|
|
|
|
use Ora2Pg;
|
|
|
|
# Init the database connection
|
|
my $dbsrc = 'dbi:Oracle:host=testdb.samse.fr;sid=TEST;port=1521';
|
|
my $dbuser = 'system';
|
|
my $dbpwd = 'manager';
|
|
|
|
# Create an instance of the Ora2Pg perl module
|
|
my $schema = new Ora2Pg (
|
|
datasource => $dbsrc, # Database DBD datasource
|
|
user => $dbuser, # Database user
|
|
password => $dbpwd, # Database password
|
|
);
|
|
|
|
# Create the POSTGRESQL representation of all objects in the database
|
|
$schema->export_schema("output.sql");
|
|
|
|
exit(0);
|
|
|
|
or if you only want to extract some tables:
|
|
|
|
# Create an instance of the Ora2Pg perl module
|
|
my @tables = ('tab1', 'tab2', 'tab3');
|
|
my $schema = new Ora2Pg (
|
|
datasource => $dbsrc, # Database DBD datasource
|
|
user => $dbuser, # Database user
|
|
password => $dbpwd, # Database password
|
|
tables => \@tables, # Tables to extract
|
|
debug => 1 # To show somethings when running
|
|
);
|
|
|
|
or if you only want to extract the 10 first tables:
|
|
|
|
# Create an instance of the Ora2Pg perl module
|
|
my $schema = new Ora2Pg (
|
|
datasource => $dbsrc, # Database DBD datasource
|
|
user => $dbuser, # Database user
|
|
password => $dbpwd, # Database password
|
|
max => 10 # 10 first tables to extract
|
|
);
|
|
|
|
or if you only want to extract tables 10 to 20:
|
|
|
|
# Create an instance of the Ora2Pg perl module
|
|
my $schema = new Ora2Pg (
|
|
datasource => $dbsrc, # Database DBD datasource
|
|
user => $dbuser, # Database user
|
|
password => $dbpwd, # Database password
|
|
min => 10 # Begin extraction at indice 10
|
|
max => 20 # End extraction at indice 20
|
|
);
|
|
|
|
To know at which indices table can be found during extraction use the option:
|
|
|
|
showtableid => 1
|
|
|
|
To extract all views set the option type as follow:
|
|
|
|
type => 'VIEW'
|
|
|
|
Default is table schema extraction
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Ora2Pg is a perl OO module used to export an Oracle database schema
|
|
to a PostgreSQL compatible schema.
|
|
|
|
It simply connect to your Oracle database, extract its structure and
|
|
generate a SQL script that you can load into your PostgreSQL database.
|
|
|
|
I'm not a Oracle DBA so I don't really know something about its internal
|
|
structure so you may find some incorrect things. Please tell me what is
|
|
wrong and what can be better.
|
|
|
|
It currently only dump the database schema, with primary, unique and
|
|
foreign keys. I've tried to excluded internal system tables but perhaps
|
|
not enougt, please let me know.
|
|
|
|
|
|
=head1 ABSTRACT
|
|
|
|
The goal of the Ora2Pg perl module is to cover all part needed to export
|
|
an Oracle database to a PostgreSQL database without other thing that provide
|
|
the connection parameters to the Oracle database.
|
|
|
|
Features must include:
|
|
|
|
- Database schema export, with unique, primary and foreign key.
|
|
- Grants/privileges export by user and group.
|
|
- Indexes and unique indexes export.
|
|
- Table or view selection (by name and max table) export.
|
|
- Predefined function/trigger export (todo)
|
|
- Data export (todo)
|
|
- Sql query converter (todo)
|
|
|
|
My knowledge regarding database is really poor especially for Oracle
|
|
so contribution is welcome.
|
|
|
|
|
|
=head1 REQUIREMENT
|
|
|
|
You just need the DBI and DBD::Oracle perl module to be installed
|
|
|
|
|
|
|
|
=head1 PUBLIC METHODS
|
|
|
|
=head2 new HASH_OPTIONS
|
|
|
|
Creates a new Ora2Pg object.
|
|
|
|
Supported options are:
|
|
|
|
- datasource : DBD datasource (required)
|
|
- user : DBD user (optional with public access)
|
|
- password : DBD password (optional with public access)
|
|
- type : Type of data to extract, can be TABLE (default) or VIEW
|
|
- debug : Print the current state of the parsing
|
|
- tables : Extract only the given tables (arrayref)
|
|
- showtableid : Display only the table indice during extraction
|
|
- min : Indice to begin extraction. Default to 0
|
|
- max : Indice to end extraction. Default to 0 mean no limits
|
|
|
|
Attempt that this list should grow a little more because all initialization is
|
|
done by this way.
|
|
|
|
=cut
|
|
|
|
sub new
|
|
{
|
|
my ($class, %options) = @_;
|
|
|
|
# This create an OO perl object
|
|
my $self = {};
|
|
bless ($self, $class);
|
|
|
|
# Initialize this object
|
|
$self->_init(%options);
|
|
|
|
# Return the instance
|
|
return($self);
|
|
}
|
|
|
|
|
|
=head2 export_sql FILENAME
|
|
|
|
Print SQL conversion output to a filename or
|
|
to STDOUT if no file is given.
|
|
|
|
=cut
|
|
|
|
sub export_schema
|
|
{
|
|
my ($self, $outfile) = @_;
|
|
|
|
if ($outfile) {
|
|
# Send output to the given file
|
|
open(FILE,">$outfile") or die "Can't open $outfile: $!";
|
|
print FILE $self->_get_sql_data();
|
|
close FILE;
|
|
return;
|
|
}
|
|
# Return data as string
|
|
return $self->_get_sql_data();
|
|
|
|
}
|
|
|
|
|
|
#### Private subroutines
|
|
|
|
=head1 PUBLIC METHODS
|
|
|
|
=head2 _init HASH_OPTIONS
|
|
|
|
Initialize a Ora2Pg object instance with a connexion to the
|
|
Oracle database.
|
|
|
|
=cut
|
|
|
|
sub _init
|
|
{
|
|
my ($self, %options) = @_;
|
|
|
|
# Connect the database
|
|
$self->{dbh} = DBI->connect($options{datasource}, $options{user}, $options{password});
|
|
|
|
# Check for connection failure
|
|
if (!$self->{dbh}) {
|
|
die "Error : $DBI::err ... $DBI::errstr\n";
|
|
}
|
|
|
|
$self->{debug} = 0;
|
|
$self->{debug} = 1 if ($options{debug});
|
|
|
|
$self->{limited} = ();
|
|
$self->{limited} = $options{tables} if ($options{tables});
|
|
|
|
$self->{min} = 0;
|
|
$self->{min} = $options{min} if ($options{min});
|
|
|
|
$self->{max} = 0;
|
|
$self->{max} = $options{max} if ($options{max});
|
|
|
|
$self->{showtableid} = 0;
|
|
$self->{showtableid} = $options{showtableid} if ($options{showtableid});
|
|
|
|
$self->{dbh}->{LongReadLen} = 0;
|
|
#$self->{dbh}->{LongTrunkOk} = 1;
|
|
|
|
# Retreive all table informations
|
|
if (!exists $options{type} || ($options{type} eq 'TABLE')) {
|
|
$self->_tables();
|
|
} else {
|
|
$self->{dbh}->{LongReadLen} = 100000;
|
|
$self->_views();
|
|
}
|
|
|
|
# Disconnect from the database
|
|
$self->{dbh}->disconnect() if ($self->{dbh});
|
|
|
|
}
|
|
|
|
|
|
# We provide a DESTROY method so that the autoloader doesn't
|
|
# bother trying to find it. We also close the DB connexion
|
|
sub DESTROY { }
|
|
|
|
|
|
=head2 _tables
|
|
|
|
This function is used to retrieve all table information.
|
|
|
|
Set the main hash of the database structure $self->{tables}.
|
|
Keys are the names of all tables retrieved from the current
|
|
database. Each table information compose an array associated
|
|
to the table_info key as array reference. In other way:
|
|
|
|
$self->{tables}{$class_name}{table_info} = [(OWNER,TYPE)];
|
|
|
|
DBI TYPE can be TABLE, VIEW, SYSTEM TABLE, GLOBAL TEMPORARY, LOCAL TEMPORARY,
|
|
ALIAS, SYNONYM or a data source specific type identifier. This only extract
|
|
TABLE type.
|
|
|
|
It also get the following informations in the DBI object to affect the
|
|
main hash of the database structure :
|
|
|
|
$self->{tables}{$class_name}{field_name} = $sth->{NAME};
|
|
$self->{tables}{$class_name}{field_type} = $sth->{TYPE};
|
|
|
|
It also call these other private subroutine to affect the main hash
|
|
of the database structure :
|
|
|
|
@{$self->{tables}{$class_name}{column_info}} = &_column_info($self, $class_name);
|
|
@{$self->{tables}{$class_name}{primary_key}} = &_primary_key($self, $class_name);
|
|
@{$self->{tables}{$class_name}{unique_key}} = &_unique_key($self, $class_name);
|
|
@{$self->{tables}{$class_name}{foreign_key}} = &_foreign_key($self, $class_name);
|
|
|
|
=cut
|
|
|
|
sub _tables
|
|
{
|
|
my ($self) = @_;
|
|
|
|
# Get all tables information given by the DBI method table_info
|
|
print STDERR "Retrieving table information...\n" if ($self->{debug});
|
|
my $sth = $self->{dbh}->table_info or die $self->{dbh}->errstr;
|
|
my @tables_infos = $sth->fetchall_arrayref();
|
|
|
|
if ($self->{showtableid}) {
|
|
foreach my $table (@tables_infos) {
|
|
for (my $i=0; $i<=$#{$table};$i++) {
|
|
print STDERR "[", $i+1, "] ${$table}[$i]->[2]\n";
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
foreach my $table (@tables_infos) {
|
|
# Set the table information for each class found
|
|
my $i = 1;
|
|
print STDERR "Min table dump set to $self->{min}.\n" if ($self->{debug} && $self->{min});
|
|
print STDERR "Max table dump set to $self->{max}.\n" if ($self->{debug} && $self->{max});
|
|
foreach my $t (@$table) {
|
|
# Jump to desired extraction
|
|
next if (${@$t}[2] =~ /\$/);
|
|
$i++, next if ($self->{min} && ($i < $self->{min}));
|
|
last if ($self->{max} && ($i > $self->{max}));
|
|
next if (($#{$self->{limited}} >= 0) && !grep(/^${@$t}[2]$/, @{$self->{limited}}));
|
|
print STDERR "[$i] " if ($self->{max} || $self->{min});
|
|
print STDERR "Scanning ${@$t}[2] (@$t)...\n" if ($self->{debug});
|
|
|
|
# Check of uniqueness of the table
|
|
if (exists $self->{tables}{${@$t}[2]}{field_name}) {
|
|
print STDERR "Warning duplicate table ${@$t}[2], SYNONYME ? Skipped.\n";
|
|
next;
|
|
}
|
|
|
|
# usually OWNER,TYPE. QUALIFIER is omitted until I know what to do with that
|
|
$self->{tables}{${@$t}[2]}{table_info} = [(${@$t}[1],${@$t}[3])];
|
|
# Set the fields information
|
|
my $sth = $self->{dbh}->prepare("SELECT * FROM ${@$t}[1].${@$t}[2] WHERE 1=0");
|
|
if (!defined($sth)) {
|
|
warn "Can't prepare statement: $DBI::errstr";
|
|
next;
|
|
}
|
|
$sth->execute;
|
|
if ($sth->err) {
|
|
warn "Can't execute statement: $DBI::errstr";
|
|
next;
|
|
}
|
|
$self->{tables}{${@$t}[2]}{field_name} = $sth->{NAME};
|
|
$self->{tables}{${@$t}[2]}{field_type} = $sth->{TYPE};
|
|
|
|
@{$self->{tables}{${@$t}[2]}{column_info}} = &_column_info($self, ${@$t}[2]);
|
|
@{$self->{tables}{${@$t}[2]}{primary_key}} = &_primary_key($self, ${@$t}[2]);
|
|
@{$self->{tables}{${@$t}[2]}{unique_key}} = &_unique_key($self, ${@$t}[2]);
|
|
@{$self->{tables}{${@$t}[2]}{foreign_key}} = &_foreign_key($self, ${@$t}[2]);
|
|
($self->{tables}{${@$t}[2]}{uniqueness}, $self->{tables}{${@$t}[2]}{indexes}) = &_get_indexes($self, ${@$t}[2]);
|
|
$self->{tables}{${@$t}[2]}{grants} = &_get_table_privilege($self, ${@$t}[2]);
|
|
$i++;
|
|
}
|
|
}
|
|
|
|
print STDERR "Retrieving groups/users information...\n" if ($self->{debug});
|
|
$self->{groups} = &_get_roles($self);
|
|
|
|
}
|
|
|
|
|
|
=head2 _views
|
|
|
|
This function is used to retrieve all views information.
|
|
|
|
Set the main hash of the views definition $self->{views}.
|
|
Keys are the names of all views retrieved from the current
|
|
database values are the text definition of the views.
|
|
|
|
It then set the main hash as follow:
|
|
|
|
# Definition of the view
|
|
$self->{views}{$table}{text} = $view_infos{$table};
|
|
# Grants defined on the views
|
|
$self->{views}{$table}{grants} = when I find how...
|
|
|
|
=cut
|
|
|
|
sub _views
|
|
{
|
|
my ($self) = @_;
|
|
|
|
# Get all views information
|
|
print STDERR "Retrieving views information...\n" if ($self->{debug});
|
|
my %view_infos = &_get_views($self);
|
|
|
|
if ($self->{showtableid}) {
|
|
my $i = 1;
|
|
foreach my $table (sort keys %view_infos) {
|
|
print STDERR "[$i] $table\n";
|
|
$i++;
|
|
}
|
|
return;
|
|
}
|
|
|
|
print STDERR "Min view dump set to $self->{min}.\n" if ($self->{debug} && $self->{min});
|
|
print STDERR "Max view dump set to $self->{max}.\n" if ($self->{debug} && $self->{max});
|
|
my $i = 1;
|
|
foreach my $table (sort keys %view_infos) {
|
|
# Set the table information for each class found
|
|
# Jump to desired extraction
|
|
next if ($table =~ /\$/);
|
|
$i++, next if ($self->{min} && ($i < $self->{min}));
|
|
last if ($self->{max} && ($i > $self->{max}));
|
|
next if (($#{$self->{limited}} >= 0) && !grep(/^$table$/, @{$self->{limited}}));
|
|
print STDERR "[$i] " if ($self->{max} || $self->{min});
|
|
print STDERR "Scanning $table...\n" if ($self->{debug});
|
|
$self->{views}{$table}{text} = $view_infos{$table};
|
|
$i++;
|
|
}
|
|
|
|
}
|
|
|
|
|
|
=head2 _get_sql_data
|
|
|
|
Returns a string containing the entire SQL Schema definition compatible with PostgreSQL
|
|
|
|
=cut
|
|
|
|
sub _get_sql_data
|
|
{
|
|
my ($self) = @_;
|
|
|
|
my $sql_header = "-- Generated by Ora2Pg, the Oracle database Schema converter, version $VERSION\n";
|
|
$sql_header .= "-- Copyright 2000 Gilles DAROLD. All rights reserved.\n";
|
|
$sql_header .= "--\n";
|
|
$sql_header .= "-- This program is free software; you can redistribute it and/or modify it under\n";
|
|
$sql_header .= "-- the same terms as Perl itself.\n\n";
|
|
|
|
my $sql_output = "";
|
|
|
|
# Process view only
|
|
if (exists $self->{views}) {
|
|
foreach my $view (sort keys %{$self->{views}}) {
|
|
$sql_output .= "CREATE VIEW $view AS $self->{views}{$view}{text};\n";
|
|
}
|
|
$sql_output .= "\n";
|
|
|
|
return $sql_header . $sql_output;
|
|
}
|
|
|
|
my @groups = ();
|
|
my @users = ();
|
|
# Dump the database structure as an XML Schema defintion
|
|
foreach my $table (keys %{$self->{tables}}) {
|
|
print STDERR "Dumping table $table...\n" if ($self->{debug});
|
|
# Can be: TABLE, VIEW, SYSTEM TABLE, GLOBAL TEMPORARY,
|
|
$sql_output .= "CREATE ${$self->{tables}{$table}{table_info}}[1] \"\L$table\E\" (\n";
|
|
my $sql_ukey = "";
|
|
my $sql_pkey = "";
|
|
foreach my $i ( 0 .. $#{$self->{tables}{$table}{field_name}} ) {
|
|
foreach my $f (@{$self->{tables}{$table}{column_info}}) {
|
|
next if (${$f}[0] ne "${$self->{tables}{$table}{field_name}}[$i]");
|
|
my $type = $self->_sql_type(${$f}[1], ${$f}[2]);
|
|
$type = "${$f}[1], ${$f}[2]" if (!$type);
|
|
$sql_output .= "\t${$f}[0] $type";
|
|
# Set the primary key definition
|
|
foreach my $k (@{$self->{tables}{$table}{primary_key}}) {
|
|
next if ($k ne "${$f}[0]");
|
|
$sql_pkey .= "$k,";
|
|
last;
|
|
}
|
|
if (${$f}[4] ne "") {
|
|
$sql_output .= " DEFAULT ${$f}[4]";
|
|
} elsif (!${$f}[3] || (${$f}[3] eq 'N')) {
|
|
$sql_output .= " NOT NULL";
|
|
}
|
|
# Set the unique key definition
|
|
foreach my $k (@{$self->{tables}{$table}{unique_key}}) {
|
|
next if ( ($k ne "${$f}[0]") || (grep(/^$k$/, @{$self->{tables}{$table}{primary_key}})) );
|
|
$sql_ukey .= "$k,";
|
|
last;
|
|
}
|
|
$sql_output .= ",\n";
|
|
last;
|
|
}
|
|
}
|
|
$sql_ukey =~ s/,$//;
|
|
$sql_pkey =~ s/,$//;
|
|
$sql_output .= "\tUNIQUE ($sql_ukey),\n" if ($sql_ukey);
|
|
$sql_output .= "\tPRIMARY KEY ($sql_pkey),\n" if ($sql_pkey);
|
|
|
|
# Add constraint definition
|
|
foreach my $h (@{$self->{tables}{$table}{foreign_key}}) {
|
|
foreach my $link (keys %{$h}) {
|
|
my ($reftable,$desttable) = split(/->/, $link);
|
|
next if ($reftable ne $table);
|
|
my $localcols = '';
|
|
foreach my $i (0 .. $#{${$h}{$link}{local}}) {
|
|
my $destname = "$desttable";
|
|
my $remote = "${${$h}{$link}{remote}}[$i]";
|
|
my $local = "${${$h}{$link}{local}}[$i]";
|
|
$sql_output .= "\tCONSTRAINT ${i}_\L$table\E_fk FOREIGN KEY ($local) REFERENCES $desttable ($remote),\n";
|
|
}
|
|
}
|
|
}
|
|
$sql_output =~ s/,$//;
|
|
$sql_output .= ");\n";
|
|
foreach my $idx (keys %{$self->{tables}{$table}{indexes}}) {
|
|
my $columns = join(',', @{$self->{tables}{$table}{indexes}{$idx}});
|
|
my $unique = '';
|
|
$unique = ' UNIQUE' if ($self->{tables}{$table}{uniqueness}{$idx} eq 'UNIQUE');
|
|
$sql_output .= "CREATE$unique INDEX \L$idx\E ON \L$table\E (\L$columns\E);\n";
|
|
}
|
|
# Add grant on this table
|
|
$sql_output .= "REVOKE ALL ON $table FROM PUBLIC;\n";
|
|
foreach my $grp (keys %{$self->{tables}{$table}{grants}}) {
|
|
if (exists $self->{groups}{$grp}) {
|
|
$sql_output .= "GRANT " . join(',', @{$self->{tables}{$table}{grants}{$grp}}) . " ON $table TO GROUP $grp;\n";
|
|
push(@groups, $grp) if (!grep(/^$grp$/, @groups));
|
|
} else {
|
|
$sql_output .= "GRANT " . join(',', @{$self->{tables}{$table}{grants}{$grp}}) . " ON $table TO $grp;\n";
|
|
push(@users, $grp) if (!grep(/^$grp$/, @users));
|
|
}
|
|
}
|
|
$sql_output .= "\n";
|
|
}
|
|
|
|
# Add privilege definition
|
|
print STDERR "Add groups/users privileges...\n" if ($self->{debug} && exists $self->{groups});
|
|
my $grants = '';
|
|
foreach my $role (@groups) {
|
|
next if (!exists $self->{groups}{$role});
|
|
$grants .= "CREATE GROUP $role;\n";
|
|
$grants .= "ALTER GROUP $role ADD USERS " . join(',', @{$self->{groups}{$role}}) . ";\n";
|
|
foreach my $u (@{$self->{groups}{$role}}) {
|
|
push(@users, $u) if (!grep(/^$u$/, @users));
|
|
}
|
|
}
|
|
foreach my $u (@users) {
|
|
$sql_header .= "CREATE USER $u WITH PASSWORD 'secret';\n";
|
|
}
|
|
$sql_header .= "\n" . $grants . "\n";
|
|
|
|
return $sql_header . $sql_output;
|
|
}
|
|
|
|
|
|
=head2 _sql_type INTERNAL_TYPE LENGTH
|
|
|
|
This function return the PostgreSQL datatype corresponding to the
|
|
Oracle internal type.
|
|
|
|
=cut
|
|
|
|
sub _sql_type
|
|
{
|
|
my ($self, $type, $len) = @_;
|
|
|
|
my %TYPE = (
|
|
'NUMBER' => 'double',
|
|
'LONG' => 'integer',
|
|
'CHAR' => 'char',
|
|
'VARCHAR2' => 'varchar',
|
|
'DATE' => 'datetime',
|
|
'RAW' => 'binary',
|
|
'ROWID' => 'oid',
|
|
'LONG RAW' => 'binary',
|
|
);
|
|
|
|
# Overide the length
|
|
$len = '' if ($type eq 'NUMBER');
|
|
|
|
if (exists $TYPE{$type}) {
|
|
if ($len) {
|
|
if (($type eq "NUMBER") || ($type eq "LONG")) {
|
|
return "$TYPE{$type}($len)";
|
|
} elsif (($type eq "CHAR") || ($type =~ /VARCHAR/)) {
|
|
return "$TYPE{$type}($len)";
|
|
} else {
|
|
return "$TYPE{$type}($len)";
|
|
}
|
|
} else {
|
|
return $TYPE{$type};
|
|
}
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
=head2 _column_info TABLE
|
|
|
|
This function implements a Oracle-native column information.
|
|
|
|
Return a list of array reference containing the following informations
|
|
for each column the given a table
|
|
|
|
[(
|
|
column name,
|
|
column type,
|
|
column length,
|
|
nullable column,
|
|
default value
|
|
)]
|
|
|
|
=cut
|
|
|
|
sub _column_info
|
|
{
|
|
my ($self, $table) = @_;
|
|
|
|
my $sth = $self->{dbh}->prepare(<<END) or die $self->{dbh}->errstr;
|
|
SELECT COLUMN_NAME, DATA_TYPE, DATA_LENGTH, NULLABLE, DATA_DEFAULT
|
|
FROM DBA_TAB_COLUMNS
|
|
WHERE TABLE_NAME='$table'
|
|
END
|
|
$sth->execute or die $sth->errstr;
|
|
my $data = $sth->fetchall_arrayref();
|
|
if ($self->{debug}) {
|
|
foreach my $d (@$data) {
|
|
print STDERR "\t$d->[0] => type:$d->[1] , length:$d->[2] , nullable:$d->[3] , default:$d->[4]\n";
|
|
}
|
|
}
|
|
|
|
return @$data;
|
|
|
|
}
|
|
|
|
|
|
=head2 _primary_key TABLE
|
|
|
|
This function implements a Oracle-native primary key column
|
|
information.
|
|
|
|
Return a list of all column name defined as primary key
|
|
for the given table.
|
|
|
|
=cut
|
|
|
|
sub _primary_key
|
|
{
|
|
my($self, $table) = @_;
|
|
|
|
my $sth = $self->{dbh}->prepare(<<END) or die $self->{dbh}->errstr;
|
|
select all_cons_columns.COLUMN_NAME
|
|
from all_constraints, all_cons_columns
|
|
where all_constraints.CONSTRAINT_TYPE='P'
|
|
and all_constraints.constraint_name=all_cons_columns.constraint_name
|
|
and all_constraints.STATUS='ENABLED'
|
|
and all_constraints.TABLE_NAME='$table'
|
|
order by all_cons_columns.position
|
|
END
|
|
$sth->execute or die $sth->errstr;
|
|
my @data = ();
|
|
while (my $row = $sth->fetch) {
|
|
push(@data, ${@$row}[0]) if (${@$row}[0] !~ /\$/);
|
|
}
|
|
return @data;
|
|
}
|
|
|
|
|
|
=head2 _unique_key TABLE
|
|
|
|
This function implements a Oracle-native unique key column
|
|
information.
|
|
|
|
Return a list of all column name defined as unique key
|
|
for the given table.
|
|
|
|
=cut
|
|
|
|
sub _unique_key
|
|
{
|
|
my($self, $table) = @_;
|
|
|
|
my $sth = $self->{dbh}->prepare(<<END) or die $self->{dbh}->errstr;
|
|
select all_cons_columns.COLUMN_NAME
|
|
from all_constraints, all_cons_columns
|
|
where all_constraints.CONSTRAINT_TYPE='U'
|
|
and all_constraints.constraint_name=all_cons_columns.constraint_name
|
|
and all_constraints.STATUS='ENABLED'
|
|
and all_constraints.TABLE_NAME='$table'
|
|
order by all_cons_columns.position
|
|
END
|
|
$sth->execute or die $sth->errstr;
|
|
|
|
my @data = ();
|
|
while (my $row = $sth->fetch) {
|
|
push(@data, ${@$row}[0]) if (${@$row}[0] !~ /\$/);
|
|
}
|
|
return @data;
|
|
}
|
|
|
|
|
|
=head2 _foreign_key TABLE
|
|
|
|
This function implements a Oracle-native foreign key reference
|
|
information.
|
|
|
|
Return a list of hash of hash of array reference. Ouuf! Nothing very difficult.
|
|
The first hash is composed of all foreign key name. The second hash just have
|
|
two key known as 'local' and remote' corresponding to the local table where the
|
|
foreign key is defined and the remote table where the key refer.
|
|
|
|
The foreign key name is composed as follow:
|
|
|
|
'local_table_name->remote_table_name'
|
|
|
|
Foreign key data consist in two array representing at the same indice the local
|
|
field and the remote field where the first one refer to the second.
|
|
Just like this:
|
|
|
|
@{$link{$fkey_name}{local}} = @local_columns;
|
|
@{$link{$fkey_name}{remote}} = @remote_columns;
|
|
|
|
=cut
|
|
|
|
sub _foreign_key
|
|
{
|
|
my ($self, $table) = @_;
|
|
|
|
my $sth = $self->{dbh}->prepare(<<END) or die $self->{dbh}->errstr;
|
|
select cls.TABLE_NAME, clf.TABLE_NAME, cls.COLUMN_NAME, clf.COLUMN_NAME
|
|
from all_constraints cns, all_cons_columns clf , all_cons_columns cls
|
|
where cns.CONSTRAINT_TYPE='R'
|
|
and cns.constraint_name=cls.constraint_name
|
|
and clf.CONSTRAINT_NAME = cns.R_CONSTRAINT_NAME
|
|
and clf.OWNER = cns.OWNER
|
|
and clf.POSITION = clf.POSITION
|
|
and cns.STATUS='ENABLED'
|
|
and cns.TABLE_NAME='EVT_DEST_PROFILE'
|
|
order by cns.CONSTRAINT_NAME, cls.position
|
|
END
|
|
$sth->execute or die $sth->errstr;
|
|
|
|
my @data = ();
|
|
my %link = ();
|
|
while (my $row = $sth->fetch) {
|
|
my @trig_info = split(/\\000/, ${@$row}[0]);
|
|
# The first field is the name of the constraint, we
|
|
# remove it because we use a table to table notation.
|
|
my $trig_name = ${@$row}[0] . "->" . ${@$row}[1];
|
|
push(@{$link{$trig_name}{local}}, ${@$row}[2]);
|
|
push(@{$link{$trig_name}{remote}}, ${@$row}[3]);
|
|
}
|
|
push(@data, \%link);
|
|
|
|
return @data;
|
|
}
|
|
|
|
|
|
=head2 _get_table_privilege TABLE
|
|
|
|
This function implements a Oracle-native table grants
|
|
information.
|
|
|
|
Return a hash of array of all users and their grants on the
|
|
given table.
|
|
|
|
=cut
|
|
|
|
sub _get_table_privilege
|
|
{
|
|
my($self, $table) = @_;
|
|
|
|
my @pg_grants = ('DELETE','INSERT','SELECT','UPDATE');
|
|
|
|
# Retrieve all ROLES defined in this database
|
|
my $str = "SELECT GRANTEE, PRIVILEGE FROM DBA_TAB_PRIVS WHERE TABLE_NAME='$table' ORDER BY GRANTEE, PRIVILEGE";
|
|
my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
|
|
$sth->execute or die $sth->errstr;
|
|
my %data = ();
|
|
while (my $row = $sth->fetch) {
|
|
push(@{$data{$row->[0]}}, $row->[1]) if (grep(/$row->[1]/, @pg_grants));
|
|
}
|
|
|
|
return \%data;
|
|
}
|
|
|
|
|
|
=head2 _get_roles
|
|
|
|
This function implements a Oracle-native roles/users
|
|
information.
|
|
|
|
Return a hash of all groups (roles) as an array of associated users.
|
|
|
|
=cut
|
|
|
|
sub _get_roles
|
|
{
|
|
my($self) = @_;
|
|
|
|
# Retrieve all ROLES defined in this database
|
|
my $str = "SELECT ROLE FROM DBA_ROLES ORDER BY ROLE";
|
|
my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
|
|
|
|
$sth->execute or die $sth->errstr;
|
|
my @roles = ();
|
|
while (my $row = $sth->fetch) {
|
|
push(@roles, $row->[0]);
|
|
}
|
|
|
|
# Get all users associated to these roles
|
|
my %groups = ();
|
|
foreach my $r (@roles) {
|
|
my $str = "SELECT GRANTEE FROM DBA_ROLE_PRIVS WHERE GRANTEE <> 'SYS' AND GRANTEE <> 'SYSTEM' AND GRANTED_ROLE='$r' AND GRANTEE IN (SELECT USERNAME FROM DBA_USERS)";
|
|
$sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
|
|
$sth->execute or die $sth->errstr;
|
|
my @users = ();
|
|
while (my $row = $sth->fetch) {
|
|
push(@users, $row->[0]);
|
|
}
|
|
$groups{$r} = \@users if ($#users >= 0);
|
|
}
|
|
|
|
return \%groups;
|
|
}
|
|
|
|
|
|
=head2 _get_indexes TABLE
|
|
|
|
This function implements a Oracle-native indexes
|
|
information.
|
|
|
|
Return an array of all indexes name which are not primary keys
|
|
for the given table.
|
|
|
|
Note: Indexes name must be created like this tablename_fieldname
|
|
else they will not be retrieved or if tablename false in the output
|
|
fieldname.
|
|
|
|
=cut
|
|
|
|
sub _get_indexes
|
|
{
|
|
my($self, $table) = @_;
|
|
|
|
# Retrieve all indexes
|
|
my $str = "SELECT DISTINCT DBA_IND_COLUMNS.INDEX_NAME, DBA_IND_COLUMNS.COLUMN_NAME, DBA_INDEXES.UNIQUENESS FROM DBA_IND_COLUMNS, DBA_INDEXES WHERE DBA_IND_COLUMNS.TABLE_NAME='$table' AND DBA_INDEXES.INDEX_NAME=DBA_IND_COLUMNS.INDEX_NAME AND DBA_IND_COLUMNS.INDEX_NAME NOT IN (SELECT CONSTRAINT_NAME FROM ALL_CONSTRAINTS WHERE TABLE_NAME='$table')";
|
|
my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
|
|
$sth->execute or die $sth->errstr;
|
|
|
|
my %data = ();
|
|
my %unique = ();
|
|
while (my $row = $sth->fetch) {
|
|
$unique{$row->[0]} = $row->[2];
|
|
push(@{$data{$row->[0]}}, $row->[1]);
|
|
}
|
|
|
|
return \%unique, \%data;
|
|
}
|
|
|
|
|
|
=head2 _get_sequences TABLE
|
|
|
|
This function implements a Oracle-native sequence
|
|
information.
|
|
|
|
Return a hash of array of sequence name with MIN_VALUE, MAX_VALUE,
|
|
INCREMENT and LAST_NUMBER for the given table.
|
|
|
|
Not working yet.
|
|
|
|
=cut
|
|
|
|
sub _get_sequences
|
|
{
|
|
my($self, $table) = @_;
|
|
|
|
# Retrieve all indexes
|
|
my $str = "SELECT SEQUENCE_NAME, MIN_VALUE, MAX_VALUE, INCREMENT_BY, LAST_NUMBER FROM DBA_SEQUENCES WHERE SEQUENCE_OWNER <> 'SYS' AND SEQUENCE_OWNER <> 'SYSTEM'";
|
|
my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
|
|
$sth->execute or die $sth->errstr;
|
|
|
|
my %data = ();
|
|
while (my $row = $sth->fetch) {
|
|
# next if ($row->[0] !~ /${table}_/);
|
|
# push(@data, $row->[0]);
|
|
}
|
|
|
|
return %data;
|
|
}
|
|
|
|
|
|
=head2 _get_views
|
|
|
|
This function implements a Oracle-native views information.
|
|
|
|
Return a hash of array of sequence name with MIN_VALUE, MAX_VALUE,
|
|
INCREMENT and LAST_NUMBER for the given table.
|
|
|
|
=cut
|
|
|
|
sub _get_views
|
|
{
|
|
my($self) = @_;
|
|
|
|
# Retrieve all views
|
|
my $str = "SELECT VIEW_NAME,TEXT FROM DBA_VIEWS WHERE OWNER <> 'SYS' AND OWNER <> 'SYSTEM'";
|
|
my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
|
|
$sth->execute or die $sth->errstr;
|
|
|
|
my %data = ();
|
|
while (my $row = $sth->fetch) {
|
|
$data{$row->[0]} = $row->[1];
|
|
}
|
|
|
|
return %data;
|
|
}
|
|
|
|
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
Gilles Darold <gilles@darold.net>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2001 Gilles Darold - All rights reserved.
|
|
|
|
This program is free software; you can redistribute it and/or modify it under
|
|
the same terms as Perl itself.
|
|
|
|
|
|
=head1 BUGS
|
|
|
|
This perl module is in the same state as my knowledge regarding database,
|
|
it can move and not be compatible with older version so I will do my best
|
|
to give you official support for Ora2Pg. Your volontee to help construct
|
|
it and your contribution are welcome.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<DBI>, L<DBD::Oracle>
|
|
|
|
=cut
|
|
|
|
|