← Back to branch summary

~vcs-imports/mammoth-replicator/trunk

« back to all changes in this revision

Viewing changes to contrib/oracle/Ora2Pg.pm

  • Committer: alvherre
  • Date: 2005-12-16 21:24:52 UTC
  • Revision ID: svn-v4:db760fc0-0f08-0410-9d63-cc6633f64896:trunk:1
Initial import of the REL8_0_3 sources from the Pgsql CVS repository.

Show diffs side-by-side

added added

removed removed

Lines of Context:
contrib/oracle/Ora2Pg.pm
 
1
package Ora2Pg;
 
2
#------------------------------------------------------------------------------
 
3
# Project  : Oracle to PostgreSQL database schema converter
 
4
# Name     : Ora2Pg.pm
 
5
# Language : 5.006 built for i686-linux
 
6
# OS       : linux RedHat 6.2 kernel 2.2.14-5
 
7
# Authors  : Gilles Darold, gilles@darold.net
 
8
# Copyright: Copyright (c) 2000 : Gilles Darold - All rights reserved -
 
9
# Function : Main module used to export Oracle database schema to PostgreSQL
 
10
# Usage    : See documentation in this file with perldoc.
 
11
#------------------------------------------------------------------------------
 
12
# This program is free software; you can redistribute it and/or modify it under
 
13
# the same terms as Perl itself.
 
14
#------------------------------------------------------------------------------
 
15
 
 
16
#use strict;
 
17
use vars qw($VERSION $PSQL);
 
18
use Carp qw(confess);
 
19
use DBI;
 
20
use POSIX qw(locale_h);
 
21
 
 
22
#set locale to LC_NUMERIC C
 
23
setlocale(LC_NUMERIC,"C");
 
24
 
 
25
 
 
26
$VERSION = "1.12";
 
27
$PSQL = "psql";
 
28
 
 
29
=head1 NAME
 
30
 
 
31
Ora2Pg - Oracle to PostgreSQL database schema converter
 
32
 
 
33
 
 
34
=head1 SYNOPSIS
 
35
 
 
36
        BEGIN {
 
37
                $ENV{ORACLE_HOME} = '/usr/local/oracle/oracle816';
 
38
        }
 
39
 
 
40
        use strict;
 
41
 
 
42
        use Ora2Pg;
 
43
 
 
44
        # Init the database connection
 
45
        my $dbsrc = 'dbi:Oracle:host=testdb.samse.fr;sid=TEST;port=1521';
 
46
        my $dbuser = 'system';
 
47
        my $dbpwd = 'manager';
 
48
 
 
49
        # Create an instance of the Ora2Pg perl module
 
50
        my $schema = new Ora2Pg (
 
51
                datasource => $dbsrc,           # Database DBD datasource
 
52
                user => $dbuser,                # Database user
 
53
                password => $dbpwd,             # Database password
 
54
                {
 
55
                        PrintError => 0,
 
56
                        RaiseError => 1,
 
57
                        AutoCommit => 0
 
58
                }
 
59
        );
 
60
 
 
61
        # Create the POSTGRESQL representation of all objects in the database
 
62
        $schema->export_schema("output.sql");
 
63
 
 
64
        exit(0);
 
65
 
 
66
or if you only want to extract some tables:
 
67
 
 
68
        # Create an instance of the Ora2Pg perl module
 
69
        my @tables = ('tab1', 'tab2', 'tab3');
 
70
        my $schema = new Ora2Pg (
 
71
                datasource => $dbsrc,           # Database DBD datasource
 
72
                user => $dbuser,                # Database user
 
73
                password => $dbpwd,             # Database password
 
74
                tables => \@tables,
 
75
        or                                      # Tables to extract
 
76
                tables => [('tab1','tab2')],
 
77
                debug => 1                      # To show somethings when running
 
78
        );
 
79
 
 
80
or if you only want to extract the 10 first tables:
 
81
 
 
82
        # Create an instance of the Ora2Pg perl module
 
83
        my $schema = new Ora2Pg (
 
84
                datasource => $dbsrc,           # Database DBD datasource
 
85
                user => $dbuser,                # Database user
 
86
                password => $dbpwd,             # Database password
 
87
                max => 10                       # 10 first tables to extract
 
88
        );
 
89
 
 
90
or if you only want to extract tables 10 to 20:
 
91
 
 
92
        # Create an instance of the Ora2Pg perl module
 
93
        my $schema = new Ora2Pg (
 
94
                datasource => $dbsrc,           # Database DBD datasource
 
95
                user => $dbuser,                # Database user
 
96
                password => $dbpwd,             # Database password
 
97
                min => 10,                      # Begin extraction at indice 10
 
98
                max => 20                       # End extraction at indice 20
 
99
        );
 
100
 
 
101
To choose a particular Oracle schema to export just set the following option
 
102
to your schema name:
 
103
 
 
104
        schema => 'APPS'
 
105
 
 
106
This schema definition can also be needed when you want to export data. If export
 
107
failed and complain that the table doesn't exists use this to prefix the table name
 
108
by the schema name.
 
109
 
 
110
If you want to use PostgreSQL 7.3 schema support activate the init option
 
111
'export_schema' set to 1. Default is no schema export
 
112
 
 
113
To know at which indices tables can be found during extraction use the option:
 
114
 
 
115
        showtableid => 1
 
116
 
 
117
To extract all views set the type option as follow:
 
118
 
 
119
        type => 'VIEW'
 
120
 
 
121
To extract all grants set the type option as follow:
 
122
 
 
123
        type => 'GRANT'
 
124
 
 
125
To extract all sequences set the type option as follow:
 
126
 
 
127
        type => 'SEQUENCE'
 
128
 
 
129
To extract all triggers set the type option as follow:
 
130
 
 
131
        type => 'TRIGGER'
 
132
 
 
133
To extract all functions set the type option as follow:
 
134
 
 
135
        type => 'FUNCTION'
 
136
 
 
137
To extract all procedures set the type option as follow:
 
138
 
 
139
        type => 'PROCEDURE'
 
140
 
 
141
To extract all packages and body set the type option as follow:
 
142
 
 
143
        type => 'PACKAGE'
 
144
 
 
145
Default is table extraction
 
146
 
 
147
        type => 'TABLE'
 
148
 
 
149
To extract all data from table extraction as INSERT statement use:
 
150
 
 
151
        type => 'DATA'
 
152
 
 
153
To extract all data from table extraction as COPY statement use:
 
154
 
 
155
        type => 'COPY'
 
156
 
 
157
and data_limit => n to specify the max tuples to return. If you set
 
158
this options to 0 or nothing, no limitation are used. Additional option
 
159
'table', 'min' and 'max' can also be used.
 
160
 
 
161
When use of COPY or DATA you can export data by calling method:
 
162
 
 
163
$schema->export_data("output.sql");
 
164
 
 
165
Data are dumped to the given filename or to STDOUT with no argument.
 
166
You can also send these data directly to a PostgreSQL backend using
 
167
 the following method:
 
168
 
 
169
$schema->send_to_pgdb($destdatasrc,$destuser,$destpasswd);
 
170
 
 
171
In this case you must call export_data() without argument after the
 
172
call to method send_to_pgdb().
 
173
 
 
174
If you set type to COPY and you want to dump data directly to a PG database,
 
175
you must call method send_to_pgdb but data will not be sent via DBD::Pg but
 
176
they will be load to the database using the psql command. Calling this method
 
177
is istill required to be able to extract database name, hostname and port
 
178
information. Edit the $PSQL variable to match the path of your psql
 
179
command (nothing to edit if psql is in your path).
 
180
 
 
181
 
 
182
=head1 DESCRIPTION
 
183
 
 
184
Ora2Pg is a perl OO module used to export an Oracle database schema
 
185
to a PostgreSQL compatible schema.
 
186
 
 
187
It simply connect to your Oracle database, extract its structure and
 
188
generate a SQL script that you can load into your PostgreSQL database.
 
189
 
 
190
I'm not a Oracle DBA so I don't really know something about its internal
 
191
structure so you may find some incorrect things. Please tell me what is
 
192
wrong and what can be better.
 
193
 
 
194
It currently dump the database schema (tables, views, sequences, indexes, grants),
 
195
with primary, unique and foreign keys into PostgreSQL syntax without editing the
 
196
SQL code generated.
 
197
 
 
198
It now can dump Oracle data into PostgreSQL DB as online process. You can choose
 
199
what columns can be exported for each table.
 
200
 
 
201
Functions, procedures and triggers PL/SQL code generated must be reviewed to match
 
202
the PostgreSQL syntax. Some usefull recommandation on porting Oracle to PostgreSQL
 
203
can be found at http://techdocs.postgresql.org/ under the "Converting from other
 
204
Databases to PostgreSQL" Oracle part. I just notice one thing more is that the
 
205
trunc() function in Oracle is the same for number or date so be carefull when
 
206
porting to PostgreSQL to use trunc() for number and date_trunc() for date.
 
207
 
 
208
 
 
209
=head1 ABSTRACT
 
210
 
 
211
The goal of the Ora2Pg perl module is to cover all part needed to export
 
212
an Oracle database to a PostgreSQL database without other thing that provide
 
213
the connection parameters to the Oracle database.
 
214
 
 
215
Features must include:
 
216
 
 
217
        - Database schema export (tables, views, sequences, indexes),
 
218
          with unique, primary and foreign key.
 
219
        - Grants/privileges export by user and group.
 
220
        - Table selection (by name and max table) export.
 
221
        - Export Oracle schema to PostgreSQL 7.3 schema.
 
222
        - Predefined functions/triggers/procedures/packages export.
 
223
        - Data export.
 
224
        - Sql query converter (todo)
 
225
 
 
226
My knowledge regarding database is really poor especially for Oracle
 
227
so contribution is welcome.
 
228
 
 
229
 
 
230
=head1 REQUIREMENT
 
231
 
 
232
You just need the DBI, DBD::Pg and DBD::Oracle perl module to be installed
 
233
 
 
234
 
 
235
 
 
236
=head1 PUBLIC METHODS
 
237
 
 
238
=head2 new HASH_OPTIONS
 
239
 
 
240
Creates a new Ora2Pg object.
 
241
 
 
242
Supported options are:
 
243
 
 
244
        - datasource    : DBD datasource (required)
 
245
        - user          : DBD user (optional with public access)
 
246
        - password      : DBD password (optional with public access)
 
247
        - schema        : Oracle internal schema to extract
 
248
        - type          : Type of data to extract, can be TABLE,VIEW,GRANT,SEQUENCE,
 
249
                          TRIGGER,FUNCTION,PROCEDURE,DATA,COPY,PACKAGE
 
250
        - debug         : Print the current state of the parsing
 
251
        - export_schema : Export Oracle schema to PostgreSQL 7.3 schema
 
252
        - tables        : Extract only the given tables (arrayref)
 
253
        - showtableid   : Display only the table indice during extraction
 
254
        - min           : Indice to begin extraction. Default to 0
 
255
        - max           : Indice to end extraction. Default to 0 mean no limits
 
256
        - data_limit    : Number max of tuples to return during data extraction (default 0 no limit)
 
257
 
 
258
Attempt that this list should grow a little more because all initialization is
 
259
done by this way.
 
260
 
 
261
=cut
 
262
 
 
263
sub new
 
264
{
 
265
        my ($class, %options) = @_;
 
266
 
 
267
        # This create an OO perl object
 
268
        my $self = {};
 
269
        bless ($self, $class);
 
270
 
 
271
        # Initialize this object
 
272
        $self->_init(%options);
 
273
        
 
274
        # Return the instance
 
275
        return($self);
 
276
}
 
