@ -18,7 +18,7 @@ use vars qw($VERSION);
use Carp qw( confess ) ; use Carp qw( confess ) ;
use DBI ; use DBI ;
$ VERSION = "1.1 " ; $ VERSION = "1.2 " ;
= head1 NAME = head1 NAME
@ -53,6 +53,50 @@ Ora2Pg - Oracle to PostgreSQL database schema converter
exit ( 0 ) ; 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 = head1 DESCRIPTION
@ -79,11 +123,13 @@ the connection parameters to the Oracle database.
Features must include: Features must include:
- database schema export ( done ) - Database schema export , with unique , primary and foreign key .
- grant export ( done ) - Grants / privileges export by user and group .
- predefined function / trigger export ( todo ) - Indexes and unique indexes export .
- data export ( todo ) - Table or view selection ( by name and max table ) export .
- sql query converter ( todo ) - Predefined function / trigger export ( todo )
- Data export ( todo )
- Sql query converter ( todo )
My knowledge regarding database is really poor especially for Oracle My knowledge regarding database is really poor especially for Oracle
so contribution is welcome . so contribution is welcome .
@ -94,6 +140,7 @@ so contribution is welcome.
You just need the DBI and DBD:: Oracle perl module to be installed You just need the DBI and DBD:: Oracle perl module to be installed
= head1 PUBLIC METHODS = head1 PUBLIC METHODS
= head2 new HASH_OPTIONS = head2 new HASH_OPTIONS
@ -105,6 +152,12 @@ Supported options are:
- datasource : DBD datasource ( required ) - datasource : DBD datasource ( required )
- user : DBD user ( optional with public access ) - user : DBD user ( optional with public access )
- password : DBD password ( 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 Attempt that this list should grow a little more because all initialization is
done by this way . done by this way .
@ -174,8 +227,31 @@ sub _init
die "Error : $DBI::err ... $DBI::errstr\n" ; 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 # Retreive all table informations
$ self - > _tables ( ) ; if ( ! exists $ options { type } || ( $ options { type } eq 'TABLE' ) ) {
$ self - > _tables ( ) ;
} else {
$ self - > { dbh } - > { LongReadLen } = 100000 ;
$ self - > _views ( ) ;
}
# Disconnect from the database # Disconnect from the database
$ self - > { dbh } - > disconnect ( ) if ( $ self - > { dbh } ) ; $ self - > { dbh } - > disconnect ( ) if ( $ self - > { dbh } ) ;
@ -199,8 +275,9 @@ to the table_info key as array reference. In other way:
$ self - > { tables } { $ class_name } { table_info } = [ ( OWNER , TYPE ) ] ; $ self - > { tables } { $ class_name } { table_info } = [ ( OWNER , TYPE ) ] ;
TYPE Can be TABLE , VIEW , SYSTEM TABLE , GLOBAL TEMPORARY , LOCAL TEMPORARY , DBI TYPE can be TABLE , VIEW , SYSTEM TABLE , GLOBAL TEMPORARY , LOCAL TEMPORARY ,
ALIAS , SYNONYM or a data source specific type identifier . 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 It also get the following informations in the DBI object to affect the
main hash of the database structure : main hash of the database structure :
@ -223,23 +300,46 @@ sub _tables
my ( $ self ) = @ _ ; my ( $ self ) = @ _ ;
# Get all tables information given by the DBI method table_info # 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 $ sth = $ self - > { dbh } - > table_info or die $ self - > { dbh } - > errstr ;
my @ tables_infos = $ sth - > fetchall_arrayref ( ) ; 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 ) { foreach my $ table ( @ tables_infos ) {
# Set the table information for each class found # 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 ) { foreach my $ t ( @$ table ) {
# usually OWNER,TYPE. QUALIFIER is omitted until # Jump to desired extraction
# I know what to do with that 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 ] ) ] ; $ self - > { tables } { $ { @$ t } [ 2 ] } { table_info } = [ ( $ { @$ t } [ 1 ] , $ { @$ t } [ 3 ] ) ] ;
# Set the fields information # Set the fields information
my $ sth = $ self - > { dbh } - > prepare ( "SELECT * FROM ${@$t}[1].${@$t}[2] WHERE 1=0" ) ; my $ sth = $ self - > { dbh } - > prepare ( "SELECT * FROM ${@$t}[1].${@$t}[2] WHERE 1=0" ) ;
if ( ! defined ( $ sth ) ) { if ( ! defined ( $ sth ) ) {
$ sth = $ self - > { dbh } - > prepare ( "SELECT * FROM ${@$t}[1].${@$t}[2] WHERE 1=0" ) ; warn "Can't prepare statement: $DBI::errstr" ;
if ( ! defined ( $ sth ) ) { next ;
warn "Can't prepare statement: $DBI::errstr" ;
next ;
}
} }
$ sth - > execute ; $ sth - > execute ;
if ( $ sth - > err ) { if ( $ sth - > err ) {
@ -253,10 +353,67 @@ sub _tables
@ { $ self - > { tables } { $ { @$ t } [ 2 ] } { primary_key } } = & _primary_key ( $ 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 ] } { unique_key } } = & _unique_key ( $ self , $ { @$ t } [ 2 ] ) ;
@ { $ self - > { tables } { $ { @$ t } [ 2 ] } { foreign_key } } = & _foreign_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 + + ;
} }
} }
( $ self - > { groups } , $ self - > { grants } ) = & _get_privilege ( $ self ) ; 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 + + ;
}
} }
@ -271,12 +428,29 @@ sub _get_sql_data
{ {
my ( $ self ) = @ _ ; my ( $ self ) = @ _ ;
my $ sql_output = "-- Generated by Ora2Pg, the Oracle database Schema converter, version $VERSION\n" ; my $ sql_header = "-- Generated by Ora2Pg, the Oracle database Schema converter, version $VERSION\n" ;
$ sql_output . = "-- Copyright 2000 Gilles DAROLD. All rights reserved.\n" ; $ sql_header . = "-- Copyright 2000 Gilles DAROLD. All rights reserved.\n" ;
$ sql_output . = "-- Author : <gilles\@darold.net>\n\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 # Dump the database structure as an XML Schema defintion
foreach my $ table ( keys % { $ self - > { tables } } ) { foreach my $ table ( keys % { $ self - > { tables } } ) {
print STDERR "Dumping table $table...\n" if ( $ self - > { debug } ) ;
# Can be: TABLE, VIEW, SYSTEM TABLE, GLOBAL TEMPORARY, # Can be: TABLE, VIEW, SYSTEM TABLE, GLOBAL TEMPORARY,
$ sql_output . = "CREATE ${$self->{tables}{$table}{table_info}}[1] \"\L$table\E\" (\n" ; $ sql_output . = "CREATE ${$self->{tables}{$table}{table_info}}[1] \"\L$table\E\" (\n" ;
my $ sql_ukey = "" ; my $ sql_ukey = "" ;
@ -295,7 +469,7 @@ sub _get_sql_data
} }
if ( $ { $ f } [ 4 ] ne "" ) { if ( $ { $ f } [ 4 ] ne "" ) {
$ sql_output . = " DEFAULT ${$f}[4]" ; $ sql_output . = " DEFAULT ${$f}[4]" ;
} elsif ( ! $ { $ f } [ 3 ] ) { } elsif ( ! $ { $ f } [ 3 ] || ( $ { $ f } [ 3 ] eq 'N' ) ) {
$ sql_output . = " NOT NULL" ; $ sql_output . = " NOT NULL" ;
} }
# Set the unique key definition # Set the unique key definition
@ -310,8 +484,8 @@ sub _get_sql_data
} }
$ sql_ukey =~ s/,$// ; $ sql_ukey =~ s/,$// ;
$ sql_pkey =~ s/,$// ; $ sql_pkey =~ s/,$// ;
$ sql_output . = "\tCONSTRAINT uk\L$table\E UNIQUE ($sql_ukey),\n" if ( $ sql_ukey ) ; $ sql_output . = "\tUNIQUE ($sql_ukey),\n" if ( $ sql_ukey ) ;
$ sql_output . = "\tCONSTRAINT pk\L$table\E PRIMARY KEY ($sql_pkey),\n" if ( $ sql_pkey ) ; $ sql_output . = "\tPRIMARY KEY ($sql_pkey),\n" if ( $ sql_pkey ) ;
# Add constraint definition # Add constraint definition
foreach my $ h ( @ { $ self - > { tables } { $ table } { foreign_key } } ) { foreach my $ h ( @ { $ self - > { tables } { $ table } { foreign_key } } ) {
@ -323,25 +497,49 @@ sub _get_sql_data
my $ destname = "$desttable" ; my $ destname = "$desttable" ;
my $ remote = "${${$h}{$link}{remote}}[$i]" ; my $ remote = "${${$h}{$link}{remote}}[$i]" ;
my $ local = "${${$h}{$link}{local}}[$i]" ; my $ local = "${${$h}{$link}{local}}[$i]" ;
$ sql_output . = "\tCONSTRAINT fk ${i}_\L$table\E FOREIGN KEY ($local) REFERENCES $desttable ($remote),\n" ; $ sql_output . = "\tCONSTRAINT ${i}_\L$table\E_fk FOREIGN KEY ($local) REFERENCES $desttable ($remote),\n" ;
} }
} }
} }
$ sql_output =~ s/,$// ; $ sql_output =~ s/,$// ;
$ sql_output . = ");\n" ; $ 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" ; $ sql_output . = "\n" ;
} }
# Add privilege definition # Add privilege definition
foreach my $ role ( keys % { $ self - > { groups } } ) { print STDERR "Add groups/users privileges...\n" if ( $ self - > { debug } && exists $ self - > { groups } ) ;
$ sql_output . = "CREATE GROUP $role;\n" ; my $ grants = '' ;
$ sql_output . = "ALTER GROUP $role ADD USERS " . join ( ',' , @ { $ self - > { groups } { $ role } } ) . ";\n" ; foreach my $ role ( @ groups ) {
foreach my $ grant ( keys % { $ self - > { grants } { $ role } } ) { next if ( ! exists $ self - > { groups } { $ role } ) ;
$ sql_output . = "GRANT $grant ON " . join ( ',' , @ { $ self - > { grants } { $ role } { $ grant } } ) . " TO GROUP $role;\n" ; $ 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_output ; return $ sql_header . $ sql_ output ;
} }
@ -416,6 +614,11 @@ WHERE TABLE_NAME='$table'
END END
$ sth - > execute or die $ sth - > errstr ; $ sth - > execute or die $ sth - > errstr ;
my $ data = $ sth - > fetchall_arrayref ( ) ; 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 ; return @$ data ;
@ -544,27 +747,52 @@ END
} }
= head2 _get_privilege = head2 _get_table_ privilege TABLE
This function implements a Oracle - native tables grants This function implements a Oracle - native table grants
information . information .
Return a hash of all groups ( roles ) with associated users Return a hash of array of all users and their grants on the
and a hash of arrays of all grants on related tables . given table .
= cut = cut
sub _get_privilege 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 ) = @ _ ; my ( $ self ) = @ _ ;
# Retrieve all ROLES defined in this database # Retrieve all ROLES defined in this database
my $ sth = $ self - > { dbh } - > prepare ( << END ) or die $ self - > { dbh } - > errstr ; my $ str = "SELECT ROLE FROM DBA_ROLES ORDER BY ROLE" ;
SELECT my $ sth = $ self - > { dbh } - > prepare ( $ str ) or die $ self - > { dbh } - > errstr ;
ROLE
FROM DBA_ROLES
ORDER BY ROLE
END
$ sth - > execute or die $ sth - > errstr ; $ sth - > execute or die $ sth - > errstr ;
my @ roles = ( ) ; my @ roles = ( ) ;
while ( my $ row = $ sth - > fetch ) { while ( my $ row = $ sth - > fetch ) {
@ -572,35 +800,115 @@ END
} }
# Get all users associated to these roles # Get all users associated to these roles
my % data = ( ) ;
my % groups = ( ) ; my % groups = ( ) ;
foreach my $ r ( @ roles ) { foreach my $ r ( @ roles ) {
my $ str = "SELECT GRANTEE FROM DBA_ROLE_PRIVS WHERE GRANTED_ROLE='$r' AND GRANTEE IN (SELECT USERNAME FROM DBA_USERS)" ; my $ str = "SELECT GRANTEE FROM DBA_ROLE_PRIVS WHERE GRANTEE <> 'SYS' AND GRANTEE <> 'SYSTEM' AND GRANTE D_ROLE='$r' AND GRANTEE IN (SELECT USERNAME FROM DBA_USERS)" ;
$ sth = $ self - > { dbh } - > prepare ( $ str ) or die $ self - > { dbh } - > errstr ; $ sth = $ self - > { dbh } - > prepare ( $ str ) or die $ self - > { dbh } - > errstr ;
$ sth - > execute or die $ sth - > errstr ; $ sth - > execute or die $ sth - > errstr ;
my @ users = ( ) ; my @ users = ( ) ;
while ( my $ row = $ sth - > fetch ) { while ( my $ row = $ sth - > fetch ) {
next if ( $ row - > [ 0 ] eq 'SYSTEM' ) ;
push ( @ users , $ row - > [ 0 ] ) ; push ( @ users , $ row - > [ 0 ] ) ;
} }
# Don't process roles relatives to DBA $ groups { $ r } = \ @ users if ( $# users >= 0 ) ;
next if ( grep ( /^DBSNMP$/ , @ users ) ) ; }
next if ( grep ( /^SYS$/ , @ users ) ) ;
$ groups { $ r } = \ @ users ; return \ % groups ;
}
$ str = "SELECT PRIVILEGE,TABLE_NAME FROM DBA_TAB_PRIVS WHERE GRANTEE='$r'" ;
$ sth = $ self - > { dbh } - > prepare ( $ str ) or die $ self - > { dbh } - > errstr ; = head2 _get_indexes TABLE
$ sth - > execute or die $ sth - > errstr ;
my @ grants = ( ) ; This function implements a Oracle - native indexes
while ( my $ row = $ sth - > fetch ) { information .
push ( @ { $ data { $ r } { "${@$row}[0]" } } , $ { @$ row } [ 1 ] ) ;
} 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 \ % groups , \ % data ; 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 ; 1 ;
__END__ __END__
Bruce Momjian
25 years ago