diff options
Diffstat (limited to 'contrib/oracle/Ora2Pg.pm')
| -rw-r--r-- | contrib/oracle/Ora2Pg.pm | 718 |
1 files changed, 564 insertions, 154 deletions
diff --git a/contrib/oracle/Ora2Pg.pm b/contrib/oracle/Ora2Pg.pm index 95439b88f73..91b9dff757d 100644 --- a/contrib/oracle/Ora2Pg.pm +++ b/contrib/oracle/Ora2Pg.pm @@ -61,7 +61,9 @@ or if you only want to extract some tables: datasource => $dbsrc, # Database DBD datasource user => $dbuser, # Database user password => $dbpwd, # Database password - tables => \@tables, # Tables to extract + tables => \@tables, + or # Tables to extract + tables => [('tab1','tab2')], debug => 1 # To show somethings when running ); @@ -82,10 +84,14 @@ or if you only want to extract tables 10 to 20: datasource => $dbsrc, # Database DBD datasource user => $dbuser, # Database user password => $dbpwd, # Database password - min => 10 # Begin extraction at indice 10 + min => 10, # Begin extraction at indice 10 max => 20 # End extraction at indice 20 ); +To choose a particular schema just set the following option to your schema name : + + schema => 'APPS' + To know at which indices table can be found during extraction use the option: showtableid => 1 @@ -94,8 +100,29 @@ To extract all views set the option type as follow: type => 'VIEW' +To extract all grants set the option type as follow: + + type => 'GRANT' + +To extract all sequences set the option type as follow: + + type => 'SEQUENCE' + +To extract all triggers set the option type as follow: + + type => 'TRIGGER' + +To extract all functions set the option type as follow: + + type => 'FUNCTION' + +To extract all procedures set the option type as follow: + + type => 'PROCEDURE' + Default is table schema extraction + type => 'TABLE' =head1 DESCRIPTION @@ -110,9 +137,16 @@ 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. +It currently dump the database schema (tables, views, sequences, indexes, grants), +with primary, unique and foreign keys into PostgreSQL syntax without editing the +SQL code generated. + +Functions, procedures and triggers PL/SQL code generated must be reviewed to match +the PostgreSQL syntax. Some usefull recommandation on porting Oracle to PostgreSQL +can be found at http://techdocs.postgresql.org/ under the "Converting from other +Databases to PostgreSQL" Oracle part. I just notice one thing more is that the +trunc() function in Oracle is the same for number or date so be carefull when +porting to PostgreSQL to use trunc() for number and date_trunc() for date. =head1 ABSTRACT @@ -123,13 +157,13 @@ the connection parameters to the Oracle database. Features must include: - - Database schema export, with unique, primary and foreign key. + - Database schema export (tables, views, sequences, indexes), + 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) + - Table selection (by name and max table) export. + - Predefined functions/triggers/procedures export. - Sql query converter (todo) + - Data export (todo) My knowledge regarding database is really poor especially for Oracle so contribution is welcome. @@ -152,7 +186,8 @@ 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 + - schema : Oracle internal schema to extract + - type : Type of data to extract, can be TABLE,VIEW,GRANT,SEQUENCE,TRIGGER,FUNCTION,PROCEDURE - debug : Print the current state of the parsing - tables : Extract only the given tables (arrayref) - showtableid : Display only the table indice during extraction @@ -206,7 +241,7 @@ sub export_schema #### Private subroutines -=head1 PUBLIC METHODS +=head1 PRIVATE METHODS =head2 _init HASH_OPTIONS @@ -233,6 +268,9 @@ sub _init $self->{limited} = (); $self->{limited} = $options{tables} if ($options{tables}); + $self->{schema} = ''; + $self->{schema} = $options{schema} if ($options{schema}); + $self->{min} = 0; $self->{min} = $options{min} if ($options{min}); @@ -248,10 +286,23 @@ sub _init # Retreive all table informations if (!exists $options{type} || ($options{type} eq 'TABLE')) { $self->_tables(); - } else { + } elsif ($options{type} eq 'VIEW') { $self->{dbh}->{LongReadLen} = 100000; $self->_views(); + } elsif ($options{type} eq 'GRANT') { + $self->_grants(); + } elsif ($options{type} eq 'SEQUENCE') { + $self->_sequences(); + } elsif ($options{type} eq 'TRIGGER') { + $self->{dbh}->{LongReadLen} = 100000; + $self->_triggers(); + } elsif (($options{type} eq 'FUNCTION') || ($options{type} eq 'PROCEDURE')) { + $self->{dbh}->{LongReadLen} = 100000; + $self->_functions($options{type}); + } else { + die "type option must be TABLE, VIEW, GRANT, SEQUENCE, TRIGGER, FUNCTION or PROCEDURE\n"; } + $self->{type} = $options{type}; # Disconnect from the database $self->{dbh}->disconnect() if ($self->{dbh}); @@ -264,6 +315,84 @@ sub _init sub DESTROY { } +=head2 _grants + +This function is used to retrieve all privilege information. + +It extract all Oracle's ROLES to convert them as Postgres groups +and search all users associated to these roles. + +Set the main hash $self->{groups}. +Set the main hash $self->{grantss}. + +=cut + +sub _grants +{ + my ($self) = @_; + +print STDERR "Retrieving groups/users information...\n" if ($self->{debug}); + $self->{users} = $self->_get_users(); + $self->{groups} = $self->_get_roles(); + $self->{grants} = $self->_get_all_grants(); + +} + + +=head2 _sequences + +This function is used to retrieve all sequences information. + +Set the main hash $self->{sequences}. + +=cut + +sub _sequences +{ + my ($self) = @_; + +print STDERR "Retrieving sequences information...\n" if ($self->{debug}); + $self->{sequences} = $self->_get_sequences(); + +} + + +=head2 _triggers + +This function is used to retrieve all triggers information. + +Set the main hash $self->{triggers}. + +=cut + +sub _triggers +{ + my ($self) = @_; + +print STDERR "Retrieving triggers information...\n" if ($self->{debug}); + $self->{triggers} = $self->_get_triggers(); + +} + + +=head2 _functions + +This function is used to retrieve all functions information. + +Set the main hash $self->{functions}. + +=cut + +sub _functions +{ + my ($self, $type) = @_; + +print STDERR "Retrieving functions information...\n" if ($self->{debug}); + $self->{functions} = $self->_get_functions($type); + +} + + =head2 _tables This function is used to retrieve all table information. @@ -288,10 +417,10 @@ main hash of the database structure : 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); + @{$self->{tables}{$class_name}{column_info}} = $self->_column_info($class_name); + @{$self->{tables}{$class_name}{primary_key}} = $self->_primary_key($class_name); + @{$self->{tables}{$class_name}{unique_key}} = $self->_unique_key($class_name); + @{$self->{tables}{$class_name}{foreign_key}} = $self->_foreign_key($class_name); =cut @@ -301,7 +430,8 @@ sub _tables # 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->_table_info or die $self->{dbh}->errstr; my @tables_infos = $sth->fetchall_arrayref(); if ($self->{showtableid}) { @@ -312,7 +442,7 @@ print STDERR "Retrieving table information...\n" if ($self->{debug}); } return; } - +my @done = (); foreach my $table (@tables_infos) { # Set the table information for each class found my $i = 1; @@ -320,7 +450,11 @@ print STDERR "Min table dump set to $self->{min}.\n" if ($self->{debug} && $self 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] =~ /\$/); +if (grep(/^${@$t}[2]$/, @done)) { +print STDERR "SSSSSS duplicate ${@$t}[0] - ${@$t}[1] - ${@$t}[2]\n"; +} else { +push(@done, ${@$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}})); @@ -349,19 +483,15 @@ print STDERR "Scanning ${@$t}[2] (@$t)...\n" if ($self->{debug}); $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]); + @{$self->{tables}{${@$t}[2]}{column_info}} = $self->_column_info(${@$t}[2]); + @{$self->{tables}{${@$t}[2]}{primary_key}} = $self->_primary_key(${@$t}[2]); + @{$self->{tables}{${@$t}[2]}{unique_key}} = $self->_unique_key(${@$t}[2]); + ($self->{tables}{${@$t}[2]}{foreign_link}, $self->{tables}{${@$t}[2]}{foreign_key}) = $self->_foreign_key(${@$t}[2]); + ($self->{tables}{${@$t}[2]}{uniqueness}, $self->{tables}{${@$t}[2]}{indexes}) = $self->_get_indexes(${@$t}[2]); $i++; } } -print STDERR "Retrieving groups/users information...\n" if ($self->{debug}); - $self->{groups} = &_get_roles($self); - } @@ -377,8 +507,6 @@ 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 @@ -388,7 +516,7 @@ sub _views # Get all views information print STDERR "Retrieving views information...\n" if ($self->{debug}); - my %view_infos = &_get_views($self); + my %view_infos = $self->_get_views(); if ($self->{showtableid}) { my $i = 1; @@ -433,25 +561,180 @@ sub _get_sql_data $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"; + $sql_header .= "BEGIN TRANSACTION;\n\n"; my $sql_output = ""; # Process view only - if (exists $self->{views}) { + if ($self->{type} eq 'VIEW') { +print STDERR "Add views definition...\n" if ($self->{debug}); foreach my $view (sort keys %{$self->{views}}) { - $sql_output .= "CREATE VIEW $view AS $self->{views}{$view}{text};\n"; + $sql_output .= "CREATE VIEW \"\L$view\E\" AS $self->{views}{$view}{text};\n"; + } + + if (!$sql_output) { + $sql_output = "-- Nothing found of type $self->{type}\n"; + } else { + $sql_output .= "\n"; } - $sql_output .= "\n"; - return $sql_header . $sql_output; + return $sql_header . $sql_output . "\nEND TRANSACTION"; } - my @groups = (); - my @users = (); - # Dump the database structure as an XML Schema defintion + # Process grant only + if ($self->{type} eq 'GRANT') { +print STDERR "Add groups/users privileges...\n" if ($self->{debug}); + # Add groups definition + my $groups = ''; + my @users = (); + my @grps = (); + foreach (@{$self->{users}}) { + next if (exists $self->{groups}{"$_"}); + next if ($self->{schema} && ($_ ne $self->{schema})); + $sql_header .= "CREATE USER $_ WITH PASSWORD 'secret';\n"; + } + foreach my $role (sort keys %{$self->{groups}}) { + push(@grps, $role); + $groups .= "CREATE GROUP $role WITH USER " . join(',', @{$self->{groups}{$role}}) . ";\n"; + } + $sql_header .= "\n" . $groups . "\n"; + + # Add privilege definition + my $grants = ''; + foreach my $table (sort keys %{$self->{grants}}) { + $grants .= "REVOKE ALL ON $table FROM PUBLIC;\n"; + foreach my $priv (sort keys %{$self->{grants}{$table}}) { + my $usr = ''; + my $grp = ''; + foreach my $user (@{$self->{grants}{$table}{$priv}}) { + if (grep(/^$user$/, @grps)) { + $grp .= "$user,"; + } else { + $usr .= "$user,"; + } + } + $grp =~ s/,$//; + $usr =~ s/,$//; + if ($grp) { + $grants .= "GRANT $priv ON $table TO GROUP $grp;\n"; + } else { + $grants .= "GRANT $priv ON $table TO $usr;\n"; + } + } + } + + if (!$grants) { + $$grants = "-- Nothing found of type $self->{type}\n"; + } + + $sql_output .= "\n" . $grants . "\n"; + + return $sql_header . $sql_output . "\nEND TRANSACTION"; + } + + # Process sequences only + if ($self->{type} eq 'SEQUENCE') { +print STDERR "Add sequences definition...\n" if ($self->{debug}); + foreach my $seq (@{$self->{sequences}}) { + my $cache = 1; + $cache = $seq->[5] if ($seq->[5]); + my $cycle = ''; + $cycle = ' CYCLE' if ($seq->[6] eq 'Y'); + if ($seq->[2] > 2147483646) { + $seq->[2] = 2147483646; + } + if ($seq->[1] < -2147483647) { + $seq->[1] = -2147483647; + } + $sql_output .= "CREATE SEQUENCE \L$seq->[0]\E INCREMENT $seq->[3] MINVALUE $seq->[1] MAXVALUE $seq->[2] START $seq->[4] CACHE $cache$cycle;\n"; + } + + if (!$sql_output) { + $sql_output = "-- Nothing found of type $self->{type}\n"; + } + + return $sql_header . $sql_output . "\nEND TRANSACTION"; + } + + # Process triggers only. PL/SQL code is pre-converted to PL/PGSQL following + # the recommendation of Roberto Mello, see http://techdocs.postgresql.org/ + # Oracle's PL/SQL to PostgreSQL PL/pgSQL HOWTO + if ($self->{type} eq 'TRIGGER') { +print STDERR "Add triggers definition...\n" if ($self->{debug}); + foreach my $trig (@{$self->{triggers}}) { + $trig->[1] =~ s/ EACH ROW//; + chop($trig->[4]); + chomp($trig->[4]); + # Check if it's a pg rule + if ($trig->[1] =~ /INSTEAD OF/) { + $sql_output .= "CREATE RULE \L$trig->[0]\E AS\n\tON \L$trig->[3]\E\n\tDO INSTEAD\n(\n\t$trig->[4]\n);\n\n"; + } else { + + #-------------------------------------------- + # PL/SQL to PL/PGSQL code conversion + #-------------------------------------------- + # Change NVL to COALESCE + #$trig->[4] =~ s/NVL\(/coalesce(/igs; + # Change trunc() to date_trunc('day', field) + # Trunc is replaced with date_trunc if we find date in the name of the value + # because Oracle have the same trunc function on number and date type :-((( + #$trig->[4] =~ s/trunc\(([^\)]*date[^\)]*)\)/date_trunc('day', $1)/igs; + # Change SYSDATE to 'now' + #$trig->[4] =~ s/SYSDATE/CURRENT_TIMESTAMP/igs; + # Change nextval on sequence + # Oracle's sequence grammar is sequence_name.nextval. + # Postgres's sequence grammar is nextval('sequence_name'). + #$trig->[4] =~ s/(\w+)\.nextval/nextval('$1')/isg; + # Escaping Single Quotes + #$trig->[4] =~ s/'/''/sg; + + $sql_output .= "CREATE FUNCTION pg_fct_\L$trig->[0]\E () RETURNS OPAQUE AS '\n$trig->[4]\n' LANGUAGE 'plpgsql'\n\n"; + $sql_output .= "CREATE TRIGGER \L$trig->[0]\E\n\t$trig->[1] $trig->[2] ON \L$trig->[3]\E FOR EACH ROW\n\tEXECUTE PROCEDURE pg_fct_\L$trig->[0]\E();\n\n"; + } + } + + if (!$sql_output) { + $sql_output = "-- Nothing found of type $self->{type}\n"; + } + + return $sql_header . $sql_output . "\nEND TRANSACTION"; + } + + # Process functions only + if (($self->{type} eq 'FUNCTION') || ($self->{type} eq 'PROCEDURE')) { +print STDERR "Add functions definition...\n" if ($self->{debug}); + foreach my $fct (sort keys %{$self->{functions}}) { + my @tmp = (); + if ($self->{functions}{$fct} =~ /^[\s\t]*function/is) { + #$self->{functions}{$fct} =~ /function[\s\n\t]*$fct[\s\n\t]*\(([^\)]*)\)/is; + $self->{functions}{$fct} =~ /function[\s\n\t]*$fct[\s\n\t]*\(([^\)]*)\)[\s\n\t]*is/is; + @tmp = split(/\n/, $1); + } else { + #$self->{functions}{$fct} =~ /procedure[\s\n\t]*$fct[\s\n\t]*\(([^\)]*)\)/is; + $self->{functions}{$fct} =~ /procedure[\s\n\t]*$fct[\s\n\t]*\(([^\)]*)\)[\s\n\t]*is\W/is; + @tmp = split(/\n/, $1); + } + my @argu = split(/,/, join(' ', @tmp)); + map { s/^.* in //is } @argu; + map { s/^.* out //is } @argu; + map { $_ = $self->_sql_type(uc($_)) } @argu; + $self->{functions}{$fct} =~ /return ([^\s]*) is/is; + $self->{functions}{$fct} = "-- Oracle function declaration, please edit to match PostgreSQL syntax.\n$self->{functions}{$fct}"; + $sql_output .= "-- PostgreSQL possible function declaration, please edit to match your needs.\nCREATE FUNCTION \L$fct\E(" . join(',', @argu) . ") RETURNS " . $self->_sql_type(uc($1)) . " AS '\n$self->{functions}{$fct}\n' LANGUAGE 'sql'\n\n"; + } + + if (!$sql_output) { + $sql_output = "-- Nothing found of type $self->{type}\n"; + } + + return $sql_header . $sql_output . "\nEND TRANSACTION"; + } + + + + # Dump the database structure 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 = ""; @@ -460,11 +743,11 @@ print STDERR "Dumping table $table...\n" if ($self->{debug}); 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"; + $sql_output .= "\t\"\L${$f}[0]\E\" $type"; # Set the primary key definition foreach my $k (@{$self->{tables}{$table}{primary_key}}) { next if ($k ne "${$f}[0]"); - $sql_pkey .= "$k,"; + $sql_pkey .= "\"\L$k\E\","; last; } if (${$f}[4] ne "") { @@ -475,7 +758,7 @@ print STDERR "Dumping table $table...\n" if ($self->{debug}); # 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,"; + $sql_ukey .= "\"\L$k\E\","; last; } $sql_output .= ",\n"; @@ -488,58 +771,39 @@ print STDERR "Dumping table $table...\n" if ($self->{debug}); $sql_output .= "\tPRIMARY KEY ($sql_pkey),\n" if ($sql_pkey); # Add constraint definition + my @done = (); 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"; - } + next if (grep(/^$h->[0]$/, @done)); + my $desttable = ''; + foreach (keys %{$self->{tables}{$table}{foreign_link}{$h->[0]}{remote}}) { + $desttable .= "$_"; } + push(@done, $h->[0]); + $sql_output .= "\tCONSTRAINT \L$h->[0]\E FOREIGN KEY (" . lc(join(',', @{$self->{tables}{$table}{foreign_link}{$h->[0]}{local}})) . ") REFERENCES \L$desttable\E (" . lc(join(',', @{$self->{tables}{$table}{foreign_link}{$h->[0]}{remote}{$desttable}})) . ")"; + $sql_output .= " MATCH $h->[2]" if ($h->[2]); + $sql_output .= " ON DELETE $h->[3]"; + $sql_output .= " $h->[4]"; + $sql_output .= " INITIALLY $h->[5],\n"; + } $sql_output =~ s/,$//; $sql_output .= ");\n"; foreach my $idx (keys %{$self->{tables}{$table}{indexes}}) { + map { s/^/"/ } @{$self->{tables}{$table}{indexes}{$idx}}; + map { s/$/"/ } @{$self->{tables}{$table}{indexes}{$idx}}; 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 .= "CREATE$unique INDEX \"\L$idx\E\" ON \"\L$table\E\" (\L$columns\E);\n"; } $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)); - } + if (!$sql_output) { + $sql_output = "-- Nothing found of type TABLE\n"; } - foreach my $u (@users) { - $sql_header .= "CREATE USER $u WITH PASSWORD 'secret';\n"; - } - $sql_header .= "\n" . $grants . "\n"; - return $sql_header . $sql_output; + return $sql_header . $sql_output . "\nEND TRANSACTION"; } @@ -555,12 +819,12 @@ sub _sql_type my ($self, $type, $len) = @_; my %TYPE = ( - 'NUMBER' => 'double', + 'NUMBER' => 'float8', 'LONG' => 'integer', 'CHAR' => 'char', 'VARCHAR2' => 'varchar', 'DATE' => 'datetime', - 'RAW' => 'binary', + 'RAW' => 'text', 'ROWID' => 'oid', 'LONG RAW' => 'binary', ); @@ -575,7 +839,7 @@ sub _sql_type } elsif (($type eq "CHAR") || ($type =~ /VARCHAR/)) { return "$TYPE{$type}($len)"; } else { - return "$TYPE{$type}($len)"; + return "$TYPE{$type}"; } } else { return $TYPE{$type}; @@ -717,68 +981,79 @@ 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 + my $str = "SELECT CONSTRAINT_NAME,R_CONSTRAINT_NAME,SEARCH_CONDITION,DELETE_RULE,DEFERRABLE,DEFERRED FROM DBA_CONSTRAINTS WHERE CONSTRAINT_TYPE='R' AND STATUS='ENABLED' AND TABLE_NAME='$table'"; + my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr; $sth->execute or die $sth->errstr; my @data = (); my %link = (); + my @tab_done = (); 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]); + next if (grep(/^$row->[0]$/, @tab_done)); + push(@data, [ @$row ]); + push(@tab_done, $row->[0]); + my $sql = "SELECT DISTINCT COLUMN_NAME FROM DBA_CONS_COLUMNS WHERE CONSTRAINT_NAME='$row->[0]'"; + my $sth2 = $self->{dbh}->prepare($sql) or die $self->{dbh}->errstr; + $sth2->execute or die $sth2->errstr; + my @done = (); + while (my $r = $sth2->fetch) { + if (!grep(/^$r->[0]$/, @done)) { + push(@{$link{$row->[0]}{local}}, $r->[0]); + push(@done, $r->[0]); + } + } + $sql = "SELECT DISTINCT TABLE_NAME,COLUMN_NAME FROM DBA_CONS_COLUMNS WHERE CONSTRAINT_NAME='$row->[1]'"; + $sth2 = $self->{dbh}->prepare($sql) or die $self->{dbh}->errstr; + $sth2->execute or die $sth2->errstr; + @done = (); + while (my $r = $sth2->fetch) { + if (!grep(/^$r->[1]$/, @done)) { + push(@{$link{$row->[0]}{remote}{$r->[0]}}, $r->[1]); + push(@done, $r->[1]); + } + } } - push(@data, \%link); - return @data; + return \%link, \@data; } -=head2 _get_table_privilege TABLE +=head2 _get_users -This function implements a Oracle-native table grants -information. +This function implements a Oracle-native users information. -Return a hash of array of all users and their grants on the -given table. +Return a hash of all users as an array. =cut -sub _get_table_privilege +sub _get_users { - my($self, $table) = @_; - - my @pg_grants = ('DELETE','INSERT','SELECT','UPDATE'); + my($self) = @_; - # Retrieve all ROLES defined in this database - my $str = "SELECT GRANTEE, PRIVILEGE FROM DBA_TAB_PRIVS WHERE TABLE_NAME='$table' ORDER BY GRANTEE, PRIVILEGE"; + # Retrieve all USERS defined in this database + my $str = "SELECT USERNAME FROM DBA_USERS"; + if (!$self->{schema}) { + $str .= " WHERE USERNAME <> 'SYS' AND USERNAME <> 'SYSTEM' AND USERNAME <> 'DBSNMP'"; + } else { + $str .= " WHERE USERNAME = '$self->{schema}'"; + } + $str .= " ORDER BY USERNAME"; my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr; + $sth->execute or die $sth->errstr; - my %data = (); + my @users = (); while (my $row = $sth->fetch) { - push(@{$data{$row->[0]}}, $row->[1]) if (grep(/$row->[1]/, @pg_grants)); + push(@users, $row->[0]); } - return \%data; + return \@users; } + =head2 _get_roles -This function implements a Oracle-native roles/users +This function implements a Oracle-native roles information. Return a hash of all groups (roles) as an array of associated users. @@ -790,43 +1065,68 @@ sub _get_roles my($self) = @_; # Retrieve all ROLES defined in this database - my $str = "SELECT ROLE FROM DBA_ROLES ORDER BY ROLE"; + my $str = "SELECT GRANTED_ROLE,GRANTEE FROM DBA_ROLE_PRIVS WHERE GRANTEE NOT IN (select distinct role from dba_roles)"; + if (!$self->{schema}) { + $str .= " AND GRANTEE <> 'SYS' AND GRANTEE <> 'SYSTEM' AND GRANTEE <> 'DBSNMP'"; + } else { + $str .= " AND GRANTEE = '$self->{schema}'"; + } my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr; $sth->execute or die $sth->errstr; - my @roles = (); + my %roles = (); while (my $row = $sth->fetch) { - push(@roles, $row->[0]); + push(@{$roles{"$row->[0]"}}, $row->[1]); } - # 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 \%roles; +} + + +=head2 _get_all_grants + +This function implements a Oracle-native user privilege +information. + +Return a hash of all tables grants as an array of associated users. + +=cut + +sub _get_all_grants +{ + my($self) = @_; + + my @PG_GRANTS = ('DELETE', 'INSERT', 'SELECT', 'UPDATE'); + + # Retrieve all ROLES defined in this database + my $str = "SELECT table_name,privilege,grantee FROM DBA_TAB_PRIVS"; + if ($self->{schema}) { + $str .= " WHERE GRANTEE = '$self->{schema}'"; + } else { + $str .= " WHERE GRANTEE <> 'SYS' AND GRANTEE <> 'SYSTEM' AND GRANTEE <> 'DBSNMP'"; + } + $str .= " ORDER BY TABLE_NAME"; + + my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr; + + $sth->execute or die $sth->errstr; + my %grants = (); + while (my $row = $sth->fetch) { + push(@{$grants{"$row->[0]"}{"$row->[1]"}}, $row->[2]) if (grep(/$row->[1]/, @PG_GRANTS)); } - return \%groups; + return \%grants; } -=head2 _get_indexes TABLE -This function implements a Oracle-native indexes -information. +=head2 _get_indexes TABLE -Return an array of all indexes name which are not primary keys -for the given table. +This function implements a Oracle-native indexes information. -Note: Indexes name must be created like this tablename_fieldname -else they will not be retrieved or if tablename false in the output -fieldname. +Return hash of array containing all unique index and a hash of +array of all indexes name which are not primary keys for the +given table. =cut @@ -850,34 +1150,36 @@ sub _get_indexes } -=head2 _get_sequences TABLE +=head2 _get_sequences -This function implements a Oracle-native sequence +This function implements a Oracle-native sequences 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) = @_; + my($self) = @_; # 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 $str = "SELECT DISTINCT SEQUENCE_NAME, MIN_VALUE, MAX_VALUE, INCREMENT_BY, LAST_NUMBER, CACHE_SIZE, CYCLE_FLAG FROM DBA_SEQUENCES"; + if (!$self->{schema}) { + $str .= " WHERE SEQUENCE_OWNER <> 'SYS' AND SEQUENCE_OWNER <> 'SYSTEM' AND SEQUENCE_OWNER <> 'DBSNMP'"; + } else { + $str .= " WHERE SEQUENCE_OWNER = '$self->{schema}'"; + } my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr; $sth->execute or die $sth->errstr; - my %data = (); + my @seqs = (); while (my $row = $sth->fetch) { - # next if ($row->[0] !~ /${table}_/); - # push(@data, $row->[0]); + push(@seqs, [ @$row ]); } - return %data; + return \@seqs; } @@ -885,8 +1187,7 @@ sub _get_sequences 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. +Return a hash of view name with the SQL query it is based on. =cut @@ -895,7 +1196,12 @@ sub _get_views my($self) = @_; # Retrieve all views - my $str = "SELECT VIEW_NAME,TEXT FROM DBA_VIEWS WHERE OWNER <> 'SYS' AND OWNER <> 'SYSTEM'"; + my $str = "SELECT VIEW_NAME,TEXT FROM DBA_VIEWS"; + if (!$self->{schema}) { + $str .= " WHERE OWNER <> 'SYS' AND OWNER <> 'SYSTEM' AND OWNER <> 'DBSNMP'"; + } else { + $str .= " WHERE OWNER = '$self->{schema}'"; + } my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr; $sth->execute or die $sth->errstr; @@ -908,6 +1214,110 @@ sub _get_views } +=head2 _get_triggers + +This function implements a Oracle-native triggers information. + +Return an array of refarray of all triggers informations + +=cut + +sub _get_triggers +{ + my($self) = @_; + + # Retrieve all indexes + my $str = "SELECT TRIGGER_NAME, TRIGGER_TYPE, TRIGGERING_EVENT, TABLE_NAME, TRIGGER_BODY FROM DBA_TRIGGERS WHERE STATUS='ENABLED'"; + if (!$self->{schema}) { + $str .= " AND OWNER <> 'SYS' AND OWNER <> 'SYSTEM' AND OWNER <> 'DBSNMP'"; + } else { + $str .= " AND OWNER = '$self->{schema}'"; + } + my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr; + $sth->execute or die $sth->errstr; + + my @triggers = (); + while (my $row = $sth->fetch) { + push(@triggers, [ @$row ]); + } + + return \@triggers; +} + + +=head2 _get_functions + +This function implements a Oracle-native functions information. + +Return a hash of all function name with their PLSQL code + +=cut + +sub _get_functions +{ + my($self, $type) = @_; + + # Retrieve all indexes + my $str = "SELECT DISTINCT OBJECT_NAME,OWNER FROM DBA_OBJECTS WHERE OBJECT_TYPE='$type' AND STATUS='VALID'"; + if (!$self->{schema}) { + $str .= " AND OWNER <> 'SYS' AND OWNER <> 'SYSTEM' AND OWNER <> 'DBSNMP'"; + } else { + $str .= " AND OWNER = '$self->{schema}'"; + } + my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr; + $sth->execute or die $sth->errstr; + + my %functions = (); + my @fct_done = (); + while (my $row = $sth->fetch) { + next if (grep(/^$row->[0]$/, @fct_done)); + push(@fct_done, $row->[0]); + my $sql = "SELECT TEXT FROM DBA_SOURCE WHERE OWNER='$row->[1]' AND NAME='$row->[0]' ORDER BY LINE"; + my $sth2 = $self->{dbh}->prepare($sql) or die $self->{dbh}->errstr; + $sth2->execute or die $sth2->errstr; + while (my $r = $sth2->fetch) { + $functions{"$row->[0]"} .= $r->[0]; + } + } + + return \%functions; +} + + +=head2 _table_info + +This function retrieve all Oracle-native tables information. + +Return a handle to a DB query statement + +=cut + + +sub _table_info +{ + my $self = shift; + + my $sql = "SELECT + NULL TABLE_CAT, + at.OWNER TABLE_SCHEM, + at.TABLE_NAME, + tc.TABLE_TYPE, + tc.COMMENTS REMARKS + from ALL_TABLES at, ALL_TAB_COMMENTS tc + where at.OWNER = tc.OWNER + and at.TABLE_NAME = tc.TABLE_NAME + "; + + if ($self->{schema}) { + $sql .= " and at.OWNER='$self->{schema}'"; + } else { + $sql .= "and at.OWNER <> 'SYS' and at.OWNER <> 'SYSTEM' and at.OWNER <> 'DBSNMP'"; + } + $sql .= " order by tc.TABLE_TYPE, at.OWNER, at.TABLE_NAME"; + my $sth = $self->{dbh}->prepare( $sql ) or return undef; + $sth->execute or return undef; + $sth; +} 1; |