277
 
 
278
 
 
279
=head2 export_data FILENAME
 
280
 
 
281
Print SQL data output to a filename or
 
282
to STDOUT if no file is given. 
 
283
 
 
284
Must be used only if type option is set to DATA or COPY
 
285
=cut
 
286
 
 
287
sub export_data
 
288
{
 
289
        my ($self, $outfile) = @_;
 
290
 
 
291
        $self->_get_sql_data($outfile);
 
292
}
 
293
 
 
294
 
 
295
=head2 export_sql FILENAME
 
296
 
 
297
Print SQL conversion output to a filename or
 
298
simply return these data if no file is given. 
 
299
 
 
300
=cut
 
301
 
 
302
sub export_schema
 
303
{
 
304
        my ($self, $outfile) = @_;
 
305
 
 
306
        if ($outfile) {
 
307
                # Send output to the given file
 
308
                open(FILE,">$outfile") or die "Can't open $outfile: $!";
 
309
                print FILE $self->_get_sql_data();
 
310
                close FILE;
 
311
                return; 
 
312
        }
 
313
 
 
314
        # Return data as string
 
315
        return $self->_get_sql_data();
 
316
 
 
317
}
 
318
 
 
319
 
 
320
=head2 send_to_pgdb DEST_DATASRC DEST_USER DEST_PASSWD
 
321
 
 
322
Open a DB handle to a PostgreSQL database
 
323
 
 
324
=cut
 
325
 
 
326
sub send_to_pgdb
 
327
{
 
328
        my ($self, $destsrc, $destuser, $destpasswd) = @_;
 
329
 
 
330
        # Connect the database
 
331
        $self->{dbhdest} = DBI->connect($destsrc, $destuser, $destpasswd);
 
332
 
 
333
        $destsrc =~ /dbname=([^;]*)/;
 
334
        $self->{dbname} = $1;
 
335
        $destsrc =~ /host=([^;]*)/;
 
336
        $self->{dbhost} = $1;
 
337
        $self->{dbhost} = 'localhost' if (!$self->{dbhost});
 
338
        $destsrc =~ /port=([^;]*)/;
 
339
        $self->{dbport} = $1;
 
340
        $self->{dbport} = 5432 if (!$self->{dbport});
 
341
        $self->{dbuser} = $destuser;
 
342
 
 
343
        # Check for connection failure
 
344
        if (!$self->{dbhdest}) {
 
345
                die "Error : $DBI::err ... $DBI::errstr\n";
 
346
        }
 
347
 
 
348
}
 
349
 
 
350
 
 
351
=head2 modify_struct TABLE_NAME ARRAYOF_FIELDNAME
 
352
 
 
353
Modify a table structure during export. Only given fieldname
 
354
will be exported. 
 
355
 
 
356
=cut
 
357
 
 
358
sub modify_struct
 
359
{
 
360
        my ($self, $table, @fields) = @_;
 
361
 
 
362
        map { $_ = lc($_) } @fields;
 
363
        $table = lc($table);
 
364
 
 
365
        push(@{$self->{modify}{$table}}, @fields);
 
366
 
 
367
}
 
368
 
 
369
 
 
370
 
 
371
 
 
372
#### Private subroutines ####
 
373
 
 
374
=head1 PRIVATE METHODS
 
375
 
 
376
=head2 _init HASH_OPTIONS
 
377
 
 
378
Initialize a Ora2Pg object instance with a connexion to the
 
379
Oracle database.
 
380
 
 
381
=cut
 
382
 
 
383
sub _init
 
384
{
 
385
        my ($self, %options) = @_;
 
386
 
 
387
        # Connect the database
 
388
        $self->{dbh} = DBI->connect($options{datasource}, $options{user}, $options{password});
 
389
 
 
390
        # Check for connection failure
 
391
        if (!$self->{dbh}) {
 
392
                die "Error : $DBI::err ... $DBI::errstr\n";
 
393
        }
 
394
 
 
395
        # Save the DB connection
 
396
        $self->{datasource} = $options{datasource};
 
397
        $self->{user} = $options{user};
 
398
        $self->{password} = $options{password};
 
399
 
 
400
        $self->{debug} = 0;
 
401
        $self->{debug} = 1 if ($options{debug});
 
402
 
 
403
        $self->{limited} = ();
 
404
        $self->{limited} = $options{tables} if ($options{tables});
 
405
 
 
406
        $self->{export_schema} = 0;
 
407
        $self->{export_schema} = $options{export_schema} if ($options{export_schema});
 
408
 
 
409
        $self->{schema} = '';
 
410
        $self->{schema} = $options{schema} if ($options{schema});
 
411
 
 
412
        $self->{min} = 0;
 
413
        $self->{min} = $options{min} if ($options{min});
 
414
 
 
415
        $self->{max} = 0;
 
416
        $self->{max} = $options{max} if ($options{max});
 
417
 
 
418
        $self->{showtableid} = 0;
 
419
        $self->{showtableid} = $options{showtableid} if ($options{showtableid});
 
420
 
 
421
        $self->{dbh}->{LongReadLen} = 0;
 
422
        #$self->{dbh}->{LongTruncOk} = 1;
 
423
 
 
424
        $self->{data_limit} = 0;
 
425
        $self->{data_current} = 0;
 
426
        $self->{data_limit} = $options{data_limit} if (exists $options{data_limit});
 
427
 
 
428
        # Retreive all table informations
 
429
        if (!exists $options{type} || ($options{type} eq 'TABLE') || ($options{type} eq 'DATA') || ($options{type} eq 'COPY')) {
 
430
                $self->{dbh}->{LongReadLen} = 100000;
 
431
                $self->_tables();
 
432
        } elsif ($options{type} eq 'VIEW') {
 
433
                $self->{dbh}->{LongReadLen} = 100000;
 
434
                $self->_views();
 
435
        } elsif ($options{type} eq 'GRANT') {
 
436
                $self->_grants();
 
437
        } elsif ($options{type} eq 'SEQUENCE') {
 
438
                $self->_sequences();
 
439
        } elsif ($options{type} eq 'TRIGGER') {
 
440
                $self->{dbh}->{LongReadLen} = 100000;
 
441
                $self->_triggers();
 
442
        } elsif (($options{type} eq 'FUNCTION') || ($options{type} eq 'PROCEDURE')) {
 
443
                $self->{dbh}->{LongReadLen} = 100000;
 
444
                $self->_functions($options{type});
 
445
        } elsif ($options{type} eq 'PACKAGE') {
 
446
                $self->{dbh}->{LongReadLen} = 100000;
 
447
                $self->_packages();
 
448
        } else {
 
449
                die "type option must be TABLE, VIEW, GRANT, SEQUENCE, TRIGGER, PACKAGE, FUNCTION or PROCEDURE\n";
 
450
        }
 
451
        $self->{type} = $options{type};
 
452
 
 
453
        # Disconnect from the database
 
454
        $self->{dbh}->disconnect() if ($self->{dbh});
 
455
 
 
456
}
 
457
 
 
458
 
 
459
# We provide a DESTROY method so that the autoloader doesn't
 
460
# bother trying to find it. We also close the DB connexion
 
461
sub DESTROY { }
 
462
 
 
463
 
 
464
=head2 _grants
 
465
 
 
466
This function is used to retrieve all privilege information.
 
467
 
 
468
It extract all Oracle's ROLES to convert them as Postgres groups
 
469
and search all users associated to these roles.
 
470
 
 
471
Set the main hash $self->{groups}.
 
472
Set the main hash $self->{grantss}.
 
473
 
 
474
=cut
 
475
 
 
476
sub _grants
 
477
{
 
478
        my ($self) = @_;
 
479
 
 
480
print STDERR "Retrieving groups/users information...\n" if ($self->{debug});
 
481
        $self->{users} = $self->_get_users();
 
482
        $self->{groups} = $self->_get_roles();
 
483
        $self->{grants} = $self->_get_all_grants();
 
484
 
 
485
}
 
486
 
 
487
 
 
488
=head2 _sequences
 
489
 
 
490
This function is used to retrieve all sequences information.
 
491
 
 
492
Set the main hash $self->{sequences}.
 
493
 
 
494
=cut
 
495
 
 
496
sub _sequences
 
497
{
 
498
        my ($self) = @_;
 
499
 
 
500
print STDERR "Retrieving sequences information...\n" if ($self->{debug});
 
501
        $self->{sequences} = $self->_get_sequences();
 
502
 
 
503
}
 
504
 
 
505
 
 
506
=head2 _triggers
 
507
 
 
508
This function is used to retrieve all triggers information.
 
509
 
 
510
Set the main hash $self->{triggers}.
 
511
 
 
512
=cut
 
513
 
 
514
sub _triggers
 
515
{
 
516
        my ($self) = @_;
 
517
 
 
518
print STDERR "Retrieving triggers information...\n" if ($self->{debug});
 
519
        $self->{triggers} = $self->_get_triggers();
 
520
 
 
521
}
 
522
 
 
523
 
 
524
=head2 _functions
 
525
 
 
526
This function is used to retrieve all functions information.
 
527
 
 
528
Set the main hash $self->{functions}.
 
529
 
 
530
=cut
 
531
 
 
532
sub _functions
 
533
{
 
534
        my ($self, $type) = @_;
 
535
 
 
536
print STDERR "Retrieving functions information...\n" if ($self->{debug});
 
537
        $self->{functions} = $self->_get_functions($type);
 
538
 
 
539
}
 
540
 
 
541
 
 
542
=head2 _packages
 
543
 
 
544
This function is used to retrieve all packages information.
 
545
 
 
546
Set the main hash $self->{packages}.
 
547
 
 
548
=cut
 
549
 
 
550
sub _packages
 
551
{
 
552
        my ($self) = @_;
 
553
 
 
554
print STDERR "Retrieving packages information...\n" if ($self->{debug});
 
555
        $self->{packages} = $self->_get_packages();
 
556
 
 
557
}
 
558
 
 
559
 
 
560
=head2 _tables
 
561
 
 
562
This function is used to retrieve all table information.
 
563
 
 
564
Set the main hash of the database structure $self->{tables}.
 
565
Keys are the names of all tables retrieved from the current
 
566
database. Each table information compose an array associated
 
567
to the table_info key as array reference. In other way:
 
568
 
 
569
    $self->{tables}{$class_name}{table_info} = [(OWNER,TYPE)];
 
570
 
 
571
DBI TYPE can be TABLE, VIEW, SYSTEM TABLE, GLOBAL TEMPORARY, LOCAL TEMPORARY,
 
572
ALIAS, SYNONYM or a data source specific type identifier. This only extract
 
573
TABLE type.
 
574
 
 
575
It also get the following informations in the DBI object to affect the
 
576
main hash of the database structure :
 
577
 
 
578
    $self->{tables}{$class_name}{field_name} = $sth->{NAME};
 
579
    $self->{tables}{$class_name}{field_type} = $sth->{TYPE};
 
580
 
 
581
It also call these other private subroutine to affect the main hash
 
582
of the database structure :
 
583
 
 
584
    @{$self->{tables}{$class_name}{column_info}} = $self->_column_info($class_name, $owner);
 
585
    @{$self->{tables}{$class_name}{primary_key}} = $self->_primary_key($class_name, $owner);
 
586
    @{$self->{tables}{$class_name}{unique_key}}  = $self->_unique_key($class_name, $owner);
 
587
    @{$self->{tables}{$class_name}{foreign_key}} = $self->_foreign_key($class_name, $owner);
 
588
 
 
589
=cut
 
590
 
 
591
sub _tables
 
592
{
 
593
        my ($self) = @_;
 
594
 
 
595
        # Get all tables information given by the DBI method table_info
 
596
print STDERR "Retrieving table information...\n" if ($self->{debug});
 
597
 
 
598
        my $sth = $self->_table_info or die $self->{dbh}->errstr;
 
599
        my @tables_infos = $sth->fetchall_arrayref();
 
600
 
 
601
        if ($self->{showtableid}) {
 
602
                foreach my $table (@tables_infos) {
 
603
                        for (my $i=0; $i<=$#{$table};$i++) {
 
604
                                print STDERR "[", $i+1, "] ${$table}[$i]->[2]\n";
 
605
                        }
 
606
                }
 
607
                return;
 
608
        }
 
609
my @done = ();
 
610
        foreach my $table (@tables_infos) {
 
611
                # Set the table information for each class found
 
612
                my $i = 1;
 
613
print STDERR "Min table dump set to $self->{min}.\n" if ($self->{debug} && $self->{min});
 
614
print STDERR "Max table dump set to $self->{max}.\n" if ($self->{debug} && $self->{max});
 
615
                foreach my $t (@$table) {
 
616
                        # Jump to desired extraction
 
617
if (grep(/^$t->[2]$/, @done)) {
 
618
print STDERR "Duplicate entry found: $t->[0] - $t->[1] - $t->[2]\n";
 
619
} else {
 
620
push(@done, $t->[2]);
 
621
}
 
622
                        $i++, next if ($self->{min} && ($i < $self->{min}));
 
623
                        last if ($self->{max} && ($i > $self->{max}));
 
624
                        next if (($#{$self->{limited}} >= 0) && !grep(/^$t->[2]$/, @{$self->{limited}}));
 
625
print STDERR "[$i] " if ($self->{max} || $self->{min});
 
626
print STDERR "Scanning $t->[2] (@$t)...\n" if ($self->{debug});
 
627
                        
 
628
                        # Check of uniqueness of the table
 
629
                        if (exists $self->{tables}{$t->[2]}{field_name}) {
 
630
                                print STDERR "Warning duplicate table $t->[2], SYNONYME ? Skipped.\n";
 
631
                                next;
 
632
                        }
 
633
 
 
634
                        # usually OWNER,TYPE. QUALIFIER is omitted until I know what to do with that
 
635
                        $self->{tables}{$t->[2]}{table_info} = [($t->[1],$t->[3])];
 
636
                        # Set the fields information
 
637
                        my $sth = $self->{dbh}->prepare("SELECT * FROM $t->[1].$t->[2] WHERE 1=0");
 
638
                        if (!defined($sth)) {
 
639
                                warn "Can't prepare statement: $DBI::errstr";
 
640
                                next;
 
641
                        }
 
642
                        $sth->execute;
 
643
                        if ($sth->err) {
 
644
                                warn "Can't execute statement: $DBI::errstr";
 
645
                                next;
 
646
                        }
 
647
                        $self->{tables}{$t->[2]}{field_name} = $sth->{NAME};
 
648
                        $self->{tables}{$t->[2]}{field_type} = $sth->{TYPE};
 
649
 
 
650
                        @{$self->{tables}{$t->[2]}{column_info}} = $self->_column_info($t->[2],$t->[1]);
 
651
                        @{$self->{tables}{$t->[2]}{primary_key}} = $self->_primary_key($t->[2],$t->[1]);
 
652
                        @{$self->{tables}{$t->[2]}{unique_key}} = $self->_unique_key($t->[2],$t->[1]);
 
653
                        ($self->{tables}{$t->[2]}{foreign_link}, $self->{tables}{$t->[2]}{foreign_key}) = $self->_foreign_key($t->[2],$t->[1]);
 
654
                        ($self->{tables}{$t->[2]}{uniqueness}, $self->{tables}{$t->[2]}{indexes}) = $self->_get_indexes($t->[2],$t->[1]);
 
655
                        $i++;
 
656
                }
 
657
        }
 
658
 
 
659
}
 
660
 
 
661
 
 
662
=head2 _views
 
663
 
 
664
This function is used to retrieve all views information.
 
665
 
 
666
Set the main hash of the views definition $self->{views}.
 
667
Keys are the names of all views retrieved from the current
 
668
database values are the text definition of the views.
 
669
 
 
670
It then set the main hash as follow:
 
671
 
 
672
    # Definition of the view
 
673
    $self->{views}{$table}{text} = $view_infos{$table};
 
674
 
 
675
=cut
 
676
 
 
677
sub _views
 
678
{
 
679
        my ($self) = @_;
 
680
 
 
681
        # Get all views information
 
682
print STDERR "Retrieving views information...\n" if ($self->{debug});
 
683
        my %view_infos = $self->_get_views();
 
684
 
 
685
        if ($self->{showtableid}) {
 
686
                my $i = 1;
 
687
                foreach my $table (sort keys %view_infos) {
 
688
                        print STDERR "[$i] $table\n";
 
689
                        $i++;
 
690
                }
 
691
                return;
 
692
        }
 
693
 
 
694
print STDERR "Min view dump set to $self->{min}.\n" if ($self->{debug} && $self->{min});
 
695
print STDERR "Max view dump set to $self->{max}.\n" if ($self->{debug} && $self->{max});
 
696
        my $i = 1;
 
697
        foreach my $table (sort keys %view_infos) {
 
698
                # Set the table information for each class found
 
699
                # Jump to desired extraction
 
700
                next if ($table =~ /\$/);
 
701
                $i++, next if ($self->{min} && ($i < $self->{min}));
 
702
                last if ($self->{max} && ($i > $self->{max}));
 
703
                next if (($#{$self->{limited}} >= 0) && !grep(/^$table$/, @{$self->{limited}}));
 
704
print STDERR "[$i] " if ($self->{max} || $self->{min});
 
705
print STDERR "Scanning $table...\n" if ($self->{debug});
 
706
                $self->{views}{$table}{text} = $view_infos{$table};
 
707
                ## Added JFR : 3/3/02 : Retrieve also aliases from views
 
708
                $self->{views}{$table}{alias}= $view_infos{$table}{alias};
 
709
                $i++;
 
710
        }
 
711
 
 
712
}
 
713
 
 
714
 
 
715
=head2 _get_sql_data
 
716
 
 
717
Returns a string containing the entire SQL Schema definition compatible with PostgreSQL
 
718
 
 
719
=cut
 
720
 
 
721
sub _get_sql_data
 
722
{
 
723
        my ($self, $outfile) = @_;
 
724
 
 
725
        my $sql_header = "-- Generated by Ora2Pg, the Oracle database Schema converter, version $VERSION\n";
 
726
        $sql_header .= "-- Copyright 2000 Gilles DAROLD. All rights reserved.\n";
 
727
        $sql_header .= "--\n";
 
728
        $sql_header .= "-- This program is free software; you can redistribute it and/or modify it under\n";
 
729
        $sql_header .= "-- the same terms as Perl itself.\n\n";
 
730
        $sql_header .= "BEGIN TRANSACTION;\n\n";
 
731
 
 
732
        my $sql_output = "";
 
733
 
 
734
        # Process view only
 
735
        if ($self->{type} eq 'VIEW') {
 
736
print STDERR "Add views definition...\n" if ($self->{debug});
 
737
                if ($self->{export_schema}) {
 
738
                        $sql_output .= "SET search_path = $self->{schema}, pg_catalog;\n\n";
 
739
                }
 
740
                foreach my $view (sort keys %{$self->{views}}) {
 
741
                        $self->{views}{$view}{text} =~ s/\s*WITH\s+.*$//s;
 
742
                        if (!@{$self->{views}{$view}{alias}}) {
 
743
                                $sql_output .= "CREATE VIEW \"\L$view\E\" AS \L$self->{views}{$view}{text};\n";
 
744
                        } else {
 
745
                                $sql_output .= "CREATE VIEW \"\L$view\E\" (";
 
746
                                my $count = 0;
 
747
                                foreach my $d (@{$self->{views}{$view}{alias}}) {
 
748
                                        if ($count == 0) {
 
749
                                                $count = 1;
 
750
                                        } else {
 
751
                                                $sql_output .= ", "
 
752
                                        }
 
753
                                        $sql_output .= "\"\L$d->[0]\E\"";
 
754
                                }
 
755
                                $sql_output .= ") AS \L$self->{views}{$view}{text};\n";
 
756
                        }
 
757
                }
 
758
 
 
759
                if (!$sql_output) {
 
760
                        $sql_output = "-- Nothing found of type $self->{type}\n";
 
761
                } else {
 
762
                        $sql_output .= "\n";
 
763
                }
 
764
 
 
765
                return $sql_header . $sql_output . "\nEND TRANSACTION;\n";
 
766
        }
 
767
 
 
768
        # Process grant only
 
769
        if ($self->{type} eq 'GRANT') {
 
770
print STDERR "Add groups/users privileges...\n" if ($self->{debug});
 
771
                if ($self->{export_schema}) {
 
772
                        $sql_output .= "SET search_path = $self->{schema}, pg_catalog;\n\n";
 
773
                }
 
774
                # Add groups definition
 
775
                my $groups = '';
 
776
                my @users = ();
 
777
                my @grps = ();
 
778
                foreach (@{$self->{users}}) {
 
779
                        next if (exists $self->{groups}{"$_"});
 
780
                        next if ($self->{schema} && ($_ ne $self->{schema}));
 
781
                        $sql_header .= "CREATE USER $_ WITH PASSWORD 'secret';\n";
 
782
                }
 
783
                foreach my $role (sort keys %{$self->{groups}}) {
 
784
                        push(@grps, $role);
 
785
                        $groups .= "CREATE GROUP $role WITH USER " . join(',', @{$self->{groups}{$role}}) . ";\n";
 
786
                }
 
787
                $sql_header .= "\n" . $groups . "\n";
 
788
 
 
789
                # Add privilege definition
 
790
                my $grants = '';
 
791
                foreach my $table (sort keys %{$self->{grants}}) {
 
792
                        $grants .= "REVOKE ALL ON $table FROM PUBLIC;\n";
 
793
                        foreach my $priv (sort keys %{$self->{grants}{$table}}) {
 
794
                                my $usr = '';
 
795
                                my $grp = '';
 
796
                                foreach my $user (@{$self->{grants}{$table}{$priv}}) {
 
797
                                        if (grep(/^$user$/, @grps)) {
 
798
                                                $grp .= "$user,";
 
799
                                        } else {
 
800
                                                $usr .= "$user,";
 
801
                                        }
 
802
                                }
 
803
                                $grp =~ s/,$//;
 
804
                                $usr =~ s/,$//;
 
805
                                if ($grp) {
 
806
                                        $grants .= "GRANT $priv ON $table TO GROUP $grp;\n";
 
807
                                } else {
 
808
                                        $grants .= "GRANT $priv ON $table TO $usr;\n";
 
809
                                }
 
810
                        }
 
811
                }
 
812
 
 
813
                if (!$grants) {
 
814
                        $$grants = "-- Nothing found of type $self->{type}\n";
 
815
                }
 
816
 
 
817
                $sql_output .= "\n" . $grants . "\n";
 
818
 
 
819
                return $sql_header . $sql_output . "\nEND TRANSACTION;\n";
 
820
        }
 
821
 
 
822
        # Process sequences only
 
823
        if ($self->{type} eq 'SEQUENCE') {
 
824
print STDERR "Add sequences definition...\n" if ($self->{debug});
 
825
                foreach my $seq (@{$self->{sequences}}) {
 
826
                        my $cache = 1;
 
827
                        $cache = $seq->[5] if ($seq->[5]);
 
828
                        my $cycle = '';
 
829
                        $cycle = ' CYCLE' if ($seq->[6] eq 'Y');
 
830
                        if ($seq->[2] > 2147483646) {
 
831
                                $seq->[2] = 2147483646;
 
832
                        }
 
833
                        if ($seq->[1] < -2147483647) {
 
834
                                $seq->[1] = -2147483647;
 
835
                        }
 
836
                        if ($self->{export_schema}) {
 
837
                                $sql_output .= "SET search_path = $self->{schema}, pg_catalog;\n\n";
 
838
                        }
 
839
                        $sql_output .= "CREATE SEQUENCE \"\L$seq->[0]\E\" INCREMENT $seq->[3] MINVALUE $seq->[1] MAXVALUE $seq->[2] START $seq->[4] CACHE $cache$cycle;\n";
 
840
                }
 
841
 
 
842
                if (!$sql_output) {
 
843
                        $sql_output = "-- Nothing found of type $self->{type}\n";
 
844
                }
 
845
 
 
846
                return $sql_header . $sql_output . "\nEND TRANSACTION;\n";
 
847
        }
 
848
 
 
849
        # Process triggers only. PL/SQL code is pre-converted to PL/PGSQL following
 
850
        # the recommendation of Roberto Mello, see http://techdocs.postgresql.org/
 
851
        # Oracle's PL/SQL to PostgreSQL PL/pgSQL HOWTO  
 
852
        if ($self->{type} eq 'TRIGGER') {
 
853
print STDERR "Add triggers definition...\n" if ($self->{debug});
 
854
                foreach my $trig (@{$self->{triggers}}) {
 
855
                        $trig->[1] =~ s/ EACH ROW//;
 
856
                        chop($trig->[4]);
 
857
                        chomp($trig->[4]);
 
858
                        # Check if it's a pg rule
 
859
                        if ($trig->[1] =~ /INSTEAD OF/) {
 
860
                                $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";
 
861
                        } else {
 
862
 
 
863
                                #--------------------------------------------
 
864
                                # PL/SQL to PL/PGSQL code conversion
 
865
                                #--------------------------------------------
 
866
                                # Change NVL to COALESCE
 
867
                                #$trig->[4] =~ s/NVL\(/coalesce(/igs;
 
868
                                # Change trunc() to date_trunc('day', field)
 
869
                                # Trunc is replaced with date_trunc if we find date in the name of the value
 
870
                                # because Oracle have the same trunc function on number and date type :-(((
 
871
                                #$trig->[4] =~ s/trunc\(([^\)]*date[^\)]*)\)/date_trunc('day', $1)/igs;
 
872
                                # Change SYSDATE to 'now'
 
873
                                #$trig->[4] =~ s/SYSDATE/CURRENT_TIMESTAMP/igs;
 
874
                                # Change nextval on sequence
 
875
                                # Oracle's sequence grammar is sequence_name.nextval.
 
876
                                # Postgres's sequence grammar is nextval('sequence_name'). 
 
877
                                #$trig->[4] =~ s/(\w+)\.nextval/nextval('$1')/isg;
 
878
                                # Escaping Single Quotes
 
879
                                #$trig->[4] =~ s/'/''/sg;
 
880
 
 
881
                                if ($self->{export_schema}) {
 
882
                                        $sql_output .= "SET search_path = $self->{schema}, pg_catalog;\n\n";
 
883
                                }
 
884
                                $sql_output .= "CREATE FUNCTION pg_fct_\L$trig->[0]\E () RETURNS TRIGGER AS '\n$trig->[4]\n' LANGUAGE 'plpgsql'\n\n";
 
885
                                $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";
 
886
                        }
 
887
                }
 
888
 
 
889
                if (!$sql_output) {
 
890
                        $sql_output = "-- Nothing found of type $self->{type}\n";
 
891
                }
 
892
 
 
893
                return $sql_header . $sql_output . "\nEND TRANSACTION;\n";
 
894
        }
 
895
 
 
896
        # Process functions only
 
897
        if (($self->{type} eq 'FUNCTION') || ($self->{type} eq 'PROCEDURE')) {
 
898
print STDERR "Add functions definition...\n" if ($self->{debug});
 
899
                foreach my $fct (sort keys %{$self->{functions}}) {
 
900
                        my @tmp = ();
 
901
                        if ($self->{functions}{$fct} =~ /^[\s\t]*function/is) {
 
902
                                #$self->{functions}{$fct} =~ /function[\s\n\t]*$fct[\s\n\t]*\(([^\)]*)\)/is;
 
903
                                $self->{functions}{$fct} =~ /function[\s\n\t]*$fct[\s\n\t]*\(([^\)]*)\)[\s\n\t]*is/is;
 
904
                                @tmp = split(/\n/, $1);
 
905
                        } else {
 
906
                                #$self->{functions}{$fct} =~ /procedure[\s\n\t]*$fct[\s\n\t]*\(([^\)]*)\)/is;
 
907
                                $self->{functions}{$fct} =~ /procedure[\s\n\t]*$fct[\s\n\t]*\(([^\)]*)\)[\s\n\t]*is\W/is;
 
908
                                @tmp = split(/\n/, $1);
 
909
                        }
 
910
                        my @argu = split(/,/, join(' ', @tmp));
 
911
                        map { s/^.* in //is } @argu;
 
912
                        map { s/^.* out //is } @argu;
 
913
                        map { $_ = $self->_sql_type(uc($_)) } @argu;
 
914
                        $self->{functions}{$fct} =~ /return ([^\s]*) is/is;
 
915
                        $self->{functions}{$fct} = "-- Oracle function declaration, please edit to match PostgreSQL syntax.\n$self->{functions}{$fct}";
 
916
                        $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";
 
917
                }
 
918
 
 
919
                if (!$sql_output) {
 
920
                        $sql_output = "-- Nothing found of type $self->{type}\n";
 
921
                }
 
922
 
 
923
                return $sql_header . $sql_output . "\nEND TRANSACTION;\n";
 
924
        }
 
925
 
 
926
        # Process functions only
 
927
        if ($self->{type} eq 'PACKAGE') {
 
928
print STDERR "Add packages definition...\n" if ($self->{debug});
 
929
                foreach my $pkg (sort keys %{$self->{packages}}) {
 
930
                        $sql_output .= "-- Oracle package '$pkg' declaration, please edit to match PostgreSQL syntax.\n";
 
931
                        $sql_output .= "$self->{packages}{$pkg}\n";
 
932
                        $sql_output .= "-- End of Oracle package '$pkg' declaration\n\n";
 
933
                }
 
934
 
 
935
                if (!$sql_output) {
 
936
                        $sql_output = "-- Nothing found of type $self->{type}\n";
 
937
                }
 
938
 
 
939
                return $sql_header . $sql_output . "\nEND TRANSACTION;\n";
 
940
        }
 
941
 
 
942
 
 
943
 
 
944
        # Extract data only
 
945
        if (($self->{type} eq 'DATA') || ($self->{type} eq 'COPY')) {
 
946
                # Connect the database
 
947
                $self->{dbh} = DBI->connect($self->{datasource}, $self->{user}, $self->{password});
 
948
                # Check for connection failure
 
949
                if (!$self->{dbh}) {
 
950
                        die "Error : $DBI::err ... $DBI::errstr\n";
 
951
                }
 
952
 
 
953
                if (!$self->{dbhdest}) {
 
954
                        if ($outfile) {
 
955
                                open(FILE,">$outfile") or die "Can't open $outfile: $!";
 
956
                                print FILE $sql_header;
 
957
                        } else {
 
958
                                print $sql_header;
 
959
                        }
 
960
                } else {
 
961
                        if ($self->{type} eq 'COPY') {
 
962
                                open(DBH, "| $PSQL -h $self->{dbhost} -p $self->{dbport} -d $self->{dbname}") or die "Can't open $PSQL command, $!\n";
 
963
                        }
 
964
                }
 
965
 
 
966
                if ($self->{export_schema}) {
 
967
                        if ($self->{dbhdest}) {
 
968
                                if ($self->{type} ne 'COPY') {
 
969
                                        my $s = $self->{dbhdest}->prepare("SET search_path = $self->{schema}, pg_catalog") or die $self->{dbhdest}->errstr . "\n";
 
970
                                        $s->execute or die $s->errstr . "\n";
 
971
                                } else {
 
972
                                        print DBH "SET search_path = $self->{schema}, pg_catalog;\n";
 
973
                                }
 
974
                        } else {
 
975
                                if ($outfile) {
 
976
                                        print FILE "SET search_path = $self->{schema}, pg_catalog;\n";
 
977
                                } else {
 
978
                                        print "SET search_path = $self->{schema}, pg_catalog;\n";
 
979
                                }
 
980
                        }
 
981
                }
 
982
 
 
983
                foreach my $table (keys %{$self->{tables}}) {
 
984
print STDERR "Dumping table $table...\n" if ($self->{debug});
 
985
                        my @tt = ();
 
986
                        my @nn = ();
 
987
                        my $s_out = "INSERT INTO \"\L$table\E\" (";
 
988
                        if ($self->{type} eq 'COPY') {
 
989
                                $s_out = "\nCOPY \"\L$table\E\" ";
 
990
                        }
 
991
                        my @fname = ();
 
992
                        foreach my $i ( 0 .. $#{$self->{tables}{$table}{field_name}} ) {
 
993
                                my $fieldname = ${$self->{tables}{$table}{field_name}}[$i];
 
994
                                if (exists $self->{modify}{"\L$table\E"}) {
 
995
                                        next if (!grep(/$fieldname/i, @{$self->{modify}{"\L$table\E"}}));
 
996
                                }
 
997
                                push(@fname, lc($fieldname));
 
998
                                foreach my $f (@{$self->{tables}{$table}{column_info}}) {
 
999
                                        next if ($f->[0] ne "$fieldname");
 
1000
                                        my $type = $self->_sql_type($f->[1], $f->[2], $f->[5], $f->[6]);
 
1001
                                        $type = "$f->[1], $f->[2]" if (!$type);
 
1002
                                        push(@tt, $type);
 
1003
                                        push(@nn, $f->[0]);
 
1004
                                        if ($self->{type} ne 'COPY') {
 
1005
                                                $s_out .= "\"\L$f->[0]\E\",";
 
1006
                                        }
 
1007
                                        last;
 
1008
                                }
 
1009
                        }
 
1010
                        if ($self->{type} eq 'COPY') {
 
1011
                                $s_out .= '(' . join(',', @fname) . ") FROM stdin;\n";
 
1012
                        }
 
1013
 
 
1014
                        if ($self->{type} ne 'COPY') {
 
1015
                                $s_out =~ s/,$//;
 
1016
                                $s_out .= ") VALUES (";
 
1017
                        }
 
1018
                        # Extract all data from the current table
 
1019
                        $self->{data_current} = 0;
 
1020
                        $self->{data_end} = 0;
 
1021
                        while ( !$self->{data_end} ) {
 
1022
                                my $sth = $self->_get_data($table, \@nn, \@tt);
 
1023
                                $self->{data_end} = 1 if (!$self->{data_limit});
 
1024
                                my $count = 0;
 
1025
                                my $sql = '';
 
1026
                                if ($self->{type} eq 'COPY') {
 
1027
                                        if ($self->{dbhdest}) {
 
1028
                                                $sql = $s_out;
 
1029
                                        } else {
 
1030
                                                if ($outfile) {
 
1031
                                                        print FILE $s_out;
 
1032
                                                } else {
 
1033
                                                        print $s_out;
 
1034
                                                }
 
1035
                                        }
 
1036
                                }
 
1037
                                while (my $row = $sth->fetch) {
 
1038
                                        if ($self->{type} ne 'COPY') {
 
1039
                                                if ($self->{dbhdest}) {
 
1040
                                                        $sql .= $s_out;
 
1041
                                                } else {
 
1042
                                                        if ($outfile) {
 
1043
                                                                print FILE $s_out;
 
1044
                                                        } else {
 
1045
                                                                print $s_out;
 
1046
                                                        }
 
1047
                                                }
 
1048
                                        }
 
1049
                                        for (my $i = 0; $i <= $#{$row}; $i++) {
 
1050
                                                if ($self->{type} ne 'COPY') {
 
1051
                                                        if ($tt[$i] =~ /(char|date|time|text)/) {
 
1052
                                                                $row->[$i] =~ s/'/''/gs;
 
1053
                                                                if ($row->[$i] ne '') {
 
1054
                                                                        $row->[$i] = "'$row->[$i]'";
 
1055
                                                                } else {
 
1056
                                                                        $row->[$i] = 'NULL';
 
1057
                                                                }
 
1058
                                                                if ($self->{dbhdest}) {
 
1059
                                                                        $sql .= $row->[$i];
 
1060
                                                                } else {
 
1061
                                                                        if ($outfile) {
 
1062
                                                                                print FILE $row->[$i];
 
1063
                                                                        } else {
 
1064
                                                                                print $row->[$i];
 
1065
                                                                        }
 
1066
                                                                }
 
1067
                                                        } else {
 
1068
                                                                $row->[$i] =~ s/,/./;
 
1069
                                                                if ($row->[$i] eq '') {
 
1070
                                                                        $row->[$i] = 'NULL';
 
1071
                                                                }
 
1072
                                                                if ($self->{dbhdest}) {
 
1073
                                                                        $sql .= $row->[$i];
 
1074
                                                                } else {
 
1075
                                                                        if ($outfile) {
 
1076
                                                                                print FILE $row->[$i];
 
1077
                                                                        } else {
 
1078
                                                                                print $row->[$i];
 
1079
                                                                        }
 
1080
                                                                }
 
1081
                                                        }
 
1082
                                                        if ($i < $#{$row}) {
 
1083
                                                                if ($self->{dbhdest}) {
 
1084
                                                                        $sql .= ",";
 
1085
                                                                } else {
 
1086
                                                                        if ($outfile) {
 
1087
                                                                                print FILE ",";
 
1088
                                                                        } else {
 
1089
                                                                                print ",";
 
1090
                                                                        }
 
1091
                                                                }
 
1092
                                                        }
 
1093
                                                } else {
 
1094
                                                        # remove end of line
 
1095
                                                        $row->[$i] =~ s/\n/\\n/gs;
 
1096
 
 
1097
                                                        if ($tt[$i] !~ /(char|date|time|text)/) {
 
1098
                                                                $row->[$i] =~ s/,/./;
 
1099
                                                        }
 
1100
                                                        if ($row->[$i] eq '') {
 
1101
                                                                $row->[$i] = '\N';
 
1102
                                                        }
 
1103
                                                        if ($self->{dbhdest}) {
 
1104
                                                                $sql .= $row->[$i];
 
1105
                                                        } else {
 
1106
                                                                if ($outfile) {
 
1107
                                                                        print FILE $row->[$i];
 
1108
                                                                } else {
 
1109
                                                                        print $row->[$i];
 
1110
                                                                }
 
1111
                                                        }
 
1112
                                                        if ($i < $#{$row}) {
 
1113
                                                                if ($self->{dbhdest}) {
 
1114
                                                                        $sql .= "\t";
 
1115
                                                                } else {
 
1116
                                                                        if ($outfile) {
 
1117
                                                                                print FILE "\t";
 
1118
                                                                        } else {
 
1119
                                                                                print "\t";
 
1120
                                                                        }
 
1121
                                                                }
 
1122
                                                        } else {
 
1123
                                                                if ($self->{dbhdest}) {
 
1124
                                                                        $sql .= "\n";
 
1125
                                                                } else {
 
1126
                                                                        if ($outfile) {
 
1127
                                                                                print FILE "\n";
 
1128
                                                                        } else {
 
1129
                                                                                print "\n";
 
1130
                                                                        }
 
1131
                                                                }
 
1132
                                                        }
 
1133
                                                }
 
1134
                                        }
 
1135
                                        if ($self->{type} ne 'COPY') {
 
1136
                                                if ($self->{dbhdest}) {
 
1137
                                                        $sql .= ");\n";
 
1138
                                                } else {
 
1139
                                                        if ($outfile) {
 
1140
                                                                print FILE ");\n";
 
1141
                                                        } else {
 
1142
                                                                print ");\n";
 
1143
                                                        }
 
1144
                                                }
 
1145
                                        }
 
1146
                                        $count++;
 
1147
                                }
 
1148
                                if ($self->{type} eq 'COPY') {
 
1149
                                        if ($self->{dbhdest}) {
 
1150
                                                $sql .= "\\.\n";
 
1151
                                        } else {
 
1152
                                                if ($outfile) {
 
1153
                                                        print FILE "\\.\n";
 
1154
                                                } else {
 
1155
                                                        print "\\.\n";
 
1156
                                                }
 
1157
                                        }
 
1158
                                }
 
1159
                                if ($self->{data_limit}) {
 
1160
                                        $self->{data_end} = 1 if ($count+1 < $self->{data_limit});
 
1161
                                }
 
1162
                                # Insert data if we are in online processing mode
 
1163
                                if ($self->{dbhdest}) {
 
1164
                                        if ($self->{type} ne 'COPY') {
 
1165
                                                my $s = $self->{dbhdest}->prepare($sql) or die $self->{dbhdest}->errstr . "\n";
 
1166
                                                $s->execute or die $s->errstr . "\n";
 
1167
                                        } else {
 
1168
                                                print DBH "$sql";
 
1169
                                        }
 
1170
                                }
 
1171
                        }
 
1172
                }
 
1173
 
 
1174
                # Disconnect from the database
 
1175
                $self->{dbh}->disconnect() if ($self->{dbh});
 
1176
 
 
1177
                if (!$self->{dbhdest}) {
 
1178
                        if ($outfile) {
 
1179
                                print FILE "\nEND TRANSACTION;\n";
 
1180
                        } else {
 
1181
                                print "\nEND TRANSACTION;\n";
 
1182
                        }
 
1183
                }
 
1184
 
 
1185
                $self->{dbhdest}->disconnect() if ($self->{dbhdest});
 
1186
 
 
1187
                if ($self->{type} eq 'COPY') {
 
1188
                        close DBH;
 
1189
                }
 
1190
 
 
1191
                return;
 
1192
        }
 
1193
        
 
1194
 
 
1195
 
 
1196
        # Dump the database structure
 
1197
        if ($self->{export_schema}) {
 
1198
                $sql_output .= "CREATE SCHEMA \L$self->{schema}\E;\n\n";
 
1199
                $sql_output .= "SET search_path = $self->{schema}, pg_catalog;\n\n";
 
1200
        }
 
1201
        foreach my $table (keys %{$self->{tables}}) {
 
1202
print STDERR "Dumping table $table...\n" if ($self->{debug});
 
1203
                $sql_output .= "CREATE ${$self->{tables}{$table}{table_info}}[1] \"\L$table\E\" (\n";
 
1204
                my $sql_ukey = "";
 
1205
                my $sql_pkey = "";
 
1206
                foreach my $i ( 0 .. $#{$self->{tables}{$table}{field_name}} ) {
 
1207
                        foreach my $f (@{$self->{tables}{$table}{column_info}}) {
 
1208
                                next if ($f->[0] ne "${$self->{tables}{$table}{field_name}}[$i]");
 
1209
                                my $type = $self->_sql_type($f->[1], $f->[2], $f->[5], $f->[6]);
 
1210
                                $type = "$f->[1], $f->[2]" if (!$type);
 
1211
                                $sql_output .= "\t\"\L$f->[0]\E\" $type";
 
1212
                                # Set the primary key definition 
 
1213
                                foreach my $k (@{$self->{tables}{$table}{primary_key}}) {
 
1214
                                        next if ($k ne "$f->[0]");
 
1215
                                        $sql_pkey .= "\"\L$k\E\",";
 
1216
                                        last;
 
1217
                                }
 
1218
                                if ($f->[4] ne "") {
 
1219
                                        $sql_output .= " DEFAULT $f->[4]";
 
1220
                                } elsif (!$f->[3] || ($f->[3] eq 'N')) {
 
1221
                                        $sql_output .= " NOT NULL";
 
1222
                                }
 
1223
                                # Set the unique key definition 
 
1224
                                foreach my $k (@{$self->{tables}{$table}{unique_key}}) {
 
1225
                                        next if ( ($k ne "$f->[0]") || (grep(/^$k$/, @{$self->{tables}{$table}{primary_key}})) );
 
1226
                                        $sql_ukey .= "\"\L$k\E\",";
 
1227
                                        last;
 
1228
                                }
 
1229
                                $sql_output .= ",\n";
 
1230
                                last;
 
1231
                        }
 
1232
                }
 
1233
                $sql_ukey =~ s/,$//;
 
1234
                $sql_pkey =~ s/,$//;
 
1235
                $sql_output .= "\tUNIQUE ($sql_ukey),\n" if ($sql_ukey);
 
1236
                $sql_output .= "\tPRIMARY KEY ($sql_pkey),\n" if ($sql_pkey);
 
1237
                $sql_output =~ s/,$//;
 
1238
                $sql_output .= ");\n";
 
1239
                foreach my $idx (keys %{$self->{tables}{$table}{indexes}}) {
 
1240
                        map { s/^/"/ } @{$self->{tables}{$table}{indexes}{$idx}};
 
1241
                        map { s/$/"/ } @{$self->{tables}{$table}{indexes}{$idx}};
 
1242
                        my $columns = join(',', @{$self->{tables}{$table}{indexes}{$idx}});
 
1243
                        my $unique = '';
 
1244
                        $unique = ' UNIQUE' if ($self->{tables}{$table}{uniqueness}{$idx} eq 'UNIQUE');
 
1245
                        $sql_output .= "CREATE$unique INDEX \L$idx\E ON \"\L$table\E\" (\L$columns\E);\n";
 
1246
                }
 
1247
                $sql_output .= "\n";
 
1248
        }
 
1249
 
 
1250
        foreach my $table (keys %{$self->{tables}}) {
 
1251
print STDERR "Dumping RI $table...\n" if ($self->{debug});
 
1252
                my $sql_ukey = "";
 
1253
                my $sql_pkey = "";
 
1254
 
 
1255
                # Add constraint definition
 
1256
                my @done = ();
 
1257
                foreach my $h (@{$self->{tables}{$table}{foreign_key}}) {
 
1258
                        next if (grep(/^$h->[0]$/, @done));
 
1259
                        my $desttable = '';
 
1260
                        foreach (keys %{$self->{tables}{$table}{foreign_link}{$h->[0]}{remote}}) {
 
1261
                                $desttable .= "$_";
 
1262
                        }
 
1263
                        push(@done, $h->[0]);
 
1264
                        $sql_output .= "ALTER TABLE \"\L$table\E\" ADD CONSTRAINT \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}})) . ")";
 
1265
                        $sql_output .= " MATCH $h->[2]" if ($h->[2]);
 
1266
                        $sql_output .= " ON DELETE $h->[3]";
 
1267
                        $sql_output .= " $h->[4]";
 
1268
                        $sql_output .= " INITIALLY $h->[5];\n";
 
1269
                        
 
1270
                }
 
1271
        }
 
1272
 
 
1273
        if (!$sql_output) {
 
1274
                $sql_output = "-- Nothing found of type TABLE\n";
 
1275
        }
 
1276
 
 
1277
        return $sql_header . $sql_output . "\nEND TRANSACTION;\n";
 
1278
}
 
1279
 
 
1280
 
 
1281
=head2 _get_data TABLE
 
1282
 
 
1283
This function implements a Oracle-native data extraction.
 
1284
 
 
1285
Return a list of array reference containing the data
 
1286
 
 
1287
=cut
 
1288
 
 
1289
sub _get_data
 
1290
{
 
1291
        my ($self, $table, $name, $type) = @_;
 
1292
 
 
1293
        my $str = "SELECT ";
 
1294
        my $tmp = "SELECT ";
 
1295
        for my $k (0 .. $#{$name}) {
 
1296
                if ( $type->[$k] =~ /(date|time)/) {
 
1297
                        $str .= "to_char($name->[$k], 'YYYY-MM-DD HH24:MI:SS'),";
 
1298
                } else {
 
1299
                        $str .= "$name->[$k],";
 
1300
                }
 
1301
                $tmp .= "$name->[$k],";
 
1302
        }
 
1303
        $str =~ s/,$//;
 
1304
        $tmp =~ s/,$//;
 
1305
        my $tmp2 = $tmp;
 
1306
        $tmp2 =~ s/SELECT /SELECT ROWNUM as noline,/;
 
1307
 
 
1308
        # Fix a problem when the table need to be prefixed by the schema
 
1309
        if ($self->{schema}) {
 
1310
                $table = "$self->{schema}.$table";
 
1311
        }
 
1312
        if ($self->{data_limit}) {
 
1313
                $str = $tmp . " FROM ( $tmp2 FROM ( $tmp FROM $table) ";
 
1314
                $str .= " WHERE ROWNUM < ($self->{data_limit} + $self->{data_current})) ";
 
1315
                $str .= " WHERE noline >= $self->{data_current}";
 
1316
        } else {
 
1317
                $str .= " FROM $table";
 
1318
        }
 
1319
        $self->{data_current} += $self->{data_limit};
 
1320
 
 
1321
        # Fix a problem when exporting type LONG and LOB
 
1322
        $self->{dbh}->{'LongReadLen'} = 1023*1024;
 
1323
        $self->{dbh}->{'LongTruncOk'} = 1;
 
1324
 
 
1325
        my $sth = $self->{dbh}->prepare($str) or die $sth->errstr . "\n";
 
1326
        $sth->execute or die $sth->errstr . "\n";
 
1327
 
 
1328
        return $sth;    
 
1329
 
 
1330
}
 
1331
 
 
1332
 
 
1333
=head2 _sql_type INTERNAL_TYPE LENGTH PRECISION SCALE
 
1334
 
 
1335
This function return the PostgreSQL datatype corresponding to the
 
1336
Oracle internal type.
 
1337
 
 
1338
=cut
 
1339
 
 
1340
sub _sql_type
 
1341
{
 
1342
        my ($self, $type, $len, $precision, $scale) = @_;
 
1343
 
 
1344
        my %TYPE = (
 
1345
                # Oracle only has one flexible underlying numeric type, NUMBER.
 
1346
                # Without precision and scale it is set to PG type float8 to match all needs
 
1347
                'NUMBER' => 'numeric',
 
1348
                # CHAR types limit of 2000 bytes with default to 1 if no length is given.
 
1349
                # PG char type has max length set to 8104 so it should match all needs
 
1350
                'CHAR' => 'char',
 
1351
                'NCHAR' => 'char',
 
1352
                # VARCHAR types the limit is 2000 bytes in Oracle 7 and 4000 in Oracle 8.
 
1353
                # PG varchar type has max length iset to 8104 so it should match all needs
 
1354
                'VARCHAR' => 'varchar',
 
1355
                'NVARCHAR' => 'varchar',
 
1356
                'VARCHAR2' => 'varchar',
 
1357
                'NVARCHAR2' => 'varchar',
 
1358
                # The DATE data type is used to store the date and time information.
 
1359
                # Pg type timestamp should match all needs
 
1360
                'DATE' => 'timestamp',
 
1361
                # Type LONG is like VARCHAR2 but with up to 2Gb.
 
1362
                # PG type text should match all needs or if you want you could use blob
 
1363
                'LONG' => 'text', # Character data of variable length
 
1364
                'LONG RAW' => 'text', # Raw binary data of variable length
 
1365
                # Types LOB and FILE are like LONG but with up to 4Gb.
 
1366
                # PG type text should match all needs or if you want you could use blob (large object)
 
1367
                'CLOB' => 'text', # A large object containing single-byte characters
 
1368
                'NLOB' => 'text', # A large object containing national character set data
 
1369
                'BLOB' => 'text', # Binary large object
 
1370
                'BFILE' => 'text', # Locator for external large binary file
 
1371
                # The RAW type is presented as hexadecimal characters. The contents are treated as binary data. Limit of 2000 bytes
 
1372
                # Pg type text should match all needs or if you want you could use blob (large object)
 
1373
                'RAW' => 'text',
 
1374
                'ROWID' => 'oid',
 
1375
                'LONG RAW' => 'text',
 
1376
                'FLOAT' => 'float8'
 
1377
        );
 
1378
 
 
1379
        # Overide the length
 
1380
        $len = $precision if ( ($type eq 'NUMBER') && $precision );
 
1381
 
 
1382
        if (exists $TYPE{$type}) {
 
1383
                if ($len) {
 
1384
                        if ( ($type eq "CHAR") || ($type =~ /VARCHAR/) ) {
 
1385
                                # Type CHAR have default length set to 1
 
1386
                                # Type VARCHAR(2) must have a given length
 
1387
                                $len = 1 if (!$len && ($type eq "CHAR"));
 
1388
                                return "$TYPE{$type}($len)";
 
1389
                        } elsif ($type eq "NUMBER") {
 
1390
                                # This is an integer
 
1391
                                if (!$scale) {
 
1392
                                        if ($precision) {
 
1393
                                                return "numeric($precision)";
 
1394
                                        }
 
1395
                                } else {
 
1396
                                        if ($precision) {
 
1397
                                                return "decimal($precision,$scale)";
 
1398
                                        }
 
1399
                                }
 
1400
                                return "$TYPE{$type}";
 
1401
                        } else {
 
1402
                                return "$TYPE{$type}";
 
1403
                        }
 
1404
                } else {
 
1405
                        
 
1406
                        return $TYPE{$type};
 
1407
                }
 
1408
        }
 
1409
 
 
1410
        return;
 
1411
}
 
1412
 
 
1413
 
 
1414
=head2 _column_info TABLE OWNER
 
1415
 
 
1416
This function implements a Oracle-native column information.
 
1417
 
 
1418
Return a list of array reference containing the following informations
 
1419
for each column the given a table
 
1420
 
 
1421
[(
 
1422
  column name,
 
1423
  column type,
 
1424
  column length,
 
1425
  nullable column,
 
1426
  default value
 
1427
)]
 
1428
 
 
1429
=cut
 
1430
 
 
1431
sub _column_info
 
1432
{
 
1433
        my ($self, $table, $owner) = @_;
 
1434
 
 
1435
        $owner = "AND OWNER='$owner' " if ($owner);
 
1436
        my $sth = $self->{dbh}->prepare(<<END) or die $self->{dbh}->errstr;
 
1437
SELECT COLUMN_NAME, DATA_TYPE, DATA_LENGTH, NULLABLE, DATA_DEFAULT, DATA_PRECISION, DATA_SCALE
 
1438
FROM DBA_TAB_COLUMNS
 
1439
WHERE TABLE_NAME='$table' $owner
 
1440
ORDER BY COLUMN_ID
 
1441
END
 
1442
        $sth->execute or die $sth->errstr;
 
1443
        my $data = $sth->fetchall_arrayref();
 
1444
if ($self->{debug}) {
 
1445
        foreach my $d (@$data) {
 
1446
print STDERR "\t$d->[0] => type:$d->[1] , length:$d->[2], precision:$d->[5], scale:$d->[6], nullable:$d->[3] , default:$d->[4]\n";
 
1447
        }
 
1448
}
 
1449
 
 
1450
        return @$data;  
 
1451
 
 
1452
}
 
1453
 
 
1454
 
 
1455
=head2 _primary_key TABLE OWNER
 
1456
 
 
1457
This function implements a Oracle-native primary key column
 
1458
information.
 
1459
 
 
1460
Return a list of all column name defined as primary key
 
1461
for the given table.
 
1462
 
 
1463
=cut
 
1464
 
 
1465
sub _primary_key
 
1466
{
 
1467
        my ($self, $table, $owner) = @_;
 
1468
 
 
1469
        $owner = "AND all_constraints.OWNER='$owner' AND all_cons_columns.OWNER=all_constraints.OWNER" if ($owner);
 
1470
        my $sth = $self->{dbh}->prepare(<<END) or die $self->{dbh}->errstr;
 
1471
SELECT   all_cons_columns.COLUMN_NAME
 
1472
FROM     all_constraints, all_cons_columns
 
1473
WHERE    all_constraints.CONSTRAINT_TYPE='P'
 
1474
AND      all_constraints.constraint_name=all_cons_columns.constraint_name
 
1475
AND      all_constraints.STATUS='ENABLED'
 
1476
AND      all_constraints.TABLE_NAME='$table' $owner
 
1477
ORDER BY all_cons_columns.position
 
1478
END
 
1479
        $sth->execute or die $sth->errstr;
 
1480
        my @data = ();
 
1481
        while (my $row = $sth->fetch) {
 
1482
                push(@data, $row->[0]) if ($row->[0] !~ /\$/);
 
1483
        }
 
1484
        return @data;
 
1485
}
 
1486
 
 
1487
 
 
1488
=head2 _unique_key TABLE OWNER
 
1489
 
 
1490
This function implements a Oracle-native unique key column
 
1491
information.
 
1492
 
 
1493
Return a list of all column name defined as unique key
 
1494
for the given table.
 
1495
 
 
1496
=cut
 
1497
 
 
1498
sub _unique_key
 
1499
{
 
1500
        my($self, $table, $owner) = @_;
 
1501
 
 
1502
        $owner = "AND all_constraints.OWNER='$owner'" if ($owner);
 
1503
        my $sth = $self->{dbh}->prepare(<<END) or die $self->{dbh}->errstr;
 
1504
SELECT   all_cons_columns.COLUMN_NAME
 
1505
FROM     all_constraints, all_cons_columns
 
1506
WHERE    all_constraints.CONSTRAINT_TYPE='U'
 
1507
AND      all_constraints.constraint_name=all_cons_columns.constraint_name
 
1508
AND      all_constraints.STATUS='ENABLED'
 
1509
AND      all_constraints.TABLE_NAME='$table' $owner
 
1510
ORDER BY all_cons_columns.position
 
1511
END
 
1512
        $sth->execute or die $sth->errstr;
 
1513
 
 
1514
        my @data = ();
 
1515
        while (my $row = $sth->fetch) {
 
1516
                push(@data, $row->[0]) if ($row->[0] !~ /\$/);
 
1517
        }
 
1518
        return @data;
 
1519
}
 
1520
 
 
1521
 
 
1522
=head2 _foreign_key TABLE OWNER
 
1523
 
 
1524
This function implements a Oracle-native foreign key reference
 
1525
information.
 
1526
 
 
1527
Return a list of hash of hash of array reference. Ouuf! Nothing very difficult.
 
1528
The first hash is composed of all foreign key name. The second hash just have
 
1529
two key known as 'local' and remote' corresponding to the local table where the
 
1530
foreign key is defined and the remote table where the key refer.
 
1531
 
 
1532
The foreign key name is composed as follow:
 
1533
 
 
1534
    'local_table_name->remote_table_name'
 
1535
 
 
1536
Foreign key data consist in two array representing at the same indice the local
 
1537
field and the remote field where the first one refer to the second.
 
1538
Just like this:
 
1539
 
 
1540
    @{$link{$fkey_name}{local}} = @local_columns;
 
1541
    @{$link{$fkey_name}{remote}} = @remote_columns;
 
1542
 
 
1543
=cut
 
1544
 
 
1545
sub _foreign_key
 
1546
{
 
1547
        my ($self, $table, $owner) = @_;
 
1548
 
 
1549
        $owner = "AND OWNER='$owner'" if ($owner);
 
1550
        my $sth = $self->{dbh}->prepare(<<END) or die $self->{dbh}->errstr;
 
1551
SELECT CONSTRAINT_NAME,R_CONSTRAINT_NAME,SEARCH_CONDITION,DELETE_RULE,DEFERRABLE,DEFERRED,R_OWNER
 
1552
FROM DBA_CONSTRAINTS
 
1553
WHERE CONSTRAINT_TYPE='R'
 
1554
AND STATUS='ENABLED'
 
1555
AND TABLE_NAME='$table' $owner
 
1556
END
 
1557
        $sth->execute or die $sth->errstr;
 
1558
 
 
1559
        my @data = ();
 
1560
        my %link = ();
 
1561
        my @tab_done = ();
 
1562
        while (my $row = $sth->fetch) {
 
1563
                next if (grep(/^$row->[0]$/, @tab_done));
 
1564
                push(@data, [ @$row ]);
 
1565
                push(@tab_done, $row->[0]);
 
1566
                my $sql = "SELECT DISTINCT COLUMN_NAME FROM DBA_CONS_COLUMNS WHERE CONSTRAINT_NAME='$row->[0]' $owner";
 
1567
                my $sth2 = $self->{dbh}->prepare($sql) or die $self->{dbh}->errstr;
 
1568
                $sth2->execute or die $sth2->errstr;
 
1569
                my @done = ();
 
1570
                while (my $r = $sth2->fetch) {
 
1571
                        if (!grep(/^$r->[0]$/, @done)) {
 
1572
                                push(@{$link{$row->[0]}{local}}, $r->[0]);
 
1573
                                push(@done, $r->[0]);
 
1574
                        }
 
1575
                }
 
1576
                $owner = "AND OWNER = '$row->[6]'" if ($owner);
 
1577
                $sql = "SELECT DISTINCT TABLE_NAME,COLUMN_NAME FROM DBA_CONS_COLUMNS WHERE CONSTRAINT_NAME='$row->[1]' $owner";
 
1578
                $sth2 = $self->{dbh}->prepare($sql) or die $self->{dbh}->errstr;
 
1579
                $sth2->execute or die $sth2->errstr;
 
1580
                @done = ();
 
1581
                while (my $r = $sth2->fetch) {
 
1582
                        if (!grep(/^$r->[1]$/, @done)) {
 
1583
                                push(@{$link{$row->[0]}{remote}{$r->[0]}}, $r->[1]);
 
1584
                                push(@done, $r->[1]);
 
1585
                        }
 
1586
 
 
1587
                }
 
1588
        }
 
1589
 
 
1590
        return \%link, \@data;
 
1591
}
 
1592
 
 
1593
 
 
1594
=head2 _get_users
 
1595
 
 
1596
This function implements a Oracle-native users information.
 
1597
 
 
1598
Return a hash of all users as an array.
 
1599
 
 
1600
=cut
 
1601
 
 
1602
sub _get_users
 
1603
{
 
1604
        my($self) = @_;
 
1605
 
 
1606
        # Retrieve all USERS defined in this database
 
1607
        my $str = "SELECT USERNAME FROM DBA_USERS";
 
1608
        if (!$self->{schema}) {
 
1609
                $str .= " WHERE USERNAME <> 'SYS' AND USERNAME <> 'SYSTEM' AND USERNAME <> 'DBSNMP' AND USERNAME <> 'OUTLN'";
 
1610
        } else {
 
1611
                $str .= " WHERE USERNAME = '$self->{schema}'";
 
1612
        }
 
1613
        $str .= " ORDER BY USERNAME";
 
1614
        my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
 
1615
 
 
1616
        $sth->execute or die $sth->errstr;
 
1617
        my @users = ();
 
1618
        while (my $row = $sth->fetch) {
 
1619
                push(@users, $row->[0]);
 
1620
        }
 
1621
 
 
1622
        return \@users;
 
1623
}
 
1624
 
 
1625
 
 
1626
 
 
1627
=head2 _get_roles
 
1628
 
 
1629
This function implements a Oracle-native roles
 
1630
information.
 
1631
 
 
1632
Return a hash of all groups (roles) as an array of associated users.
 
1633
 
 
1634
=cut
 
1635
 
 
1636
sub _get_roles
 
1637
{
 
1638
        my($self) = @_;
 
1639
 
 
1640
        # Retrieve all ROLES defined in this database
 
1641
        my $str = "SELECT GRANTED_ROLE,GRANTEE FROM DBA_ROLE_PRIVS WHERE GRANTEE NOT IN (select distinct role from dba_roles)";
 
1642
        if (!$self->{schema}) {
 
1643
                $str .= " AND GRANTEE <> 'SYS' AND GRANTEE <> 'SYSTEM' AND GRANTEE <> 'DBSNMP' AND GRANTEE <> 'OUTLN'";
 
1644
        } else {
 
1645
                $str .= " AND GRANTEE = '$self->{schema}'";
 
1646
        }
 
1647
        my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
 
1648
 
 
1649
        $sth->execute or die $sth->errstr;
 
1650
        my %roles = ();
 
1651
        while (my $row = $sth->fetch) {
 
1652
                push(@{$roles{"$row->[0]"}}, $row->[1]);
 
1653
        }
 
1654
 
 
1655
        return \%roles;
 
1656
}
 
1657
 
 
1658
 
 
1659
=head2 _get_all_grants
 
1660
 
 
1661
This function implements a Oracle-native user privilege
 
1662
information.
 
1663
 
 
1664
Return a hash of all tables grants as an array of associated users.
 
1665
 
 
1666
=cut
 
1667
 
 
1668
sub _get_all_grants
 
1669
{
 
1670
        my($self) = @_;
 
1671
 
 
1672
        my @PG_GRANTS = ('DELETE', 'INSERT', 'SELECT', 'UPDATE');
 
1673
 
 
1674
        # Retrieve all ROLES defined in this database
 
1675
        my $str = "SELECT table_name,privilege,grantee FROM DBA_TAB_PRIVS";
 
1676
        if ($self->{schema}) {
 
1677
                $str .= " WHERE GRANTEE = '$self->{schema}'";
 
1678
        } else {
 
1679
                $str .= " WHERE GRANTEE <> 'SYS' AND GRANTEE <> 'SYSTEM' AND GRANTEE <> 'DBSNMP' AND GRANTEE <> 'OUTLN'";
 
1680
        }
 
1681
        $str .= " ORDER BY TABLE_NAME";
 
1682
 
 
1683
        my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
 
1684
 
 
1685
        $sth->execute or die $sth->errstr;
 
1686
        my %grants = ();
 
1687
        while (my $row = $sth->fetch) {
 
1688
                push(@{$grants{"$row->[0]"}{"$row->[1]"}}, $row->[2]) if (grep(/$row->[1]/, @PG_GRANTS));
 
1689
        }
 
1690
 
 
1691
        return \%grants;
 
1692
}
 
1693
 
 
1694
 
 
1695
 
 
1696
=head2 _get_indexes TABLE OWNER
 
1697
 
 
1698
This function implements a Oracle-native indexes information.
 
1699
 
 
1700
Return hash of array containing all unique index and a hash of
 
1701
array of all indexes name which are not primary keys for the
 
1702
given table.
 
1703
 
 
1704
=cut
 
1705
 
 
1706
sub _get_indexes
 
1707
{
 
1708
        my ($self, $table, $owner) = @_;
 
1709
 
 
1710
        my $sub_owner = '';
 
1711
        if ($owner) {
 
1712
                $owner = "AND dba_indexes.OWNER='$owner' AND dba_ind_columns.INDEX_OWNER=dba_indexes.OWNER";
 
1713
                $sub_owner = "AND OWNER=dba_indexes.TABLE_OWNER";
 
1714
        }
 
1715
        # Retrieve all indexes 
 
1716
        my $sth = $self->{dbh}->prepare(<<END) or die $self->{dbh}->errstr;
 
1717
SELECT DISTINCT dba_ind_columns.INDEX_NAME, dba_ind_columns.COLUMN_NAME, dba_indexes.UNIQUENESS
 
1718
FROM dba_ind_columns, dba_indexes
 
1719
WHERE dba_ind_columns.TABLE_NAME='$table' $owner
 
1720
AND dba_indexes.INDEX_NAME=dba_ind_columns.INDEX_NAME
 
1721
AND dba_ind_columns.INDEX_NAME NOT IN (SELECT CONSTRAINT_NAME FROM all_constraints WHERE TABLE_NAME='$table' $sub_owner)
 
1722
END
 
1723
        $sth->execute or die $sth->errstr;
 
1724
 
 
1725
        my %data = ();
 
1726
        my %unique = ();
 
1727
        while (my $row = $sth->fetch) {
 
1728
                $unique{$row->[0]} = $row->[2];
 
1729
                push(@{$data{$row->[0]}}, $row->[1]);
 
1730
        }
 
1731
 
 
1732
        return \%unique, \%data;
 
1733
}
 
1734
 
 
1735
 
 
1736
=head2 _get_sequences
 
1737
 
 
1738
This function implements a Oracle-native sequences
 
1739
information.
 
1740
 
 
1741
Return a hash of array of sequence name with MIN_VALUE, MAX_VALUE,
 
1742
INCREMENT and LAST_NUMBER for the given table.
 
1743
 
 
1744
=cut
 
1745
 
 
1746
sub _get_sequences
 
1747
{
 
1748
        my($self) = @_;
 
1749
 
 
1750
        # Retrieve all indexes 
 
1751
        my $str = "SELECT DISTINCT SEQUENCE_NAME, MIN_VALUE, MAX_VALUE, INCREMENT_BY, LAST_NUMBER, CACHE_SIZE, CYCLE_FLAG FROM DBA_SEQUENCES";
 
1752
        if (!$self->{schema}) {
 
1753
                $str .= " WHERE SEQUENCE_OWNER <> 'SYS' AND SEQUENCE_OWNER <> 'SYSTEM' AND SEQUENCE_OWNER <> 'DBSNMP' AND SEQUENCE_OWNER <> 'OUTLN'";
 
1754
        } else {
 
1755
                $str .= " WHERE SEQUENCE_OWNER = '$self->{schema}'";
 
1756
        }
 
1757
        my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
 
1758
        $sth->execute or die $sth->errstr;
 
1759
 
 
1760
        my @seqs = ();
 
1761
        while (my $row = $sth->fetch) {
 
1762
                push(@seqs, [ @$row ]);
 
1763
        }
 
1764
 
 
1765
        return \@seqs;
 
1766
}
 
1767
 
 
1768
 
 
1769
=head2 _get_views
 
1770
 
 
1771
This function implements a Oracle-native views information.
 
1772
 
 
1773
Return a hash of view name with the SQL query it is based on.
 
1774
 
 
1775
=cut
 
1776
 
 
1777
sub _get_views
 
1778
{
 
1779
        my($self) = @_;
 
1780
 
 
1781
        # Retrieve all views
 
1782
        my $str = "SELECT VIEW_NAME,TEXT FROM DBA_VIEWS";
 
1783
        if (!$self->{schema}) {
 
1784
                $str .= " WHERE OWNER <> 'SYS' AND OWNER <> 'SYSTEM' AND OWNER <> 'DBSNMP' AND OWNER <> 'OUTLN'";
 
1785
        } else {
 
1786
                $str .= " WHERE OWNER = '$self->{schema}'";
 
1787
        }
 
1788
        my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
 
1789
        $sth->execute or die $sth->errstr;
 
1790
 
 
1791
        my %data = ();
 
1792
        while (my $row = $sth->fetch) {
 
1793
                $data{$row->[0]} = $row->[1];
 
1794
                @{$data{$row->[0]}{alias}} = $self->_alias_info ($row->[0]);
 
1795
        }
 
1796
 
 
1797
        return %data;
 
1798
}
 
1799
 
 
1800
=head2 _alias_info
 
1801
 
 
1802
This function implements a Oracle-native column information.
 
1803
 
 
1804
Return a list of array reference containing the following informations
 
1805
for each alias of the given view
 
1806
 
 
1807
[(
 
1808
  column name,
 
1809
  column id
 
1810
)]
 
1811
 
 
1812
=cut
 
1813
 
 
1814
sub _alias_info
 
1815
{
 
1816
        my ($self, $view) = @_;
 
1817
 
 
1818
        my $sth = $self->{dbh}->prepare(<<END) or die $self->{dbh}->errstr;
 
1819
SELECT COLUMN_NAME, COLUMN_ID
 
1820
FROM DBA_TAB_COLUMNS
 
1821
WHERE TABLE_NAME='$view'
 
1822
END
 
1823
        $sth->execute or die $sth->errstr;
 
1824
        my $data = $sth->fetchall_arrayref();
 
1825
        if ($self->{debug}) {
 
1826
                foreach my $d (@$data) {
 
1827
                        print STDERR "\t$d->[0] =>  column id:$d->[1]\n";
 
1828
                }
 
1829
        }
 
1830
 
 
1831
        return @$data; 
 
1832
 
 
1833
}
 
1834
 
 
1835
=head2 _get_triggers
 
1836
 
 
1837
This function implements a Oracle-native triggers information.
 
1838
 
 
1839
Return an array of refarray of all triggers informations
 
1840
 
 
1841
=cut
 
1842
 
 
1843
sub _get_triggers
 
1844
{
 
1845
        my($self) = @_;
 
1846
 
 
1847
        # Retrieve all indexes 
 
1848
        my $str = "SELECT TRIGGER_NAME, TRIGGER_TYPE, TRIGGERING_EVENT, TABLE_NAME, TRIGGER_BODY FROM DBA_TRIGGERS WHERE STATUS='ENABLED'";
 
1849
        if (!$self->{schema}) {
 
1850
                $str .= " AND OWNER <> 'SYS' AND OWNER <> 'SYSTEM' AND OWNER <> 'DBSNMP' AND OWNER <> 'OUTLN'";
 
1851
        } else {
 
1852
                $str .= " AND OWNER = '$self->{schema}'";
 
1853
        }
 
1854
        my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
 
1855
        $sth->execute or die $sth->errstr;
 
1856
 
 
1857
        my @triggers = ();
 
1858
        while (my $row = $sth->fetch) {
 
1859
                push(@triggers, [ @$row ]);
 
1860
        }
 
1861
 
 
1862
        return \@triggers;
 
1863
}
 
1864
 
 
1865
 
 
1866
=head2 _get_functions
 
1867
 
 
1868
This function implements a Oracle-native functions information.
 
1869
 
 
1870
Return a hash of all function name with their PLSQL code
 
1871
 
 
1872
=cut
 
1873
 
 
1874
sub _get_functions
 
1875
{
 
1876
        my($self, $type) = @_;
 
1877
 
 
1878
        # Retrieve all indexes 
 
1879
        my $str = "SELECT DISTINCT OBJECT_NAME,OWNER FROM DBA_OBJECTS WHERE OBJECT_TYPE='$type' AND STATUS='VALID'";
 
1880
        if (!$self->{schema}) {
 
1881
                $str .= " AND OWNER <> 'SYS' AND OWNER <> 'SYSTEM' AND OWNER <> 'DBSNMP' AND OWNER <> 'OUTLN'";
 
1882
        } else {
 
1883
                $str .= " AND OWNER = '$self->{schema}'";
 
1884
        }
 
1885
        my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
 
1886
        $sth->execute or die $sth->errstr;
 
1887
 
 
1888
        my %functions = ();
 
1889
        my @fct_done = ();
 
1890
        while (my $row = $sth->fetch) {
 
1891
                next if (grep(/^$row->[0]$/, @fct_done));
 
1892
                push(@fct_done, $row->[0]);
 
1893
                my $sql = "SELECT TEXT FROM DBA_SOURCE WHERE OWNER='$row->[1]' AND NAME='$row->[0]' ORDER BY LINE";
 
1894
                my $sth2 = $self->{dbh}->prepare($sql) or die $self->{dbh}->errstr;
 
1895
                $sth2->execute or die $sth2->errstr;
 
1896
                while (my $r = $sth2->fetch) {
 
1897
                        $functions{"$row->[0]"} .= $r->[0];
 
1898
                }
 
1899
        }
 
1900
 
 
1901
        return \%functions;
 
1902
}
 
1903
 
 
1904
 
 
1905
=head2 _get_packages
 
1906
 
 
1907
This function implements a Oracle-native packages information.
 
1908
 
 
1909
Return a hash of all function name with their PLSQL code
 
1910
 
 
1911
=cut
 
1912
 
 
1913
sub _get_packages
 
1914
{
 
1915
        my ($self) = @_;
 
1916
 
 
1917
        # Retrieve all indexes 
 
1918
        my $str = "SELECT DISTINCT OBJECT_NAME,OWNER FROM DBA_OBJECTS WHERE OBJECT_TYPE='PACKAGE' AND STATUS='VALID'";
 
1919
        if (!$self->{schema}) {
 
1920
                $str .= " AND OWNER <> 'SYS' AND OWNER <> 'SYSTEM' AND OWNER <> 'DBSNMP' AND OWNER <> 'OUTLN'";
 
1921
        } else {
 
1922
                $str .= " AND OWNER = '$self->{schema}'";
 
1923
        }
 
1924
 
 
1925
        my $sth = $self->{dbh}->prepare($str) or die $self->{dbh}->errstr;
 
1926
        $sth->execute or die $sth->errstr;
 
1927
 
 
1928
        my %packages = ();
 
1929
        my @fct_done = ();
 
1930
        while (my $row = $sth->fetch) {
 
1931
print STDERR "\tFound Package: $row->[0]\n" if ($self->{debug});
 
1932
                next if (grep(/^$row->[0]$/, @fct_done));
 
1933
                push(@fct_done, $row->[0]);
 
1934
                my $sql = "SELECT TEXT FROM DBA_SOURCE WHERE OWNER='$row->[1]' AND NAME='$row->[0]' AND (TYPE='PACKAGE' OR TYPE='PACKAGE BODY') ORDER BY TYPE, LINE";
 
1935
                my $sth2 = $self->{dbh}->prepare($sql) or die $self->{dbh}->errstr;
 
1936
                $sth2->execute or die $sth2->errstr;
 
1937
                while (my $r = $sth2->fetch) {
 
1938
                        $packages{"$row->[0]"} .= $r->[0];
 
1939
                }
 
1940
        }
 
1941
 
 
1942
        return \%packages;
 
1943
}
 
1944
 
 
1945
 
 
1946
 
 
1947
=head2 _table_info
 
1948
 
 
1949
This function retrieve all Oracle-native tables information.
 
1950
 
 
1951
Return a handle to a DB query statement
 
1952
 
 
1953
=cut
 
1954
 
 
1955
 
 
1956
sub _table_info
 
1957
{
 
1958
        my $self = shift;
 
1959
 
 
1960
        my $sql = "SELECT
 
1961
                NULL            TABLE_CAT,
 
1962
                at.OWNER        TABLE_SCHEM,
 
1963
                at.TABLE_NAME,
 
1964
                tc.TABLE_TYPE,
 
1965
                tc.COMMENTS     REMARKS
 
1966
            from ALL_TABLES at, ALL_TAB_COMMENTS tc
 
1967
            where at.OWNER = tc.OWNER
 
1968
            and at.TABLE_NAME = tc.TABLE_NAME
 
1969
        ";
 
1970
 
 
1971
        if ($self->{schema}) {
 
1972
                $sql .= " and at.OWNER='$self->{schema}'";
 
1973
        } else {
 
1974
            $sql .= "AND at.OWNER <> 'SYS' AND at.OWNER <> 'SYSTEM' AND at.OWNER <> 'DBSNMP' AND at.OWNER <> 'OUTLN'";
 
1975
        }
 
1976
        $sql .= " order by tc.TABLE_TYPE, at.OWNER, at.TABLE_NAME";
 
1977
        my $sth = $self->{dbh}->prepare( $sql ) or return undef;
 
1978
        $sth->execute or return undef;
 
1979
        $sth;
 
1980
}
 
1981
 
 
1982
1;
 
1983
 
 
1984
__END__
 
1985
 
 
1986
 
 
1987
=head1 AUTHOR
 
1988
 
 
1989
Gilles Darold <gilles@darold.net>
 
1990
 
 
1991
 
 
1992
=head1 COPYRIGHT
 
1993
 
 
1994
Copyright (c) 2001 Gilles Darold - All rights reserved.
 
1995
 
 
1996
This program is free software; you can redistribute it and/or modify it under
 
1997
the same terms as Perl itself.
 
1998
 
 
1999
 
 
2000
=head1 BUGS
 
2001
 
 
2002
This perl module is in the same state as my knowledge regarding database,
 
2003
it can move and not be compatible with older version so I will do my best
 
2004
to give you official support for Ora2Pg. Your volontee to help construct
 
2005
it and your contribution are welcome.
 
2006
 
 
2007
 
 
2008
=head1 SEE ALSO
 
2009
 
 
2010
L<DBI>, L<DBD::Oracle>, L<DBD::Pg>
 
2011
 
 
2012
 
 
2013
=head1 ACKNOWLEDGEMENTS
 
2014
 
 
2015
Thanks to Jason Servetar who decided me to implement data extraction.
 
2016
 
 
2017
=cut
 
2018
 
 
2019