1package Ora2Pg; 2#------------------------------------------------------------------------------ 3# Project : Oracle to PostgreSQL database schema converter 4# Name : Ora2Pg.pm 5# Language : Perl 6# Authors : Gilles Darold, gilles _AT_ darold _DOT_ net 7# Copyright: Copyright (c) 2000-2021 : Gilles Darold - All rights reserved - 8# Function : Main module used to export Oracle database schema to PostgreSQL 9# Usage : See documentation in this file with perldoc. 10#------------------------------------------------------------------------------ 11# 12# This program is free software: you can redistribute it and/or modify 13# it under the terms of the GNU General Public License as published by 14# the Free Software Foundation, either version 3 of the License, or 15# any later version. 16# 17# This program is distributed in the hope that it will be useful, 18# but WITHOUT ANY WARRANTY; without even the implied warranty of 19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20# GNU General Public License for more details. 21# 22# You should have received a copy of the GNU General Public License 23# along with this program. If not, see < http://www.gnu.org/licenses/ >. 24# 25#------------------------------------------------------------------------------ 26 27use vars qw($VERSION $PSQL %AConfig); 28use Carp qw(confess); 29use DBI; 30use POSIX qw(locale_h _exit :sys_wait_h strftime); 31use IO::File; 32use Config; 33use Time::HiRes qw/usleep/; 34use Fcntl qw/ :flock /; 35use IO::Handle; 36use IO::Pipe; 37use File::Basename; 38use File::Spec qw/ tmpdir /; 39use File::Temp qw/ tempfile /; 40use Benchmark; 41use Encode; 42 43#set locale to LC_NUMERIC C 44setlocale(LC_NUMERIC,"C"); 45 46$VERSION = '22.1'; 47$PSQL = $ENV{PLSQL} || 'psql'; 48 49$| = 1; 50 51our %RUNNING_PIDS = (); 52# Multiprocess communication pipe 53our $pipe = undef; 54our $TMP_DIR = File::Spec->tmpdir() || '/tmp'; 55our %ordered_views = (); 56 57# Character that must be escaped in COPY statement 58my $ESCAPE_COPY = { "\0" => "", "\\" => "\\\\", "\r" => "\\r", "\n" => "\\n", "\t" => "\\t"}; 59 60# Oracle internal timestamp month equivalent 61our %ORACLE_MONTHS = ('JAN'=>'01', 'FEB'=>'02','MAR'=>'03','APR'=>'04','MAY'=>'05','JUN'=>'06','JUL'=>'07','AUG'=>'08','SEP'=>'09','OCT'=>10,'NOV'=>11,'DEC'=>12); 62 63# Exclude table generated by partition logging, materialized view logs, statistis on spatial index, 64# spatial index tables, sequence index tables, interMedia Text index tables and Unified Audit tables. 65# LogMiner, Oracle Advanced Replication, hash table used by loadjava. 66our @EXCLUDED_TABLES = ('USLOG\$_.*', 'MLOG\$_.*', 'RUPD\$_.*', 'MDXT_.*', 'MDRT_.*', 'MDRS_.*', 'DR\$.*', 'CLI_SWP\$.*', 'LOGMNR\$.*', 'REPCAT\$.*', 'JAVA\$.*', 'AQ\$.*', 'BIN\$.*', 'SDO_GR_.*', '.*\$JAVA\$.*', 'PROF\$.*', 'TOAD_PLAN_.*', 'SYS_.*\$', 'QUEST_SL_.*'); 67our @EXCLUDED_TABLES_8I = ('USLOG$_%', 'MLOG$_%', 'RUPD$_%', 'MDXT_%', 'MDRT_%', 'MDRS_%', 'DR$%', 'CLI_SWP$%', 'LOGMNR$%', 'REPCAT$%', 'JAVA$%', 'AQ$%', 'BIN$%', '%$JAVA$%', 'PROF$%', 'TOAD_PLAN_%', 'SYS_%$', 'QUEST_SL_%'); 68 69our @Oracle_tables = qw( 70EVT_CARRIER_CONFIGURATION 71EVT_DEST_PROFILE 72EVT_HISTORY 73EVT_INSTANCE 74EVT_MAIL_CONFIGURATION 75EVT_MONITOR_NODE 76EVT_NOTIFY_STATUS 77EVT_OPERATORS 78EVT_OPERATORS_ADDITIONAL 79EVT_OPERATORS_SYSTEMS 80EVT_OUTSTANDING 81EVT_PROFILE 82EVT_PROFILE_EVENTS 83EVT_REGISTRY 84EVT_REGISTRY_BACKLOG 85OLS_DIR_BUSINESSE 86OLS_DIR_BUSINESSES 87SDO_COORD_REF_SYS 88SDO_CS_SRS 89SDO_INDEX_METADATA_TABLE 90SDO_INDEX_METADATA_TABLES 91SDO_PC_BLK_TABLE 92SDO_STYLES_TABLE 93SDO_TIN_BLK_TABLE 94SMACTUALPARAMETER_S 95SMGLOBALCONFIGURATION_S 96SMFORMALPARAMETER_S 97SMFOLDER_S 98SMDISTRIBUTIONSET_S 99SMDEPENDENTLINKS 100SMDEPENDENTINDEX 101SMDEPENDEEINDEX 102SMDEFAUTH_S 103SMDBAUTH_S 104SMPARALLELJOB_S 105SMPACKAGE_S 106SMOWNERLINKS 107SMOWNERINDEX 108SMOWNEEINDEX 109SMOSNAMES_X 110SMOMSTRING_S 111SMMOWNERLINKS 112SMMOWNERINDEX 113SMPACKAGE_S 114SMPARALLELJOB_S 115SMPARALLELOPERATION_S 116SMPARALLELSTATEMENT_S 117SMPRODUCT_S 118SMP_AD_ADDRESSES_ 119SMP_AD_DISCOVERED_NODES_ 120SMP_AD_NODES_ 121SMP_AD_PARMS_ 122SMP_AUTO_DISCOVERY_ITEM_ 123SMP_AUTO_DISCOVERY_PARMS_ 124SMP_BLOB_ 125SMP_CREDENTIALS\$ 126SMP_JOB_ 127SMP_JOB_EVENTLIST_ 128SMP_JOB_HISTORY_ 129SMP_JOB_INSTANCE_ 130SMP_JOB_LIBRARY_ 131SMP_JOB_TASK_INSTANCE_ 132SMP_LONG_TEXT_ 133SMP_REP_VERSION 134SMP_SERVICES 135SMP_SERVICE_GROUP_DEFN_ 136SMP_SERVICE_GROUP_ITEM_ 137SMP_SERVICE_ITEM_ 138SMP_UPDATESERVICES_CALLED_ 139SMAGENTJOB_S 140SMARCHIVE_S 141SMBREAKABLELINKS 142SMCLIQUE 143SMCONFIGURATION 144SMCONSOLESOSETTING_S 145SMDATABASE_S 146SMHOSTAUTH_S 147SMHOST_S 148SMINSTALLATION_S 149SMLOGMESSAGE_S 150SMMONTHLYENTRY_S 151SMMONTHWEEKENTRY_S 152SMP_USER_DETAILS 153SMRELEASE_S 154SMRUN_S 155SMSCHEDULE_S 156SMSHAREDORACLECLIENT_S 157SMSHAREDORACLECONFIGURATION_S 158SMTABLESPACE_S 159SMVCENDPOINT_S 160SMWEEKLYENTRY_S 161); 162push(@EXCLUDED_TABLES, @Oracle_tables); 163 164# Some function might be excluded from export and assessment. 165our @EXCLUDED_FUNCTION = ('SQUIRREL_GET_ERROR_OFFSET'); 166 167our @FKEY_OPTIONS = ('NEVER', 'DELETE', 'ALWAYS'); 168 169# Minimized the footprint on disc, so that more rows fit on a data page, 170# which is the most important factor for speed. 171our %TYPALIGN = ( 172 # Types and size, 1000 = variable 173 'boolean' => 1, 174 'smallint' => 2, 175 'smallserial' => 2, 176 'integer' => 4, 177 'real' => 4, 178 'serial' => 4, 179 'date' => 4, 180 'oid' => 4, 181 'macaddr' => 6, 182 'bigint' => 8, 183 'bigserial' => 8, 184 'double precision' => 8, 185 'macaddr8' => 8, 186 'money' => 8, 187 'time' => 8, 188 'timestamp' => 8, 189 'timestamp without time zone' => 8, 190 'timestamp with time zone' => 8, 191 'interval' => 16, 192 'point' => 16, 193 'tinterval' => 16, 194 'uuid' => 16, 195 'circle' => 24, 196 'box' => 32, 197 'line' => 32, 198 'lseg' => 32, 199 'bit' => 1000, 200 'bytea' => 1000, 201 'character varying' => 1000, 202 'cidr' => 19, 203 'json' => 1000, 204 'jsonb' => 1000, 205 'numeric' => 1000, 206 'path' => 1000, 207 'polygon' => 1000, 208 'text' => 1000, 209 'xml' => 1000, 210 # aliases 211 'bool' => 1, 212 'timetz' => 12, 213 'char' => 1000, 214 'decimal' => 1000, 215 # deprecated 216 'int2' => 2, 217 'abstime' => 4, 218 'bpchar' => 4, 219 'int4' => 4, 220 'reltime' => 4, 221 'float4' => 4, 222 'timestamptz' => 8, 223 'float8' => 8, 224 'int8' => 8, 225 'name' => 64, 226 'inet' => 19, 227 'varbit' => 1000, 228 'varchar' => 1000 229); 230 231# These definitions can be overriden from configuration file 232our %TYPE = ( 233 # Oracle only has one flexible underlying numeric type, NUMBER. 234 # Without precision and scale it is set to the PG type float8 235 # to match all needs 236 'NUMBER' => 'numeric', 237 # CHAR types limit of 2000 bytes with defaults to 1 if no length 238 # is specified. PG char type has max length set to 8104 so it 239 # should match all needs 240 'CHAR' => 'char', 241 'NCHAR' => 'char', 242 # VARCHAR types the limit is 2000 bytes in Oracle 7 and 4000 in 243 # Oracle 8. PG varchar type has max length iset to 8104 so it 244 # should match all needs 245 'VARCHAR' => 'varchar', 246 'NVARCHAR' => 'varchar', 247 'VARCHAR2' => 'varchar', 248 'NVARCHAR2' => 'varchar', 249 'STRING' => 'varchar', 250 # The DATE data type is used to store the date and time 251 # information. PG type timestamp should match all needs. 252 'DATE' => 'timestamp', 253 # Type LONG is like VARCHAR2 but with up to 2Gb. PG type text 254 # should match all needs or if you want you could use blob 255 'LONG' => 'text', # Character data of variable length 256 'LONG RAW' => 'bytea', 257 # Types LOB and FILE are like LONG but with up to 4Gb. PG type 258 # text should match all needs or if you want you could use blob 259 # (large object) 260 'CLOB' => 'text', # A large object containing single-byte characters 261 'NCLOB' => 'text', # A large object containing national character set data 262 'BLOB' => 'bytea', # Binary large object 263 # The full path to the external file is returned if destination type is text. 264 # If the destination type is bytea the content of the external file is returned. 265 'BFILE' => 'bytea', # Locator for external large binary file 266 # The RAW type is presented as hexadecimal characters. The 267 # contents are treated as binary data. Limit of 2000 bytes 268 # PG type text should match all needs or if you want you could 269 # use blob (large object) 270 'RAW' => 'bytea', 271 'ROWID' => 'oid', 272 'UROWID' => 'oid', 273 'FLOAT' => 'double precision', 274 'DEC' => 'decimal', 275 'DECIMAL' => 'decimal', 276 'DOUBLE PRECISION' => 'double precision', 277 'INT' => 'numeric', 278 'INTEGER' => 'numeric', 279 'BINARY_INTEGER' => 'integer', 280 'PLS_INTEGER' => 'integer', 281 'REAL' => 'real', 282 'SMALLINT' => 'smallint', 283 'BINARY_FLOAT' => 'double precision', 284 'BINARY_DOUBLE' => 'double precision', 285 'TIMESTAMP' => 'timestamp', 286 'BOOLEAN' => 'boolean', 287 'INTERVAL' => 'interval', 288 'XMLTYPE' => 'xml', 289 'TIMESTAMP WITH TIME ZONE' => 'timestamp with time zone', 290 'TIMESTAMP WITH LOCAL TIME ZONE' => 'timestamp with time zone', 291 'SDO_GEOMETRY' => 'geometry', 292); 293 294our %ORA2PG_SDO_GTYPE = ( 295 '0' => 'GEOMETRY', 296 '1' => 'POINT', 297 '2' => 'LINESTRING', 298 '3' => 'POLYGON', 299 '4' => 'GEOMETRYCOLLECTION', 300 '5' => 'MULTIPOINT', 301 '6' => 'MULTILINESTRING', 302 '7' => 'MULTIPOLYGON', 303 '8' => 'SOLID', 304 '9' => 'MULTISOLID' 305); 306 307our %GTYPE = ( 308 'UNKNOWN_GEOMETRY' => 'GEOMETRY', 309 'GEOMETRY' => 'GEOMETRY', 310 'POINT' => 'POINT', 311 'LINE' => 'LINESTRING', 312 'CURVE' => 'LINESTRING', 313 'POLYGON' => 'POLYGON', 314 'SURFACE' => 'POLYGON', 315 'COLLECTION' => 'GEOMETRYCOLLECTION', 316 'MULTIPOINT' => 'MULTIPOINT', 317 'MULTILINE' => 'MULTILINESTRING', 318 'MULTICURVE' => 'MULTILINESTRING', 319 'MULTIPOLYGON' => 'MULTIPOLYGON', 320 'MULTISURFACE' => 'MULTIPOLYGON', 321 'SOLID' => 'SOLID', 322 'MULTISOLID' => 'MULTISOLID' 323); 324our %INDEX_TYPE = ( 325 'NORMAL' => 'b-tree', 326 'NORMAL/REV' => 'reversed b-tree', 327 'FUNCTION-BASED NORMAL' => 'function based b-tree', 328 'FUNCTION-BASED NORMAL/REV' => 'function based reversed b-tree', 329 'BITMAP' => 'bitmap', 330 'BITMAP JOIN' => 'bitmap join', 331 'FUNCTION-BASED BITMAP' => 'function based bitmap', 332 'FUNCTION-BASED BITMAP JOIN' => 'function based bitmap join', 333 'CLUSTER' => 'cluster', 334 'DOMAIN' => 'domain', 335 'IOT - TOP' => 'IOT', 336 'SPATIAL INDEX' => 'spatial index', 337); 338 339# Reserved keywords in PostgreSQL 340our @KEYWORDS = qw( 341 ALL ANALYSE ANALYZE AND ANY ARRAY AS ASC ASYMMETRIC AUTHORIZATION BINARY 342 BOTH CASE CAST CHECK COLLATE COLLATION COLUMN CONCURRENTLY CONSTRAINT CREATE 343 CROSS CURRENT_CATALOG CURRENT_DATE CURRENT_ROLE CURRENT_SCHEMA CURRENT_TIME 344 CURRENT_TIMESTAMP CURRENT_USER DEFAULT DEFERRABLE DESC DISTINCT DO ELSE END 345 EXCEPT FALSE FETCH FOR FOREIGN FREEZE FROM FULL GRANT GROUP HAVING ILIKE IN 346 INITIALLY INNER INTERSECT INTO IS ISNULL JOIN LATERAL LEADING LEFT LIKE LIMIT 347 LOCALTIME LOCALTIMESTAMP NATURAL NOT NOTNULL NULL OFFSET ON ONLY OR ORDER OUTER 348 OVERLAPS PLACING PRIMARY REFERENCES RETURNING RIGHT SELECT SESSION_USER SIMILAR 349 SOME SYMMETRIC TABLE TABLESAMPLE THEN TO TRAILING TRUE UNION UNIQUE USER USING 350 VARIADIC VERBOSE WHEN WHERE WINDOW WITH 351); 352 353# Reserved keywords that can be used in PostgreSQL as function or type name 354our @FCT_TYPE_KEYWORDS = qw( 355 AUTHORIZATION BINARY COLLATION CONCURRENTLY CROSS CURRENT_SCHEMA FREEZE 356 FULL ILIKE INNER IS ISNULL JOIN LEFT LIKE NATURAL NOTNULL OUTER OVERLAPS 357 RIGHT SIMILAR TABLESAMPLE VERBOSE 358); 359 360 361our @SYSTEM_FIELDS = qw(oid tableoid xmin xmin cmin xmax cmax ctid); 362our %BOOLEAN_MAP = ( 363 'yes' => 't', 364 'no' => 'f', 365 'y' => 't', 366 'n' => 'f', 367 '1' => 't', 368 '0' => 'f', 369 'true' => 't', 370 'false' => 'f', 371 'enabled'=> 't', 372 'disabled'=> 'f', 373 't' => 't', 374 'f' => 'f', 375); 376 377our @GRANTS = ( 378 'SELECT', 'INSERT', 'UPDATE', 'DELETE', 'TRUNCATE', 379 'REFERENCES', 'TRIGGER', 'USAGE', 'CREATE', 'CONNECT', 380 'TEMPORARY', 'TEMP', 'USAGE', 'ALL', 'ALL PRIVILEGES', 381 'EXECUTE' 382); 383 384$SIG{'CHLD'} = 'DEFAULT'; 385 386#### 387# method used to fork as many child as wanted 388## 389sub spawn 390{ 391 my $coderef = shift; 392 393 unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { 394 print "usage: spawn CODEREF"; 395 exit 0; 396 } 397 398 my $pid; 399 if (!defined($pid = fork)) { 400 print STDERR "Error: cannot fork: $!\n"; 401 return; 402 } elsif ($pid) { 403 $RUNNING_PIDS{$pid} = $pid; 404 return; # the parent 405 } 406 # the child -- go spawn 407 $< = $>; 408 $( = $); # suid progs only 409 exit &$coderef(); 410} 411 412# With multiprocess we need to wait all childs 413sub wait_child 414{ 415 my $sig = shift; 416 print STDERR "Received terminating signal ($sig).\n"; 417 if ($^O !~ /MSWin32|dos/i) { 418 1 while wait != -1; 419 $SIG{INT} = \&wait_child; 420 $SIG{TERM} = \&wait_child; 421 } 422 print STDERR "Aborting.\n"; 423 _exit(0); 424} 425$SIG{INT} = \&wait_child; 426$SIG{TERM} = \&wait_child; 427 428=head1 PUBLIC METHODS 429 430=head2 new HASH_OPTIONS 431 432Creates a new Ora2Pg object. 433 434The only required option is: 435 436 - config : Path to the configuration file (required). 437 438All directives found in the configuration file can be overwritten in the 439instance call by passing them in lowercase as arguments. 440 441=cut 442 443sub new 444{ 445 my ($class, %options) = @_; 446 447 # This create an OO perl object 448 my $self = {}; 449 bless ($self, $class); 450 451 # Initialize this object 452 $self->_init(%options); 453 454 # Return the instance 455 return($self); 456} 457 458 459 460=head2 export_schema FILENAME 461 462Print SQL data output to a file name or 463to STDOUT if no file name is specified. 464 465=cut 466 467sub export_schema 468{ 469 my $self = shift; 470 471 # Create default export file where things will be written with the dump() method 472 # First remove it if the output file already exists 473 foreach my $t (@{$self->{export_type}}) 474 { 475 next if ($t =~ /^(?:SHOW_|TEST)/i); # SHOW_* commands are not concerned here 476 477 # Set current export type 478 $self->{type} = $t; 479 480 if ($self->{type} ne 'LOAD') 481 { 482 # Close open main output file 483 if (defined $self->{fhout}) { 484 $self->close_export_file($self->{fhout}); 485 } 486 # Remove old export file if it already exists 487 $self->remove_export_file(); 488 # then create a new one 489 $self->create_export_file(); 490 } 491 492 # Dump exported statement to output 493 $self->_get_sql_statements(); 494 495 if ($self->{type} ne 'LOAD') 496 { 497 # Close output export file create above 498 $self->close_export_file($self->{fhout}) if (defined $self->{fhout}); 499 } 500 } 501 502 # Disconnect from the database 503 $self->{dbh}->disconnect() if ($self->{dbh}); 504 $self->{dbhdest}->disconnect() if ($self->{dbhdest}); 505 506 # Try to requalify package function call 507 if (!$self->{package_as_schema}) { 508 $self->fix_function_call(); 509 } 510 511 my $dirprefix = ''; 512 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 513 unlink($dirprefix . 'temp_pass2_file.dat'); 514} 515 516 517=head2 open_export_file FILENAME 518 519Open a file handle to a given filename. 520 521=cut 522 523sub open_export_file 524{ 525 my ($self, $outfile, $noprefix) = @_; 526 527 my $filehdl = undef; 528 529 if ($outfile && $outfile ne '-') { 530 if ($outfile ne '-') { 531 if ($self->{output_dir} && !$noprefix) { 532 $outfile = $self->{output_dir} . '/' . $outfile; 533 } 534 if ($self->{input_file} && ($outfile eq $self->{input_file})) { 535 $self->logit("FATAL: input file is the same as output file: $outfile, can not overwrite it.\n",0,1); 536 } 537 } 538 # If user request data compression 539 if ($outfile =~ /\.gz$/i) { 540 eval("use Compress::Zlib;"); 541 $self->{compress} = 'Zlib'; 542 $filehdl = gzopen("$outfile", "wb") or $self->logit("FATAL: Can't create deflation file $outfile\n",0,1); 543 } elsif ($outfile =~ /\.bz2$/i) { 544 $self->logit("Error: can't run bzip2\n",0,1) if (!-x $self->{bzip2}); 545 $self->{compress} = 'Bzip2'; 546 $filehdl = new IO::File; 547 $filehdl->open("|$self->{bzip2} --stdout >$outfile") or $self->logit("FATAL: Can't open pipe to $self->{bzip2} --stdout >$outfile: $!\n", 0,1); 548 } else { 549 $filehdl = new IO::File; 550 $filehdl->open(">$outfile") or $self->logit("FATAL: Can't open $outfile: $!\n", 0, 1); 551 } 552 $filehdl->autoflush(1) if (defined $filehdl && !$self->{compress}); 553 } 554 555 return $filehdl; 556} 557 558=head2 create_export_file FILENAME 559 560Set output file and open a file handle on it, 561will use STDOUT if no file name is specified. 562 563=cut 564 565sub create_export_file 566{ 567 my ($self, $outfile) = @_; 568 569 # Do not create the default export file with direct data export 570 if (($self->{type} eq 'INSERT') || ($self->{type} eq 'COPY')) { 571 return if ($self->{pg_dsn}); 572 } 573 574 # Init with configuration OUTPUT filename 575 $outfile ||= $self->{output}; 576 if ($outfile) 577 { 578 if ($outfile ne '-') 579 { 580 # Prefix out file with export type in multiple export type call 581 $outfile = $self->{type} . "_$outfile" if ($#{$self->{export_type}} > 0); 582 if ($self->{output_dir} && $outfile) { 583 $outfile = $self->{output_dir} . "/" . $outfile; 584 } 585 if ($self->{input_file} && ($outfile eq $self->{input_file})) { 586 $self->logit("FATAL: input file is the same as output file: $outfile, can not overwrite it.\n",0,1); 587 } 588 } 589 590 # Send output to the specified file 591 if ($outfile =~ /\.gz$/) 592 { 593 eval("use Compress::Zlib;"); 594 $self->{compress} = 'Zlib'; 595 $self->{fhout} = gzopen($outfile, "wb") or $self->logit("FATAL: Can't create deflation file $outfile\n", 0, 1); 596 } 597 elsif ($outfile =~ /\.bz2$/) 598 { 599 $self->logit("FATAL: can't run bzip2\n",0,1) if (!-x $self->{bzip2}); 600 $self->{compress} = 'Bzip2'; 601 $self->{fhout} = new IO::File; 602 $self->{fhout}->open("|$self->{bzip2} --stdout >$outfile") or $self->logit("FATAL: Can't open pipe to $self->{bzip2} --stdout >$outfile: $!\n", 0, 1); 603 } 604 else 605 { 606 $self->{fhout} = new IO::File; 607 $self->{fhout}->open(">>$outfile") or $self->logit("FATAL: Can't open $outfile: $!\n", 0, 1); 608 $self->set_binmode($self->{fhout}); 609 } 610 if ( $self->{compress} && (($self->{jobs} > 1) || ($self->{oracle_copies} > 1)) ) 611 { 612 die "FATAL: you can't use compressed output with parallel dump\n"; 613 } 614 } 615} 616 617sub remove_export_file 618{ 619 my ($self, $outfile) = @_; 620 621 # Init with configuration OUTPUT filename 622 $outfile ||= $self->{output}; 623 if ($outfile && $outfile ne '-') 624 { 625 # Prefix out file with export type in multiple export type call 626 $outfile = $self->{type} . "_$outfile" if ($#{$self->{export_type}} > 0); 627 if ($self->{output_dir} && $outfile) 628 { 629 $outfile = $self->{output_dir} . "/" . $outfile; 630 } 631 if ($self->{input_file} && ($outfile eq $self->{input_file})) 632 { 633 $self->logit("FATAL: input file is the same as output file: $outfile, can not overwrite it.\n",0,1); 634 } 635 unlink($outfile); 636 } 637} 638 639=head2 append_export_file FILENAME 640 641Open a file handle to a given filename to append data. 642 643=cut 644 645sub append_export_file 646{ 647 my ($self, $outfile, $noprefix) = @_; 648 649 my $filehdl = undef; 650 651 if ($outfile) 652 { 653 if ($self->{output_dir} && !$noprefix) { 654 $outfile = $self->{output_dir} . '/' . $outfile; 655 } 656 # If user request data compression 657 if ($self->{compress} && (($self->{jobs} > 1) || ($self->{oracle_copies} > 1))) { 658 die "FATAL: you can't use compressed output with parallel dump\n"; 659 } else { 660 $filehdl = new IO::File; 661 $filehdl->open(">>$outfile") or $self->logit("FATAL: Can't open $outfile: $!\n", 0, 1); 662 $filehdl->autoflush(1); 663 } 664 } 665 666 return $filehdl; 667} 668 669=head2 read_export_file FILENAME 670 671Open a file handle to a given filename to read data. 672 673=cut 674 675sub read_export_file 676{ 677 my ($self, $infile) = @_; 678 679 my $filehdl = new IO::File; 680 $filehdl->open("<$infile") or $self->logit("FATAL: Can't read $infile: $!\n", 0, 1); 681 682 return $filehdl; 683} 684 685 686=head2 close_export_file FILEHANDLE 687 688Close a file handle. 689 690=cut 691 692sub close_export_file 693{ 694 my ($self, $filehdl, $not_compressed) = @_; 695 696 697 return if (!defined $filehdl); 698 699 if (!$not_compressed && $self->{output} =~ /\.gz$/) { 700 $filehdl->gzclose(); 701 } else { 702 $filehdl->close(); 703 } 704} 705 706=head2 modify_struct TABLE_NAME ARRAYOF_FIELDNAME 707 708Modify the table structure during the export. Only the specified columns 709will be exported. 710 711=cut 712 713sub modify_struct 714{ 715 my ($self, $table, @fields) = @_; 716 717 if (!$self->{preserve_case}) { 718 map { $_ = lc($_) } @fields; 719 $table = lc($table); 720 } 721 push(@{$self->{modify}{$table}}, @fields); 722 723} 724 725=head2 is_reserved_words 726 727Returns 1 if the given object name is a PostgreSQL reserved word 728Returns 2 if the object name is only numeric 729Returns 3 if the object name is a system column 730 731=cut 732 733sub is_reserved_words 734{ 735 my ($self, $obj_name) = @_; 736 737 if ($obj_name && grep(/^\Q$obj_name\E$/i, @KEYWORDS)) { 738 return 1 if (!grep(/^$self->{type}/, 'FUNCTION', 'PACKAGE', 'PROCEDURE') || grep(/^\Q$obj_name\E$/i, @FCT_TYPE_KEYWORDS)); 739 } 740 if ($obj_name =~ /^\d+/) { 741 return 2; 742 } 743 if ($obj_name && grep(/^\Q$obj_name\E$/i, @SYSTEM_FIELDS)) { 744 return 3; 745 } 746 747 return 0; 748} 749 750=head2 quote_object_name 751 752Return a quoted object named when needed: 753 - PostgreSQL reserved word 754 - unsupported character 755 - start with a digit or digit only 756=cut 757 758 759sub quote_object_name 760{ 761 my ($self, @obj_list) = @_; 762 763 my @ret = (); 764 765 foreach my $obj_name (@obj_list) 766 { 767 next if ($obj_name =~ /^SYS_NC\d+/); 768 769 # Start by removing any double quote and extra space 770 $obj_name =~ s/"//g; 771 $obj_name =~ s/^\s+//; 772 $obj_name =~ s/\s+$//; 773 774 # When PRESERVE_CASE is not enabled set object name to lower case 775 if (!$self->{preserve_case}) 776 { 777 $obj_name = lc($obj_name); 778 # then if there is non alphanumeric or the object name is a reserved word 779 if ($obj_name =~ /[^a-z0-9\_\.]/ || ($self->{use_reserved_words} && $self->is_reserved_words($obj_name)) || $obj_name =~ /^\d+/) 780 { 781 # Add double quote to [schema.] object name 782 if ($obj_name !~ /^[^\.]+\.[^\.]+$/ && $obj_name !~ /^[^\.]+\.[^\.]+\.[^\.]+$/) { 783 $obj_name = '"' . $obj_name . '"'; 784 } elsif ($obj_name =~ /^[^\.]+\.[^\.]+$/) { 785 $obj_name =~ s/^([^\.]+)\.([^\.]+)$/"$1"\."$2"/; 786 } else { 787 $obj_name =~ s/^([^\.]+)\.([^\.]+)\.([^\.]+)$/"$1"\."$2"\."$3"/; 788 } 789 $obj_name = '"' . $obj_name . '"' if ($obj_name =~ /^\d+/); 790 } 791 } 792 # Add double quote to [schema.] object name 793 elsif ($obj_name !~ /^[^\.]+\.[^\.]+$/ && $obj_name !~ /^[^\.]+\.[^\.]+\.[^\.]+$/) { 794 $obj_name = "\"$obj_name\""; 795 } elsif ($obj_name =~ /^[^\.]+\.[^\.]+$/) { 796 $obj_name =~ s/^([^\.]+)\.([^\.]+)$/"$1"\."$2"/; 797 } else { 798 $obj_name =~ s/^([^\.]+)\.([^\.]+)\.([^\.]+)$/"$1"\."$2"\."$3"/; 799 } 800 push(@ret, $obj_name); 801 } 802 803 return join(',', @ret); 804} 805 806=head2 replace_tables HASH 807 808Modify table names during the export. 809 810=cut 811 812sub replace_tables 813{ 814 my ($self, %tables) = @_; 815 816 foreach my $t (keys %tables) { 817 $self->{replaced_tables}{"\L$t\E"} = $tables{$t}; 818 } 819 820} 821 822=head2 replace_cols HASH 823 824Modify column names during the export. 825 826=cut 827 828sub replace_cols 829{ 830 my ($self, %cols) = @_; 831 832 foreach my $t (keys %cols) { 833 foreach my $c (keys %{$cols{$t}}) { 834 $self->{replaced_cols}{"\L$t\E"}{"\L$c\E"} = $cols{$t}{$c}; 835 } 836 } 837 838} 839 840=head2 set_where_clause HASH 841 842Add a WHERE clause during data export on specific tables or on all tables 843 844=cut 845 846sub set_where_clause 847{ 848 my ($self, $global, %table_clause) = @_; 849 850 $self->{global_where} = $global; 851 foreach my $t (keys %table_clause) { 852 $self->{where}{"\L$t\E"} = $table_clause{$t}; 853 } 854 855} 856 857=head2 set_delete_clause HASH 858 859Add a DELETE clause before data export on specific tables or on all tables 860 861=cut 862 863sub set_delete_clause 864{ 865 my ($self, $global, %table_clause) = @_; 866 867 $self->{global_delete} = $global; 868 foreach my $t (keys %table_clause) { 869 $self->{delete}{"\L$t\E"} = $table_clause{$t}; 870 } 871 872} 873 874 875#### Private subroutines #### 876 877=head1 PRIVATE METHODS 878 879=head2 _init HASH_OPTIONS 880 881Initialize an Ora2Pg object instance with a connexion to the 882Oracle database. 883 884=cut 885 886sub _init 887{ 888 my ($self, %options) = @_; 889 890 # Use custom temp directory if specified 891 $TMP_DIR = $options{temp_dir} || $TMP_DIR; 892 893 # Read configuration file 894 $self->read_config($options{config}) if ($options{config}); 895 896 # Those are needed by DBI 897 $ENV{ORACLE_HOME} = $AConfig{'ORACLE_HOME'} if ($AConfig{'ORACLE_HOME'}); 898 $ENV{NLS_LANG} = $AConfig{'NLS_LANG'} if ($AConfig{'NLS_LANG'}); 899 900 # Init arrays 901 $self->{default_tablespaces} = (); 902 $self->{limited} = (); 903 $self->{excluded} = (); 904 $self->{view_as_table} = (); 905 $self->{modify} = (); 906 $self->{replaced_tables} = (); 907 $self->{replaced_cols} = (); 908 $self->{replace_as_boolean} = (); 909 $self->{ora_boolean_values} = (); 910 $self->{null_equal_empty} = 1; 911 $self->{estimate_cost} = 0; 912 $self->{where} = (); 913 $self->{replace_query} = (); 914 $self->{ora_reserved_words} = (); 915 $self->{defined_pk} = (); 916 $self->{allow_partition} = (); 917 $self->{empty_lob_null} = 0; 918 $self->{look_forward_function} = (); 919 $self->{no_function_metadata} = 0; 920 $self->{oracle_fdw_transform} = (); 921 $self->{all_objects} = (); 922 923 # Initial command to execute at Oracle and PostgreSQL connexion 924 $self->{ora_initial_command} = (); 925 $self->{pg_initial_command} = (); 926 927 # To register user defined exception 928 $self->{custom_exception} = (); 929 $self->{exception_id} = 50001; 930 931 # Init PostgreSQL DB handle 932 $self->{dbhdest} = undef; 933 $self->{standard_conforming_strings} = 1; 934 $self->{create_schema} = 1; 935 936 # Init some arrays 937 $self->{external_table} = (); 938 $self->{function_metadata} = (); 939 $self->{grant_object} = ''; 940 941 # Used to precise if we need to prefix partition tablename with main tablename 942 $self->{prefix_partition} = 0; 943 $self->{prefix_part_subpartition} = 1; 944 945 # Use to preserve the data export type with geometry objects 946 $self->{local_type} = ''; 947 948 # Shall we log on error during data import or abort. 949 $self->{log_on_error} = 0; 950 951 # Initialize some variable related to export of mysql database 952 $self->{is_mysql} = 0; 953 $self->{mysql_mode} = ''; 954 $self->{mysql_internal_extract_format} = 0; 955 $self->{mysql_pipes_as_concat} = 0; 956 957 # List of users for audit trail 958 $self->{audit_user} = ''; 959 960 # Disable copy freeze by default 961 $self->{copy_freeze} = ''; 962 963 # Use FTS index to convert CONTEXT Oracle's indexes by default 964 $self->{context_as_trgm} = 0; 965 $self->{fts_index_only} = 1; 966 $self->{fts_config} = ''; 967 $self->{use_unaccent} = 1; 968 $self->{use_lower_unaccent} = 1; 969 970 # Enable rewrite of outer join by default. 971 $self->{rewrite_outer_join} = 1; 972 973 # Init comment and text constant storage variables 974 $self->{idxcomment} = 0; 975 $self->{comment_values} = (); 976 $self->{text_values} = (); 977 $self->{text_values_pos} = 0; 978 979 # Keep commit/rollback in converted pl/sql code by default 980 $self->{comment_commit_rollback} = 0; 981 982 # Keep savepoint in converted pl/sql code by default 983 $self->{comment_savepoint} = 0; 984 985 # Storage of string constant placeholder regexp 986 $self->{string_constant_regexp} = (); 987 $self->{alternative_quoting_regexp} = (); 988 989 # Global file handle 990 $self->{cfhout} = undef; 991 992 # oracle_fdw foreign server 993 $self->{fdw_server} = ''; 994 995 # Initialyze following configuration file 996 foreach my $k (sort keys %AConfig) 997 { 998 if (lc($k) eq 'allow') { 999 $self->{limited} = $AConfig{ALLOW}; 1000 } elsif (lc($k) eq 'exclude') { 1001 $self->{excluded} = $AConfig{EXCLUDE}; 1002 } else { 1003 $self->{lc($k)} = $AConfig{$k}; 1004 } 1005 } 1006 1007 # Set default system user/schema to not export. Most of them are extracted from this doc: 1008 # http://docs.oracle.com/cd/E11882_01/server.112/e10575/tdpsg_user_accounts.htm#TDPSG20030 1009 push(@{$self->{sysusers}},'SYSTEM','CTXSYS','DBSNMP','EXFSYS','LBACSYS','MDSYS','MGMT_VIEW','OLAPSYS','ORDDATA','OWBSYS','ORDPLUGINS','ORDSYS','OUTLN','SI_INFORMTN_SCHEMA','SYS','SYSMAN','WK_TEST','WKSYS','WKPROXY','WMSYS','XDB','APEX_PUBLIC_USER','DIP','FLOWS_020100','FLOWS_030000','FLOWS_040100','FLOWS_010600','FLOWS_FILES','MDDATA','ORACLE_OCM','SPATIAL_CSW_ADMIN_USR','SPATIAL_WFS_ADMIN_USR','XS$NULL','PERFSTAT','SQLTXPLAIN','DMSYS','TSMSYS','WKSYS','APEX_040000','APEX_040200','DVSYS','OJVMSYS','GSMADMIN_INTERNAL','APPQOSSYS','DVSYS','DVF','AUDSYS','APEX_030200','MGMT_VIEW','ODM','ODM_MTR','TRACESRV','MTMSYS','OWBSYS_AUDIT','WEBSYS','WK_PROXY','OSE$HTTP$ADMIN','AURORA$JIS$UTILITY$','AURORA$ORB$UNAUTHENTICATED','DBMS_PRIVILEGE_CAPTURE','CSMIG', 'MGDSYS', 'SDE','DBSFWUSER'); 1010 1011 # Set default tablespace to exclude when using USE_TABLESPACE 1012 push(@{$self->{default_tablespaces}}, 'TEMP', 'USERS','SYSTEM'); 1013 1014 # Verify grant objects 1015 if ($self->{type} eq 'GRANT' && $self->{grant_object}) 1016 { 1017 die "FATAL: wrong object type in GRANT_OBJECTS directive.\n" if (!grep(/^$self->{grant_object}$/, 'USER', 'TABLE', 'VIEW', 'MATERIALIZED VIEW', 'SEQUENCE', 'PROCEDURE', 'FUNCTION', 'PACKAGE BODY', 'TYPE', 'SYNONYM', 'DIRECTORY')); 1018 } 1019 1020 # Default boolean values 1021 foreach my $k (keys %BOOLEAN_MAP) { 1022 $self->{ora_boolean_values}{lc($k)} = $BOOLEAN_MAP{$k}; 1023 } 1024 # additional boolean values given from config file 1025 foreach my $k (keys %{$self->{boolean_values}}) { 1026 $self->{ora_boolean_values}{lc($k)} = $AConfig{BOOLEAN_VALUES}{$k}; 1027 } 1028 1029 # Set transaction isolation level 1030 if ($self->{transaction} eq 'readonly') { 1031 $self->{transaction} = 'SET TRANSACTION READ ONLY'; 1032 } elsif ($self->{transaction} eq 'readwrite') { 1033 $self->{transaction} = 'SET TRANSACTION READ WRITE'; 1034 } elsif ($self->{transaction} eq 'committed') { 1035 $self->{transaction} = 'SET TRANSACTION ISOLATION LEVEL READ COMMITTED'; 1036 } elsif ($self->{transaction} eq 'serializable') { 1037 $self->{transaction} = 'SET TRANSACTION ISOLATION LEVEL SERIALIZABLE'; 1038 } else { 1039 if (grep(/^$self->{type}$/, 'COPY', 'INSERT')) { 1040 $self->{transaction} = 'SET TRANSACTION ISOLATION LEVEL SERIALIZABLE'; 1041 } else { 1042 $self->{transaction} = 'SET TRANSACTION ISOLATION LEVEL READ COMMITTED'; 1043 } 1044 } 1045 $self->{function_check} = 1 if (not defined $self->{function_check} || $self->{function_check} eq ''); 1046 $self->{qualify_function} = 1 if (!exists $self->{qualify_function}); 1047 1048 # Set default function to use for uuid generation 1049 $self->{uuid_function} ||= 'uuid_generate_v4'; 1050 1051 # Set default cost unit value to 5 minutes 1052 $self->{cost_unit_value} ||= 5; 1053 1054 # Set default human days limit for type C migration level 1055 $self->{human_days_limit} ||= 5; 1056 1057 # Defined if column order must be optimized 1058 $self->{reordering_columns} ||= 0; 1059 1060 # Initialize suffix that may be added to the index name 1061 $self->{indexes_suffix} ||= ''; 1062 1063 # Disable synchronous commit for pg data load 1064 $self->{synchronous_commit} ||= 0; 1065 1066 # Disallow NOLOGGING / UNLOGGED table creation 1067 $self->{disable_unlogged} ||= 0; 1068 1069 # Default degree for Oracle parallelism 1070 if ($self->{default_parallelism_degree} eq '') { 1071 $self->{default_parallelism_degree} = 0; 1072 } 1073 1074 # Add header to output file 1075 $self->{no_header} ||= 0; 1076 1077 # Mark function as STABLE by default 1078 if (not defined $self->{function_stable} || $self->{function_stable} ne '0') { 1079 $self->{function_stable} = 1; 1080 } 1081 1082 # Initialize rewriting of index name 1083 if (not defined $self->{indexes_renaming} || $self->{indexes_renaming} ne '0') { 1084 $self->{indexes_renaming} = 1; 1085 } 1086 1087 # Enable autonomous transaction conversion. Default is enable it. 1088 if (!exists $self->{autonomous_transaction} || $self->{autonomous_transaction} ne '0') { 1089 $self->{autonomous_transaction} = 1; 1090 } 1091 1092 # Don't use *_pattern_ops with indexes by default 1093 $self->{use_index_opclass} ||= 0; 1094 1095 # Autodetect spatial type 1096 $self->{autodetect_spatial_type} ||= 0; 1097 1098 # Use btree_gin extenstion to create bitmap like index with pg >= 9.4 1099 $self->{bitmap_as_gin} = 1 if ($self->{bitmap_as_gin} ne '0'); 1100 1101 # Create tables with OIDs or not, default to not create OIDs 1102 $self->{with_oid} ||= 0; 1103 1104 # Minimum of lines required in a table to use parallelism 1105 $self->{parallel_min_rows} ||= 100000; 1106 1107 # Should we replace zero date with something else than NULL 1108 $self->{replace_zero_date} ||= ''; 1109 if ($self->{replace_zero_date} && (uc($self->{replace_zero_date}) ne '-INFINITY') && ($self->{replace_zero_date} !~ /^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/)) { 1110 die "FATAL: wrong format in REPLACE_ZERO_DATE value, should be YYYY-MM-DD HH:MM:SS or -INFINITY\n"; 1111 } 1112 1113 # Defined default value for to_number translation 1114 $self->{to_number_conversion} ||= 'numeric'; 1115 1116 # Set regexp to detect parts of statements that need to be considered as text 1117 if ($AConfig{STRING_CONSTANT_REGEXP}) { 1118 push(@{ $self->{string_constant_regexp} } , split(/;/, $AConfig{STRING_CONSTANT_REGEXP})); 1119 } 1120 if ($AConfig{ALTERNATIVE_QUOTING_REGEXP}) { 1121 push(@{ $self->{alternative_quoting_regexp} } , split(/;/, $AConfig{ALTERNATIVE_QUOTING_REGEXP})); 1122 } 1123 1124 # Defined if we must add a drop if exists statement before creating an object 1125 $self->{drop_if_exists} ||= 0; 1126 1127 # Overwrite configuration with all given parameters 1128 # and try to preserve backward compatibility 1129 foreach my $k (keys %options) 1130 { 1131 if (($k eq 'allow') && $options{allow}) 1132 { 1133 $self->{limited} = (); 1134 # Syntax: TABLE[regex1 regex2 ...];VIEW[regex1 regex2 ...];glob_regex1 glob_regex2 ... 1135 my @allow_vlist = split(/\s*;\s*/, $options{allow}); 1136 foreach my $a (@allow_vlist) 1137 { 1138 if ($a =~ /^([^\[]+)\[(.*)\]$/) { 1139 push(@{$self->{limited}{"\U$1\E"}}, split(/[\s,]+/, $2) ); 1140 } else { 1141 push(@{$self->{limited}{ALL}}, split(/[\s,]+/, $a) ); 1142 } 1143 } 1144 } 1145 elsif (($k eq 'exclude') && $options{exclude}) 1146 { 1147 $self->{excluded} = (); 1148 # Syntax: TABLE[regex1 regex2 ...];VIEW[regex1 regex2 ...];glob_regex1 glob_regex2 ... 1149 my @exclude_vlist = split(/\s*;\s*/, $options{exclude}); 1150 foreach my $a (@exclude_vlist) 1151 { 1152 if ($a =~ /^([^\[]+)\[(.*)\]$/) { 1153 push(@{$self->{excluded}{"\U$1\E"}}, split(/[\s,]+/, $2) ); 1154 } else { 1155 push(@{$self->{excluded}{ALL}}, split(/[\s,]+/, $a) ); 1156 } 1157 } 1158 } 1159 elsif (($k eq 'view_as_table') && $options{view_as_table}) 1160 { 1161 $self->{view_as_table} = (); 1162 push(@{$self->{view_as_table}}, split(/[\s;,]+/, $options{view_as_table}) ); 1163 } elsif (($k eq 'datasource') && $options{datasource}) { 1164 $self->{oracle_dsn} = $options{datasource}; 1165 } elsif (($k eq 'user') && $options{user}) { 1166 $self->{oracle_user} = $options{user}; 1167 } elsif (($k eq 'password') && $options{password}) { 1168 $self->{oracle_pwd} = $options{password}; 1169 } elsif (($k eq 'is_mysql') && $options{is_mysql}) { 1170 $self->{is_mysql} = $options{is_mysql}; 1171 } elsif ($options{$k} ne '') { 1172 $self->{"\L$k\E"} = $options{$k}; 1173 } 1174 } 1175 1176 # Global regex will be applied to the export type only 1177 foreach my $i (@{$self->{limited}{ALL}}) 1178 { 1179 my $typ = $self->{type} || 'TABLE'; 1180 $typ = 'TABLE' if ($self->{type} =~ /(SHOW_TABLE|SHOW_COLUMN|FDW|KETTLE|COPY|INSERT|TEST)/); 1181 push(@{$self->{limited}{$typ}}, $i); 1182 } 1183 delete $self->{limited}{ALL}; 1184 foreach my $i (@{$self->{excluded}{ALL}}) 1185 { 1186 my $typ = $self->{type} || 'TABLE'; 1187 $typ = 'TABLE' if ($self->{type} =~ /(SHOW_TABLE|SHOW_COLUMN|FDW|KETTLE|COPY|INSERT|TEST)/); 1188 push(@{$self->{excluded}{$typ}}, $i); 1189 } 1190 delete $self->{excluded}{ALL}; 1191 1192 $self->{debug} = 1 if ($AConfig{'DEBUG'} == 1); 1193 1194 # Set default XML data extract method 1195 if (not defined $self->{xml_pretty} || ($self->{xml_pretty} != 0)) { 1196 $self->{xml_pretty} = 1; 1197 } 1198 1199 # Set a default name for the foreign server 1200 if (!$self->{fdw_server} && $self->{type} eq 'FDW') { 1201 $self->{fdw_server} = 'orcl'; 1202 } 1203 1204 # Should we use \i or \ir in psql scripts 1205 if ($AConfig{PSQL_RELATIVE_PATH}) { 1206 $self->{psql_relative_path} = 'r'; 1207 } else { 1208 $self->{psql_relative_path} = ''; 1209 } 1210 1211 # Clean potential remaining temporary files 1212 my $dirprefix = ''; 1213 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 1214 unlink($dirprefix . 'temp_pass2_file.dat'); 1215 unlink($dirprefix . 'temp_cost_file.dat'); 1216 1217 # Log file handle 1218 $self->{fhlog} = undef; 1219 if ($self->{logfile}) 1220 { 1221 $self->{fhlog} = new IO::File; 1222 $self->{fhlog}->open(">>$self->{logfile}") or $self->logit("FATAL: can't log to $self->{logfile}, $!\n", 0, 1); 1223 } 1224 1225 # Autoconvert SRID 1226 if (not defined $self->{convert_srid} || ($self->{convert_srid} != 0)) { 1227 $self->{convert_srid} = 1; 1228 } 1229 if (not defined $self->{default_srid}) { 1230 $self->{default_srid} = 4326; 1231 } 1232 1233 # Force Ora2Pg to extract spatial object in binary format 1234 $self->{geometry_extract_type} = uc($self->{geometry_extract_type}); 1235 if (!$self->{geometry_extract_type} || !grep(/^$self->{geometry_extract_type}$/, 'WKT','WKB','INTERNAL')) { 1236 $self->{geometry_extract_type} = 'INTERNAL'; 1237 } 1238 1239 # Default value for triming can be LEADING, TRAILING or BOTH 1240 $self->{trim_type} = 'BOTH' if (!$self->{trim_type} || !grep(/^$self->{trim_type}/, 'BOTH', 'LEADING', 'TRAILING')); 1241 # Default triming character is space 1242 $self->{trim_char} = ' ' if ($self->{trim_char} eq ''); 1243 1244 # Disable the use of orafce library by default 1245 $self->{use_orafce} ||= 0; 1246 1247 # Enable BLOB data export by default 1248 if (not defined $self->{enable_blob_export}) { 1249 $self->{enable_blob_export} = 1; 1250 } 1251 1252 # Table data export will be sorted by name by default 1253 $self->{data_export_order} ||= 'name'; 1254 1255 # Free some memory 1256 %options = (); 1257 %AConfig = (); 1258 1259 # Enable create or replace by default 1260 if ($self->{create_or_replace} || not defined $self->{create_or_replace}) { 1261 $self->{create_or_replace} = ' OR REPLACE'; 1262 } else { 1263 $self->{create_or_replace} = ''; 1264 } 1265 1266 $self->{copy_freeze} = ' FREEZE' if ($self->{copy_freeze}); 1267 # Prevent use of COPY FREEZE with some incompatible case 1268 if ($self->{copy_freeze}) 1269 { 1270 if ($self->{pg_dsn} && ($self->{jobs} > 1)) { 1271 $self->logit("FATAL: You can not use COPY FREEZE with -j (JOBS) > 1 and direct import to PostgreSQL.\n", 0, 1); 1272 } elsif ($self->{oracle_copies} > 1) { 1273 $self->logit("FATAL: You can not use COPY FREEZE with -J (ORACLE_COPIES) > 1.\n", 0, 1); 1274 } 1275 } 1276 else 1277 { 1278 $self->{copy_freeze} = ''; 1279 } 1280 1281 # Multiprocess init 1282 $self->{jobs} ||= 1; 1283 $self->{child_count} = 0; 1284 # backward compatibility 1285 if ($self->{thread_count}) { 1286 $self->{jobs} = $self->{thread_count} || 1; 1287 } 1288 $self->{has_utf8_fct} = 1; 1289 eval { utf8::valid("test utf8 function"); }; 1290 if ($@) { 1291 # Old perl install doesn't include these functions 1292 $self->{has_utf8_fct} = 0; 1293 } 1294 1295 # Autodetexct if we are exporting a MySQL database 1296 if ($self->{oracle_dsn} =~ /dbi:mysql/i) { 1297 $self->{is_mysql} = 1; 1298 } 1299 1300 if ($self->{is_mysql}) { 1301 # MySQL do not supports this syntax fallback to read committed 1302 $self->{transaction} =~ s/(READ ONLY|READ WRITE)/ISOLATION LEVEL READ COMMITTED/; 1303 } 1304 1305 # Set Oracle, Perl and PostgreSQL encoding that will be used 1306 $self->_init_environment(); 1307 1308 # Multiple Oracle connection 1309 $self->{oracle_copies} ||= 0; 1310 $self->{ora_conn_count} = 0; 1311 $self->{data_limit} ||= 10000; 1312 $self->{blob_limit} ||= 0; 1313 $self->{disable_partition} ||= 0; 1314 $self->{parallel_tables} ||= 0; 1315 $self->{no_lob_locator} = 1 if ($self->{no_lob_locator} ne '0'); 1316 1317 # Transformation and output during data export 1318 $self->{oracle_speed} ||= 0; 1319 $self->{ora2pg_speed} ||= 0; 1320 if (($self->{oracle_speed} || $self->{ora2pg_speed}) && !grep(/^$self->{type}$/, 'COPY', 'INSERT', 'DATA')) { 1321 # No output is only available for data export. 1322 die "FATAL: --oracle_speed or --ora2pg_speed can only be use with data export.\n"; 1323 } 1324 $self->{oracle_speed} = 1 if ($self->{ora2pg_speed}); 1325 1326 # Shall we prefix function with a schema name to emulate a package? 1327 $self->{package_as_schema} = 1 if (not exists $self->{package_as_schema} || ($self->{package_as_schema} eq '')); 1328 $self->{package_functions} = (); 1329 1330 # Set user defined data type translation 1331 if ($self->{data_type}) 1332 { 1333 $self->{data_type} =~ s/\\,/#NOSEP#/gs; 1334 my @transl = split(/[,;]/, uc($self->{data_type})); 1335 $self->{data_type} = (); 1336 # Set default type conversion 1337 %{$self->{data_type}} = %TYPE; 1338 if ($self->{is_mysql}) { 1339 %{$self->{data_type}} = %Ora2Pg::MySQL::MYSQL_TYPE; 1340 } 1341 # then set custom type conversion from the DATA_TYPE 1342 # configuration directive 1343 foreach my $t (@transl) 1344 { 1345 my ($typ, $val) = split(/:/, $t); 1346 $typ =~ s/^\s+//; 1347 $typ =~ s/\s+$//; 1348 $val =~ s/^\s+//; 1349 $val =~ s/\s+$//; 1350 $typ =~ s/#NOSEP#/,/g; 1351 $val =~ s/#NOSEP#/,/g; 1352 $self->{data_type}{$typ} = lc($val) if ($val); 1353 } 1354 } 1355 else 1356 { 1357 # Set default type conversion 1358 %{$self->{data_type}} = %TYPE; 1359 if ($self->{is_mysql}) { 1360 %{$self->{data_type}} = %Ora2Pg::MySQL::MYSQL_TYPE; 1361 } 1362 } 1363 1364 # Set some default 1365 $self->{global_where} ||= ''; 1366 $self->{global_delete} ||= ''; 1367 $self->{prefix} = 'DBA'; 1368 if ($self->{user_grants}) { 1369 $self->{prefix} = 'ALL'; 1370 } 1371 $self->{bzip2} ||= '/usr/bin/bzip2'; 1372 $self->{default_numeric} ||= 'bigint'; 1373 $self->{type_of_type} = (); 1374 $self->{dump_as_html} ||= 0; 1375 $self->{dump_as_csv} ||= 0; 1376 $self->{dump_as_sheet} ||= 0; 1377 $self->{top_max} ||= 10; 1378 $self->{print_header} ||= 0; 1379 $self->{use_default_null} = 1 if (!defined $self->{use_default_null}); 1380 1381 $self->{estimate_cost} = 1 if ($self->{dump_as_sheet}); 1382 $self->{count_rows} ||= 0; 1383 1384 # Enforce preservation of primary and unique keys 1385 # when USE_TABLESPACE is enabled 1386 if ($self->{use_tablespace} && !$self->{keep_pkey_names}) 1387 { 1388 print STDERR "WARNING: Enforcing KEEP_PKEY_NAMES to 1 as USE_TABLESPACE is enabled.\n"; 1389 $self->{keep_pkey_names} = 1; 1390 } 1391 1392 # DATADIFF defaults 1393 $self->{datadiff} ||= 0; 1394 $self->{datadiff_del_suffix} ||= '_del'; 1395 $self->{datadiff_ins_suffix} ||= '_ins'; 1396 $self->{datadiff_upd_suffix} ||= '_upd'; 1397 1398 # Internal date boundary. Date below will be added to 2000, others will used 1900 1399 $self->{internal_date_max} ||= 49; 1400 1401 # Set the target PostgreSQL major version 1402 if (!$self->{pg_version}) 1403 { 1404 print STDERR "WARNING: target PostgreSQL version must be set in PG_VERSION configuration directive. Using default: 11\n"; 1405 $self->{pg_version} = 11; 1406 } 1407 1408 # Compatibility with PostgreSQL versions 1409 if ($self->{pg_version} >= 9.0) 1410 { 1411 $self->{pg_supports_when} = 1; 1412 $self->{pg_supports_ifexists} = 'IF EXISTS'; 1413 } 1414 if ($self->{pg_version} >= 9.1) { 1415 $self->{pg_supports_insteadof} = 1; 1416 } 1417 if ($self->{pg_version} >= 9.3) { 1418 $self->{pg_supports_mview} = 1; 1419 $self->{pg_supports_lateral} = 1; 1420 } 1421 if ($self->{pg_version} >= 9.4) { 1422 $self->{pg_supports_checkoption} = 1; 1423 } 1424 if ($self->{pg_version} >= 9.5) { 1425 $self->{pg_supports_named_operator} = 1; 1426 } 1427 if ($self->{pg_version} >= 10) { 1428 $self->{pg_supports_partition} = 1; 1429 $self->{pg_supports_identity} = 1; 1430 } 1431 if ($self->{pg_version} >= 11) { 1432 $self->{pg_supports_procedure} = 1; 1433 } 1434 1435 # Other PostgreSQL fork compatibility 1436 # Redshift 1437 if ($self->{pg_supports_substr} eq '') { 1438 $self->{pg_supports_substr} = 1; 1439 } 1440 1441 $self->{pg_background} ||= 0; 1442 1443 # Backward compatibility with LongTrunkOk with typo 1444 if ($self->{longtrunkok} && not defined $self->{longtruncok}) { 1445 $self->{longtruncok} = $self->{longtrunkok}; 1446 } 1447 $self->{longtruncok} = 0 if (not defined $self->{longtruncok}); 1448 # With lob locators LONGREADLEN must at least be 1MB 1449 if (!$self->{longreadlen} || !$self->{no_lob_locator}) { 1450 $self->{longreadlen} = (1023*1024); 1451 } 1452 1453 # Backward compatibility with PG_NUMERIC_TYPE alone 1454 $self->{pg_integer_type} = 1 if (not defined $self->{pg_integer_type}); 1455 # Backward compatibility with CASE_SENSITIVE 1456 $self->{preserve_case} = $self->{case_sensitive} if (defined $self->{case_sensitive} && not defined $self->{preserve_case}); 1457 $self->{schema} = uc($self->{schema}) if (!$self->{preserve_case} && ($self->{oracle_dsn} !~ /:mysql/i)); 1458 # With MySQL override schema with the database name 1459 if ($self->{oracle_dsn} =~ /:mysql:.*database=([^;]+)/i) 1460 { 1461 if ($self->{schema} ne $1) 1462 { 1463 $self->{schema} = $1; 1464 #$self->logit("WARNING: setting SCHEMA to MySQL database name $1.\n", 0); 1465 } 1466 if (!$self->{schema}) { 1467 $self->logit("FATAL: cannot find a valid mysql database in DSN, $self->{oracle_dsn}.\n", 0, 1); 1468 } 1469 } 1470 1471 if (($self->{standard_conforming_strings} =~ /^off$/i) || ($self->{standard_conforming_strings} == 0)) { 1472 $self->{standard_conforming_strings} = 0; 1473 } else { 1474 $self->{standard_conforming_strings} = 1; 1475 } 1476 if (!defined $self->{compile_schema} || $self->{compile_schema}) { 1477 $self->{compile_schema} = 1; 1478 } else { 1479 $self->{compile_schema} = 0; 1480 } 1481 $self->{export_invalid} ||= 0; 1482 $self->{use_reserved_words} ||= 0; 1483 $self->{pkey_in_create} ||= 0; 1484 $self->{security} = (); 1485 # Should we add SET ON_ERROR_STOP to generated SQL files 1486 $self->{stop_on_error} = 1 if (not defined $self->{stop_on_error}); 1487 # Force foreign keys to be created initialy deferred if export type 1488 # is TABLE or to set constraint deferred with data export types/ 1489 $self->{defer_fkey} ||= 0; 1490 1491 # Allow multiple or chained extraction export type 1492 $self->{export_type} = (); 1493 if ($self->{type}) { 1494 @{$self->{export_type}} = split(/[\s,;]+/, $self->{type}); 1495 # Assume backward compatibility with DATA replacement by INSERT 1496 map { s/^DATA$/INSERT/; } @{$self->{export_type}}; 1497 } else { 1498 @{$self->{export_type}} = ('TABLE'); 1499 } 1500 1501 # If you decide to autorewrite PLSQL code, this load the dedicated 1502 # Perl module 1503 $self->{plsql_pgsql} = 1 if ($self->{plsql_pgsql} eq ''); 1504 $self->{plsql_pgsql} = 1 if ($self->{estimate_cost}); 1505 if ($self->{plsql_pgsql}) { 1506 use Ora2Pg::PLSQL; 1507 } 1508 1509 $self->{fhout} = undef; 1510 $self->{compress} = ''; 1511 $self->{pkgcost} = 0; 1512 $self->{total_pkgcost} = 0; 1513 1514 if ($^O =~ /MSWin32|dos/i) 1515 { 1516 if ( ($self->{oracle_copies} > 1) || ($self->{jobs} > 1) || ($self->{parallel_tables} > 1) ) 1517 { 1518 $self->logit("WARNING: multiprocess is not supported under that kind of OS.\n", 0); 1519 $self->logit("If you need full speed at data export, please use Linux instead.\n", 0); 1520 } 1521 $self->{oracle_copies} = 0; 1522 $self->{jobs} = 0; 1523 $self->{parallel_tables} = 0; 1524 } 1525 if ($self->{parallel_tables} > 1) { 1526 $self->{file_per_table} = 1; 1527 } 1528 if ($self->{jobs} > 1) { 1529 $self->{file_per_function} = 1; 1530 } 1531 1532 if ($self->{debug}) 1533 { 1534 $self->logit("Ora2Pg version: $VERSION\n"); 1535 $self->logit("Export type: $self->{type}\n", 1); 1536 $self->logit("Geometry export type: $self->{geometry_extract_type}\n", 1); 1537 } 1538 1539 # Replace ; or space by comma in the audit user list 1540 $self->{audit_user} =~ s/[;\s]+/,/g; 1541 1542 # Set the PostgreSQL connection information for data import or to 1543 # defined the dblink connection to use in autonomous transaction 1544 $self->set_pg_conn_details(); 1545 1546 # Mark that we are exporting data using oracle_fdw 1547 $self->{oracle_fdw_data_export} = 0; 1548 if ($self->{fdw_server} && $self->{type} =~ /^(INSERT|COPY)$/) { 1549 $self->{oracle_fdw_data_export} = 1; 1550 } 1551 1552 if (!$self->{input_file}) 1553 { 1554 if ($self->{type} eq 'LOAD') { 1555 $self->logit("FATAL: with LOAD you must provide an input file\n", 0, 1); 1556 } 1557 if (!$self->{oracle_dsn} || ($self->{oracle_dsn} =~ /;sid=SIDNAME/)) { 1558 $self->logit("FATAL: you must set ORACLE_DSN in ora2pg.conf or use a DDL input file.\n", 0, 1); 1559 } 1560 # Connect the database 1561 if ($self->{oracle_dsn} =~ /dbi:mysql/i) 1562 { 1563 $self->{dbh} = $self->_mysql_connection(); 1564 1565 $self->{is_mysql} = 1; 1566 1567 # Get the Oracle version 1568 $self->{db_version} = $self->_get_version(); 1569 1570 } else { 1571 $self->{dbh} = $self->_oracle_connection(); 1572 1573 # Get the Oracle version 1574 $self->{db_version} = $self->_get_version(); 1575 1576 # Compile again all objects in the schema 1577 if ($self->{compile_schema}) { 1578 $self->_compile_schema(uc($self->{compile_schema})); 1579 } 1580 } 1581 if (!grep(/^$self->{type}$/, 'COPY', 'INSERT', 'SEQUENCE', 'GRANT', 'TABLESPACE', 'QUERY', 'SYNONYM', 'FDW', 'KETTLE', 'DBLINK', 'DIRECTORY') && $self->{type} !~ /SHOW_/) 1582 { 1583 if ($self->{plsql_pgsql} && !$self->{no_function_metadata}) 1584 { 1585 my @done = (); 1586 if ($#{ $self->{look_forward_function} } >= 0) 1587 { 1588 foreach my $o (@{ $self->{look_forward_function} }) 1589 { 1590 next if (grep(/^$o$/i, @done) || uc($o) eq uc($self->{schema})); 1591 push(@done, $o); 1592 if ($self->{type} eq 'VIEW') { 1593 # Limit to package lookup with VIEW export type 1594 $self->_get_package_function_list($o) if (!$self->{is_mysql}); 1595 } else { 1596 # Extract all package/function/procedure meta information 1597 $self->_get_plsql_metadata($o); 1598 } 1599 } 1600 } 1601 if ($self->{type} eq 'VIEW') { 1602 # Limit to package lookup with WIEW export type 1603 $self->_get_package_function_list() if (!$self->{is_mysql}); 1604 } else { 1605 # Extract all package/function/procedure meta information 1606 $self->_get_plsql_metadata(); 1607 } 1608 } 1609 1610 $self->{security} = $self->_get_security_definer($self->{type}) if (grep(/^$self->{type}$/, 'TRIGGER', 'FUNCTION','PROCEDURE','PACKAGE')); 1611 } 1612 } 1613 else 1614 { 1615 $self->{plsql_pgsql} = 1; 1616 1617 if (grep(/^$self->{type}$/, 'TABLE', 'SEQUENCE', 'GRANT', 'TABLESPACE', 'VIEW', 'TRIGGER', 'QUERY', 'FUNCTION','PROCEDURE','PACKAGE','TYPE','SYNONYM', 'DIRECTORY', 'DBLINK','LOAD')) 1618 { 1619 if ($self->{type} eq 'LOAD') 1620 { 1621 if (!$self->{pg_dsn}) { 1622 $self->logit("FATAL: You must set PG_DSN to connect to PostgreSQL to be able to dispatch load over multiple connections.\n", 0, 1); 1623 } elsif ($self->{jobs} <= 1) { 1624 $self->logit("FATAL: You must set set -j (JOBS) > 1 to be able to dispatch load over multiple connections.\n", 0, 1); 1625 } 1626 } 1627 $self->export_schema(); 1628 } 1629 else 1630 { 1631 $self->logit("FATAL: bad export type using input file option\n", 0, 1); 1632 } 1633 return; 1634 } 1635 1636 # Register export structure modification 1637 if ($self->{type} =~ /^(INSERT|COPY|TABLE)$/) 1638 { 1639 for my $t (keys %{$self->{'modify_struct'}}) { 1640 $self->modify_struct($t, @{$self->{'modify_struct'}{$t}}); 1641 } 1642 } 1643 1644 if ($self->{oracle_fdw_data_export} && scalar keys %{$self->{'modify_struct'}} > 0) { 1645 $self->logit("FATAL: MODIFY_STRUCT is not supported with oracle_fdw data export.\n", 0, 1); 1646 } 1647 1648 # backup output filename in multiple export mode 1649 $self->{output_origin} = ''; 1650 if ($#{$self->{export_type}} > 0) { 1651 $self->{output_origin} = $self->{output}; 1652 } 1653 1654 # Retreive all export types information 1655 foreach my $t (@{$self->{export_type}}) 1656 { 1657 $self->{type} = $t; 1658 1659 if (($self->{type} eq 'TABLE') || ($self->{type} eq 'FDW') || ($self->{type} eq 'INSERT') || ($self->{type} eq 'COPY') || ($self->{type} eq 'KETTLE')) 1660 { 1661 $self->{plsql_pgsql} = 1; 1662 $self->_tables(); 1663 # Partitionned table do not accept NOT VALID constraint 1664 if ($self->{pg_supports_partition} && $self->{type} eq 'TABLE') 1665 { 1666 # Get the list of partition 1667 $self->{partitions} = $self->_get_partitions_list(); 1668 } 1669 } elsif ($self->{type} eq 'VIEW') { 1670 $self->_views(); 1671 } elsif ($self->{type} eq 'SYNONYM') { 1672 $self->_synonyms(); 1673 } elsif ($self->{type} eq 'GRANT') { 1674 $self->_grants(); 1675 } elsif ($self->{type} eq 'SEQUENCE') { 1676 $self->_sequences(); 1677 } elsif ($self->{type} eq 'TRIGGER') { 1678 $self->_triggers(); 1679 } elsif ($self->{type} eq 'FUNCTION') { 1680 $self->_functions(); 1681 } elsif ($self->{type} eq 'PROCEDURE') { 1682 $self->_procedures(); 1683 } elsif ($self->{type} eq 'PACKAGE') { 1684 $self->_packages(); 1685 } elsif ($self->{type} eq 'TYPE') { 1686 $self->_types(); 1687 } elsif ($self->{type} eq 'TABLESPACE') { 1688 $self->_tablespaces(); 1689 } elsif ($self->{type} eq 'PARTITION') { 1690 $self->_partitions(); 1691 } elsif ($self->{type} eq 'DBLINK') { 1692 $self->_dblinks(); 1693 } elsif ($self->{type} eq 'DIRECTORY') { 1694 $self->_directories(); 1695 } elsif ($self->{type} eq 'MVIEW') { 1696 $self->_materialized_views(); 1697 } elsif ($self->{type} eq 'QUERY') { 1698 $self->_queries(); 1699 } elsif ( ($self->{type} eq 'SHOW_REPORT') || ($self->{type} eq 'SHOW_VERSION') 1700 || ($self->{type} eq 'SHOW_SCHEMA') || ($self->{type} eq 'SHOW_TABLE') 1701 || ($self->{type} eq 'SHOW_COLUMN') || ($self->{type} eq 'SHOW_ENCODING')) 1702 { 1703 $self->_show_infos($self->{type}); 1704 $self->{dbh}->disconnect() if ($self->{dbh}); 1705 exit 0; 1706 } 1707 elsif ($self->{type} eq 'TEST') 1708 { 1709 $self->{dbhdest} = $self->_send_to_pgdb() if ($self->{pg_dsn} && !$self->{dbhdest}); 1710 # Check if all tables have the same number of indexes, constraints, etc. 1711 $self->_test_table(); 1712 # Count each object at both sides 1713 foreach my $o ('VIEW', 'MVIEW', 'SEQUENCE', 'TYPE', 'FDW') 1714 { 1715 next if ($self->{is_mysql} && grep(/^$o$/, 'MVIEW','TYPE','FDW')); 1716 $self->_count_object($o); 1717 } 1718 # count function/procedure/package function 1719 $self->_test_function(); 1720 # compare sequences values 1721 $self->_test_seq_values(); 1722 # Count row in each table 1723 if ($self->{count_rows}) { 1724 $self->_table_row_count(); 1725 } 1726 1727 $self->{dbhtest}->disconnect() if ($self->{dbhtest}); 1728 $self->{dbh}->disconnect() if ($self->{dbh}); 1729 exit 0; 1730 } 1731 elsif ($self->{type} eq 'TEST_VIEW') 1732 { 1733 $self->{dbhdest} = $self->_send_to_pgdb() if ($self->{pg_dsn} && !$self->{dbhdest}); 1734 $self->_unitary_test_views(); 1735 $self->{dbhtest}->disconnect() if ($self->{dbhtest}); 1736 $self->{dbh}->disconnect() if ($self->{dbh}); 1737 exit 0; 1738 } 1739 elsif ($self->{type} eq 'TEST_DATA') 1740 { 1741 if (!$self->{schema}) 1742 { 1743 $self->{dbhtest}->disconnect() if ($self->{dbhtest}); 1744 $self->{dbh}->disconnect() if ($self->{dbh}); 1745 $self->logit("FATAL: an Oracle schema to compare must be defined.\n", 0, 1); 1746 } 1747 if (!$self->{pg_dsn}) 1748 { 1749 $self->{dbhtest}->disconnect() if ($self->{dbhtest}); 1750 $self->{dbh}->disconnect() if ($self->{dbh}); 1751 $self->logit("FATAL: a PostgreSQL connection datasource must be defined.\n", 0, 1); 1752 } 1753 # Create a connection to PostgreSQL 1754 $self->{dbhdest} = $self->_send_to_pgdb() if (!$self->{dbhdest}); 1755 # Create the oracle_fdw extension en the foreign server 1756 $self->_create_foreign_server(); 1757 # Import the foreign tables following ALLOW or EXCLUDE 1758 $self->_import_foreign_schema(); 1759 $self->{dbhtest}->disconnect() if ($self->{dbhtest}); 1760 $self->{dbh}->disconnect() if ($self->{dbh}); 1761 exit 0; 1762 } 1763 else 1764 { 1765 warn "type option must be (TABLE, VIEW, GRANT, SEQUENCE, TRIGGER, PACKAGE, FUNCTION, PROCEDURE, PARTITION, TYPE, INSERT, COPY, TABLESPACE, SHOW_REPORT, SHOW_VERSION, SHOW_SCHEMA, SHOW_TABLE, SHOW_COLUMN, SHOW_ENCODING, FDW, MVIEW, QUERY, KETTLE, DBLINK, SYNONYM, DIRECTORY, LOAD, TEST, TEST_VIEW, TEST_DATA), unknown $self->{type}\n"; 1766 } 1767 $self->replace_tables(%{$self->{'replace_tables'}}); 1768 $self->replace_cols(%{$self->{'replace_cols'}}); 1769 $self->set_where_clause($self->{'global_where'}, %{$self->{'where'}}); 1770 $self->set_delete_clause($self->{'global_delete'}, %{$self->{'delete'}}); 1771 } 1772 1773 if ( ($self->{type} eq 'INSERT') || ($self->{type} eq 'COPY') || ($self->{type} eq 'KETTLE') ) 1774 { 1775 if ( ($self->{type} eq 'KETTLE') && !$self->{pg_dsn} ) { 1776 $self->logit("FATAL: PostgreSQL connection datasource must be defined with KETTLE export.\n", 0, 1); 1777 } 1778 elsif ($self->{type} ne 'KETTLE') 1779 { 1780 if ($self->{defer_fkey} && $self->{pg_dsn}) { 1781 $self->logit("FATAL: DEFER_FKEY can not be used with direct import to PostgreSQL, check use of DROP_FKEY instead.\n", 0, 1); 1782 } 1783 if ($self->{datadiff} && $self->{pg_dsn}) { 1784 $self->logit("FATAL: DATADIFF can not be used with direct import to PostgreSQL because direct import may load data in several transactions.\n", 0, 1); 1785 } 1786 if ($self->{datadiff} && !$self->{pg_supports_lateral}) { 1787 $self->logit("FATAL: DATADIFF requires LATERAL support (Pg version 9.3 and above; see config parameter PG_SUPPORTS_LATERAL)\n", 0, 1); 1788 } 1789 $self->{dbhdest} = $self->_send_to_pgdb() if ($self->{pg_dsn} && !$self->{dbhdest}); 1790 # In case we will use oracle_fdw creates the foreign tables 1791 if ($self->{fdw_server} && $self->{pg_dsn}) 1792 { 1793 # Create the oracle_fdw extension en the foreign server 1794 $self->_create_foreign_server(); 1795 # Import the foreign tables following ALLOW or EXCLUDE 1796 #$self->_import_foreign_schema(); 1797 } 1798 } 1799 } 1800 1801 # Disconnect from the database 1802 $self->{dbh}->disconnect() if ($self->{dbh}); 1803} 1804 1805 1806sub _oracle_connection 1807{ 1808 my ($self, $quiet) = @_; 1809 1810 if (!defined $self->{oracle_pwd}) 1811 { 1812 eval("use Term::ReadKey;") unless $self->{oracle_user} eq '/'; 1813 $self->{oracle_user} = $self->_ask_username('Oracle') unless (defined $self->{oracle_user}); 1814 $self->{oracle_pwd} = $self->_ask_password('Oracle') unless ($self->{oracle_user} eq '/'); 1815 } 1816 my $ora_session_mode = ($self->{oracle_user} eq "/" || $self->{oracle_user} eq "sys") ? 2 : undef; 1817 1818 $self->logit("ORACLE_HOME = $ENV{ORACLE_HOME}\n", 1); 1819 $self->logit("NLS_LANG = $ENV{NLS_LANG}\n", 1); 1820 $self->logit("NLS_NCHAR = $ENV{NLS_NCHAR}\n", 1); 1821 $self->logit("Trying to connect to database: $self->{oracle_dsn}\n", 1) if (!$quiet); 1822 1823 my $dbh = DBI->connect($self->{oracle_dsn}, $self->{oracle_user}, $self->{oracle_pwd}, 1824 { 1825 ora_envhp => 0, 1826 LongReadLen=>$self->{longreadlen}, 1827 LongTruncOk=>$self->{longtruncok}, 1828 AutoInactiveDestroy => 1, 1829 PrintError => 0, 1830 ora_session_mode => $ora_session_mode, 1831 ora_client_info => 'ora2pg ' || $VERSION 1832 } 1833 ); 1834 1835 # Check for connection failure 1836 if (!$dbh) { 1837 $self->logit("FATAL: $DBI::err ... $DBI::errstr\n", 0, 1); 1838 } 1839 1840 # Get Oracle version, needed to set date/time format 1841 my $sth = $dbh->prepare( "SELECT BANNER FROM v\$version" ) or return undef; 1842 $sth->execute or return undef; 1843 while ( my @row = $sth->fetchrow()) { 1844 $self->{db_version} = $row[0]; 1845 last; 1846 } 1847 $sth->finish(); 1848 chomp($self->{db_version}); 1849 $self->{db_version} =~ s/ \- .*//; 1850 1851 # Check if the connection user has the DBA privilege 1852 $sth = $dbh->prepare( "SELECT 1 FROM DBA_ROLE_PRIVS" ); 1853 if (!$sth) { 1854 my $ret = $dbh->err; 1855 if ($ret == 942 && $self->{prefix} eq 'DBA') { 1856 $self->logit("HINT: you should activate USER_GRANTS for a connection without DBA privilege. Continuing with USER privilege.\n"); 1857 # No DBA privilege, set use of ALL_* tables instead of DBA_* tables 1858 $self->{prefix} = 'ALL'; 1859 $self->{user_grants} = 1; 1860 } 1861 } else { 1862 $sth->finish(); 1863 } 1864 1865 # Fix a problem when exporting type LONG and LOB 1866 $dbh->{'LongReadLen'} = $self->{longreadlen}; 1867 $dbh->{'LongTruncOk'} = $self->{longtruncok}; 1868 # Embedded object (user defined type) must be returned as an 1869 # array rather than an instance. This is normally the default. 1870 $dbh->{'ora_objects'} = 0; 1871 1872 # Force datetime format 1873 $self->_datetime_format($dbh); 1874 # Force numeric format 1875 $self->_numeric_format($dbh); 1876 1877 # Use consistent reads for concurrent dumping... 1878 $dbh->begin_work || $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 1879 if ($self->{debug} && !$quiet) { 1880 $self->logit("Isolation level: $self->{transaction}\n", 1); 1881 } 1882 $sth = $dbh->prepare($self->{transaction}) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 1883 $sth->execute or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 1884 $sth->finish; 1885 1886 # Force execution of initial command 1887 $self->_ora_initial_command($dbh); 1888 1889 return $dbh; 1890} 1891 1892sub _mysql_connection 1893{ 1894 my ($self, $quiet) = @_; 1895 1896 use Ora2Pg::MySQL; 1897 1898 $self->logit("Trying to connect to database: $self->{oracle_dsn}\n", 1) if (!$quiet); 1899 1900 if (!defined $self->{oracle_pwd}) 1901 { 1902 eval("use Term::ReadKey;"); 1903 $self->{oracle_user} = $self->_ask_username('MySQL') unless (defined $self->{oracle_user}); 1904 $self->{oracle_pwd} = $self->_ask_password('MySQL'); 1905 } 1906 1907 my $dbh = DBI->connect("$self->{oracle_dsn}", $self->{oracle_user}, $self->{oracle_pwd}, { 1908 'RaiseError' => 1, 1909 AutoInactiveDestroy => 1, 1910 mysql_enable_utf8 => 1, 1911 mysql_conn_attrs => { program_name => 'ora2pg ' || $VERSION } 1912 } 1913 ); 1914 1915 # Check for connection failure 1916 if (!$dbh) { 1917 $self->logit("FATAL: $DBI::err ... $DBI::errstr\n", 0, 1); 1918 } 1919 1920 # Use consistent reads for concurrent dumping... 1921 #$dbh->do('START TRANSACTION WITH CONSISTENT SNAPSHOT;') || $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 1922 if ($self->{debug} && !$quiet) { 1923 $self->logit("Isolation level: $self->{transaction}\n", 1); 1924 } 1925 my $sth = $dbh->prepare($self->{transaction}) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 1926 $sth->execute or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 1927 $sth->finish; 1928 1929 # Get SQL_MODE from the MySQL database 1930 $sth = $dbh->prepare('SELECT @@sql_mode') or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 1931 $sth->execute or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 1932 while (my $row = $sth->fetch) { 1933 $self->{mysql_mode} = $row->[0]; 1934 } 1935 $sth->finish; 1936 1937 if ($self->{nls_lang}) { 1938 if ($self->{debug} && !$quiet) { 1939 $self->logit("Set default encoding to '$self->{nls_lang}' and collate to '$self->{nls_nchar}'\n", 1); 1940 } 1941 my $collate = ''; 1942 $collate = " COLLATE '$self->{nls_nchar}'" if ($self->{nls_nchar}); 1943 $sth = $dbh->prepare("SET NAMES '$self->{nls_lang}'$collate") or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 1944 $sth->execute or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 1945 $sth->finish; 1946 } 1947 # Force execution of initial command 1948 $self->_ora_initial_command($dbh); 1949 1950 if ($self->{mysql_mode} =~ /PIPES_AS_CONCAT/) { 1951 $self->{mysql_pipes_as_concat} = 1; 1952 } 1953 1954 # Instruct Ora2Pg that the database engine is mysql 1955 $self->{is_mysql} = 1; 1956 1957 return $dbh; 1958} 1959 1960# use to set encoding 1961sub _init_environment 1962{ 1963 my ($self) = @_; 1964 1965 # Set default Oracle client encoding 1966 if (!$self->{nls_lang}) { 1967 if (!$self->{is_mysql}) { 1968 $self->{nls_lang} = 'AMERICAN_AMERICA.AL32UTF8'; 1969 } else { 1970 $self->{nls_lang} = 'utf8'; 1971 } 1972 } 1973 if (!$self->{nls_nchar}) { 1974 if (!$self->{is_mysql}) { 1975 $self->{nls_nchar} = 'AL32UTF8'; 1976 } else { 1977 $self->{nls_nchar} = 'utf8_general_ci'; 1978 } 1979 } 1980 $ENV{NLS_LANG} = $self->{nls_lang}; 1981 $ENV{NLS_NCHAR} = $self->{nls_nchar}; 1982 1983 # Force Perl to use utf8 I/O encoding by default or the 1984 # encoding given in the BINMODE configuration directive. 1985 # See http://perldoc.perl.org/5.14.2/open.html for values 1986 # that can be used. Default is :utf8 1987 $self->set_binmode(); 1988 1989 # Set default PostgreSQL client encoding to UTF8 1990 if (!$self->{client_encoding} || ($self->{nls_lang} =~ /UTF8/) ) { 1991 $self->{client_encoding} = 'UTF8'; 1992 } 1993 1994} 1995 1996sub set_binmode 1997{ 1998 my $self = shift; 1999 2000 my ($package, $filename, $line) = caller; 2001 2002 if ( !$self->{input_file} && (!$self->{'binmode'} || $self->{nls_lang} =~ /UTF8/i) ) { 2003 use open ':utf8'; 2004 } elsif ($self->{'binmode'} =~ /^:/) { 2005 eval "use open '$self->{'binmode'}';" or die "FATAL: can't use open layer $self->{'binmode'}\n"; 2006 } elsif ($self->{'binmode'}) { 2007 eval "use open 'encoding($self->{'binmode'})';" or die "FATAL: can't use open layer :encoding($self->{'binmode'})\n"; 2008 } 2009 # Set default PostgreSQL client encoding to UTF8 2010 if (!$self->{client_encoding} || ($self->{nls_lang} =~ /UTF8/ && !$self->{input_file}) ) { 2011 $self->{client_encoding} = 'UTF8'; 2012 } 2013 2014 if ($#_ == 0) { 2015 my $enc = $self->{'binmode'} || 'utf8'; 2016 $enc =~ s/^://; 2017 binmode($_[0], ":encoding($enc)"); 2018 } 2019 2020} 2021 2022sub _is_utf8_file 2023{ 2024 2025 my $file = shift(); 2026 2027 my $utf8 = 0; 2028 if (open(my $f, '<', $file)) { 2029 local $/; 2030 my $data = <$f>; 2031 close($f); 2032 if (utf8::decode($data)) { 2033 $utf8 = 1 2034 } 2035 } 2036 2037 return $utf8; 2038} 2039 2040# We provide a DESTROY method so that the autoloader doesn't 2041# bother trying to find it. We also close the DB connexion 2042sub DESTROY 2043{ 2044 my $self = shift; 2045 2046 #$self->{dbh}->disconnect() if ($self->{dbh}); 2047 2048} 2049 2050 2051sub set_pg_conn_details 2052{ 2053 my $self = shift; 2054 2055 # Init connection details with configuration options 2056 $self->{pg_dsn} ||= ''; 2057 2058 $self->{pg_dsn} =~ /dbname=([^;]*)/; 2059 $self->{dbname} = $1 || 'testdb'; 2060 $self->{pg_dsn} =~ /host=([^;]*)/; 2061 $self->{dbhost} = $1 || 'localhost'; 2062 $self->{pg_dsn} =~ /port=([^;]*)/; 2063 $self->{dbport} = $1 || 5432; 2064 $self->{dbuser} = $self->{pg_user} || 'pguser'; 2065 $self->{dbpwd} = $self->{pg_pwd} || 'pgpwd'; 2066 2067 if (!$self->{dblink_conn}) { 2068 #$self->{dblink_conn} = "port=$self->{dbport} dbname=$self->{dbname} host=$self->{dbhost} user=$self->{dbuser} password=$self->{dbpwd}"; 2069 # Use a more generic connection string, the password must be 2070 # set in .pgpass. Default is to use unix socket to connect. 2071 $self->{dblink_conn} = "format('port=%s dbname=%s user=%s', current_setting('port'), current_database(), current_user)"; 2072 } 2073} 2074 2075 2076=head2 _send_to_pgdb 2077 2078Open a DB handle to a PostgreSQL database 2079 2080=cut 2081 2082sub _send_to_pgdb 2083{ 2084 my ($self) = @_; 2085 2086 eval("use DBD::Pg qw(:pg_types);"); 2087 2088 return if ($self->{oracle_speed}); 2089 2090 if (!defined $self->{pg_pwd}) 2091 { 2092 eval("use Term::ReadKey;"); 2093 $self->{pg_user} = $self->_ask_username('PostgreSQL') unless (defined($self->{pg_user})); 2094 $self->{pg_pwd} = $self->_ask_password('PostgreSQL'); 2095 } 2096 2097 $ENV{PGAPPNAME} = 'ora2pg ' || $VERSION; 2098 2099 # Connect the destination database 2100 my $dbhdest = DBI->connect($self->{pg_dsn}, $self->{pg_user}, $self->{pg_pwd}, {AutoInactiveDestroy => 1}); 2101 2102 # Check for connection failure 2103 if (!$dbhdest) { 2104 $self->logit("FATAL: $DBI::err ... $DBI::errstr\n", 0, 1); 2105 } 2106 2107 # Force execution of initial command 2108 $self->_pg_initial_command($dbhdest); 2109 2110 return $dbhdest; 2111} 2112 2113=head2 _grants 2114 2115This function is used to retrieve all privilege information. 2116 2117It extracts all Oracle's ROLES to convert them to Postgres groups (or roles) 2118and searches all users associated to these roles. 2119 2120=cut 2121 2122sub _grants 2123{ 2124 my ($self) = @_; 2125 2126 $self->logit("Retrieving users/roles/grants information...\n", 1); 2127 ($self->{grants}, $self->{roles}) = $self->_get_privilege(); 2128} 2129 2130 2131=head2 _sequences 2132 2133This function is used to retrieve all sequences information. 2134 2135=cut 2136 2137sub _sequences 2138{ 2139 my ($self) = @_; 2140 2141 $self->logit("Retrieving sequences information...\n", 1); 2142 $self->{sequences} = $self->_get_sequences(); 2143 2144} 2145 2146 2147=head2 _triggers 2148 2149This function is used to retrieve all triggers information. 2150 2151=cut 2152 2153sub _triggers 2154{ 2155 my ($self) = @_; 2156 2157 $self->logit("Retrieving triggers information...\n", 1); 2158 $self->{triggers} = $self->_get_triggers(); 2159} 2160 2161 2162=head2 _functions 2163 2164This function is used to retrieve all functions information. 2165 2166=cut 2167 2168sub _functions 2169{ 2170 my $self = shift; 2171 2172 $self->logit("Retrieving functions information...\n", 1); 2173 $self->{functions} = $self->_get_functions(); 2174 2175} 2176 2177=head2 _procedures 2178 2179This function is used to retrieve all procedures information. 2180 2181=cut 2182 2183sub _procedures 2184{ 2185 my $self = shift; 2186 2187 $self->logit("Retrieving procedures information...\n", 1); 2188 2189 $self->{procedures} = $self->_get_procedures(); 2190 2191} 2192 2193 2194=head2 _packages 2195 2196This function is used to retrieve all packages information. 2197 2198=cut 2199 2200sub _packages 2201{ 2202 my ($self) = @_; 2203 2204 $self->logit("Retrieving packages information...\n", 1); 2205 $self->{packages} = $self->_get_packages(); 2206 2207} 2208 2209 2210=head2 _types 2211 2212This function is used to retrieve all custom types information. 2213 2214=cut 2215 2216sub _types 2217{ 2218 my ($self) = @_; 2219 2220 $self->logit("Retrieving user defined types information...\n", 1); 2221 $self->{types} = $self->_get_types(); 2222 2223} 2224 2225=head2 _tables 2226 2227This function is used to retrieve all table information. 2228 2229Sets the main hash of the database structure $self->{tables}. 2230Keys are the names of all tables retrieved from the current 2231database. Each table information is composed of an array associated 2232to the table_info key as array reference. In other way: 2233 2234 $self->{tables}{$class_name}{table_info} = [(OWNER,TYPE,COMMENT,NUMROW)]; 2235 2236DBI TYPE can be TABLE, VIEW, SYSTEM TABLE, GLOBAL TEMPORARY, LOCAL TEMPORARY, 2237ALIAS, SYNONYM or a data source specific type identifier. This only extracts 2238the TABLE type. 2239 2240It also gets the following information in the DBI object to affect the 2241main hash of the database structure : 2242 2243 $self->{tables}{$class_name}{field_name} = $sth->{NAME}; 2244 $self->{tables}{$class_name}{field_type} = $sth->{TYPE}; 2245 2246It also calls these other private subroutines to affect the main hash 2247of the database structure : 2248 2249 @{$self->{tables}{$class_name}{column_info}} = $self->_column_info($class_name, $owner, 'TABLE'); 2250 %{$self->{tables}{$class_name}{unique_key}} = $self->_unique_key($class_name, $owner); 2251 @{$self->{tables}{$class_name}{foreign_key}} = $self->_foreign_key($class_name, $owner); 2252 %{$self->{tables}{$class_name}{check_constraint}} = $self->_check_constraint($class_name, $owner); 2253 2254=cut 2255 2256sub sort_view_by_iter 2257{ 2258 2259 if (exists $ordered_views{$a}{iter} || exists $ordered_views{$b}{iter}) { 2260 return $ordered_views{$a}{iter} <=> $ordered_views{$b}{iter}; 2261 } else { 2262 return $a cmp $b; 2263 } 2264} 2265 2266sub _tables 2267{ 2268 my ($self, $nodetail) = @_; 2269 2270 # Get all tables information specified by the DBI method table_info 2271 $self->logit("Retrieving table information...\n", 1); 2272 2273 # Retrieve tables informations 2274 my %tables_infos = $self->_table_info(); 2275 2276 # Retrieve column identity information 2277 if ($self->{type} ne 'FDW') 2278 { 2279 %{ $self->{identity_info} } = $self->_get_identities(); 2280 } 2281 2282 if (scalar keys %tables_infos > 0) 2283 { 2284 if ( grep(/^$self->{type}$/, 'TABLE','SHOW_REPORT','COPY','INSERT') 2285 && !$self->{skip_indices} && !$self->{skip_indexes}) 2286 { 2287 $self->logit("Retrieving index information...\n", 1); 2288 my $autogen = 0; 2289 $autogen = 1 if (grep(/^$self->{type}$/, 'COPY','INSERT')); 2290 my ($uniqueness, $indexes, $idx_type, $idx_tbsp) = $self->_get_indexes('',$self->{schema}, $autogen); 2291 foreach my $tb (keys %{$indexes}) 2292 { 2293 next if (!exists $tables_infos{$tb}); 2294 %{$self->{tables}{$tb}{indexes}} = %{$indexes->{$tb}}; 2295 } 2296 foreach my $tb (keys %{$idx_type}) { 2297 next if (!exists $tables_infos{$tb}); 2298 %{$self->{tables}{$tb}{idx_type}} = %{$idx_type->{$tb}}; 2299 } 2300 foreach my $tb (keys %{$idx_tbsp}) { 2301 next if (!exists $tables_infos{$tb}); 2302 %{$self->{tables}{$tb}{idx_tbsp}} = %{$idx_tbsp->{$tb}}; 2303 } 2304 foreach my $tb (keys %{$uniqueness}) { 2305 next if (!exists $tables_infos{$tb}); 2306 %{$self->{tables}{$tb}{uniqueness}} = %{$uniqueness->{$tb}}; 2307 } 2308 } 2309 2310 # Get detailed informations on each tables 2311 if (!$nodetail) 2312 { 2313 $self->logit("Retrieving columns information...\n", 1); 2314 # Retrieve all column's details 2315 my %columns_infos = $self->_column_info('',$self->{schema}, 'TABLE'); 2316 foreach my $tb (keys %columns_infos) 2317 { 2318 next if (!exists $tables_infos{$tb}); 2319 foreach my $c (keys %{$columns_infos{$tb}}) { 2320 push(@{$self->{tables}{$tb}{column_info}{$c}}, @{$columns_infos{$tb}{$c}}); 2321 } 2322 } 2323 %columns_infos = (); 2324 2325 # Retrieve comment of each columns and FK information if not foreign table export 2326 if ($self->{type} ne 'FDW' and !$self->{oracle_fdw_data_export}) 2327 { 2328 if ($self->{type} eq 'TABLE') 2329 { 2330 $self->logit("Retrieving comments information...\n", 1); 2331 my %columns_comments = $self->_column_comments(); 2332 foreach my $tb (keys %columns_comments) 2333 { 2334 next if (!exists $tables_infos{$tb}); 2335 foreach my $c (keys %{$columns_comments{$tb}}) { 2336 $self->{tables}{$tb}{column_comments}{$c} = $columns_comments{$tb}{$c}; 2337 } 2338 } 2339 } 2340 2341 # Extract foreign keys informations 2342 if (!$self->{skip_fkeys}) 2343 { 2344 $self->logit("Retrieving foreign keys information...\n", 1); 2345 my ($foreign_link, $foreign_key) = $self->_foreign_key('',$self->{schema}); 2346 foreach my $tb (keys %{$foreign_link}) { 2347 next if (!exists $tables_infos{$tb}); 2348 %{$self->{tables}{$tb}{foreign_link}} = %{$foreign_link->{$tb}}; 2349 } 2350 foreach my $tb (keys %{$foreign_key}) { 2351 next if (!exists $tables_infos{$tb}); 2352 push(@{$self->{tables}{$tb}{foreign_key}}, @{$foreign_key->{$tb}}); 2353 } 2354 } 2355 } 2356 } 2357 2358 # Retrieve unique keys and check constraint information if not FDW export 2359 if ($self->{type} ne 'FDW' and !$self->{oracle_fdw_data_export}) 2360 { 2361 $self->logit("Retrieving unique keys information...\n", 1); 2362 my %unique_keys = $self->_unique_key('',$self->{schema}); 2363 foreach my $tb (keys %unique_keys) 2364 { 2365 next if (!exists $tables_infos{$tb}); 2366 foreach my $c (keys %{$unique_keys{$tb}}) { 2367 $self->{tables}{$tb}{unique_key}{$c} = $unique_keys{$tb}{$c}; 2368 } 2369 } 2370 %unique_keys = (); 2371 2372 if (!$self->{skip_checks} && !$self->{is_mysql}) 2373 { 2374 $self->logit("Retrieving check constraints information...\n", 1); 2375 my %check_constraints = $self->_check_constraint('',$self->{schema}); 2376 foreach my $tb (keys %check_constraints) { 2377 next if (!exists $tables_infos{$tb}); 2378 %{$self->{tables}{$tb}{check_constraint}} = ( %{$check_constraints{$tb}}); 2379 } 2380 } 2381 2382 } 2383 } 2384 2385 my @done = (); 2386 my $id = 0; 2387 # Set the table information for each class found 2388 my $i = 1; 2389 my $num_total_table = scalar keys %tables_infos; 2390 my $count_table = 0; 2391 my $PGBAR_REFRESH = set_refresh_count($num_total_table); 2392 foreach my $t (sort keys %tables_infos) 2393 { 2394 if (!$self->{quiet} && !$self->{debug} && ($count_table % $PGBAR_REFRESH) == 0) 2395 { 2396 print STDERR $self->progress_bar($i, $num_total_table, 25, '=', 'tables', "scanning table $t" ), "\r"; 2397 } 2398 $count_table++; 2399 2400 if (grep(/^$t$/, @done)) { 2401 $self->logit("Duplicate entry found: $t\n", 1); 2402 } else { 2403 push(@done, $t); 2404 } 2405 $self->logit("[$i] Scanning table $t ($tables_infos{$t}{num_rows} rows)...\n", 1); 2406 2407 # Check of uniqueness of the table 2408 if (exists $self->{tables}{$t}{field_name}) { 2409 $self->logit("Warning duplicate table $t, maybe a SYNONYM ? Skipped.\n", 1); 2410 next; 2411 } 2412 # Try to respect order specified in the TABLES limited extraction array 2413 if ($#{$self->{limited}{TABLE}} > 0) 2414 { 2415 $self->{tables}{$t}{internal_id} = 0; 2416 for (my $j = 0; $j <= $#{$self->{limited}{TABLE}}; $j++) 2417 { 2418 if (uc($self->{limited}{TABLE}->[$j]) eq uc($t)) 2419 { 2420 $self->{tables}{$t}{internal_id} = $j; 2421 last; 2422 } 2423 } 2424 } 2425 2426 # usually TYPE,COMMENT,NUMROW,... 2427 $self->{tables}{$t}{table_info}{type} = $tables_infos{$t}{type}; 2428 $self->{tables}{$t}{table_info}{comment} = $tables_infos{$t}{comment}; 2429 $self->{tables}{$t}{table_info}{num_rows} = $tables_infos{$t}{num_rows}; 2430 $self->{tables}{$t}{table_info}{owner} = $tables_infos{$t}{owner}; 2431 $self->{tables}{$t}{table_info}{tablespace} = $tables_infos{$t}{tablespace}; 2432 $self->{tables}{$t}{table_info}{nested} = $tables_infos{$t}{nested}; 2433 $self->{tables}{$t}{table_info}{size} = $tables_infos{$t}{size}; 2434 $self->{tables}{$t}{table_info}{auto_increment} = $tables_infos{$t}{auto_increment}; 2435 $self->{tables}{$t}{table_info}{connection} = $tables_infos{$t}{connection}; 2436 $self->{tables}{$t}{table_info}{nologging} = $tables_infos{$t}{nologging}; 2437 $self->{tables}{$t}{table_info}{partitioned} = $tables_infos{$t}{partitioned}; 2438 if (exists $tables_infos{$t}{fillfactor}) { 2439 $self->{tables}{$t}{table_info}{fillfactor} = $tables_infos{$t}{fillfactor}; 2440 } 2441 2442 # Set the fields information 2443 if ($self->{type} ne 'SHOW_REPORT') 2444 { 2445 my $tmp_tbname = $t; 2446 if (!$self->{is_mysql}) 2447 { 2448 if ( $t !~ /\./ ) { 2449 $tmp_tbname = "\"$tables_infos{$t}{owner}\".\"$t\""; 2450 } else { 2451 # in case we already have the schema name, add doublequote 2452 $tmp_tbname =~ s/\./"."/; 2453 $tmp_tbname = "\"$tmp_tbname\""; 2454 } 2455 } 2456 my $query = "SELECT * FROM $tmp_tbname WHERE 1=0"; 2457 if ($tables_infos{$t}{nested} eq 'YES') { 2458 $query = "SELECT /*+ nested_table_get_refs */ * FROM $tmp_tbname WHERE 1=0"; 2459 } 2460 my $sth = $self->{dbh}->prepare($query); 2461 if (!defined($sth)) { 2462 warn "Can't prepare statement: $DBI::errstr"; 2463 next; 2464 } 2465 $sth->execute; 2466 if ($sth->err) { 2467 warn "Can't execute statement: $DBI::errstr"; 2468 next; 2469 } 2470 $self->{tables}{$t}{type} = 'table'; 2471 $self->{tables}{$t}{field_name} = $sth->{NAME}; 2472 $self->{tables}{$t}{field_type} = $sth->{TYPE}; 2473 } 2474 $i++; 2475 } 2476 2477 if (!$self->{quiet} && !$self->{debug}) { 2478 print STDERR $self->progress_bar($i - 1, $num_total_table, 25, '=', 'tables', 'end of scanning.'), "\n"; 2479 } 2480 2481 # Try to search requested TABLE names in the VIEW names if not found in 2482 # real TABLE names 2483 if ($#{$self->{view_as_table}} >= 0) 2484 { 2485 my %view_infos = $self->_get_views(); 2486 # Retrieve comment of each columns 2487 my %columns_comments = $self->_column_comments(); 2488 foreach my $view (keys %columns_comments) 2489 { 2490 next if (!exists $view_infos{$view}); 2491 next if (!grep($view =~ /^$_$/i, @{$self->{view_as_table}})); 2492 foreach my $c (keys %{$columns_comments{$view}}) { 2493 $self->{tables}{$view}{column_comments}{$c} = $columns_comments{$view}{$c}; 2494 } 2495 } 2496 foreach my $view (sort keys %view_infos) 2497 { 2498 # Set the table information for each class found 2499 # Jump to desired extraction 2500 next if (!grep($view =~ /^$_$/i, @{$self->{view_as_table}})); 2501 $self->logit("Scanning view $view to export as table...\n", 0); 2502 2503 $self->{tables}{$view}{type} = 'view'; 2504 $self->{tables}{$view}{text} = $view_infos{$view}{text}; 2505 $self->{tables}{$view}{owner} = $view_infos{$view}{owner}; 2506 $self->{tables}{$view}{iter} = $view_infos{$view}{iter} if (exists $view_infos{$view}{iter}); 2507 $self->{tables}{$view}{alias}= $view_infos{$view}{alias}; 2508 $self->{tables}{$view}{comment} = $view_infos{$view}{comment}; 2509 my $realview = $view; 2510 $realview =~ s/"//g; 2511 if (!$self->{is_mysql}) 2512 { 2513 if ($realview !~ /\./) { 2514 $realview = "\"$self->{tables}{$view}{owner}\".\"$realview\""; 2515 } else { 2516 $realview =~ s/\./"."/; 2517 $realview = "\"$realview\""; 2518 } 2519 2520 } 2521 # Set the fields information 2522 my $sth = $self->{dbh}->prepare("SELECT * FROM $realview WHERE 1=0"); 2523 if (!defined($sth)) 2524 { 2525 warn "Can't prepare statement: $DBI::errstr"; 2526 next; 2527 } 2528 $sth->execute; 2529 if ($sth->err) 2530 { 2531 warn "Can't execute statement: $DBI::errstr"; 2532 next; 2533 } 2534 $self->{tables}{$view}{field_name} = $sth->{NAME}; 2535 $self->{tables}{$view}{field_type} = $sth->{TYPE}; 2536 my %columns_infos = $self->_column_info($view, $self->{schema}, 'VIEW'); 2537 foreach my $tb (keys %columns_infos) 2538 { 2539 next if ($tb ne $view); 2540 foreach my $c (keys %{$columns_infos{$tb}}) { 2541 push(@{$self->{tables}{$view}{column_info}{$c}}, @{$columns_infos{$tb}{$c}}); 2542 } 2543 } 2544 } 2545 } 2546 2547 # Look at external tables 2548 if (!$self->{is_mysql} && ($self->{db_version} !~ /Release 8/)) { 2549 %{$self->{external_table}} = $self->_get_external_tables(); 2550 } 2551 2552 if ($self->{type} eq 'TABLE') 2553 { 2554 $self->logit("Retrieving table partitioning information...\n", 0); 2555 %{ $self->{partitions_list} } = $self->_get_partitioned_table(); 2556 } 2557} 2558 2559sub _get_plsql_code 2560{ 2561 my $str = shift(); 2562 2563 my $ct = ''; 2564 my @parts = split(/\b(BEGIN|DECLARE|END\s*(?!IF|LOOP|CASE|INTO|FROM|,|\))[^;\s]*\s*;)/i, $str); 2565 my $code = ''; 2566 my $other = ''; 2567 my $i = 0; 2568 for (; $i <= $#parts; $i++) 2569 { 2570 $ct++ if ($parts[$i] =~ /\bBEGIN\b/i); 2571 $ct-- if ($parts[$i] =~ /\bEND\s*(?!IF|LOOP|CASE|INTO|FROM|,|\))[^;\s]*\s*;/i); 2572 if ( ($ct ne '') && ($ct == 0) ) { 2573 $code .= $parts[$i]; 2574 last; 2575 } 2576 $code .= $parts[$i]; 2577 } 2578 $i++; 2579 for (; $i <= $#parts; $i++) { 2580 $other .= $parts[$i]; 2581 } 2582 2583 return ($code, $other); 2584} 2585 2586sub _parse_constraint 2587{ 2588 my ($self, $tb_name, $cur_col_name, $c) = @_; 2589 2590 if ($c =~ /^([^\s]+)\s+(UNIQUE|PRIMARY KEY)\s*\(([^\)]+)\)/is) 2591 { 2592 my $tp = 'U'; 2593 $tp = 'P' if ($2 eq 'PRIMARY KEY'); 2594 $self->{tables}{$tb_name}{unique_key}{$1} = { ( 2595 type => $tp, 'generated' => 0, 'index_name' => $1, 2596 columns => () 2597 ) }; 2598 push(@{$self->{tables}{$tb_name}{unique_key}{$1}{columns}}, split(/\s*,\s*/, $3)); 2599 } 2600 elsif ($c =~ /^([^\s]+)\s+CHECK\s*\((.*)\)/is) 2601 { 2602 my $name = $1; 2603 my $desc = $2; 2604 if ($desc =~ /^([a-z_\$0-9]+)\b/i) { 2605 $name .= "_$1"; 2606 } 2607 my %tmp = ($name => $desc); 2608 $self->{tables}{$tb_name}{check_constraint}{constraint}{$name}{condition} = $desc; 2609 if ($c =~ /NOVALIDATE/is) { 2610 $self->{tables}{$tb_name}{check_constraint}{constraint}{$name}{validate} = 'NOT VALIDATED'; 2611 } 2612 } 2613 elsif ($c =~ /^([^\s]+)\s+FOREIGN KEY (\([^\)]+\))?\s*REFERENCES ([^\(\s]+)\s*\(([^\)]+)\)/is) 2614 { 2615 my $c_name = $1; 2616 if ($2) { 2617 $cur_col_name = $2; 2618 } 2619 my $f_tb_name = $3; 2620 my @col_list = split(/,/, $4); 2621 $c_name =~ s/"//g; 2622 $f_tb_name =~ s/"//g; 2623 $cur_col_name =~ s/[\("\)]//g; 2624 map { s/"//g; } @col_list; 2625 if (!$self->{export_schema}) { 2626 $f_tb_name =~ s/^[^\.]+\.//; 2627 map { s/^[^\.]+\.//; } @col_list; 2628 } 2629 push(@{$self->{tables}{$tb_name}{foreign_link}{"\U$c_name\E"}{local}}, $cur_col_name); 2630 push(@{$self->{tables}{$tb_name}{foreign_link}{"\U$c_name\E"}{remote}{$f_tb_name}}, @col_list); 2631 my $deferrable = ''; 2632 $deferrable = 'DEFERRABLE' if ($c =~ /DEFERRABLE/); 2633 my $deferred = ''; 2634 $deferred = 'DEFERRED' if ($c =~ /INITIALLY DEFERRED/); 2635 my $novalidate = ''; 2636 $novalidate = 'NOT VALIDATED' if ($c =~ /NOVALIDATE/); 2637 # CONSTRAINT_NAME,R_CONSTRAINT_NAME,SEARCH_CONDITION,DELETE_RULE,$deferrable,DEFERRED,R_OWNER,TABLE_NAME,OWNER,UPDATE_RULE,VALIDATED 2638 push(@{$self->{tables}{$tb_name}{foreign_key}}, [ ($c_name,'','','',$deferrable,$deferred,'',$tb_name,'','',$novalidate) ]); 2639 } 2640} 2641 2642sub _remove_text_constant_part 2643{ 2644 my ($self, $str) = @_; 2645 2646 for (my $i = 0; $i <= $#{$self->{alternative_quoting_regexp}}; $i++) { 2647 while ($$str =~ s/$self->{alternative_quoting_regexp}[$i]/\?TEXTVALUE$self->{text_values_pos}\?/s) { 2648 $self->{text_values}{$self->{text_values_pos}} = '$$' . $1 . '$$'; 2649 $self->{text_values_pos}++; 2650 } 2651 } 2652 2653 $$str =~ s/\\'/ORA2PG_ESCAPE1_QUOTE'/gs; 2654 while ($$str =~ s/''/ORA2PG_ESCAPE2_QUOTE/gs) {} 2655 2656 while ($$str =~ s/('[^']+')/\?TEXTVALUE$self->{text_values_pos}\?/s) { 2657 $self->{text_values}{$self->{text_values_pos}} = $1; 2658 $self->{text_values_pos}++; 2659 } 2660 2661 for (my $i = 0; $i <= $#{$self->{string_constant_regexp}}; $i++) { 2662 while ($$str =~ s/($self->{string_constant_regexp}[$i])/\?TEXTVALUE$self->{text_values_pos}\?/s) { 2663 $self->{text_values}{$self->{text_values_pos}} = $1; 2664 $self->{text_values_pos}++; 2665 } 2666 } 2667} 2668 2669sub _restore_text_constant_part 2670{ 2671 my ($self, $str) = @_; 2672 2673 $$str =~ s/\?TEXTVALUE(\d+)\?/$self->{text_values}{$1}/gs; 2674 $$str =~ s/ORA2PG_ESCAPE2_QUOTE/''/gs; 2675 $$str =~ s/ORA2PG_ESCAPE1_QUOTE'/\\'/gs; 2676 2677 if ($self->{type} eq 'TRIGGER') { 2678 $$str =~ s/(\s+)(NEW|OLD)\.'([^']+)'/$1$2\.$3/igs; 2679 } 2680} 2681 2682sub _get_dml_from_file 2683{ 2684 my $self = shift; 2685 2686 # Load file in a single string 2687 my $content = $self->read_input_file($self->{input_file}); 2688 2689 $content =~ s/CREATE\s+OR\s+REPLACE/CREATE/gs; 2690 $content =~ s/CREATE\s+EDITIONABLE/CREATE/gs; 2691 $content =~ s/CREATE\s+NONEDITIONABLE/CREATE/gs; 2692 2693 if ($self->{is_mysql}) 2694 { 2695 $content =~ s/CREATE\s+ALGORITHM=[^\s]+/CREATE/gs; 2696 $content =~ s/CREATE\s+DEFINER=[^\s]+/CREATE/gs; 2697 $content =~ s/SQL SECURITY DEFINER VIEW/VIEW/gs; 2698 } 2699 2700 return $content; 2701} 2702 2703sub read_schema_from_file 2704{ 2705 my $self = shift; 2706 2707 # Load file in a single string 2708 my $content = $self->_get_dml_from_file(); 2709 2710 # Clear content from comment and text constant for better parsing 2711 $self->_remove_comments(\$content, 1); 2712 $content =~ s/\%ORA2PG_COMMENT\d+\%//gs; 2713 my $tid = 0; 2714 2715 my @statements = split(/\s*;\s*/, $content); 2716 2717 foreach $content (@statements) 2718 { 2719 $content .= ';'; 2720 2721 # Remove some unwanted and unused keywords from the statements 2722 $content =~ s/\s+(PARALLEL|COMPRESS)\b//igs; 2723 2724 if ($content =~ s/TRUNCATE TABLE\s+([^\s;]+)([^;]*);//is) 2725 { 2726 my $tb_name = $1; 2727 $tb_name =~ s/"//gs; 2728 if (!exists $self->{tables}{$tb_name}{table_info}{type}) 2729 { 2730 $self->{tables}{$tb_name}{table_info}{type} = 'TABLE'; 2731 $self->{tables}{$tb_name}{table_info}{num_rows} = 0; 2732 $tid++; 2733 $self->{tables}{$tb_name}{internal_id} = $tid; 2734 } 2735 $self->{tables}{$tb_name}{truncate_table} = 1; 2736 } 2737 elsif ($content =~ s/CREATE\s+(GLOBAL|PRIVATE)?\s*(TEMPORARY)?\s*TABLE[\s]+([^\s]+)\s+AS\s+([^;]+);//is) 2738 { 2739 my $tb_name = $3; 2740 $tb_name =~ s/"//gs; 2741 my $tb_def = $4; 2742 $tb_def =~ s/\s+/ /gs; 2743 $self->{tables}{$tb_name}{table_info}{type} = 'TEMPORARY ' if ($2); 2744 $self->{tables}{$tb_name}{table_info}{type} .= 'TABLE'; 2745 $self->{tables}{$tb_name}{table_info}{num_rows} = 0; 2746 $tid++; 2747 $self->{tables}{$tb_name}{internal_id} = $tid; 2748 $self->{tables}{$tb_name}{table_as} = $tb_def; 2749 } 2750 elsif ($content =~ s/CREATE\s+(GLOBAL|PRIVATE)?\s*(TEMPORARY)?\s*TABLE[\s]+([^\s\(]+)\s*([^;]+);//is) 2751 { 2752 my $tb_name = $3; 2753 my $tb_def = $4; 2754 my $tb_param = ''; 2755 $tb_name =~ s/"//gs; 2756 $self->{tables}{$tb_name}{table_info}{type} = 'TEMPORARY ' if ($2); 2757 $self->{tables}{$tb_name}{table_info}{type} .= 'TABLE'; 2758 $self->{tables}{$tb_name}{table_info}{num_rows} = 0; 2759 $tid++; 2760 $self->{tables}{$tb_name}{internal_id} = $tid; 2761 # For private temporary table extract the ON COMMIT information (18c) 2762 if ($tb_def =~ s/ON\s+COMMIT\s+PRESERVE\s+DEFINITION//is) 2763 { 2764 $self->{tables}{$tb_name}{table_info}{on_commit} = 'ON COMMIT PRESERVE ROWS'; 2765 } 2766 elsif ($tb_def =~ s/ON\s+COMMIT\s+DROP\s+DEFINITION//is) 2767 { 2768 $self->{tables}{$tb_name}{table_info}{on_commit} = 'ON COMMIT DROP'; 2769 } 2770 elsif ($self->{tables}{$tb_name}{table_info}{type} eq 'TEMPORARY ') 2771 { 2772 # Default for PRIVATE TEMPORARY TABLE 2773 $self->{tables}{$tb_name}{table_info}{on_commit} = 'ON COMMIT DROP'; 2774 } 2775 # Get table embedded comment 2776 if ($tb_def =~ s/COMMENT=["']([^"']+)["']//is) 2777 { 2778 $self->{tables}{$tb_name}{table_info}{comment} = $1; 2779 } 2780 $tb_def =~ s/^\(//; 2781 my %fct_placeholder = (); 2782 my $i = 0; 2783 while ($tb_def =~ s/(\([^\(\)]*\))/\%\%FCT$i\%\%/is) 2784 { 2785 $fct_placeholder{$i} = $1; 2786 $i++; 2787 }; 2788 ($tb_def, $tb_param) = split(/\s*\)\s*/, $tb_def); 2789 my @column_defs = split(/\s*,\s*/, $tb_def); 2790 map { s/^\s+//; s/\s+$//; } @column_defs; 2791 my $pos = 0; 2792 my $cur_c_name = ''; 2793 foreach my $c (@column_defs) 2794 { 2795 next if (!$c); 2796 2797 # Replace temporary substitution 2798 while ($c =~ s/\%\%FCT(\d+)\%\%/$fct_placeholder{$1}/is) { 2799 delete $fct_placeholder{$1}; 2800 } 2801 # Mysql unique key embedded definition, transform it to special parsing 2802 $c =~ s/^UNIQUE KEY/INDEX UNIQUE/is; 2803 # Remove things that are not possible with postgres 2804 $c =~ s/(PRIMARY KEY.*)NOT NULL/$1/is; 2805 # Rewrite some parts for easiest/generic parsing 2806 my $tbn = $tb_name; 2807 $tbn =~ s/\./_/gs; 2808 $c =~ s/^(PRIMARY KEY|UNIQUE)/CONSTRAINT o2pu_$tbn $1/is; 2809 $c =~ s/^(CHECK[^,;]+)DEFERRABLE\s+INITIALLY\s+DEFERRED/$1/is; 2810 $c =~ s/^CHECK\b/CONSTRAINT o2pc_$tbn CHECK/is; 2811 $c =~ s/^FOREIGN KEY/CONSTRAINT o2pf_$tbn FOREIGN KEY/is; 2812 2813 $c =~ s/\(\s+/\(/gs; 2814 2815 # register column name between double quote 2816 my $i = 0; 2817 my %col_name = (); 2818 # Get column name 2819 while ($c =~ s/("[^"]+")/\%\%COLNAME$i\%\%/s) 2820 { 2821 $col_name{$i} = $1; 2822 $i++; 2823 } 2824 if ($c =~ s/^\s*([^\s]+)\s*//s) 2825 { 2826 my $c_name = $1; 2827 $c_name =~ s/\%\%COLNAME(\d+)\%\%/$col_name{$1}/sg; 2828 $c =~ s/\%\%COLNAME(\d+)\%\%/$col_name{$1}/sg; 2829 if (!$self->{preserve_case}) { 2830 $c_name =~ s/"//gs; 2831 } 2832 # Retrieve all columns information 2833 if (!grep(/^\Q$c_name\E$/i, 'CONSTRAINT','INDEX')) 2834 { 2835 $cur_c_name = $c_name; 2836 $c_name =~ s/\./_/gs; 2837 my $c_default = ''; 2838 my $virt_col = 'NO'; 2839 $c =~ s/\s+ENABLE//is; 2840 if ($c =~ s/\bGENERATED\s+(ALWAYS|BY\s+DEFAULT)\s+(ON\s+NULL\s+)?AS\s+IDENTITY\s*(.*)//is) 2841 { 2842 $self->{identity_info}{$tb_name}{$c_name}{generation} = $1; 2843 my $options = $3; 2844 $self->{identity_info}{$tb_name}{$c_name}{options} = $3; 2845 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/(SCALE|EXTEND|SESSION)_FLAG: .//isg; 2846 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/KEEP_VALUE: .//is; 2847 2848 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/(START WITH):/$1/is; 2849 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/(INCREMENT BY):/$1/is; 2850 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/MAX_VALUE:/MAXVALUE/is; 2851 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/MIN_VALUE:/MINVALUE/is; 2852 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/CYCLE_FLAG: N/NO CYCLE/is; 2853 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/NOCYCLE/NO CYCLE/is; 2854 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/CYCLE_FLAG: Y/CYCLE/is; 2855 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/CACHE_SIZE:/CACHE/is; 2856 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/CACHE_SIZE:/CACHE/is; 2857 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/ORDER_FLAG: .//is; 2858 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/,//gs; 2859 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/\s$//s; 2860 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/CACHE\s+0/CACHE 1/is; 2861 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/\s*NOORDER//is; 2862 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/\s*NOKEEP//is; 2863 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/\s*NOSCALE//is; 2864 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/\s*NOT\s+NULL//is; 2865 # Be sure that we don't exceed the bigint max value, 2866 # we assume that the increment is always positive 2867 if ($self->{identity_info}{$tb_name}{$c_name}{options} =~ /MAXVALUE\s+(\d+)/is) { 2868 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/(MAXVALUE)\s+\d+/$1 9223372036854775807/is; 2869 } 2870 $self->{identity_info}{$tb_name}{$c_name}{options} =~ s/\s+/ /igs; 2871 } 2872 elsif ($c =~ s/\b(GENERATED ALWAYS AS|AS)\s+(.*)//is) 2873 { 2874 $virt_col = 'YES'; 2875 $c_default = $2; 2876 $c_default =~ s/\s+VIRTUAL//is; 2877 } 2878 my $c_type = ''; 2879 if ($c =~ s/^ENUM\s*(\([^\(\)]+\))\s*//is) 2880 { 2881 $c_type = 'varchar'; 2882 my $ck_name = 'o2pc_' . $c_name; 2883 $self->_parse_constraint($tb_name, $c_name, "$ck_name CHECK ($c_name IN $1)"); 2884 } elsif ($c =~ s/^([^\s\(]+)\s*//s) { 2885 $c_type = $1; 2886 } elsif ($c_default) 2887 { 2888 # Try to guess a type the virtual column was declared without one, 2889 # but always default to text and always display a warning. 2890 if ($c_default =~ /ROUND\s*\(/is) { 2891 $c_type = 'numeric'; 2892 } elsif ($c_default =~ /TO_DATE\s\(/is) { 2893 $c_type = 'timestamp'; 2894 } else { 2895 $c_type = 'text'; 2896 } 2897 print STDERR "WARNING: Virtual column $tb_name.$cur_c_name has no data type defined, using $c_type but you need to check that this is the right type.\n"; 2898 } 2899 else 2900 { 2901 next; 2902 } 2903 my $c_length = ''; 2904 my $c_scale = ''; 2905 if ($c =~ s/^\(([^\)]+)\)\s*//s) 2906 { 2907 $c_length = $1; 2908 if ($c_length =~ s/\s*,\s*(\d+)\s*//s) { 2909 $c_scale = $1; 2910 } 2911 } 2912 my $c_nullable = 1; 2913 if ($c =~ s/CONSTRAINT\s*([^\s]+)?\s*NOT NULL//s) { 2914 $c_nullable = 0; 2915 } elsif ($c =~ s/NOT NULL//) { 2916 $c_nullable = 0; 2917 } 2918 2919 if (($c =~ s/(UNIQUE|PRIMARY KEY)\s*\(([^\)]+)\)//is) || ($c =~ s/(UNIQUE|PRIMARY KEY)\s*//is)) 2920 { 2921 $c_name =~ s/\./_/gs; 2922 my $pk_name = 'o2pu_' . $c_name; 2923 my $cols = $c_name; 2924 if ($2) { 2925 $cols = $2; 2926 } 2927 $self->_parse_constraint($tb_name, $c_name, "$pk_name $1 ($cols)"); 2928 2929 } 2930 elsif ( ($c =~ s/CONSTRAINT\s([^\s]+)\sCHECK\s*\(([^\)]+)\)//is) || ($c =~ s/CHECK\s*\(([^\)]+)\)//is) ) 2931 { 2932 $c_name =~ s/\./_/gs; 2933 my $pk_name = 'o2pc_' . $c_name; 2934 my $chk_search = $1; 2935 if ($2) 2936 { 2937 $pk_name = $1; 2938 $chk_search = $2; 2939 } 2940 $chk_search .= $c if ($c eq ')'); 2941 $self->_parse_constraint($tb_name, $c_name, "$pk_name CHECK ($chk_search)"); 2942 } 2943 elsif ($c =~ s/REFERENCES\s+([^\(\s]+)\s*\(([^\)]+)\)//is) 2944 { 2945 2946 $c_name =~ s/\./_/gs; 2947 my $pk_name = 'o2pf_' . $c_name; 2948 my $chk_search = $1 . "($2)"; 2949 $chk_search =~ s/\s+//gs; 2950 $self->_parse_constraint($tb_name, $c_name, "$pk_name FOREIGN KEY ($c_name) REFERENCES $chk_search"); 2951 } 2952 2953 my $auto_incr = 0; 2954 if ($c =~ s/\s*AUTO_INCREMENT\s*//is) { 2955 $auto_incr = 1; 2956 } 2957 # At this stage only the DEFAULT part might be on the string 2958 if ($c =~ /\bDEFAULT\s+/is) 2959 { 2960 if ($c =~ s/\bDEFAULT\s+('[^']+')\s*//is) { 2961 $c_default = $1; 2962 } elsif ($c =~ s/\bDEFAULT\s+([^\s]+)\s*$//is) { 2963 $c_default = $1; 2964 } elsif ($c =~ s/\bDEFAULT\s+(.*)$//is) { 2965 $c_default = $1; 2966 } 2967 $c_default =~ s/"//gs; 2968 if ($self->{plsql_pgsql}) { 2969 $c_default = Ora2Pg::PLSQL::convert_plsql_code($self, $c_default); 2970 } 2971 } 2972 if ($c_type =~ /date|timestamp/i && $c_default =~ /'0000-00-00/) 2973 { 2974 if ($self->{replace_zero_date}) { 2975 $c_default = $self->{replace_zero_date}; 2976 } else { 2977 $c_default =~ s/^'0000-00-00/'1970-01-01/; 2978 } 2979 if ($c_default =~ /^[\-]*INFINITY$/) { 2980 $c_default .= "::$c_type"; 2981 } 2982 } 2983 # COLUMN_NAME,DATA_TYPE,DATA_LENGTH,NULLABLE,DATA_DEFAULT,DATA_PRECISION,DATA_SCALE,CHAR_LENGTH,TABLE_NAME,OWNER,VIRTUAL_COLUMN,POSITION,AUTO_INCREMENT,SRID,SDO_DIM,SDO_GTYPE 2984 push(@{$self->{tables}{$tb_name}{column_info}{$c_name}}, ($c_name, $c_type, $c_length, $c_nullable, $c_default, $c_length, $c_scale, $c_length, $tb_name, '', $virt_col, $pos, $auto_incr)); 2985 } 2986 elsif (uc($c_name) eq 'CONSTRAINT') 2987 { 2988 $self->_parse_constraint($tb_name, $cur_c_name, $c); 2989 } 2990 elsif (uc($c_name) eq 'INDEX') 2991 { 2992 if ($c =~ /^\s*UNIQUE\s+([^\s]+)\s+\(([^\)]+)\)/) 2993 { 2994 my $idx_name = $1; 2995 my @cols = (); 2996 push(@cols, split(/\s*,\s*/, $2)); 2997 map { s/^"//; s/"$//; } @cols; 2998 $self->{tables}{$tb_name}{unique_key}->{$idx_name}{type} = 'U'; 2999 $self->{tables}{$tb_name}{unique_key}->{$idx_name}{generated} = 0; 3000 $self->{tables}{$tb_name}{unique_key}->{$idx_name}{index_name} = $idx_name; 3001 push(@{$self->{tables}{$tb_name}{unique_key}->{$idx_name}{columns}}, @cols); 3002 } 3003 elsif ($c =~ /^\s*([^\s]+)\s+\(([^\)]+)\)/) 3004 { 3005 my $idx_name = $1; 3006 my @cols = (); 3007 push(@cols, split(/\s*,\s*/, $2)); 3008 map { s/^"//; s/"$//; } @cols; 3009 push(@{$self->{tables}{$tb_name}{indexes}{$idx_name}}, @cols); 3010 } 3011 } 3012 } 3013 else 3014 { 3015 $c =~ s/\%\%COLNAME(\d+)\%\%/$col_name{$1}/sg; 3016 } 3017 $pos++; 3018 } 3019 map {s/^/\t/; s/$/,\n/; } @column_defs; 3020 # look for storage information 3021 if ($tb_param =~ /TABLESPACE[\s]+([^\s]+)/is) { 3022 $self->{tables}{$tb_name}{table_info}{tablespace} = $1; 3023 $self->{tables}{$tb_name}{table_info}{tablespace} =~ s/"//gs; 3024 } 3025 if ($tb_param =~ /PCTFREE\s+(\d+)/is) { 3026 # We only take care of pctfree upper than the default 3027 if ($1 > 10) { 3028 # fillfactor must be >= 10 3029 $self->{tables}{$tb_name}{table_info}{fillfactor} = 100 - min(90, $1); 3030 } 3031 } 3032 if ($tb_param =~ /\bNOLOGGING\b/is) { 3033 $self->{tables}{$tb_name}{table_info}{nologging} = 1; 3034 } 3035 3036 if ($tb_param =~ /ORGANIZATION EXTERNAL/is) { 3037 if ($tb_param =~ /DEFAULT DIRECTORY ([^\s]+)/is) { 3038 $self->{external_table}{$tb_name}{director} = $1; 3039 } 3040 $self->{external_table}{$tb_name}{delimiter} = ','; 3041 if ($tb_param =~ /FIELDS TERMINATED BY '(.)'/is) { 3042 $self->{external_table}{$tb_name}{delimiter} = $1; 3043 } 3044 if ($tb_param =~ /PREPROCESSOR EXECDIR\s*:\s*'([^']+)'/is) { 3045 $self->{external_table}{$tb_name}{program} = $1; 3046 } 3047 if ($tb_param =~ /LOCATION\s*\(\s*'([^']+)'\s*\)/is) { 3048 $self->{external_table}{$tb_name}{location} = $1; 3049 } 3050 } 3051 3052 } elsif ($content =~ s/CREATE\s+(UNIQUE|BITMAP)?\s*INDEX\s+([^\s]+)\s+ON\s+([^\s\(]+)\s*\((.*)\)//is) { 3053 my $is_unique = $1; 3054 my $idx_name = $2; 3055 my $tb_name = $3; 3056 my $idx_def = $4; 3057 $idx_name =~ s/"//gs; 3058 $tb_name =~ s/\s+/ /gs; 3059 $idx_def =~ s/\s+/ /gs; 3060 $idx_def =~ s/\s*nologging//is; 3061 $idx_def =~ s/STORAGE\s*\([^\)]+\)\s*//is; 3062 $idx_def =~ s/COMPRESS(\s+\d+)?\s*//is; 3063 # look for storage information 3064 if ($idx_def =~ s/TABLESPACE\s*([^\s]+)\s*//is) { 3065 $self->{tables}{$tb_name}{idx_tbsp}{$idx_name} = $1; 3066 $self->{tables}{$tb_name}{idx_tbsp}{$idx_name} =~ s/"//gs; 3067 } 3068 if ($idx_def =~ s/ONLINE\s*//is) { 3069 $self->{tables}{$tb_name}{concurrently}{$idx_name} = 1; 3070 } 3071 if ($idx_def =~ s/INDEXTYPE\s+IS\s+.*SPATIAL_INDEX//is) { 3072 $self->{tables}{$tb_name}{spatial}{$idx_name} = 1; 3073 $self->{tables}{$tb_name}{idx_type}{$idx_name}{type} = 'SPATIAL INDEX'; 3074 $self->{tables}{$tb_name}{idx_type}{$idx_name}{type_name} = 'SPATIAL_INDEX'; 3075 } 3076 if ($idx_def =~ s/layer_gtype=([^\s,]+)//is) { 3077 $self->{tables}{$tb_name}{idx_type}{$idx_name}{type_constraint} = uc($1); 3078 } 3079 if ($idx_def =~ s/sdo_indx_dims=(\d)//is) { 3080 $self->{tables}{$tb_name}{idx_type}{$idx_name}{type_dims} = $1; 3081 } 3082 $idx_def =~ s/\)[^\)]*$//s; 3083 if ($is_unique eq 'BITMAP') { 3084 $is_unique = ''; 3085 $self->{tables}{$tb_name}{idx_type}{$idx_name}{type_name} = 'BITMAP'; 3086 } 3087 $self->{tables}{$tb_name}{uniqueness}{$idx_name} = $is_unique || ''; 3088 $idx_def =~ s/SYS_EXTRACT_UTC\s*\(([^\)]+)\)/$1/isg; 3089 push(@{$self->{tables}{$tb_name}{indexes}{$idx_name}}, $idx_def); 3090 $self->{tables}{$tb_name}{idx_type}{$idx_name}{type} = 'NORMAL'; 3091 if ($idx_def =~ /\(/s) { 3092 $self->{tables}{$tb_name}{idx_type}{$idx_name}{type} = 'FUNCTION-BASED'; 3093 } 3094 3095 if (!exists $self->{tables}{$tb_name}{table_info}{type}) { 3096 $self->{tables}{$tb_name}{table_info}{type} = 'TABLE'; 3097 $self->{tables}{$tb_name}{table_info}{num_rows} = 0; 3098 $tid++; 3099 $self->{tables}{$tb_name}{internal_id} = $tid; 3100 } 3101 3102 } elsif ($content =~ s/ALTER\s+TABLE\s+([^\s]+)\s+ADD\s*\(*\s*(.*)//is) { 3103 my $tb_name = $1; 3104 $tb_name =~ s/"//g; 3105 my $tb_def = $2; 3106 # Oracle allow multiple constraints declaration inside a single ALTER TABLE 3107 while ($tb_def =~ s/CONSTRAINT\s+([^\s]+)\s+CHECK\s*(\(.*?\))\s+(ENABLE|DISABLE|VALIDATE|NOVALIDATE|DEFERRABLE|INITIALLY|DEFERRED|USING\s+INDEX|\s+)+([^,]*)//is) { 3108 my $constname = $1; 3109 my $code = $2; 3110 my $states = $3; 3111 my $tbspace_move = $4; 3112 if (!exists $self->{tables}{$tb_name}{table_info}{type}) { 3113 $self->{tables}{$tb_name}{table_info}{type} = 'TABLE'; 3114 $self->{tables}{$tb_name}{table_info}{num_rows} = 0; 3115 $tid++; 3116 $self->{tables}{$tb_name}{internal_id} = $tid; 3117 } 3118 my $validate = ''; 3119 $validate = ' NOT VALID' if ( $states =~ /NOVALIDATE/is); 3120 push(@{$self->{tables}{$tb_name}{alter_table}}, "ADD CONSTRAINT \L$constname\E CHECK $code$validate"); 3121 if ( $tbspace_move =~ /USING\s+INDEX\s+TABLESPACE\s+([^\s]+)/is) { 3122 if ($self->{use_tablespace}) { 3123 $tbspace_move = "ALTER INDEX $constname SET TABLESPACE " . lc($1); 3124 push(@{$self->{tables}{$tb_name}{alter_index}}, $tbspace_move); 3125 } 3126 } elsif ($tbspace_move =~ /USING\s+INDEX\s+([^\s]+)/is) { 3127 $self->{tables}{$tb_name}{alter_table}[-1] .= " USING INDEX " . lc($1); 3128 } 3129 3130 } 3131 while ($tb_def =~ s/CONSTRAINT\s+([^\s]+)\s+FOREIGN\s+KEY\s*(\(.*?\)\s+REFERENCES\s+[^\s]+\s*\(.*?\))\s*([^,\)]+|$)//is) { 3132 my $constname = $1; 3133 my $other_def = $3; 3134 if (!exists $self->{tables}{$tb_name}{table_info}{type}) { 3135 $self->{tables}{$tb_name}{table_info}{type} = 'TABLE'; 3136 $self->{tables}{$tb_name}{table_info}{num_rows} = 0; 3137 $tid++; 3138 $self->{tables}{$tb_name}{internal_id} = $tid; 3139 } 3140 push(@{$self->{tables}{$tb_name}{alter_table}}, "ADD CONSTRAINT \L$constname\E FOREIGN KEY $2"); 3141 if ($other_def =~ /(ON\s+DELETE\s+(?:NO ACTION|RESTRICT|CASCADE|SET NULL))/is) { 3142 $self->{tables}{$tb_name}{alter_table}[-1] .= " $1"; 3143 } 3144 if ($other_def =~ /(ON\s+UPDATE\s+(?:NO ACTION|RESTRICT|CASCADE|SET NULL))/is) { 3145 $self->{tables}{$tb_name}{alter_table}[-1] .= " $1"; 3146 } 3147 my $validate = ''; 3148 $validate = ' NOT VALID' if ( $other_def =~ /NOVALIDATE/is); 3149 $self->{tables}{$tb_name}{alter_table}[-1] .= $validate; 3150 } 3151 # We can just have one primary key constraint 3152 if ($tb_def =~ s/CONSTRAINT\s+([^\s]+)\s+PRIMARY KEY//is) { 3153 my $constname = lc($1); 3154 $tb_def =~ s/^[^\(]+//; 3155 if ( $tb_def =~ s/USING\s+INDEX\s+TABLESPACE\s+([^\s]+).*//s) { 3156 $tb_def =~ s/\s+$//; 3157 if ($self->{use_tablespace}) { 3158 my $tbspace_move = "ALTER INDEX $constname SET TABLESPACE $1"; 3159 push(@{$self->{tables}{$tb_name}{alter_index}}, $tbspace_move); 3160 } 3161 push(@{$self->{tables}{$tb_name}{alter_table}}, "ADD PRIMARY KEY $constname " . lc($tb_def)); 3162 } elsif ($tb_def =~ s/USING\s+INDEX\s+([^\s]+).*//s) { 3163 push(@{$self->{tables}{$tb_name}{alter_table}}, "ADD PRIMARY KEY " . lc($tb_def)); 3164 $self->{tables}{$tb_name}{alter_table}[-1] .= " USING INDEX " . lc($1); 3165 } elsif ($tb_def) { 3166 push(@{$self->{tables}{$tb_name}{alter_table}}, "ADD PRIMARY KEY $constname " . lc($tb_def)); 3167 } 3168 if (!exists $self->{tables}{$tb_name}{table_info}{type}) { 3169 $self->{tables}{$tb_name}{table_info}{type} = 'TABLE'; 3170 $self->{tables}{$tb_name}{table_info}{num_rows} = 0; 3171 $tid++; 3172 $self->{tables}{$tb_name}{internal_id} = $tid; 3173 } 3174 } 3175 } 3176 3177 } 3178 3179 # Extract comments 3180 $self->read_comment_from_file(); 3181} 3182 3183sub read_comment_from_file 3184{ 3185 my $self = shift; 3186 3187 # Load file in a single string 3188 my $content = $self->_get_dml_from_file(); 3189 3190 my $tid = 0; 3191 3192 while ($content =~ s/COMMENT\s+ON\s+TABLE\s+([^\s]+)\s+IS\s+'([^;]+);//is) 3193 { 3194 my $tb_name = $1; 3195 my $tb_comment = $2; 3196 $tb_name =~ s/"//g; 3197 $tb_comment =~ s/'\s*$//g; 3198 if (exists $self->{tables}{$tb_name}) { 3199 $self->{tables}{$tb_name}{table_info}{comment} = $tb_comment; 3200 } 3201 } 3202 3203 while ($content =~ s/COMMENT\s+ON\s+COLUMN\s+(.*?)\s+IS\s*'([^;]+);//is) 3204 { 3205 my $tb_name = $1; 3206 my $tb_comment = $2; 3207 # register column name between double quote 3208 my $i = 0; 3209 my %col_name = (); 3210 # Get column name 3211 while ($tb_name =~ s/("[^"]+")/\%\%COLNAME$i\%\%/s) 3212 { 3213 $col_name{$i} = $1; 3214 $i++; 3215 } 3216 $tb_comment =~ s/'\s*$//g; 3217 if ($tb_name =~ s/\.([^\.]+)$//) 3218 { 3219 my $cname = $1; 3220 $tb_name =~ s/\%\%COLNAME(\d+)\%\%/$col_name{$1}/sg; 3221 $tb_name =~ s/"//g; 3222 $cname =~ s/\%\%COLNAME(\d+)\%\%/$col_name{$1}/sg; 3223 $cname =~ s/"//g; 3224 $cname =~ s/\./_/g; 3225 if (exists $self->{tables}{$tb_name}) { 3226 $self->{tables}{$tb_name}{column_comments}{"\L$cname\E"} = $tb_comment; 3227 } elsif (exists $self->{views}{$tb_name}) { 3228 $self->{views}{$tb_name}{column_comments}{"\L$cname\E"} = $tb_comment; 3229 } 3230 } 3231 else 3232 { 3233 $tb_name =~ s/\%\%COLNAME(\d+)\%\%/$col_name{$1}/sg; 3234 } 3235 } 3236 3237} 3238 3239sub read_view_from_file 3240{ 3241 my $self = shift; 3242 3243 # Load file in a single string 3244 my $content = $self->_get_dml_from_file(); 3245 3246 # Clear content from comment and text constant for better parsing 3247 $self->_remove_comments(\$content); 3248 3249 my $tid = 0; 3250 3251 $content =~ s/\s+NO\s+FORCE\s+/ /gs; 3252 $content =~ s/\s+FORCE\s+/ /gs; 3253 $content =~ s/\s+OR\s+REPLACE\s+/ /gs; 3254 $content =~ s/CREATE\s+VIEW\s+([^\s]+)\s+OF\s+(.*?)\s+AS\s+/CREATE VIEW $1 AS /sg; 3255 # Views with aliases 3256 while ($content =~ s/CREATE\s+VIEW\s+([^\s]+)\s*\((.*?)\)\s+AS\s+([^;]+)(;|$)//is) { 3257 my $v_name = $1; 3258 my $v_alias = $2; 3259 my $v_def = $3; 3260 $v_name =~ s/"//g; 3261 $tid++; 3262 $self->{views}{$v_name}{text} = $v_def; 3263 $self->{views}{$v_name}{iter} = $tid; 3264 # Remove constraint 3265 while ($v_alias =~ s/(,[^,\(]+\(.*)$//) {}; 3266 my @aliases = split(/\s*,\s*/, $v_alias); 3267 foreach (@aliases) { 3268 s/^\s+//; 3269 s/\s+$//; 3270 my @tmp = split(/\s+/); 3271 push(@{$self->{views}{$v_name}{alias}}, \@tmp); 3272 } 3273 } 3274 # Standard views 3275 while ($content =~ s/CREATE\sVIEW[\s]+([^\s]+)\s+AS\s+([^;]+);//i) { 3276 my $v_name = $1; 3277 my $v_def = $2; 3278 $v_name =~ s/"//g; 3279 $tid++; 3280 $self->{views}{$v_name}{text} = $v_def; 3281 } 3282 3283 # Extract comments 3284 $self->read_comment_from_file(); 3285} 3286 3287sub read_grant_from_file 3288{ 3289 my $self = shift; 3290 3291 # Load file in a single string 3292 my $content = $self->_get_dml_from_file(); 3293 3294 # Clear content from comment and text constant for better parsing 3295 $self->_remove_comments(\$content); 3296 3297 my $tid = 0; 3298 3299 # Extract grant information 3300 while ($content =~ s/GRANT\s+(.*?)\s+ON\s+([^\s]+)\s+TO\s+([^;]+)(\s+WITH GRANT OPTION)?;//i) { 3301 my $g_priv = $1; 3302 my $g_name = $2; 3303 $g_name =~ s/"//g; 3304 my $g_user = $3; 3305 my $g_option = $4; 3306 $g_priv =~ s/\s+//g; 3307 $tid++; 3308 $self->{grants}{$g_name}{type} = ''; 3309 push(@{$self->{grants}{$g_name}{privilege}{$g_user}}, split(/,/, $g_priv)); 3310 if ($g_priv =~ /EXECUTE/) { 3311 $self->{grants}{$table}{type} = 'PACKAGE BODY'; 3312 } else { 3313 $self->{grants}{$table}{type} = 'TABLE'; 3314 } 3315 } 3316 3317} 3318 3319sub read_trigger_from_file 3320{ 3321 my $self = shift; 3322 3323 # Load file in a single string 3324 my $content = $self->_get_dml_from_file(); 3325 3326 # Clear content from comment and text constant for better parsing 3327 $self->_remove_comments(\$content); 3328 3329 my $tid = 0; 3330 my $doloop = 1; 3331 my @triggers_decl = split(/(?:CREATE)?(?:\s+OR\s+REPLACE)?\s*(?:DEFINER=[^\s]+)?\s*\bTRIGGER(\s+|$)/is, $content); 3332 foreach $content (@triggers_decl) 3333 { 3334 my $t_name = ''; 3335 my $t_pos = ''; 3336 my $t_event = ''; 3337 my $tb_name = ''; 3338 my $trigger = ''; 3339 my $t_type = ''; 3340 if ($content =~ s/^([^\s]+)\s+(BEFORE|AFTER|INSTEAD\s+OF)\s+(.*?)\s+ON\s+([^\s]+)\s+(.*)(\bEND\s*(?!IF|LOOP|CASE|INTO|FROM|,)[a-z0-9_]*(?:;|$))//is) 3341 { 3342 $t_name = $1; 3343 $t_pos = $2; 3344 $t_event = $3; 3345 $tb_name = $4; 3346 $trigger = $5 . $6; 3347 $t_name =~ s/"//g; 3348 } 3349 elsif ($content =~ s/^([^\s]+)\s+(BEFORE|AFTER|INSTEAD|\s+|OF)((?:INSERT|UPDATE|DELETE|OR|\s+|OF)+\s+(?:.*?))*\s+ON\s+([^\s]+)\s+(.*)(\bEND\s*(?!IF|LOOP|CASE|INTO|FROM|,)[a-z0-9_]*(?:;|$))//is) 3350 { 3351 $t_name = $1; 3352 $t_pos = $2; 3353 $t_event = $3; 3354 $tb_name = $4; 3355 $trigger = $5 . $6; 3356 $t_name =~ s/"//g; 3357 } 3358 3359 next if (!$t_name || ! $tb_name); 3360 3361 # Remove referencing clause, not supported by PostgreSQL 3362 $trigger =~ s/REFERENCING\s+(.*?)(FOR\s+EACH\s+)/$2/is; 3363 3364 if ($trigger =~ s/^\s*(FOR\s+EACH\s+)(ROW|STATEMENT)\s*//is) { 3365 $t_type = $1 . $2; 3366 } 3367 my $t_when_cond = ''; 3368 if ($trigger =~ s/^\s*WHEN\s+(.*?)\s+((?:BEGIN|DECLARE|CALL).*)//is) 3369 { 3370 $t_when_cond = $1; 3371 $trigger = $2; 3372 if ($trigger =~ /^(BEGIN|DECLARE)/i) { 3373 ($trigger, $content) = &_get_plsql_code($trigger); 3374 } 3375 else 3376 { 3377 $trigger =~ s/([^;]+;)\s*(.*)/$1/; 3378 $content = $2; 3379 } 3380 } 3381 else 3382 { 3383 if ($trigger =~ /^(BEGIN|DECLARE)/i) { 3384 ($trigger, $content) = &_get_plsql_code($trigger); 3385 } 3386 } 3387 $tid++; 3388 3389 # TRIGGER_NAME, TRIGGER_TYPE, TRIGGERING_EVENT, TABLE_NAME, TRIGGER_BODY, WHEN_CLAUSE, DESCRIPTION,ACTION_TYPE 3390 $trigger =~ s/\bEND\s+[^\s]+\s+$/END/is; 3391 my $when_event = ''; 3392 if ($t_when_cond) { 3393 $when_event = "$t_name\n$t_pos $t_event ON $tb_name\n$t_type"; 3394 } 3395 push(@{$self->{triggers}}, [($t_name, $t_pos, $t_event, $tb_name, $trigger, $t_when_cond, $when_event, $t_type)]); 3396 } 3397} 3398 3399sub read_sequence_from_file 3400{ 3401 my $self = shift; 3402 3403 # Load file in a single string 3404 my $content = $self->_get_dml_from_file(); 3405 3406 # Clear content from comment and text constant for better parsing 3407 $self->_remove_comments(\$content, 1); 3408 $content =~ s/\%ORA2PG_COMMENT\d+\%//gs; 3409 my $tid = 0; 3410 3411 # Sequences 3412 while ($content =~ s/CREATE\s+SEQUENCE[\s]+([^\s;]+)\s*([^;]+);//i) 3413 { 3414 my $s_name = $1; 3415 my $s_def = $2; 3416 $s_name =~ s/"//g; 3417 $s_def =~ s/\s+/ /g; 3418 $tid++; 3419 my @seq_info = (); 3420 3421 # Field of @seq_info 3422 # SEQUENCE_NAME, MIN_VALUE, MAX_VALUE, INCREMENT_BY, LAST_NUMBER, CACHE_SIZE, CYCLE_FLAG, SEQUENCE_OWNER FROM $self->{prefix}_SEQUENCES"; 3423 push(@seq_info, $s_name); 3424 if ($s_def =~ /MINVALUE\s+([\-\d]+)/i) { 3425 push(@seq_info, $1); 3426 } else { 3427 push(@seq_info, ''); 3428 } 3429 if ($s_def =~ /MAXVALUE\s+([\-\d]+)/i) 3430 { 3431 if ($1 > 9223372036854775807) { 3432 push(@seq_info, 9223372036854775807); 3433 } else { 3434 push(@seq_info, $1); 3435 } 3436 } else { 3437 push(@seq_info, ''); 3438 } 3439 if ($s_def =~ /INCREMENT\s*(?:BY)?\s+([\-\d]+)/i) { 3440 push(@seq_info, $1); 3441 } else { 3442 push(@seq_info, 1); 3443 } 3444 3445 if ($s_def =~ /START\s+WITH\s+([\-\d]+)/i) { 3446 push(@seq_info, $1); 3447 } else { 3448 push(@seq_info, ''); 3449 } 3450 if ($s_def =~ /CACHE\s+(\d+)/i) { 3451 push(@seq_info, $1); 3452 } else { 3453 push(@seq_info, ''); 3454 } 3455 if ($s_def =~ /NOCYCLE/i) { 3456 push(@seq_info, 'NO'); 3457 } else { 3458 push(@seq_info, 'YES'); 3459 } 3460 if ($s_name =~ /^([^\.]+)\./i) { 3461 push(@seq_info, $1); 3462 } else { 3463 push(@seq_info, ''); 3464 } 3465 push(@{$self->{sequences}{$s_name}}, @seq_info); 3466 } 3467} 3468 3469sub read_tablespace_from_file 3470{ 3471 my $self = shift; 3472 3473 # Load file in a single string 3474 my $content = $self->_get_dml_from_file(); 3475 3476 my @tbsps = split(/\s*;\s*/, $content); 3477 # tablespace without undo ones 3478 foreach $content (@tbsps) { 3479 $content .= ';'; 3480 if ($content =~ /CREATE\s+(?:BIGFILE|SMALLFILE)?\s*(?:TEMPORARY)?\s*TABLESPACE\s+([^\s;]+)\s*([^;]*);/is) { 3481 my $t_name = $1; 3482 my $t_def = $2; 3483 $t_name =~ s/"//g; 3484 if ($t_def =~ /(?:DATA|TEMP)FILE\s+'([^']+)'/is) { 3485 my $t_path = $1; 3486 $t_path =~ s/:/\//g; 3487 $t_path =~ s/\\/\//g; 3488 if (dirname($t_path) eq '.') { 3489 $t_path = 'change_tablespace_dir'; 3490 } else { 3491 $t_path = dirname($t_path); 3492 } 3493 # TYPE - TABLESPACE_NAME - FILEPATH - OBJECT_NAME 3494 @{$self->{tablespaces}{TABLE}{$t_name}{$t_path}} = (); 3495 } 3496 3497 } 3498 } 3499} 3500 3501sub read_directory_from_file 3502{ 3503 my $self = shift; 3504 3505 # Load file in a single string 3506 my $content = $self->_get_dml_from_file(); 3507 3508 # Directory 3509 while ($content =~ s/CREATE(?: OR REPLACE)?\s+DIRECTORY\s+([^\s]+)\s+AS\s+'([^']+)'\s*;//is) { 3510 my $d_name = uc($1); 3511 my $d_def = $2; 3512 $d_name =~ s/"//g; 3513 if ($d_def !~ /\/$/) { 3514 $d_def .= '/'; 3515 } 3516 $self->{directory}{$d_name}{path} = $d_def; 3517 } 3518 3519 # Directory 3520 while ($content =~ s/GRANT\s+(.*?)ON\s+DIRECTORY\s+([^\s]+)\s+TO\s+([^;\s]+)\s*;//is) { 3521 my $d_grant = $1; 3522 my $d_name = uc($2); 3523 my $d_user = uc($3); 3524 $d_name =~ s/"//g; 3525 $d_user =~ s/"//g; 3526 $self->{directory}{$d_name}{grantee}{$d_user} = $d_grant; 3527 } 3528} 3529 3530sub read_synonym_from_file 3531{ 3532 my $self = shift; 3533 3534 # Load file in a single string 3535 my $content = $self->_get_dml_from_file(); 3536 3537 # Directory 3538 while ($content =~ s/CREATE(?: OR REPLACE)?(?: PUBLIC)?\s+SYNONYM\s+([^\s]+)\s+FOR\s+([^;\s]+)\s*;//is) { 3539 my $s_name = uc($1); 3540 my $s_def = $2; 3541 $s_name =~ s/"//g; 3542 $s_def =~ s/"//g; 3543 if ($s_name =~ s/^([^\.]+)\.//) { 3544 $self->{synonyms}{$s_name}{owner} = $1; 3545 } else { 3546 $self->{synonyms}{$s_name}{owner} = $self->{schema}; 3547 } 3548 if ($s_def =~ s/@(.*)//) { 3549 $self->{synonyms}{$s_name}{dblink} = $1; 3550 } 3551 if ($s_def =~ s/^([^\.]+)\.//) { 3552 $self->{synonyms}{$s_name}{table_owner} = $1; 3553 } 3554 $self->{synonyms}{$s_name}{table_name} = $s_def; 3555 } 3556 3557} 3558 3559sub read_dblink_from_file 3560{ 3561 my $self = shift; 3562 3563 # Load file in a single string 3564 my $content = $self->_get_dml_from_file(); 3565 3566 # Directory 3567 while ($content =~ s/CREATE(?: SHARED)?(?: PUBLIC)?\s+DATABASE\s+LINK\s+([^\s]+)\s+CONNECT TO\s+([^\s]+)\s*([^;]+);//is) { 3568 my $d_name = $1; 3569 my $d_user = $2; 3570 my $d_auth = $3; 3571 $d_name =~ s/"//g; 3572 $d_user =~ s/"//g; 3573 $self->{dblink}{$d_name}{owner} = $self->{shema}; 3574 $self->{dblink}{$d_name}{user} = $d_user; 3575 $self->{dblink}{$d_name}{username} = $self->{pg_user} || $d_user; 3576 if ($d_auth =~ s/USING\s+([^\s]+)//) { 3577 $self->{dblink}{$d_name}{host} = $1; 3578 $self->{dblink}{$d_name}{host} =~ s/'//g; 3579 } 3580 if ($d_auth =~ s/IDENTIFIED\s+BY\s+([^\s]+)//) { 3581 $self->{dblink}{$d_name}{password} = $1; 3582 } 3583 if ($d_auth =~ s/AUTHENTICATED\s+BY\s+([^\s]+)\s+IDENTIFIED\s+BY\s+([^\s]+)//) { 3584 $self->{dblink}{$d_name}{user} = $1; 3585 $self->{dblink}{$d_name}{password} = $2; 3586 $self->{dblink}{$d_name}{username} = $self->{pg_user} || $1; 3587 } 3588 } 3589 3590 # Directory 3591 while ($content =~ s/CREATE(?: SHARED)?(?: PUBLIC)?\s+DATABASE\s+LINK\s+([^\s]+)\s+USING\s+([^;]+);//is) { 3592 my $d_name = $1; 3593 my $d_conn = $2; 3594 $d_name =~ s/"//g; 3595 $d_conn =~ s/'//g; 3596 $self->{dblink}{$d_name}{owner} = $self->{shema}; 3597 $self->{dblink}{$d_name}{host} = $d_conn; 3598 } 3599 3600 3601} 3602 3603 3604=head2 _views 3605 3606This function is used to retrieve all views information. 3607 3608Sets the main hash of the views definition $self->{views}. 3609Keys are the names of all views retrieved from the current 3610database and values are the text definitions of the views. 3611 3612It then sets the main hash as follows: 3613 3614 # Definition of the view 3615 $self->{views}{$table}{text} = $lview_infos{$table}; 3616 3617=cut 3618 3619sub _views 3620{ 3621 my ($self) = @_; 3622 3623 # Get all views information 3624 $self->logit("Retrieving views information...\n", 1); 3625 my %view_infos = $self->_get_views(); 3626 # Retrieve comment of each columns 3627 my %columns_comments = $self->_column_comments(); 3628 foreach my $view (keys %columns_comments) { 3629 next if (!exists $view_infos{$view}); 3630 foreach my $c (keys %{$columns_comments{$view}}) { 3631 $self->{views}{$view}{column_comments}{$c} = $columns_comments{$view}{$c}; 3632 } 3633 } 3634 3635 my $i = 1; 3636 foreach my $view (sort keys %view_infos) { 3637 $self->logit("[$i] Scanning $view...\n", 1); 3638 $self->{views}{$view}{text} = $view_infos{$view}{text}; 3639 $self->{views}{$view}{owner} = $view_infos{$view}{owner}; 3640 $self->{views}{$view}{iter} = $view_infos{$view}{iter} if (exists $view_infos{$view}{iter}); 3641 $self->{views}{$view}{comment} = $view_infos{$view}{comment}; 3642 # Retrieve also aliases from views 3643 $self->{views}{$view}{alias} = $view_infos{$view}{alias}; 3644 $i++; 3645 } 3646 3647} 3648 3649=head2 _materialized_views 3650 3651This function is used to retrieve all materialized views information. 3652 3653Sets the main hash of the views definition $self->{materialized_views}. 3654Keys are the names of all materialized views retrieved from the current 3655database and values are the text definitions of the views. 3656 3657It then sets the main hash as follows: 3658 3659 # Definition of the materialized view 3660 $self->{materialized_views}{text} = $mview_infos{$view}; 3661 3662=cut 3663 3664sub _materialized_views 3665{ 3666 my ($self) = @_; 3667 3668 # Get all views information 3669 $self->logit("Retrieving materialized views information...\n", 1); 3670 my %mview_infos = $self->_get_materialized_views(); 3671 3672 my $i = 1; 3673 foreach my $table (sort keys %mview_infos) 3674 { 3675 $self->logit("[$i] Scanning $table...\n", 1); 3676 $self->{materialized_views}{$table}{text} = $mview_infos{$table}{text}; 3677 $self->{materialized_views}{$table}{updatable}= $mview_infos{$table}{updatable}; 3678 $self->{materialized_views}{$table}{refresh_mode}= $mview_infos{$table}{refresh_mode}; 3679 $self->{materialized_views}{$table}{refresh_method}= $mview_infos{$table}{refresh_method}; 3680 $self->{materialized_views}{$table}{no_index}= $mview_infos{$table}{no_index}; 3681 $self->{materialized_views}{$table}{rewritable}= $mview_infos{$table}{rewritable}; 3682 $self->{materialized_views}{$table}{build_mode}= $mview_infos{$table}{build_mode}; 3683 $self->{materialized_views}{$table}{owner}= $mview_infos{$table}{owner}; 3684 $i++; 3685 } 3686 3687 # Retrieve index informations 3688 if (scalar keys %mview_infos) 3689 { 3690 my ($uniqueness, $indexes, $idx_type, $idx_tbsp) = $self->_get_indexes('',$self->{schema}); 3691 foreach my $tb (keys %{$indexes}) 3692 { 3693 next if (!exists $self->{materialized_views}{$tb}); 3694 %{$self->{materialized_views}{$tb}{indexes}} = %{$indexes->{$tb}}; 3695 } 3696 foreach my $tb (keys %{$idx_type}) 3697 { 3698 next if (!exists $self->{materialized_views}{$tb}); 3699 %{$self->{materialized_views}{$tb}{idx_type}} = %{$idx_type->{$tb}}; 3700 } 3701 } 3702} 3703 3704=head2 _tablespaces 3705 3706This function is used to retrieve all Oracle Tablespaces information. 3707 3708Sets the main hash $self->{tablespaces}. 3709 3710=cut 3711 3712sub _tablespaces 3713{ 3714 my ($self) = @_; 3715 3716 $self->logit("Retrieving tablespaces information...\n", 1); 3717 $self->{tablespaces} = $self->_get_tablespaces(); 3718 $self->{list_tablespaces} = $self->_list_tablespaces(); 3719 3720} 3721 3722=head2 _partitions 3723 3724This function is used to retrieve all Oracle partition information. 3725 3726Sets the main hash $self->{partition}. 3727 3728=cut 3729 3730sub _partitions 3731{ 3732 my ($self) = @_; 3733 3734 $self->logit("Retrieving partitions information...\n", 1); 3735 ($self->{partitions}, $self->{partitions_default}) = $self->_get_partitions(); 3736 3737 ($self->{subpartitions}, $self->{subpartitions_default}) = $self->_get_subpartitions(); 3738 3739 # Get partition list meta information 3740 %{ $self->{partitions_list} } = $self->_get_partitioned_table(); 3741 %{ $self->{subpartitions_list} } = $self->_get_subpartitioned_table(); 3742 3743 # Look for main table indexes to reproduce them on partition 3744 my ($uniqueness, $indexes, $idx_type, $idx_tbsp) = $self->_get_indexes('',$self->{schema}, 0); 3745 foreach my $tb (keys %{$indexes}) { 3746 %{$self->{tables}{$tb}{indexes}} = %{$indexes->{$tb}}; 3747 } 3748 foreach my $tb (keys %{$idx_type}) { 3749 %{$self->{tables}{$tb}{idx_type}} = %{$idx_type->{$tb}}; 3750 } 3751 foreach my $tb (keys %{$idx_tbsp}) { 3752 %{$self->{tables}{$tb}{idx_tbsp}} = %{$idx_tbsp->{$tb}}; 3753 } 3754 foreach my $tb (keys %{$uniqueness}) { 3755 %{$self->{tables}{$tb}{uniqueness}} = %{$uniqueness->{$tb}}; 3756 } 3757 3758 # Retrieve all unique keys informations 3759 my %unique_keys = $self->_unique_key('',$self->{schema}); 3760 foreach my $tb (keys %unique_keys) { 3761 foreach my $c (keys %{$unique_keys{$tb}}) { 3762 $self->{tables}{$tb}{unique_key}{$c} = $unique_keys{$tb}{$c}; 3763 } 3764 } 3765} 3766 3767=head2 _dblinks 3768 3769This function is used to retrieve all Oracle dblinks information. 3770 3771Sets the main hash $self->{dblink}. 3772 3773=cut 3774 3775sub _dblinks 3776{ 3777 my ($self) = @_; 3778 3779 $self->logit("Retrieving dblinks information...\n", 1); 3780 %{$self->{dblink}} = $self->_get_dblink(); 3781 3782} 3783 3784=head2 _directories 3785 3786This function is used to retrieve all Oracle directories information. 3787 3788Sets the main hash $self->{directory}. 3789 3790=cut 3791 3792sub _directories 3793{ 3794 my ($self) = @_; 3795 3796 $self->logit("Retrieving directories information...\n", 1); 3797 %{$self->{directory}} = $self->_get_directory(); 3798 3799} 3800 3801 3802sub get_replaced_tbname 3803{ 3804 my ($self, $tmptb) = @_; 3805 3806 if (exists $self->{replaced_tables}{"\L$tmptb\E"} && $self->{replaced_tables}{"\L$tmptb\E"}) { 3807 $self->logit("\tReplacing table $tmptb as " . $self->{replaced_tables}{lc($tmptb)} . "...\n", 1); 3808 $tmptb = $self->{replaced_tables}{lc($tmptb)}; 3809 } 3810 3811 $tmptb = $self->quote_object_name($tmptb); 3812 3813 return $tmptb; 3814} 3815 3816sub get_tbname_with_suffix 3817{ 3818 my ($self, $tmptb, $suffix) = @_; 3819 3820 return $self->quote_object_name($tmptb . $suffix); 3821} 3822 3823 3824sub _export_table_data 3825{ 3826 my ($self, $table, $dirprefix, $sql_header) = @_; 3827 3828 $self->logit("Exporting data of table $table...\n", 1); 3829 3830 # Rename table and double-quote it if required 3831 my $tmptb = $self->get_replaced_tbname($table); 3832 3833 # Open output file 3834 $self->data_dump($sql_header, $table) if (!$self->{pg_dsn} && $self->{file_per_table}); 3835 3836 my $total_record = 0; 3837 3838 # When copy freeze is required, force a transaction with a truncate 3839 if ($self->{copy_freeze} && !$self->{pg_dsn}) { 3840 $self->{truncate_table} = 1; 3841 if ($self->{file_per_table}) { 3842 $self->data_dump("BEGIN;\n", $table); 3843 } else { 3844 $self->dump("\nBEGIN;\n"); 3845 } 3846 } else { 3847 $self->{copy_freeze} = ''; 3848 } 3849 3850 # Open a new connection to PostgreSQL destination with parallel table export 3851 my $local_dbh = undef; 3852 if (($self->{parallel_tables} > 1) && $self->{pg_dsn}) { 3853 $local_dbh = $self->_send_to_pgdb(); 3854 } else { 3855 $local_dbh = $self->{dbhdest}; 3856 } 3857 3858 if ($self->{global_delete} || exists $self->{delete}{"\L$table\E"}) 3859 { 3860 my $delete_clause = ''; 3861 my $delete_clause_start = "DELETE"; 3862 if ($self->{datadiff}) { 3863 $delete_clause_start = "INSERT INTO " . $self->get_tbname_with_suffix($tmptb, $self->{datadiff_del_suffix}) . " SELECT *"; 3864 } 3865 if (exists $self->{delete}{"\L$table\E"} && $self->{delete}{"\L$table\E"}) 3866 { 3867 $delete_clause = "$delete_clause_start FROM $tmptb WHERE " . $self->{delete}{"\L$table\E"} . ";"; 3868 $self->logit("\tApplying DELETE clause on table: " . $self->{delete}{"\L$table\E"} . "\n", 1); 3869 } 3870 elsif ($self->{global_delete}) 3871 { 3872 $delete_clause = "$delete_clause_start FROM $tmptb WHERE " . $self->{global_delete} . ";"; 3873 $self->logit("\tApplying DELETE global clause: " . $self->{global_delete} . "\n", 1); 3874 3875 } 3876 if ($delete_clause) 3877 { 3878 if ($self->{pg_dsn}) 3879 { 3880 $self->logit("Deleting from table $table...\n", 1); 3881 my $s = $local_dbh->do("$delete_clause") or $self->logit("FATAL: " . $local_dbh->errstr . "\n", 0, 1); 3882 } 3883 else 3884 { 3885 if ($self->{file_per_table}) { 3886 $self->data_dump("$delete_clause\n", $table); 3887 } else { 3888 $self->dump("\n$delete_clause\n"); 3889 } 3890 } 3891 } 3892 } 3893 3894 # Add table truncate order if there's no global DELETE clause or one specific to the current table 3895 if ($self->{truncate_table} && !$self->{global_delete} && !exists $self->{delete}{"\L$table\E"}) 3896 { 3897 # Set search path 3898 my $search_path = $self->set_search_path(); 3899 if ($self->{pg_dsn} && !$self->{oracle_speed}) 3900 { 3901 if ($search_path) { 3902 $local_dbh->do($search_path) or $self->logit("FATAL: " . $local_dbh->errstr . "\n", 0, 1); 3903 } 3904 $self->logit("Truncating table $table...\n", 1); 3905 my $s = $local_dbh->do("TRUNCATE TABLE $tmptb;") or $self->logit("FATAL: " . $local_dbh->errstr . "\n", 0, 1); 3906 } 3907 else 3908 { 3909 my $head = "SET client_encoding TO '\U$self->{client_encoding}\E';\n"; 3910 $head .= "SET synchronous_commit TO off;\n" if (!$self->{synchronous_commit}); 3911 if ($self->{file_per_table}) { 3912 $self->data_dump("$head$search_path\nTRUNCATE TABLE $tmptb;\n", $table); 3913 } else { 3914 $self->dump("\n$head$search_path\nTRUNCATE TABLE $tmptb;\n"); 3915 } 3916 } 3917 } 3918 3919 # With partitioned table, load data direct from table partition 3920 if (exists $self->{partitions}{$table}) 3921 { 3922 foreach my $pos (sort {$self->{partitions}{$table}{$a} <=> $self->{partitions}{$table}{$b}} keys %{$self->{partitions}{$table}}) 3923 { 3924 my $part_name = $self->{partitions}{$table}{$pos}{name}; 3925 my $tbpart_name = $part_name; 3926 $tbpart_name = $table . '_' . $part_name if ($self->{prefix_partition}); 3927 next if ($self->{allow_partition} && !grep($_ =~ /^$tbpart_name$/i, @{$self->{allow_partition}})); 3928 3929 if (exists $self->{subpartitions}{$table}{$part_name}) 3930 { 3931 foreach my $p (sort {$a <=> $b} keys %{$self->{subpartitions}{$table}{$part_name}}) 3932 { 3933 my $subpart = $self->{subpartitions}{$table}{$part_name}{$p}{name}; 3934 next if ($self->{allow_partition} && !grep($_ =~ /^$subpart$/i, @{$self->{allow_partition}})); 3935 my $sub_tb_name = $subpart; 3936 $sub_tb_name =~ s/^[^\.]+\.//; # remove schema part if any 3937 $sub_tb_name = "${table}_$sub_tb_name" if ($self->{prefix_partition}); 3938 if ($self->{file_per_table} && !$self->{pg_dsn}) { 3939 # Do not dump data again if the file already exists 3940 next if ($self->file_exists("$dirprefix${sub_tb_name}_$self->{output}")); 3941 } 3942 3943 $self->logit("Dumping sub partition table $table ($subpart)...\n", 1); 3944 $total_record = $self->_dump_table($dirprefix, $sql_header, $table, $subpart, 1); 3945 # Rename temporary filename into final name 3946 $self->rename_dump_partfile($dirprefix, $sub_tb_name); 3947 } 3948 # Now load content of the default subpartition table 3949 if ($self->{subpartitions_default}{$table}{$part_name}) 3950 { 3951 if (!$self->{allow_partition} || grep($_ =~ /^$self->{subpartitions_default}{$table}{$part_name}$/i, @{$self->{allow_partition}})) 3952 { 3953 if ($self->{file_per_table} && !$self->{pg_dsn}) 3954 { 3955 # Do not dump data again if the file already exists 3956 if (!$self->file_exists("$dirprefix$self->{subpartitions_default}{$table}{$part_name}_$self->{output}")) 3957 { 3958 $total_record = $self->_dump_table($dirprefix, $sql_header, $table, $self->{subpartitions_default}{$table}{$part_name}, 1); 3959 } 3960 } 3961 else 3962 { 3963 $total_record = $self->_dump_table($dirprefix, $sql_header, $table, $self->{subpartitions_default}{$table}{$part_name}, 1); 3964 } 3965 } 3966 # Rename temporary filename into final name 3967 $self->rename_dump_partfile($dirprefix, $self->{subpartitions_default}{$table}{$part_name}, $table); 3968 } 3969 } 3970 else 3971 { 3972 if ($self->{file_per_table} && !$self->{pg_dsn}) 3973 { 3974 # Do not dump data again if the file already exists 3975 next if ($self->file_exists("$dirprefix${tbpart_name}_$self->{output}")); 3976 } 3977 3978 $self->logit("Dumping partition table $table ($part_name)...\n", 1); 3979 $total_record = $self->_dump_table($dirprefix, $sql_header, $table, $part_name); 3980 # Rename temporary filename into final name 3981 $self->rename_dump_partfile($dirprefix, $part_name, $table); 3982 } 3983 } 3984 # Now load content of the default partition table 3985 if ($self->{partitions_default}{$table}) 3986 { 3987 if (!$self->{allow_partition} || grep($_ =~ /^$self->{partitions_default}{$table}$/i, @{$self->{allow_partition}})) 3988 { 3989 if ($self->{file_per_table} && !$self->{pg_dsn}) 3990 { 3991 # Do not dump data again if the file already exists 3992 if (!$self->file_exists("$dirprefix$self->{partitions_default}{$table}_$self->{output}")) 3993 { 3994 $total_record = $self->_dump_table($dirprefix, $sql_header, $table, $self->{partitions_default}{$table}); 3995 } 3996 } 3997 else 3998 { 3999 $total_record = $self->_dump_table($dirprefix, $sql_header, $table, $self->{partitions_default}{$table}); 4000 } 4001 # Rename temporary filename into final name 4002 $self->rename_dump_partfile($dirprefix, $self->{partitions_default}{$table}, $table); 4003 } 4004 } 4005 } 4006 else 4007 { 4008 4009 $total_record = $self->_dump_table($dirprefix, $sql_header, $table); 4010 } 4011 4012 # When copy freeze is required, close the transaction 4013 if ($self->{copy_freeze} && !$self->{pg_dsn}) 4014 { 4015 if ($self->{file_per_table}) { 4016 $self->data_dump("COMMIT;\n", $table); 4017 } else { 4018 $self->dump("\nCOMMIT;\n"); 4019 } 4020 } 4021 4022 # close the connection with parallel table export 4023 if (($self->{parallel_tables} > 1) && $self->{pg_dsn}) { 4024 $local_dbh->disconnect() if (defined $local_dbh); 4025 } 4026 4027 # Rename temporary filename into final name 4028 $self->rename_dump_partfile($dirprefix, $table) if (!$self->{oracle_speed}); 4029 4030 return $total_record; 4031} 4032 4033sub _export_fdw_table_data 4034{ 4035 my ($self, $table, $dirprefix, $sql_header) = @_; 4036 4037 $self->logit("FATAL: foreign data export requires that PG_DSN to be set \n", 0, 1) if (!$self->{pg_dsn}); 4038 4039 $self->logit("Exporting data of table $table using foreign table...\n", 1); 4040 4041 # Rename table and double-quote it if required 4042 my $tmptb = $self->get_replaced_tbname($table); 4043 4044 my $total_record = 0; 4045 4046 $self->{copy_freeze} = ''; 4047 4048 # Open a new connection to PostgreSQL destination with parallel table export 4049 my $local_dbh = undef; 4050 if ($self->{parallel_tables} > 1) { 4051 $local_dbh = $self->_send_to_pgdb(); 4052 } else { 4053 $local_dbh = $self->{dbhdest}; 4054 } 4055 4056 if ($self->{global_delete} || exists $self->{delete}{"\L$table\E"}) 4057 { 4058 my $delete_clause = ''; 4059 my $delete_clause_start = "DELETE"; 4060 if (exists $self->{delete}{"\L$table\E"} && $self->{delete}{"\L$table\E"}) 4061 { 4062 $delete_clause = "$delete_clause_start FROM $tmptb WHERE " . $self->{delete}{"\L$table\E"} . ";"; 4063 $self->logit("\tApplying DELETE clause on table: " . $self->{delete}{"\L$table\E"} . "\n", 1); 4064 } 4065 elsif ($self->{global_delete}) 4066 { 4067 $delete_clause = "$delete_clause_start FROM $tmptb WHERE " . $self->{global_delete} . ";"; 4068 $self->logit("\tApplying DELETE global clause: " . $self->{global_delete} . "\n", 1); 4069 4070 } 4071 if ($delete_clause) 4072 { 4073 $self->logit("Deleting from table $table...\n", 1); 4074 my $s = $local_dbh->do("$delete_clause") or $self->logit("FATAL: " . $local_dbh->errstr . "\n", 0, 1); 4075 } 4076 } 4077 4078 # Add table truncate order if there's no global DELETE clause or one specific to the current table 4079 if ($self->{truncate_table} && !$self->{global_delete} && !exists $self->{delete}{"\L$table\E"}) 4080 { 4081 # Set search path 4082 my $search_path = $self->set_search_path(); 4083 if (!$self->{oracle_speed}) 4084 { 4085 if ($search_path) 4086 { 4087 $self->logit("Setting search_path using: $search_path...\n", 1); 4088 $local_dbh->do($search_path) or $self->logit("FATAL: " . $local_dbh->errstr . "\n", 0, 1); 4089 } 4090 $self->logit("Truncating table $table...\n", 1); 4091 my $s = $local_dbh->do("TRUNCATE TABLE $tmptb;") or $self->logit("FATAL: " . $local_dbh->errstr . "\n", 0, 1); 4092 } 4093 } 4094 4095 $total_record = $self->_dump_fdw_table($dirprefix, $sql_header, $table, $local_dbh); 4096 4097 # close the connection with parallel table export 4098 if ($self->{parallel_tables} > 1) { 4099 $local_dbh->disconnect() if (defined $local_dbh); 4100 } 4101 4102 return $total_record; 4103} 4104 4105sub rename_dump_partfile 4106{ 4107 my ($self, $dirprefix, $partname, $tbl) = @_; 4108 4109 my $filename = "${dirprefix}tmp_${partname}_$self->{output}"; 4110 my $filedest = "${dirprefix}${partname}_$self->{output}"; 4111 if ($tbl && $self->{prefix_partition}) { 4112 $filename = "${dirprefix}tmp_${tbl}_${partname}_$self->{output}"; 4113 $filedest = "${dirprefix}${tbl}_${partname}_$self->{output}"; 4114 } 4115 if (-e $filename) { 4116 $self->logit("Renaming temporary file $filename into $filedest\n", 1); 4117 rename($filename, $filedest); 4118 } 4119} 4120 4121sub set_refresh_count 4122{ 4123 my $count = shift; 4124 4125 return 500 if ($count > 10000); 4126 return 100 if ($count > 1000); 4127 return 10 if ($count > 100); 4128 return 1; 4129} 4130 4131sub translate_function 4132{ 4133 my ($self, $i, $num_total_function, %functions) = @_; 4134 4135 my $dirprefix = ''; 4136 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 4137 4138 # Clear memory in multiprocess mode 4139 if ($self->{jobs} > 1) { 4140 $self->{functions} = (); 4141 $self->{procedures} = (); 4142 } 4143 4144 my $t0 = Benchmark->new; 4145 4146 my $sql_output = ''; 4147 my $lsize = 0; 4148 my $lcost = 0; 4149 my $fct_count = 0; 4150 my $PGBAR_REFRESH = set_refresh_count($num_total_function); 4151 foreach my $fct (sort keys %functions) 4152 { 4153 if (!$self->{quiet} && !$self->{debug} && ($fct_count % $PGBAR_REFRESH) == 0) 4154 { 4155 print STDERR $self->progress_bar($i+1, $num_total_function, 25, '=', 'functions', "generating $fct" ), "\r"; 4156 } 4157 $fct_count++; 4158 $self->logit("Dumping function $fct...\n", 1); 4159 if ($self->{file_per_function}) { 4160 my $f = "$dirprefix${fct}_$self->{output}"; 4161 $f =~ s/\.(?:gz|bz2)$//i; 4162 $self->dump("\\i$self->{psql_relative_path} $f\n"); 4163 $self->save_filetoupdate_list("ORA2PG_$self->{type}", lc($fct), "$dirprefix${fct}_$self->{output}"); 4164 } else { 4165 $self->save_filetoupdate_list("ORA2PG_$self->{type}", lc($fct), "$dirprefix$self->{output}"); 4166 } 4167 4168 my $fhdl = undef; 4169 4170 $self->_remove_comments(\$functions{$fct}{text}); 4171 $lsize = length($functions{$fct}{text}); 4172 4173 if ($self->{file_per_function}) 4174 { 4175 $self->logit("Dumping to one file per function : ${fct}_$self->{output}\n", 1); 4176 $fhdl = $self->open_export_file("${fct}_$self->{output}"); 4177 $self->set_binmode($fhdl) if (!$self->{compress}); 4178 } 4179 if ($self->{plsql_pgsql}) 4180 { 4181 my $sql_f = ''; 4182 if ($self->{is_mysql}) { 4183 $sql_f = $self->_convert_function($functions{$fct}{owner}, $functions{$fct}{text}, $fct); 4184 } else { 4185 $sql_f = $self->_convert_function($functions{$fct}{owner}, $functions{$fct}{text}); 4186 } 4187 if ( $sql_f ) 4188 { 4189 $sql_output .= $sql_f . "\n\n"; 4190 if ($self->{estimate_cost}) 4191 { 4192 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $sql_f); 4193 $cost += $Ora2Pg::PLSQL::OBJECT_SCORE{'FUNCTION'}; 4194 $lcost += $cost; 4195 $self->logit("Function ${fct} estimated cost: $cost\n", 1); 4196 $sql_output .= "-- Function ${fct} estimated cost: $cost\n"; 4197 foreach (sort { $cost_detail{$b} <=> $cost_detail{$a} } keys %cost_detail) 4198 { 4199 next if (!$cost_detail{$_}); 4200 $sql_output .= "\t-- $_ => $cost_detail{$_}"; 4201 if (!$self->{is_mysql}) { 4202 $sql_output .= " (cost: $Ora2Pg::PLSQL::UNCOVERED_SCORE{$_})" if ($Ora2Pg::PLSQL::UNCOVERED_SCORE{$_}); 4203 } else { 4204 $sql_output .= " (cost: $Ora2Pg::PLSQL::UNCOVERED_MYSQL_SCORE{$_})" if ($Ora2Pg::PLSQL::UNCOVERED_MYSQL_SCORE{$_}); 4205 } 4206 $sql_output .= "\n"; 4207 } 4208 if ($self->{jobs} > 1) 4209 { 4210 my $tfh = $self->append_export_file($dirprefix . 'temp_cost_file.dat', 1); 4211 flock($tfh, 2) || die "FATAL: can't lock file temp_cost_file.dat\n"; 4212 $tfh->print("${fct}:$lsize:$lcost\n"); 4213 $self->close_export_file($tfh, 1); 4214 } 4215 } 4216 } 4217 } 4218 else 4219 { 4220 $sql_output .= $functions{$fct}{text} . "\n\n"; 4221 } 4222 $self->_restore_comments(\$sql_output); 4223 if ($self->{plsql_pgsql}) { 4224 $sql_output =~ s/(-- REVOKE ALL ON (?:FUNCTION|PROCEDURE) [^;]+ FROM PUBLIC;)/&remove_newline($1)/sge; 4225 } 4226 4227 my $sql_header = "-- Generated by Ora2Pg, the Oracle database Schema converter, version $VERSION\n"; 4228 $sql_header .= "-- Copyright 2000-2021 Gilles DAROLD. All rights reserved.\n"; 4229 $sql_header .= "-- DATASOURCE: $self->{oracle_dsn}\n\n"; 4230 if ($self->{client_encoding}) { 4231 $sql_header .= "SET client_encoding TO '\U$self->{client_encoding}\E';\n\n"; 4232 } 4233 if ($self->{type} ne 'TABLE') { 4234 $sql_header .= $self->set_search_path(); 4235 } 4236 $sql_header .= "\\set ON_ERROR_STOP ON\n\n" if ($self->{stop_on_error}); 4237 $sql_header .= "SET check_function_bodies = false;\n\n" if (!$self->{function_check}); 4238 $sql_header = '' if ($self->{no_header}); 4239 4240 if ($self->{file_per_function}) { 4241 $self->dump($sql_header . $sql_output, $fhdl); 4242 $self->close_export_file($fhdl); 4243 $sql_output = ''; 4244 } 4245 } 4246 4247 my $t1 = Benchmark->new; 4248 my $td = timediff($t1, $t0); 4249 $self->logit("Translating of $fct_count functions took: " . timestr($td) . "\n", 1); 4250 4251 return ($sql_output, $lsize, $lcost); 4252} 4253 4254sub _replace_declare_var 4255{ 4256 my ($self, $code) = @_; 4257 4258 if ($$code =~ s/\b(DECLARE\s+(?:.*?)\s+BEGIN)/\%DECLARE\%/is) { 4259 my $declare = $1; 4260 # Collect user defined function 4261 while ($declare =~ s/\b([^\s]+)\s+EXCEPTION\s*;//i) { 4262 my $e = lc($1); 4263 if (!exists $Ora2Pg::PLSQL::EXCEPTION_MAP{"\U$e\L"} && !grep(/^$e$/, values %Ora2Pg::PLSQL::EXCEPTION_MAP) && !exists $self->{custom_exception}{$e}) { 4264 $self->{custom_exception}{$e} = $self->{exception_id}++; 4265 } 4266 } 4267 $declare =~ s/PRAGMA\s+EXCEPTION_INIT[^;]*;//igs; 4268 if ($self->{is_mysql}) { 4269 ($$code, $declare) = Ora2Pg::MySQL::replace_mysql_variables($self, $$code, $declare); 4270 } 4271 $$code =~ s/\%DECLARE\%/$declare/is; 4272 } elsif ($self->{is_mysql}) { 4273 ($$code, $declare) = Ora2Pg::MySQL::replace_mysql_variables($self, $$code, $declare); 4274 $$code = "DECLARE\n" . $declare . "\n" . $$code if ($declare); 4275 } 4276 4277 # Replace call to raise exception 4278 foreach my $e (keys %{$self->{custom_exception}}) { 4279 $$code =~ s/\bRAISE\s+$e\b/RAISE EXCEPTION '$e' USING ERRCODE = '$self->{custom_exception}{$e}'/igs; 4280 $$code =~ s/(\s+WHEN\s+)$e\s+/$1SQLSTATE '$self->{custom_exception}{$e}' /igs; 4281 } 4282 4283} 4284 4285# Routine used to save the file to update in pass2 of translation 4286sub save_filetoupdate_list 4287{ 4288 my ($self, $pname, $ftcname, $file_name) = @_; 4289 4290 my $dirprefix = ''; 4291 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 4292 4293 my $tfh = $self->append_export_file($dirprefix . 'temp_pass2_file.dat', 1); 4294 flock($tfh, 2) || die "FATAL: can't lock file temp_pass2_file.dat\n"; 4295 $tfh->print("${pname}:${ftcname}:$file_name\n"); 4296 $self->close_export_file($tfh, 1); 4297} 4298 4299=head2 _set_file_header 4300 4301Returns a string containing the common header of each output file. 4302 4303=cut 4304 4305sub _set_file_header 4306{ 4307 my $self = shift(); 4308 4309 return '' if ($self->{no_header}); 4310 4311 my $sql_header = "-- Generated by Ora2Pg, the Oracle database Schema converter, version $VERSION\n"; 4312 $sql_header .= "-- Copyright 2000-2021 Gilles DAROLD. All rights reserved.\n"; 4313 $sql_header .= "-- DATASOURCE: $self->{oracle_dsn}\n\n"; 4314 if ($self->{client_encoding}) 4315 { 4316 $sql_header .= "SET client_encoding TO '\U$self->{client_encoding}\E';\n\n"; 4317 } 4318 if ($self->{type} ne 'TABLE') 4319 { 4320 $sql_header .= $self->set_search_path(); 4321 } 4322 $sql_header .= "\\set ON_ERROR_STOP ON\n\n" if ($self->{stop_on_error}); 4323 $sql_header .= "SET check_function_bodies = false;\n\n" if (!$self->{function_check}); 4324 4325 return $sql_header; 4326} 4327 4328=head2 export_view 4329 4330Export Oracle view into PostgreSQL compatible SQL statements. 4331 4332=cut 4333 4334sub export_view 4335{ 4336 my $self = shift; 4337 4338 my $sql_header = $self->_set_file_header(); 4339 my $sql_output = ""; 4340 4341 $self->logit("Add views definition...\n", 1); 4342 4343 # Read DML from file if any 4344 if ($self->{input_file}) { 4345 $self->read_view_from_file(); 4346 } 4347 my $nothing = 0; 4348 $self->dump($sql_header); 4349 my $dirprefix = ''; 4350 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 4351 my $i = 1; 4352 my $num_total_view = scalar keys %{$self->{views}}; 4353 %ordered_views = %{$self->{views}}; 4354 my $count_view = 0; 4355 my $PGBAR_REFRESH = set_refresh_count($num_total_view); 4356 foreach my $view (sort sort_view_by_iter keys %ordered_views) 4357 { 4358 $self->logit("\tAdding view $view...\n", 1); 4359 if (!$self->{quiet} && !$self->{debug} && ($count_view % $PGBAR_REFRESH) == 0) 4360 { 4361 print STDERR $self->progress_bar($i, $num_total_view, 25, '=', 'views', "generating $view" ), "\r"; 4362 } 4363 $count_view++; 4364 my $fhdl = undef; 4365 if ($self->{file_per_table}) 4366 { 4367 my $file_name = "$dirprefix${view}_$self->{output}"; 4368 $file_name =~ s/\.(gz|bz2)$//; 4369 $self->dump("\\i$self->{psql_relative_path} $file_name\n"); 4370 $self->logit("Dumping to one file per view : ${view}_$self->{output}\n", 1); 4371 $fhdl = $self->open_export_file("${view}_$self->{output}"); 4372 $self->set_binmode($fhdl) if (!$self->{compress}); 4373 $self->save_filetoupdate_list("ORA2PG_$self->{type}", lc($view), $file_name); 4374 } else { 4375 $self->save_filetoupdate_list("ORA2PG_$self->{type}", lc($view), "$dirprefix$self->{output}"); 4376 } 4377 $self->_remove_comments(\$self->{views}{$view}{text}); 4378 if (!$self->{pg_supports_checkoption}) { 4379 $self->{views}{$view}{text} =~ s/\s*WITH\s+CHECK\s+OPTION//is; 4380 } 4381 # Remove unsupported definitions from the ddl statement 4382 $self->{views}{$view}{text} =~ s/\s*WITH\s+READ\s+ONLY//is; 4383 $self->{views}{$view}{text} =~ s/\s*OF\s+([^\s]+)\s+(WITH|UNDER)\s+[^\)]+\)//is; 4384 $self->{views}{$view}{text} =~ s/\s*OF\s+XMLTYPE\s+[^\)]+\)//is; 4385 $self->{views}{$view}{text} = $self->_format_view($view, $self->{views}{$view}{text}); 4386 my $tmpv = $view; 4387 if (exists $self->{replaced_tables}{"\L$tmpv\E"} && $self->{replaced_tables}{"\L$tmpv\E"}) 4388 { 4389 $self->logit("\tReplacing table $tmpv as " . $self->{replaced_tables}{lc($tmpv)} . "...\n", 1); 4390 $tmpv = $self->{replaced_tables}{lc($tmpv)}; 4391 } 4392 if ($self->{export_schema} && !$self->{schema} && ($tmpv =~ /^([^\.]+)\./) ) { 4393 $sql_output .= $self->set_search_path($1) . "\n"; 4394 } 4395 $tmpv = $self->quote_object_name($tmpv); 4396 4397 if (!@{$self->{views}{$view}{alias}}) 4398 { 4399 $sql_output .= "CREATE$self->{create_or_replace} VIEW $tmpv AS "; 4400 $sql_output .= $self->{views}{$view}{text}; 4401 $sql_output .= ';' if ($sql_output !~ /;\s*$/s); 4402 $sql_output .= "\n"; 4403 if ($self->{estimate_cost}) { 4404 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $self->{views}{$view}{text}, 'VIEW'); 4405 $cost += $Ora2Pg::PLSQL::OBJECT_SCORE{'VIEW'}; 4406 $cost_value += $cost; 4407 $sql_output .= "\n-- Estimed cost of view [ $view ]: " . sprintf("%2.2f", $cost); 4408 } 4409 $sql_output .= "\n"; 4410 } 4411 else 4412 { 4413 $sql_output .= "CREATE$self->{create_or_replace} VIEW $tmpv ("; 4414 my $count = 0; 4415 my %col_to_replace = (); 4416 foreach my $d (@{$self->{views}{$view}{alias}}) 4417 { 4418 if ($count == 0) { 4419 $count = 1; 4420 } else { 4421 $sql_output .= ", "; 4422 } 4423 # Change column names 4424 my $fname = $d->[0]; 4425 if (exists $self->{replaced_cols}{"\L$view\E"}{"\L$fname\E"} && $self->{replaced_cols}{"\L$view\E"}{"\L$fname\E"}) 4426 { 4427 $self->logit("\tReplacing column \L$d->[0]\E as " . $self->{replaced_cols}{"\L$view\E"}{"\L$fname\E"} . "...\n", 1); 4428 $fname = $self->{replaced_cols}{"\L$view\E"}{"\L$fname\E"}; 4429 } 4430 $sql_output .= $self->quote_object_name($fname); 4431 } 4432 $sql_output .= ") AS " . $self->{views}{$view}{text}; 4433 $sql_output .= ';' if ($sql_output !~ /;\s*$/s); 4434 $sql_output .= "\n"; 4435 if ($self->{estimate_cost}) 4436 { 4437 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $self->{views}{$view}{text}, 'VIEW'); 4438 $cost += $Ora2Pg::PLSQL::OBJECT_SCORE{'VIEW'}; 4439 $cost_value += $cost; 4440 $sql_output .= "\n-- Estimed cost of view [ $view ]: " . sprintf("%2.2f", $cost); 4441 } 4442 $sql_output .= "\n"; 4443 } 4444 4445 if ($self->{force_owner}) 4446 { 4447 my $owner = $self->{views}{$view}{owner}; 4448 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 4449 $sql_output .= "ALTER VIEW $tmpv OWNER TO " . $self->quote_object_name($owner) . ";\n"; 4450 } 4451 4452 # Add comments on view and columns 4453 if (!$self->{disable_comment}) 4454 { 4455 if ($self->{views}{$view}{comment}) 4456 { 4457 $sql_output .= "COMMENT ON VIEW $tmpv "; 4458 $self->{views}{$view}{comment} =~ s/'/''/gs; 4459 $sql_output .= " IS E'" . $self->{views}{$view}{comment} . "';\n\n"; 4460 } 4461 4462 foreach my $f (sort { lc{$a} cmp lc($b) } keys %{$self->{views}{$view}{column_comments}}) 4463 { 4464 next unless $self->{views}{$view}{column_comments}{$f}; 4465 $self->{views}{$view}{column_comments}{$f} =~ s/'/''/gs; 4466 # Change column names 4467 my $fname = $f; 4468 if (exists $self->{replaced_cols}{"\L$view\E"}{"\L$f\E"} && $self->{replaced_cols}{"\L$view\E"}{"\L$f\E"}) { 4469 $fname = $self->{replaced_cols}{"\L$view\E"}{"\L$f\E"}; 4470 } 4471 $sql_output .= "COMMENT ON COLUMN " . $self->quote_object_name($tmpv) . '.' 4472 . $self->quote_object_name($fname) 4473 . " IS E'" . $self->{views}{$view}{column_comments}{$f} . "';\n"; 4474 } 4475 } 4476 4477 if ($self->{file_per_table}) 4478 { 4479 $self->dump($sql_header . $sql_output, $fhdl); 4480 $self->_restore_comments(\$sql_output); 4481 $self->close_export_file($fhdl); 4482 $sql_output = ''; 4483 } 4484 $nothing++; 4485 $i++; 4486 4487 } 4488 %ordered_views = (); 4489 4490 if (!$self->{quiet} && !$self->{debug}) { 4491 print STDERR $self->progress_bar($i - 1, $num_total_view, 25, '=', 'views', 'end of output.'), "\n"; 4492 } 4493 4494 if (!$nothing) { 4495 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 4496 } else { 4497 $sql_output .= "\n"; 4498 } 4499 4500 $self->dump($sql_output); 4501 4502 return; 4503} 4504 4505=head2 export_mview 4506 4507Export Oracle materialized view into PostgreSQL compatible SQL statements. 4508 4509=cut 4510 4511sub export_mview 4512{ 4513 my $self = shift; 4514 4515 my $sql_header = $self->_set_file_header(); 4516 my $sql_output = ""; 4517 4518 $self->logit("Add materialized views definition...\n", 1); 4519 4520 my $nothing = 0; 4521 $self->dump($sql_header) if ($self->{file_per_table} && !$self->{pg_dsn}); 4522 my $dirprefix = ''; 4523 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 4524 if ($self->{plsql_pgsql} && !$self->{pg_supports_mview}) 4525 { 4526 $sql_header .= "DROP TABLE IF EXISTS materialized_views;\n" if ($self->{drop_if_exists}); 4527 my $sqlout = qq{ 4528$sql_header 4529 4530CREATE TABLE materialized_views ( 4531mview_name text NOT NULL PRIMARY KEY, 4532view_name text NOT NULL, 4533iname text, 4534last_refresh TIMESTAMP WITH TIME ZONE 4535); 4536 4537CREATE OR REPLACE FUNCTION create_materialized_view(text, text, text) 4538RETURNS VOID 4539AS \$\$ 4540DECLARE 4541mview ALIAS FOR \$1; -- name of the materialized view to create 4542vname ALIAS FOR \$2; -- name of the related view 4543iname ALIAS FOR \$3; -- name of the colum of mview to used as unique key 4544entry materialized_views%ROWTYPE; 4545BEGIN 4546EXECUTE 'SELECT * FROM materialized_views WHERE mview_name = ' || quote_literal(mview) || '' INTO entry; 4547IF entry.iname IS NOT NULL THEN 4548RAISE EXCEPTION 'Materialized view % already exist.', mview; 4549END IF; 4550 4551EXECUTE 'REVOKE ALL ON ' || quote_ident(vname) || ' FROM PUBLIC'; 4552EXECUTE 'GRANT SELECT ON ' || quote_ident(vname) || ' TO PUBLIC'; 4553EXECUTE 'CREATE TABLE ' || quote_ident(mview) || ' AS SELECT * FROM ' || quote_ident(vname); 4554EXECUTE 'REVOKE ALL ON ' || quote_ident(mview) || ' FROM PUBLIC'; 4555EXECUTE 'GRANT SELECT ON ' || quote_ident(mview) || ' TO PUBLIC'; 4556INSERT INTO materialized_views (mview_name, view_name, iname, last_refresh) 4557VALUES ( 4558quote_literal(mview), 4559quote_literal(vname), 4560quote_literal(iname), 4561CURRENT_TIMESTAMP 4562); 4563IF iname IS NOT NULL THEN 4564EXECUTE 'CREATE INDEX ' || quote_ident(mview) || '_' || quote_ident(iname) || '_idx ON ' || quote_ident(mview) || '(' || quote_ident(iname) || ')'; 4565END IF; 4566 4567RETURN; 4568END 4569\$\$ 4570SECURITY DEFINER 4571LANGUAGE plpgsql; 4572 4573CREATE OR REPLACE FUNCTION drop_materialized_view(text) RETURNS VOID 4574AS 4575\$\$ 4576DECLARE 4577mview ALIAS FOR \$1; 4578entry materialized_views%ROWTYPE; 4579BEGIN 4580EXECUTE 'SELECT * FROM materialized_views WHERE mview_name = ''' || quote_literal(mview) || '''' INTO entry; 4581IF entry.iname IS NULL THEN 4582RAISE EXCEPTION 'Materialized view % does not exist.', mview; 4583END IF; 4584 4585IF entry.iname IS NOT NULL THEN 4586EXECUTE 'DROP INDEX ' || quote_ident(mview) || '_' || entry.iname || '_idx'; 4587END IF; 4588EXECUTE 'DROP TABLE ' || quote_ident(mview); 4589EXECUTE 'DELETE FROM materialized_views WHERE mview_name=''' || quote_literal(mview) || ''''; 4590 4591RETURN; 4592END 4593\$\$ 4594SECURITY DEFINER 4595LANGUAGE plpgsql ; 4596 4597CREATE OR REPLACE FUNCTION refresh_full_materialized_view(text) RETURNS VOID 4598AS \$\$ 4599DECLARE 4600mview ALIAS FOR \$1; 4601entry materialized_views%ROWTYPE; 4602BEGIN 4603EXECUTE 'SELECT * FROM materialized_views WHERE mview_name = ''' || quote_literal(mview) || '''' INTO entry; 4604IF entry.iname IS NULL THEN 4605RAISE EXCEPTION 'Materialized view % does not exist.', mview; 4606END IF; 4607 4608IF entry.iname IS NOT NULL THEN 4609EXECUTE 'DROP INDEX ' || quote_ident(mview) || '_' || entry.iname || '_idx'; 4610END IF; 4611EXECUTE 'TRUNCATE ' || quote_ident(mview); 4612EXECUTE 'INSERT INTO ' || quote_ident(mview) || ' SELECT * FROM ' || entry.view_name; 4613EXECUTE 'UPDATE materialized_views SET last_refresh=CURRENT_TIMESTAMP WHERE mview_name=''' || quote_literal(mview) || ''''; 4614 4615IF entry.iname IS NOT NULL THEN 4616EXECUTE 'CREATE INDEX ' || quote_ident(mview) || '_' || entry.iname || '_idx ON ' || quote_ident(mview) || '(' || entry.iname || ')'; 4617END IF; 4618 4619RETURN; 4620END 4621\$\$ 4622SECURITY DEFINER 4623LANGUAGE plpgsql ; 4624 4625}; 4626 $self->dump($sqlout); 4627 } 4628 my $i = 1; 4629 my $num_total_mview = scalar keys %{$self->{materialized_views}}; 4630 my $count_mview = 0; 4631 my $PGBAR_REFRESH = set_refresh_count($num_total_mview); 4632 foreach my $view (sort { $a cmp $b } keys %{$self->{materialized_views}}) 4633 { 4634 $self->logit("\tAdding materialized view $view...\n", 1); 4635 if (!$self->{quiet} && !$self->{debug} && ($count_mview % $PGBAR_REFRESH) == 0) { 4636 print STDERR $self->progress_bar($i, $num_total_mview, 25, '=', 'materialized views', "generating $view" ), "\r"; 4637 } 4638 $count_mview++; 4639 my $fhdl = undef; 4640 if ($self->{file_per_table} && !$self->{pg_dsn}) { 4641 my $file_name = "$dirprefix${view}_$self->{output}"; 4642 $file_name =~ s/\.(gz|bz2)$//; 4643 $self->dump("\\i$self->{psql_relative_path} $file_name\n"); 4644 $self->logit("Dumping to one file per materialized view : ${view}_$self->{output}\n", 1); 4645 $fhdl = $self->open_export_file("${view}_$self->{output}"); 4646 $self->set_binmode($fhdl) if (!$self->{compress}); 4647 $self->save_filetoupdate_list("ORA2PG_$self->{type}", lc($view), $file_name); 4648 } else { 4649 $self->save_filetoupdate_list("ORA2PG_$self->{type}", lc($view), "$dirprefix$self->{output}"); 4650 } 4651 if (!$self->{plsql_pgsql}) 4652 { 4653 $sql_output .= "DROP MATERIALIZED VIEW IF EXISTS $view;\n" if ($self->{drop_if_exists}); 4654 $sql_output .= "CREATE MATERIALIZED VIEW $view\n"; 4655 $sql_output .= "BUILD $self->{materialized_views}{$view}{build_mode}\n"; 4656 $sql_output .= "REFRESH $self->{materialized_views}{$view}{refresh_method} ON $self->{materialized_views}{$view}{refresh_mode}\n"; 4657 $sql_output .= "ENABLE QUERY REWRITE" if ($self->{materialized_views}{$view}{rewritable}); 4658 $sql_output .= "AS $self->{materialized_views}{$view}{text}"; 4659 $sql_output .= " USING INDEX" if ($self->{materialized_views}{$view}{no_index}); 4660 $sql_output .= " USING NO INDEX" if (!$self->{materialized_views}{$view}{no_index}); 4661 $sql_output .= ";\n\n"; 4662 4663 # Set the index definition 4664 my ($idx, $fts_idx) = $self->_create_indexes($view, 0, %{$self->{materialized_views}{$view}{indexes}}); 4665 $sql_output .= "$idx$fts_idx\n\n"; 4666 } else { 4667 $self->{materialized_views}{$view}{text} = $self->_format_view($view, $self->{materialized_views}{$view}{text}); 4668 if (!$self->{preserve_case}) { 4669 $self->{materialized_views}{$view}{text} =~ s/"//gs; 4670 } 4671 if ($self->{export_schema} && !$self->{schema} && ($view =~ /^([^\.]+)\./) ) { 4672 $sql_output .= $self->set_search_path($1) . "\n"; 4673 } 4674 $self->{materialized_views}{$view}{text} =~ s/^PERFORM/SELECT/; 4675 if (!$self->{pg_supports_mview}) 4676 { 4677 $sql_output .= "DROP VIEW IF EXISTS \L$view\E_mview;\n" if ($self->{drop_if_exists}); 4678 $sql_output .= "CREATE VIEW \L$view\E_mview AS\n"; 4679 $sql_output .= $self->{materialized_views}{$view}{text}; 4680 $sql_output .= ";\n\n"; 4681 $sql_output .= "SELECT create_materialized_view('\L$view\E','\L$view\E_mview', change with the name of the colum to used for the index);\n\n\n"; 4682 4683 if ($self->{force_owner}) 4684 { 4685 my $owner = $self->{materialized_views}{$view}{owner}; 4686 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 4687 $sql_output .= "ALTER VIEW " . $self->quote_object_name($view . '_mview') 4688 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 4689 } 4690 } 4691 else 4692 { 4693 $sql_output .= "DROP MATERIALIZED VIEW IF EXISTS \L$view\E;\n" if ($self->{drop_if_exists}); 4694 $sql_output .= "CREATE MATERIALIZED VIEW \L$view\E AS\n"; 4695 $sql_output .= $self->{materialized_views}{$view}{text}; 4696 if ($self->{materialized_views}{$view}{build_mode} eq 'DEFERRED') { 4697 $sql_output .= " WITH NO DATA"; 4698 } 4699 $sql_output .= ";\n"; 4700 # Set the index definition 4701 my ($idx, $fts_idx) = $self->_create_indexes($view, 0, %{$self->{materialized_views}{$view}{indexes}}); 4702 $sql_output .= "$idx$fts_idx\n\n"; 4703 } 4704 } 4705 if ($self->{force_owner}) 4706 { 4707 my $owner = $self->{materialized_views}{$view}{owner}; 4708 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 4709 $sql_output .= "ALTER MATERIALIZED VIEW " . $self->quote_object_name($view) 4710 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 4711 } 4712 4713 if ($self->{file_per_table} && !$self->{pg_dsn}) 4714 { 4715 $self->dump($sql_header . $sql_output, $fhdl); 4716 $self->close_export_file($fhdl); 4717 $sql_output = ''; 4718 } 4719 $nothing++; 4720 $i++; 4721 } 4722 if (!$self->{quiet} && !$self->{debug}) { 4723 print STDERR $self->progress_bar($i - 1, $num_total_mview, 25, '=', 'materialized views', 'end of output.'), "\n"; 4724 } 4725 if (!$nothing) { 4726 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 4727 } 4728 4729 $self->dump($sql_output); 4730 4731 return; 4732} 4733 4734=head2 export_grant 4735 4736Export Oracle user grants into PostgreSQL compatible SQL statements. 4737 4738=cut 4739 4740sub export_grant 4741{ 4742 my $self = shift; 4743 4744 my $sql_header = $self->_set_file_header(); 4745 my $sql_output = ""; 4746 4747 $self->logit("Add users/roles/grants privileges...\n", 1); 4748 4749 my $grants = ''; 4750 my $users = ''; 4751 4752 # Read DML from file if any 4753 if ($self->{input_file}) { 4754 $self->read_grant_from_file(); 4755 } 4756 4757 # Do not create privilege defintiion if object type is USER 4758 delete $self->{grants} if ($self->{grant_object} && $self->{grant_object} eq 'USER'); 4759 4760 # Add privilege definition 4761 foreach my $table (sort {"$self->{grants}{$a}{type}.$a" cmp "$self->{grants}{$b}{type}.$b" } keys %{$self->{grants}}) { 4762 my $realtable = lc($table); 4763 my $obj = $self->{grants}{$table}{type} || 'TABLE'; 4764 if ($self->{export_schema} && $self->{schema}) { 4765 $realtable = $self->quote_object_name("$self->{schema}.$table"); 4766 } elsif ($self->{preserve_case}) { 4767 $realtable = $self->quote_object_name($table); 4768 } 4769 $grants .= "-- Set priviledge on $self->{grants}{$table}{type} $table\n"; 4770 4771 my $ownee = $self->quote_object_name($self->{grants}{$table}{owner}); 4772 4773 my $wgrantoption = ''; 4774 if ($self->{grants}{$table}{grantable}) { 4775 $wgrantoption = ' WITH GRANT OPTION'; 4776 } 4777 if ($self->{grants}{$table}{type} ne 'PACKAGE BODY') { 4778 if ($self->{grants}{$table}{owner}) { 4779 if (grep(/^$self->{grants}{$table}{owner}$/, @{$self->{roles}{roles}})) { 4780 $grants .= "ALTER $obj $realtable OWNER TO ROLE $ownee;\n"; 4781 $obj = '' if (!grep(/^$obj$/, 'FUNCTION', 'SEQUENCE','SCHEMA','TABLESPACE')); 4782 $grants .= "GRANT ALL ON $obj $realtable TO ROLE $ownee$wgrantoption;\n"; 4783 } else { 4784 $grants .= "ALTER $obj $realtable OWNER TO $ownee;\n"; 4785 $obj = '' if (!grep(/^$obj$/, 'FUNCTION', 'SEQUENCE','SCHEMA','TABLESPACE')); 4786 $grants .= "GRANT ALL ON $obj $realtable TO $ownee$wgrantoption;\n"; 4787 } 4788 } 4789 if (grep(/^$self->{grants}{$table}{type}$/, 'FUNCTION', 'SEQUENCE','SCHEMA','TABLESPACE')) { 4790 $grants .= "REVOKE ALL ON $self->{grants}{$table}{type} $realtable FROM PUBLIC;\n"; 4791 } else { 4792 $grants .= "REVOKE ALL ON $realtable FROM PUBLIC;\n"; 4793 } 4794 } else { 4795 if ($self->{grants}{$table}{owner}) { 4796 if (grep(/^$self->{grants}{$table}{owner}$/, @{$self->{roles}{roles}})) { 4797 $grants .= "ALTER SCHEMA $realtable OWNER TO ROLE $ownee;\n"; 4798 $grants .= "GRANT ALL ON SCHEMA $realtable TO ROLE $ownee$wgrantoption;\n"; 4799 } else { 4800 $grants .= "ALTER SCHEMA $realtable OWNER TO $ownee;\n"; 4801 $grants .= "GRANT ALL ON SCHEMA $realtable TO $ownee$wgrantoption;\n"; 4802 } 4803 } 4804 $grants .= "REVOKE ALL ON SCHEMA $realtable FROM PUBLIC;\n"; 4805 } 4806 foreach my $usr (sort keys %{$self->{grants}{$table}{privilege}}) { 4807 my $agrants = ''; 4808 foreach my $g (@GRANTS) { 4809 $agrants .= "$g," if (grep(/^$g$/i, @{$self->{grants}{$table}{privilege}{$usr}})); 4810 } 4811 $agrants =~ s/,$//; 4812 $usr = $self->quote_object_name($usr); 4813 if ($self->{grants}{$table}{type} ne 'PACKAGE BODY') { 4814 if (grep(/^$self->{grants}{$table}{type}$/, 'FUNCTION', 'SEQUENCE','SCHEMA','TABLESPACE', 'TYPE')) { 4815 $grants .= "GRANT $agrants ON $obj $realtable TO $usr$wgrantoption;\n"; 4816 } else { 4817 $grants .= "GRANT $agrants ON $realtable TO $usr$wgrantoption;\n"; 4818 } 4819 } else { 4820 $grants .= "GRANT USAGE ON SCHEMA $realtable TO $usr$wgrantoption;\n"; 4821 $grants .= "GRANT EXECUTE ON ALL FUNCTIONS IN SCHEMA $realtable TO $usr$wgrantoption;\n"; 4822 } 4823 } 4824 $grants .= "\n"; 4825 } 4826 4827 # Do not create user when privilege on an object type is asked 4828 delete $self->{roles} if ($self->{grant_object} && $self->{grant_object} ne 'USER'); 4829 4830 foreach my $r (@{$self->{roles}{owner}}, @{$self->{roles}{grantee}}) 4831 { 4832 my $secret = 'change_my_secret'; 4833 if ($self->{gen_user_pwd}) { 4834 $secret = &randpattern("CccnCccn"); 4835 } 4836 $sql_header .= "CREATE " . ($self->{roles}{type}{$r} ||'USER') . " $r"; 4837 $sql_header .= " WITH PASSWORD '$secret'" if ($self->{roles}{password_required}{$r} ne 'NO'); 4838 # It's difficult to parse all oracle privilege. So if one admin option is set we set all PG admin option. 4839 if (grep(/YES|1/, @{$self->{roles}{$r}{admin_option}})) { 4840 $sql_header .= " CREATEDB CREATEROLE CREATEUSER INHERIT"; 4841 } 4842 if ($self->{roles}{type}{$r} eq 'USER') { 4843 $sql_header .= " LOGIN"; 4844 } 4845 if (exists $self->{roles}{role}{$r}) { 4846 $users .= " IN ROLE " . join(',', @{$self->{roles}{role}{$r}}); 4847 } 4848 $sql_header .= ";\n"; 4849 } 4850 if (!$grants) { 4851 $grants = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 4852 } 4853 4854 $sql_output .= "\n" . $grants . "\n" if ($grants); 4855 4856 $self->_restore_comments(\$grants); 4857 $self->dump($sql_header . $sql_output); 4858 4859 return; 4860} 4861 4862=head2 export_sequence 4863 4864Export Oracle sequence into PostgreSQL compatible SQL statements. 4865 4866=cut 4867 4868sub export_sequence 4869{ 4870 my $self = shift; 4871 4872 my $sql_header = $self->_set_file_header(); 4873 my $sql_output = ""; 4874 4875 $self->logit("Add sequences definition...\n", 1); 4876 4877 # Read DML from file if any 4878 if ($self->{input_file}) { 4879 $self->read_sequence_from_file(); 4880 } 4881 my $i = 1; 4882 my $num_total_sequence = scalar keys %{$self->{sequences}}; 4883 my $count_seq = 0; 4884 my $PGBAR_REFRESH = set_refresh_count($num_total_sequence); 4885 if ($self->{export_schema} && ($self->{pg_schema} || $self->{schema})) { 4886 $sql_output .= "CREATE SCHEMA IF NOT EXISTS " . $self->quote_object_name($self->{pg_schema} || $self->{schema}) . ";\n"; 4887 } 4888 foreach my $seq (sort keys %{$self->{sequences}}) 4889 { 4890 if (!$self->{quiet} && !$self->{debug} && ($count_seq % $PGBAR_REFRESH) == 0) { 4891 print STDERR $self->progress_bar($i, $num_total_sequence, 25, '=', 'sequences', "generating $seq" ), "\r"; 4892 } 4893 $count_seq++; 4894 my $cache = ''; 4895 $cache = $self->{sequences}{$seq}->[5] if ($self->{sequences}{$seq}->[5]); 4896 my $cycle = ''; 4897 $cycle = ' CYCLE' if ($self->{sequences}{$seq}->[6] eq 'Y'); 4898 $sql_output .= "DROP SEQUENCE IF EXISTS " . $self->quote_object_name($seq) . ";\n" if ($self->{drop_if_exists}); 4899 $sql_output .= "CREATE SEQUENCE " . $self->quote_object_name($seq) . " INCREMENT $self->{sequences}{$seq}->[3]"; 4900 if ($self->{sequences}{$seq}->[1] eq '' || $self->{sequences}{$seq}->[1] < (-2**63-1)) { 4901 $sql_output .= " NO MINVALUE"; 4902 } else { 4903 $sql_output .= " MINVALUE $self->{sequences}{$seq}->[1]"; 4904 } 4905 # Max value lower than start value are not allowed 4906 if (($self->{sequences}{$seq}->[2] > 0) && ($self->{sequences}{$seq}->[2] < $self->{sequences}{$seq}->[4])) { 4907 $self->{sequences}{$seq}->[2] = $self->{sequences}{$seq}->[4]; 4908 4909 } 4910 if ($self->{sequences}{$seq}->[2] eq '' || $self->{sequences}{$seq}->[2] > (2**63-1)) { 4911 $sql_output .= " NO MAXVALUE"; 4912 } else { 4913 $self->{sequences}{$seq}->[2] = 9223372036854775807 if ($self->{sequences}{$seq}->[2] > 9223372036854775807); 4914 $sql_output .= " MAXVALUE $self->{sequences}{$seq}->[2]"; 4915 } 4916 $sql_output .= " START $self->{sequences}{$seq}->[4]"; 4917 $sql_output .= " CACHE $cache" if ($cache ne ''); 4918 $sql_output .= "$cycle;\n"; 4919 4920 if ($self->{force_owner}) { 4921 my $owner = $self->{sequences}{$seq}->[7]; 4922 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 4923 $sql_output .= "ALTER SEQUENCE " . $self->quote_object_name($seq) 4924 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 4925 } 4926 $i++; 4927 } 4928 if (!$self->{quiet} && !$self->{debug}) { 4929 print STDERR $self->progress_bar($i - 1, $num_total_sequence, 25, '=', 'sequences', 'end of output.'), "\n"; 4930 } 4931 if (!$sql_output) { 4932 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 4933 } 4934 4935 $self->dump($sql_header . $sql_output); 4936 4937 return; 4938} 4939 4940=head2 export_dblink 4941 4942Export Oracle sequence into PostgreSQL compatible SQL statements. 4943 4944=cut 4945 4946sub export_dblink 4947{ 4948 my $self = shift; 4949 4950 my $sql_header = $self->_set_file_header(); 4951 my $sql_output = ""; 4952 4953 $self->logit("Add dblink definition...\n", 1); 4954 4955 # Read DML from file if any 4956 if ($self->{input_file}) { 4957 $self->read_dblink_from_file(); 4958 } 4959 my $i = 1; 4960 my $num_total_dblink = scalar keys %{$self->{dblink}}; 4961 4962 foreach my $db (sort { $a cmp $b } keys %{$self->{dblink}}) 4963 { 4964 if (!$self->{quiet} && !$self->{debug}) { 4965 print STDERR $self->progress_bar($i, $num_total_dblink, 25, '=', 'dblink', "generating $db" ), "\r"; 4966 } 4967 $sql_output .= "CREATE SERVER " . $self->quote_object_name($db); 4968 if (!$self->{is_mysql}) { 4969 $sql_output .= " FOREIGN DATA WRAPPER oracle_fdw OPTIONS (dbserver '$self->{dblink}{$db}{host}');\n"; 4970 } else { 4971 $sql_output .= " FOREIGN DATA WRAPPER mysql_fdw OPTIONS (host '$self->{dblink}{$db}{host}'"; 4972 $sql_output .= ", port '$self->{dblink}{$db}{port}'" if ($self->{dblink}{$db}{port}); 4973 $sql_output .= ");\n"; 4974 } 4975 if ($self->{dblink}{$db}{password} ne 'NONE') { 4976 $self->{dblink}{$db}{password} ||= 'secret'; 4977 $self->{dblink}{$db}{password} = ", password '$self->{dblink}{$db}{password}'"; 4978 } 4979 if ($self->{dblink}{$db}{username}) { 4980 $sql_output .= "CREATE USER MAPPING FOR " . $self->quote_object_name($self->{dblink}{$db}{username}) 4981 . " SERVER " . $self->quote_object_name($db) 4982 . " OPTIONS (user '" . $self->quote_object_name($self->{dblink}{$db}{user}) 4983 . "' $self->{dblink}{$db}{password});\n"; 4984 } 4985 4986 if ($self->{force_owner}) { 4987 my $owner = $self->{dblink}{$db}{owner}; 4988 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 4989 $sql_output .= "ALTER FOREIGN DATA WRAPPER " . $self->quote_object_name($db) 4990 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 4991 } 4992 $i++; 4993 } 4994 if (!$self->{quiet} && !$self->{debug}) { 4995 print STDERR $self->progress_bar($i - 1, $num_total_dblink, 25, '=', 'dblink', 'end of output.'), "\n"; 4996 } 4997 if (!$sql_output) { 4998 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 4999 } 5000 5001 $self->dump($sql_header . $sql_output); 5002 5003 return; 5004} 5005 5006=head2 export_directory 5007 5008Export Oracle directory into PostgreSQL compatible SQL statements. 5009 5010=cut 5011 5012sub export_directory 5013{ 5014 my $self = shift; 5015 5016 my $sql_header = $self->_set_file_header(); 5017 my $sql_output = ""; 5018 5019 $self->logit("Add directory definition...\n", 1); 5020 5021 # Read DML from file if any 5022 if ($self->{input_file}) { 5023 $self->read_directory_from_file(); 5024 } 5025 my $i = 1; 5026 my $num_total_directory = scalar keys %{$self->{directory}}; 5027 5028 foreach my $db (sort { $a cmp $b } keys %{$self->{directory}}) { 5029 5030 if (!$self->{quiet} && !$self->{debug}) { 5031 print STDERR $self->progress_bar($i, $num_total_directory, 25, '=', 'directory', "generating $db" ), "\r"; 5032 } 5033 $sql_output .= "INSERT INTO external_file.directories (directory_name,directory_path) VALUES ('$db', '$self->{directory}{$db}{path}');\n"; 5034 foreach my $owner (keys %{$self->{directory}{$db}{grantee}}) { 5035 my $write = 'false'; 5036 $write = 'true' if ($self->{directory}{$db}{grantee}{$owner} =~ /write/i); 5037 $sql_output .= "INSERT INTO external_file.directory_roles(directory_name,directory_role,directory_read,directory_write) VALUES ('$db','" . $self->quote_object_name($owner) . "', true, $write);\n"; 5038 } 5039 $i++; 5040 } 5041 if (!$self->{quiet} && !$self->{debug}) { 5042 print STDERR $self->progress_bar($i - 1, $num_total_directory, 25, '=', 'directory', 'end of output.'), "\n"; 5043 } 5044 if (!$sql_output) { 5045 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 5046 } 5047 5048 $self->dump($sql_header . $sql_output); 5049 5050 return; 5051} 5052 5053=head2 export_trigger 5054 5055Export Oracle trigger into PostgreSQL compatible SQL statements. 5056 5057=cut 5058 5059sub export_trigger 5060{ 5061 my $self = shift; 5062 5063 my $sql_header = $self->_set_file_header(); 5064 my $sql_output = ""; 5065 5066 $self->logit("Add triggers definition...\n", 1); 5067 5068 $self->dump($sql_header); 5069 # Read DML from file if any 5070 if ($self->{input_file}) { 5071 $self->read_trigger_from_file(); 5072 } 5073 my $dirprefix = ''; 5074 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 5075 my $nothing = 0; 5076 my $i = 1; 5077 my $num_total_trigger = $#{$self->{triggers}} + 1; 5078 my $count_trig = 0; 5079 my $PGBAR_REFRESH = set_refresh_count($num_total_trigger); 5080 foreach my $trig (sort {$a->[0] cmp $b->[0]} @{$self->{triggers}}) 5081 { 5082 if (!$self->{quiet} && !$self->{debug} && ($count_trig % $PGBAR_REFRESH) == 0) { 5083 print STDERR $self->progress_bar($i, $num_total_trigger, 25, '=', 'triggers', "generating $trig->[0]" ), "\r"; 5084 } 5085 $count_trig++; 5086 my $fhdl = undef; 5087 if ($self->{file_per_function}) 5088 { 5089 my $schm = ''; 5090 $schm = $trig->[8] . '-' if ($self->{export_schema} && !$self->{schema}); 5091 my $f = "$dirprefix$schm$trig->[0]_$self->{output}"; 5092 $f =~ s/\.(?:gz|bz2)$//i; 5093 $self->dump("\\i$self->{psql_relative_path} $f\n"); 5094 $self->logit("Dumping to one file per trigger : $schm$trig->[0]_$self->{output}\n", 1); 5095 $fhdl = $self->open_export_file("$schm$trig->[0]_$self->{output}"); 5096 $self->set_binmode($fhdl) if (!$self->{compress}); 5097 $self->save_filetoupdate_list("ORA2PG_$self->{type}", lc($trig->[0]), "$dirprefix$schm$trig->[0]_$self->{output}"); 5098 } 5099 else 5100 { 5101 $self->save_filetoupdate_list("ORA2PG_$self->{type}", lc($trig->[0]), "$dirprefix$self->{output}"); 5102 } 5103 $trig->[1] =~ s/\s*EACH ROW//is; 5104 chomp($trig->[4]); 5105 5106 $trig->[4] =~ s/([^\*])[;\/]$/$1/; 5107 5108 $self->logit("\tDumping trigger $trig->[0] defined on table $trig->[3]...\n", 1); 5109 my $tbname = $self->get_replaced_tbname($trig->[3]); 5110 5111 # Store current trigger table name for possible use in outer join translation 5112 $self->{current_trigger_table} = $trig->[3]; 5113 5114 # Replace column name in function code 5115 if (exists $self->{replaced_cols}{"\L$trig->[3]\E"}) 5116 { 5117 foreach my $coln (sort keys %{$self->{replaced_cols}{"\L$trig->[3]\E"}}) 5118 { 5119 $self->logit("\tReplacing column \L$coln\E as " . $self->{replaced_cols}{"\L$trig->[3]\E"}{"\L$coln\E"} . "...\n", 1); 5120 my $cname = $self->{replaced_cols}{"\L$trig->[3]\E"}{"\L$coln\E"}; 5121 $cname = $self->quote_object_name($cname); 5122 $trig->[4] =~ s/(OLD|NEW)\.$coln\b/$1\.$cname/igs; 5123 $trig->[6] =~ s/\b$coln\b/$self->{replaced_cols}{"\L$trig->[3]\E"}{"\L$coln\E"}/is; 5124 } 5125 } 5126 # Extract columns specified in the UPDATE OF ... ON clause 5127 my $cols = ''; 5128 if ($trig->[2] =~ /UPDATE/ && $trig->[6] =~ /UPDATE\s+OF\s+(.*?)\s+ON/i) 5129 { 5130 my @defs = split(/\s*,\s*/, $1); 5131 $cols = ' OF '; 5132 foreach my $c (@defs) { 5133 $cols .= $self->quote_object_name($c) . ','; 5134 } 5135 $cols =~ s/,$//; 5136 } 5137 5138 if ($self->{export_schema} && !$self->{schema}) { 5139 $sql_output .= $self->set_search_path($trig->[8]) . "\n"; 5140 } 5141 # Check if it's like a pg rule 5142 $self->_remove_comments(\$trig->[4]); 5143 if (!$self->{pg_supports_insteadof} && $trig->[1] =~ /INSTEAD OF/) 5144 { 5145 if ($self->{plsql_pgsql}) 5146 { 5147 $trig->[4] = Ora2Pg::PLSQL::convert_plsql_code($self, $trig->[4]); 5148 $self->_replace_declare_var(\$trig->[4]); 5149 } 5150 $sql_output .= "CREATE$self->{create_or_replace} RULE " . $self->quote_object_name($trig->[0]) 5151 . " AS\n\tON " . $self->quote_object_name($trig->[2]) 5152 . " TO " . $self->quote_object_name($tbname) 5153 . "\n\tDO INSTEAD\n(\n\t$trig->[4]\n);\n\n"; 5154 if ($self->{force_owner}) 5155 { 5156 my $owner = $trig->[8]; 5157 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 5158 $sql_output .= "ALTER RULE " . $self->quote_object_name($trig->[0]) 5159 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 5160 } 5161 } 5162 else 5163 { 5164 # Replace direct call of a stored procedure in triggers 5165 if ($trig->[7] eq 'CALL') 5166 { 5167 if ($self->{plsql_pgsql}) 5168 { 5169 $trig->[4] = Ora2Pg::PLSQL::convert_plsql_code($self, $trig->[4]); 5170 $self->_replace_declare_var(\$trig->[4]); 5171 } 5172 $trig->[4] = "BEGIN\nPERFORM $trig->[4];\nEND;"; 5173 } 5174 else 5175 { 5176 my $ret_kind = 'RETURN NEW;'; 5177 if (uc($trig->[2]) eq 'DELETE') { 5178 $ret_kind = 'RETURN OLD;'; 5179 } elsif (uc($trig->[2]) =~ /DELETE/) { 5180 $ret_kind = "IF TG_OP = 'DELETE' THEN\n\tRETURN OLD;\nELSE\n\tRETURN NEW;\nEND IF;\n"; 5181 } 5182 if ($self->{plsql_pgsql}) 5183 { 5184 # Add a semi colon if none 5185 if ($trig->[4] !~ /\bBEGIN\b/i) 5186 { 5187 chomp($trig->[4]); 5188 $trig->[4] .= ';' if ($trig->[4] !~ /;\s*$/s); 5189 $trig->[4] = "BEGIN\n$trig->[4]\n$ret_kind\nEND;"; 5190 } 5191 $trig->[4] = Ora2Pg::PLSQL::convert_plsql_code($self, $trig->[4]); 5192 $self->_replace_declare_var(\$trig->[4]); 5193 5194 # When an exception statement is used enclosed everything 5195 # in a block before returning NEW 5196 if ($trig->[4] =~ /EXCEPTION(.*?)\b(END[;]*)[\s\/]*$/is) 5197 { 5198 $trig->[4] =~ s/^\s*BEGIN/BEGIN\n BEGIN/ism; 5199 $trig->[4] =~ s/\b(END[;]*)[\s\/]*$/ END;\n$1/is; 5200 } 5201 # Add return statement. 5202 $trig->[4] =~ s/\b(END[;]*)(\s*\%ORA2PG_COMMENT\d+\%\s*)?[\s\/]*$/$ret_kind\n$1$2/igs; 5203 # Look at function header to convert sql type 5204 my @parts = split(/BEGIN/i, $trig->[4]); 5205 if ($#parts > 0) 5206 { 5207 if (!$self->{is_mysql}) { 5208 $parts[0] = Ora2Pg::PLSQL::replace_sql_type($parts[0], $self->{pg_numeric_type}, $self->{default_numeric}, $self->{pg_integer_type}, %{$self->{data_type}}); 5209 } else { 5210 $parts[0] = Ora2Pg::MySQL::replace_sql_type($parts[0], $self->{pg_numeric_type}, $self->{default_numeric}, $self->{pg_integer_type}, %{$self->{data_type}}); 5211 } 5212 } 5213 $trig->[4] = join('BEGIN', @parts); 5214 $trig->[4] =~ s/\bRETURN\s*;/$ret_kind/igs; 5215 } 5216 } 5217 $sql_output .= "DROP TRIGGER $self->{pg_supports_ifexists} " . $self->quote_object_name($trig->[0]) 5218 . " ON " . $self->quote_object_name($tbname) . " CASCADE;\n"; 5219 my $security = ''; 5220 my $revoke = ''; 5221 my $trig_fctname = $self->quote_object_name("trigger_fct_\L$trig->[0]\E"); 5222 if ($self->{security}{"\U$trig->[0]\E"}{security} eq 'DEFINER') 5223 { 5224 $security = " SECURITY DEFINER"; 5225 $revoke = "-- REVOKE ALL ON FUNCTION $trig_fctname() FROM PUBLIC;\n"; 5226 } 5227 $security = " SECURITY INVOKER" if ($self->{force_security_invoker}); 5228 if ($self->{pg_supports_when} && $trig->[5]) 5229 { 5230 if (!$self->{preserve_case}) 5231 { 5232 $trig->[4] =~ s/"([^"]+)"/\L$1\E/gs; 5233 $trig->[4] =~ s/ALTER TRIGGER\s+[^\s]+\s+ENABLE(;)?//; 5234 } 5235 $sql_output .= "CREATE$self->{create_or_replace} FUNCTION $trig_fctname() RETURNS trigger AS \$BODY\$\n$trig->[4]\n\$BODY\$\n LANGUAGE 'plpgsql'$security;\n$revoke\n"; 5236 if ($self->{force_owner}) 5237 { 5238 my $owner = $trig->[8]; 5239 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 5240 $sql_output .= "ALTER FUNCTION $trig_fctname() OWNER TO " . $self->quote_object_name($owner) . ";\n\n"; 5241 } 5242 $self->_remove_comments(\$trig->[6]); 5243 $trig->[6] =~ s/\n+$//s; 5244 $trig->[6] =~ s/^[^\.\s]+\.//; 5245 if (!$self->{preserve_case}) { 5246 $trig->[6] =~ s/"([^"]+)"/\L$1\E/gs; 5247 } 5248 chomp($trig->[6]); 5249 # Remove referencing clause, not supported by PostgreSQL 5250 $trig->[6] =~ s/REFERENCING\s+(.*?)(FOR\s+EACH\s+)/$2/is; 5251 $trig->[6] =~ s/^\s*["]*(?:$trig->[0])["]*//is; 5252 $trig->[6] =~ s/\s+ON\s+([^"\s]+)\s+/" ON " . $self->quote_object_name($1) . " "/ies; 5253 $sql_output .= "DROP TRIGGER IF EXISTS " . $self->quote_object_name($trig->[0]) . " ON " . $self->quote_object_name($1) . ";\n" if ($self->{drop_if_exists}); 5254 $sql_output .= "CREATE TRIGGER " . $self->quote_object_name($trig->[0]) . "$trig->[6]\n"; 5255 if ($trig->[5]) 5256 { 5257 $self->_remove_comments(\$trig->[5]); 5258 $trig->[5] =~ s/"([^"]+)"/\L$1\E/gs if (!$self->{preserve_case}); 5259 if ($self->{plsql_pgsql}) 5260 { 5261 $trig->[5] = Ora2Pg::PLSQL::convert_plsql_code($self, $trig->[5]); 5262 $self->_replace_declare_var(\$trig->[5]); 5263 } 5264 $sql_output .= "\tWHEN ($trig->[5])\n"; 5265 } 5266 $sql_output .= "\tEXECUTE PROCEDURE $trig_fctname();\n\n"; 5267 } 5268 else 5269 { 5270 if (!$self->{preserve_case}) 5271 { 5272 $trig->[4] =~ s/"([^"]+)"/\L$1\E/gs; 5273 $trig->[4] =~ s/ALTER TRIGGER\s+[^\s]+\s+ENABLE(;)?//; 5274 } 5275 $sql_output .= "CREATE$self->{create_or_replace} FUNCTION $trig_fctname() RETURNS trigger AS \$BODY\$\n$trig->[4]\n\$BODY\$\n LANGUAGE 'plpgsql'$security;\n$revoke\n"; 5276 if ($self->{force_owner}) 5277 { 5278 my $owner = $trig->[8]; 5279 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 5280 $sql_output .= "ALTER FUNCTION $trig_fctname() OWNER TO " . $self->quote_object_name($owner) . ";\n\n"; 5281 } 5282 $sql_output .= "DROP TRIGGER IF EXISTS " . $self->quote_object_name($trig->[0]) . " ON " . $self->quote_object_name($tbname) . ";\n" if ($self->{drop_if_exists}); 5283 $sql_output .= "CREATE TRIGGER " . $self->quote_object_name($trig->[0]) . "\n\t"; 5284 my $statement = 0; 5285 $statement = 1 if ($trig->[1] =~ s/ STATEMENT//); 5286 $sql_output .= "$trig->[1] $trig->[2]$cols ON " . $self->quote_object_name($tbname) . " "; 5287 if ($statement) { 5288 $sql_output .= "FOR EACH STATEMENT\n"; 5289 } else { 5290 $sql_output .= "FOR EACH ROW\n"; 5291 } 5292 $sql_output .= "\tEXECUTE PROCEDURE $trig_fctname();\n\n"; 5293 } 5294 } 5295 $self->_restore_comments(\$sql_output); 5296 if ($self->{file_per_function}) 5297 { 5298 $self->dump($sql_header . $sql_output, $fhdl); 5299 $self->close_export_file($fhdl); 5300 $sql_output = ''; 5301 } 5302 $nothing++; 5303 $i++; 5304 } 5305 delete $self->{current_trigger_table}; 5306 5307 if (!$self->{quiet} && !$self->{debug}) { 5308 print STDERR $self->progress_bar($i - 1, $num_total_trigger, 25, '=', 'triggers', 'end of output.'), "\n"; 5309 } 5310 if (!$nothing) { 5311 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 5312 } 5313 5314 $self->dump($sql_output); 5315 5316 return; 5317} 5318 5319=head2 parallelize_statements 5320 5321Parallelize SQL statements to import into PostgreSQL. 5322 5323=cut 5324 5325sub parallelize_statements 5326{ 5327 my $self = shift; 5328 5329 my $sql_header = $self->_set_file_header(); 5330 my $sql_output = ""; 5331 5332 $self->logit("Parse SQL orders to load...\n", 1); 5333 5334 my $nothing = 0; 5335 #--------------------------------------------------------- 5336 # Load a file containing SQL code to load into PostgreSQL 5337 #--------------------------------------------------------- 5338 my %comments = (); 5339 my @settings = (); 5340 if ($self->{input_file}) 5341 { 5342 $self->{functions} = (); 5343 $self->logit("Reading input SQL orders from file $self->{input_file}...\n", 1); 5344 my $content = $self->read_input_file($self->{input_file}); 5345 # remove comments only, text constants are preserved 5346 $self->_remove_comments(\$content, 1); 5347 $content =~ s/\%ORA2PG_COMMENT\d+\%//gs; 5348 my $query = 1; 5349 foreach my $l (split(/\n/, $content)) 5350 { 5351 chomp($l); 5352 next if ($l =~ /^\s*$/); 5353 # do not parse interactive or session command 5354 next if ($l =~ /^(\\set|\\pset|\\i)/is); 5355 # Put setting change in header to apply them on all parallel session 5356 # This will help to set a special search_path or encoding 5357 if ($l =~ /^SET\s+/i) 5358 { 5359 push(@settings, $l); 5360 next; 5361 } 5362 if ($old_line) 5363 { 5364 $l = $old_line .= ' ' . $l; 5365 $old_line = ''; 5366 } 5367 if ($l =~ /;\s*$/) 5368 { 5369 $self->{queries}{$query} .= "$l\n"; 5370 $query++; 5371 } else { 5372 $self->{queries}{$query} .= "$l\n"; 5373 } 5374 } 5375 } else { 5376 $self->logit("No input file, aborting...\n", 0, 1); 5377 } 5378 5379 #-------------------------------------------------------- 5380 my $total_queries = scalar keys %{$self->{queries}}; 5381 $self->{child_count} = 0; 5382 foreach my $q (sort {$a <=> $b} keys %{$self->{queries}}) 5383 { 5384 chomp($self->{queries}{$q}); 5385 next if (!$self->{queries}{$q}); 5386 if ($self->{jobs} > 1) 5387 { 5388 while ($self->{child_count} >= $self->{jobs}) 5389 { 5390 my $kid = waitpid(-1, WNOHANG); 5391 if ($kid > 0) 5392 { 5393 $self->{child_count}--; 5394 delete $RUNNING_PIDS{$kid}; 5395 } 5396 usleep(50000); 5397 } 5398 spawn sub { 5399 $self->_pload_to_pg($q, $self->{queries}{$q}, @settings); 5400 }; 5401 $self->{child_count}++; 5402 } else { 5403 $self->_pload_to_pg($q, $self->{queries}{$q}, @settings); 5404 } 5405 if (!$self->{quiet} && !$self->{debug}) { 5406 print STDERR $self->progress_bar($q, $total_queries, 25, '=', 'queries', "dispatching query #$q" ), "\r"; 5407 } 5408 $nothing++; 5409 } 5410 $self->{queries} = (); 5411 5412 if (!$total_queries) { 5413 $self->logit("No query to load...\n", 0); 5414 } else { 5415 # Wait for all child end 5416 while ($self->{child_count} > 0) 5417 { 5418 my $kid = waitpid(-1, WNOHANG); 5419 if ($kid > 0) 5420 { 5421 $self->{child_count}--; 5422 delete $RUNNING_PIDS{$kid}; 5423 } 5424 usleep(50000); 5425 } 5426 if (!$self->{quiet} && !$self->{debug}) { 5427 print STDERR "\n"; 5428 } 5429 } 5430 return; 5431} 5432 5433=head2 translate_query 5434 5435Translate Oracle's queries into PostgreSQL compatible statement. 5436 5437=cut 5438 5439sub translate_query 5440{ 5441 my $self = shift; 5442 5443 my $sql_header = $self->_set_file_header(); 5444 my $sql_output = ""; 5445 5446 $self->logit("Parse queries definition...\n", 1); 5447 $self->dump($sql_header); 5448 5449 my $nothing = 0; 5450 my $dirprefix = ''; 5451 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 5452 #--------------------------------------------------------- 5453 # Code to use to find queries parser issues, it load a file 5454 # containing the untouched SQL code from Oracle queries 5455 #--------------------------------------------------------- 5456 if ($self->{input_file}) 5457 { 5458 $self->{functions} = (); 5459 $self->logit("Reading input code from file $self->{input_file}...\n", 1); 5460 my $content = $self->read_input_file($self->{input_file}); 5461 $self->_remove_comments(\$content); 5462 my $query = 1; 5463 foreach my $l (split(/(?:^\/$|;\s*$)/m, $content)) 5464 { 5465 chomp($l); 5466 next if ($l =~ /^\s*$/s); 5467 $self->{queries}{$query}{code} = "$l\n"; 5468 $query++; 5469 } 5470 $content = ''; 5471 foreach my $q (keys %{$self->{queries}}) { 5472 $self->_restore_comments(\$self->{queries}{$q}{code}); 5473 } 5474 } 5475 5476 foreach my $q (sort { $a <=> $b } keys %{$self->{queries}}) 5477 { 5478 if ($self->{queries}{$q}{code} !~ /(SELECT|UPDATE|DELETE|INSERT|DROP|TRUNCATE|CREATE(?:UNIQUE)? INDEX)/is) { 5479 $self->{queries}{$q}{to_be_parsed} = 0; 5480 } else { 5481 $self->{queries}{$q}{to_be_parsed} = 1; 5482 } 5483 } 5484 5485 #-------------------------------------------------------- 5486 5487 my $total_size = 0; 5488 my $cost_value = 0; 5489 foreach my $q (sort {$a <=> $b} keys %{$self->{queries}}) 5490 { 5491 $total_size += length($self->{queries}{$q}{code}); 5492 $self->logit("Dumping query $q...\n", 1); 5493 if ($self->{queries}{$q}{to_be_parsed}) { 5494 if ($self->{plsql_pgsql}) { 5495 $self->_remove_comments(\$self->{queries}{$q}{code}); 5496 my $sql_q = Ora2Pg::PLSQL::convert_plsql_code($self, $self->{queries}{$q}{code}); 5497 my $estimate = ''; 5498 if ($self->{estimate_cost}) { 5499 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $sql_q, 'QUERY'); 5500 $cost += $Ora2Pg::PLSQL::OBJECT_SCORE{'QUERY'}; 5501 $cost_value += $cost; 5502 $estimate = "\n-- Estimed cost of query [ $q ]: " . sprintf("%2.2f", $cost); 5503 } 5504 $self->_restore_comments(\$sql_q); 5505 $sql_output .= $sql_q; 5506 $sql_output .= ';' if ($sql_q !~ /;\s*$/); 5507 $sql_output .= $estimate; 5508 } else { 5509 $sql_output .= $self->{queries}{$q}{code}; 5510 } 5511 } else { 5512 $sql_output .= $self->{queries}{$q}{code}; 5513 $sql_output .= ';' if ($self->{queries}{$q}{code} !~ /;\s*$/); 5514 } 5515 $sql_output .= "\n"; 5516 $nothing++; 5517 } 5518 if ($self->{estimate_cost}) { 5519 $cost_value = sprintf("%2.2f", $cost_value); 5520 my @infos = ( "Total number of queries: ".(scalar keys %{$self->{queries}}).".", 5521 "Total size of queries code: $total_size bytes.", 5522 "Total estimated cost: $cost_value units, ".$self->_get_human_cost($cost_value)."." 5523 ); 5524 $self->logit(join("\n", @infos) . "\n", 1); 5525 map { s/^/-- /; } @infos; 5526 $sql_output .= join("\n", @infos); 5527 } 5528 if (!$nothing) { 5529 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 5530 } 5531 $self->dump($sql_output); 5532 5533 $self->{queries} = (); 5534 5535 return; 5536} 5537 5538=head2 export_function 5539 5540Export Oracle functions into PostgreSQL compatible statement. 5541 5542=cut 5543 5544sub export_function 5545{ 5546 my $self = shift; 5547 5548 my $sql_header = $self->_set_file_header(); 5549 my $sql_output = ""; 5550 5551 use constant SQL_DATATYPE => 2; 5552 $self->logit("Add functions definition...\n", 1); 5553 $self->dump($sql_header); 5554 my $nothing = 0; 5555 my $dirprefix = ''; 5556 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 5557 #--------------------------------------------------------- 5558 # Code to use to find function parser issues, it load a file 5559 # containing the untouched PL/SQL code from Oracle Function 5560 #--------------------------------------------------------- 5561 if ($self->{input_file}) 5562 { 5563 $self->{functions} = (); 5564 $self->logit("Reading input code from file $self->{input_file}...\n", 1); 5565 my $content = $self->read_input_file($self->{input_file}); 5566 $self->_remove_comments(\$content); 5567 my @allfct = split(/\n/, $content); 5568 my $fcnm = ''; 5569 my $old_line = ''; 5570 my $language = ''; 5571 foreach my $l (@allfct) { 5572 chomp($l); 5573 $l =~ s/\r//g; 5574 next if ($l =~ /^\s*$/); 5575 if ($old_line) { 5576 $l = $old_line .= ' ' . $l; 5577 $old_line = ''; 5578 } 5579 if ($l =~ /^\s*CREATE\s*(?:OR REPLACE)?\s*(?:EDITIONABLE|NONEDITIONABLE|DEFINER=[^\s]+)?\s*$/i) { 5580 $old_line = $l; 5581 next; 5582 } 5583 if ($l =~ /^\s*(?:EDITIONABLE|NONEDITIONABLE|DEFINER=[^\s]+)?\s*(FUNCTION|PROCEDURE)$/i) { 5584 $old_line = $l; 5585 next; 5586 } 5587 if ($l =~ /^\s*CREATE\s*(?:OR REPLACE)?\s*(?:EDITIONABLE|NONEDITIONABLE|DEFINER=[^\s]+)?\s*(FUNCTION|PROCEDURE)\s*$/i) { 5588 $old_line = $l; 5589 next; 5590 } 5591 $l =~ s/^\s*CREATE (?:OR REPLACE)?\s*(?:EDITIONABLE|NONEDITIONABLE|DEFINER=[^\s]+)?\s*(FUNCTION|PROCEDURE)/$1/i; 5592 $l =~ s/^\s*(?:EDITIONABLE|NONEDITIONABLE)?\s*(FUNCTION|PROCEDURE)/$1/i; 5593 if ($l =~ /^(FUNCTION|PROCEDURE)\s+([^\s\(]+)/i) { 5594 $fcnm = $2; 5595 $fcnm =~ s/"//g; 5596 } 5597 next if (!$fcnm); 5598 if ($l =~ /LANGUAGE\s+([^\s="'><\!\(\)]+)/is) { 5599 $language = $1; 5600 } 5601 $self->{functions}{$fcnm}{text} .= "$l\n"; 5602 5603 if (!$language) { 5604 if ($l =~ /^END\s+$fcnm(_atx)?\s*;/i) { 5605 $fcnm = ''; 5606 } 5607 } else { 5608 if ($l =~ /;/i) { 5609 $fcnm = ''; 5610 $language = ''; 5611 } 5612 } 5613 } 5614 # Get all metadata from all functions when we are 5615 # reading a file, otherwise it has already been done 5616 foreach my $fct (sort keys %{$self->{functions}}) 5617 { 5618 $self->{functions}{$fct}{text} =~ s/(.*?\b(?:FUNCTION|PROCEDURE)\s+(?:[^\s\(]+))(\s*\%ORA2PG_COMMENT\d+\%\s*)+/$2$1 /is; 5619 my %fct_detail = $self->_lookup_function($self->{functions}{$fct}{text}, ($self->{is_mysql}) ? $fct : undef); 5620 if (!exists $fct_detail{name}) { 5621 delete $self->{functions}{$fct}; 5622 next; 5623 } 5624 $self->{functions}{$fct}{type} = uc($fct_detail{type}); 5625 delete $fct_detail{code}; 5626 delete $fct_detail{before}; 5627 my $sch = 'unknown'; 5628 my $fname = $fct; 5629 if ($fname =~ s/^([^\.\s]+)\.([^\s]+)$/$2/is) { 5630 $sch = $1; 5631 } 5632 $fname =~ s/"//g; 5633 %{$self->{function_metadata}{$sch}{'none'}{$fname}{metadata}} = %fct_detail; 5634 $self->_restore_comments(\$self->{functions}{$fct}{text}); 5635 } 5636 } 5637 5638 #-------------------------------------------------------- 5639 my $total_size = 0; 5640 my $cost_value = 0; 5641 my $num_total_function = scalar keys %{$self->{functions}}; 5642 my $fct_cost = ''; 5643 my $parallel_fct_count = 0; 5644 unlink($dirprefix . 'temp_cost_file.dat') if ($self->{parallel_tables} > 1 && $self->{estimate_cost}); 5645 5646 my $t0 = Benchmark->new; 5647 5648 # Group functions by chunk in multiprocess mode 5649 my $num_chunk = $self->{jobs} || 1; 5650 my @fct_group = (); 5651 my $i = 0; 5652 foreach my $key ( sort keys %{$self->{functions}} ) 5653 { 5654 $fct_group[$i++]{$key} = $self->{functions}{$key}; 5655 $i = 0 if ($i == $num_chunk); 5656 } 5657 my $num_cur_fct = 0; 5658 for ($i = 0; $i <= $#fct_group; $i++) 5659 { 5660 5661 if ($self->{jobs} > 1) { 5662 $self->logit("Creating a new process to translate functions...\n", 1); 5663 spawn sub { 5664 $self->translate_function($num_cur_fct, $num_total_function, %{$fct_group[$i]}); 5665 }; 5666 $parallel_fct_count++; 5667 } else { 5668 my ($code, $lsize, $lcost) = $self->translate_function($num_cur_fct, $num_total_function, %{$fct_group[$i]}); 5669 $sql_output .= $code; 5670 $total_size += $lsize; 5671 $cost_value += $lcost; 5672 } 5673 $num_cur_fct += scalar keys %{$fct_group[$i]}; 5674 $nothing++; 5675 } 5676 # Wait for all oracle connection terminaison 5677 if ($self->{jobs} > 1) 5678 { 5679 while ($parallel_fct_count) 5680 { 5681 my $kid = waitpid(-1, WNOHANG); 5682 if ($kid > 0) { 5683 $parallel_fct_count--; 5684 delete $RUNNING_PIDS{$kid}; 5685 } 5686 usleep(50000); 5687 } 5688 if ($self->{estimate_cost}) { 5689 my $tfh = $self->read_export_file($dirprefix . 'temp_cost_file.dat'); 5690 flock($tfh, 2) || die "FATAL: can't lock file temp_cost_file.dat\n"; 5691 while (my $l = <$tfh>) { 5692 chomp($l); 5693 my ($fname, $fsize, $fcost) = split(/:/, $l); 5694 $total_size += $fsize; 5695 $cost_value += $fcost; 5696 } 5697 $self->close_export_file($tfh, 1); 5698 unlink($dirprefix . 'temp_cost_file.dat'); 5699 } 5700 } 5701 if (!$self->{quiet} && !$self->{debug}) { 5702 print STDERR $self->progress_bar($num_cur_fct, $num_total_function, 25, '=', 'functions', 'end of functions export.'), "\n"; 5703 } 5704 if ($self->{estimate_cost}) { 5705 my @infos = ( "Total number of functions: ".(scalar keys %{$self->{functions}}).".", 5706 "Total size of function code: $total_size bytes.", 5707 "Total estimated cost: $cost_value units, ".$self->_get_human_cost($cost_value)."." 5708 ); 5709 $self->logit(join("\n", @infos) . "\n", 1); 5710 map { s/^/-- /; } @infos; 5711 $sql_output .= "\n" . join("\n", @infos); 5712 $sql_output .= "\n" . $fct_cost; 5713 } 5714 if (!$nothing) { 5715 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 5716 } 5717 5718 $self->dump($sql_output); 5719 5720 $self->{functions} = (); 5721 5722 my $t1 = Benchmark->new; 5723 my $td = timediff($t1, $t0); 5724 $self->logit("Total time to translate all functions with $num_chunk process: " . timestr($td) . "\n", 1); 5725 5726 return; 5727} 5728 5729=head2 export_procedure 5730 5731Export Oracle procedures into PostgreSQL compatible statement. 5732 5733=cut 5734 5735sub export_procedure 5736{ 5737 my $self = shift; 5738 5739 my $sql_header = $self->_set_file_header(); 5740 my $sql_output = ""; 5741 5742 use constant SQL_DATATYPE => 2; 5743 $self->logit("Add procedures definition...\n", 1); 5744 my $nothing = 0; 5745 my $dirprefix = ''; 5746 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 5747 $self->dump($sql_header); 5748 #--------------------------------------------------------- 5749 # Code to use to find procedure parser issues, it load a file 5750 # containing the untouched PL/SQL code from Oracle Procedure 5751 #--------------------------------------------------------- 5752 if ($self->{input_file}) 5753 { 5754 $self->{procedures} = (); 5755 $self->logit("Reading input code from file $self->{input_file}...\n", 1); 5756 my $content = $self->read_input_file($self->{input_file}); 5757 $self->_remove_comments(\$content); 5758 my @allfct = split(/\n/, $content); 5759 my $fcnm = ''; 5760 my $old_line = ''; 5761 my $language = ''; 5762 my $first_comment = ''; 5763 foreach my $l (@allfct) 5764 { 5765 $l =~ s/\r//g; 5766 next if ($l =~ /^\/$/); 5767 next if ($l =~ /^\s*$/); 5768 if ($old_line) 5769 { 5770 $l = $old_line .= ' ' . $l; 5771 $old_line = ''; 5772 } 5773 $comment .= $l if ($l =~ /^\%ORA2PG_COMMENT\d+\%$/); 5774 if ($l =~ /^\s*CREATE\s*(?:OR REPLACE)?\s*(?:EDITIONABLE|NONEDITIONABLE)?\s*$/i) 5775 { 5776 $old_line = $comment . $l; 5777 $comment = ''; 5778 next; 5779 } 5780 if ($l =~ /^\s*(?:EDITIONABLE|NONEDITIONABLE)?\s*(FUNCTION|PROCEDURE)$/i) 5781 { 5782 $old_line = $comment . $l; 5783 $comment = ''; 5784 next; 5785 } 5786 if ($l =~ /^\s*CREATE\s*(?:OR REPLACE)?\s*(?:EDITIONABLE|NONEDITIONABLE)?\s*(FUNCTION|PROCEDURE)\s*$/i) 5787 { 5788 $old_line = $comment . $l; 5789 $comment = ''; 5790 next; 5791 } 5792 $l =~ s/^\s*CREATE (?:OR REPLACE)?\s*(?:EDITIONABLE|NONEDITIONABLE)?\s*(FUNCTION|PROCEDURE)/$1/i; 5793 $l =~ s/^\s*(?:EDITIONABLE|NONEDITIONABLE)?\s*(FUNCTION|PROCEDURE)/$1/i; 5794 if ($l =~ /^(FUNCTION|PROCEDURE)\s+([^\s\(]+)/i) 5795 { 5796 $fcnm = $2; 5797 $fcnm =~ s/"//g; 5798 } 5799 next if (!$fcnm); 5800 if ($l =~ /LANGUAGE\s+([^\s="'><\!\(\)]+)/is) { 5801 $language = $1; 5802 } 5803 if ($comment) 5804 { 5805 $self->{procedures}{$fcnm}{text} .= "$comment"; 5806 $comment = ''; 5807 } 5808 $self->{procedures}{$fcnm}{text} .= "$l\n"; 5809 if (!$language) 5810 { 5811 if ($l =~ /^END\s+$fcnm(_atx)?\s*;/i) { 5812 $fcnm = ''; 5813 } 5814 } 5815 else 5816 { 5817 if ($l =~ /;/i) 5818 { 5819 $fcnm = ''; 5820 $language = ''; 5821 } 5822 } 5823 } 5824 5825 # Get all metadata from all procedures when we are 5826 # reading a file, otherwise it has already been done 5827 foreach my $fct (sort keys %{$self->{procedures}}) 5828 { 5829 $self->{procedures}{$fct}{text} =~ s/(.*?\b(?:FUNCTION|PROCEDURE)\s+(?:[^\s\(]+))(\s*\%ORA2PG_COMMENT\d+\%\s*)+/$2$1 /is; 5830 my %fct_detail = $self->_lookup_function($self->{procedures}{$fct}{text}, ($self->{is_mysql}) ? $fct : undef); 5831 if (!exists $fct_detail{name}) 5832 { 5833 delete $self->{procedures}{$fct}; 5834 next; 5835 } 5836 $self->{procedures}{$fct}{type} = $fct_detail{type}; 5837 delete $fct_detail{code}; 5838 delete $fct_detail{before}; 5839 my $sch = 'unknown'; 5840 my $fname = $fct; 5841 if ($fname =~ s/^([^\.\s]+)\.([^\s]+)$/$2/is) { 5842 $sch = $1; 5843 } 5844 $fname =~ s/"//g; 5845 %{$self->{function_metadata}{$sch}{'none'}{$fname}{metadata}} = %fct_detail; 5846 $self->_restore_comments(\$self->{procedures}{$fct}{text}); 5847 } 5848 } 5849 5850 #-------------------------------------------------------- 5851 my $total_size = 0; 5852 my $cost_value = 0; 5853 my $num_total_function = scalar keys %{$self->{procedures}}; 5854 my $fct_cost = ''; 5855 my $parallel_fct_count = 0; 5856 unlink($dirprefix . 'temp_cost_file.dat') if ($self->{parallel_tables} > 1 && $self->{estimate_cost}); 5857 5858 my $t0 = Benchmark->new; 5859 5860 # Group functions by chunk in multiprocess mode 5861 my $num_chunk = $self->{jobs} || 1; 5862 my @fct_group = (); 5863 my $i = 0; 5864 foreach my $key (sort keys %{$self->{procedures}} ) { 5865 $fct_group[$i++]{$key} = $self->{procedures}{$key}; 5866 $i = 0 if ($i == $num_chunk); 5867 } 5868 my $num_cur_fct = 0; 5869 for ($i = 0; $i <= $#fct_group; $i++) { 5870 if ($self->{jobs} > 1) { 5871 $self->logit("Creating a new process to translate procedures...\n", 1); 5872 spawn sub { 5873 $self->translate_function($num_cur_fct, $num_total_function, %{$fct_group[$i]}); 5874 }; 5875 $parallel_fct_count++; 5876 } else { 5877 my ($code, $lsize, $lcost) = $self->translate_function($num_cur_fct, $num_total_function, %{$fct_group[$i]}); 5878 $sql_output .= $code; 5879 $total_size += $lsize;; 5880 $cost_value += $lcost; 5881 } 5882 $num_cur_fct += scalar keys %{$fct_group[$i]}; 5883 $nothing++; 5884 } 5885 5886 # Wait for all oracle connection terminaison 5887 if ($self->{jobs} > 1) { 5888 while ($parallel_fct_count) { 5889 my $kid = waitpid(-1, WNOHANG); 5890 if ($kid > 0) { 5891 $parallel_fct_count--; 5892 delete $RUNNING_PIDS{$kid}; 5893 } 5894 usleep(50000); 5895 } 5896 if ($self->{estimate_cost}) { 5897 my $tfh = $self->read_export_file($dirprefix . 'temp_cost_file.dat'); 5898 flock($tfh, 2) || die "FATAL: can't lock file temp_cost_file.dat\n"; 5899 if (defined $tfh) { 5900 while (my $l = <$tfh>) { 5901 chomp($l); 5902 my ($fname, $fsize, $fcost) = split(/:/, $l); 5903 $total_size += $fsize; 5904 $cost_value += $fcost; 5905 } 5906 $self->close_export_file($tfh, 1); 5907 } 5908 unlink($dirprefix . 'temp_cost_file.dat'); 5909 } 5910 } 5911 if (!$self->{quiet} && !$self->{debug}) 5912 { 5913 print STDERR $self->progress_bar($num_cur_fct, $num_total_function, 25, '=', 'procedures', 'end of procedures export.'), "\n"; 5914 } 5915 if ($self->{estimate_cost}) { 5916 my @infos = ( "Total number of procedures: ".(scalar keys %{$self->{procedures}}).".", 5917 "Total size of procedures code: $total_size bytes.", 5918 "Total estimated cost: $cost_value units, ".$self->_get_human_cost($cost_value)."." 5919 ); 5920 $self->logit(join("\n", @infos) . "\n", 1); 5921 map { s/^/-- /; } @infos; 5922 $sql_output .= "\n" . join("\n", @infos); 5923 $sql_output .= "\n" . $fct_cost; 5924 } 5925 if (!$nothing) { 5926 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 5927 } 5928 5929 $self->dump($sql_output); 5930 5931 $self->{procedures} = (); 5932 5933 my $t1 = Benchmark->new; 5934 my $td = timediff($t1, $t0); 5935 $self->logit("Total time to translate all functions with $num_chunk process: " . timestr($td) . "\n", 1); 5936 5937 return; 5938} 5939 5940=head2 export_package 5941 5942Export Oracle package into PostgreSQL compatible statement. 5943 5944=cut 5945 5946sub export_package 5947{ 5948 my $self = shift; 5949 5950 my $sql_header = $self->_set_file_header(); 5951 my $sql_output = ""; 5952 5953 $self->{current_package} = ''; 5954 $self->logit("Add packages definition...\n", 1); 5955 my $nothing = 0; 5956 my $dirprefix = ''; 5957 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 5958 $self->dump($sql_header); 5959 5960 #--------------------------------------------------------- 5961 # Code to use to find package parser bugs, it load a file 5962 # containing the untouched PL/SQL code from Oracle Package 5963 #--------------------------------------------------------- 5964 if ($self->{input_file}) 5965 { 5966 $self->{plsql_pgsql} = 1; 5967 $self->{packages} = (); 5968 $self->logit("Reading input code from file $self->{input_file}...\n", 1); 5969 my $content = $self->read_input_file($self->{input_file}); 5970 my $pknm = ''; 5971 my $before = ''; 5972 my $old_line = ''; 5973 my $skip_pkg_header = 0; 5974 $self->_remove_comments(\$content); 5975 # Normalise start of package declaration 5976 $content =~ s/CREATE(?:\s+OR\s+REPLACE)?(?:\s+EDITIONABLE|\s+NONEDITIONABLE)?\s+PACKAGE\s+/CREATE OR REPLACE PACKAGE /igs; 5977 # Preserve header 5978 $content =~ s/^(.*?)(CREATE OR REPLACE PACKAGE)/$2/s; 5979 my $start = $1 || ''; 5980 my @pkg_content = split(/CREATE OR REPLACE PACKAGE\s+/is, $content); 5981 for (my $i = 0; $i <= $#pkg_content; $i++) 5982 { 5983 # package declaration 5984 if ($pkg_content[$i] !~ /^BODY\s+/is) 5985 { 5986 if ($pkg_content[$i] =~ /^([^\s]+)/is) 5987 { 5988 my $pname = lc($1); 5989 $pname =~ s/"//g; 5990 $pname =~ s/^[^\.]+\.//g; 5991 $self->{packages}{$pname}{desc} = 'CREATE OR REPLACE PACKAGE ' . $pkg_content[$i]; 5992 $self->{packages}{$pname}{text} = $start if ($start); 5993 $start = ''; 5994 } 5995 } 5996 else 5997 { 5998 if ($pkg_content[$i] =~ /^BODY\s+([^\s]+)\s+/is) 5999 { 6000 my $pname = lc($1); 6001 $pname =~ s/"//g; 6002 $pname =~ s/^[^\.]+\.//g; 6003 $self->{packages}{$pname}{text} .= 'CREATE OR REPLACE PACKAGE ' . $pkg_content[$i]; 6004 } 6005 } 6006 } 6007 @pkg_content = (); 6008 6009 foreach my $pkg (sort keys %{$self->{packages}}) 6010 { 6011 my $tmp_txt = ''; 6012 if (exists $self->{packages}{$pkg}{desc}) 6013 { 6014 # Move comments at end of package declaration before package definition 6015 while ($self->{packages}{$pkg}{desc} =~ s/(\%ORA2PG_COMMENT\d+\%\s*)$//) { 6016 $self->{packages}{$pkg}{text} = $1 . $self->{packages}{$pkg}{text}; 6017 } 6018 } 6019 # Get all metadata from all procedures/function when we are 6020 # reading from a file, otherwise it has already been done 6021 $tmp_txt = $self->{packages}{$pkg}{text}; 6022 $tmp_txt =~ s/^.*CREATE OR REPLACE PACKAGE\s+/CREATE OR REPLACE PACKAGE /s; 6023 my %infos = $self->_lookup_package($tmp_txt); 6024 my $sch = 'unknown'; 6025 my $pname = $pkg; 6026 if ($pname =~ s/^([^\.\s]+)\.([^\s]+)$/$2/is) { 6027 $sch = $1; 6028 } 6029 foreach my $f (sort keys %infos) 6030 { 6031 next if (!$f); 6032 my $name = lc($f); 6033 delete $infos{$f}{code}; 6034 delete $infos{$f}{before}; 6035 $pname =~ s/"//g; 6036 $name =~ s/"//g; 6037 %{$self->{function_metadata}{$sch}{$pname}{$name}{metadata}} = %{$infos{$f}}; 6038 } 6039 $self->_restore_comments(\$self->{packages}{$pkg}{text}); 6040 } 6041 } 6042 6043 #-------------------------------------------------------- 6044 my $default_global_vars = ''; 6045 6046 my $number_fct = 0; 6047 my $i = 1; 6048 my $num_total_package = scalar keys %{$self->{packages}}; 6049 foreach my $pkg (sort keys %{$self->{packages}}) 6050 { 6051 my $total_size = 0; 6052 my $total_size_no_comment = 0; 6053 my $cost_value = 0; 6054 if (!$self->{quiet} && !$self->{debug}) { 6055 print STDERR $self->progress_bar($i, $num_total_package, 25, '=', 'packages', "generating $pkg" ), "\r"; 6056 } 6057 $i++, next if (!$self->{packages}{$pkg}{text} && !$self->{packages}{$pkg}{desc}); 6058 6059 # Save and cleanup previous global variables defined in other package 6060 if (scalar keys %{$self->{global_variables}}) 6061 { 6062 foreach my $n (sort keys %{$self->{global_variables}}) 6063 { 6064 if (exists $self->{global_variables}{$n}{constant} || exists $self->{global_variables}{$n}{default}) { 6065 $default_global_vars .= "$n = '$self->{global_variables}{$n}{default}'\n"; 6066 } else { 6067 $default_global_vars .= "$n = ''\n"; 6068 } 6069 } 6070 } 6071 %{$self->{global_variables}} = (); 6072 my $pkgbody = ''; 6073 my $fct_cost = ''; 6074 if (!$self->{plsql_pgsql}) 6075 { 6076 $self->logit("Dumping package $pkg...\n", 1); 6077 if ($self->{file_per_function}) 6078 { 6079 my $f = "$dirprefix\L${pkg}\E_$self->{output}"; 6080 $f =~ s/\.(?:gz|bz2)$//i; 6081 $pkgbody = "\\i$self->{psql_relative_path} $f\n"; 6082 my $fhdl = $self->open_export_file("$dirprefix\L${pkg}\E_$self->{output}", 1); 6083 $self->set_binmode($fhdl) if (!$self->{compress}); 6084 $self->dump($sql_header . $self->{packages}{$pkg}{desc} . "\n\n" . $self->{packages}{$pkg}{text}, $fhdl); 6085 $self->close_export_file($fhdl); 6086 } else { 6087 $pkgbody = $self->{packages}{$pkg}{desc} . "\n\n" . $self->{packages}{$pkg}{text}; 6088 } 6089 6090 } 6091 else 6092 { 6093 $self->{current_package} = $pkg; 6094 6095 # If there is a declaration only do not go further than looking at global var 6096 if (!$self->{packages}{$pkg}{text}) 6097 { 6098 $self->_convert_package($pkg); 6099 $i++; 6100 next; 6101 } 6102 6103 if ($self->{estimate_cost}) { 6104 $total_size += length($self->{packages}->{$pkg}{text}); 6105 } 6106 $self->_remove_comments(\$self->{packages}{$pkg}{text}); 6107 6108 # Normalyse package creation call 6109 $self->{packages}{$pkg}{text} =~ s/CREATE(?:\s+OR\s+REPLACE)?(?:\s+EDITIONABLE|\s+NONEDITIONABLE)?\s+PACKAGE\s+/CREATE OR REPLACE PACKAGE /is; 6110 if ($self->{estimate_cost}) 6111 { 6112 my %infos = $self->_lookup_package($self->{packages}{$pkg}{text}); 6113 foreach my $f (sort keys %infos) 6114 { 6115 next if (!$f); 6116 my @cnt = $infos{$f}{code} =~ /(\%ORA2PG_COMMENT\d+\%)/i; 6117 $total_size_no_comment += (length($infos{$f}{code}) - (17 * length(join('', @cnt)))); 6118 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $infos{$f}{code}); 6119 $self->logit("Function $f estimated cost: $cost\n", 1); 6120 $cost_value += $cost; 6121 $number_fct++; 6122 $fct_cost .= "\t-- Function $f total estimated cost: $cost\n"; 6123 foreach (sort { $cost_detail{$b} <=> $cost_detail{$a} } keys %cost_detail) { 6124 next if (!$cost_detail{$_}); 6125 $fct_cost .= "\t\t-- $_ => $cost_detail{$_}"; 6126 if (!$self->{is_mysql}) { 6127 $fct_cost .= " (cost: $Ora2Pg::PLSQL::UNCOVERED_SCORE{$_})" if ($Ora2Pg::PLSQL::UNCOVERED_SCORE{$_}); 6128 } else { 6129 $fct_cost .= " (cost: $Ora2Pg::PLSQL::UNCOVERED_MYSQL_SCORE{$_})" if ($Ora2Pg::PLSQL::UNCOVERED_MYSQL_SCORE{$_}); 6130 } 6131 $fct_cost .= "\n"; 6132 } 6133 } 6134 $cost_value += $Ora2Pg::PLSQL::OBJECT_SCORE{'PACKAGE BODY'}; 6135 $fct_cost .= "-- Total estimated cost for package $pkg: $cost_value units, " . $self->_get_human_cost($cost_value) . "\n"; 6136 } 6137 $txt = $self->_convert_package($pkg); 6138 $self->_restore_comments(\$txt) if (!$self->{file_per_function}); 6139 $txt =~ s/(-- REVOKE ALL ON (?:FUNCTION|PROCEDURE) [^;]+ FROM PUBLIC;)/&remove_newline($1)/sge; 6140 if (!$self->{file_per_function}) { 6141 $self->normalize_function_call(\$txt); 6142 } 6143 $pkgbody .= $txt; 6144 $pkgbody =~ s/[\r\n]*\bEND;\s*$//is; 6145 $pkgbody =~ s/(\s*;)\s*$/$1/is; 6146 } 6147 if ($self->{estimate_cost}) { 6148 $self->logit("Total size of package code: $total_size bytes.\n", 1); 6149 $self->logit("Total size of package code without comments and header: $total_size_no_comment bytes.\n", 1); 6150 $self->logit("Total estimated cost for package $pkg: $cost_value units, " . $self->_get_human_cost($cost_value) . ".\n", 1); 6151 } 6152 if ($pkgbody && ($pkgbody =~ /[a-z]/is)) { 6153 $sql_output .= "\n\n-- Oracle package '$pkg' declaration, please edit to match PostgreSQL syntax.\n"; 6154 $sql_output .= $pkgbody . "\n"; 6155 $sql_output .= "-- End of Oracle package '$pkg' declaration\n\n"; 6156 if ($self->{estimate_cost}) { 6157 $sql_output .= "-- Total size of package code: $total_size bytes.\n"; 6158 $sql_output .= "-- Total size of package code without comments and header: $total_size_no_comment bytes.\n"; 6159 $sql_output .= "-- Detailed cost per function:\n" . $fct_cost; 6160 } 6161 $nothing++; 6162 } 6163 $self->{total_pkgcost} += ($number_fct*$Ora2Pg::PLSQL::OBJECT_SCORE{'FUNCTION'}); 6164 $self->{total_pkgcost} += $Ora2Pg::PLSQL::OBJECT_SCORE{'PACKAGE BODY'}; 6165 $i++; 6166 } 6167 if ($self->{estimate_cost} && $number_fct) { 6168 $self->logit("Total number of functions found inside all packages: $number_fct.\n", 1); 6169 } 6170 if (!$self->{quiet} && !$self->{debug}) { 6171 print STDERR $self->progress_bar($i - 1, $num_total_package, 25, '=', 'packages', 'end of output.'), "\n"; 6172 } 6173 if (!$nothing) { 6174 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 6175 } 6176 6177 $self->dump($sql_output); 6178 6179 $self->{packages} = (); 6180 $sql_output = ''; 6181 # Create file to load custom variable initialization into postgresql.conf 6182 if (scalar keys %{$self->{global_variables}}) { 6183 foreach my $n (sort keys %{$self->{global_variables}}) { 6184 if (exists $self->{global_variables}{$n}{constant} || exists $self->{global_variables}{$n}{default}) { 6185 $default_global_vars .= "$n = '$self->{global_variables}{$n}{default}'\n"; 6186 } else { 6187 $default_global_vars .= "$n = ''\n"; 6188 } 6189 } 6190 } 6191 %{$self->{global_variables}} = (); 6192 6193 # Save global variable that need to be initialized at startup 6194 if ($default_global_vars) { 6195 my $dirprefix = ''; 6196 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 6197 open(OUT, ">${dirprefix}global_variables.conf"); 6198 print OUT "-- Global variables with default values used in packages.\n"; 6199 print OUT $default_global_vars; 6200 close(OUT); 6201 } 6202 6203 return; 6204} 6205 6206=head2 export_type 6207 6208Export Oracle type into PostgreSQL compatible statement. 6209 6210=cut 6211 6212sub export_type 6213{ 6214 my $self = shift; 6215 6216 my $sql_header = $self->_set_file_header(); 6217 my $sql_output = ""; 6218 6219 $self->logit("Add custom types definition...\n", 1); 6220 #--------------------------------------------------------- 6221 # Code to use to find type parser issues, it load a file 6222 # containing the untouched PL/SQL code from Oracle type 6223 #--------------------------------------------------------- 6224 if ($self->{input_file}) { 6225 $self->{types} = (); 6226 $self->logit("Reading input code from file $self->{input_file}...\n", 1); 6227 my $content = $self->read_input_file($self->{input_file}); 6228 $self->_remove_comments(\$content); 6229 my $i = 0; 6230 foreach my $l (split(/;/, $content)) { 6231 chomp($l); 6232 next if ($l =~ /^[\s\/]*$/s); 6233 my $cmt = ''; 6234 while ($l =~ s/(\%ORA2PG_COMMENT\d+\%)//s) { 6235 $cmt .= "$1"; 6236 } 6237 $self->_restore_comments(\$cmt); 6238 $l =~ s/^\s+//; 6239 $l =~ s/^CREATE\s+(?:OR REPLACE)?\s*(?:NONEDITIONABLE|EDITIONABLE)?\s*//is; 6240 $l .= ";\n"; 6241 if ($l =~ /^(SUBTYPE|TYPE)\s+([^\s\(]+)/is) { 6242 push(@{$self->{types}}, { ('name' => $2, 'code' => $l, 'comment' => $cmt, 'pos' => $i) }); 6243 } 6244 $i++; 6245 } 6246 } 6247 #-------------------------------------------------------- 6248 my $i = 1; 6249 foreach my $tpe (sort {$a->{pos} <=> $b->{pos} } @{$self->{types}}) { 6250 $self->logit("Dumping type $tpe->{name}...\n", 1); 6251 if (!$self->{quiet} && !$self->{debug}) { 6252 print STDERR $self->progress_bar($i, $#{$self->{types}}+1, 25, '=', 'types', "generating $tpe->{name}" ), "\r"; 6253 } 6254 if ($self->{plsql_pgsql}) { 6255 $tpe->{code} = $self->_convert_type($tpe->{code}, $tpe->{owner}); 6256 } else { 6257 if ($tpe->{code} !~ /^SUBTYPE\s+/) { 6258 $tpe->{code} = "CREATE$self->{create_or_replace} $tpe->{code}\n"; 6259 } 6260 } 6261 $tpe->{code} =~ s/REPLACE type/REPLACE TYPE/; 6262 $sql_output .= $tpe->{comment} . $tpe->{code} . "\n"; 6263 $i++; 6264 } 6265 $self->_restore_comments(\$sql_output); 6266 $self->{comment_values} = (); 6267 6268 if (!$self->{quiet} && !$self->{debug}) { 6269 print STDERR $self->progress_bar($i - 1, $#{$self->{types}}+1, 25, '=', 'types', 'end of output.'), "\n"; 6270 } 6271 if (!$sql_output) { 6272 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 6273 } 6274 $self->dump($sql_header . $sql_output); 6275 6276 return; 6277} 6278 6279=head2 export_tablespace 6280 6281Export Oracle tablespace into PostgreSQL compatible statement. 6282 6283=cut 6284 6285sub export_tablespace 6286{ 6287 my $self = shift; 6288 6289 my $sql_header = $self->_set_file_header(); 6290 $sql_header .= "-- Oracle tablespaces export, please edit path to match your filesystem.\n"; 6291 $sql_header .= "-- In PostgreSQl the path must be a directory and is expected to already exists\n"; 6292 my $sql_output = ""; 6293 6294 $self->logit("Add tablespaces definition...\n", 1); 6295 6296 my $create_tb = ''; 6297 my @done = (); 6298 # Read DML from file if any 6299 if ($self->{input_file}) { 6300 $self->read_tablespace_from_file(); 6301 } 6302 my $dirprefix = ''; 6303 foreach my $tb_type (sort keys %{$self->{tablespaces}}) 6304 { 6305 next if ($tb_type eq 'INDEX PARTITION' || $tb_type eq 'TABLE PARTITION'); 6306 # TYPE - TABLESPACE_NAME - FILEPATH - OBJECT_NAME 6307 foreach my $tb_name (sort keys %{$self->{tablespaces}{$tb_type}}) 6308 { 6309 foreach my $tb_path (sort keys %{$self->{tablespaces}{$tb_type}{$tb_name}}) 6310 { 6311 # Replace Oracle tablespace filename 6312 my $loc = $tb_name; 6313 if ($tb_path =~ /^(.*[^\\\/]+)/) { 6314 $loc = $1 . '/' . $loc; 6315 } 6316 if (!grep(/^$tb_name$/, @done)) 6317 { 6318 $create_tb .= "CREATE TABLESPACE \L$tb_name\E LOCATION '$loc';\n"; 6319 my $owner = $self->{list_tablespaces}{$tb_name}{owner} || ''; 6320 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 6321 if ($owner) 6322 { 6323 $create_tb .= "ALTER TABLESPACE " . $self->quote_object_name($tb_name) 6324 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 6325 } 6326 } 6327 push(@done, $tb_name); 6328 foreach my $obj (@{$self->{tablespaces}{$tb_type}{$tb_name}{$tb_path}}) { 6329 next if ($self->{file_per_index} && ($tb_type eq 'INDEX')); 6330 $sql_output .= "ALTER $tb_type " . $self->quote_object_name($obj) 6331 . " SET TABLESPACE " . $self->quote_object_name($tb_name) . ";\n"; 6332 } 6333 } 6334 } 6335 } 6336 6337 $sql_output = "$create_tb\n" . $sql_output if ($create_tb); 6338 if (!$sql_output) { 6339 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 6340 } 6341 6342 $self->dump($sql_header . $sql_output); 6343 6344 if ($self->{file_per_index} && (scalar keys %{$self->{tablespaces}} > 0)) 6345 { 6346 my $fhdl = undef; 6347 $self->logit("Dumping tablespace alter indexes to one separate file : TBSP_INDEXES_$self->{output}\n", 1); 6348 $fhdl = $self->open_export_file("TBSP_INDEXES_$self->{output}"); 6349 $self->set_binmode($fhdl) if (!$self->{compress}); 6350 $sql_output = ''; 6351 foreach my $tb_type (sort keys %{$self->{tablespaces}}) { 6352 # TYPE - TABLESPACE_NAME - FILEPATH - OBJECT_NAME 6353 foreach my $tb_name (sort keys %{$self->{tablespaces}{$tb_type}}) { 6354 foreach my $tb_path (sort keys %{$self->{tablespaces}{$tb_type}{$tb_name}}) { 6355 # Replace Oracle tablespace filename 6356 my $loc = $tb_name; 6357 $tb_path =~ /^(.*)[^\\\/]+$/; 6358 $loc = $1 . $loc; 6359 foreach my $obj (@{$self->{tablespaces}{$tb_type}{$tb_name}{$tb_path}}) { 6360 next if ($tb_type eq 'TABLE'); 6361 $sql_output .= "ALTER $tb_type \L$obj\E SET TABLESPACE \L$tb_name\E;\n"; 6362 } 6363 } 6364 } 6365 } 6366 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$sql_output && !$self->{no_header}); 6367 $self->dump($sql_header . $sql_output, $fhdl); 6368 $self->close_export_file($fhdl); 6369 } 6370 return; 6371} 6372 6373=head2 export_kettle 6374 6375Export Oracle table into Kettle script to load data into PostgreSQL. 6376 6377=cut 6378 6379sub export_kettle 6380{ 6381 my $self = shift; 6382 6383 my $sql_header = $self->_set_file_header(); 6384 my $sql_output = ""; 6385 6386 # Remove external table from data export 6387 if (scalar keys %{$self->{external_table}} ) { 6388 foreach my $table (keys %{$self->{tables}}) { 6389 if ( grep(/^$table$/i, keys %{$self->{external_table}}) ) { 6390 delete $self->{tables}{$table}; 6391 } 6392 } 6393 } 6394 6395 # Ordering tables by name by default 6396 my @ordered_tables = sort { $a cmp $b } keys %{$self->{tables}}; 6397 if (lc($self->{data_export_order}) eq 'size') { 6398 @ordered_tables = sort { 6399 ($self->{tables}{$b}{table_info}{num_rows} || $self->{tables}{$a}{table_info}{num_rows}) ? 6400 $self->{tables}{$b}{table_info}{num_rows} <=> $self->{tables}{$a}{table_info}{num_rows} : 6401 $a cmp $b 6402 } keys %{$self->{tables}}; 6403 } 6404 6405 my $dirprefix = ''; 6406 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 6407 foreach my $table (@ordered_tables) { 6408 $shell_commands .= $self->create_kettle_output($table, $dirprefix); 6409 } 6410 $self->dump("#!/bin/sh\n\n", $fhdl); 6411 $self->dump("KETTLE_TEMPLATE_PATH='.'\n\n", $fhdl); 6412 $self->dump($shell_commands, $fhdl); 6413 6414 return; 6415} 6416 6417=head2 export_partition 6418 6419Export Oracle partition into PostgreSQL compatible statement. 6420 6421=cut 6422 6423sub export_partition 6424{ 6425 my $self = shift; 6426 6427 my $sql_header = $self->_set_file_header(); 6428 my $sql_output = ""; 6429 6430 $self->logit("Add partitions definition...\n", 1); 6431 6432 my $total_partition = 0; 6433 foreach my $t (sort keys %{ $self->{partitions} }) { 6434 $total_partition += scalar keys %{$self->{partitions}{$t}}; 6435 } 6436 foreach my $t (sort keys %{ $self->{subpartitions_list} }) 6437 { 6438 foreach my $p (sort keys %{ $self->{subpartitions_list}{$t} }) { 6439 $total_partition += $self->{subpartitions_list}{$t}{$p}{count}; 6440 } 6441 } 6442 6443 # Extract partition definition from partitioned tables 6444 my $nparts = 1; 6445 my $partition_indexes = ''; 6446 foreach my $table (sort keys %{$self->{partitions}}) 6447 { 6448 my $function = ''; 6449 $function = qq{ 6450CREATE$self->{create_or_replace} FUNCTION ${table}_insert_trigger() 6451RETURNS TRIGGER AS \$\$ 6452BEGIN 6453} if (!$self->{pg_supports_partition}); 6454 6455 my $cond = 'IF'; 6456 my $funct_cond = ''; 6457 my %create_table = (); 6458 my $idx = 0; 6459 my $old_pos = ''; 6460 my $old_part = ''; 6461 my $owner = ''; 6462 my $PGBAR_REFRESH = set_refresh_count($total_partition); 6463 # Extract partitions in their position order 6464 foreach my $pos (sort {$a <=> $b} keys %{$self->{partitions}{$table}}) 6465 { 6466 next if (!$self->{partitions}{$table}{$pos}{name}); 6467 my $part = $self->{partitions}{$table}{$pos}{name}; 6468 if (!$self->{quiet} && !$self->{debug} && ($nparts % $PGBAR_REFRESH) == 0) 6469 { 6470 print STDERR $self->progress_bar($nparts, $total_partition, 25, '=', 'partitions', "generating $table/$part" ), "\r"; 6471 } 6472 $nparts++; 6473 my $create_table_tmp = ''; 6474 my $create_table_index_tmp = ''; 6475 my $tb_name = ''; 6476 if ($self->{prefix_partition}) { 6477 $tb_name = $table . "_" . $part; 6478 } else { 6479 if ($self->{export_schema} && !$self->{schema} && ($table =~ /^([^\.]+)\./)) { 6480 $tb_name = $1 . '.' . $part; 6481 } else { 6482 $tb_name = $part; 6483 } 6484 } 6485 $create_table_tmp .= "DROP TABLE IF EXISTS " . $self->quote_object_name($tb_name) . ";\n" if ($self->{drop_if_exists}); 6486 if (!$self->{pg_supports_partition}) 6487 { 6488 if (!exists $self->{subpartitions}{$table}{$part}) { 6489 $create_table_tmp .= "CREATE TABLE " . $self->quote_object_name($tb_name) 6490 . " ( CHECK (\n"; 6491 } 6492 } else { 6493 $create_table_tmp .= "CREATE TABLE " . $self->quote_object_name($tb_name) 6494 . " PARTITION OF " . $self->quote_object_name($table) . "\n"; 6495 $create_table_tmp .= "FOR VALUES"; 6496 } 6497 6498 my @condition = (); 6499 my @ind_col = (); 6500 for (my $i = 0; $i <= $#{$self->{partitions}{$table}{$pos}{info}}; $i++) 6501 { 6502 # We received all values for partitonning on multiple column, so get the one at the right indice 6503 my $value = Ora2Pg::PLSQL::convert_plsql_code($self, $self->{partitions}{$table}{$pos}{info}[$i]->{value}); 6504 if ($#{$self->{partitions}{$table}{$pos}{info}} == 0) 6505 { 6506 my @values = split(/,\s/, Ora2Pg::PLSQL::convert_plsql_code($self, $self->{partitions}{$table}{$pos}{info}[$i]->{value})); 6507 $value = $values[$i]; 6508 } 6509 my $old_value = ''; 6510 if ($old_part) 6511 { 6512 $old_value = Ora2Pg::PLSQL::convert_plsql_code($self, $self->{partitions}{$table}{$old_pos}{info}[$i]->{value}); 6513 if ($#{$self->{partitions}{$table}{$pos}{info}} == 0) 6514 { 6515 my @values = split(/,\s/, Ora2Pg::PLSQL::convert_plsql_code($self, $self->{partitions}{$table}{$old_pos}{info}[$i]->{value})); 6516 $old_value = $values[$i]; 6517 } 6518 } 6519 6520 if ($self->{partitions}{$table}{$pos}{info}[$i]->{type} eq 'LIST') 6521 { 6522 if (!$self->{pg_supports_partition}) { 6523 $check_cond .= "\t$self->{partitions}{$table}{$pos}{info}[$i]->{column} IN ($value)"; 6524 } else { 6525 $check_cond .= " IN ($value)"; 6526 } 6527 } 6528 elsif ($self->{partitions}{$table}{$pos}{info}[$i]->{type} eq 'RANGE') 6529 { 6530 if (!$self->{pg_supports_partition}) 6531 { 6532 if ($old_part eq '') { 6533 $check_cond .= "\t$self->{partitions}{$table}{$pos}{info}[$i]->{column} < $value"; 6534 } 6535 else 6536 { 6537 $check_cond .= "\t$self->{partitions}{$table}{$pos}{info}[$i]->{column} >= $old_value" 6538 . " AND $self->{partitions}{$table}{$pos}{info}[$i]->{column} < $value"; 6539 } 6540 } 6541 else 6542 { 6543 if ($old_part eq '') 6544 { 6545 my $val = 'MINVALUE,' x ($#{$self->{partitions}{$table}{$pos}{info}}+1); 6546 $val =~ s/,$//; 6547 $check_cond .= " FROM ($val) TO ($value)"; 6548 } else { 6549 $check_cond .= " FROM ($old_value) TO ($value)"; 6550 } 6551 $i += $#{$self->{partitions}{$table}{$pos}{info}}; 6552 } 6553 } 6554 elsif ($self->{partitions}{$table}{$pos}{info}[$i]->{type} eq 'HASH') 6555 { 6556 if ($self->{pg_version} < 11) 6557 { 6558 print STDERR "WARNING: Hash partitioning not supported, skipping partitioning of table $table\n"; 6559 $function = ''; 6560 $create_table_tmp = ''; 6561 $create_table_index_tmp = ''; 6562 next; 6563 } 6564 else 6565 { 6566 my $part_clause = " WITH (MODULUS " . (scalar keys %{$self->{partitions}{$table}}) . ", REMAINDER " . ($pos-1) . ")"; 6567 $check_cond .= $part_clause if ($check_cond !~ /\Q$part_clause\E$/); 6568 } 6569 } 6570 else 6571 { 6572 print STDERR "WARNING: Unknown partitioning type $self->{partitions}{$table}{$pos}{info}[$i]->{type}, skipping partitioning of table $table\n"; 6573 $create_table_tmp = ''; 6574 $create_table_index_tmp = ''; 6575 next; 6576 } 6577 if (!$self->{pg_supports_partition}) 6578 { 6579 $check_cond .= " AND" if ($i < $#{$self->{partitions}{$table}{$pos}{info}}); 6580 } 6581 my $fct = ''; 6582 my $colname = $self->{partitions}{$table}{$pos}{info}[$i]->{column}; 6583 if ($colname =~ s/([^\(]+)\(([^\)]+)\)/$2/) 6584 { 6585 $fct = $1; 6586 } 6587 my $cindx = $self->{partitions}{$table}{$pos}{info}[$i]->{column} || ''; 6588 $cindx = lc($cindx) if (!$self->{preserve_case}); 6589 $cindx = Ora2Pg::PLSQL::convert_plsql_code($self, $cindx); 6590 my $has_hash_subpartition = 0; 6591 if (exists $self->{subpartitions}{$table}{$part}) 6592 { 6593 foreach my $p (sort {$a <=> $b} keys %{$self->{subpartitions}{$table}{$part}}) 6594 { 6595 for (my $j = 0; $j <= $#{$self->{subpartitions}{$table}{$part}{$p}{info}}; $j++) 6596 { 6597 if ($self->{subpartitions}{$table}{$part}{$p}{info}[$j]->{type} eq 'HASH') 6598 { 6599 $has_hash_subpartition = 1; 6600 last; 6601 } 6602 } 6603 last if ($has_hash_subpartition); 6604 } 6605 } 6606 6607 if (!exists $self->{subpartitions}{$table}{$part} || (!$self->{pg_supports_partition} && $has_hash_subpartition)) 6608 { 6609 # Reproduce indexes definition from the main table before PG 11 6610 # after they are automatically created on partition tables 6611 if ($self->{pg_version} < 11) 6612 { 6613 my ($idx, $fts_idx) = $self->_create_indexes($table, 0, %{$self->{tables}{$table}{indexes}}); 6614 my $tb_name2 = $self->quote_object_name($tb_name); 6615 $create_table_index_tmp .= "CREATE INDEX " 6616 . $self->quote_object_name("${tb_name}_$colname$pos") 6617 . " ON " . $self->quote_object_name($tb_name) . " ($cindx);\n"; 6618 if ($idx || $fts_idx) 6619 { 6620 $idx =~ s/ $table/ $tb_name2/igs; 6621 $fts_idx =~ s/ $table/ $tb_name2/igs; 6622 # remove indexes already created 6623 $idx =~ s/CREATE [^;]+ \($cindx\);//; 6624 $fts_idx =~ s/CREATE [^;]+ \($cindx\);//; 6625 if ($idx || $fts_idx) 6626 { 6627 # fix index name to avoid duplicate index name 6628 $idx =~ s/(CREATE(?:.*?)INDEX ([^\s]+)) /$1$pos /gs; 6629 $fts_idx =~ s/(CREATE(?:.*?)INDEX ([^\s]+)) /$1$pos /gs; 6630 $create_table_index_tmp .= "-- Reproduce partition indexes that was defined on the parent table\n"; 6631 } 6632 $create_table_index_tmp .= "$idx\n" if ($idx); 6633 $create_table_index_tmp .= "$fts_idx\n" if ($fts_idx); 6634 } 6635 6636 # Set the unique (and primary) key definition 6637 $idx = $self->_create_unique_keys($table, $self->{tables}{$table}{unique_key}); 6638 if ($idx) 6639 { 6640 $idx =~ s/ $table/ $tb_name2/igs; 6641 # remove indexes already created 6642 $idx =~ s/CREATE [^;]+ \($cindx\);//; 6643 if ($idx) 6644 { 6645 # fix index name to avoid duplicate index name 6646 $idx =~ s/(CREATE(?:.*?)INDEX ([^\s]+)) /$1$pos /gs; 6647 $create_table_index_tmp .= "-- Reproduce partition unique indexes / pk that was defined on the parent table\n"; 6648 $create_table_index_tmp .= "$idx\n"; 6649 # Remove duplicate index with this one 6650 if ($idx =~ /ALTER TABLE $tb_name2 ADD PRIMARY KEY (.*);/s) 6651 { 6652 my $collist = quotemeta($1); 6653 $create_table_index_tmp =~ s/CREATE INDEX [^;]+ ON $tb_name2 $collist;//s; 6654 } 6655 } 6656 } 6657 } 6658 } 6659 my $deftb = ''; 6660 $deftb = "${table}_" if ($self->{prefix_partition}); 6661 if ($self->{partitions_default}{$table} && ($create_table{$table}{index} !~ /ON $deftb$self->{partitions_default}{$table} /)) 6662 { 6663 $cindx = $self->{partitions}{$table}{$pos}{info}[$i]->{column} || ''; 6664 $cindx = lc($cindx) if (!$self->{preserve_case}); 6665 $cindx = Ora2Pg::PLSQL::convert_plsql_code($self, $cindx); 6666 $create_table_index_tmp .= "CREATE INDEX " . $self->quote_object_name("$deftb$self->{partitions_default}{$table}_$colname") . " ON " . $self->quote_object_name("$deftb$self->{partitions_default}{$table}") . " ($cindx);\n"; 6667 } 6668 push(@ind_col, $self->{partitions}{$table}{$pos}{info}[$i]->{column}) if (!grep(/^$self->{partitions}{$table}{$pos}{info}[$i]->{column}$/, @ind_col)); 6669 if ($self->{partitions}{$table}{$pos}{info}[$i]->{type} eq 'LIST') 6670 { 6671 if (!$fct) { 6672 push(@condition, "NEW.$self->{partitions}{$table}{$pos}{info}[$i]->{column} IN (" . Ora2Pg::PLSQL::convert_plsql_code($self, $self->{partitions}{$table}{$pos}{info}[$i]->{value}) . ")"); 6673 } else { 6674 push(@condition, "$fct(NEW.$colname) IN (" . Ora2Pg::PLSQL::convert_plsql_code($self, $self->{partitions}{$table}{$pos}{info}[$i]->{value}) . ")"); 6675 } 6676 } 6677 elsif ($self->{partitions}{$table}{$pos}{info}[$i]->{type} eq 'RANGE') 6678 { 6679 if (!$fct) { 6680 push(@condition, "NEW.$self->{partitions}{$table}{$pos}{info}[$i]->{column} < " . Ora2Pg::PLSQL::convert_plsql_code($self, $self->{partitions}{$table}{$pos}{info}[$i]->{value})); 6681 } else { 6682 push(@condition, "$fct(NEW.$colname) < " . Ora2Pg::PLSQL::convert_plsql_code($self, $self->{partitions}{$table}{$pos}{info}[$i]->{value})); 6683 } 6684 } 6685 $owner = $self->{partitions}{$table}{$pos}{info}[$i]->{owner} || ''; 6686 } 6687 6688 if (!$self->{pg_supports_partition}) 6689 { 6690 if ($self->{partitions}{$table}{$pos}{info}[$i]->{type} ne 'HASH') 6691 { 6692 if (!exists $self->{subpartitions}{$table}{$part}) 6693 { 6694 $create_table_tmp .= $check_cond . "\n"; 6695 $create_table_tmp .= ") ) INHERITS ($table);\n"; 6696 } 6697 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 6698 if ($owner) { 6699 $create_table_tmp .= "ALTER TABLE " . $self->quote_object_name($tb_name) 6700 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 6701 } 6702 } 6703 } 6704 else 6705 { 6706 $create_table_tmp .= $check_cond; 6707 if (exists $self->{subpartitions_list}{"\L$table\E"}{"\L$part\E"}{type}) 6708 { 6709 if ($self->{subpartitions_list}{"\L$table\E"}{"\L$part\E"}{type}) 6710 { 6711 $create_table_tmp .= "\nPARTITION BY " . $self->{subpartitions_list}{"\L$table\E"}{"\L$part\E"}{type} . " ("; 6712 for (my $j = 0; $j <= $#{$self->{subpartitions_list}{"\L$table\E"}{"\L$part\E"}{columns}}; $j++) 6713 { 6714 $create_table_tmp .= ', ' if ($j > 0); 6715 $create_table_tmp .= $self->quote_object_name($self->{subpartitions_list}{"\L$table\E"}{"\L$part\E"}{columns}[$j]); 6716 } 6717 $create_table_tmp .= ")"; 6718 } 6719 else 6720 { 6721 print STDERR "WARNING: unsupported subpartition type on table '$table' for partition '$part'\n"; 6722 $sql_output .= " -- Unsupported partition type, please check\n"; 6723 } 6724 } 6725 $create_table_tmp .= ";\n"; 6726 } 6727 # Add subpartition if any defined on Oracle 6728 my $sub_funct_cond = ''; 6729 my $sub_old_part = ''; 6730 if (exists $self->{subpartitions}{$table}{$part}) 6731 { 6732 my $sub_cond = 'IF'; 6733 my $sub_funct_cond_tmp = ''; 6734 my $create_subtable_tmp = ''; 6735 my $total_subpartition = scalar %{$self->{subpartitions}{$table}{$part}} || 0; 6736 foreach my $p (sort {$a <=> $b} keys %{$self->{subpartitions}{$table}{$part}}) 6737 { 6738 my $subpart = $self->{subpartitions}{$table}{$part}{$p}{name}; 6739 my $sub_tb_name = $subpart; 6740 $sub_tb_name =~ s/^[^\.]+\.//; # remove schema part if any 6741 if ($self->{prefix_partition}) 6742 { 6743 if ($self->{prefix_sub_partition}) { 6744 $sub_tb_name = "${tb_name}_$sub_tb_name"; 6745 } else { 6746 $sub_tb_name = "${table}_$sub_tb_name"; 6747 } 6748 } 6749 if (!$self->{quiet} && !$self->{debug} && ($nparts % $PGBAR_REFRESH) == 0) 6750 { 6751 print STDERR $self->progress_bar($nparts, $total_partition, 25, '=', 'partitions', "generating $table/$part/$subpart" ), "\r"; 6752 } 6753 $nparts++; 6754 $create_subtable_tmp .= "DROP TABLE IF EXISTS " . $self->quote_object_name($sub_tb_name) . ";\n" if ($self->{drop_if_exists}); 6755 $create_subtable_tmp .= "CREATE TABLE " . $self->quote_object_name($sub_tb_name); 6756 if (!$self->{pg_supports_partition}) { 6757 $create_subtable_tmp .= " ( CHECK (\n"; 6758 } 6759 else 6760 { 6761 $create_subtable_tmp .= " PARTITION OF " . $self->quote_object_name($tb_name) . "\n"; 6762 $create_subtable_tmp .= "FOR VALUES"; 6763 } 6764 my $sub_check_cond_tmp = ''; 6765 my @subcondition = (); 6766 for (my $i = 0; $i <= $#{$self->{subpartitions}{$table}{$part}{$p}{info}}; $i++) 6767 { 6768 # We received all values for partitonning on multiple column, so get the one at the right indice 6769 my $value = Ora2Pg::PLSQL::convert_plsql_code($self, $self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{value}); 6770 if ($#{$self->{subpartitions}{$table}{$part}{$p}{info}} == 0) 6771 { 6772 my @values = split(/,\s/, Ora2Pg::PLSQL::convert_plsql_code($self, $self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{value})); 6773 $value = $values[$i]; 6774 } 6775 my $old_value = ''; 6776 if ($sub_old_part) 6777 { 6778 $old_value = Ora2Pg::PLSQL::convert_plsql_code($self, $self->{subpartitions}{$table}{$part}{$sub_old_pos}{info}[$i]->{value}); 6779 if ($#{$self->{subpartitions}{$table}{$part}{$p}{info}} == 0) 6780 { 6781 my @values = split(/,\s/, Ora2Pg::PLSQL::convert_plsql_code($self, $self->{subpartitions}{$table}{$part}{$sub_old_pos}{info}[$i]->{value})); 6782 $old_value = $values[$i]; 6783 } 6784 } 6785 6786 if ($self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{type} eq 'LIST') 6787 { 6788 if (!$self->{pg_supports_partition}) { 6789 $sub_check_cond_tmp .= "$self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{column} IN ($value)"; 6790 } else { 6791 $sub_check_cond_tmp .= " IN ($value)"; 6792 } 6793 } 6794 elsif ($self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{type} eq 'RANGE') 6795 { 6796 if (!$self->{pg_supports_partition}) 6797 { 6798 if ($old_part eq '') { 6799 $sub_check_cond_tmp .= "\t$self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{column} < $value"; 6800 } 6801 else 6802 { 6803 $sub_check_cond_tmp .= "\t$self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{column} >= $old_value" 6804 . " AND $self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{column} < $value"; 6805 } 6806 } 6807 else 6808 { 6809 if ($old_part eq '') 6810 { 6811 my $val = 'MINVALUE,' x ($#{$self->{subpartitions}{$table}{$part}{$p}{info}}+1); 6812 $val =~ s/,$//; 6813 $sub_check_cond_tmp .= " FROM ($val) TO ($value)"; 6814 } else { 6815 $sub_check_cond_tmp .= " FROM ($old_value) TO ($value)"; 6816 } 6817 $i += $#{$self->{subpartitions}{$table}{$part}{$p}{info}}; 6818 } 6819 } 6820 elsif ($self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{type} eq 'HASH') 6821 { 6822 if ($self->{pg_version} < 11) 6823 { 6824 print STDERR "WARNING: Hash partitioning not supported, skipping subpartitioning of table $table\n"; 6825 $create_subtable_tmp = ''; 6826 $sub_funct_cond_tmp = ''; 6827 next; 6828 } 6829 else 6830 { 6831 my $part_clause = " WITH (MODULUS " . $self->{subpartitions_list}{"\L$table\E"}{"\L$part\E"}{count} . ", REMAINDER " . ($p-1) . ")"; 6832 $sub_check_cond_tmp .= $part_clause if ($sub_check_cond_tmp !~ /\Q$part_clause\E$/); 6833 } 6834 } 6835 else 6836 { 6837 print STDERR "WARNING: Unknown partitioning type $self->{partitions}{$table}{$pos}{info}[$i]->{type}, skipping partitioning of table $table\n"; 6838 $create_subtable_tmp = ''; 6839 $sub_funct_cond_tmp = ''; 6840 next; 6841 } 6842 if (!$self->{pg_supports_partition}) { 6843 $sub_check_cond_tmp .= " AND " if ($i < $#{$self->{subpartitions}{$table}{$part}{$p}{info}}); 6844 } 6845 # Reproduce indexes definition from the main table before PG 11 6846 # after they are automatically created on partition tables 6847 if ($self->{pg_version} < 11) 6848 { 6849 push(@ind_col, $self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{column}) if (!grep(/^$self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{column}$/, @ind_col)); 6850 my $fct = ''; 6851 my $colname = $self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{column}; 6852 if ($colname =~ s/([^\(]+)\(([^\)]+)\)/$2/) { 6853 $fct = $1; 6854 } 6855 $cindx = join(',', @ind_col); 6856 $cindx = lc($cindx) if (!$self->{preserve_case}); 6857 $cindx = Ora2Pg::PLSQL::convert_plsql_code($self, $cindx); 6858 $create_table_index_tmp .= "CREATE INDEX " . $self->quote_object_name("${sub_tb_name}_$colname$p") 6859 . " ON " . $self->quote_object_name("$sub_tb_name") . " ($cindx);\n"; 6860 my $tb_name2 = $self->quote_object_name("$sub_tb_name"); 6861 # Reproduce indexes definition from the main table 6862 my ($idx, $fts_idx) = $self->_create_indexes($table, 0, %{$self->{tables}{$table}{indexes}}); 6863 if ($idx || $fts_idx) { 6864 $idx =~ s/ $table/ $tb_name2/igs; 6865 $fts_idx =~ s/ $table/ $tb_name2/igs; 6866 # remove indexes already created 6867 $idx =~ s/CREATE [^;]+ \($cindx\);//; 6868 $fts_idx =~ s/CREATE [^;]+ \($cindx\);//; 6869 if ($idx || $fts_idx) { 6870 # fix index name to avoid duplicate index name 6871 $idx =~ s/(CREATE(?:.*?)INDEX ([^\s]+)) /$1${pos}_$p /gs; 6872 $fts_idx =~ s/(CREATE(?:.*?)INDEX ([^\s]+)) /$1${pos}_$p /gs; 6873 $create_table_index_tmp .= "-- Reproduce subpartition indexes that was defined on the parent table\n"; 6874 } 6875 $create_table_index_tmp .= "$idx\n" if ($idx); 6876 $create_table_index_tmp .= "$fts_idx\n" if ($fts_idx); 6877 } 6878 6879 # Set the unique (and primary) key definition 6880 $idx = $self->_create_unique_keys($table, $self->{tables}{$table}{unique_key}); 6881 if ($idx) { 6882 $create_table_index_tmp .= "-- Reproduce subpartition unique indexes / pk that was defined on the parent table\n"; 6883 $idx =~ s/ $table/ $tb_name2/igs; 6884 # remove indexes already created 6885 $idx =~ s/CREATE [^;]+ \($cindx\);//; 6886 if ($idx) { 6887 # fix index name to avoid duplicate index name 6888 $idx =~ s/(CREATE(?:.*?)INDEX ([^\s]+)) /$1${pos}_$p /gs; 6889 $create_table_index_tmp .= "$idx\n"; 6890 # Remove duplicate index with this one 6891 if ($idx =~ /ALTER TABLE $tb_name2 ADD PRIMARY KEY (.*);/s) { 6892 my $collist = quotemeta($1); 6893 $create_table_index_tmp =~ s/CREATE INDEX [^;]+ ON $tb_name2 $collist;//s; 6894 } 6895 } 6896 } 6897 } 6898 if ($self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{type} eq 'LIST') { 6899 if (!$fct) { 6900 push(@subcondition, "NEW.$self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{column} IN (" . Ora2Pg::PLSQL::convert_plsql_code($self, $self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{value}) . ")"); 6901 } else { 6902 push(@subcondition, "$fct(NEW.$colname) IN (" . Ora2Pg::PLSQL::convert_plsql_code($self, $self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{value}) . ")"); 6903 } 6904 } elsif ($self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{type} eq 'RANGE') { 6905 if (!$fct) { 6906 push(@subcondition, "NEW.$self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{column} < " . Ora2Pg::PLSQL::convert_plsql_code($self, $self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{value})); 6907 } else { 6908 push(@subcondition, "$fct(NEW.$colname) < " . Ora2Pg::PLSQL::convert_plsql_code($self, $self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{value})); 6909 } 6910 } 6911 $owner = $self->{subpartitions}{$table}{$part}{$p}{info}[$i]->{owner} || ''; 6912 } 6913 if ($self->{pg_supports_partition}) { 6914 $sub_check_cond_tmp .= ';'; 6915 $create_subtable_tmp .= "$sub_check_cond_tmp\n"; 6916 } else { 6917 $create_subtable_tmp .= $check_cond; 6918 $create_subtable_tmp .= " AND $sub_check_cond_tmp" if ($sub_check_cond_tmp); 6919 $create_subtable_tmp .= "\n) ) INHERITS ($table);\n"; 6920 } 6921 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 6922 if ($owner) { 6923 $create_subtable_tmp .= "ALTER TABLE " . $self->quote_object_name("$sub_tb_name") 6924 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 6925 } 6926 if ($#subcondition >= 0) { 6927 $sub_funct_cond_tmp .= "\t\t$sub_cond ( " . join(' AND ', @subcondition) . " ) THEN INSERT INTO " 6928 . $self->quote_object_name("$sub_tb_name") . " VALUES (NEW.*);\n"; 6929 $sub_cond = 'ELSIF'; 6930 } 6931 $sub_old_part = $part; 6932 $sub_old_pos = $p; 6933 } 6934 if ($create_subtable_tmp) { 6935 $create_table_tmp .= $create_subtable_tmp; 6936 $sub_funct_cond = $sub_funct_cond_tmp; 6937 } 6938 } 6939 $check_cond = ''; 6940 6941 if ($#condition >= 0) 6942 { 6943 if (!$sub_funct_cond) { 6944 $funct_cond .= "\t$cond ( " . join(' AND ', @condition) . " ) THEN INSERT INTO " . $self->quote_object_name($tb_name) . " VALUES (NEW.*);\n"; 6945 } 6946 else 6947 { 6948 my $sub_old_pos = 0; 6949 if (!$self->{pg_supports_partition}) 6950 { 6951 $sub_funct_cond = Ora2Pg::PLSQL::convert_plsql_code($self, $sub_funct_cond); 6952 $funct_cond .= "\t$cond ( " . join(' AND ', @condition) . " ) THEN \n"; 6953 $funct_cond .= $sub_funct_cond; 6954 if (exists $self->{subpartitions_default}{$table}{$part}) 6955 { 6956 my $deftb = ''; 6957 $deftb = "${table}_" if ($self->{prefix_partition}); 6958 $funct_cond .= "\t\tELSE INSERT INTO " . $self->quote_object_name("$deftb$self->{subpartitions_default}{$table}{$part}") 6959 . " VALUES (NEW.*);\n\t\tEND IF;\n"; 6960 $create_table_tmp .= "DROP TABLE IF EXISTS " . $self->quote_object_name("$deftb$self->{subpartitions_default}{$table}{$part}") . ";\n" if ($self->{drop_if_exists}); 6961 $create_table_tmp .= "CREATE TABLE " . $self->quote_object_name("$deftb$self->{subpartitions_default}{$table}{$part}") 6962 . " () INHERITS ($table);\n"; 6963 $create_table_index_tmp .= "CREATE INDEX " . $self->quote_object_name("$deftb$self->{subpartitions_default}{$table}{$part}_$pos") 6964 . " ON " . $self->quote_object_name("$deftb$self->{subpartitions_default}{$table}{$part}") . " ($cindx);\n"; 6965 } 6966 else 6967 { 6968 $funct_cond .= qq{ ELSE 6969 -- Raise an exception 6970 RAISE EXCEPTION 'Value out of range in subpartition. Fix the ${table}_insert_trigger() function!'; 6971 }; 6972 $funct_cond .= "\t\tEND IF;\n"; 6973 } 6974 6975 # With default partition just add default and continue 6976 } 6977 elsif (exists $self->{subpartitions_default}{$table}{$part}) 6978 { 6979 my $tb_name = $self->{subpartitions_default}{$table}{$part}; 6980 if ($self->{prefix_partition}) { 6981 $tb_name = $table . "_" . $self->{subpartitions_default}{$table}{$part}; 6982 } elsif ($self->{export_schema} && !$self->{schema} && ($table =~ /^([^\.]+)\./)) { 6983 $tb_name = $1 . '.' . $self->{subpartitions_default}{$table}{$part}; 6984 } 6985 $create_table_tmp .= "DROP TABLE IF EXISTS " . $self->quote_object_name($tb_name) . ";\n" if ($self->{drop_if_exists}); 6986 if ($self->{pg_version} >= 11) { 6987 $create_table_tmp .= "CREATE TABLE " . $self->quote_object_name($tb_name) 6988 . " PARTITION OF " . $self->quote_object_name($table) . " DEFAULT;\n"; 6989 } elsif ($self->{subpartitions}{$table}{$part}{$sub_old_pos}{info}[$i]->{type} eq 'RANGE') { 6990 $create_table_tmp .= "CREATE TABLE " . $self->quote_object_name($tb_name) 6991 . " PARTITION OF " . $self->quote_object_name($table) . " FOR VALUES FROM ($self->{subpartitions}{$table}{$part}{$sub_old_pos}{info}[-1]->{value}) TO (MAX_VALUE);\n"; 6992 } 6993 } 6994 } 6995 $cond = 'ELSIF'; 6996 } 6997 $old_part = $part; 6998 $old_pos = $pos; 6999 $create_table{$table}{table} .= $create_table_tmp; 7000 $create_table{$table}{index} .= $create_table_index_tmp; 7001 } 7002 7003 if (exists $create_table{$table}) 7004 { 7005 if (!$self->{pg_supports_partition}) 7006 { 7007 if ($self->{partitions_default}{$table}) 7008 { 7009 my $deftb = ''; 7010 $deftb = "${table}_" if ($self->{prefix_partition}); 7011 my $pname = $self->quote_object_name("$deftb$self->{partitions_default}{$table}"); 7012 $function .= $funct_cond . qq{ ELSE 7013 INSERT INTO $pname VALUES (NEW.*); 7014}; 7015 } 7016 elsif ($function) 7017 { 7018 $function .= $funct_cond . qq{ ELSE 7019 -- Raise an exception 7020 RAISE EXCEPTION 'Value out of range in partition. Fix the ${table}_insert_trigger() function!'; 7021}; 7022 } 7023 $function .= qq{ 7024END IF; 7025RETURN NULL; 7026END; 7027\$\$ 7028LANGUAGE plpgsql; 7029} if ($function); 7030 $function = Ora2Pg::PLSQL::convert_plsql_code($self, $function); 7031 } 7032 else 7033 { 7034 # With default partition just add default and continue 7035 if (exists $self->{partitions_default}{$table}) 7036 { 7037 my $tb_name = ''; 7038 if ($self->{prefix_partition}) { 7039 $tb_name = $table . "_" . $self->{partitions_default}{$table}; 7040 } 7041 else 7042 { 7043 if ($self->{export_schema} && !$self->{schema} && ($table =~ /^([^\.]+)\./)) { 7044 $tb_name = $1 . '.' . $self->{partitions_default}{$table}; 7045 } else { 7046 $tb_name = $self->{partitions_default}{$table}; 7047 } 7048 } 7049 $create_table{$table}{table} .= "DROP TABLE IF EXISTS " . $self->quote_object_name($tb_name) . ";\n" if ($self->{drop_if_exists}); 7050 if ($self->{pg_version} >= 11) { 7051 $create_table{$table}{table} .= "CREATE TABLE " . $self->quote_object_name($tb_name) 7052 . " PARTITION OF " . $self->quote_object_name($table) . " DEFAULT;\n"; 7053 } else { 7054 $create_table{$table}{table} .= "CREATE TABLE " . $self->quote_object_name($tb_name) 7055 . " PARTITION OF " . $self->quote_object_name($table) . " FOR VALUES FROM ($self->{partitions}{$table}{$old_pos}{info}[-1]->{value}) TO (MAX_VALUE);\n"; 7056 } 7057 } 7058 } 7059 } 7060 7061 if (exists $create_table{$table}) 7062 { 7063 $partition_indexes .= qq{ 7064-- Create indexes on each partition of table $table 7065$create_table{$table}{'index'} 7066 7067} if ($create_table{$table}{'index'}); 7068 $sql_output .= qq{ 7069$create_table{$table}{table} 7070}; 7071 my $tb = $self->quote_object_name($table); 7072 my $trg = $self->quote_object_name("${table}_insert_trigger"); 7073 my $defname = $self->{partitions_default}{$table}; 7074 $defname = $table . '_' . $defname if ($self->{prefix_partition}); 7075 $defname = $self->quote_object_name($defname); 7076 if (!$self->{pg_supports_partition} && $function) 7077 { 7078 $sql_output .= qq{ 7079-- Create default table, where datas are inserted if no condition match 7080CREATE TABLE $defname () INHERITS ($tb); 7081} if ($self->{partitions_default}{$table}); 7082 $sql_output .= qq{ 7083 7084$function 7085 7086CREATE TRIGGER ${table}_trigger_insert 7087BEFORE INSERT ON $table 7088FOR EACH ROW EXECUTE PROCEDURE $trg(); 7089 7090------------------------------------------------------------------------------- 7091}; 7092 7093 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 7094 if ($owner) 7095 { 7096 $sql_output .= "ALTER TABLE " . $self->quote_object_name($self->{partitions_default}{$table}) 7097 . " OWNER TO " . $self->quote_object_name($owner) . ";\n" 7098 if ($self->{partitions_default}{$table}); 7099 $sql_output .= "ALTER FUNCTION " . $self->quote_object_name("${table}_insert_trigger") 7100 . "() OWNER TO " . $self->quote_object_name($owner) . ";\n"; 7101 } 7102 } 7103 } 7104 } 7105 if (!$self->{quiet} && !$self->{debug}) { 7106 print STDERR $self->progress_bar($nparts - 1, $total_partition, 25, '=', 'partitions', 'end of output.'), "\n"; 7107 } 7108 if (!$sql_output) { 7109 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 7110 } 7111 $self->dump($sql_header . $sql_output); 7112 7113 if ($partition_indexes) 7114 { 7115 my $fhdl = undef; 7116 $self->logit("Dumping partition indexes to file : PARTITION_INDEXES_$self->{output}\n", 1); 7117 $sql_header = "-- Generated by Ora2Pg, the Oracle database Schema converter, version $VERSION\n"; 7118 $sql_header .= "-- Copyright 2000-2021 Gilles DAROLD. All rights reserved.\n"; 7119 $sql_header .= "-- DATASOURCE: $self->{oracle_dsn}\n\n"; 7120 $sql_header = '' if ($self->{no_header}); 7121 $fhdl = $self->open_export_file("PARTITION_INDEXES_$self->{output}"); 7122 $self->set_binmode($fhdl) if (!$self->{compress}); 7123 $self->dump($sql_header . $partition_indexes, $fhdl); 7124 $self->close_export_file($fhdl); 7125 } 7126 7127 return; 7128} 7129 7130=head2 export_synonym 7131 7132Export Oracle synonym into PostgreSQL compatible statement. 7133 7134=cut 7135 7136sub export_synonym 7137{ 7138 my $self = shift; 7139 7140 my $sql_header = $self->_set_file_header(); 7141 my $sql_output = ""; 7142 7143 $self->logit("Add synonyms definition...\n", 1); 7144 # Read DML from file if any 7145 if ($self->{input_file}) { 7146 $self->read_synonym_from_file(); 7147 } 7148 my $i = 1; 7149 my $num_total_synonym = scalar keys %{$self->{synonyms}}; 7150 my $count_syn = 0; 7151 my $PGBAR_REFRESH = set_refresh_count($num_total_synonym); 7152 foreach my $syn (sort { $a cmp $b } keys %{$self->{synonyms}}) 7153 { 7154 if (!$self->{quiet} && !$self->{debug} && ($count_syn % $PGBAR_REFRESH) == 0) { 7155 print STDERR $self->progress_bar($i, $num_total_synonym, 25, '=', 'synonyms', "generating $syn" ), "\r"; 7156 } 7157 $count_syn++; 7158 if ($self->{synonyms}{$syn}{dblink}) { 7159 $sql_output .= "-- You need to create foreign table $self->{synonyms}{$syn}{table_owner}.$self->{synonyms}{$syn}{table_name} using foreign server: $self->{synonyms}{$syn}{dblink} (see DBLINK and FDW export type)\n"; 7160 } 7161 $sql_output .= "CREATE$self->{create_or_replace} VIEW " . $self->quote_object_name("$self->{synonyms}{$syn}{owner}.$syn") 7162 . " AS SELECT * FROM " . $self->quote_object_name("$self->{synonyms}{$syn}{table_owner}.$self->{synonyms}{$syn}{table_name}") . ";\n"; 7163 my $owner = $self->{synonyms}{$syn}{table_owner}; 7164 $owner = $self->{force_owner} if ($self->{force_owner} && ($self->{force_owner} ne "1")); 7165 $sql_output .= "ALTER VIEW " . $self->quote_object_name("$self->{synonyms}{$syn}{owner}.$syn") 7166 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 7167 $sql_output .= "GRANT ALL ON " . $self->quote_object_name("$self->{synonyms}{$syn}{owner}.$syn") 7168 . " TO " . $self->quote_object_name($self->{synonyms}{$syn}{owner}) . ";\n\n"; 7169 $i++; 7170 } 7171 if (!$self->{quiet} && !$self->{debug}) { 7172 print STDERR $self->progress_bar($i - 1, $num_total_synonym, 25, '=', 'synonyms', 'end of output.'), "\n"; 7173 } 7174 if (!$sql_output) { 7175 $sql_output = "-- Nothing found of type $self->{type}\n" if (!$self->{no_header}); 7176 } 7177 7178 $self->dump($sql_header . $sql_output); 7179 7180 return; 7181} 7182 7183=head2 export_table 7184 7185Export Oracle table into PostgreSQL compatible statement. 7186 7187=cut 7188 7189sub export_table 7190{ 7191 my $self = shift; 7192 7193 my $sql_header = $self->_set_file_header(); 7194 my $sql_output = ""; 7195 7196 $self->logit("Exporting tables...\n", 1); 7197 7198 if (!$self->{oracle_fdw_data_export}) 7199 { 7200 if ($self->{export_schema} && ($self->{schema} || $self->{pg_schema})) 7201 { 7202 if ($self->{create_schema}) { 7203 if ($self->{pg_schema} && $self->{pg_schema} =~ /,/) { 7204 $self->logit("FATAL: with export type TABLE you can not set multiple schema to PG_SCHEMA when EXPORT_SCHEMA is enabled.\n", 0, 1); 7205 } 7206 $sql_output .= "CREATE SCHEMA IF NOT EXISTS " . $self->quote_object_name($self->{pg_schema} || $self->{schema}) . ";\n"; 7207 } 7208 my $owner = ''; 7209 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 7210 $owner ||= $self->{schema}; 7211 if ($owner && $self->{create_schema}) { 7212 $sql_output .= "ALTER SCHEMA " . $self->quote_object_name($self->{pg_schema} || $self->{schema}) . " OWNER TO \L$owner\E;\n"; 7213 } 7214 $sql_output .= "\n"; 7215 } 7216 elsif ($self->{export_schema}) 7217 { 7218 if ($self->{create_schema}) { 7219 my $current_schema = ''; 7220 foreach my $table (sort keys %{$self->{tables}}) { 7221 if ($table =~ /^([^\.]+)\..*/) { 7222 if ($1 ne $current_schema) { 7223 $current_schema = $1; 7224 $sql_output .= "CREATE SCHEMA IF NOT EXISTS " . $self->quote_object_name($1) . ";\n"; 7225 } 7226 } 7227 } 7228 } 7229 } 7230 $sql_output .= $self->set_search_path(); 7231 } 7232 else 7233 { 7234 # prefix the search path with FDW import ora2pg_fdw_import schema 7235 my $tmp_search_path = $self->set_search_path(); 7236 $tmp_search_path =~ s/search_path = /search_path = ora2pg_fdw_import,/; 7237 $sql_output .= $tmp_search_path; 7238 } 7239 7240 # Read DML from file if any 7241 if ($self->{input_file}) { 7242 $self->read_schema_from_file(); 7243 } 7244 7245 my $constraints = ''; 7246 if ($self->{file_per_constraint}) { 7247 $constraints .= $self->set_search_path(); 7248 } 7249 my $indices = ''; 7250 my $fts_indices = ''; 7251 7252 # Find first the total number of tables 7253 my $num_total_table = scalar keys %{$self->{tables}}; 7254 7255 # Hash that will contains virtual column information to build triggers 7256 my %virtual_trigger_info = (); 7257 7258 # Stores DDL to restart autoincrement sequences 7259 my $sequence_output = ''; 7260 7261 # Dump all table/index/constraints SQL definitions 7262 my $ib = 1; 7263 my $count_table = 0; 7264 my $PGBAR_REFRESH = set_refresh_count($num_total_table); 7265 foreach my $table (sort { 7266 if (exists $self->{tables}{$a}{internal_id}) { 7267 $self->{tables}{$a}{internal_id} <=> $self->{tables}{$b}{internal_id}; 7268 } else { 7269 $a cmp $b; 7270 } 7271 } keys %{$self->{tables}}) 7272 { 7273 # Foreign table can not be temporary 7274 next if (($self->{type} eq 'FDW' || $self->{oracle_fdw_data_export}) 7275 and $self->{tables}{$table}{table_info}{type} =~/ TEMPORARY/); 7276 7277 $self->logit("Dumping table $table...\n", 1); 7278 if (!$self->{quiet} && !$self->{debug} && ($count_table % $PGBAR_REFRESH) == 0) { 7279 print STDERR $self->progress_bar($ib, $num_total_table, 25, '=', 'tables', "exporting $table" ), "\r"; 7280 } 7281 $count_table++; 7282 7283 # Create FDW server if required 7284 if ($self->{external_to_fdw}) { 7285 if ( grep(/^$table$/i, keys %{$self->{external_table}}) ) { 7286 $sql_header .= "CREATE EXTENSION IF NOT EXISTS file_fdw;\n\n" if ($sql_header !~ /CREATE EXTENSION .* file_fdw;/is); 7287 $sql_header .= "CREATE SERVER \L$self->{external_table}{$table}{directory}\E FOREIGN DATA WRAPPER file_fdw;\n\n" if ($sql_header !~ /CREATE SERVER $self->{external_table}{$table}{directory} FOREIGN DATA WRAPPER file_fdw;/is); 7288 } 7289 } 7290 7291 my $tbname = $self->get_replaced_tbname($table); 7292 my $foreign = ''; 7293 if ( ($self->{type} eq 'FDW') || $self->{oracle_fdw_data_export} || ($self->{external_to_fdw} && (grep(/^$table$/i, keys %{$self->{external_table}}) || $self->{tables}{$table}{table_info}{connection})) ) { 7294 $foreign = ' FOREIGN'; 7295 } 7296 my $obj_type = $self->{tables}{$table}{table_info}{type} || 'TABLE'; 7297 if ( ($obj_type eq 'TABLE') && $self->{tables}{$table}{table_info}{nologging} && !$self->{disable_unlogged} ) { 7298 $obj_type = 'UNLOGGED ' . $obj_type; 7299 } 7300 if (exists $self->{tables}{$table}{table_as}) { 7301 if ($self->{plsql_pgsql}) { 7302 $self->{tables}{$table}{table_as} = Ora2Pg::PLSQL::convert_plsql_code($self, $self->{tables}{$table}{table_as}); 7303 } 7304 my $withoid = _make_WITH($self->{with_oid}, $self->{tables}{$tbname}{table_info}); 7305 $sql_output .= "\nCREATE $obj_type $tbname $withoid AS $self->{tables}{$table}{table_as};\n"; 7306 next; 7307 } 7308 if (exists $self->{tables}{$table}{truncate_table}) { 7309 $sql_output .= "\nTRUNCATE TABLE $tbname;\n"; 7310 } 7311 my $serial_sequence = ''; 7312 my $enum_str = ''; 7313 my @skip_column_check = (); 7314 if (exists $self->{tables}{$table}{column_info}) 7315 { 7316 my $schem = ''; 7317 7318 # Add the destination schema 7319 if ($self->{external_to_fdw} && ($self->{type} eq 'INSERT' || $self->{type} eq 'COPY')) { 7320 $sql_output .= "\nCREATE$foreign $obj_type ora2pg_fdw_import.$tbname (\n"; 7321 } else { 7322 $sql_output .= "\nCREATE$foreign $obj_type $tbname (\n"; 7323 } 7324 7325 7326 # Extract column information following the Oracle position order 7327 foreach my $k (sort { 7328 if (!$self->{reordering_columns}) { 7329 $self->{tables}{$table}{column_info}{$a}[11] <=> $self->{tables}{$table}{column_info}{$b}[11]; 7330 } else { 7331 my $tmpa = $self->{tables}{$table}{column_info}{$a}; 7332 $tmpa->[2] =~ s/\D//g; 7333 my $typa = $self->_sql_type($tmpa->[1], $tmpa->[2], $tmpa->[5], $tmpa->[6], $tmpa->[4]); 7334 $typa =~ s/\(.*//; 7335 my $tmpb = $self->{tables}{$table}{column_info}{$b}; 7336 $tmpb->[2] =~ s/\D//g; 7337 my $typb = $self->_sql_type($tmpb->[1], $tmpb->[2], $tmpb->[5], $tmpb->[6], $tmpb->[4]); 7338 $typb =~ s/\(.*//; 7339 if($TYPALIGN{$typa} != $TYPALIGN{$typb}){ 7340 # sort by field size asc 7341 $TYPALIGN{$typa} <=> $TYPALIGN{$typb}; 7342 }else{ 7343 # if same size sort by original position 7344 $self->{tables}{$table}{column_info}{$a}[11] <=> $self->{tables}{$table}{column_info}{$b}[11]; 7345 } 7346 } 7347 } keys %{$self->{tables}{$table}{column_info}}) { 7348 7349 # COLUMN_NAME,DATA_TYPE,DATA_LENGTH,NULLABLE,DATA_DEFAULT,DATA_PRECISION,DATA_SCALE,CHAR_LENGTH,TABLE_NAME,OWNER,VIRTUAL_COLUMN,POSITION,AUTO_INCREMENT,SRID,SDO_DIM,SDO_GTYPE 7350 my $f = $self->{tables}{$table}{column_info}{$k}; 7351 $f->[2] =~ s/\D//g; 7352 my $type = $self->_sql_type($f->[1], $f->[2], $f->[5], $f->[6], $f->[4]); 7353 $type = "$f->[1], $f->[2]" if (!$type); 7354 # Change column names 7355 my $fname = $f->[0]; 7356 if (exists $self->{replaced_cols}{"\L$table\E"}{"\L$fname\E"} && $self->{replaced_cols}{"\L$table\E"}{"\L$fname\E"}) { 7357 $self->logit("\tReplacing column \L$f->[0]\E as " . $self->{replaced_cols}{"\L$table\E"}{"\L$fname\E"} . "...\n", 1); 7358 $fname = $self->{replaced_cols}{"\L$table\E"}{"\L$fname\E"}; 7359 } 7360 7361 # Check if we need auto increment 7362 if ($f->[12] eq 'auto_increment' || $f->[12] eq '1') { 7363 if ($type !~ s/bigint/bigserial/) { 7364 if ($type !~ s/smallint/smallserial/) { 7365 $type =~ s/integer/serial/; 7366 } 7367 } 7368 if ($type =~ /serial/) { 7369 my $seqname = lc($tbname) . '_' . lc($fname) . '_seq'; 7370 if ($self->{preserve_case}) { 7371 $seqname = $tbname . '_' . $fname . '_seq'; 7372 } 7373 my $tobequoted = 0; 7374 if ($seqname =~ s/"//g) { 7375 $tobequoted = 1; 7376 } 7377 7378 if (length($seqname) > 63) { 7379 if (length($tbname) > 29) { 7380 $seqname = substr(lc($tbname), 0, 29); 7381 } else { 7382 $seqname = lc($tbname); 7383 } 7384 if (length($fname) > 29) { 7385 $seqname .= '_' . substr(lc($fname), 0, 29); 7386 } else { 7387 $seqname .= '_' . lc($fname); 7388 } 7389 $seqname .= '_seq'; 7390 } 7391 if ($tobequoted) { 7392 $seqname = '"' . $seqname . '"'; 7393 } 7394 $serial_sequence .= "ALTER SEQUENCE $seqname RESTART WITH $self->{tables}{$table}{table_info}{auto_increment};\n" if (exists $self->{tables}{$table}{table_info}{auto_increment}); 7395 } 7396 } 7397 7398 # Check if this column should be replaced by a boolean following table/column name 7399 if ($f->[1] =~ /ENUM/i) { 7400 $f->[1] =~ s/^ENUM\(//i; 7401 $f->[1] =~ s/\)$//; 7402 my $keyname = $tbname . '_' . $fname . '_chk'; 7403 $keyname =~ s/(.*)"(_${fname}_chk)/$1$2"/; # used when preserve_case is enable 7404 $enum_str .= "ALTER TABLE $tbname ADD CONSTRAINT $keyname CHECK ($fname IN ($f->[1]));\n"; 7405 $type = 'varchar'; 7406 } 7407 my $typlen = $f->[5]; 7408 $typlen ||= $f->[2]; 7409 if (!$self->{oracle_fdw_data_export}) 7410 { 7411 if (grep(/^$f->[0]$/i, @{$self->{'replace_as_boolean'}{uc($table)}})) { 7412 $type = 'boolean'; 7413 push(@skip_column_check, $fname); 7414 # Check if this column should be replaced by a boolean following type/precision 7415 } elsif (exists $self->{'replace_as_boolean'}{uc($f->[1])} && ($self->{'replace_as_boolean'}{uc($f->[1])}[0] == $typlen)) { 7416 $type = 'boolean'; 7417 push(@skip_column_check, $fname); 7418 } 7419 } 7420 if ($f->[1] =~ /SDO_GEOMETRY/) { 7421 # 12:SRID,13:SDO_DIM,14:SDO_GTYPE 7422 # Set the dimension, array is (srid, dims, gtype) 7423 my $suffix = ''; 7424 if ($f->[13] == 3) { 7425 $suffix = 'Z'; 7426 } elsif ($f->[13] == 4) { 7427 $suffix = 'ZM'; 7428 } 7429 my $gtypes = ''; 7430 if (!$f->[14] || ($f->[14] =~ /,/) ) { 7431 $gtypes = $ORA2PG_SDO_GTYPE{0}; 7432 } else { 7433 $gtypes = $f->[14]; 7434 } 7435 $type = "geometry($gtypes$suffix"; 7436 if ($f->[12]) { 7437 $type .= ",$f->[12]"; 7438 } 7439 $type .= ")"; 7440 } 7441 $type = $self->{'modify_type'}{"\L$table\E"}{"\L$f->[0]\E"} if (exists $self->{'modify_type'}{"\L$table\E"}{"\L$f->[0]\E"}); 7442 $fname = $self->quote_object_name($fname); 7443 $sql_output .= "\t$fname $type"; 7444 if ($foreign && $self->is_primary_key_column($table, $f->[0])) { 7445 $sql_output .= " OPTIONS (key 'true')"; 7446 } 7447 if (!$f->[3] || ($f->[3] =~ /^N/)) { 7448 # smallserial, serial and bigserial use a NOT NULL sequence as default value, 7449 # so we don't need to add it here 7450 if ($type !~ /serial/) { 7451 push(@{$self->{tables}{$table}{check_constraint}{notnull}}, $f->[0]); 7452 $sql_output .= " NOT NULL"; 7453 } 7454 } 7455 7456 # Autoincremented columns 7457 if (!$self->{schema} && $self->{export_schema}) { 7458 $f->[8] = "$f->[9].$f->[8]"; 7459 } 7460 if (exists $self->{identity_info}{$f->[8]}{$f->[0]} and $self->{type} ne 'FDW' and !$self->{oracle_fdw_data_export}) 7461 { 7462 $sql_output =~ s/ NOT NULL\s*$//s; # IDENTITY or serial column are NOT NULL by default 7463 if ($self->{pg_supports_identity}) 7464 { 7465 $sql_output =~ s/ [^\s]+$/ bigint/; # Force bigint 7466 $sql_output .= " GENERATED $self->{identity_info}{$f->[8]}{$f->[0]}{generation} AS IDENTITY"; 7467 $sql_output .= " (" . $self->{identity_info}{$f->[8]}{$f->[0]}{options} . ')' if (exists $self->{identity_info}{$f->[8]}{$f->[0]}{options} && $self->{identity_info}{$f->[8]}{$f->[0]}{options} ne ''); 7468 } 7469 else 7470 { 7471 $sql_output =~ s/bigint\s*$/bigserial/s; 7472 $sql_output =~ s/smallint\s*$/smallserial/s; 7473 $sql_output =~ s/(integer|int)\s*$/serial/s; 7474 } 7475 $sql_output .= ",\n"; 7476 $sequence_output .= "SELECT ora2pg_upd_autoincrement_seq('$f->[8]','$f->[0]');\n"; 7477 next; 7478 } 7479 7480 # Default value 7481 if ($f->[4] ne "" && uc($f->[4]) ne 'NULL') 7482 { 7483 $f->[4] =~ s/^\s+//; 7484 $f->[4] =~ s/\s+$//; 7485 $f->[4] =~ s/"//gs; 7486 if ($self->{plsql_pgsql}) { 7487 $f->[4] = Ora2Pg::PLSQL::convert_plsql_code($self, $f->[4]); 7488 } 7489 # Check if this is a virtual column before proceeding to default value export 7490 if ($self->{tables}{$table}{column_info}{$k}[10] eq 'YES') { 7491 $virtual_trigger_info{$table}{$k} = $f->[4]; 7492 $virtual_trigger_info{$table}{$k} =~ s/"//gs; 7493 foreach my $c (keys %{$self->{tables}{$table}{column_info}}) { 7494 $virtual_trigger_info{$table}{$k} =~ s/\b$c\b/NEW.$c/gs; 7495 } 7496 7497 } else { 7498 7499 if (($f->[4] ne '') && ($self->{type} ne 'FDW') && !$self->{oracle_fdw_data_export}) { 7500 if ($type eq 'boolean') { 7501 my $found = 0; 7502 foreach my $k (sort {$b cmp $a} %{ $self->{ora_boolean_values} }) { 7503 if ($f->[4] =~ /\b$k\b/i) { 7504 $sql_output .= " DEFAULT '" . $self->{ora_boolean_values}{$k} . "'"; 7505 $found = 1; 7506 last; 7507 } 7508 } 7509 $sql_output .= " DEFAULT " . $f->[4] if (!$found); 7510 } else { 7511 if (($f->[4] !~ /^'/) && ($f->[4] =~ /[^\d\.]/)) { 7512 if ($type =~ /CHAR|TEXT|ENUM/i) { 7513 $f->[4] = "'$f->[4]'" if ($f->[4] !~ /[']/ && $f->[4] !~ /\(.*\)/); 7514 } elsif ($type =~ /DATE|TIME/i) { 7515 if ($f->[4] =~ /0000-00-00/) { 7516 if ($self->{replace_zero_date}) { 7517 $f->[4] = $self->{replace_zero_date}; 7518 } else { 7519 $f->[4] =~ s/^0000-00-00/1970-01-01/; 7520 } 7521 } 7522 if ($f->[4] =~ /^\d+/) { 7523 $f->[4] = "'$f->[4]'"; 7524 } elsif ($f->[4] =~ /^[\-]*INFINITY$/) { 7525 $f->[4] = "'$f->[4]'::$type"; 7526 } elsif ($f->[4] =~ /AT TIME ZONE/i) { 7527 $f->[4] = "($f->[4])"; 7528 } 7529 } 7530 } 7531 else 7532 { 7533 my @c = $f->[4] =~ /\./g; 7534 if ($#c >= 1) 7535 { 7536 if ($type =~ /CHAR|TEXT|ENUM/i) { 7537 $f->[4] = "'$f->[4]'" if ($f->[4] !~ /[']/ && $f->[4] !~ /\(.*\)/); 7538 } elsif ($type =~ /DATE|TIME/i) { 7539 if ($f->[4] =~ /0000-00-00/) { 7540 if ($self->{replace_zero_date}) { 7541 $f->[4] = $self->{replace_zero_date}; 7542 } else { 7543 $f->[4] =~ s/^0000-00-00/1970-01-01/; 7544 } 7545 } 7546 if ($f->[4] =~ /^\d+/) { 7547 $f->[4] = "'$f->[4]'"; 7548 } elsif ($f->[4] =~ /^[\-]*INFINITY$/) { 7549 $f->[4] = "'$f->[4]'::$type"; 7550 } elsif ($f->[4] =~ /AT TIME ZONE/i) { 7551 $f->[4] = "($f->[4])"; 7552 } 7553 } else { 7554 $f->[4] = "'$f->[4]'"; 7555 } 7556 } 7557 } 7558 $f->[4] = 'NULL' if ($f->[4] eq "''" && $type =~ /int|double|numeric/i); 7559 $sql_output .= " DEFAULT $f->[4]"; 7560 } 7561 } 7562 } 7563 } 7564 $sql_output .= ",\n"; 7565 } 7566 if ($self->{pkey_in_create}) { 7567 $sql_output .= $self->_get_primary_keys($table, $self->{tables}{$table}{unique_key}); 7568 } 7569 $sql_output =~ s/,$//; 7570 $sql_output .= ')'; 7571 if (exists $self->{tables}{$table}{table_info}{on_commit}) 7572 { 7573 $sql_output .= ' ' . $self->{tables}{$table}{table_info}{on_commit}; 7574 } 7575 7576 if ($self->{tables}{$table}{table_info}{partitioned} && $self->{pg_supports_partition} && !$self->{disable_partition}) { 7577 if ($self->{partitions_list}{"\L$table\E"}{type}) 7578 { 7579 $sql_output .= " PARTITION BY " . $self->{partitions_list}{"\L$table\E"}{type} . " ("; 7580 for (my $j = 0; $j <= $#{$self->{partitions_list}{"\L$table\E"}{columns}}; $j++) 7581 { 7582 $sql_output .= ', ' if ($j > 0); 7583 $sql_output .= $self->quote_object_name($self->{partitions_list}{"\L$table\E"}{columns}[$j]); 7584 } 7585 $sql_output .= ")"; 7586 } 7587 else 7588 { 7589 print STDERR "WARNING: unsupported partition type on table '$table'\n"; 7590 $sql_output .= " -- Unsupported partition type, please check\n"; 7591 } 7592 } 7593 if ( ($self->{type} ne 'FDW') && !$self->{oracle_fdw_data_export} && (!$self->{external_to_fdw} || (!grep(/^$table$/i, keys %{$self->{external_table}}) && !$self->{tables}{$table}{table_info}{connection})) ) 7594 { 7595 my $withoid = _make_WITH($self->{with_oid}, $self->{tables}{$table}{table_info}); 7596 if ($self->{use_tablespace} && $self->{tables}{$table}{table_info}{tablespace} && !grep(/^$self->{tables}{$table}{table_info}{tablespace}$/i, @{$self->{default_tablespaces}})) { 7597 $sql_output .= " $withoid TABLESPACE $self->{tables}{$table}{table_info}{tablespace};\n"; 7598 } else { 7599 $sql_output .= " $withoid;\n"; 7600 } 7601 } 7602 elsif ( grep(/^$table$/i, keys %{$self->{external_table}}) ) 7603 { 7604 my $program = ''; 7605 $program = ", program '$self->{external_table}{$table}{program}'" if ($self->{external_table}{$table}{program}); 7606 $sql_output .= " SERVER \L$self->{external_table}{$table}{directory}\E OPTIONS(filename '$self->{external_table}{$table}{directory_path}$self->{external_table}{$table}{location}', format 'csv', delimiter '$self->{external_table}{$table}{delimiter}'$program);\n"; 7607 } 7608 elsif ($self->{is_mysql}) 7609 { 7610 $schem = "dbname '$self->{schema}'," if ($self->{schema}); 7611 my $r_server = $self->{fdw_server}; 7612 my $r_table = $table; 7613 if ($self->{tables}{$table}{table_info}{connection} =~ /([^'\/]+)\/([^']+)/) 7614 { 7615 $r_server = $1; 7616 $r_table = $2; 7617 } 7618 $sql_output .= " SERVER $r_server OPTIONS($schem table_name '$r_table');\n"; 7619 } 7620 else 7621 { 7622 my $tmptb = $table; 7623 if ($self->{schema}) { 7624 $schem = "schema '$self->{schema}',"; 7625 } elsif ($tmptb =~ s/^([^\.]+)\.//) { 7626 $schem = "schema '$1',"; 7627 } 7628 $sql_output .= " SERVER $self->{fdw_server} OPTIONS($schem table '$tmptb', readonly 'true');\n"; 7629 } 7630 } 7631 # For data export from foreign table, go to next table 7632 if ($self->{oracle_fdw_data_export}) 7633 { 7634 $ib++; 7635 next; 7636 } 7637 7638 $sql_output .= $serial_sequence; 7639 $sql_output .= $enum_str; 7640 7641 # Add comments on table 7642 if (!$self->{disable_comment} && $self->{tables}{$table}{table_info}{comment}) 7643 { 7644 $self->{tables}{$table}{table_info}{comment} =~ s/'/''/gs; 7645 $sql_output .= "COMMENT ON$foreign TABLE " . $self->quote_object_name($tbname) . " IS E'$self->{tables}{$table}{table_info}{comment}';\n"; 7646 } 7647 7648 # Add comments on columns 7649 if (!$self->{disable_comment}) 7650 { 7651 foreach my $f (sort { lc($a) cmp lc($b) } keys %{$self->{tables}{$table}{column_comments}}) 7652 { 7653 next unless $self->{tables}{$table}{column_comments}{$f}; 7654 $self->{tables}{$table}{column_comments}{$f} =~ s/'/''/gs; 7655 # Change column names 7656 my $fname = $f; 7657 if (exists $self->{replaced_cols}{"\L$table\E"}{lc($fname)} && $self->{replaced_cols}{"\L$table\E"}{lc($fname)}) { 7658 $self->logit("\tReplacing column $f as " . $self->{replaced_cols}{"\L$table\E"}{lc($fname)} . "...\n", 1); 7659 $fname = $self->{replaced_cols}{"\L$table\E"}{lc($fname)}; 7660 } 7661 $sql_output .= "COMMENT ON COLUMN " . $self->quote_object_name($tbname) . '.' 7662 . $self->quote_object_name($fname) 7663 . " IS E'" . $self->{tables}{$table}{column_comments}{$f} . "';\n"; 7664 } 7665 } 7666 7667 # Change ownership 7668 if ($self->{force_owner}) 7669 { 7670 my $owner = $self->{tables}{$table}{table_info}{owner}; 7671 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 7672 $sql_output .= "ALTER$foreign $self->{tables}{$table}{table_info}{type} " . $self->quote_object_name($tbname) 7673 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 7674 } 7675 if (exists $self->{tables}{$table}{alter_index} && $self->{tables}{$table}{alter_index}) 7676 { 7677 foreach (@{$self->{tables}{$table}{alter_index}}) { 7678 $sql_output .= "$_;\n"; 7679 } 7680 } 7681 my $export_indexes = 1; 7682 7683 if ((!$self->{tables}{$table}{table_info}{partitioned} || $self->{pg_version} >= 11 7684 || $self->{disable_partition}) && $self->{type} ne 'FDW') 7685 { 7686 # Set the indexes definition 7687 my ($idx, $fts_idx) = $self->_create_indexes($table, 0, %{$self->{tables}{$table}{indexes}}); 7688 $indices .= "$idx\n" if ($idx); 7689 $fts_indices .= "$fts_idx\n" if ($fts_idx); 7690 if (!$self->{file_per_index}) 7691 { 7692 $sql_output .= $indices; 7693 $indices = ''; 7694 $sql_output .= $fts_indices; 7695 $fts_indices = ''; 7696 } 7697 7698 # Set the unique (and primary) key definition 7699 $constraints .= $self->_create_unique_keys($table, $self->{tables}{$table}{unique_key}); 7700 # Set the check constraint definition 7701 $constraints .= $self->_create_check_constraint($table, $self->{tables}{$table}{check_constraint},$self->{tables}{$table}{field_name}, @skip_column_check); 7702 if (!$self->{file_per_constraint}) 7703 { 7704 $sql_output .= $constraints; 7705 $constraints = ''; 7706 } 7707 } 7708 7709 if (exists $self->{tables}{$table}{alter_table} && !$self->{disable_unlogged} ) 7710 { 7711 $obj_type =~ s/UNLOGGED //; 7712 foreach (@{$self->{tables}{$table}{alter_table}}) { 7713 $sql_output .= "\nALTER $obj_type $tbname $_;\n"; 7714 } 7715 } 7716 $ib++; 7717 } 7718 7719 if (!$self->{quiet} && !$self->{debug}) 7720 { 7721 print STDERR $self->progress_bar($ib - 1, $num_total_table, 25, '=', 'tables', 'end of table export.'), "\n"; 7722 } 7723 7724 # When exporting data with oracle_fdw there is no more to do 7725 return $sql_output if ($self->{oracle_fdw_data_export}); 7726 7727 if ($sequence_output && $self->{type} ne 'FDW') 7728 { 7729 my $fhdl = undef; 7730 $sequence_output = qq{ 7731CREATE OR REPLACE FUNCTION ora2pg_upd_autoincrement_seq (tbname text, colname text) RETURNS VOID AS \$body\$ 7732DECLARE 7733 query text; 7734 maxval bigint; 7735 seqname text; 7736BEGIN 7737 query := 'SELECT max(' || colname || ')+1 FROM ' || tbname; 7738 EXECUTE query INTO maxval; 7739 IF (maxval IS NOT NULL) THEN 7740 query := \$\$SELECT (string_to_array(adsrc,''''))[2] FROM pg_attrdef WHERE adrelid = '\$\$ 7741 || tbname || \$\$'::regclass AND adnum = (SELECT attnum FROM pg_attribute WHERE attrelid = '\$\$ 7742 || tbname || \$\$'::regclass AND attname = '\$\$ || colname || \$\$') AND adsrc LIKE 'nextval%'\$\$; 7743 EXECUTE query INTO seqname; 7744 IF (seqname IS NOT NULL) THEN 7745 query := 'ALTER SEQUENCE ' || seqname || ' RESTART WITH ' || maxval; 7746 EXECUTE query; 7747 END IF; 7748 ELSE 7749 RAISE NOTICE 'Table % is empty, you must load the AUTOINCREMENT file after data import.', tbname; 7750 END IF; 7751END; 7752\$body\$ 7753LANGUAGE PLPGSQL; 7754 7755} . $sequence_output; 7756 $sequence_output .= "DROP FUNCTION ora2pg_upd_autoincrement_seq(text, text);\n"; 7757 $self->logit("Dumping DDL to restart autoincrement sequences into separate file : AUTOINCREMENT_$self->{output}\n", 1); 7758 $fhdl = $self->open_export_file("AUTOINCREMENT_$self->{output}"); 7759 $self->set_binmode($fhdl) if (!$self->{compress}); 7760 $sequence_output = $self->set_search_path() . $sequence_output; 7761 $self->dump($sql_header . $sequence_output, $fhdl); 7762 $self->close_export_file($fhdl); 7763 } 7764 7765 if ($self->{file_per_index} && ($self->{type} ne 'FDW')) 7766 { 7767 my $fhdl = undef; 7768 $self->logit("Dumping indexes to one separate file : INDEXES_$self->{output}\n", 1); 7769 $fhdl = $self->open_export_file("INDEXES_$self->{output}"); 7770 $self->set_binmode($fhdl) if (!$self->{compress}); 7771 $indices = "-- Nothing found of type indexes\n" if (!$indices && !$self->{no_header}); 7772 $indices =~ s/\n+/\n/gs; 7773 $self->_restore_comments(\$indices); 7774 $indices = $self->set_search_path() . $indices; 7775 $self->dump($sql_header . $indices, $fhdl); 7776 $self->close_export_file($fhdl); 7777 $indices = ''; 7778 if ($fts_indices) { 7779 $fts_indices =~ s/\n+/\n/gs; 7780 my $unaccent = ''; 7781 if ($self->{use_lower_unaccent}) { 7782 $unaccent = qq{ 7783CREATE EXTENSION IF NOT EXISTS unaccent; 7784CREATE OR REPLACE FUNCTION unaccent_immutable(text) 7785RETURNS text AS 7786\$\$ 7787 SELECT lower(public.unaccent('public.unaccent', \$1)); 7788\$\$ LANGUAGE sql IMMUTABLE; 7789 7790}; 7791 } elsif ($self->{use_unaccent}) { 7792 $unaccent = qq{ 7793CREATE EXTENSION IF NOT EXISTS unaccent; 7794CREATE OR REPLACE FUNCTION unaccent_immutable(text) 7795RETURNS text AS 7796\$\$ 7797 SELECT public.unaccent('public.unaccent', \$1); 7798\$\$ LANGUAGE sql IMMUTABLE; 7799 7800}; 7801 } 7802 # FTS TRIGGERS are exported in a separated file to be able to parallelize index creation 7803 $self->logit("Dumping triggers for FTS indexes to one separate file : FTS_INDEXES_$self->{output}\n", 1); 7804 $fhdl = $self->open_export_file("FTS_INDEXES_$self->{output}"); 7805 $self->set_binmode($fhdl) if (!$self->{compress}); 7806 $self->_restore_comments(\$fts_indices); 7807 $fts_indices = $self->set_search_path() . $fts_indices; 7808 $self->dump($sql_header. $unaccent . $fts_indices, $fhdl); 7809 $self->close_export_file($fhdl); 7810 $fts_indices = ''; 7811 } 7812 } 7813 7814 # Dumping foreign key constraints 7815 my $fkeys = ''; 7816 foreach my $table (sort keys %{$self->{tables}}) 7817 { 7818 next if ($#{$self->{tables}{$table}{foreign_key}} < 0); 7819 $self->logit("Dumping RI $table...\n", 1); 7820 # Add constraint definition 7821 if ($self->{type} ne 'FDW') { 7822 my $create_all = $self->_create_foreign_keys($table); 7823 if ($create_all) { 7824 if ($self->{file_per_fkeys}) { 7825 $fkeys .= $create_all; 7826 } else { 7827 if ($self->{file_per_constraint}) { 7828 $constraints .= $create_all; 7829 } else { 7830 $sql_output .= $create_all; 7831 } 7832 } 7833 } 7834 } 7835 } 7836 7837 if ($self->{file_per_constraint} && ($self->{type} ne 'FDW')) 7838 { 7839 my $fhdl = undef; 7840 $self->logit("Dumping constraints to one separate file : CONSTRAINTS_$self->{output}\n", 1); 7841 $fhdl = $self->open_export_file("CONSTRAINTS_$self->{output}"); 7842 $self->set_binmode($fhdl) if (!$self->{compress}); 7843 $constraints = "-- Nothing found of type constraints\n" if (!$constraints && !$self->{no_header}); 7844 $self->_restore_comments(\$constraints); 7845 $self->dump($sql_header . $constraints, $fhdl); 7846 $self->close_export_file($fhdl); 7847 $constraints = ''; 7848 } 7849 7850 if ($fkeys) 7851 { 7852 my $fhdl = undef; 7853 $self->logit("Dumping foreign keys to one separate file : FKEYS_$self->{output}\n", 1); 7854 $fhdl = $self->open_export_file("FKEYS_$self->{output}"); 7855 $self->set_binmode($fhdl) if (!$self->{compress}); 7856 $fkeys = "-- Nothing found of type foreign keys\n" if (!$fkeys && !$self->{no_header}); 7857 $self->_restore_comments(\$fkeys); 7858 $fkeys = $self->set_search_path() . $fkeys; 7859 $self->dump($sql_header . $fkeys, $fhdl); 7860 $self->close_export_file($fhdl); 7861 $fkeys = ''; 7862 } 7863 7864 if (!$sql_output) 7865 { 7866 $sql_output = "-- Nothing found of type TABLE\n" if (!$self->{no_header}); 7867 } 7868 else 7869 { 7870 $self->_restore_comments(\$sql_output); 7871 } 7872 7873 $self->dump($sql_header . $sql_output); 7874 7875 # Some virtual column have been found 7876 if ($self->{type} ne 'FDW' and scalar keys %virtual_trigger_info > 0) 7877 { 7878 my $trig_out = ''; 7879 foreach my $tb (sort keys %virtual_trigger_info) { 7880 my $tname = "virt_col_${tb}_trigger"; 7881 $tname =~ s/\./_/g; 7882 $tname = $self->quote_object_name($tname); 7883 my $fname = "fct_virt_col_${tb}_trigger"; 7884 $fname =~ s/\./_/g; 7885 $fname = $self->quote_object_name($fname); 7886 $trig_out .= "DROP TRIGGER $self->{pg_supports_ifexists} $tname ON " . $self->quote_object_name($tb) . " CASCADE;\n\n"; 7887 $trig_out .= "CREATE$self->{create_or_replace} FUNCTION $fname() RETURNS trigger AS \$BODY\$\n"; 7888 $trig_out .= "BEGIN\n"; 7889 foreach my $c (sort keys %{$virtual_trigger_info{$tb}}) { 7890 $trig_out .= "\tNEW.$c = $virtual_trigger_info{$tb}{$c};\n"; 7891 } 7892 $tb = $self->quote_object_name($tb); 7893 $trig_out .= qq{ 7894RETURN NEW; 7895end 7896\$BODY\$ 7897 LANGUAGE 'plpgsql' SECURITY DEFINER; 7898 7899CREATE TRIGGER $tname 7900 BEFORE INSERT OR UPDATE ON $tb FOR EACH ROW 7901 EXECUTE PROCEDURE $fname(); 7902 7903}; 7904 } 7905 $self->_restore_comments(\$trig_out); 7906 if (!$self->{file_per_constraint}) { 7907 $self->dump($trig_out); 7908 } else { 7909 my $fhdl = undef; 7910 $self->logit("Dumping virtual column triggers to one separate file : VIRTUAL_COLUMNS_$self->{output}\n", 1); 7911 $fhdl = $self->open_export_file("VIRTUAL_COLUMNS_$self->{output}"); 7912 $self->set_binmode($fhdl) if (!$self->{compress}); 7913 $self->dump($sql_header . $trig_out, $fhdl); 7914 $self->close_export_file($fhdl); 7915 } 7916 } 7917} 7918 7919=head2 _get_sql_statements 7920 7921Returns a string containing the PostgreSQL compatible SQL Schema 7922definition. 7923 7924=cut 7925 7926sub _get_sql_statements 7927{ 7928 my $self = shift; 7929 7930 # Process view 7931 if ($self->{type} eq 'VIEW') 7932 { 7933 $self->export_view(); 7934 } 7935 7936 # Process materialized view 7937 elsif ($self->{type} eq 'MVIEW') 7938 { 7939 $self->export_mview(); 7940 } 7941 7942 # Process grant 7943 elsif ($self->{type} eq 'GRANT') 7944 { 7945 $self->export_grant(); 7946 } 7947 7948 # Process sequences 7949 elsif ($self->{type} eq 'SEQUENCE') 7950 { 7951 $self->export_sequence(); 7952 } 7953 7954 # Process dblink 7955 elsif ($self->{type} eq 'DBLINK') 7956 { 7957 $self->export_dblink(); 7958 } 7959 7960 # Process dblink 7961 elsif ($self->{type} eq 'DIRECTORY') 7962 { 7963 $self->export_directory(); 7964 } 7965 7966 # Process triggers 7967 elsif ($self->{type} eq 'TRIGGER') 7968 { 7969 $self->export_trigger(); 7970 } 7971 7972 # Process queries to parallelize 7973 elsif ($self->{type} eq 'LOAD') 7974 { 7975 $self->parallelize_statements(); 7976 } 7977 7978 # Process queries only 7979 elsif ($self->{type} eq 'QUERY') 7980 { 7981 $self->translate_query(); 7982 } 7983 7984 # Process functions only 7985 elsif ($self->{type} eq 'FUNCTION') 7986 { 7987 $self->export_function(); 7988 } 7989 7990 # Process procedures only 7991 elsif ($self->{type} eq 'PROCEDURE') 7992 { 7993 $self->export_procedure(); 7994 } 7995 7996 # Process packages only 7997 elsif ($self->{type} eq 'PACKAGE') 7998 { 7999 $self->export_package(); 8000 } 8001 8002 # Process types only 8003 elsif ($self->{type} eq 'TYPE') 8004 { 8005 $self->export_type(); 8006 } 8007 8008 # Process TABLESPACE only 8009 elsif ($self->{type} eq 'TABLESPACE') 8010 { 8011 $self->export_tablespace(); 8012 } 8013 8014 # Export as Kettle XML file 8015 elsif ($self->{type} eq 'KETTLE') 8016 { 8017 $self->export_kettle(); 8018 } 8019 8020 # Process PARTITION only 8021 elsif ($self->{type} eq 'PARTITION') 8022 { 8023 $self->export_partition(); 8024 } 8025 8026 # Process synonyms only 8027 elsif ($self->{type} eq 'SYNONYM') 8028 { 8029 $self->export_synonym(); 8030 } 8031 8032 # Dump the database structure: tables, constraints, indexes, etc. 8033 elsif ($self->{type} eq 'TABLE' or $self->{type} eq 'FDW') 8034 { 8035 $self->export_table(); 8036 } 8037 8038 # Extract data only 8039 elsif (($self->{type} eq 'INSERT') || ($self->{type} eq 'COPY')) 8040 { 8041 if ($self->{oracle_fdw_data_export} && $self->{pg_dsn}) 8042 { 8043 my $fdw_definition = $self->export_table(); 8044 $self->{dbhdest}->do("DROP SCHEMA IF EXISTS ora2pg_fdw_import CASCADE") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8045 $self->{dbhdest}->do("CREATE SCHEMA ora2pg_fdw_import") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8046 $self->{dbhdest}->do($fdw_definition) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . ", SQL: $fdw_definition\n", 0, 1); 8047 } 8048 8049 my $sql_output = ""; 8050 my $dirprefix = ''; 8051 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 8052 8053 my $t0 = Benchmark->new; 8054 8055 # Connect the Oracle database to gather information 8056 if ($self->{oracle_dsn} =~ /dbi:mysql/i) { 8057 $self->{dbh} = $self->_mysql_connection(); 8058 } else { 8059 $self->{dbh} = $self->_oracle_connection(); 8060 } 8061 8062 # Remove external table from data export 8063 if (scalar keys %{$self->{external_table}} ) 8064 { 8065 foreach my $table (keys %{$self->{tables}}) 8066 { 8067 if ( grep(/^$table$/i, keys %{$self->{external_table}}) ) { 8068 delete $self->{tables}{$table}; 8069 } 8070 } 8071 } 8072 # Remove remote table from export, they must be exported using FDW export type 8073 foreach my $table (sort keys %{$self->{tables}}) 8074 { 8075 if ( $self->{tables}{$table}{table_info}{connection} ) { 8076 delete $self->{tables}{$table}; 8077 } 8078 } 8079 8080 # Get partition information 8081 $self->_partitions() if (!$self->{disable_partition}); 8082 8083 # Ordering tables by name by default 8084 my @ordered_tables = sort { $a cmp $b } keys %{$self->{tables}}; 8085 if (lc($self->{data_export_order}) eq 'size') 8086 { 8087 @ordered_tables = sort { 8088 ($self->{tables}{$b}{table_info}{num_rows} || $self->{tables}{$a}{table_info}{num_rows}) ? 8089 $self->{tables}{$b}{table_info}{num_rows} <=> $self->{tables}{$a}{table_info}{num_rows} : 8090 $a cmp $b 8091 } keys %{$self->{tables}}; 8092 } 8093 8094 # Set SQL orders that should be in the file header 8095 # (before the COPY or INSERT commands) 8096 my $first_header = "$sql_header\n"; 8097 # Add search path and constraint deferring 8098 my $search_path = $self->set_search_path(); 8099 if (!$self->{pg_dsn}) 8100 { 8101 # Set search path 8102 if ($search_path) { 8103 $first_header .= $self->set_search_path(); 8104 } 8105 # Open transaction 8106 $first_header .= "BEGIN;\n"; 8107 # Defer all constraints 8108 if ($self->{defer_fkey}) { 8109 $first_header .= "SET CONSTRAINTS ALL DEFERRED;\n\n"; 8110 } 8111 } 8112 elsif (!$self->{oracle_speed}) 8113 { 8114 # Set search path 8115 if ($search_path) { 8116 $self->{dbhdest}->do($search_path) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8117 } 8118 $self->{dbhdest}->do("BEGIN;") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8119 } 8120 8121 #### Defined all SQL commands that must be executed before and after data loading 8122 my $load_file = "\n"; 8123 foreach my $table (@ordered_tables) 8124 { 8125 # Do not process nested table 8126 if (!$self->{is_mysql} && $self->{tables}{$table}{table_info}{nested} ne 'NO') 8127 { 8128 $self->logit("WARNING: nested table $table will not be exported.\n", 1); 8129 next; 8130 } 8131 8132 # Remove main table partition (for MySQL "SELECT * FROM emp PARTITION (p1);" is supported from 5.6) 8133 delete $self->{partitions}{$table} if (exists $self->{partitions}{$table} && $self->{is_mysql} && ($self->{db_version} =~ /^5\.[012345]/)); 8134 if (-e "${dirprefix}tmp_${table}_$self->{output}") { 8135 $self->logit("Removing incomplete export file ${dirprefix}tmp_${table}_$self->{output}\n", 1); 8136 unlink("${dirprefix}tmp_${table}_$self->{output}"); 8137 } 8138 # Rename table and double-quote it if required 8139 my $tmptb = $self->get_replaced_tbname($table); 8140 8141 #### Set SQL commands that must be executed before data loading 8142 8143 # Drop foreign keys if required 8144 if ($self->{drop_fkey}) 8145 { 8146 $self->logit("Dropping foreign keys of table $table...\n", 1); 8147 my @drop_all = $self->_drop_foreign_keys($table, @{$self->{tables}{$table}{foreign_key}}); 8148 foreach my $str (@drop_all) { 8149 chomp($str); 8150 next if (!$str); 8151 if ($self->{pg_dsn}) { 8152 my $s = $self->{dbhdest}->do($str) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8153 } else { 8154 $first_header .= "$str\n"; 8155 } 8156 } 8157 } 8158 8159 # Drop indexes if required 8160 if ($self->{drop_indexes}) 8161 { 8162 $self->logit("Dropping indexes of table $table...\n", 1); 8163 my @drop_all = $self->_drop_indexes($table, %{$self->{tables}{$table}{indexes}}) . "\n"; 8164 foreach my $str (@drop_all) 8165 { 8166 chomp($str); 8167 next if (!$str); 8168 if ($self->{pg_dsn}) { 8169 my $s = $self->{dbhdest}->do($str) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8170 } else { 8171 $first_header .= "$str\n"; 8172 } 8173 } 8174 } 8175 8176 # Disable triggers of current table if requested 8177 if ($self->{disable_triggers} && !$self->{oracle_speed}) 8178 { 8179 my $trig_type = 'USER'; 8180 $trig_type = 'ALL' if (uc($self->{disable_triggers}) eq 'ALL'); 8181 if ($self->{pg_dsn}) { 8182 my $s = $self->{dbhdest}->do("ALTER TABLE $tmptb DISABLE TRIGGER $trig_type;") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8183 } else { 8184 $first_header .= "ALTER TABLE $tmptb DISABLE TRIGGER $trig_type;\n"; 8185 } 8186 } 8187 8188 #### Add external data file loading if file_per_table is enable 8189 if ($self->{file_per_table} && !$self->{pg_dsn}) 8190 { 8191 my $file_name = "$dirprefix${table}_$self->{output}"; 8192 $file_name =~ s/\.(gz|bz2)$//; 8193 $load_file .= "\\i$self->{psql_relative_path} $file_name\n"; 8194 } 8195 8196 # With partitioned table, load data direct from table partition 8197 if (exists $self->{partitions}{$table}) 8198 { 8199 foreach my $pos (sort {$a <=> $b} keys %{$self->{partitions}{$table}}) 8200 { 8201 my $part_name = $self->{partitions}{$table}{$pos}{name}; 8202 my $tb_name = ''; 8203 if (!exists $self->{subpartitions}{$table}{$part_name}) { 8204 $tb_name = $part_name; 8205 } 8206 $tb_name = $table . '_' . $tb_name if ($self->{prefix_partition}); 8207 next if ($self->{allow_partition} && !grep($_ =~ /^$part_name$/i, @{$self->{allow_partition}})); 8208 8209 if (exists $self->{subpartitions}{$table}{$part_name}) 8210 { 8211 foreach my $p (sort {$a <=> $b} keys %{$self->{subpartitions}{$table}{$part_name}}) 8212 { 8213 my $subpart = $self->{subpartitions}{$table}{$part_name}{$p}{name}; 8214 next if ($self->{allow_partition} && !grep($_ =~ /^$subpart$/i, @{$self->{allow_partition}})); 8215 my $sub_tb_name = $subpart; 8216 $sub_tb_name =~ s/^[^\.]+\.//; # remove schema part if any 8217 $sub_tb_name = "${tb_name}$sub_tb_name" if ($self->{prefix_partition}); 8218 if ($self->{file_per_table} && !$self->{pg_dsn}) { 8219 my $file_name = "$dirprefix${sub_tb_name}_$self->{output}"; 8220 $file_name =~ s/\.(gz|bz2)$//; 8221 $load_file .= "\\i$self->{psql_relative_path} $file_name\n"; 8222 } 8223 } 8224 # Now load content of the default partion table 8225 if ($self->{subpartitions_default}{$table}{$part_name}) 8226 { 8227 if (!$self->{allow_partition} || grep($_ =~ /^$self->{subpartitions_default}{$table}{$part_name}$/i, @{$self->{allow_partition}})) 8228 { 8229 if ($self->{file_per_table} && !$self->{pg_dsn}) 8230 { 8231 my $part_name = $self->{subpartitions_default}{$table}{$part_name}; 8232 $part_name = "${tb_name}$part_name" if ($self->{prefix_partition}); 8233 my $file_name = "$dirprefix${part_name}_$self->{output}"; 8234 $file_name =~ s/\.(gz|bz2)$//; 8235 $load_file .= "\\i$self->{psql_relative_path} $file_name\n"; 8236 } 8237 } 8238 } 8239 } 8240 else 8241 { 8242 if ($self->{file_per_table} && !$self->{pg_dsn}) 8243 { 8244 my $file_name = "$dirprefix${tb_name}_$self->{output}"; 8245 $file_name =~ s/\.(gz|bz2)$//; 8246 $load_file .= "\\i$self->{psql_relative_path} $file_name\n"; 8247 } 8248 } 8249 } 8250 # Now load content of the default partion table 8251 if ($self->{partitions_default}{$table}) 8252 { 8253 if (!$self->{allow_partition} || grep($_ =~ /^$self->{partitions_default}{$table}$/i, @{$self->{allow_partition}})) 8254 { 8255 if ($self->{file_per_table} && !$self->{pg_dsn}) 8256 { 8257 my $part_name = $self->{partitions_default}{$table}; 8258 $part_name = $table . '_' . $part_name if ($self->{prefix_partition}); 8259 my $file_name = "$dirprefix${part_name}_$self->{output}"; 8260 $file_name =~ s/\.(gz|bz2)$//; 8261 $load_file .= "\\i$self->{psql_relative_path} $file_name\n"; 8262 } 8263 } 8264 } 8265 } 8266 8267 # Create temporary tables for DATADIFF 8268 if ($self->{datadiff}) 8269 { 8270 my $tmptb_del = $self->get_tbname_with_suffix($tmptb, $self->{datadiff_del_suffix}); 8271 my $tmptb_ins = $self->get_tbname_with_suffix($tmptb, $self->{datadiff_ins_suffix}); 8272 my $tmptb_upd = $self->get_tbname_with_suffix($tmptb, $self->{datadiff_upd_suffix}); 8273 if ($self->{datadiff_work_mem}) { 8274 $first_header .= "SET work_mem TO '" . $self->{datadiff_work_mem} . "';\n"; 8275 } 8276 if ($self->{datadiff_temp_buffers}) { 8277 $first_header .= "SET temp_buffers TO '" . $self->{datadiff_temp_buffers} . "';\n"; 8278 } 8279 $first_header .= "LOCK TABLE $tmptb IN EXCLUSIVE MODE;\n"; 8280 $first_header .= "CREATE TEMPORARY TABLE $tmptb_del"; 8281 $first_header .= " (LIKE $tmptb INCLUDING DEFAULTS INCLUDING CONSTRAINTS INCLUDING INDEXES)"; 8282 $first_header .= " ON COMMIT DROP;\n"; 8283 $first_header .= "CREATE TEMPORARY TABLE $tmptb_ins"; 8284 $first_header .= " (LIKE $tmptb INCLUDING DEFAULTS INCLUDING CONSTRAINTS INCLUDING INDEXES)"; 8285 $first_header .= " ON COMMIT DROP;\n"; 8286 $first_header .= "CREATE TEMPORARY TABLE $tmptb_upd"; 8287 $first_header .= " (old $tmptb_del, new $tmptb_ins, changed_columns TEXT[])"; 8288 $first_header .= " ON COMMIT DROP;\n"; 8289 8290 } 8291 8292 } 8293 8294 if (!$self->{pg_dsn}) 8295 { 8296 # Write header to file 8297 $self->dump($first_header); 8298 8299 if ($self->{file_per_table}) { 8300 # Write file loader 8301 $self->dump($load_file); 8302 } 8303 } 8304 8305 # Commit transaction 8306 if ($self->{pg_dsn} && !$self->{oracle_speed}) { 8307 my $s = $self->{dbhdest}->do("COMMIT;") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8308 } 8309 8310 #### 8311 #### Proceed to data export 8312 #### 8313 8314 # Set total number of rows 8315 $self->{global_rows} = 0; 8316 foreach my $table (keys %{$self->{tables}}) 8317 { 8318 if ($self->{global_where}) 8319 { 8320 if ($self->{is_mysql} && ($self->{global_where} =~ /\s+LIMIT\s+\d+,(\d+)/)) { 8321 $self->{tables}{$table}{table_info}{num_rows} = $1 if ($i < $self->{tables}{$table}{table_info}{num_rows}); 8322 } elsif ($self->{global_where} =~ /\s+ROWNUM\s+[<=>]+\s+(\d+)/) { 8323 $self->{tables}{$table}{table_info}{num_rows} = $1 if ($i < $self->{tables}{$table}{table_info}{num_rows}); 8324 } 8325 } 8326 elsif (exists $self->{where}{"\L$table\E"}) 8327 { 8328 if ($self->{is_mysql} && ($self->{where}{"\L$table\E"} =~ /\s+LIMIT\s+\d+,(\d+)/)) { 8329 $self->{tables}{$table}{table_info}{num_rows} = $1 if ($i < $self->{tables}{$table}{table_info}{num_rows}); 8330 } elsif ($self->{where}{"\L$table\E"} =~ /\s+ROWNUM\s+[<=>]+\s+(\d+)/) { 8331 $self->{tables}{$table}{table_info}{num_rows} = $1 if ($i < $self->{tables}{$table}{table_info}{num_rows}); 8332 } 8333 } 8334 $self->{global_rows} += $self->{tables}{$table}{table_info}{num_rows}; 8335 } 8336 8337 # Open a pipe for interprocess communication 8338 my $reader = new IO::Handle; 8339 my $writer = new IO::Handle; 8340 8341 # Fork the logger process 8342 if (!$self->{quiet} && !$self->{debug}) 8343 { 8344 if ( ($self->{jobs} > 1) || ($self->{oracle_copies} > 1) || ($self->{parallel_tables} > 1)) 8345 { 8346 $pipe = IO::Pipe->new($reader, $writer); 8347 $writer->autoflush(1); 8348 spawn sub { 8349 $self->multiprocess_progressbar(); 8350 }; 8351 } 8352 } 8353 $dirprefix = ''; 8354 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 8355 8356 my $first_start_time = time(); 8357 my $global_count = 0; 8358 my $parallel_tables_count = 1; 8359 $self->{oracle_copies} = 1 if ($self->{parallel_tables} > 1); 8360 8361 # Send global startup information to pipe 8362 if (defined $pipe) 8363 { 8364 $pipe->writer(); 8365 $pipe->print("GLOBAL EXPORT START TIME: $first_start_time\n"); 8366 $pipe->print("GLOBAL EXPORT ROW NUMBER: $self->{global_rows}\n"); 8367 } 8368 $self->{global_start_time} = time(); 8369 foreach my $table (@ordered_tables) 8370 { 8371 # Do not process nested table 8372 if (!$self->{is_mysql} && $self->{tables}{$table}{table_info}{nested} ne 'NO') 8373 { 8374 $self->logit("WARNING: nested table $table will not be exported.\n", 1); 8375 next; 8376 } 8377 8378 if ($self->{file_per_table} && !$self->{pg_dsn}) 8379 { 8380 # Do not dump data again if the file already exists 8381 next if ($self->file_exists("$dirprefix${table}_$self->{output}")); 8382 } 8383 8384 # Set global count 8385 $global_count += $self->{tables}{$table}{table_info}{num_rows}; 8386 8387 # Extract all column information used to determine data export. 8388 # This hash will be used in function _howto_get_data() 8389 %{$self->{colinfo}} = $self->_column_attributes($table, $self->{schema}, 'TABLE'); 8390 8391 my $total_record = 0; 8392 if ($self->{parallel_tables} > 1) 8393 { 8394 spawn sub { 8395 if (!$self->{fdw_server} || !$self->{pg_dsn}) { 8396 $self->_export_table_data($table, $dirprefix, $sql_header); 8397 } else { 8398 $self->_export_fdw_table_data($table, $dirprefix, $sql_header); 8399 } 8400 }; 8401 $parallel_tables_count++; 8402 8403 # Wait for oracle connection terminaison 8404 while ($parallel_tables_count > $self->{parallel_tables}) 8405 { 8406 my $kid = waitpid(-1, WNOHANG); 8407 if ($kid > 0) 8408 { 8409 $parallel_tables_count--; 8410 delete $RUNNING_PIDS{$kid}; 8411 } 8412 usleep(50000); 8413 } 8414 } 8415 else 8416 { 8417 if (!$self->{fdw_server} || !$self->{pg_dsn}) { 8418 $total_record = $self->_export_table_data($table, $dirprefix, $sql_header); 8419 } else { 8420 $total_record = $self->_export_fdw_table_data($table, $dirprefix, $sql_header); 8421 } 8422 } 8423 8424 # Display total export position 8425 if (!$self->{quiet} && !$self->{debug}) 8426 { 8427 if ( ($self->{jobs} <= 1) && ($self->{oracle_copies} <= 1) && ($self->{parallel_tables} <= 1) ) 8428 { 8429 my $last_end_time = time(); 8430 my $dt = $last_end_time - $first_start_time; 8431 $dt ||= 1; 8432 my $rps = int(($total_record || $global_count) / $dt); 8433 print STDERR $self->progress_bar(($total_record || $global_count), $self->{global_rows}, 25, '=', 'rows', "on total estimated data ($dt sec., avg: $rps recs/sec)"), "\r"; 8434 } 8435 } 8436 } 8437 if (!$self->{quiet} && !$self->{debug}) 8438 { 8439 if ( ($self->{jobs} <= 1) && ($self->{oracle_copies} <= 1) && ($self->{parallel_tables} <= 1) ) { 8440 print "\n"; 8441 } 8442 } 8443 8444 # Wait for all child die 8445 if ( ($self->{oracle_copies} > 1) || ($self->{parallel_tables} > 1) ) 8446 { 8447 # Wait for all child dies less the logger 8448 my $minnumchild = 1; # will not wait for progressbar process 8449 $minnumchild = 0 if ($self->{debug} || $self->{quiet}); # in debug or quiet mode there is no progressbar 8450 while (scalar keys %RUNNING_PIDS > $minnumchild) 8451 { 8452 my $kid = waitpid(-1, WNOHANG); 8453 if ($kid > 0) { 8454 delete $RUNNING_PIDS{$kid}; 8455 } 8456 usleep(50000); 8457 } 8458 # Terminate the process logger 8459 foreach my $k (keys %RUNNING_PIDS) 8460 { 8461 kill(10, $k); 8462 %RUNNING_PIDS = (); 8463 } 8464 # Reopen a new database handler 8465 $self->{dbh}->disconnect() if (defined $self->{dbh}); 8466 if ($self->{oracle_dsn} =~ /dbi:mysql/i) { 8467 $self->{dbh} = $self->_mysql_connection(); 8468 } else { 8469 $self->{dbh} = $self->_oracle_connection(); 8470 } 8471 } 8472 8473 # Start a new transaction 8474 if ($self->{pg_dsn} && !$self->{oracle_speed}) { 8475 my $s = $self->{dbhdest}->do("BEGIN;") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8476 8477 } 8478 8479 # Remove function created to export external table 8480 if ($self->{bfile_found} eq 'text') 8481 { 8482 $self->logit("Removing function ora2pg_get_bfilename() used to retrieve path from BFILE.\n", 1); 8483 my $bfile_function = "DROP FUNCTION ora2pg_get_bfilename"; 8484 my $sth2 = $self->{dbh}->do($bfile_function); 8485 } 8486 elsif ($self->{bfile_found} eq 'efile') 8487 { 8488 $self->logit("Removing function ora2pg_get_efile() used to retrieve EFILE from BFILE.\n", 1); 8489 my $efile_function = "DROP FUNCTION ora2pg_get_efile"; 8490 my $sth2 = $self->{dbh}->do($efile_function); 8491 } 8492 elsif ($self->{bfile_found} eq 'bytea') 8493 { 8494 $self->logit("Removing function ora2pg_get_bfile() used to retrieve BFILE content.\n", 1); 8495 my $efile_function = "DROP FUNCTION ora2pg_get_bfile"; 8496 my $sth2 = $self->{dbh}->do($efile_function); 8497 } 8498 8499 #### Set SQL commands that must be executed after data loading 8500 my $footer = ''; 8501 my (@datadiff_tbl, @datadiff_del, @datadiff_upd, @datadiff_ins); 8502 foreach my $table (@ordered_tables) 8503 { 8504 # Do not process nested table 8505 if (!$self->{is_mysql} && $self->{tables}{$table}{table_info}{nested} ne 'NO') 8506 { 8507 $self->logit("WARNING: nested table $table will not be exported.\n", 1); 8508 next; 8509 } 8510 8511 # Rename table and double-quote it if required 8512 my $tmptb = $self->get_replaced_tbname($table); 8513 8514 # DATADIFF reduction (annihilate identical deletions and insertions) and execution 8515 if ($self->{datadiff}) 8516 { 8517 my $tmptb_del = $self->get_tbname_with_suffix($tmptb, $self->{datadiff_del_suffix}); 8518 my $tmptb_upd = $self->get_tbname_with_suffix($tmptb, $self->{datadiff_upd_suffix}); 8519 my $tmptb_ins = $self->get_tbname_with_suffix($tmptb, $self->{datadiff_ins_suffix}); 8520 my @pg_colnames_nullable = @{$self->{tables}{$table}{pg_colnames_nullable}}; 8521 my @pg_colnames_notnull = @{$self->{tables}{$table}{pg_colnames_notnull}}; 8522 my @pg_colnames_pkey = @{$self->{tables}{$table}{pg_colnames_pkey}}; 8523 # reduce by deleting matching (i.e. quasi "unchanged") entries from $tmptb_del and $tmptb_ins 8524 $footer .= "WITH del AS (SELECT t, row_number() OVER (PARTITION BY t.*) rownum, ctid FROM $tmptb_del t), "; 8525 $footer .= "ins AS (SELECT t, row_number() OVER (PARTITION BY t.*) rownum, ctid FROM $tmptb_ins t), "; 8526 $footer .= "paired AS (SELECT del.ctid ctid1, ins.ctid ctid2 FROM del JOIN ins ON del.t IS NOT DISTINCT FROM ins.t "; 8527 foreach my $col (@pg_colnames_nullable) { 8528 $footer .= "AND (((del.t).$col IS NULL AND (ins.t).$col IS NULL) OR ((del.t).$col = (ins.t).$col)) "; 8529 } 8530 foreach my $col (@pg_colnames_notnull, @pg_colnames_pkey) { 8531 $footer .= "AND ((del.t).$col = (ins.t).$col) "; 8532 } 8533 $footer .= "AND del.rownum = ins.rownum), "; 8534 $footer .= "del_del AS (DELETE FROM $tmptb_del WHERE ctid = ANY(ARRAY(SELECT ctid1 FROM paired))), "; 8535 $footer .= "del_ins AS (DELETE FROM $tmptb_ins WHERE ctid = ANY(ARRAY(SELECT ctid2 FROM paired))) "; 8536 $footer .= "SELECT 1;\n"; 8537 # convert matching delete+insert into update if configured and primary key exists 8538 if ($self->{datadiff_update_by_pkey} && $#pg_colnames_pkey >= 0) { 8539 $footer .= "WITH upd AS (SELECT old, new, old.ctid ctid1, new.ctid ctid2, ARRAY("; 8540 for my $col (@pg_colnames_notnull) { 8541 $footer .= "SELECT '$col'::TEXT WHERE old.$col <> new.$col UNION ALL "; 8542 } 8543 for my $col (@pg_colnames_nullable) { 8544 $footer .= "SELECT '$col'::TEXT WHERE old.$col <> new.$col OR ((old.$col IS NULL) <> (new.$col IS NULL)) UNION ALL "; 8545 } 8546 $footer .= "SELECT ''::TEXT WHERE FALSE) changed_columns FROM $tmptb_del old "; 8547 $footer .= "JOIN $tmptb_ins new USING (" . join(', ', @pg_colnames_pkey) . ")), "; 8548 $footer .= "del_del AS (DELETE FROM $tmptb_del WHERE ctid = ANY(ARRAY(SELECT ctid1 FROM upd))), "; 8549 $footer .= "del_ins AS (DELETE FROM $tmptb_ins WHERE ctid = ANY(ARRAY(SELECT ctid2 FROM upd))) "; 8550 $footer .= "INSERT INTO $tmptb_upd (old, new, changed_columns) SELECT old, new, changed_columns FROM upd;\n"; 8551 } 8552 # call optional function specified in config to be called before actual deletion/insertion 8553 $footer .= "SELECT " . $self->{datadiff_before} . "('" . $tmptb . "', '" . $tmptb_del . "', '" . $tmptb_upd . "', '" . $tmptb_ins . "');\n" 8554 if ($self->{datadiff_before}); 8555 # do actual delete 8556 $footer .= "WITH del AS (SELECT d.delctid FROM (SELECT t, COUNT(*) c FROM $tmptb_del t GROUP BY t) s "; 8557 $footer .= "LEFT JOIN LATERAL (SELECT ctid delctid FROM $tmptb tbl WHERE tbl IS NOT DISTINCT FROM s.t "; 8558 foreach my $col (@pg_colnames_nullable) { 8559 $footer .= "AND (((s.t).$col IS NULL AND tbl.$col IS NULL) OR ((s.t).$col = tbl.$col)) "; 8560 } 8561 foreach my $col (@pg_colnames_notnull, @pg_colnames_pkey) { 8562 $footer .= "AND ((s.t).$col = tbl.$col) "; 8563 } 8564 $footer .= "LIMIT s.c) d ON TRUE) "; 8565 $footer .= "DELETE FROM $tmptb WHERE ctid = ANY(ARRAY(SELECT delctid FROM del));\n"; 8566 # do actual update 8567 if ($self->{datadiff_update_by_pkey} && $#pg_colnames_pkey >= 0 && ($#pg_colnames_nullable >= 0 || $#pg_colnames_notnull >= 0)) { 8568 $footer .= "UPDATE $tmptb SET "; 8569 $footer .= join(', ', map { $_ . ' = (upd.new).' . $_ } @pg_colnames_notnull, @pg_colnames_nullable); 8570 $footer .= " FROM $tmptb_upd upd WHERE "; 8571 $footer .= join(' AND ', map { $_ . ' = (upd.old).' . $_ } @pg_colnames_pkey); 8572 $footer .= ";\n"; 8573 } 8574 # do actual insert 8575 $footer .= "INSERT INTO $tmptb SELECT * FROM $tmptb_ins;\n"; 8576 # call optional function specified in config to be called after actual deletion/insertion 8577 $footer .= "SELECT " . $self->{datadiff_after} . "('" . $tmptb . "', '" . $tmptb_del . "', '" . $tmptb_upd . "', '" . $tmptb_ins . "');\n" 8578 if ($self->{datadiff_after}); 8579 # push table names in array for bunch function call in the end 8580 push @datadiff_tbl, $tmptb; 8581 push @datadiff_del, $tmptb_del; 8582 push @datadiff_upd, $tmptb_upd; 8583 push @datadiff_ins, $tmptb_ins; 8584 } 8585 8586 8587 # disable triggers of current table if requested 8588 if ($self->{disable_triggers} && !$self->{oracle_speed}) 8589 { 8590 my $trig_type = 'USER'; 8591 $trig_type = 'ALL' if (uc($self->{disable_triggers}) eq 'ALL'); 8592 my $str = "ALTER TABLE $tmptb ENABLE TRIGGER $trig_type;"; 8593 if ($self->{pg_dsn}) { 8594 my $s = $self->{dbhdest}->do($str) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8595 } else { 8596 $footer .= "$str\n"; 8597 } 8598 } 8599 8600 # Recreate all foreign keys of the concerned tables 8601 if ($self->{drop_fkey} && !$self->{oracle_speed}) 8602 { 8603 my @create_all = (); 8604 $self->logit("Restoring foreign keys of table $table...\n", 1); 8605 push(@create_all, $self->_create_foreign_keys($table)); 8606 foreach my $str (@create_all) 8607 { 8608 chomp($str); 8609 next if (!$str); 8610 if ($self->{pg_dsn}) { 8611 my $s = $self->{dbhdest}->do($str) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8612 } else { 8613 $footer .= "$str\n"; 8614 } 8615 } 8616 } 8617 8618 # Recreate all indexes 8619 if ($self->{drop_indexes} && !$self->{oracle_speed}) 8620 { 8621 my @create_all = (); 8622 $self->logit("Restoring indexes of table $table...\n", 1); 8623 push(@create_all, $self->_create_indexes($table, 1, %{$self->{tables}{$table}{indexes}})); 8624 if ($#create_all >= 0) 8625 { 8626 foreach my $str (@create_all) 8627 { 8628 chomp($str); 8629 next if (!$str); 8630 if ($self->{pg_dsn}) { 8631 my $s = $self->{dbhdest}->do($str) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . ", SQL: $str\n", 0, 1); 8632 } else { 8633 $footer .= "$str\n"; 8634 } 8635 } 8636 } 8637 } 8638 } 8639 8640 # Insert restart sequences orders 8641 if (($#ordered_tables >= 0) && !$self->{disable_sequence} && !$self->{oracle_speed}) 8642 { 8643 $self->logit("Restarting sequences\n", 1); 8644 my @restart_sequence = $self->_extract_sequence_info(); 8645 foreach my $str (@restart_sequence) 8646 { 8647 if ($self->{pg_dsn}) { 8648 my $s = $self->{dbhdest}->do($str) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8649 } else { 8650 $footer .= "$str\n"; 8651 } 8652 } 8653 } 8654 8655 # DATADIFF: call optional function specified in config to be called with all table names right before commit 8656 if ($self->{datadiff} && $self->{datadiff_after_all} && $#datadiff_tbl >= 0) 8657 { 8658 $footer .= "SELECT " . $self->{datadiff_after_all} . "(ARRAY['"; 8659 $footer .= join("', '", @datadiff_tbl) . "'], ARRAY['"; 8660 $footer .= join("', '", @datadiff_del) . "'], ARRAY['"; 8661 $footer .= join("', '", @datadiff_upd) . "'], ARRAY['"; 8662 $footer .= join("', '", @datadiff_ins) . "']);\n"; 8663 } 8664 8665 # Commit transaction 8666 if ($self->{pg_dsn} && !$self->{oracle_speed}) { 8667 my $s = $self->{dbhdest}->do("COMMIT;") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 8668 } else { 8669 $footer .= "COMMIT;\n\n"; 8670 } 8671 8672 # Recreate constraint an indexes if required 8673 $self->dump("\n$footer") if (!$self->{pg_dsn} && $footer); 8674 8675 my $npart = 0; 8676 my $nsubpart = 0; 8677 foreach my $t (sort keys %{ $self->{partitions} }) { 8678 $npart += scalar keys %{$self->{partitions}{$t}}; 8679 } 8680 foreach my $t (sort keys %{ $self->{subpartitions_list} }) 8681 { 8682 foreach my $p (sort keys %{ $self->{subpartitions_list}{$t} }) { 8683 $nsubpart += scalar keys %{ $self->{subpartitions_list}{$t}{$p}}; 8684 } 8685 } 8686 8687 my $t1 = Benchmark->new; 8688 my $td = timediff($t1, $t0); 8689 my $timestr = timestr($td); 8690 my $title = 'Total time to export data'; 8691 if ($self->{ora2pg_speed}) { 8692 $title = 'Total time to process data from Oracle'; 8693 } elsif ($self->{oracle_speed}) { 8694 $title = 'Total time to extract data from Oracle'; 8695 } 8696 $self->logit("$title from " . (scalar keys %{$self->{tables}}) . " tables ($npart partitions, $nsubpart sub-partitions) and $self->{global_rows} total rows: $timestr\n", 1); 8697 if ($timestr =~ /^(\d+) wallclock secs/) 8698 { 8699 my $mean = sprintf("%.2f", $self->{global_rows}/($1 || 1)); 8700 $self->logit("Speed average: $mean rows/sec\n", 1); 8701 } 8702 return; 8703 } 8704} 8705 8706sub fix_function_call 8707{ 8708 my $self = shift; 8709 8710 8711 $self->logit("Fixing function calls in output files...\n", 0); 8712 8713 my $dirprefix = ''; 8714 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 8715 8716 return unless(open(my $tfh, '<', $dirprefix . 'temp_pass2_file.dat')); 8717 while (my $l = <$tfh>) { 8718 chomp($l); 8719 my ($pname, $fname, $file_name) = split(/:/, $l); 8720 $file_to_update{$pname}{$fname} = $file_name; 8721 } 8722 close($tfh); 8723 8724 my $child_count = 0; 8725 # Fix call to package function in files 8726 foreach my $pname (sort keys %file_to_update ) { 8727 next if ($pname =~ /^ORA2PG_/); 8728 foreach my $fname (sort keys %{ $file_to_update{$pname} } ) { 8729 if ($self->{jobs} > 1) { 8730 while ($child_count >= $self->{jobs}) { 8731 my $kid = waitpid(-1, WNOHANG); 8732 if ($kid > 0) { 8733 $child_count--; 8734 delete $RUNNING_PIDS{$kid}; 8735 } 8736 usleep(50000); 8737 } 8738 spawn sub { 8739 $self->requalify_package_functions($file_to_update{$pname}{$fname}); 8740 }; 8741 $child_count++; 8742 } else { 8743 $self->requalify_package_functions($file_to_update{$pname}{$fname}); 8744 } 8745 } 8746 } 8747 8748 # Wait for all child end 8749 while ($child_count > 0) { 8750 my $kid = waitpid(-1, WNOHANG); 8751 if ($kid > 0) { 8752 $child_count--; 8753 delete $RUNNING_PIDS{$kid}; 8754 } 8755 usleep(50000); 8756 } 8757} 8758 8759# Requalify function call by using double quoted if necessary and by replacing 8760# dot with an undescore when PACKAGE_AS_SCHEMA is disabled. 8761sub requalify_package_functions 8762{ 8763 my ($self, $filename) = @_; 8764 8765 if (open(my $fh, '<', $filename)) { 8766 $self->set_binmode($fh); 8767 my $content = ''; 8768 while (<$fh>) { $content .= $_; }; 8769 close($f); 8770 $self->requalify_function_call(\$content); 8771 if (open(my $fh, '>', $filename)) { 8772 $self->set_binmode($fh); 8773 print $fh $content; 8774 close($fh); 8775 } else { 8776 print STDERR "ERROR: requalify package functions can't write to $filename, $!\n"; 8777 return; 8778 } 8779 } else { 8780 print STDERR "ERROR: requalify package functions can't read file $filename, $!\n"; 8781 return; 8782 } 8783} 8784 8785# Routine used to read input file and return content as string, 8786# Character / is replaces by a ; and \r are removed 8787sub read_input_file 8788{ 8789 my ($self, $file) = @_; 8790 8791 8792 my $content = ''; 8793 if (open(my $fin, '<', $file)) 8794 { 8795 $self->set_binmode($fin) if (_is_utf8_file( $file)); 8796 while (<$fin>) { next if /^\/$/; $content .= $_; }; 8797 close($fin); 8798 } else { 8799 die "FATAL: can't read file $file, $!\n"; 8800 } 8801 8802 $content =~ s/[\r\n]\/([\r\n]|$)/;$2/gs; 8803 $content =~ s/\r//gs; 8804 $content =~ s/[\r\n]SHOW\s+(?:ERRORS|ERR|BTITLE|BTI|LNO|PNO|RECYCLEBIN|RECYC|RELEASE|REL|REPFOOTER|REPF|REPHEADER|REPH|SPOOL|SPOO|SGA|SQLCODE|TTITLE|TTI|USER|XQUERY|SPPARAMETERS|PARAMETERS)[^\r\n]*([\r\n]|$)/;$2/igs; 8805 8806 if ($self->{is_mysql}) 8807 { 8808 $content =~ s/"/'/gs; 8809 $content =~ s/`/"/gs; 8810 } 8811 8812 return $content; 8813} 8814 8815sub file_exists 8816{ 8817 my ($self, $file) = @_; 8818 8819 return 0 if ($self->{oracle_speed}); 8820 8821 if ($self->{file_per_table} && !$self->{pg_dsn}) { 8822 if (-e "$file") { 8823 $self->logit("WARNING: Skipping dumping data to file $file, file already exists.\n", 0); 8824 return 1; 8825 } 8826 } 8827 return 0; 8828} 8829 8830#### 8831# dump table content 8832#### 8833sub _dump_table 8834{ 8835 my ($self, $dirprefix, $sql_header, $table, $part_name, $is_subpart) = @_; 8836 8837 my @cmd_head = (); 8838 my @cmd_foot = (); 8839 8840 # Set search path 8841 my $search_path = $self->set_search_path(); 8842 if ((!$self->{truncate_table} || $self->{pg_dsn}) && $search_path) { 8843 push(@cmd_head,$search_path); 8844 } 8845 8846 # Rename table and double-quote it if required 8847 my $tmptb = ''; 8848 8849 # Prefix partition name with tablename, if pg_supports_partition is enabled 8850 # direct import to partition is not allowed so import to main table. 8851 if (!$self->{pg_supports_partition} && $part_name && $self->{prefix_partition}) { 8852 $tmptb = $self->get_replaced_tbname($table . '_' . $part_name); 8853 } elsif (!$self->{pg_supports_partition} && $part_name) { 8854 $tmptb = $self->get_replaced_tbname($part_name || $table); 8855 } else { 8856 $tmptb = $self->get_replaced_tbname($table); 8857 } 8858 8859 # Replace Tablename by temporary table for DATADIFF (data will be inserted in real table at the end) 8860 # !!! does not work correctly for partitions yet !!! 8861 if ($self->{datadiff}) { 8862 $tmptb = $self->get_tbname_with_suffix($tmptb, $self->{datadiff_ins_suffix}); 8863 } 8864 8865 # Build the header of the query 8866 my @tt = (); 8867 my @stt = (); 8868 my @nn = (); 8869 my $col_list = ''; 8870 my $has_geometry = 0; 8871 my $has_identity = 0; 8872 $has_identity = 1 if (exists $self->{identity_info}{$table}); 8873 8874 # Extract column information following the Oracle position order 8875 my @fname = (); 8876 my (@pg_colnames_nullable, @pg_colnames_notnull, @pg_colnames_pkey); 8877 foreach my $i ( 0 .. $#{$self->{tables}{$table}{field_name}} ) 8878 { 8879 my $fieldname = ${$self->{tables}{$table}{field_name}}[$i]; 8880 if (!$self->{preserve_case}) 8881 { 8882 if (exists $self->{modify}{"\L$table\E"}) { 8883 next if (!grep(/^\Q$fieldname\E$/i, @{$self->{modify}{"\L$table\E"}})); 8884 } 8885 } 8886 else 8887 { 8888 if (exists $self->{modify}{"$table"}) { 8889 next if (!grep(/^\Q$fieldname\E$/i, @{$self->{modify}{"$table"}})); 8890 } 8891 } 8892 8893 my $f = $self->{tables}{"$table"}{column_info}{"$fieldname"}; 8894 $f->[2] =~ s/\D//g; 8895 if (!$self->{enable_blob_export} && $f->[1] =~ /blob/i) 8896 { 8897 # user don't want to export blob 8898 next; 8899 } 8900 8901 if (!$self->{preserve_case}) { 8902 push(@fname, lc($fieldname)); 8903 } else { 8904 push(@fname, $fieldname); 8905 } 8906 8907 if ($f->[1] =~ /SDO_GEOMETRY/i) 8908 { 8909 $self->{local_type} = $self->{type} if (!$self->{local_type}); 8910 $has_geometry = 1; 8911 } 8912 8913 my $type = $self->_sql_type($f->[1], $f->[2], $f->[5], $f->[6], $f->[4]); 8914 $type = "$f->[1], $f->[2]" if (!$type); 8915 8916 if (uc($f->[1]) eq 'ENUM') { 8917 $f->[1] = 'varchar'; 8918 } 8919 push(@stt, uc($f->[1])); 8920 push(@tt, $type); 8921 push(@nn, $self->{tables}{$table}{column_info}{$fieldname}); 8922 # Change column names 8923 my $colname = $f->[0]; 8924 if ($self->{replaced_cols}{lc($table)}{lc($f->[0])}) { 8925 $self->logit("\tReplacing column $f->[0] as " . $self->{replaced_cols}{lc($table)}{lc($f->[0])} . "...\n", 1); 8926 $colname = $self->{replaced_cols}{lc($table)}{lc($f->[0])}; 8927 } 8928 $colname = $self->quote_object_name($colname); 8929 if ($colname !~ /"/ && $self->is_reserved_words($colname)) { 8930 $colname = '"' . $colname . '"'; 8931 } 8932 $col_list .= "$colname,"; 8933 if ($self->is_primary_key_column($table, $fieldname)) { 8934 push @pg_colnames_pkey, "$colname"; 8935 } elsif ($f->[3] =~ m/^Y/) { 8936 push @pg_colnames_nullable, "$colname"; 8937 } else { 8938 push @pg_colnames_notnull, "$colname"; 8939 } 8940 } 8941 $col_list =~ s/,$//; 8942 $self->{tables}{$table}{pg_colnames_nullable} = \@pg_colnames_nullable; 8943 $self->{tables}{$table}{pg_colnames_notnull} = \@pg_colnames_notnull; 8944 $self->{tables}{$table}{pg_colnames_pkey} = \@pg_colnames_pkey; 8945 8946 my $overriding_system = ''; 8947 if ($self->{pg_supports_identity}) { 8948 $overriding_system = ' OVERRIDING SYSTEM VALUE' if ($has_identity); 8949 } 8950 8951 my $s_out = "INSERT INTO $tmptb ($col_list"; 8952 if ($self->{type} eq 'COPY') { 8953 $s_out = "\nCOPY $tmptb ($col_list"; 8954 } 8955 8956 if ($self->{type} eq 'COPY') { 8957 $s_out .= ") FROM STDIN$self->{copy_freeze};\n"; 8958 } else { 8959 $s_out .= ")$overriding_system VALUES ("; 8960 } 8961 8962 # Prepare statements might work in binary mode but not WKT 8963 # and INTERNAL because they use the call to ST_GeomFromText() 8964 $has_geometry = 0 if ($self->{geometry_extract_type} eq 'WKB'); 8965 8966 # Use prepared statement in INSERT mode and only if 8967 # we are not exporting a row with a spatial column 8968 my $sprep = ''; 8969 if ($self->{pg_dsn} && !$has_geometry) { 8970 if ($self->{type} ne 'COPY') { 8971 $s_out .= '?,' foreach (@fname); 8972 $s_out =~ s/,$//; 8973 $s_out .= ")"; 8974 $sprep = $s_out; 8975 } 8976 } 8977 8978 # Extract all data from the current table 8979 my $total_record = $self->ask_for_data($table, \@cmd_head, \@cmd_foot, $s_out, \@nn, \@tt, $sprep, \@stt, $part_name, $is_subpart); 8980 8981 $self->{type} = $self->{local_type} if ($self->{local_type}); 8982 $self->{local_type} = ''; 8983 8984} 8985 8986#### 8987# dump FDW table content 8988#### 8989sub _dump_fdw_table 8990{ 8991 my ($self, $dirprefix, $sql_header, $table, $local_dbh) = @_; 8992 8993 my @cmd_head = (); 8994 my @cmd_foot = (); 8995 8996 # Set search path 8997 my $search_path = $self->set_search_path(); 8998 if (!$self->{truncate_table} && $search_path) { 8999 push(@cmd_head,$search_path); 9000 } 9001 9002 # Rename table and double-quote it if required 9003 my $tmptb = $self->get_replaced_tbname($table); 9004 9005 # Replace Tablename by temporary table for DATADIFF (data will be inserted in real table at the end) 9006 # !!! does not work correctly for partitions yet !!! 9007 if ($self->{datadiff}) { 9008 $tmptb = $self->get_tbname_with_suffix($tmptb, $self->{datadiff_ins_suffix}); 9009 } 9010 9011 # Build the header of the query 9012 my @tt = (); 9013 my @stt = (); 9014 my @nn = (); 9015 my $col_list = ''; 9016 my $fdw_col_list = ''; 9017 my $has_geometry = 0; 9018 my $has_identity = 0; 9019 $has_identity = 1 if (exists $self->{identity_info}{$table}); 9020 9021 # Extract column information following the Oracle position order 9022 my @fname = (); 9023 my (@pg_colnames_nullable, @pg_colnames_notnull, @pg_colnames_pkey); 9024 foreach my $i ( 0 .. $#{$self->{tables}{$table}{field_name}} ) 9025 { 9026 my $fieldname = ${$self->{tables}{$table}{field_name}}[$i]; 9027 if (!$self->{preserve_case}) 9028 { 9029 if (exists $self->{modify}{"\L$table\E"}) { 9030 next if (!grep(/^\Q$fieldname\E$/i, @{$self->{modify}{"\L$table\E"}})); 9031 } 9032 } 9033 else 9034 { 9035 if (exists $self->{modify}{"$table"}) { 9036 next if (!grep(/^\Q$fieldname\E$/i, @{$self->{modify}{"$table"}})); 9037 } 9038 } 9039 9040 my $f = $self->{tables}{"$table"}{column_info}{"$fieldname"}; 9041 $f->[2] =~ s/\D//g; 9042 if (!$self->{enable_blob_export} && $f->[1] =~ /blob/i) 9043 { 9044 # user don't want to export blob 9045 next; 9046 } 9047 9048 if (!$self->{preserve_case}) { 9049 push(@fname, lc($fieldname)); 9050 } else { 9051 push(@fname, $fieldname); 9052 } 9053 9054 if ($f->[1] =~ /SDO_GEOMETRY/i) 9055 { 9056 $self->{local_type} = $self->{type} if (!$self->{local_type}); 9057 $has_geometry = 1; 9058 } 9059 9060 my $type = $self->_sql_type($f->[1], $f->[2], $f->[5], $f->[6], $f->[4]); 9061 $type = "$f->[1], $f->[2]" if (!$type); 9062 9063 # Check for boolean rewritting 9064 my $typlen = $f->[5]; 9065 $typlen ||= $f->[2]; 9066 # Check if this column should be replaced by a boolean following table/column name 9067 if (grep(/^\L$fieldname\E$/i, @{$self->{'replace_as_boolean'}{uc($table)}})) { 9068 $type = 'boolean'; 9069 # Check if this column should be replaced by a boolean following type/precision 9070 } elsif (exists $self->{'replace_as_boolean'}{uc($f->[1])} && ($self->{'replace_as_boolean'}{uc($f->[1])}[0] == $typlen)) { 9071 $type = 'boolean'; 9072 } 9073 # check if destination column type must be changed 9074 my $colname = $fieldname; 9075 $colname =~ s/["`]//g; 9076 $type = $self->{'modify_type'}{"\L$table\E"}{"\L$colname\E"} if (exists $self->{'modify_type'}{"\L$table\E"}{"\L$colname\E"}); 9077 9078 if (uc($f->[1]) eq 'ENUM') { 9079 $type = 'varchar'; 9080 } 9081 # Change column names 9082 $colname = $f->[0]; 9083 if ($self->{replaced_cols}{lc($table)}{lc($f->[0])}) { 9084 $self->logit("\tReplacing column $f->[0] as " . $self->{replaced_cols}{lc($table)}{lc($f->[0])} . "...\n", 1); 9085 $colname = $self->{replaced_cols}{lc($table)}{lc($f->[0])}; 9086 } 9087 # If there is any transformation to apply replace the column name with the clause 9088 if (exists $self->{oracle_fdw_transform}{lc($table)}{lc($colname)}) { 9089 $fdw_col_list .= $self->{oracle_fdw_transform}{lc($table)}{lc($colname)} . ","; 9090 } else { 9091 # If this column is translated into boolean apply the CASE clause 9092 if ($type eq 'boolean') 9093 { 9094 $fdw_col_list .= "(CASE WHEN \"$colname\" IS NULL THEN NULL"; 9095 my $true_list = ''; 9096 foreach my $k (keys %{$self->{ora_boolean_values}}) 9097 { 9098 if ($self->{ora_boolean_values}{$k} eq 't') { 9099 $true_list .= " lower(\"$colname\") = '$k' OR"; 9100 } 9101 } 9102 $true_list =~ s/ OR$//; 9103 $fdw_col_list .= " WHEN ($true_list) THEN 't' ELSE 'f' END)::boolean,"; 9104 } 9105 else 9106 { 9107 $fdw_col_list .= $self->quote_object_name($colname) . ","; 9108 #$fdw_col_list .= "\"$colname\","; 9109 } 9110 } 9111 $colname = $self->quote_object_name($colname); 9112 if ($colname !~ /"/ && $self->is_reserved_words($colname)) { 9113 $colname = '"' . $colname . '"'; 9114 } 9115 $col_list .= "$colname,"; 9116 if ($self->is_primary_key_column($table, $fieldname)) { 9117 push @pg_colnames_pkey, "$colname"; 9118 } elsif ($f->[3] =~ m/^Y/) { 9119 push @pg_colnames_nullable, "$colname"; 9120 } else { 9121 push @pg_colnames_notnull, "$colname"; 9122 } 9123 } 9124 $col_list =~ s/,$//; 9125 $fdw_col_list =~ s/,$//; 9126 $self->{tables}{$table}{pg_colnames_nullable} = \@pg_colnames_nullable; 9127 $self->{tables}{$table}{pg_colnames_notnull} = \@pg_colnames_notnull; 9128 $self->{tables}{$table}{pg_colnames_pkey} = \@pg_colnames_pkey; 9129 9130 my $overriding_system = ''; 9131 if ($self->{pg_supports_identity} && $has_identity) { 9132 $overriding_system = ' OVERRIDING SYSTEM VALUE'; 9133 } 9134 9135 my $s_out = "INSERT INTO $tmptb ($col_list"; 9136 my $fdwtb = $tmptb; 9137 $fdwtb = '"' . $tmptb . '"' if ($tmptb !~ /"/); 9138 $s_out .= ")$overriding_system SELECT $fdw_col_list FROM ora2pg_fdw_import.$fdwtb"; 9139 9140 $0 = "ora2pg - exporting table ora2pg_fdw_import.$fdwtb"; 9141 9142 # Overwrite the query if REPLACE_QUERY is defined for this table 9143 if ($self->{replace_query}{"\L$table\E"}) 9144 { 9145 $s_out = $self->{replace_query}{"\L$table\E"}; 9146 } 9147 9148 # Prepare statements might work in binary mode but not WKT 9149 # and INTERNAL because they use the call to ST_GeomFromText() 9150 $has_geometry = 0 if ($self->{geometry_extract_type} eq 'WKB'); 9151 9152 if ( ($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"} ) 9153 { 9154 my $colpk = $self->{defined_pk}{"\L$table\E"}; 9155 if ($self->{preserve_case}) { 9156 $colpk = '"' . $colpk . '"'; 9157 } 9158 my $cond = " ABS(MOD($colpk, $self->{oracle_copies})) = ?"; 9159 if ($s_out !~ s/\bWHERE\s+/WHERE $cond AND /) 9160 { 9161 if ($s_out !~ s/\b(ORDER\s+BY\s+.*)/WHERE $cond $1/) { 9162 $s_out .= " WHERE $cond"; 9163 } 9164 } 9165 $self->{ora_conn_count} = 0; 9166 while ($self->{ora_conn_count} < $self->{oracle_copies}) 9167 { 9168 spawn sub { 9169 $self->logit("Creating new connection to extract data in parallel...\n", 1); 9170 my $dbh = $local_dbh->clone(); 9171 my $search_path = $self->set_search_path(); 9172 if ($search_path) { 9173 $dbh->do($search_path) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 9174 } 9175 my $sth = $dbh->prepare($s_out) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 9176 $self->logit("Parallelizing on core #$self->{ora_conn_count} with query: $s_out\n", 1); 9177 $self->logit("Exporting foreign table data for $table, #$self->{ora_conn_count}\n", 1); 9178 $sth->execute($self->{ora_conn_count}) or $self->logit("FATAL: " . $dbh->errstr . ", SQL: $s_out\n", 0, 1); 9179 $sth->finish(); 9180 if (defined $pipe) 9181 { 9182 my $t_time = time(); 9183 $pipe->print("TABLE EXPORT ENDED: $table, end: $t_time, rows $self->{tables}{$table}{table_info}{num_rows}\n"); 9184 } 9185 $dbh->disconnect() if ($dbh); 9186 }; 9187 $self->{ora_conn_count}++; 9188 } 9189 # Wait for oracle connection terminaison 9190 while ($self->{ora_conn_count} > 0) 9191 { 9192 my $kid = waitpid(-1, WNOHANG); 9193 if ($kid > 0) 9194 { 9195 $self->{ora_conn_count}--; 9196 delete $RUNNING_PIDS{$kid}; 9197 } 9198 usleep(50000); 9199 } 9200 } 9201 else 9202 { 9203 $self->logit("Exporting foreign table data for $table using query: $s_out\n", 1); 9204 $local_dbh->do($s_out) or $self->logit("ERROR: " . $local_dbh->errstr . ", SQL: $s_out\n", 1); 9205 } 9206 9207 $self->{type} = $self->{local_type} if ($self->{local_type}); 9208 $self->{local_type} = ''; 9209} 9210 9211sub exclude_mviews 9212{ 9213 my ($self, $cols) = @_; 9214 9215 my $sql = " AND ($cols) NOT IN (SELECT OWNER, TABLE_NAME FROM $self->{prefix}_OBJECT_TABLES)"; 9216 $sql .= " AND ($cols) NOT IN (SELECT OWNER, MVIEW_NAME FROM $self->{prefix}_MVIEWS UNION ALL SELECT LOG_OWNER, LOG_TABLE FROM $self->{prefix}_MVIEW_LOGS)" if ($self->{type} ne 'FDW'); 9217 return $sql; 9218} 9219 9220=head2 _column_comments 9221 9222This function return comments associated to columns 9223 9224=cut 9225sub _column_comments 9226{ 9227 my ($self, $table) = @_; 9228 9229 return Ora2Pg::MySQL::_column_comments($self, $table) if ($self->{is_mysql}); 9230 9231 my $condition = ''; 9232 9233 my $sql = "SELECT A.COLUMN_NAME,A.COMMENTS,A.TABLE_NAME,A.OWNER FROM $self->{prefix}_COL_COMMENTS A $condition"; 9234 if ($self->{schema}) { 9235 $sql .= "WHERE A.OWNER='$self->{schema}' "; 9236 } else { 9237 $sql .= " WHERE A.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 9238 } 9239 $sql .= "AND A.TABLE_NAME='$table' " if ($table); 9240 if ($self->{db_version} !~ /Release 8/) { 9241 $sql .= $self->exclude_mviews('A.OWNER, A.TABLE_NAME'); 9242 } 9243 if (!$table) { 9244 $sql .= $self->limit_to_objects('TABLE','TABLE_NAME'); 9245 } else { 9246 @{$self->{query_bind_params}} = (); 9247 } 9248 9249 my $sth = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 9250 9251 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 9252 my %data = (); 9253 while (my $row = $sth->fetch) 9254 { 9255 if (!$self->{schema} && $self->{export_schema}) { 9256 $row->[2] = "$row->[3].$row->[2]"; 9257 } 9258 if (!$self->{preserve_case}) { 9259 next if (exists $self->{modify}{"\L$row->[2]\E"} && !grep(/^\Q$row->[0]\E$/i, @{$self->{modify}{"\L$row->[2]\E"}})); 9260 } else { 9261 next if (exists $self->{modify}{$row->[2]} && !grep(/^\Q$row->[0]\E$/i, @{$self->{modify}{$row->[2]}})); 9262 } 9263 $data{$row->[2]}{$row->[0]} = $row->[1]; 9264 } 9265 9266 return %data; 9267} 9268 9269 9270=head2 _create_indexes 9271 9272This function return SQL code to create indexes of a table 9273and triggers to create for FTS indexes. 9274 9275- $indexonly mean no FTS index output 9276 9277=cut 9278sub _create_indexes 9279{ 9280 my ($self, $table, $indexonly, %indexes) = @_; 9281 9282 my $tbsaved = $table; 9283 # The %indexes hash can be passed from table or materialized views definition 9284 my $objtyp = 'tables'; 9285 if (!exists $self->{tables}{$tbsaved} && exists $self->{materialized_views}{$tbsaved}) { 9286 $objtyp = 'materialized_views'; 9287 } 9288 9289 my %pkcollist = (); 9290 # Save the list of column for PK to check unique index that must be removed 9291 foreach my $consname (keys %{$self->{$objtyp}{$tbsaved}{unique_key}}) 9292 { 9293 next if ($self->{$objtyp}{$tbsaved}{unique_key}->{$consname}{type} ne 'P'); 9294 my @conscols = grep(!/^\d+$/, @{$self->{$objtyp}{$tbsaved}{unique_key}->{$consname}{columns}}); 9295 # save the list of column for PK to check unique index that must be removed 9296 $pkcollist{$tbsaved} = join(", ", @conscols); 9297 } 9298 $pkcollist{$tbsaved} =~ s/\s+/ /g; 9299 9300 $table = $self->get_replaced_tbname($table); 9301 my @out = (); 9302 my @fts_out = (); 9303 my $has_to_char = 0; 9304 # Set the index definition 9305 foreach my $idx (sort keys %indexes) 9306 { 9307 # Remove cols than have only digit as name 9308 @{$indexes{$idx}} = grep(!/^\d+$/, @{$indexes{$idx}}); 9309 9310 # Cluster, bitmap join, reversed and IOT indexes will not be exported at all 9311 # Hash indexes will be exported as btree if PG < 10 9312 next if ($self->{$objtyp}{$tbsaved}{idx_type}{$idx}{type} =~ /JOIN|IOT|CLUSTER|REV/i); 9313 9314 if (exists $self->{replaced_cols}{"\L$tbsaved\E"} && $self->{replaced_cols}{"\L$tbsaved\E"}) 9315 { 9316 foreach my $c (keys %{$self->{replaced_cols}{"\L$tbsaved\E"}}) { 9317 map { s/\b$c\b/$self->{replaced_cols}{"\L$tbsaved\E"}{"\L$c\E"}/i } @{$indexes{$idx}}; 9318 } 9319 } 9320 9321 my @strings = (); 9322 my $i = 0; 9323 for (my $j = 0; $j <= $#{$indexes{$idx}}; $j++) 9324 { 9325 $indexes{$idx}->[$j] =~ s/''/%%ESCAPED_STRING%%/g; 9326 while ($indexes{$idx}->[$j] =~ s/'([^']+)'/%%string$i%%/) 9327 { 9328 push(@strings, $1); 9329 $i++; 9330 } 9331 if ($self->{plsql_pgsql}) { 9332 $indexes{$idx}->[$j] = Ora2Pg::PLSQL::convert_plsql_code($self, $indexes{$idx}->[$j], @strings); 9333 } 9334 $indexes{$idx}->[$j] =~ s/%%ESCAPED_STRING%%/''/ig; 9335 $has_to_char = 1 if ($indexes{$idx}->[$j] =~ s/TO_CHAR\s*\(/immutable_to_char\(/ig); 9336 } 9337 9338 # Add index opclass if required and type allow it 9339 my %opclass_type = (); 9340 if ($self->{use_index_opclass}) 9341 { 9342 my $i = 0; 9343 for (my $j = 0; $j <= $#{$indexes{$idx}}; $j++) 9344 { 9345 if (exists $self->{$objtyp}{$tbsaved}{column_info}{uc($indexes{$idx}->[$j])}) 9346 { 9347 my $d = $self->{$objtyp}{$tbsaved}{column_info}{uc($indexes{$idx}->[$j])}; 9348 $d->[2] =~ s/\D//g; 9349 if ( (($self->{use_index_opclass} == 1) || ($self->{use_index_opclass} <= $d->[2])) && ($d->[1] =~ /VARCHAR/)) { 9350 my $typ = $self->_sql_type($d->[1], $d->[2], $d->[5], $d->[6], $f->[4]); 9351 $typ =~ s/\(.*//; 9352 if ($typ =~ /varchar/) { 9353 $typ = ' varchar_pattern_ops'; 9354 } elsif ($typ =~ /text/) { 9355 $typ = ' text_pattern_ops'; 9356 } elsif ($typ =~ /char/) { 9357 $typ = ' bpchar_pattern_ops'; 9358 } 9359 $opclass_type{$indexes{$idx}->[$j]} = "$indexes{$idx}->[$j] $typ"; 9360 } 9361 } 9362 } 9363 } 9364 # Add parentheses to index column definition when a space is found 9365 if (!$self->{input_file}) 9366 { 9367 for ($i = 0; $i <= $#{$indexes{$idx}}; $i++) 9368 { 9369 if ( ($indexes{$idx}->[$i] =~ /\s/) && ($indexes{$idx}->[$i] !~ /^[^\.\s]+\s+DESC$/i) ) { 9370 $indexes{$idx}->[$i] = '(' . $indexes{$idx}->[$i] . ')'; 9371 } 9372 } 9373 } 9374 my $columns = ''; 9375 foreach my $s (@{$indexes{$idx}}) 9376 { 9377 $s = '"' . $s . '"' if ($self->is_reserved_words($s)); 9378 if ($s =~ /\|\|/) { 9379 $columns .= '(' . $s . ')'; 9380 } else { 9381 $columns .= ((exists $opclass_type{$s}) ? $opclass_type{$s} : $s) . ", "; 9382 } 9383 # Add double quotes on column name if PRESERVE_CASE is enabled 9384 foreach my $c (keys %{$self->{tables}{$tbsaved}{column_info}}) 9385 { 9386 $columns =~ s/\b$c\b/"$c"/g if ($self->{preserve_case} && $columns !~ /"$c"/); 9387 } 9388 } 9389 $columns =~ s/, $//s; 9390 $columns =~ s/\s+/ /gs; 9391 my $colscompare = $columns; 9392 $colscompare =~ s/"//g; 9393 $colscompare =~ s/ //g; 9394 my $columnlist = ''; 9395 my $skip_index_creation = 0; 9396 my %pk_hist = (); 9397 9398 foreach my $consname (keys %{$self->{$objtyp}{$tbsaved}{unique_key}}) 9399 { 9400 my $constype = $self->{$objtyp}{$tbsaved}{unique_key}->{$consname}{type}; 9401 next if (($constype ne 'P') && ($constype ne 'U')); 9402 my @conscols = grep(!/^\d+$/, @{$self->{$objtyp}{$tbsaved}{unique_key}->{$consname}{columns}}); 9403 for ($i = 0; $i <= $#conscols; $i++) 9404 { 9405 # Change column names 9406 if (exists $self->{replaced_cols}{"\L$tbsaved\E"}{"\L$conscols[$i]\E"} && $self->{replaced_cols}{"\L$tbsaved\E"}{"\L$conscols[$i]\E"}) { 9407 $conscols[$i] = $self->{replaced_cols}{"\L$tbsaved\E"}{"\L$conscols[$i]\E"}; 9408 } 9409 } 9410 $columnlist = join(',', @conscols); 9411 $columnlist =~ s/"//gs; 9412 $columnlist =~ s/\s+//gs; 9413 if ($constype eq 'P') 9414 { 9415 $pk_hist{$table} = $columnlist; 9416 } 9417 if (lc($columnlist) eq lc($colscompare)) 9418 { 9419 $skip_index_creation = 1; 9420 last; 9421 } 9422 } 9423 9424 # Do not create the index if there already a constraint on the same column list 9425 # or there a primary key defined on the same columns as a unique index, in both cases 9426 # the index will be automatically created by PostgreSQL at constraint import time. 9427 if (!$skip_index_creation) 9428 { 9429 my $unique = ''; 9430 $unique = ' UNIQUE' if ($self->{$objtyp}{$tbsaved}{uniqueness}{$idx} eq 'UNIQUE'); 9431 my $str = ''; 9432 my $fts_str = ''; 9433 my $concurrently = ''; 9434 if ($self->{$objtyp}{$tbsaved}{concurrently}{$idx}) { 9435 $concurrently = ' CONCURRENTLY'; 9436 } 9437 $columns = lc($columns) if (!$self->{preserve_case}); 9438 next if ( lc($columns) eq lc($pkcollist{$tbsaved}) ); 9439 9440 for ($i = 0; $i <= $#strings; $i++) { 9441 $columns =~ s/\%\%string$i\%\%/'$strings[$i]'/; 9442 } 9443 9444 # Replace call of schema.package.function() into package.function() 9445 $columns =~ s/\b[^\s\.]+\.([^\s\.]+\.[^\s\.]+)\s*\(/$1\(/is; 9446 9447 # Do not create indexes if they are already defined as constraints 9448 if ($self->{type} eq 'TABLE') 9449 { 9450 my $col_list = $columns; 9451 $col_list =~ s/"//g; 9452 $col_list =~ s/, /,/g; 9453 next if (exists $pk_hist{$table} && uc($pk_hist{$table}) eq uc($col_list)); 9454 } 9455 9456 my $schm = ''; 9457 my $idxname = ''; 9458 if ($idx =~ /^([^\.]+)\.(.*)$/) 9459 { 9460 $schm = $1; 9461 $idxname = $2; 9462 } else { 9463 $idxname = $idx; 9464 } 9465 if ($self->{indexes_renaming}) 9466 { 9467 if ($table =~ /^([^\.]+)\.(.*)$/) { 9468 $schm = $1; 9469 $idxname = $2; 9470 } else { 9471 $idxname = $table; 9472 } 9473 $idxname =~ s/"//g; 9474 my @collist = @{$indexes{$idx}}; 9475 # Remove double quote, DESC and parenthesys 9476 map { s/"//g; s/.*\(([^\)]+)\).*/$1/; s/\s+DESC//i; s/::.*//; } @collist; 9477 $idxname = $idxname . '_' . join('_', @collist); 9478 $idxname =~ s/\s+//g; 9479 if ($self->{indexes_suffix}) { 9480 $idxname = substr($idxname,0,59); 9481 } else { 9482 $idxname = substr($idxname,0,63); 9483 } 9484 } 9485 $idxname = $schm . '.' . $idxname if ($schm); 9486 $idxname = $self->quote_object_name($idxname); 9487 my $tb = $self->quote_object_name($table); 9488 if ($self->{$objtyp}{$tbsaved}{idx_type}{$idx}{type_name} =~ /SPATIAL_INDEX/) 9489 { 9490 $str .= "CREATE INDEX$concurrently " . $self->quote_object_name("$idxname$self->{indexes_suffix}") 9491 . " ON $tb USING gist($columns)"; 9492 } 9493 elsif ($self->{bitmap_as_gin} && $self->{$objtyp}{$tbsaved}{idx_type}{$idx}{type_name} eq 'BITMAP') 9494 { 9495 $str .= "CREATE INDEX$concurrently " . $self->quote_object_name("$idxname$self->{indexes_suffix}") 9496 . " ON $tb USING gin($columns)"; 9497 } 9498 elsif ( ($self->{$objtyp}{$tbsaved}{idx_type}{$idx}{type_name} =~ /CTXCAT/) || 9499 ($self->{context_as_trgm} && ($self->{$objtyp}{$tbsaved}{idx_type}{$idx}{type_name} =~ /FULLTEXT|CONTEXT/)) ) 9500 { 9501 # use pg_trgm 9502 my @cols = split(/\s*,\s*/, $columns); 9503 map { s/^(.*)$/unaccent_immutable($1)/; } @cols if ($self->{use_unaccent}); 9504 $columns = join(" gin_trgm_ops, ", @cols); 9505 $columns .= " gin_trgm_ops"; 9506 $str .= "CREATE INDEX$concurrently " . $self->quote_object_name("$idxname$self->{indexes_suffix}") 9507 . " ON $tb USING gin($columns)"; 9508 } 9509 elsif (($self->{$objtyp}{$tbsaved}{idx_type}{$idx}{type_name} =~ /FULLTEXT|CONTEXT/) && $self->{fts_index_only}) 9510 { 9511 my $stemmer = $self->{fts_config} || lc($self->{$objtyp}{$tbsaved}{idx_type}{$idx}{stemmer}) || 'pg_catalog.english'; 9512 my $dico = $stemmer; 9513 $dico =~ s/^pg_catalog\.//; 9514 if ($self->{use_unaccent}) { 9515 $dico =~ s/^(..).*/$1/; 9516 if ($fts_str !~ /CREATE TEXT SEARCH CONFIGURATION $dico (COPY = $stemmer);/s) { 9517 $fts_str .= "CREATE TEXT SEARCH CONFIGURATION $dico (COPY = $stemmer);\n"; 9518 $stemmer =~ s/pg_catalog\.//; 9519 $fts_str .= "ALTER TEXT SEARCH CONFIGURATION $dico ALTER MAPPING FOR hword, hword_part, word WITH unaccent, ${stemmer}_stem;\n\n"; 9520 } 9521 } 9522 # use function-based index" 9523 my @cols = split(/\s*,\s*/, $columns); 9524 $columns = "to_tsvector('$dico', " . join("||' '||", @cols) . ")"; 9525 $fts_str .= "CREATE INDEX$concurrently " . $self->quote_object_name("$idxname$self->{indexes_suffix}") 9526 . " ON $tb USING gin($columns);\n"; 9527 } 9528 elsif (($self->{$objtyp}{$tbsaved}{idx_type}{$idx}{type_name} =~ /FULLTEXT|CONTEXT/) && !$self->{fts_index_only}) 9529 { 9530 # use Full text search, then create dedicated column and trigger before the index. 9531 map { s/"//g; } @{$indexes{$idx}}; 9532 my $newcolname = join('_', @{$indexes{$idx}}); 9533 $fts_str .= "\n-- Append the FTS column to the table\n"; 9534 $fts_str .= "\nALTER TABLE $tb ADD COLUMN tsv_" . substr($newcolname,0,59) . " tsvector;\n"; 9535 my $fctname = "tsv_${table}_" . substr($newcolname,0,59-(length($table)+1)); 9536 my $trig_name = "trig_tsv_${table}_" . substr($newcolname,0,54-(length($table)+1)); 9537 my $contruct_vector = ''; 9538 my $update_vector = ''; 9539 my $weight = 'A'; 9540 my $stemmer = $self->{fts_config} || lc($self->{$objtyp}{$tbsaved}{idx_type}{$idx}{stemmer}) || 'pg_catalog.english'; 9541 my $dico = $stemmer; 9542 $dico =~ s/^pg_catalog\.//; 9543 if ($self->{use_unaccent}) 9544 { 9545 $dico =~ s/^(..).*/$1/; 9546 if ($fts_str !~ /CREATE TEXT SEARCH CONFIGURATION $dico (COPY = $stemmer);/s) 9547 { 9548 $fts_str .= "CREATE TEXT SEARCH CONFIGURATION $dico (COPY = $stemmer);\n"; 9549 $stemmer =~ s/pg_catalog\.//; 9550 $fts_str .= "ALTER TEXT SEARCH CONFIGURATION $dico ALTER MAPPING FOR hword, hword_part, word WITH unaccent, ${stemmer}_stem;\n\n"; 9551 } 9552 } 9553 if ($#{$indexes{$idx}} > 0) 9554 { 9555 foreach my $col (@{$indexes{$idx}}) 9556 { 9557 $contruct_vector .= "\t\tsetweight(to_tsvector('$dico', coalesce(new.$col,'')), '$weight') ||\n"; 9558 $update_vector .= " setweight(to_tsvector('$dico', coalesce($col,'')), '$weight') ||"; 9559 $weight++; 9560 } 9561 $contruct_vector =~ s/\|\|$/;/s; 9562 $update_vector =~ s/\|\|$/;/s; 9563 } 9564 else 9565 { 9566 $contruct_vector = "\t\tto_tsvector('$dico', coalesce(new.$indexes{$idx}->[0],''))\n"; 9567 $update_vector = " to_tsvector('$dico', coalesce($indexes{$idx}->[0],''))"; 9568 } 9569 9570 $fts_str .= qq{ 9571-- When the data migration is done without trigger, create tsvector data for all the existing records 9572UPDATE $tb SET tsv_$newcolname = $update_vector 9573 9574-- Trigger used to keep fts field up to date 9575CREATE FUNCTION $fctname() RETURNS trigger AS \$\$ 9576BEGIN 9577 IF TG_OP = 'INSERT' OR new.$newcolname != old.$newcolname THEN 9578 new.tsv_$newcolname := 9579$contruct_vector 9580 END IF; 9581 return new; 9582END 9583\$\$ LANGUAGE plpgsql; 9584 9585CREATE TRIGGER $trig_name BEFORE INSERT OR UPDATE 9586 ON $tb 9587 FOR EACH ROW EXECUTE PROCEDURE $fctname(); 9588 9589} if (!$indexonly); 9590 if ($objtyp eq 'tables') 9591 { 9592 $str .= "CREATE$unique INDEX$concurrently " . $self->quote_object_name("$idxname$self->{indexes_suffix}") 9593 . " ON $table USING gin(tsv_$newcolname)"; 9594 } 9595 else 9596 { 9597 $fts_str .= "CREATE$unique INDEX$concurrently " . $self->quote_object_name("$idxname$self->{indexes_suffix}") 9598 . " ON $table USING gin(tsv_$newcolname)"; 9599 } 9600 } 9601 elsif ($self->{$objtyp}{$tbsaved}{idx_type}{$idx}{type} =~ /DOMAIN/i && $self->{$objtyp}{$tbsaved}{idx_type}{$idx}{type_name} !~ /SPATIAL_INDEX/) 9602 { 9603 $str .= "-- Was declared as DOMAIN index, please check for FTS adaptation if require\n"; 9604 $str .= "-- CREATE$unique INDEX$concurrently " . $self->quote_object_name("$idxname$self->{indexes_suffix}") 9605 . " ON $table ($columns)"; 9606 } 9607 else 9608 { 9609 $str .= "CREATE$unique INDEX$concurrently " . $self->quote_object_name("$idxname$self->{indexes_suffix}") 9610 . " ON $table ($columns)"; 9611 } 9612 if ($self->{use_tablespace} && $self->{$objtyp}{$tbsaved}{idx_tbsp}{$idx} && !grep(/^$self->{$objtyp}{$tbsaved}{idx_tbsp}{$idx}$/i, @{$self->{default_tablespaces}})) 9613 { 9614 $str .= " TABLESPACE $self->{$objtyp}{$tbsaved}{idx_tbsp}{$idx}"; 9615 } 9616 if ($str) 9617 { 9618 $str .= ";"; 9619 push(@out, $str); 9620 } 9621 push(@fts_out, $fts_str) if ($fts_str); 9622 } 9623 } 9624 9625 if ($has_to_char) 9626 { 9627 unshift(@out, qq{ 9628-- Function used in indexes must be immutable, use immutable_to_char() instead of to_char() 9629CREATE OR REPLACE FUNCTION immutable_to_char(timestamp, fmt text) RETURNS text AS 9630\$\$ SELECT to_char(\$1, \$2); \$\$ 9631LANGUAGE sql immutable; 9632 9633}); 9634 } 9635 9636 return $indexonly ? (@out,@fts_out) : (join("\n", @out), join("\n", @fts_out)); 9637} 9638 9639=head2 _drop_indexes 9640 9641This function return SQL code to drop indexes of a table 9642 9643=cut 9644sub _drop_indexes 9645{ 9646 my ($self, $table, %indexes) = @_; 9647 9648 my $tbsaved = $table; 9649 $table = $self->get_replaced_tbname($table); 9650 9651 my @out = (); 9652 # Set the index definition 9653 foreach my $idx (keys %indexes) 9654 { 9655 # Cluster, bitmap join, reversed and IOT indexes will not be exported at all 9656 next if ($self->{tables}{$tbsaved}{idx_type}{$idx}{type} =~ /JOIN|IOT|CLUSTER|REV/i); 9657 9658 if (exists $self->{replaced_cols}{"\L$tbsaved\E"} && $self->{replaced_cols}{"\L$tbsaved\E"}) 9659 { 9660 foreach my $c (keys %{$self->{replaced_cols}{"\L$tbsaved\E"}}) 9661 { 9662 map { s/\b$c\b/$self->{replaced_cols}{"\L$tbsaved\E"}{"\L$c\E"}/i } @{$indexes{$idx}}; 9663 } 9664 } 9665 map { if ($_ !~ /\(.*\)/) { $_ = $self->quote_object_name($_) } } @{$indexes{$idx}}; 9666 9667 my $columns = ''; 9668 foreach my $s (@{$indexes{$idx}}) 9669 { 9670 if ($s =~ /\|\|/) { 9671 $columns .= '(' . $s . ')'; 9672 } else { 9673 $columns .= ((exists $opclass_type{$s}) ? $opclass_type{$s} : $s) . ", "; 9674 } 9675 # Add double quotes on column name if PRESERVE_CASE is enabled 9676 foreach my $c (keys %{$self->{tables}{$tbsaved}{column_info}}) 9677 { 9678 $columns =~ s/\b$c\b/"$c"/ if ($self->{preserve_case} && $columns !~ /"$c"/); 9679 } 9680 } 9681 $columns =~ s/, $//s; 9682 $columns =~ s/\s+//gs; 9683 my $colscompare = $columns; 9684 $colscompare =~ s/"//gs; 9685 my $columnlist = ''; 9686 my $skip_index_creation = 0; 9687 my %pk_hist = (); 9688 9689 foreach my $consname (keys %{$self->{tables}{$tbsaved}{unique_key}}) 9690 { 9691 my $constype = $self->{tables}{$tbsaved}{unique_key}->{$consname}{type}; 9692 next if (($constype ne 'P') && ($constype ne 'U')); 9693 my @conscols = grep(!/^\d+$/, @{$self->{tables}{$tbsaved}{unique_key}->{$consname}{columns}}); 9694 for ($i = 0; $i <= $#conscols; $i++) 9695 { 9696 # Change column names 9697 if (exists $self->{replaced_cols}{"\L$tbsaved\E"}{"\L$conscols[$i]\E"} && $self->{replaced_cols}{"\L$tbsaved\E"}{"\L$conscols[$i]\E"}) { 9698 $conscols[$i] = $self->{replaced_cols}{"\L$tbsaved\E"}{"\L$conscols[$i]\E"}; 9699 } 9700 } 9701 $columnlist = join(',', @conscols); 9702 $columnlist =~ s/"//gs; 9703 $columnlist =~ s/\s+//gs; 9704 if ($constype eq 'P') 9705 { 9706 $pk_hist{$table} = $columnlist; 9707 } 9708 if (lc($columnlist) eq lc($colscompare)) { 9709 $skip_index_creation = 1; 9710 last; 9711 } 9712 } 9713 9714 # Do not create the index if there already a constraint on the same column list 9715 # the index will be automatically created by PostgreSQL at constraint import time. 9716 if (!$skip_index_creation) 9717 { 9718 if ($self->{indexes_renaming}) 9719 { 9720 map { s/"//g; } @{$indexes{$idx}}; 9721 $idx = $self->quote_object_name($table.'_'.join('_', @{$indexes{$idx}})); 9722 $idx = $table . '_' . join('_', @{$indexes{$idx}}); 9723 $idx =~ s/\s+//g; 9724 if ($self->{indexes_suffix}) { 9725 $idx = substr($idx,0,59); 9726 } else { 9727 $idx = substr($idx,0,63); 9728 } 9729 } 9730 if ($self->{tables}{$table}{idx_type}{$idx}{type} =~ /DOMAIN/i && $self->{tables}{$table}{idx_type}{$idx}{type_name} !~ /SPATIAL_INDEX/) 9731 { 9732 $idx = $self->quote_object_name($idx); 9733 push(@out, "-- Declared as DOMAIN index, uncomment line below if it must be removed"); 9734 push(@out, "-- DROP INDEX $self->{pg_supports_ifexists} $idx\L$self->{indexes_suffix}\E;"); 9735 } 9736 else 9737 { 9738 $idx = $self->quote_object_name($idx); 9739 push(@out, "DROP INDEX $self->{pg_supports_ifexists} $idx\L$self->{indexes_suffix}\E;"); 9740 } 9741 } 9742 } 9743 9744 return wantarray ? @out : join("\n", @out); 9745} 9746 9747=head2 _exportable_indexes 9748 9749This function return the indexes that will be exported 9750 9751=cut 9752 9753sub _exportable_indexes 9754{ 9755 my ($self, $table, %indexes) = @_; 9756 9757 my @out = (); 9758 # Set the index definition 9759 foreach my $idx (keys %indexes) 9760 { 9761 9762 map { if ($_ !~ /\(.*\)/) { s/^/"/; s/$/"/; } } @{$indexes{$idx}}; 9763 map { s/"//gs } @{$indexes{$idx}}; 9764 my $columns = join(',', @{$indexes{$idx}}); 9765 my $colscompare = $columns; 9766 my $columnlist = ''; 9767 my $skip_index_creation = 0; 9768 foreach my $consname (keys %{$self->{tables}{$table}{unique_key}}) 9769 { 9770 my $constype = $self->{tables}{$table}{unique_key}->{$consname}{type}; 9771 next if (($constype ne 'P') && ($constype ne 'U')); 9772 my @conscols = @{$self->{tables}{$table}{unique_key}->{$consname}{columns}}; 9773 $columnlist = join(',', @conscols); 9774 $columnlist =~ s/"//gs; 9775 if (lc($columnlist) eq lc($colscompare)) { 9776 $skip_index_creation = 1; 9777 last; 9778 } 9779 } 9780 9781 # The index will not be created 9782 if (!$skip_index_creation) { 9783 push(@out, $idx); 9784 } 9785 } 9786 9787 return @out; 9788} 9789 9790 9791=head2 is_primary_key_column 9792 9793This function return 1 when the specified column is a primary key 9794 9795=cut 9796sub is_primary_key_column 9797{ 9798 my ($self, $table, $col) = @_; 9799 9800 # Set the unique (and primary) key definition 9801 foreach my $consname (keys %{ $self->{tables}{$table}{unique_key} }) { 9802 next if ($self->{tables}{$table}{unique_key}->{$consname}{type} ne 'P'); 9803 my @conscols = @{$self->{tables}{$table}{unique_key}->{$consname}{columns}}; 9804 for (my $i = 0; $i <= $#conscols; $i++) { 9805 if (lc($conscols[$i]) eq lc($col)) { 9806 return 1; 9807 } 9808 } 9809 } 9810 9811 return 0; 9812} 9813 9814 9815=head2 _get_primary_keys 9816 9817This function return SQL code to add primary keys of a create table definition 9818 9819=cut 9820sub _get_primary_keys 9821{ 9822 my ($self, $table, $unique_key) = @_; 9823 9824 my $out = ''; 9825 9826 # Set the unique (and primary) key definition 9827 foreach my $consname (keys %$unique_key) 9828 { 9829 next if ($self->{pkey_in_create} && ($unique_key->{$consname}{type} ne 'P')); 9830 my $constype = $unique_key->{$consname}{type}; 9831 my $constgen = $unique_key->{$consname}{generated}; 9832 my $index_name = $unique_key->{$consname}{index_name}; 9833 my @conscols = @{$unique_key->{$consname}{columns}}; 9834 my %constypenames = ('U' => 'UNIQUE', 'P' => 'PRIMARY KEY'); 9835 my $constypename = $constypenames{$constype}; 9836 for (my $i = 0; $i <= $#conscols; $i++) 9837 { 9838 # Change column names 9839 if (exists $self->{replaced_cols}{"\L$table\E"}{"\L$conscols[$i]\E"} && $self->{replaced_cols}{"\L$table\E"}{"\L$conscols[$i]\E"}) { 9840 $conscols[$i] = $self->{replaced_cols}{"\L$table\E"}{"\L$conscols[$i]\E"}; 9841 } 9842 } 9843 map { $_ = $self->quote_object_name($_) } @conscols; 9844 9845 my $columnlist = join(',', @conscols); 9846 if ($columnlist) 9847 { 9848 if ($self->{pkey_in_create}) 9849 { 9850 if (!$self->{keep_pkey_names} || ($constgen eq 'GENERATED NAME')) { 9851 $out .= "\tPRIMARY KEY ($columnlist)"; 9852 } else { 9853 $out .= "\tCONSTRAINT " . $self->quote_object_name($consname) . " PRIMARY KEY ($columnlist)"; 9854 } 9855 if ($self->{use_tablespace} && $self->{tables}{$table}{idx_tbsp}{$index_name} && !grep(/^$self->{tables}{$table}{idx_tbsp}{$index_name}$/i, @{$self->{default_tablespaces}})) { 9856 $out .= " USING INDEX TABLESPACE " . $self->quote_object_name($self->{tables}{$table}{idx_tbsp}{$index_name}); 9857 } 9858 $out .= ",\n"; 9859 } 9860 } 9861 } 9862 $out =~ s/,$//s; 9863 9864 return $out; 9865} 9866 9867 9868=head2 _create_unique_keys 9869 9870This function return SQL code to create unique and primary keys of a table 9871 9872=cut 9873sub _create_unique_keys 9874{ 9875 my ($self, $table, $unique_key) = @_; 9876 9877 my $out = ''; 9878 9879 my $tbsaved = $table; 9880 $table = $self->get_replaced_tbname($table); 9881 9882 # Set the unique (and primary) key definition 9883 foreach my $consname (keys %$unique_key) 9884 { 9885 next if ($self->{pkey_in_create} && ($unique_key->{$consname}{type} eq 'P')); 9886 my $constype = $unique_key->{$consname}{type}; 9887 my $constgen = $unique_key->{$consname}{generated}; 9888 my $index_name = $unique_key->{$consname}{index_name}; 9889 my $deferrable = $unique_key->{$consname}{deferrable}; 9890 my $deferred = $unique_key->{$consname}{deferred}; 9891 my @conscols = @{$unique_key->{$consname}{columns}}; 9892 # Exclude unique index used in PK when column list is the same 9893 next if (($constype eq 'U') && exists $pkcollist{$table} && ($pkcollist{$table} eq join(",", @conscols))); 9894 9895 my %constypenames = ('U' => 'UNIQUE', 'P' => 'PRIMARY KEY'); 9896 my $constypename = $constypenames{$constype}; 9897 for (my $i = 0; $i <= $#conscols; $i++) 9898 { 9899 # Change column names 9900 if (exists $self->{replaced_cols}{"\L$tbsaved\E"}{"\L$conscols[$i]\E"} && $self->{replaced_cols}{"\L$tbsaved\L"}{"\L$conscols[$i]\E"}) { 9901 $conscols[$i] = $self->{replaced_cols}{"\L$tbsaved\E"}{"\L$conscols[$i]\E"}; 9902 } 9903 } 9904 # Add the partition column if it is not is the PK 9905 if ($constype eq 'P' && exists $self->{partitions_list}{"\L$tbsaved\E"}) 9906 { 9907 for (my $j = 0; $j <= $#{$self->{partitions_list}{"\L$tbsaved\E"}{columns}}; $j++) 9908 { 9909 push(@conscols, $self->{partitions_list}{"\L$tbsaved\E"}{columns}[$j]) if (!grep(/^$self->{partitions_list}{"\L$tbsaved\E"}{columns}[$j]$/i, @conscols)); 9910 } 9911 } 9912 map { $_ = $self->quote_object_name($_) } @conscols; 9913 9914 my $columnlist = join(',', @conscols); 9915 if ($columnlist) 9916 { 9917 if (!$self->{keep_pkey_names} || ($constgen eq 'GENERATED NAME')) { 9918 $out .= "ALTER TABLE $table ADD $constypename ($columnlist)"; 9919 } else { 9920 $out .= "ALTER TABLE $table ADD CONSTRAINT \L$consname\E $constypename ($columnlist)"; 9921 } 9922 if ($self->{use_tablespace} && $self->{tables}{$tbsaved}{idx_tbsp}{$index_name} && !grep(/^$self->{tables}{$tbsaved}{idx_tbsp}{$index_name}$/i, @{$self->{default_tablespaces}})) { 9923 $out .= " USING INDEX TABLESPACE $self->{tables}{$tbsaved}{idx_tbsp}{$index_name}"; 9924 } 9925 if ($deferrable eq "DEFERRABLE") 9926 { 9927 $out .= " DEFERRABLE"; 9928 if ($deferred eq "DEFERRED") { 9929 $out .= " INITIALLY DEFERRED"; 9930 } 9931 } 9932 $out .= ";\n"; 9933 } 9934 } 9935 return $out; 9936} 9937 9938=head2 _create_check_constraint 9939 9940This function return SQL code to create the check constraints of a table 9941 9942=cut 9943sub _create_check_constraint 9944{ 9945 my ($self, $table, $check_constraint, $field_name, @skip_column_check) = @_; 9946 9947 my $tbsaved = $table; 9948 $table = $self->get_replaced_tbname($table); 9949 9950 my $out = ''; 9951 # Set the check constraint definition 9952 foreach my $k (keys %{$check_constraint->{constraint}}) 9953 { 9954 my $chkconstraint = $check_constraint->{constraint}->{$k}{condition}; 9955 my $validate = ''; 9956 $validate = ' NOT VALID' if ($check_constraint->{constraint}->{$k}{validate} eq 'NOT VALIDATED'); 9957 next if (!$chkconstraint); 9958 my $skip_create = 0; 9959 if (exists $check_constraint->{notnull}) 9960 { 9961 foreach my $col (@{$check_constraint->{notnull}}) { 9962 $skip_create = 1, last if (lc($chkconstraint) eq lc("\"$col\" IS NOT NULL")); 9963 } 9964 } 9965 if (!$skip_create) 9966 { 9967 if (exists $self->{replaced_cols}{"\L$tbsaved\E"} && $self->{replaced_cols}{"\L$tbsaved\E"}) 9968 { 9969 foreach my $c (keys %{$self->{replaced_cols}{"\L$tbsaved\E"}}) 9970 { 9971 $chkconstraint =~ s/"$c"/"$self->{replaced_cols}{"\L$tbsaved\E"}{"\L$c\E"}"/gsi; 9972 $chkconstraint =~ s/\b$c\b/$self->{replaced_cols}{"\L$tbsaved\E"}{"\L$c\E"}/gsi; 9973 } 9974 } 9975 if ($self->{plsql_pgsql}) { 9976 $chkconstraint = Ora2Pg::PLSQL::convert_plsql_code($self, $chkconstraint); 9977 } 9978 foreach my $c (@$field_name) 9979 { 9980 my $ret = $self->quote_object_name($c); 9981 $chkconstraint =~ s/\b$c\b/$ret/igs; 9982 $chkconstraint =~ s/""/"/igs; 9983 } 9984 $k = $self->quote_object_name($k); 9985 9986 # If the column has been converted as a boolean do not export the constraint 9987 my $converted_as_boolean = 0; 9988 foreach my $c (@$field_name) 9989 { 9990 if (grep(/^$c$/i, @skip_column_check) && $chkconstraint =~ /\b$c\b/i) { 9991 $converted_as_boolean = 1; 9992 } 9993 } 9994 if (!$converted_as_boolean) 9995 { 9996 $chkconstraint = Ora2Pg::PLSQL::replace_oracle_function($self, $chkconstraint); 9997 $out .= "ALTER TABLE $table ADD CONSTRAINT $k CHECK ($chkconstraint)$validate;\n"; 9998 } 9999 } 10000 } 10001 10002 return $out; 10003} 10004 10005=head2 _create_foreign_keys 10006 10007This function return SQL code to create the foreign keys of a table 10008 10009=cut 10010sub _create_foreign_keys 10011{ 10012 my ($self, $table) = @_; 10013 10014 my @out = (); 10015 10016 my $tbsaved = $table; 10017 $table = $self->get_replaced_tbname($table); 10018 10019 # Add constraint definition 10020 my @done = (); 10021 foreach my $fkname (sort keys %{$self->{tables}{$tbsaved}{foreign_link}}) 10022 { 10023 next if (grep(/^$fkname$/, @done)); 10024 10025 # Extract all attributes if the foreign key definition 10026 my $state; 10027 foreach my $h (@{$self->{tables}{$tbsaved}{foreign_key}}) 10028 { 10029 if (lc($h->[0]) eq lc($fkname)) 10030 { 10031 # @$h : CONSTRAINT_NAME,R_CONSTRAINT_NAME,SEARCH_CONDITION,DELETE_RULE,$deferrable,DEFERRED,R_OWNER,TABLE_NAME,OWNER,UPDATE_RULE,VALIDATED 10032 push(@$state, @$h); 10033 last; 10034 } 10035 } 10036 foreach my $desttable (sort keys %{$self->{tables}{$tbsaved}{foreign_link}{$fkname}{remote}}) 10037 { 10038 push(@done, $fkname); 10039 10040 # This is not possible to reference a partitionned table 10041 next if ($self->{pg_supports_partition} && exists $self->{partitions_list}{lc($desttable)}); 10042 10043 # Foreign key constraint on partitionned table do not support 10044 # NO VALID when the remote table is not partitionned 10045 my $allow_fk_notvalid = 1; 10046 $allow_fk_notvalid = 0 if ($self->{pg_supports_partition} && exists $self->{partitions_list}{lc($tbsaved)}); 10047 my $str = ''; 10048 # Add double quote to column name 10049 map { $_ = '"' . $_ . '"' } @{$self->{tables}{$tbsaved}{foreign_link}{$fkname}{local}}; 10050 map { $_ = '"' . $_ . '"' } @{$self->{tables}{$tbsaved}{foreign_link}{$fkname}{remote}{$desttable}}; 10051 10052 # Get the name of the foreign table after replacement if any 10053 my $subsdesttable = $self->get_replaced_tbname($desttable); 10054 # Prefix the table name with the schema name if owner of 10055 # remote table is not the same as local one 10056 if ($self->{schema} && (lc($state->[6]) ne lc($state->[8]))) { 10057 $subsdesttable = $self->quote_object_name($state->[6]) . '.' . $subsdesttable; 10058 } 10059 10060 my @lfkeys = (); 10061 push(@lfkeys, @{$self->{tables}{$tbsaved}{foreign_link}{$fkname}{local}}); 10062 if (exists $self->{replaced_cols}{"\L$tbsaved\E"} && $self->{replaced_cols}{"\L$tbsaved\E"}) { 10063 foreach my $c (keys %{$self->{replaced_cols}{"\L$tbsaved\E"}}) { 10064 map { s/"$c"/"$self->{replaced_cols}{"\L$tbsaved\E"}{"\L$c\E"}"/i } @lfkeys; 10065 } 10066 } 10067 my @rfkeys = (); 10068 push(@rfkeys, @{$self->{tables}{$tbsaved}{foreign_link}{$fkname}{remote}{$desttable}}); 10069 if (exists $self->{replaced_cols}{"\L$desttable\E"} && $self->{replaced_cols}{"\L$desttable\E"}) 10070 { 10071 foreach my $c (keys %{$self->{replaced_cols}{"\L$desttable\E"}}) { 10072 map { s/"$c"/"$self->{replaced_cols}{"\L$desttable\E"}{"\L$c\E"}"/i } @rfkeys; 10073 } 10074 } 10075 for (my $i = 0; $i <= $#lfkeys; $i++) { 10076 $lfkeys[$i] = $self->quote_object_name(split(/\s*,\s*/, $lfkeys[$i])); 10077 } 10078 for (my $i = 0; $i <= $#rfkeys; $i++) { 10079 $rfkeys[$i] = $self->quote_object_name(split(/\s*,\s*/, $rfkeys[$i])); 10080 } 10081 $fkname = $self->quote_object_name($fkname); 10082 $str .= "ALTER TABLE $table ADD CONSTRAINT $fkname FOREIGN KEY (" . join(',', @lfkeys) . ") REFERENCES $subsdesttable(" . join(',', @rfkeys) . ")"; 10083 $str .= " MATCH $state->[2]" if ($state->[2]); 10084 if ($state->[3]) { 10085 $str .= " ON DELETE $state->[3]"; 10086 } else { 10087 $str .= " ON DELETE NO ACTION"; 10088 } 10089 if ($self->{is_mysql}) { 10090 $str .= " ON UPDATE $state->[9]" if ($state->[9]); 10091 } else { 10092 if ( ($self->{fkey_add_update} eq 'ALWAYS') || ( ($self->{fkey_add_update} eq 'DELETE') && ($str =~ /ON DELETE CASCADE/) ) ) { 10093 $str .= " ON UPDATE CASCADE"; 10094 } 10095 } 10096 # if DEFER_FKEY is enabled, force constraint to be 10097 # deferrable and defer it initially. 10098 if (!$self->{is_mysql}) 10099 { 10100 $str .= (($self->{'defer_fkey'} ) ? ' DEFERRABLE' : " $state->[4]") if ($state->[4]); 10101 $state->[5] = 'DEFERRED' if ($state->[5] =~ /^Y/); 10102 $state->[5] ||= 'IMMEDIATE'; 10103 $str .= " INITIALLY " . ( ($self->{'defer_fkey'} ) ? 'DEFERRED' : $state->[5] ); 10104 if ($allow_fk_notvalid && $state->[9] eq 'NOT VALIDATED') { 10105 $str .= " NOT VALID"; 10106 } 10107 } 10108 $str .= ";\n"; 10109 push(@out, $str); 10110 } 10111 } 10112 10113 return wantarray ? @out : join("\n", @out); 10114} 10115 10116=head2 _drop_foreign_keys 10117 10118This function return SQL code to the foreign keys of a table 10119 10120=cut 10121sub _drop_foreign_keys 10122{ 10123 my ($self, $table, @foreign_key) = @_; 10124 10125 my @out = (); 10126 10127 $table = $self->get_replaced_tbname($table); 10128 10129 # Add constraint definition 10130 my @done = (); 10131 foreach my $h (@foreign_key) { 10132 next if (grep(/^$h->[0]$/, @done)); 10133 push(@done, $h->[0]); 10134 my $str = ''; 10135 $h->[0] = $self->quote_object_name($h->[0]); 10136 $str .= "ALTER TABLE $table DROP CONSTRAINT $self->{pg_supports_ifexists} $h->[0];"; 10137 push(@out, $str); 10138 } 10139 10140 return wantarray ? @out : join("\n", @out); 10141} 10142 10143 10144=head2 _extract_sequence_info 10145 10146This function retrieves the last value returned from the sequences in the 10147Oracle database. The result is a SQL script assigning the new start values 10148to the sequences found in the Oracle database. 10149 10150=cut 10151sub _extract_sequence_info 10152{ 10153 my $self = shift; 10154 10155 return Ora2Pg::MySQL::_extract_sequence_info($self) if ($self->{is_mysql}); 10156 10157 my $sql = "SELECT DISTINCT SEQUENCE_NAME, MIN_VALUE, MAX_VALUE, INCREMENT_BY, CYCLE_FLAG, ORDER_FLAG, CACHE_SIZE, LAST_NUMBER,SEQUENCE_OWNER FROM $self->{prefix}_SEQUENCES"; 10158 if ($self->{schema}) { 10159 $sql .= " WHERE SEQUENCE_OWNER='$self->{schema}'"; 10160 } else { 10161 $sql .= " WHERE SEQUENCE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 10162 } 10163 $sql .= $self->limit_to_objects('SEQUENCE','SEQUENCE_NAME'); 10164 10165 my @script = (); 10166 10167 my $sth = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr ."\n", 0, 1); 10168 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 10169 10170 while (my $seq_info = $sth->fetchrow_hashref) { 10171 10172 my $seqname = $seq_info->{SEQUENCE_NAME}; 10173 if (!$self->{schema} && $self->{export_schema}) { 10174 $seqname = $seq_info->{SEQUENCE_OWNER} . '.' . $seq_info->{SEQUENCE_NAME}; 10175 } 10176 10177 my $nextvalue = $seq_info->{LAST_NUMBER} + $seq_info->{INCREMENT_BY}; 10178 my $alter = "ALTER SEQUENCE $self->{pg_supports_ifexists} " . $self->quote_object_name($seqname) . " RESTART WITH $nextvalue;"; 10179 push(@script, $alter); 10180 $self->logit("Extracted sequence information for sequence \"$seqname\"\n", 1); 10181 } 10182 $sth->finish(); 10183 10184 return @script; 10185 10186} 10187 10188 10189=head2 _howto_get_data TABLE 10190 10191This function implements an Oracle-native data extraction. 10192 10193Returns the SQL query to use to retrieve data 10194 10195=cut 10196 10197sub _howto_get_data 10198{ 10199 my ($self, $table, $name, $type, $src_type, $part_name, $is_subpart) = @_; 10200 10201 # Fix a problem when the table need to be prefixed by the schema 10202 my $realtable = $table; 10203 $realtable =~ s/\"//g; 10204 # Do not use double quote with mysql, but backquote 10205 if (!$self->{is_mysql}) 10206 { 10207 if (!$self->{schema} && $self->{export_schema}) 10208 { 10209 $realtable =~ s/\./"."/; 10210 $realtable = "\"$realtable\""; 10211 } 10212 else 10213 { 10214 $realtable = "\"$realtable\""; 10215 my $owner = $self->{tables}{$table}{table_info}{owner} || $self->{tables}{$table}{owner} || ''; 10216 if ($owner) 10217 { 10218 $owner =~ s/\"//g; 10219 $owner = "\"$owner\""; 10220 $realtable = "$owner.$realtable"; 10221 } 10222 } 10223 } 10224 else 10225 { 10226 $realtable = "\`$realtable\`"; 10227 } 10228 10229 delete $self->{nullable}{$table}; 10230 10231 my $alias = 'a'; 10232 my $str = "SELECT "; 10233 if ($self->{tables}{$table}{table_info}{nested} eq 'YES') { 10234 $str = "SELECT /* nested_table_get_refs */ "; 10235 } 10236 10237 my $extraStr = ""; 10238 # Lookup through columns information 10239 if ($#{$name} < 0) 10240 { 10241 # There a problem whe can't find any column in this table 10242 return ''; 10243 } 10244 else 10245 { 10246 for my $k (0 .. $#{$name}) 10247 { 10248 my $realcolname = $name->[$k]->[0]; 10249 my $spatial_srid = ''; 10250 $self->{nullable}{$table}{$k} = $self->{colinfo}->{$table}{$realcolname}{nullable}; 10251 if ($name->[$k]->[0] !~ /"/) 10252 { 10253 # Do not use double quote with mysql 10254 if (!$self->{is_mysql}) { 10255 $name->[$k]->[0] = '"' . $name->[$k]->[0] . '"'; 10256 } else { 10257 $name->[$k]->[0] = '`' . $name->[$k]->[0] . '`'; 10258 } 10259 } 10260 if ( ( $src_type->[$k] =~ /^char/i) && ($type->[$k] =~ /(varchar|text)/i)) { 10261 $str .= "trim($self->{trim_type} '$self->{trim_char}' FROM $name->[$k]->[0]) AS $name->[$k]->[0],"; 10262 } elsif ($self->{is_mysql} && $src_type->[$k] =~ /bit/i) { 10263 $str .= "BIN($name->[$k]->[0]),"; 10264 } 10265 # If dest type is bytea the content of the file is exported as bytea 10266 elsif ( ($src_type->[$k] =~ /bfile/i) && ($type->[$k] =~ /bytea/i) ) 10267 { 10268 $self->{bfile_found} = 'bytea'; 10269 $str .= "ora2pg_get_bfile($name->[$k]->[0]),"; 10270 } 10271 # If dest type is efile the content of the file is exported to use the efile extension 10272 elsif ( ($src_type->[$k] =~ /bfile/i) && ($type->[$k] =~ /efile/i) ) 10273 { 10274 $self->{bfile_found} = 'efile'; 10275 $str .= "ora2pg_get_efile($name->[$k]->[0]),"; 10276 } 10277 # Only extract path to the bfile if dest type is text. 10278 elsif ( ($src_type->[$k] =~ /bfile/i) && ($type->[$k] =~ /text/i) ) 10279 { 10280 $self->{bfile_found} = 'text'; 10281 $str .= "ora2pg_get_bfilename($name->[$k]->[0]),"; 10282 } 10283 elsif ( $src_type->[$k] =~ /xmltype/i) 10284 { 10285 if ($self->{xml_pretty}) { 10286 $str .= "$alias.$name->[$k]->[0].extract('/').getStringVal(),"; 10287 } else { 10288 $str .= "$alias.$name->[$k]->[0].extract('/').getClobVal(),"; 10289 } 10290 } 10291 # ArcGis Geometries 10292 elsif ( !$self->{is_mysql} && $src_type->[$k] =~ /^(ST_|STGEOM_)/i) 10293 { 10294 if ($self->{geometry_extract_type} eq 'WKB') { 10295 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN SDE.ST_ASBINARY($name->[$k]->[0]) ELSE NULL END,"; 10296 } else { 10297 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN SDE.ST_ASTEXT($name->[$k]->[0]) ELSE NULL END,"; 10298 } 10299 } 10300 # Oracle geometries 10301 elsif ( !$self->{is_mysql} && $src_type->[$k] =~ /SDO_GEOMETRY/i) 10302 { 10303 10304 # Set SQL query to get the SRID of the column 10305 if ($self->{convert_srid} > 1) { 10306 $spatial_srid = $self->{convert_srid}; 10307 } else { 10308 $spatial_srid = $self->{colinfo}->{$table}{$realcolname}{spatial_srid}; 10309 } 10310 10311 # With INSERT statement we always use WKT 10312 if ($self->{type} eq 'INSERT') 10313 { 10314 if ($self->{geometry_extract_type} eq 'WKB') { 10315 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN SDO_UTIL.TO_WKBGEOMETRY($name->[$k]->[0]) ELSE NULL END,"; 10316 } elsif ($self->{geometry_extract_type} eq 'INTERNAL') { 10317 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN $name->[$k]->[0] ELSE NULL END,"; 10318 } else { 10319 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN 'ST_GeomFromText('''||SDO_UTIL.TO_WKTGEOMETRY($name->[$k]->[0])||''','||($spatial_srid)||')' ELSE NULL END,"; 10320 } 10321 } 10322 else 10323 { 10324 if ($self->{geometry_extract_type} eq 'WKB') { 10325 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN SDO_UTIL.TO_WKBGEOMETRY($name->[$k]->[0]) ELSE NULL END,"; 10326 } elsif ($self->{geometry_extract_type} eq 'INTERNAL') { 10327 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN $name->[$k]->[0] ELSE NULL END,"; 10328 } else { 10329 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN SDO_UTIL.TO_WKTGEOMETRY($name->[$k]->[0]) ELSE NULL END,"; 10330 } 10331 } 10332 } 10333 elsif ( $self->{is_mysql} && $src_type->[$k] =~ /geometry/i) 10334 { 10335 if ($self->{db_version} < '5.7.6') 10336 { 10337 if ($self->{geometry_extract_type} eq 'WKB') { 10338 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN CONCAT('SRID=',SRID($name->[$k]->[0]),';', AsBinary($name->[$k]->[0])) ELSE NULL END,"; 10339 } else { 10340 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN CONCAT('SRID=',SRID($name->[$k]->[0]),';', AsText($name->[$k]->[0])) ELSE NULL END,"; 10341 } 10342 } 10343 else 10344 { 10345 if ($self->{geometry_extract_type} eq 'WKB') { 10346 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN CONCAT('SRID=',ST_Srid($name->[$k]->[0]),';', ST_AsBinary($name->[$k]->[0])) ELSE NULL END,"; 10347 } else { 10348 $str .= "CASE WHEN $name->[$k]->[0] IS NOT NULL THEN CONCAT('SRID=',ST_Srid($name->[$k]->[0]),';', ST_AsText($name->[$k]->[0])) ELSE NULL END,"; 10349 } 10350 } 10351 } 10352 elsif ( !$self->{is_mysql} && (($src_type->[$k] =~ /clob/i) || ($src_type->[$k] =~ /blob/i)) ) 10353 { 10354 if (!$self->{enable_blob_export} && $src_type->[$k] =~ /blob/i) { 10355 # user don't want to export blob 10356 next; 10357 } 10358 if ($self->{empty_lob_null}) { 10359 $str .= "CASE WHEN dbms_lob.getlength($name->[$k]->[0]) = 0 THEN NULL ELSE $name->[$k]->[0] END,"; 10360 } else { 10361 $str .= "$name->[$k]->[0],"; 10362 } 10363 } 10364 else 10365 { 10366 $str .= "$name->[$k]->[0],"; 10367 10368 } 10369 push(@{$self->{spatial_srid}{$table}}, $spatial_srid); 10370 10371 if ($type->[$k] =~ /bytea/i && $self->{enable_blob_export}) 10372 { 10373 if ($self->{data_limit} >= 1000) 10374 { 10375 $self->{local_data_limit}{$table} = int($self->{data_limit}/10); 10376 while ($self->{local_data_limit}{$table} > 1000) { 10377 $self->{local_data_limit}{$table} = int($self->{local_data_limit}{$table}/10); 10378 } 10379 } 10380 else 10381 { 10382 $self->{local_data_limit}{$table} = $self->{data_limit}; 10383 } 10384 $self->{local_data_limit}{$table} = $self->{blob_limit} if ($self->{blob_limit}); 10385 } 10386 } 10387 $str =~ s/,$//; 10388 } 10389 10390 # If we have a BFILE that might be exported as text we need to create a function 10391 my $bfile_function = ''; 10392 if ($self->{bfile_found} eq 'text') { 10393 $self->logit("Creating function ora2pg_get_bfilename( p_bfile IN BFILE ) to retrieve path from BFILE.\n", 1); 10394 $bfile_function = qq{ 10395CREATE OR REPLACE FUNCTION ora2pg_get_bfilename( p_bfile IN BFILE ) RETURN 10396VARCHAR2 10397 AS 10398 l_dir VARCHAR2(4000); 10399 l_fname VARCHAR2(4000); 10400 l_path VARCHAR2(4000); 10401 BEGIN 10402 IF p_bfile IS NULL 10403 THEN RETURN NULL; 10404 ELSE 10405 dbms_lob.FILEGETNAME( p_bfile, l_dir, l_fname ); 10406 SELECT DIRECTORY_PATH INTO l_path FROM $self->{prefix}_DIRECTORIES WHERE DIRECTORY_NAME = l_dir; 10407 l_dir := rtrim(l_path,'/'); 10408 RETURN l_dir || '/' || l_fname; 10409 END IF; 10410 END; 10411}; 10412 # If we have a BFILE that might be exported as efile we need to create a function 10413 } elsif ($self->{bfile_found} eq 'efile') { 10414 $self->logit("Creating function ora2pg_get_efile( p_bfile IN BFILE ) to retrieve EFILE from BFILE.\n", 1); 10415 my $quote = ''; 10416 $quote = "''" if ($self->{type} eq 'INSERT'); 10417 $bfile_function = qq{ 10418CREATE OR REPLACE FUNCTION ora2pg_get_efile( p_bfile IN BFILE ) RETURN 10419VARCHAR2 10420 AS 10421 l_dir VARCHAR2(4000); 10422 l_fname VARCHAR2(4000); 10423 BEGIN 10424 IF p_bfile IS NULL THEN 10425 RETURN NULL; 10426 ELSE 10427 dbms_lob.FILEGETNAME( p_bfile, l_dir, l_fname ); 10428 RETURN '($quote' || l_dir || '$quote,$quote' || l_fname || '$quote)'; 10429 END IF; 10430 END; 10431}; 10432 # If we have a BFILE that might be exported as bytea we need to create a 10433 # function that exports the bfile as a binary BLOB, a HEX encoded string 10434 } 10435 elsif ($self->{bfile_found} eq 'bytea') 10436 { 10437 $self->logit("Creating function ora2pg_get_bfile( p_bfile IN BFILE ) to retrieve BFILE content as BLOB.\n", 1); 10438 $bfile_function = qq{ 10439CREATE OR REPLACE FUNCTION ora2pg_get_bfile( p_bfile IN BFILE ) RETURN 10440BLOB AS 10441 filecontent BLOB := NULL; 10442 src_file BFILE := NULL; 10443 l_step PLS_INTEGER := 12000; 10444 l_dir VARCHAR2(4000); 10445 l_fname VARCHAR2(4000); 10446 offset NUMBER := 1; 10447BEGIN 10448 IF p_bfile IS NULL THEN 10449 RETURN NULL; 10450 END IF; 10451 10452 DBMS_LOB.FILEGETNAME( p_bfile, l_dir, l_fname ); 10453 src_file := BFILENAME( l_dir, l_fname ); 10454 IF src_file IS NULL THEN 10455 RETURN NULL; 10456 END IF; 10457 10458 DBMS_LOB.FILEOPEN(src_file, DBMS_LOB.FILE_READONLY); 10459 DBMS_LOB.CREATETEMPORARY(filecontent, true); 10460 DBMS_LOB.LOADBLOBFROMFILE (filecontent, src_file, DBMS_LOB.LOBMAXSIZE, offset, offset); 10461 DBMS_LOB.FILECLOSE(src_file); 10462 RETURN filecontent; 10463END; 10464}; 10465 } 10466 10467 if ($bfile_function) 10468 { 10469 my $local_dbh = $self->_oracle_connection(); 10470 my $sth2 = $local_dbh->do($bfile_function); 10471 $local_dbh->disconnect() if ($local_dbh); 10472 } 10473 10474 # Fix empty column list with nested table 10475 $str =~ s/ ""$/ \*/; 10476 10477 if ($part_name) 10478 { 10479 if ($is_subpart) { 10480 $alias = "SUBPARTITION($part_name) a"; 10481 } else { 10482 $alias = "PARTITION($part_name) a"; 10483 } 10484 } 10485 # Force parallelism on Oracle side 10486 if ($self->{default_parallelism_degree} > 1) 10487 { 10488 # Only if the number of rows is upper than PARALLEL_MIN_ROWS 10489 $self->{tables}{$table}{table_info}{num_rows} ||= 0; 10490 if ($self->{tables}{"\L$table\E"}{table_info}{num_rows} > $self->{parallel_min_rows}) { 10491 $str =~ s#^SELECT #SELECT /*+ FULL(a) PARALLEL(a, $self->{default_parallelism_degree}) */ #; 10492 } 10493 } 10494 $str .= " FROM $realtable $alias"; 10495 10496 if (exists $self->{where}{"\L$table\E"} && $self->{where}{"\L$table\E"}) 10497 { 10498 ($str =~ / WHERE /) ? $str .= ' AND ' : $str .= ' WHERE '; 10499 if (!$self->{is_mysql} || ($self->{where}{"\L$table\E"} !~ /\s+LIMIT\s+\d/)) { 10500 $str .= '(' . $self->{where}{"\L$table\E"} . ')'; 10501 } else { 10502 $str .= $self->{where}{"\L$table\E"}; 10503 } 10504 $self->logit("\tApplying WHERE clause on table: " . $self->{where}{"\L$table\E"} . "\n", 1); 10505 } 10506 elsif ($self->{global_where}) 10507 { 10508 ($str =~ / WHERE /) ? $str .= ' AND ' : $str .= ' WHERE '; 10509 if (!$self->{is_mysql} || ($self->{global_where} !~ /\s+LIMIT\s+\d/)) { 10510 $str .= '(' . $self->{global_where} . ')'; 10511 } else { 10512 $str .= $self->{global_where}; 10513 } 10514 $self->logit("\tApplying WHERE global clause: " . $self->{global_where} . "\n", 1); 10515 } 10516 10517 # Automatically set the column on which query will be splitted 10518 # to the first column with a unique key and of type NUMBER. 10519 if ($self->{oracle_copies} > 1) 10520 { 10521 if (!exists $self->{defined_pk}{"\L$table\E"}) 10522 { 10523 foreach my $consname (keys %{$self->{tables}{$table}{unique_key}}) 10524 { 10525 my $constype = $self->{tables}{$table}{unique_key}->{$consname}{type}; 10526 if (($constype eq 'P') || ($constype eq 'U')) 10527 { 10528 foreach my $c (@{$self->{tables}{$table}{unique_key}->{$consname}{columns}}) 10529 { 10530 for my $k (0 .. $#{$name}) 10531 { 10532 my $realcolname = $name->[$k]->[0]; 10533 $realcolname =~ s/"//g; 10534 if ($c eq $realcolname) 10535 { 10536 if ($src_type->[$k] =~ /^number\(.*,.*\)/i) 10537 { 10538 $self->{defined_pk}{"\L$table\E"} = "ROUND($c)"; 10539 last; 10540 } 10541 elsif ($src_type->[$k] =~ /^number/i) 10542 { 10543 $self->{defined_pk}{"\L$table\E"} = $c; 10544 last; 10545 } 10546 } 10547 } 10548 last if (exists $self->{defined_pk}{"\L$table\E"}); 10549 } 10550 } 10551 last if (exists $self->{defined_pk}{"\L$table\E"}); 10552 } 10553 } 10554 if ($self->{defined_pk}{"\L$table\E"}) 10555 { 10556 my $colpk = $self->{defined_pk}{"\L$table\E"}; 10557 if ($self->{preserve_case}) { 10558 $colpk = '"' . $colpk . '"'; 10559 } 10560 if ($str =~ / WHERE /) { 10561 $str .= " AND"; 10562 } else { 10563 $str .= " WHERE"; 10564 } 10565 $str .= " ABS(MOD($colpk, $self->{oracle_copies})) = ?"; 10566 } 10567 } 10568 10569 $self->logit("DEGUG: Query sent to Oracle: $str\n", 1); 10570 10571 return $str; 10572} 10573 10574=head2 _howto_get_fdw_data TABLE 10575 10576This function implements an Oracle data extraction through oracle_fdw. 10577Returns the SQL query to use to retrieve data 10578 10579=cut 10580 10581sub _howto_get_fdw_data 10582{ 10583 my ($self, $table, $name, $type, $src_type, $part_name, $is_subpart) = @_; 10584 10585 # Fix a problem when the table need to be prefixed by the schema 10586 my $realtable = $table; 10587 $realtable =~ s/\"//g; 10588 # Do not use double quote with mysql, but backquote 10589 if (!$self->{is_mysql}) 10590 { 10591 if (!$self->{schema} && $self->{export_schema}) 10592 { 10593 $realtable =~ s/\./"."/; 10594 $realtable = "\"$realtable\""; 10595 } 10596 else 10597 { 10598 $realtable = "\"$realtable\""; 10599 my $owner = $self->{tables}{$table}{table_info}{owner} || $self->{tables}{$table}{owner} || ''; 10600 if ($owner) 10601 { 10602 $owner =~ s/\"//g; 10603 $owner = "\"$owner\""; 10604 $realtable = "$owner.$realtable"; 10605 } 10606 } 10607 } 10608 else 10609 { 10610 $realtable = "\`$realtable\`"; 10611 } 10612 10613 delete $self->{nullable}{$table}; 10614 10615 my $alias = 'a'; 10616 my $str = "SELECT "; 10617 10618 my $extraStr = ""; 10619 # Lookup through columns information 10620 if ($#{$name} < 0) 10621 { 10622 # There a problem whe can't find any column in this table 10623 return ''; 10624 } 10625 else 10626 { 10627 for my $k (0 .. $#{$name}) 10628 { 10629 my $realcolname = $name->[$k]->[0]; 10630 my $spatial_srid = ''; 10631 $self->{nullable}{$table}{$k} = $self->{colinfo}->{$table}{$realcolname}{nullable}; 10632 if ($name->[$k]->[0] !~ /"/) 10633 { 10634 # Do not use double quote with mysql 10635 if (!$self->{is_mysql}) { 10636 $name->[$k]->[0] = '"' . $name->[$k]->[0] . '"'; 10637 } else { 10638 $name->[$k]->[0] = '`' . $name->[$k]->[0] . '`'; 10639 } 10640 } 10641 # If dest type is bytea the content of the file is exported as bytea 10642 if ( ($src_type->[$k] =~ /bfile/i) && ($type->[$k] =~ /bytea/i) ) 10643 { 10644 $self->{bfile_found} = 'bytea'; 10645 } 10646 # If dest type is efile the content of the file is exported to use the efile extension 10647 elsif ( ($src_type->[$k] =~ /bfile/i) && ($type->[$k] =~ /efile/i) ) 10648 { 10649 $self->{bfile_found} = 'efile'; 10650 $self->logit("FATAL: with oracle_fdw data export, BFILE can only be converted to bytea\n", 0, 1); 10651 } 10652 # Only extract path to the bfile if dest type is text. 10653 elsif ( ($src_type->[$k] =~ /bfile/i) && ($type->[$k] =~ /text/i) ) 10654 { 10655 $self->{bfile_found} = 'text'; 10656 $self->logit("FATAL: with oracle_fdw data export, BFILE can only be converted to bytea\n", 0, 1); 10657 } 10658 $str .= "$name->[$k]->[0],"; 10659 10660 push(@{$self->{spatial_srid}{$table}}, $spatial_srid); 10661 # Wit oracle_fdw export we migrate data in stream not in chunk 10662 $self->{data_limit} = 0; 10663 $self->{local_data_limit}{$table} = 0; 10664 $self->{blob_limit} = 0; 10665 } 10666 $str =~ s/,$//; 10667 } 10668 $str .= " FROM $realtable $alias"; 10669 10670 if (exists $self->{where}{"\L$table\E"} && $self->{where}{"\L$table\E"}) 10671 { 10672 ($str =~ / WHERE /) ? $str .= ' AND ' : $str .= ' WHERE '; 10673 if (!$self->{is_mysql} || ($self->{where}{"\L$table\E"} !~ /\s+LIMIT\s+\d/)) { 10674 $str .= '(' . $self->{where}{"\L$table\E"} . ')'; 10675 } else { 10676 $str .= $self->{where}{"\L$table\E"}; 10677 } 10678 $self->logit("\tApplying WHERE clause on table: " . $self->{where}{"\L$table\E"} . "\n", 1); 10679 } 10680 elsif ($self->{global_where}) 10681 { 10682 ($str =~ / WHERE /) ? $str .= ' AND ' : $str .= ' WHERE '; 10683 if (!$self->{is_mysql} || ($self->{global_where} !~ /\s+LIMIT\s+\d/)) { 10684 $str .= '(' . $self->{global_where} . ')'; 10685 } else { 10686 $str .= $self->{global_where}; 10687 } 10688 $self->logit("\tApplying WHERE global clause: " . $self->{global_where} . "\n", 1); 10689 } 10690 10691 # Automatically set the column on which query will be splitted 10692 # to the first column with a unique key and of type NUMBER. 10693 if ($self->{oracle_copies} > 1) 10694 { 10695 if (!exists $self->{defined_pk}{"\L$table\E"}) 10696 { 10697 foreach my $consname (keys %{$self->{tables}{$table}{unique_key}}) 10698 { 10699 my $constype = $self->{tables}{$table}{unique_key}->{$consname}{type}; 10700 if (($constype eq 'P') || ($constype eq 'U')) 10701 { 10702 foreach my $c (@{$self->{tables}{$table}{unique_key}->{$consname}{columns}}) 10703 { 10704 for my $k (0 .. $#{$name}) 10705 { 10706 my $realcolname = $name->[$k]->[0]; 10707 $realcolname =~ s/"//g; 10708 if ($c eq $realcolname) 10709 { 10710 if ($src_type->[$k] =~ /^number\(.*,.*\)/i) 10711 { 10712 $self->{defined_pk}{"\L$table\E"} = "ROUND($c)"; 10713 last; 10714 } 10715 elsif ($src_type->[$k] =~ /^number/i) 10716 { 10717 $self->{defined_pk}{"\L$table\E"} = $c; 10718 last; 10719 } 10720 } 10721 } 10722 last if (exists $self->{defined_pk}{"\L$table\E"}); 10723 } 10724 } 10725 last if (exists $self->{defined_pk}{"\L$table\E"}); 10726 } 10727 } 10728 if ($self->{defined_pk}{"\L$table\E"}) 10729 { 10730 my $colpk = $self->{defined_pk}{"\L$table\E"}; 10731 if ($self->{preserve_case}) { 10732 $colpk = '"' . $colpk . '"'; 10733 } 10734 if ($str =~ / WHERE /) { 10735 $str .= " AND"; 10736 } else { 10737 $str .= " WHERE"; 10738 } 10739 $str .= " ABS(MOD($colpk, $self->{oracle_copies})) = ?"; 10740 } 10741 } 10742 10743 $self->logit("DEGUG: Query sent to Oracle: $str\n", 1); 10744 10745 return $str; 10746} 10747 10748 10749=head2 _sql_type INTERNAL_TYPE LENGTH PRECISION SCALE 10750 10751This function returns the PostgreSQL data type corresponding to the 10752Oracle data type. 10753 10754=cut 10755 10756sub _sql_type 10757{ 10758 my ($self, $type, $len, $precision, $scale, $default) = @_; 10759 10760 $type = uc($type); # Force uppercase 10761 10762 if ($self->{is_mysql}) { 10763 return Ora2Pg::MySQL::_sql_type($self, $type, $len, $precision, $scale); 10764 } 10765 10766 my $data_type = ''; 10767 10768 # Simplify timestamp type 10769 $type =~ s/TIMESTAMP\(\d+\)/TIMESTAMP/; 10770 10771 # Interval precision for year/month/day is not supported by PostgreSQL 10772 if ($type =~ /INTERVAL/) { 10773 $type =~ s/(INTERVAL\s+YEAR)\s*\(\d+\)/$1/; 10774 $type =~ s/(INTERVAL\s+YEAR\s+TO\s+MONTH)\s*\(\d+\)/$1/; 10775 $type =~ s/(INTERVAL\s+DAY)\s*\(\d+\)/$1/; 10776 # maximum precision allowed for seconds is 6 10777 if ($type =~ /INTERVAL\s+DAY\s+TO\s+SECOND\s*\((\d+)\)/) { 10778 if ($1 > 6) { 10779 $type =~ s/(INTERVAL\s+DAY\s+TO\s+SECOND)\s*\(\d+\)/$1(6)/; 10780 } 10781 } 10782 } 10783 10784 # Overide the length 10785 if ( ($type eq 'NUMBER') && $precision ) { 10786 $len = $precision; 10787 return $self->{data_type}{'NUMBER(*)'} if ($scale eq '0' && exists $self->{data_type}{'NUMBER(*)'}); 10788 } elsif ( ($type eq 'NUMBER') && ($len == 38) ) { 10789 if ($scale eq '0' && $precision eq '') { 10790 # Allow custom type rewrite for NUMBER(*,0) 10791 return $self->{data_type}{'NUMBER(*,0)'} if (exists $self->{data_type}{'NUMBER(*,0)'}); 10792 } 10793 $precision = $len; 10794 } elsif ( $type =~ /CHAR/ && $len && exists $self->{data_type}{"$type($len)"}) { 10795 return $self->{data_type}{"$type($len)"}; 10796 } elsif ( $type =~ /RAW/ && $len && exists $self->{data_type}{"$type($len)"}) { 10797 return $self->{data_type}{"$type($len)"}; 10798 } elsif ( $type =~ /RAW/ && $len && $default =~ /sys_guid/i) { 10799 return 'uuid'; 10800 } 10801 10802 # Special case of * precision 10803 if ($precision eq '*') 10804 { 10805 if ($len ne '*') { 10806 $precision = $len; 10807 } else { 10808 $precision = 38; 10809 } 10810 } 10811 10812 if (exists $self->{data_type}{$type}) 10813 { 10814 if ($len) 10815 { 10816 if ( ($type eq "CHAR") || ($type eq "NCHAR") || ($type =~ /VARCHAR/) ) 10817 { 10818 # Type CHAR have default length set to 1 10819 # Type VARCHAR(2) must have a specified length 10820 $len = 1 if (!$len && (($type eq "CHAR") || ($type eq "NCHAR")) ); 10821 return "$self->{data_type}{$type}($len)"; 10822 } 10823 elsif ($type eq "NUMBER") 10824 { 10825 # This is an integer 10826 if (!$scale) 10827 { 10828 if ($precision) 10829 { 10830 if (exists $self->{data_type}{"$type($precision)"}) { 10831 return $self->{data_type}{"$type($precision)"}; 10832 } 10833 if ($self->{pg_integer_type}) 10834 { 10835 if ($precision < 5) { 10836 return 'smallint'; 10837 } elsif ($precision <= 9) { 10838 return 'integer'; # The speediest in PG 10839 } elsif ($precision <= 19) { 10840 return 'bigint'; 10841 } else { 10842 return "numeric($precision)"; 10843 } 10844 } 10845 return "numeric($precision)"; 10846 } 10847 elsif ($self->{pg_integer_type}) 10848 { 10849 # Most of the time interger should be enought? 10850 return $self->{default_numeric} || 'bigint'; 10851 } 10852 } 10853 else 10854 { 10855 if (exists $self->{data_type}{"$type($precision,$scale)"}) { 10856 return $self->{data_type}{"$type($precision,$scale)"}; 10857 } 10858 if ($self->{pg_numeric_type}) 10859 { 10860 if ($precision eq '') { 10861 return "decimal(38, $scale)"; 10862 } elsif ($precision <= 6) { 10863 return 'real'; 10864 } elsif ($precision <= 15) { 10865 return 'double precision'; 10866 } 10867 } 10868 $precision = 38 if ($precision eq ''); 10869 return "decimal($precision,$scale)"; 10870 } 10871 } 10872 return "$self->{data_type}{$type}"; 10873 } 10874 else 10875 { 10876 if (($type eq 'NUMBER') && $self->{pg_integer_type}) { 10877 return $self->{default_numeric}; 10878 } else { 10879 return $self->{data_type}{$type}; 10880 } 10881 } 10882 } 10883 10884 return $type; 10885} 10886 10887 10888=head2 _column_info TABLE OWNER 10889 10890This function implements an Oracle-native column information. 10891 10892Returns a list of array references containing the following information 10893elements for each column the specified table 10894 10895[( 10896 column name, 10897 column type, 10898 column length, 10899 nullable column, 10900 default value 10901 ... 10902)] 10903 10904=cut 10905 10906sub _column_info 10907{ 10908 my ($self, $table, $owner, $objtype, $recurs) = @_; 10909 10910 return Ora2Pg::MySQL::_column_info($self,'',$owner,'TABLE') if ($self->{is_mysql}); 10911 10912 $objtype ||= 'TABLE'; 10913 10914 my $condition = ''; 10915 $condition .= "AND A.TABLE_NAME='$table' " if ($table); 10916 if ($owner) { 10917 $condition .= "AND A.OWNER='$owner' "; 10918 } else { 10919 $condition .= " AND A.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 10920 } 10921 if (!$table) { 10922 $condition .= $self->limit_to_objects('TABLE', 'A.TABLE_NAME'); 10923 } else { 10924 @{$self->{query_bind_params}} = (); 10925 } 10926 10927 my $sth = ''; 10928 my $sql = ''; 10929 #my $virtual_col = "SELECT V.VIRTUAL_COLUMN FROM $self->{prefix}_TAB_COLS V WHERE V.OWNER=? AND V.TABLE_NAME=? AND V.COLUMN_NAME=?"; 10930 if ($self->{db_version} !~ /Release 8/) 10931 { 10932 my $exclude_mview = $self->exclude_mviews('A.OWNER, A.TABLE_NAME'); 10933 $sql = qq{ 10934SELECT A.COLUMN_NAME, A.DATA_TYPE, A.DATA_LENGTH, A.NULLABLE, A.DATA_DEFAULT, 10935 A.DATA_PRECISION, A.DATA_SCALE, A.CHAR_LENGTH, A.TABLE_NAME, A.OWNER, V.VIRTUAL_COLUMN 10936FROM $self->{prefix}_TAB_COLUMNS A, $self->{prefix}_OBJECTS O, $self->{prefix}_TAB_COLS V 10937WHERE A.OWNER=O.OWNER and A.TABLE_NAME=O.OBJECT_NAME and O.OBJECT_TYPE='$objtype' 10938 AND A.OWNER=V.OWNER AND A.TABLE_NAME=V.TABLE_NAME AND A.COLUMN_NAME=V.COLUMN_NAME $condition 10939 $exclude_mview 10940ORDER BY A.COLUMN_ID 10941}; 10942 $sql = qq{ 10943SELECT A.COLUMN_NAME, A.DATA_TYPE, A.DATA_LENGTH, A.NULLABLE, A.DATA_DEFAULT, 10944 A.DATA_PRECISION, A.DATA_SCALE, A.CHAR_LENGTH, A.TABLE_NAME, A.OWNER, V.VIRTUAL_COLUMN 10945FROM $self->{prefix}_TAB_COLUMNS A, $self->{prefix}_TAB_COLS V 10946WHERE A.OWNER=V.OWNER AND A.TABLE_NAME=V.TABLE_NAME AND A.COLUMN_NAME=V.COLUMN_NAME $condition 10947 $exclude_mview 10948ORDER BY A.COLUMN_ID 10949}; 10950 $sql = qq{ 10951SELECT A.COLUMN_NAME, A.DATA_TYPE, A.DATA_LENGTH, A.NULLABLE, A.DATA_DEFAULT, 10952 A.DATA_PRECISION, A.DATA_SCALE, A.CHAR_LENGTH, A.TABLE_NAME, A.OWNER, 'NO' as "VIRTUAL_COLUMN" 10953FROM $self->{prefix}_TAB_COLUMNS A 10954WHERE 1=1 $condition 10955ORDER BY A.COLUMN_ID 10956}; 10957 $sth = $self->{dbh}->prepare($sql); 10958 if (!$sth) 10959 { 10960 my $ret = $self->{dbh}->err; 10961 if (!$recurs && ($ret == 942) && ($self->{prefix} eq 'DBA')) 10962 { 10963 $self->logit("HINT: Please activate USER_GRANTS or connect using a user with DBA privilege.\n"); 10964 $self->{prefix} = 'ALL'; 10965 return $self->_column_info($table, $owner, $objtype, 1); 10966 } 10967 $self->logit("FATAL: _column_info() " . $self->{dbh}->errstr . "\n", 0, 1); 10968 } 10969 } 10970 else 10971 { 10972 # an 8i database. 10973 $sql = qq{ 10974SELECT A.COLUMN_NAME, A.DATA_TYPE, A.DATA_LENGTH, A.NULLABLE, A.DATA_DEFAULT, 10975 A.DATA_PRECISION, A.DATA_SCALE, A.DATA_LENGTH, A.TABLE_NAME, A.OWNER, 'NO' as "VIRTUAL_COLUMN" 10976FROM $self->{prefix}_TAB_COLUMNS A, $self->{prefix}_OBJECTS O 10977WHERE A.OWNER=O.OWNER and A.TABLE_NAME=O.OBJECT_NAME and O.OBJECT_TYPE='$objtype' 10978 $condition 10979ORDER BY A.COLUMN_ID 10980}; 10981 $sql = qq{ 10982SELECT A.COLUMN_NAME, A.DATA_TYPE, A.DATA_LENGTH, A.NULLABLE, A.DATA_DEFAULT, 10983 A.DATA_PRECISION, A.DATA_SCALE, A.DATA_LENGTH, A.TABLE_NAME, A.OWNER, 'NO' as "VIRTUAL_COLUMN" 10984FROM $self->{prefix}_TAB_COLUMNS A 10985 $condition 10986ORDER BY A.COLUMN_ID 10987}; 10988 $sth = $self->{dbh}->prepare($sql); 10989 if (!$sth) 10990 { 10991 my $ret = $self->{dbh}->err; 10992 if (!$recurs && ($ret == 942) && ($self->{prefix} eq 'DBA')) 10993 { 10994 $self->logit("HINT: Please activate USER_GRANTS or connect using a user with DBA privilege.\n"); 10995 $self->{prefix} = 'ALL'; 10996 return $self->_column_info($table, $owner, $objtype, 1); 10997 } 10998 $self->logit("FATAL: _column_info() " . $self->{dbh}->errstr . "\n", 0, 1); 10999 } 11000 } 11001 $self->logit("DEBUG, $sql", 1); 11002 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: _column_info() " . $self->{dbh}->errstr . "\n", 0, 1); 11003 11004 # Default number of line to scan to grab the geometry type of the column. 11005 # If it not limited, the query will scan the entire table which may take a very long time. 11006 my $max_lines = 50000; 11007 $max_lines = $self->{autodetect_spatial_type} if ($self->{autodetect_spatial_type} > 1); 11008 my $spatial_gtype = 'SELECT DISTINCT c.%s.SDO_GTYPE FROM %s c WHERE ROWNUM < ' . $max_lines; 11009 my $st_spatial_gtype = 'SELECT DISTINCT ST_GeometryType(c.%s) FROM %s c WHERE ROWNUM < ' . $max_lines; 11010 # Set query to retrieve the SRID 11011 my $spatial_srid = "SELECT SRID FROM ALL_SDO_GEOM_METADATA WHERE TABLE_NAME=? AND COLUMN_NAME=? AND OWNER=?"; 11012 my $st_spatial_srid = "SELECT ST_SRID(c.%s) FROM %s c"; 11013 if ($self->{convert_srid}) 11014 { 11015 # Translate SRID to standard EPSG SRID, may return 0 because there's lot of Oracle only SRID. 11016 $spatial_srid = 'SELECT sdo_cs.map_oracle_srid_to_epsg(SRID) FROM ALL_SDO_GEOM_METADATA WHERE TABLE_NAME=? AND COLUMN_NAME=? AND OWNER=?'; 11017 } 11018 # Get the dimension of the geometry by looking at the number of element in the SDO_DIM_ARRAY 11019 my $spatial_dim = "SELECT t.SDO_DIMNAME, t.SDO_LB, t.SDO_UB FROM ALL_SDO_GEOM_METADATA m, TABLE (m.diminfo) t WHERE m.TABLE_NAME=? AND m.COLUMN_NAME=? AND OWNER=?"; 11020 my $st_spatial_dim = "SELECT ST_DIMENSION(c.%s) FROM %s c"; 11021 11022 my $t0 = Benchmark->new; 11023 my %data = (); 11024 my $pos = 0; 11025 my $ncols = 0; 11026 while (my $row = $sth->fetch) 11027 { 11028 my $tmptable = "$row->[9].$row->[8]"; 11029 next if (!exists $self->{all_objects}{$tmptable} 11030 || $self->{all_objects}{$tmptable} ne $objtype); 11031 11032 $row->[2] = $row->[7] if $row->[1] =~ /char/i; 11033 11034 # Seems that for a NUMBER with a DATA_SCALE to 0, no DATA_PRECISION and a DATA_LENGTH of 22 11035 # Oracle use a NUMBER(38) instead 11036 if ( ($row->[1] eq 'NUMBER') && ($row->[6] eq '0') && ($row->[5] eq '') && ($row->[2] == 22) ) { 11037 $row->[2] = 38; 11038 } 11039 11040 $tmptable = $row->[8]; 11041 if ($self->{export_schema} && !$self->{schema}) { 11042 $tmptable = "$row->[9].$row->[8]"; 11043 } 11044 11045 # check if this is a spatial column (srid, dim, gtype) 11046 my @geom_inf = (); 11047 if ($row->[1] eq 'SDO_GEOMETRY' || $row->[1] =~ /^ST_|STGEOM_/) 11048 { 11049 # Get the SRID of the column 11050 if ($self->{convert_srid} > 1) { 11051 push(@geom_inf, $self->{convert_srid}); 11052 } 11053 else 11054 { 11055 my @result = (); 11056 $spatial_srid = $st_spatial_srid if ($row->[1] =~ /^ST_|STGEOM_/); 11057 my $sth2 = $self->{dbh}->prepare($spatial_srid); 11058 if (!$sth2) 11059 { 11060 if ($self->{dbh}->errstr !~ /ORA-01741/) { 11061 $self->logit("FATAL: _column_info() " . $self->{dbh}->errstr . "\n", 0, 1); 11062 } else { 11063 # No SRID defined, use default one 11064 $self->logit("WARNING: Error retreiving SRID, no matter default SRID will be used: $spatial_srid\n", 0); 11065 } 11066 } 11067 else 11068 { 11069 if ($row->[1] =~ /^ST_|STGEOM_/) { 11070 $sth2->execute($row->[0]) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11071 } else { 11072 $sth2->execute($row->[8],$row->[0],$row->[9]) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11073 } 11074 while (my $r = $sth2->fetch) { 11075 push(@result, $r->[0]) if ($r->[0] =~ /\d+/); 11076 } 11077 $sth2->finish(); 11078 } 11079 if ($#result == 0) { 11080 push(@geom_inf, $result[0]); 11081 } elsif ($self->{default_srid}) { 11082 push(@geom_inf, $self->{default_srid}); 11083 } else { 11084 push(@geom_inf, 0); 11085 } 11086 } 11087 11088 # Grab constraint type and dimensions from index definition 11089 my $found_contraint = 0; 11090 foreach my $idx (keys %{$self->{tables}{$tmptable}{idx_type}}) 11091 { 11092 if (exists $self->{tables}{$tmptable}{idx_type}{$idx}{type_constraint}) 11093 { 11094 foreach my $c (@{$self->{tables}{$tmptable}{indexes}{$idx}}) 11095 { 11096 if ($c eq $row->[0]) 11097 { 11098 if ($self->{tables}{$tmptable}{idx_type}{$idx}{type_dims}) { 11099 $found_dims = $self->{tables}{$tmptable}{idx_type}{$idx}{type_dims}; 11100 } 11101 if ($self->{tables}{$tmptable}{idx_type}{$idx}{type_constraint}) { 11102 $found_contraint = $GTYPE{$self->{tables}{$tmptable}{idx_type}{$idx}{type_constraint}} || $self->{tables}{$tmptable}{idx_type}{$idx}{type_constraint}; 11103 } 11104 } 11105 } 11106 } 11107 } 11108 11109 # Get the dimension of the geometry column 11110 if (!$found_dims) 11111 { 11112 $spatial_dim = $st_spatial_dim if ($row->[1] =~ /^ST_|STGEOM_/); 11113 $sth2 = $self->{dbh}->prepare($spatial_dim); 11114 if (!$sth2) { 11115 $self->logit("FATAL: _column_info() " . $self->{dbh}->errstr . "\n", 0, 1); 11116 } 11117 if ($row->[1] =~ /^ST_|STGEOM_/) { 11118 $sth2->execute($row->[0]) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11119 } else { 11120 $sth2->execute($row->[8],$row->[0],$row->[9]) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11121 } 11122 my $count = 0; 11123 while (my $r = $sth2->fetch) { 11124 $count++; 11125 } 11126 $sth2->finish(); 11127 push(@geom_inf, $count); 11128 } 11129 else 11130 { 11131 push(@geom_inf, $found_dims); 11132 } 11133 11134 # Set dimension and type of the spatial column 11135 if (!$found_contraint && $self->{autodetect_spatial_type}) 11136 { 11137 # Get spatial information 11138 my $colname = $row->[9] . "." . $row->[8]; 11139 my $squery = sprintf($spatial_gtype, $row->[0], $colname); 11140 if ($row->[1] =~ /^ST_|STGEOM_/) { 11141 $squery = sprintf($st_spatial_gtype, $row->[0], $colname); 11142 } 11143 my $sth2 = $self->{dbh}->prepare($squery); 11144 if (!$sth2) { 11145 $self->logit("FATAL: _column_info() " . $self->{dbh}->errstr . "\n", 0, 1); 11146 } 11147 $sth2->execute or $self->logit("FATAL: _column_info() " . $self->{dbh}->errstr . "\n", 0, 1); 11148 my @result = (); 11149 while (my $r = $sth2->fetch) 11150 { 11151 if ($r->[0] =~ /(\d)$/) { 11152 push(@result, $ORA2PG_SDO_GTYPE{$1}); 11153 } elsif ($r->[0] =~ /ST_(.*)$/) { 11154 push(@result, $1); 11155 } 11156 } 11157 $sth2->finish(); 11158 if ($#result == 0) { 11159 push(@geom_inf, $result[0]); 11160 } else { 11161 push(@geom_inf, join(',', @result)); 11162 } 11163 } 11164 elsif ($found_contraint) 11165 { 11166 push(@geom_inf, $found_contraint); 11167 } 11168 else 11169 { 11170 push(@geom_inf, $ORA2PG_SDO_GTYPE{0}); 11171 } 11172 } 11173 11174 # Replace dot in column name by underscore 11175 if ($row->[0] =~ /\./ && (!exists $self->{replaced_cols}{"\L$tmptable\E"} 11176 || !exists $self->{replaced_cols}{"\L$tmptable\E"}{"\L$row->[0]\E"})) { 11177 $self->{replaced_cols}{"\L$tmptable\E"}{"\L$row->[0]\E"} = $row->[0]; 11178 $self->{replaced_cols}{"\L$tmptable\E"}{"\L$row->[0]\E"} =~ s/\./_/g; 11179 } 11180 11181 if (!$self->{schema} && $self->{export_schema}) 11182 { 11183 next if (exists $self->{modify}{"\L$tmptable\E"} && !grep(/^\Q$row->[0]\E$/i, @{$self->{modify}{"\L$tmptable\E"}})); 11184 push(@{$data{$tmptable}{"$row->[0]"}}, (@$row, $pos, @geom_inf)); 11185 } 11186 else 11187 { 11188 if (!$self->{preserve_case}) { 11189 next if (exists $self->{modify}{"\L$row->[8]\E"} && !grep(/^\Q$row->[0]\E$/i, @{$self->{modify}{"\L$row->[8]\E"}})); 11190 } else { 11191 next if (exists $self->{modify}{$row->[8]} && !grep(/^\Q$row->[0]\E$/i, @{$self->{modify}{$row->[8]}})); 11192 } 11193 push(@{$data{"$row->[8]"}{"$row->[0]"}}, (@$row, $pos, @geom_inf)); 11194 } 11195 $pos++; 11196 $ncols++; 11197 } 11198 my $t1 = Benchmark->new; 11199 $td = timediff($t1, $t0); 11200 $self->logit("Collecting $ncols columns in $self->{prefix}_INDEXES took: " . timestr($td) . "\n", 1); 11201 11202 return %data; 11203} 11204 11205sub _column_attributes 11206{ 11207 my ($self, $table, $owner, $objtype) = @_; 11208 11209 return Ora2Pg::MySQL::_column_attributes($self,'',$owner,'TABLE') if ($self->{is_mysql}); 11210 11211 $objtype ||= 'TABLE'; 11212 11213 my $condition = ''; 11214 $condition .= "AND A.TABLE_NAME='$table' " if ($table); 11215 if ($owner) { 11216 $condition .= "AND A.OWNER='$owner' "; 11217 } else { 11218 $condition .= " AND A.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 11219 } 11220 if (!$table) { 11221 $condition .= $self->limit_to_objects('TABLE', 'A.TABLE_NAME'); 11222 } else { 11223 @{$self->{query_bind_params}} = (); 11224 } 11225 11226 my $sth = ''; 11227 if ($self->{db_version} !~ /Release 8/) { 11228 $sth = $self->{dbh}->prepare(<<END); 11229SELECT A.COLUMN_NAME, A.NULLABLE, A.DATA_DEFAULT, A.TABLE_NAME, A.OWNER, A.COLUMN_ID 11230FROM $self->{prefix}_TAB_COLUMNS A, $self->{prefix}_OBJECTS O WHERE A.OWNER=O.OWNER and A.TABLE_NAME=O.OBJECT_NAME and O.OBJECT_TYPE='$objtype' $condition 11231ORDER BY A.COLUMN_ID 11232END 11233 if (!$sth) { 11234 $self->logit("FATAL: _column_attributes() " . $self->{dbh}->errstr . "\n", 0, 1); 11235 } 11236 } else { 11237 # an 8i database. 11238 $sth = $self->{dbh}->prepare(<<END); 11239SELECT A.COLUMN_NAME, A.NULLABLE, A.DATA_DEFAULT, A.TABLE_NAME, A.OWNER, A.COLUMN_ID 11240FROM $self->{prefix}_TAB_COLUMNS A, $self->{prefix}_OBJECTS O WHERE A.OWNER=O.OWNER and A.TABLE_NAME=O.OBJECT_NAME and O.OBJECT_TYPE='$objtype' $condition 11241ORDER BY A.COLUMN_ID 11242END 11243 if (!$sth) { 11244 $self->logit("FATAL: _column_attributes() " . $self->{dbh}->errstr . "\n", 0, 1); 11245 } 11246 } 11247 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: _column_attributes() " . $self->{dbh}->errstr . "\n", 0, 1); 11248 11249 my %data = (); 11250 while (my $row = $sth->fetch) 11251 { 11252 if ($self->{export_schema} && !$self->{schema}) { 11253 $data{"$row->[4].$row->[3]"}{"$row->[0]"}{nullable} = $row->[1]; 11254 $data{"$row->[4].$row->[3]"}{"$row->[0]"}{default} = $row->[2]; 11255 } else { 11256 $data{$row->[3]}{"$row->[0]"}{nullable} = $row->[1]; 11257 $data{$row->[3]}{"$row->[0]"}{default} = $row->[2]; 11258 } 11259 my $f = $self->{tables}{"$table"}{column_info}{"$row->[0]"}; 11260 if ( ($f->[1] =~ /SDO_GEOMETRY/i) && ($self->{convert_srid} <= 1) ) { 11261 $spatial_srid = "SELECT COALESCE(SRID, $self->{default_srid}) FROM ALL_SDO_GEOM_METADATA WHERE TABLE_NAME='\U$table\E' AND COLUMN_NAME='$row->[0]' AND OWNER='\U$self->{tables}{$table}{table_info}{owner}\E'"; 11262 if ($self->{convert_srid} == 1) { 11263 $spatial_srid = "SELECT COALESCE(sdo_cs.map_oracle_srid_to_epsg(SRID), $self->{default_srid}) FROM ALL_SDO_GEOM_METADATA WHERE TABLE_NAME='\U$table\E' AND COLUMN_NAME='$row->[0]' AND OWNER='\U$self->{tables}{$table}{table_info}{owner}\E'"; 11264 } 11265 my $sth2 = $self->{dbh}->prepare($spatial_srid); 11266 if (!$sth2) { 11267 if ($self->{dbh}->errstr !~ /ORA-01741/) { 11268 $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11269 } else { 11270 # No SRID defined, use default one 11271 $spatial_srid = $self->{default_srid} || '0'; 11272 $self->logit("WARNING: Error retreiving SRID, no matter default SRID will be used: $spatial_srid\n", 0); 11273 } 11274 } else { 11275 $sth2->execute() or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11276 my @result = (); 11277 while (my $r = $sth2->fetch) { 11278 push(@result, $r->[0]) if ($r->[0] =~ /\d+/); 11279 } 11280 $sth2->finish(); 11281 if ($self->{export_schema} && !$self->{schema}) { 11282 $data{"$row->[4].$row->[3]"}{"$row->[0]"}{spatial_srid} = $result[0] || $self->{default_srid} || '0'; 11283 } else { 11284 $data{$row->[3]}{"$row->[0]"}{spatial_srid} = $result[0] || $self->{default_srid} || '0'; 11285 } 11286 } 11287 } 11288 } 11289 11290 return %data; 11291} 11292 11293sub _encrypted_columns 11294{ 11295 my ($self, $table, $owner) = @_; 11296 11297 return Ora2Pg::MySQL::_encrypted_columns($self,'',$owner) if ($self->{is_mysql}); 11298 11299 # Encryption appears in version 10 only 11300 return if ($self->{db_version} =~ /Release [8|9]/); 11301 11302 my $condition = ''; 11303 $condition .= "AND A.TABLE_NAME='$table' " if ($table); 11304 if ($owner) { 11305 $condition .= "AND A.OWNER='$owner' "; 11306 } else { 11307 $condition .= " AND A.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 11308 } 11309 if (!$table) { 11310 $condition .= $self->limit_to_objects('TABLE', 'A.TABLE_NAME'); 11311 } else { 11312 @{$self->{query_bind_params}} = (); 11313 } 11314 $condition =~ s/^\s*AND /WHERE /s; 11315 11316 my $sth = $self->{dbh}->prepare(<<END); 11317SELECT A.COLUMN_NAME, A.TABLE_NAME, A.OWNER, A.ENCRYPTION_ALG 11318FROM $self->{prefix}_ENCRYPTED_COLUMNS A 11319$condition 11320END 11321 if (!$sth) { 11322 $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11323 } 11324 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11325 11326 my %data = (); 11327 while (my $row = $sth->fetch) { 11328 if ($self->{export_schema} && !$self->{schema}) { 11329 $data{"$row->[2].$row->[1].$row->[0]"} = $row->[3]; 11330 } else { 11331 $data{"$row->[1].$row->[0]"} = $row->[3]; 11332 } 11333 } 11334 11335 return %data; 11336} 11337 11338 11339 11340=head2 _unique_key TABLE OWNER 11341 11342This function implements an Oracle-native unique (including primary) 11343key column information. 11344 11345Returns a hash of hashes in the following form: 11346 ( owner => table => constraintname => (type => 'PRIMARY', 11347 columns => ('a', 'b', 'c')), 11348 owner => table => constraintname => (type => 'UNIQUE', 11349 columns => ('b', 'c', 'd')), 11350 etc. 11351 ) 11352 11353=cut 11354 11355sub _unique_key 11356{ 11357 my ($self, $table, $owner, $type) = @_; 11358 11359 return Ora2Pg::MySQL::_unique_key($self,$table,$owner) if ($self->{is_mysql}); 11360 11361 my %result = (); 11362 11363 my @accepted_constraint_types = (); 11364 if ($type) { 11365 push @accepted_constraint_types, "'$type'"; 11366 } else { 11367 push @accepted_constraint_types, "'P'" unless($self->{skip_pkeys}); 11368 push @accepted_constraint_types, "'U'" unless($self->{skip_ukeys}); 11369 } 11370 return %result unless(@accepted_constraint_types); 11371 11372 my $cons_types = '('. join(',', @accepted_constraint_types) .')'; 11373 11374 my $indexname = "'' AS INDEX_NAME"; 11375 if ($self->{db_version} !~ /Release 8/) { 11376 $indexname = 'B.INDEX_NAME'; 11377 } 11378 # Get columns of all the table in the specified schema or excluding the list of system schema 11379 my $sql = qq{SELECT DISTINCT A.COLUMN_NAME,A.CONSTRAINT_NAME,A.OWNER,A.POSITION,B.CONSTRAINT_NAME,B.CONSTRAINT_TYPE,B.DEFERRABLE,B.DEFERRED,B.GENERATED,B.TABLE_NAME,B.OWNER,$indexname 11380FROM $self->{prefix}_CONS_COLUMNS A JOIN $self->{prefix}_CONSTRAINTS B ON (B.CONSTRAINT_NAME = A.CONSTRAINT_NAME AND B.OWNER = A.OWNER) 11381}; 11382 if ($owner) { 11383 $sql .= " WHERE A.OWNER = '$owner'"; 11384 } else { 11385 $sql .= " WHERE A.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 11386 } 11387 $sql .= " AND B.CONSTRAINT_TYPE IN $cons_types"; 11388 $sql .= " AND B.TABLE_NAME='$table'" if ($table); 11389 $sql .= " AND B.STATUS='ENABLED' "; 11390 if ($self->{db_version} !~ /Release 8/) { 11391 $sql .= $self->exclude_mviews('B.OWNER, B.TABLE_NAME'); 11392 } 11393 11394 # Get the list of constraints in the specified schema or excluding the list of system schema 11395 my @tmpparams = (); 11396 if ($self->{type} ne 'SHOW_REPORT') 11397 { 11398 $sql .= $self->limit_to_objects('UKEY|TABLE', 'B.CONSTRAINT_NAME|B.TABLE_NAME'); 11399 push(@tmpparams, @{$self->{query_bind_params}}); 11400 $sql .= $self->limit_to_objects('UKEY', 'B.CONSTRAINT_NAME'); 11401 push(@tmpparams, @{$self->{query_bind_params}}); 11402 } 11403 $sql .= " ORDER BY A.POSITION"; 11404 11405 my $sth = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11406 $sth->execute(@tmpparams) or $self->logit("FATAL: " . $sth->errstr . "\n", 0, 1); 11407 11408 while (my $row = $sth->fetch) 11409 { 11410 my $name = $row->[9]; 11411 if (!$self->{schema} && $self->{export_schema}) 11412 { 11413 $name = "$row->[10].$row->[9]"; 11414 } 11415 if (!exists $result{$name}{$row->[4]}) 11416 { 11417 $result{$name}{$row->[4]} = { (type => $row->[5], 'generated' => $row->[8], 'index_name' => $row->[11], 'deferrable' => $row->[6], 'deferred' => $row->[7], columns => ()) }; 11418 push(@{ $result{$name}{$row->[4]}->{columns} }, $row->[0]) if ($row->[4] !~ /^SYS_NC/i); 11419 } 11420 elsif ($row->[4] !~ /^SYS_NC/i) 11421 { 11422 push(@{ $result{$name}{$row->[4]}->{columns} }, $row->[0]); 11423 } 11424 } 11425 return %result; 11426} 11427 11428=head2 _check_constraint TABLE OWNER 11429 11430This function implements an Oracle-native check constraint 11431information. 11432 11433Returns a hash of lists of all column names defined as check constraints 11434for the specified table and constraint name. 11435 11436=cut 11437 11438sub _check_constraint 11439{ 11440 my($self, $table, $owner) = @_; 11441 11442 my $condition = ''; 11443 $condition .= "AND TABLE_NAME='$table' " if ($table); 11444 if ($owner) { 11445 $condition .= "AND OWNER = '$owner' "; 11446 } else { 11447 $condition .= "AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 11448 } 11449 $condition .= $self->limit_to_objects('CKEY|TABLE', 'CONSTRAINT_NAME|TABLE_NAME'); 11450 11451 my $sql = qq{ 11452SELECT A.CONSTRAINT_NAME,A.R_CONSTRAINT_NAME,A.SEARCH_CONDITION,A.DELETE_RULE,A.DEFERRABLE,A.DEFERRED,A.R_OWNER,A.TABLE_NAME,A.OWNER,A.VALIDATED 11453FROM $self->{prefix}_CONSTRAINTS A 11454WHERE A.CONSTRAINT_TYPE='C' $condition 11455AND A.STATUS='ENABLED' 11456}; 11457 11458 if ($self->{db_version} !~ /Release 8/) { 11459 $sql .= $self->exclude_mviews('A.OWNER, A.TABLE_NAME'); 11460 } 11461 my $sth = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11462 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11463 11464 my %data = (); 11465 while (my $row = $sth->fetch) { 11466 if ($self->{export_schema} && !$self->{schema}) { 11467 $row->[7] = "$row->[8].$row->[7]"; 11468 } 11469 $data{$row->[7]}{constraint}{$row->[0]}{condition} = $row->[2]; 11470 $data{$row->[7]}{constraint}{$row->[0]}{validate} = $row->[9]; 11471 } 11472 11473 return %data; 11474} 11475 11476=head2 _foreign_key TABLE OWNER 11477 11478This function implements an Oracle-native foreign key reference 11479information. 11480 11481Returns a list of hash of hash of array references. Ouf! Nothing very difficult. 11482The first hash is composed of all foreign key names. The second hash has just 11483two keys known as 'local' and 'remote' corresponding to the local table where 11484the foreign key is defined and the remote table referenced by the key. 11485 11486The foreign key name is composed as follows: 11487 11488 'local_table_name->remote_table_name' 11489 11490Foreign key data consists in two arrays representing at the same index for the 11491local field and the remote field where the first one refers to the second one. 11492Just like this: 11493 11494 @{$link{$fkey_name}{local}} = @local_columns; 11495 @{$link{$fkey_name}{remote}} = @remote_columns; 11496 11497=cut 11498 11499sub _foreign_key 11500{ 11501 my ($self, $table, $owner) = @_; 11502 11503 return Ora2Pg::MySQL::_foreign_key($self,$table,$owner) if ($self->{is_mysql}); 11504 11505 my @tmpparams = (); 11506 my $condition = ''; 11507 $condition .= "AND CONS.TABLE_NAME='$table' " if ($table); 11508 if ($owner) { 11509 $condition .= "AND CONS.OWNER = '$owner' "; 11510 } else { 11511 $condition .= "AND CONS.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 11512 } 11513 $condition .= $self->limit_to_objects('FKEY|TABLE','CONS.CONSTRAINT_NAME|CONS.TABLE_NAME'); 11514 11515 my $deferrable = $self->{fkey_deferrable} ? "'DEFERRABLE' AS DEFERRABLE" : "DEFERRABLE"; 11516 my $defer = $self->{fkey_deferrable} ? "'DEFERRABLE' AS DEFERRABLE" : "CONS.DEFERRABLE"; 11517 11518 my $sql = <<END; 11519SELECT 11520 CONS.TABLE_NAME, 11521 CONS.CONSTRAINT_NAME, 11522 COLS.COLUMN_NAME, 11523 CONS_R.TABLE_NAME R_TABLE_NAME, 11524 CONS.R_CONSTRAINT_NAME, 11525 COLS_R.COLUMN_NAME R_COLUMN_NAME, 11526 CONS.SEARCH_CONDITION,CONS.DELETE_RULE,$defer,CONS.DEFERRED, 11527 CONS.OWNER,CONS.R_OWNER, 11528 COLS.POSITION,COLS_R.POSITION, 11529 CONS.VALIDATED 11530FROM $self->{prefix}_CONSTRAINTS CONS 11531 LEFT JOIN $self->{prefix}_CONS_COLUMNS COLS ON (COLS.CONSTRAINT_NAME = CONS.CONSTRAINT_NAME AND COLS.OWNER = CONS.OWNER AND COLS.TABLE_NAME = CONS.TABLE_NAME) 11532 LEFT JOIN $self->{prefix}_CONSTRAINTS CONS_R ON (CONS_R.CONSTRAINT_NAME = CONS.R_CONSTRAINT_NAME AND CONS_R.OWNER = CONS.R_OWNER) 11533 LEFT JOIN $self->{prefix}_CONS_COLUMNS COLS_R ON (COLS_R.CONSTRAINT_NAME = CONS.R_CONSTRAINT_NAME AND COLS_R.POSITION=COLS.POSITION AND COLS_R.OWNER = CONS.R_OWNER) 11534WHERE CONS.CONSTRAINT_TYPE = 'R' $condition 11535END 11536 if ($self->{db_version} !~ /Release 8/) { 11537 $sql .= $self->exclude_mviews('CONS.OWNER, CONS.TABLE_NAME'); 11538 } 11539 11540 $sql .= "\nORDER BY CONS.TABLE_NAME, CONS.CONSTRAINT_NAME, COLS.POSITION"; 11541 11542 if ($self->{db_version} =~ /Release 8/) { 11543 $sql = <<END; 11544SELECT 11545 CONS.TABLE_NAME, 11546 CONS.CONSTRAINT_NAME, 11547 COLS.COLUMN_NAME, 11548 CONS_R.TABLE_NAME R_TABLE_NAME, 11549 CONS.R_CONSTRAINT_NAME, 11550 COLS_R.COLUMN_NAME R_COLUMN_NAME, 11551 CONS.SEARCH_CONDITION,CONS.DELETE_RULE,$defer,CONS.DEFERRED, 11552 CONS.OWNER,CONS.R_OWNER, 11553 COLS.POSITION,COLS_R.POSITION, 11554 CONS.VALIDATED 11555FROM $self->{prefix}_CONSTRAINTS CONS, $self->{prefix}_CONS_COLUMNS COLS, $self->{prefix}_CONSTRAINTS CONS_R, $self->{prefix}_CONS_COLUMNS COLS_R 11556WHERE CONS_R.CONSTRAINT_NAME = CONS.R_CONSTRAINT_NAME AND CONS_R.OWNER = CONS.R_OWNER 11557 AND COLS.CONSTRAINT_NAME = CONS.CONSTRAINT_NAME AND COLS.OWNER = CONS.OWNER AND COLS.TABLE_NAME = CONS.TABLE_NAME 11558 AND COLS_R.CONSTRAINT_NAME = CONS.R_CONSTRAINT_NAME AND COLS_R.POSITION=COLS.POSITION AND COLS_R.OWNER = CONS.R_OWNER 11559 AND CONS.CONSTRAINT_TYPE = 'R' $condition 11560ORDER BY CONS.TABLE_NAME, CONS.CONSTRAINT_NAME, COLS.POSITION 11561END 11562 } 11563 my $sth = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11564 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $sth->errstr . "\n", 0, 1); 11565 11566 my %data = (); 11567 my %link = (); 11568 #my @tab_done = (); 11569 while (my $row = $sth->fetch) { 11570 my $local_table = $row->[0]; 11571 my $remote_table = $row->[3]; 11572 if (!$self->{schema} && $self->{export_schema}) { 11573 $local_table = "$row->[10].$row->[0]"; 11574 $remote_table = "$row->[11].$row->[3]"; 11575 } 11576 if (!$self->{preserve_case}) { 11577 next if (exists $self->{modify}{"\L$local_table\E"} && !grep(/^\Q$row->[2]\E$/i, @{$self->{modify}{"\L$local_table\E"}})); 11578 next if (exists $self->{modify}{"\L$remote_table\E"} && !grep(/^\Q$row->[5]\E$/i, @{$self->{modify}{"\L$remote_table\E"}})); 11579 } else { 11580 next if (exists $self->{modify}{$local_table} && !grep(/^\Q$row->[2]\E$/i, @{$self->{modify}{$local_table}})); 11581 next if (exists $self->{modify}{$remote_table} && !grep(/^\Q$row->[5]\E$/i, @{$self->{modify}{$remote_table}})); 11582 } 11583 push(@{$data{$local_table}}, [ ($row->[1],$row->[4],$row->[6],$row->[7],$row->[8],$row->[9],$row->[11],$row->[0],$row->[10],$row->[14]) ]); 11584 # TABLENAME CONSTNAME COLNAME 11585 push(@{$link{$local_table}{$row->[1]}{local}}, $row->[2]); 11586 # TABLENAME CONSTNAME TABLENAME COLNAME 11587 push(@{$link{$local_table}{$row->[1]}{remote}{$remote_table}}, $row->[5]); 11588 } 11589 11590 return \%link, \%data; 11591} 11592 11593 11594=head2 _get_privilege 11595 11596This function implements an Oracle-native object priviledge information. 11597 11598Returns a hash of all priviledge. 11599 11600=cut 11601 11602sub _get_privilege 11603{ 11604 my($self) = @_; 11605 11606 # If the user is given as not DBA, do not look at tablespace 11607 if ($self->{user_grants}) { 11608 $self->logit("WARNING: Exporting privilege as non DBA user is not allowed, see USER_GRANT\n", 0); 11609 return; 11610 } 11611 11612 return Ora2Pg::MySQL::_get_privilege($self) if ($self->{is_mysql}); 11613 11614 my %privs = (); 11615 my %roles = (); 11616 11617 # Retrieve all privilege per table defined in this database 11618 my $str = "SELECT b.GRANTEE,b.OWNER,b.TABLE_NAME,b.PRIVILEGE,a.OBJECT_TYPE,b.GRANTABLE FROM DBA_TAB_PRIVS b, DBA_OBJECTS a"; 11619 if ($self->{schema}) { 11620 $str .= " WHERE b.GRANTOR = '$self->{schema}'"; 11621 } else { 11622 $str .= " WHERE b.GRANTOR NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 11623 } 11624 $str .= " AND b.TABLE_NAME=a.OBJECT_NAME AND a.OWNER=b.GRANTOR"; 11625 if ($self->{grant_object} && $self->{grant_object} ne 'USER') { 11626 $str .= " AND a.OBJECT_TYPE = '\U$self->{grant_object}\E'"; 11627 } else { 11628 $str .= " AND a.OBJECT_TYPE <> 'TYPE'"; 11629 } 11630 $str .= " " . $self->limit_to_objects('GRANT|TABLE|VIEW|FUNCTION|PROCEDURE|SEQUENCE', 'b.GRANTEE|b.TABLE_NAME|b.TABLE_NAME|b.TABLE_NAME|b.TABLE_NAME|b.TABLE_NAME'); 11631 11632 if (!$self->{export_invalid}) { 11633 $str .= " AND a.STATUS='VALID'"; 11634 } 11635 #$str .= " ORDER BY b.TABLE_NAME, b.GRANTEE"; 11636 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11637 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11638 while (my $row = $sth->fetch) { 11639 next if ($row->[0] eq 'PUBLIC'); 11640 if (!$self->{schema} && $self->{export_schema}) { 11641 $row->[2] = "$row->[1].$row->[2]"; 11642 } 11643 $privs{$row->[2]}{type} = $row->[4]; 11644 $privs{$row->[2]}{owner} = $row->[1] if (!$privs{$row->[2]}{owner}); 11645 if ($row->[5] eq 'YES') { 11646 $privs{$row->[2]}{grantable} = $row->[5]; 11647 } 11648 push(@{$privs{$row->[2]}{privilege}{$row->[0]}}, $row->[3]); 11649 push(@{$roles{owner}}, $row->[1]) if (!grep(/^$row->[1]$/, @{$roles{owner}})); 11650 push(@{$roles{grantee}}, $row->[0]) if (!grep(/^$row->[0]$/, @{$roles{grantee}})); 11651 } 11652 $sth->finish(); 11653 11654 # Retrieve all privilege per column table defined in this database 11655 $str = "SELECT b.GRANTEE,b.OWNER,b.TABLE_NAME,b.PRIVILEGE,b.COLUMN_NAME FROM DBA_COL_PRIVS b, DBA_OBJECTS a"; 11656 if ($self->{schema}) { 11657 $str .= " WHERE b.GRANTOR = '$self->{schema}'"; 11658 } else { 11659 $str .= " WHERE b.GRANTOR NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 11660 } 11661 if (!$self->{export_invalid}) { 11662 $str .= " AND a.STATUS='VALID'"; 11663 } 11664 $str .= " AND b.TABLE_NAME=a.OBJECT_NAME AND a.OWNER=b.GRANTOR AND a.OBJECT_TYPE <> 'TYPE'"; 11665 if ($self->{grant_object} && $self->{grant_object} ne 'USER') { 11666 $str .= " AND a.OBJECT_TYPE = '\U$self->{grant_object}\E'"; 11667 } else { 11668 $str .= " AND a.OBJECT_TYPE <> 'TYPE'"; 11669 } 11670 $str .= " " . $self->limit_to_objects('GRANT|TABLE|VIEW|FUNCTION|PROCEDURE|SEQUENCE', 'b.GRANTEE|b.TABLE_NAME|b.TABLE_NAME|b.TABLE_NAME|b.TABLE_NAME|b.TABLE_NAME'); 11671 11672 $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11673 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11674 while (my $row = $sth->fetch) { 11675 if (!$self->{schema} && $self->{export_schema}) { 11676 $row->[2] = "$row->[1].$row->[2]"; 11677 } 11678 $privs{$row->[2]}{owner} = $row->[1] if (!$privs{$row->[2]}{owner}); 11679 push(@{$privs{$row->[2]}{column}{$row->[4]}{$row->[0]}}, $row->[3]); 11680 push(@{$roles{owner}}, $row->[1]) if (!grep(/^$row->[1]$/, @{$roles{owner}})); 11681 push(@{$roles{grantee}}, $row->[0]) if (!grep(/^$row->[0]$/, @{$roles{grantee}})); 11682 } 11683 $sth->finish(); 11684 11685 # Search if users have admin rights 11686 my @done = (); 11687 foreach my $r (@{$roles{owner}}, @{$roles{grantee}}) { 11688 next if (grep(/^$r$/, @done)); 11689 push(@done, $r); 11690 # Get all system priviledge given to a role 11691 $str = "SELECT PRIVILEGE,ADMIN_OPTION FROM DBA_SYS_PRIVS WHERE GRANTEE = '$r'"; 11692 $str .= " " . $self->limit_to_objects('GRANT', 'GRANTEE'); 11693 #$str .= " ORDER BY PRIVILEGE"; 11694 $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11695 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11696 while (my $row = $sth->fetch) { 11697 push(@{$roles{admin}{$r}{privilege}}, $row->[0]); 11698 push(@{$roles{admin}{$r}{admin_option}}, $row->[1]); 11699 } 11700 $sth->finish(); 11701 } 11702 # Now try to find if it's a user or a role 11703 foreach my $u (@done) { 11704 $str = "SELECT GRANTED_ROLE FROM DBA_ROLE_PRIVS WHERE GRANTEE = '$u'"; 11705 $str .= " " . $self->limit_to_objects('GRANT', 'GRANTEE'); 11706 #$str .= " ORDER BY GRANTED_ROLE"; 11707 $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11708 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11709 while (my $row = $sth->fetch) { 11710 push(@{$roles{role}{$u}}, $row->[0]); 11711 } 11712 $str = "SELECT USERNAME FROM DBA_USERS WHERE USERNAME = '$u'"; 11713 $str .= " " . $self->limit_to_objects('GRANT', 'USERNAME'); 11714 #$str .= " ORDER BY USERNAME"; 11715 $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11716 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11717 while (my $row = $sth->fetch) { 11718 $roles{type}{$u} = 'USER'; 11719 } 11720 next if $roles{type}{$u}; 11721 $str = "SELECT ROLE,PASSWORD_REQUIRED FROM DBA_ROLES WHERE ROLE='$u'"; 11722 $str .= " " . $self->limit_to_objects('GRANT', 'ROLE'); 11723 #$str .= " ORDER BY ROLE"; 11724 $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11725 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11726 while (my $row = $sth->fetch) { 11727 $roles{type}{$u} = 'ROLE'; 11728 $roles{password_required}{$u} = $row->[1]; 11729 } 11730 $sth->finish(); 11731 } 11732 11733 return (\%privs, \%roles); 11734} 11735 11736=head2 _get_security_definer 11737 11738This function implements an Oracle-native functions security definer / current_user information. 11739 11740Returns a hash of all object_type/function/security. 11741 11742=cut 11743 11744sub _get_security_definer 11745{ 11746 my ($self, $type) = @_; 11747 11748 return Ora2Pg::MySQL::_get_security_definer($self, $type) if ($self->{is_mysql}); 11749 11750 my %security = (); 11751 11752 # This table does not exists before 10g 11753 return if ($self->{db_version} =~ /Release [89]/); 11754 11755 # Retrieve security privilege per function defined in this database 11756 # Version of Oracle 10 does not have the OBJECT_TYPE column. 11757 my $str = "SELECT AUTHID,OBJECT_TYPE,OBJECT_NAME,OWNER FROM $self->{prefix}_PROCEDURES"; 11758 if ($self->{db_version} =~ /Release 10/) { 11759 $str = "SELECT AUTHID,'ALL' AS OBJECT_TYPE,OBJECT_NAME,OWNER FROM $self->{prefix}_PROCEDURES"; 11760 } 11761 if ($self->{schema}) { 11762 $str .= " WHERE OWNER = '$self->{schema}'"; 11763 } else { 11764 $str .= " WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 11765 } 11766 if ( $type && ($self->{db_version} !~ /Release 10/) ) { 11767 $str .= " AND OBJECT_TYPE='$type'"; 11768 } 11769 $str .= " " . $self->limit_to_objects('FUNCTION|PROCEDURE|PACKAGE|TRIGGER', 'OBJECT_NAME|OBJECT_NAME|OBJECT_NAME|OBJECT_NAME'); 11770 #$str .= " ORDER BY OBJECT_NAME"; 11771 11772 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11773 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11774 while (my $row = $sth->fetch) { 11775 next if (!$row->[0]); 11776 if (!$self->{schema} && $self->{export_schema}) { 11777 $row->[2] = "$row->[3].$row->[2]"; 11778 } 11779 $security{$row->[2]}{security} = $row->[0]; 11780 $security{$row->[2]}{owner} = $row->[3]; 11781 } 11782 $sth->finish(); 11783 11784 return (\%security); 11785} 11786 11787 11788 11789 11790=head2 _get_indexes TABLE OWNER 11791 11792This function implements an Oracle-native indexes information. 11793 11794Returns a hash of an array containing all unique indexes and a hash of 11795array of all indexe names which are not primary keys for the specified table. 11796 11797=cut 11798 11799sub _get_indexes 11800{ 11801 my ($self, $table, $owner, $generated_indexes) = @_; 11802 11803 return Ora2Pg::MySQL::_get_indexes($self,$table,$owner) if ($self->{is_mysql}); 11804 11805 # Retrieve all indexes 11806 11807 # Retrieve FTS indexes information before. 11808 my %idx_info = (); 11809 %idx_info = $self->_get_fts_indexes_info($owner) if ($self->_table_exists('CTXSYS', 'CTX_INDEX_VALUES')); 11810 11811 my $sub_owner = ''; 11812 if ($owner) { 11813 $sub_owner = "AND A.INDEX_OWNER=B.TABLE_OWNER"; 11814 } 11815 11816 my $condition = ''; 11817 $condition .= "AND A.TABLE_NAME='$table' " if ($table); 11818 if ($owner) { 11819 $condition .= "AND A.INDEX_OWNER='$owner' "; 11820 } else { 11821 $condition .= " AND A.INDEX_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 11822 } 11823 if (!$table) { 11824 $condition .= $self->limit_to_objects('TABLE|INDEX', "A.TABLE_NAME|A.INDEX_NAME"); 11825 } else { 11826 @{$self->{query_bind_params}} = (); 11827 } 11828 11829 # When comparing number of index we need to retrieve generated index (mostly PK) 11830 my $generated = ''; 11831 $generated = " B.GENERATED = 'N' AND" if (!$generated_indexes); 11832 11833 my $t0 = Benchmark->new; 11834 my $sth = ''; 11835 if ($self->{db_version} !~ /Release 8/) 11836 { 11837 my $no_mview = $self->exclude_mviews('A.INDEX_OWNER, A.TABLE_NAME'); 11838 $no_mview = '' if ($self->{type} eq 'MVIEW'); 11839 $sth = $self->{dbh}->prepare(<<END) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11840SELECT DISTINCT A.INDEX_NAME,A.COLUMN_NAME,B.UNIQUENESS,A.COLUMN_POSITION,B.INDEX_TYPE,B.TABLE_TYPE,B.GENERATED,B.JOIN_INDEX,A.TABLE_NAME,A.INDEX_OWNER,B.TABLESPACE_NAME,B.ITYP_NAME,B.PARAMETERS,A.DESCEND 11841FROM $self->{prefix}_IND_COLUMNS A 11842JOIN $self->{prefix}_INDEXES B ON (B.INDEX_NAME=A.INDEX_NAME AND B.OWNER=A.INDEX_OWNER) 11843WHERE$generated B.TEMPORARY = 'N' $condition $no_mview 11844ORDER BY A.COLUMN_POSITION 11845END 11846 } 11847 else 11848 { 11849 # an 8i database. 11850 $sth = $self->{dbh}->prepare(<<END) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11851SELECT DISTINCT A.INDEX_NAME,A.COLUMN_NAME,B.UNIQUENESS,A.COLUMN_POSITION,B.INDEX_TYPE,B.TABLE_TYPE,B.GENERATED, 'NO', A.TABLE_NAME,A.INDEX_OWNER,B.TABLESPACE_NAME,B.ITYP_NAME,B.PARAMETERS,A.DESCEND 11852FROM $self->{prefix}_IND_COLUMNS A, $self->{prefix}_INDEXES B 11853WHERE B.INDEX_NAME=A.INDEX_NAME AND B.OWNER=A.INDEX_OWNER $condition 11854AND$generated B.TEMPORARY = 'N' 11855ORDER BY A.COLUMN_POSITION 11856END 11857 } 11858 11859 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11860 11861 my $idxnc = qq{SELECT IE.COLUMN_EXPRESSION FROM $self->{prefix}_IND_EXPRESSIONS IE, $self->{prefix}_IND_COLUMNS IC 11862WHERE IE.INDEX_OWNER = IC.INDEX_OWNER 11863AND IE.INDEX_NAME = IC.INDEX_NAME 11864AND IE.TABLE_OWNER = IC.TABLE_OWNER 11865AND IE.TABLE_NAME = IC.TABLE_NAME 11866AND IE.COLUMN_POSITION = IC.COLUMN_POSITION 11867AND IC.COLUMN_NAME = ? 11868AND IE.TABLE_NAME = ? 11869AND IC.TABLE_OWNER = ? 11870}; 11871 my $sth2 = $self->{dbh}->prepare($idxnc) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11872 my %data = (); 11873 my %unique = (); 11874 my %idx_type = (); 11875 my $nidx = 0; 11876 while (my $row = $sth->fetch) 11877 { 11878 # Exclude log indexes of materialized views, there must be a better 11879 # way to exclude then than looking at index name, fill free to fix it. 11880 next if ($row->[0] =~ /^I_SNAP\$_/); 11881 11882 my $save_tb = $row->[8]; 11883 if (!$self->{schema} && $self->{export_schema}) { 11884 $row->[8] = "$row->[9].$row->[8]"; 11885 } 11886 if (!$self->{preserve_case}) { 11887 next if (exists $self->{modify}{"\L$row->[8]\E"} && !grep(/^\Q$row->[1]\E$/i, @{$self->{modify}{"\L$row->[8]\E"}})); 11888 } else { 11889 next if (exists $self->{modify}{$row->[8]} && !grep(/^\Q$row->[1]\E$/i, @{$self->{modify}{$row->[8]}})); 11890 } 11891 # Show a warning when an index has the same name as the table 11892 if ( !$self->{indexes_renaming} && !$self->{indexes_suffix} && (lc($row->[0]) eq lc($table)) ) { 11893 print STDERR "WARNING: index $row->[0] has the same name as the table itself. Please rename it before export or enable INDEXES_RENAMING.\n"; 11894 } 11895 $unique{$row->[8]}{$row->[0]} = $row->[2]; 11896 11897 # Save original column name 11898 my $colname = $row->[1]; 11899 # Replace function based index type 11900 if ( ($row->[4] =~ /FUNCTION-BASED/i) && ($colname =~ /^SYS_NC\d+\$$/) ) 11901 { 11902 $sth2->execute($colname,$save_tb,$row->[-5]) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11903 my $nc = $sth2->fetch(); 11904 $row->[1] = $nc->[0]; 11905 $row->[1] =~ s/"//g; 11906 $row->[1] =~ s/'//g if ($row->[1] =~ /^'[^'\s]+'$/); 11907 # Single row constraint based on a constant and a function based unique index 11908 if ($nc->[0] =~ /^\d+$/ && $row->[4] =~ /FUNCTION-BASED/i) { 11909 $row->[1] = '(' . $nc->[0] . ')'; 11910 } 11911 # Enclose with double quote if required when is is not an index function 11912 elsif ($row->[1] !~ /\(.*\)/ && $row->[4] !~ /FUNCTION-BASED/i) { 11913 $row->[1] = $self->quote_object_name($row->[1]); 11914 } 11915 # Append DESC sort order when not default to ASC 11916 if ($row->[13] eq 'DESC') { 11917 $row->[1] .= " DESC"; 11918 } 11919 } 11920 else 11921 { 11922 # Quote column with unsupported symbols 11923 $row->[1] = $self->quote_object_name($row->[1]); 11924 } 11925 11926 $row->[1] =~ s/SYS_EXTRACT_UTC\s*\(([^\)]+)\)/$1/isg; 11927 11928 # Index with DESC are declared as FUNCTION-BASED, fix that 11929 if (($row->[4] =~ /FUNCTION-BASED/i) && ($row->[1] !~ /\(.*\)/)) { 11930 $row->[4] =~ s/FUNCTION-BASED\s*//; 11931 } 11932 $idx_type{$row->[8]}{$row->[0]}{type_name} = $row->[11]; 11933 if (($#{$row} > 6) && ($row->[7] eq 'Y')) { 11934 $idx_type{$row->[8]}{$row->[0]}{type} = $row->[4] . ' JOIN'; 11935 } else { 11936 $idx_type{$row->[8]}{$row->[0]}{type} = $row->[4]; 11937 } 11938 my $idx_name = $row->[0]; 11939 if (!$self->{schema} && $self->{export_schema}) { 11940 $idx_name = "$row->[9].$row->[0]"; 11941 } 11942 if (exists $idx_info{$idx_name}) { 11943 $idx_type{$row->[8]}{$row->[0]}{stemmer} = $idx_info{$idx_name}{stemmer}; 11944 } 11945 if ($row->[11] =~ /SPATIAL_INDEX/) { 11946 $idx_type{$row->[8]}{$row->[0]}{type} = 'SPATIAL INDEX'; 11947 if ($row->[12] =~ /layer_gtype=([^\s,]+)/i) { 11948 $idx_type{$row->[9]}{$row->[0]}{type_constraint} = uc($1); 11949 } 11950 if ($row->[12] =~ /sdo_indx_dims=(\d+)/i) { 11951 $idx_type{$row->[8]}{$row->[0]}{type_dims} = $1; 11952 } 11953 } 11954 if ($row->[4] eq 'BITMAP') { 11955 $idx_type{$row->[8]}{$row->[0]}{type} = $row->[4]; 11956 } 11957 push(@{$data{$row->[8]}{$row->[0]}}, $row->[1]); 11958 $index_tablespace{$row->[8]}{$row->[0]} = $row->[10]; 11959 $nidx++; 11960 } 11961 $sth->finish(); 11962 $sth2->finish(); 11963 my $t1 = Benchmark->new; 11964 $td = timediff($t1, $t0); 11965 $self->logit("Collecting $nidx indexes in $self->{prefix}_INDEXES took: " . timestr($td) . "\n", 1); 11966 11967 return \%unique, \%data, \%idx_type, \%index_tablespace; 11968} 11969 11970=head2 _get_fts_indexes_info 11971 11972This function retrieve FTS index attributes informations 11973 11974Returns a hash of containing all useful attribute values for all FTS indexes 11975 11976=cut 11977 11978sub _get_fts_indexes_info 11979{ 11980 my ($self, $owner) = @_; 11981 11982 my $condition = ''; 11983 $condition .= "AND IXV_INDEX_OWNER='$owner' " if ($owner); 11984 $condition .= $self->limit_to_objects('INDEX', "IXV_INDEX_NAME"); 11985 11986 # Retrieve all indexes informations 11987 my $sth = $self->{dbh}->prepare(<<END) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11988SELECT DISTINCT IXV_INDEX_OWNER,IXV_INDEX_NAME,IXV_CLASS,IXV_ATTRIBUTE,IXV_VALUE 11989FROM CTXSYS.CTX_INDEX_VALUES 11990WHERE (IXV_CLASS='WORDLIST' AND IXV_ATTRIBUTE='STEMMER') $condition 11991END 11992 11993 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 11994 my %indexes_info = (); 11995 while (my $row = $sth->fetch) { 11996 my $save_idx = $row->[1]; 11997 if (!$self->{schema} && $self->{export_schema}) { 11998 $row->[1] = "$row->[0].$row->[1]"; 11999 } 12000 $indexes_info{$row->[1]}{"\L$row->[3]\E"} = $row->[4]; 12001 } 12002 12003 return %indexes_info; 12004} 12005 12006 12007 12008=head2 _get_sequences 12009 12010This function implements an Oracle-native sequences information. 12011 12012Returns a hash of an array of sequence names with MIN_VALUE, MAX_VALUE, 12013INCREMENT and LAST_NUMBER for the specified table. 12014 12015=cut 12016 12017sub _get_sequences 12018{ 12019 my ($self) = @_; 12020 12021 return Ora2Pg::MySQL::_get_sequences($self) if ($self->{is_mysql}); 12022 12023 # Retrieve all indexes 12024 my $str = "SELECT DISTINCT SEQUENCE_NAME, MIN_VALUE, MAX_VALUE, INCREMENT_BY, LAST_NUMBER, CACHE_SIZE, CYCLE_FLAG, SEQUENCE_OWNER FROM $self->{prefix}_SEQUENCES"; 12025 if (!$self->{schema}) { 12026 $str .= " WHERE SEQUENCE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12027 } else { 12028 $str .= " WHERE SEQUENCE_OWNER = '$self->{schema}'"; 12029 } 12030 # Exclude sequence used for IDENTITY columns 12031 $str .= " AND SEQUENCE_NAME NOT LIKE 'ISEQ\$\$_%'"; 12032 $str .= $self->limit_to_objects('SEQUENCE', 'SEQUENCE_NAME'); 12033 #$str .= " ORDER BY SEQUENCE_NAME"; 12034 12035 12036 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12037 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12038 12039 my %seqs = (); 12040 while (my $row = $sth->fetch) 12041 { 12042 if (!$self->{schema} && $self->{export_schema}) { 12043 $row->[0] = $row->[7] . '.' . $row->[0]; 12044 } 12045 push(@{$seqs{$row->[0]}}, @$row); 12046 } 12047 12048 return \%seqs; 12049} 12050 12051=head2 _get_identities 12052 12053This function retrieve information about IDENTITY columns that must be 12054exported as PostgreSQL serial. 12055 12056=cut 12057 12058sub _get_identities 12059{ 12060 my ($self) = @_; 12061 12062 return Ora2Pg::MySQL::_get_identities($self) if ($self->{is_mysql}); 12063 12064 # Identity column appears in version 12 only 12065 return if ($self->{db_version} =~ /Release (8|9|10|11)/); 12066 12067 # Retrieve all indexes 12068 my $str = "SELECT OWNER, TABLE_NAME, COLUMN_NAME, GENERATION_TYPE, IDENTITY_OPTIONS FROM $self->{prefix}_TAB_IDENTITY_COLS"; 12069 if (!$self->{schema}) { 12070 $str .= " WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12071 } else { 12072 $str .= " WHERE OWNER = '$self->{schema}'"; 12073 } 12074 $str .= $self->limit_to_objects('TABLE', 'TABLE_NAME'); 12075 #$str .= " ORDER BY OWNER, TABLE_NAME, COLUMN_NAME"; 12076 12077 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12078 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12079 12080 my %seqs = (); 12081 while (my $row = $sth->fetch) 12082 { 12083 if (!$self->{schema} && $self->{export_schema}) { 12084 $row->[1] = "$row->[0].$row->[1]"; 12085 } 12086 # GENERATION_TYPE can be ALWAYS, BY DEFAULT and BY DEFAULT ON NULL 12087 $seqs{$row->[1]}{$row->[2]}{generation} = $row->[3]; 12088 # SEQUENCE options 12089 $seqs{$row->[1]}{$row->[2]}{options} = $row->[4]; 12090 $seqs{$row->[1]}{$row->[2]}{options} =~ s/(SCALE|EXTEND|SESSION)_FLAG: .//ig; 12091 $seqs{$row->[1]}{$row->[2]}{options} =~ s/KEEP_VALUE: .//is; 12092 $seqs{$row->[1]}{$row->[2]}{options} =~ s/(START WITH):/$1/; 12093 $seqs{$row->[1]}{$row->[2]}{options} =~ s/(INCREMENT BY):/$1/; 12094 $seqs{$row->[1]}{$row->[2]}{options} =~ s/MAX_VALUE:/MAXVALUE/; 12095 $seqs{$row->[1]}{$row->[2]}{options} =~ s/MIN_VALUE:/MINVALUE/; 12096 $seqs{$row->[1]}{$row->[2]}{options} =~ s/CYCLE_FLAG: N/NO CYCLE/; 12097 $seqs{$row->[1]}{$row->[2]}{options} =~ s/CYCLE_FLAG: Y/CYCLE/; 12098 $seqs{$row->[1]}{$row->[2]}{options} =~ s/CACHE_SIZE:/CACHE/; 12099 $seqs{$row->[1]}{$row->[2]}{options} =~ s/CACHE_SIZE:/CACHE/; 12100 $seqs{$row->[1]}{$row->[2]}{options} =~ s/ORDER_FLAG: .//; 12101 $seqs{$row->[1]}{$row->[2]}{options} =~ s/,//g; 12102 $seqs{$row->[1]}{$row->[2]}{options} =~ s/\s$//; 12103 $seqs{$row->[1]}{$row->[2]}{options} =~ s/CACHE\s+0/CACHE 1/; 12104 # For default values don't use option at all 12105 if ( $seqs{$row->[1]}{$row->[2]}{options} eq 'START WITH 1 INCREMENT BY 1 MAXVALUE 9999999999999999999999999999 MINVALUE 1 NO CYCLE CACHE 20') { 12106 delete $seqs{$row->[1]}{$row->[2]}{options}; 12107 } 12108 # Limit the sequence value to bigint max 12109 $seqs{$row->[1]}{$row->[2]}{options} =~ s/MAXVALUE 9999999999999999999999999999/MAXVALUE 9223372036854775807/; 12110 $seqs{$row->[1]}{$row->[2]}{options} =~ s/\s+/ /g; 12111 } 12112 12113 return %seqs; 12114} 12115 12116=head2 _get_external_tables 12117 12118This function implements an Oracle-native external tables information. 12119 12120Returns a hash of external tables names with the file they are based on. 12121 12122=cut 12123 12124sub _get_external_tables 12125{ 12126 my($self) = @_; 12127 12128 # Retrieve all database link from dba_db_links table 12129 my $str = "SELECT a.*,b.DIRECTORY_PATH,c.LOCATION,a.OWNER FROM $self->{prefix}_EXTERNAL_TABLES a, $self->{prefix}_DIRECTORIES b, $self->{prefix}_EXTERNAL_LOCATIONS c"; 12130 if (!$self->{schema}) { 12131 $str .= " WHERE a.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12132 } else { 12133 $str .= " WHERE a.OWNER = '$self->{schema}'"; 12134 } 12135 $str .= " AND a.DEFAULT_DIRECTORY_NAME = b.DIRECTORY_NAME AND a.TABLE_NAME=c.TABLE_NAME AND a.DEFAULT_DIRECTORY_NAME=c.DIRECTORY_NAME AND a.OWNER=c.OWNER"; 12136 $str .= $self->limit_to_objects('TABLE', 'a.TABLE_NAME'); 12137 #$str .= " ORDER BY a.TABLE_NAME"; 12138 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12139 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12140 12141 my %data = (); 12142 while (my $row = $sth->fetch) { 12143 if (!$self->{schema} && $self->{export_schema}) { 12144 $row->[1] = "$row->[0].$row->[1]"; 12145 } 12146 $data{$row->[1]}{directory} = $row->[5]; 12147 $data{$row->[1]}{directory_path} = $row->[10]; 12148 if ($data{$row->[1]}{directory_path} =~ /([\/\\])/) { 12149 $data{$row->[1]}{directory_path} .= $1 if ($data{$row->[1]}{directory_path} !~ /$1$/); 12150 } 12151 $data{$row->[1]}{location} = $row->[11]; 12152 $data{$row->[1]}{delimiter} = ','; 12153 if ($row->[8] =~ /FIELDS TERMINATED BY '(.)'/is) { 12154 $data{$row->[1]}{delimiter} = $1; 12155 } 12156 if ($row->[8] =~ /PREPROCESSOR EXECDIR\s*:\s*'([^']+)'/is) { 12157 $data{$row->[1]}{program} = $1; 12158 } 12159 } 12160 $sth->finish(); 12161 12162 return %data; 12163} 12164 12165=head2 _get_directory 12166 12167This function implements an Oracle-native directory information. 12168 12169Returns a hash of directory names with the path they are based on. 12170 12171=cut 12172 12173sub _get_directory 12174{ 12175 my ($self) = @_; 12176 12177 # Retrieve all database link from dba_db_links table 12178 my $str = "SELECT d.DIRECTORY_NAME, d.DIRECTORY_PATH, d.OWNER, p.GRANTEE, p.PRIVILEGE FROM $self->{prefix}_DIRECTORIES d, $self->{prefix}_TAB_PRIVS p"; 12179 $str .= " WHERE d.DIRECTORY_NAME = p.TABLE_NAME"; 12180 if (!$self->{schema}) { 12181 $str .= " AND p.GRANTEE NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12182 } else { 12183 $str .= " AND p.GRANTEE = '$self->{schema}'"; 12184 } 12185 $str .= $self->limit_to_objects('TABLE', 'd.DIRECTORY_NAME'); 12186 #$str .= " ORDER BY d.DIRECTORY_NAME"; 12187 12188 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12189 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12190 12191 my %data = (); 12192 while (my $row = $sth->fetch) { 12193 12194 if (!$self->{schema} && $self->{export_schema}) { 12195 $row->[0] = "$row->[2].$row->[0]"; 12196 } 12197 $data{$row->[0]}{path} = $row->[1]; 12198 if ($row->[1] !~ /\/$/) { 12199 $data{$row->[0]}{path} .= '/'; 12200 } 12201 $data{$row->[0]}{grantee}{$row->[3]} .= $row->[4]; 12202 } 12203 $sth->finish(); 12204 12205 return %data; 12206} 12207 12208=head2 _get_dblink 12209 12210This function implements an Oracle-native database link information. 12211 12212Returns a hash of dblink names with the connection they are based on. 12213 12214=cut 12215 12216 12217sub _get_dblink 12218{ 12219 my($self) = @_; 12220 12221 return Ora2Pg::MySQL::_get_dblink($self) if ($self->{is_mysql}); 12222 12223 # Retrieve all database link from dba_db_links table 12224 my $str = "SELECT OWNER,DB_LINK,USERNAME,HOST FROM $self->{prefix}_DB_LINKS"; 12225 if (!$self->{schema}) { 12226 $str .= " WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12227 } else { 12228 $str .= " WHERE OWNER = '$self->{schema}'"; 12229 } 12230 $str .= $self->limit_to_objects('DBLINK', 'DB_LINK'); 12231 #$str .= " ORDER BY DB_LINK"; 12232 12233 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12234 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12235 12236 my %data = (); 12237 while (my $row = $sth->fetch) { 12238 if (!$self->{schema} && $self->{export_schema}) { 12239 $row->[1] = "$row->[0].$row->[1]"; 12240 } 12241 $data{$row->[1]}{owner} = $row->[0]; 12242 $data{$row->[1]}{user} = $row->[2]; 12243 $data{$row->[1]}{username} = $self->{pg_user} || $row->[2]; 12244 $data{$row->[1]}{host} = $row->[3]; 12245 } 12246 12247 return %data; 12248} 12249 12250=head2 _get_job 12251 12252This function implements an Oracle-native job information. 12253 12254Reads together from view [ALL|DBA]_JOBS and from view [ALL|DBA]_SCHEDULER_JOBS. 12255 12256Returns a hash of job number with the connection they are based on. 12257 12258=cut 12259 12260 12261sub _get_job 12262{ 12263 my($self) = @_; 12264 12265 return Ora2Pg::MySQL::_get_job($self) if ($self->{is_mysql}); 12266 12267 # Jobs appears in version 10 only 12268 return if ($self->{db_version} =~ /Release [8|9]/); 12269 12270 # Retrieve all database job from user_jobs table 12271 my $str = "SELECT JOB,WHAT,INTERVAL,SCHEMA_USER FROM $self->{prefix}_JOBS"; 12272 if (!$self->{schema}) { 12273 $str .= " WHERE SCHEMA_USER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12274 } else { 12275 $str .= " WHERE SCHEMA_USER = '$self->{schema}'"; 12276 } 12277 $str .= $self->limit_to_objects('JOB', 'JOB'); 12278 #$str .= " ORDER BY JOB"; 12279 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12280 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12281 12282 my %data = (); 12283 while (my $row = $sth->fetch) { 12284 if (!$self->{schema} && $self->{export_schema}) { 12285 $row->[0] = "$row->[3].$row->[0]"; 12286 } 12287 $data{$row->[0]}{what} = $row->[1]; 12288 $data{$row->[0]}{interval} = $row->[2]; 12289 } 12290 12291 # Retrieve all database jobs from view [ALL|DBA]_SCHEDULER_JOBS 12292 $str = "SELECT job_name AS JOB, job_action AS WHAT, repeat_interval AS INTERVAL, owner AS SCHEMA_USER"; 12293 $str .= " FROM $self->{prefix}_SCHEDULER_JOBS"; 12294 $str .= " WHERE repeat_interval IS NOT NULL"; 12295 $str .= " AND client_id IS NULL"; 12296 if (!$self->{schema}) { 12297 $str .= " AND owner NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12298 } else { 12299 $str .= " AND owner = '$self->{schema}'"; 12300 } 12301 $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12302 $sth->execute or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12303 while ($row = $sth->fetch) { 12304 if (!$self->{schema} && $self->{export_schema}) { 12305 $row->[0] = "$row->[3].$row->[0]"; 12306 } 12307 $data{$row->[0]}{what} = $row->[1]; 12308 $data{$row->[0]}{interval} = $row->[2]; 12309 } 12310 12311 return %data; 12312} 12313 12314 12315=head2 _get_views 12316 12317This function implements an Oracle-native views information. 12318 12319Returns a hash of view names with the SQL queries they are based on. 12320 12321=cut 12322 12323sub _get_views 12324{ 12325 my($self) = @_; 12326 12327 12328 return Ora2Pg::MySQL::_get_views($self) if ($self->{is_mysql}); 12329 12330 my $owner = ''; 12331 if ($self->{schema}) { 12332 $owner = "AND A.OWNER='$self->{schema}' "; 12333 } else { 12334 $owner = "AND A.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 12335 } 12336 12337 #### 12338 # Get name of all VIEW objects in ALL_OBJECTS looking at OBJECT_TYPE='VIEW' 12339 #### 12340 my $sql = "SELECT A.OWNER,A.OBJECT_NAME,A.OBJECT_TYPE FROM $self->{prefix}_OBJECTS A WHERE A.OBJECT_TYPE IN 'VIEW' $owner"; 12341 if (!$self->{export_invalid}) { 12342 $sql .= " AND A.STATUS='VALID'"; 12343 } 12344 $sql .= $self->limit_to_objects('VIEW', 'A.OBJECT_NAME'); 12345 $self->logit("DEBUG: $sql\n", 2); 12346 my $t0 = Benchmark->new; 12347 my $sth = $self->{dbh}->prepare( $sql ) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12348 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12349 my $nrows = 0; 12350 my %tbtype = (); 12351 while (my $row = $sth->fetch) 12352 { 12353 $all_objects{"$row->[0].$row->[1]"} = $row->[2]; 12354 $nrows++; 12355 } 12356 $sth->finish(); 12357 my $t1 = Benchmark->new; 12358 my $td = timediff($t1, $t0); 12359 $self->logit("Collecting $nrows tables in $self->{prefix}_OBJECTS took: " . timestr($td) . "\n", 1); 12360 12361 my %comments = (); 12362 if ($self->{type} ne 'SHOW_REPORT') 12363 { 12364 $sql = "SELECT A.TABLE_NAME,A.COMMENTS,A.TABLE_TYPE,A.OWNER FROM $self->{prefix}_TAB_COMMENTS A WHERE 1=1 $owner"; 12365 $sql .= $self->limit_to_objects('VIEW', 'A.TABLE_NAME'); 12366 $sth = $self->{dbh}->prepare( $sql ) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12367 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12368 while (my $row = $sth->fetch) 12369 { 12370 next if (!exists $self->{all_objects}{"$row->[3].$row->[0]"}); 12371 12372 if (!$self->{schema} && $self->{export_schema}) 12373 { 12374 $row->[0] = "$row->[3].$row->[0]"; 12375 } 12376 $comments{$row->[0]}{comment} = $row->[1]; 12377 $comments{$row->[0]}{table_type} = $row->[2]; 12378 } 12379 $sth->finish(); 12380 } 12381 12382 # Retrieve all views 12383 my $str = "SELECT v.VIEW_NAME,v.TEXT,v.OWNER FROM $self->{prefix}_VIEWS v"; 12384 if (!$self->{schema}) { 12385 $str .= " WHERE v.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12386 } else { 12387 $str .= " WHERE v.OWNER = '$self->{schema}'"; 12388 } 12389 $str .= $self->limit_to_objects('VIEW', 'v.VIEW_NAME'); 12390 12391 # Compute view order, where depended view appear before using view 12392 my %view_order = (); 12393 if ($self->{type} ne 'SHOW_REPORT' && !$self->{no_view_ordering}) 12394 { 12395 if ($self->{db_version} !~ /Release (8|9|10|11\.1)/) 12396 { 12397 if ($self->{schema}) { 12398 $owner = "AND o.OWNER='$self->{schema}' "; 12399 } else { 12400 $owner = "AND o.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 12401 } 12402 $sql = qq{ 12403WITH x (ITER, OWNER, OBJECT_NAME) AS 12404( SELECT 1 , o.OWNER, o.OBJECT_NAME FROM $self->{prefix}_OBJECTS o WHERE OBJECT_TYPE = 'VIEW' $owner 12405 AND NOT EXISTS (SELECT 1 FROM $self->{prefix}_DEPENDENCIES d WHERE TYPE LIKE 'VIEW' AND REFERENCED_TYPE = 'VIEW' 12406 AND REFERENCED_OWNER = o.OWNER AND d.OWNER = o.OWNER and o.OBJECT_NAME=d.NAME) 12407UNION ALL 12408 SELECT ITER + 1, d.OWNER, d.NAME FROM $self->{prefix}_DEPENDENCIES d 12409 JOIN x ON d.REFERENCED_OWNER = x.OWNER and d.REFERENCED_NAME = x.OBJECT_NAME 12410 WHERE TYPE LIKE 'VIEW' AND REFERENCED_TYPE = 'VIEW' 12411) 12412SELECT max(ITER) ITER, OWNER, OBJECT_NAME FROM x 12413GROUP BY OWNER, OBJECT_NAME 12414ORDER BY ITER ASC, 2, 3 12415}; 12416 12417 my $sth = $self->{dbh}->prepare( $sql ) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12418 $sth->execute or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12419 while (my $row = $sth->fetch) { 12420 $view_order{"\U$row->[1].$row->[2]\E"} = $row->[0]; 12421 } 12422 $sth->finish(); 12423 } 12424 } 12425 12426 $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12427 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12428 12429 my %data = (); 12430 while (my $row = $sth->fetch) 12431 { 12432 next if (!exists $all_objects{"$row->[2].$row->[0]"}); 12433 if (!$self->{schema} && $self->{export_schema}) { 12434 $row->[0] = "$row->[2].$row->[0]"; 12435 } 12436 $data{$row->[0]}{text} = $row->[1]; 12437 $data{$row->[0]}{owner} = $row->[2]; 12438 $data{$row->[0]}{comment} = $comments{$row->[0]}{comment} || ''; 12439 if ($self->{type} ne 'SHOW_REPORT') 12440 { 12441 @{$data{$row->[0]}{alias}} = $self->_alias_info ($row->[0]); 12442 } 12443 if ($self->{type} ne 'SHOW_REPORT' && exists $view_order{"\U$row->[2].$row->[0]\E"}) 12444 { 12445 $data{$row->[0]}{iter} = $view_order{"\U$row->[2].$row->[0]\E"}; 12446 } 12447 } 12448 12449 return %data; 12450} 12451 12452=head2 _get_materialized_views 12453 12454This function implements an Oracle-native materialized views information. 12455 12456Returns a hash of view names with the SQL queries they are based on. 12457 12458=cut 12459 12460sub _get_materialized_views 12461{ 12462 my($self) = @_; 12463 12464 return Ora2Pg::MySQL::_get_materialized_views($self) if ($self->{is_mysql}); 12465 12466 # Retrieve all views 12467 my $str = "SELECT MVIEW_NAME,QUERY,UPDATABLE,REFRESH_MODE,REFRESH_METHOD,USE_NO_INDEX,REWRITE_ENABLED,BUILD_MODE,OWNER FROM $self->{prefix}_MVIEWS"; 12468 if ($self->{db_version} =~ /Release 8/) { 12469 $str = "SELECT MVIEW_NAME,QUERY,UPDATABLE,REFRESH_MODE,REFRESH_METHOD,'',REWRITE_ENABLED,BUILD_MODE,OWNER FROM $self->{prefix}_MVIEWS"; 12470 } 12471 if (!$self->{schema}) { 12472 $str .= " WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12473 } else { 12474 $str .= " WHERE OWNER = '$self->{schema}'"; 12475 } 12476 $str .= $self->limit_to_objects('MVIEW', 'MVIEW_NAME'); 12477 #$str .= " ORDER BY MVIEW_NAME"; 12478 my $sth = $self->{dbh}->prepare($str); 12479 if (not defined $sth) { 12480 $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12481 } 12482 if (not $sth->execute(@{$self->{query_bind_params}})) { 12483 $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12484 return (); 12485 } 12486 12487 my %data = (); 12488 while (my $row = $sth->fetch) { 12489 if (!$self->{schema} && $self->{export_schema}) { 12490 $row->[0] = "$row->[8].$row->[0]"; 12491 } 12492 $data{$row->[0]}{text} = $row->[1]; 12493 $data{$row->[0]}{updatable} = ($row->[2] eq 'Y') ? 1 : 0; 12494 $data{$row->[0]}{refresh_mode} = $row->[3]; 12495 $data{$row->[0]}{refresh_method} = $row->[4]; 12496 $data{$row->[0]}{no_index} = ($row->[5] eq 'Y') ? 1 : 0; 12497 $data{$row->[0]}{rewritable} = ($row->[6] eq 'Y') ? 1 : 0; 12498 $data{$row->[0]}{build_mode} = $row->[7]; 12499 $data{$row->[0]}{owner} = $row->[8]; 12500 } 12501 12502 return %data; 12503} 12504 12505sub _get_materialized_view_names 12506{ 12507 my($self) = @_; 12508 12509 # Retrieve all views 12510 my $str = "SELECT MVIEW_NAME,OWNER FROM $self->{prefix}_MVIEWS"; 12511 if (!$self->{schema}) { 12512 $str .= " WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12513 } else { 12514 $str .= " WHERE OWNER = '$self->{schema}'"; 12515 } 12516 $str .= $self->limit_to_objects('MVIEW', 'MVIEW_NAME'); 12517 #$str .= " ORDER BY MVIEW_NAME"; 12518 my $sth = $self->{dbh}->prepare($str); 12519 if (not defined $sth) { 12520 $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12521 } 12522 if (not $sth->execute(@{$self->{query_bind_params}})) { 12523 $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12524 } 12525 12526 my @data = (); 12527 while (my $row = $sth->fetch) { 12528 if (!$self->{schema} && $self->{export_schema}) { 12529 $row->[0] = "$row->[1].$row->[0]"; 12530 } 12531 push(@data, uc($row->[0])); 12532 } 12533 12534 return @data; 12535} 12536 12537 12538=head2 _alias_info 12539 12540This function implements an Oracle-native column information. 12541 12542Returns a list of array references containing the following information 12543for each alias of the specified view: 12544 12545[( 12546 column name, 12547 column id 12548)] 12549 12550=cut 12551 12552sub _alias_info 12553{ 12554 my ($self, $view) = @_; 12555 12556 my $str = "SELECT COLUMN_NAME, COLUMN_ID, OWNER FROM $self->{prefix}_TAB_COLUMNS WHERE TABLE_NAME='$view'"; 12557 if ($self->{schema}) { 12558 $str .= " AND OWNER = '$self->{schema}'"; 12559 } else { 12560 $str .= " AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12561 } 12562 $str .= " ORDER BY COLUMN_ID ASC"; 12563 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12564 $sth->execute or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12565 my $data = $sth->fetchall_arrayref(); 12566 $self->logit("View $view column aliases:\n", 1); 12567 foreach my $d (@$data) { 12568 if (!$self->{schema} && $self->{export_schema}) { 12569 $row->[0] = "$row->[2].$row->[0]"; 12570 } 12571 $self->logit("\t$d->[0] => column id:$d->[1]\n", 1); 12572 } 12573 12574 return @$data; 12575 12576} 12577 12578=head2 _get_triggers 12579 12580This function implements an Oracle-native triggers information. 12581 12582Returns an array of refarray of all triggers information. 12583 12584=cut 12585 12586sub _get_triggers 12587{ 12588 my($self) = @_; 12589 12590 return Ora2Pg::MySQL::_get_triggers($self) if ($self->{is_mysql}); 12591 12592 # Retrieve all indexes 12593 my $str = "SELECT TRIGGER_NAME, TRIGGER_TYPE, TRIGGERING_EVENT, TABLE_NAME, TRIGGER_BODY, WHEN_CLAUSE, DESCRIPTION, ACTION_TYPE, OWNER FROM $self->{prefix}_TRIGGERS WHERE STATUS='ENABLED'"; 12594 if (!$self->{schema}) { 12595 $str .= " AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12596 } else { 12597 $str .= " AND OWNER = '$self->{schema}'"; 12598 } 12599 $str .= " " . $self->limit_to_objects('TABLE|VIEW|TRIGGER','TABLE_NAME|TABLE_NAME|TRIGGER_NAME'); 12600 12601 #$str .= " ORDER BY TABLE_NAME, TRIGGER_NAME"; 12602 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12603 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12604 12605 my @triggers = (); 12606 while (my $row = $sth->fetch) { 12607 push(@triggers, [ @$row ]); 12608 } 12609 12610 return \@triggers; 12611} 12612 12613sub _list_triggers 12614{ 12615 my($self) = @_; 12616 12617 return Ora2Pg::MySQL::_list_triggers($self) if ($self->{is_mysql}); 12618 12619 # Retrieve all indexes 12620 my $str = "SELECT TRIGGER_NAME, TABLE_NAME, OWNER FROM $self->{prefix}_TRIGGERS WHERE STATUS='ENABLED'"; 12621 if (!$self->{schema}) { 12622 $str .= " AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12623 } else { 12624 $str .= " AND OWNER = '$self->{schema}'"; 12625 } 12626 $str .= " " . $self->limit_to_objects('TABLE|VIEW|TRIGGER','TABLE_NAME|TABLE_NAME|TRIGGER_NAME'); 12627 12628 #$str .= " ORDER BY TABLE_NAME, TRIGGER_NAME"; 12629 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12630 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12631 12632 my %triggers = (); 12633 while (my $row = $sth->fetch) { 12634 if (!$self->{schema} && $self->{export_schema}) { 12635 push(@{$triggers{"$row->[2].$row->[1]"}}, $row->[0]); 12636 } else { 12637 push(@{$triggers{$row->[1]}}, $row->[0]); 12638 } 12639 } 12640 12641 return %triggers; 12642} 12643 12644=head2 _get_plsql_metadata 12645 12646This function retrieve all metadata on Oracle store procedure. 12647 12648Returns a hash of all function names with their metadata 12649information (arguments, return type, etc.). 12650 12651=cut 12652 12653sub _get_plsql_metadata 12654{ 12655 my $self = shift; 12656 my $owner = shift; 12657 12658 return Ora2Pg::MySQL::_get_plsql_metadata($self, $owner) if ($self->{is_mysql}); 12659 12660 # Retrieve all functions 12661 my $str = "SELECT DISTINCT OBJECT_NAME,OWNER,OBJECT_TYPE FROM $self->{prefix}_OBJECTS WHERE (OBJECT_TYPE = 'FUNCTION' OR OBJECT_TYPE = 'PROCEDURE' OR OBJECT_TYPE = 'PACKAGE BODY')"; 12662 $str .= " AND STATUS='VALID'" if (!$self->{export_invalid}); 12663 if ($owner) { 12664 $str .= " AND OWNER = '$owner'"; 12665 $self->logit("Looking forward functions declaration in schema $owner.\n", 1) if (!$quiet); 12666 } elsif (!$self->{schema}) { 12667 $str .= " AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12668 $self->logit("Looking forward functions declaration in all schema.\n", 1) if (!$quiet); 12669 } else { 12670 $str .= " AND OWNER = '$self->{schema}'"; 12671 $self->logit("Looking forward functions declaration in schema $self->{schema}.\n", 1) if (!$quiet); 12672 } 12673 #$str .= " ORDER BY OBJECT_NAME"; 12674 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12675 $sth->execute or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12676 12677 my %functions = (); 12678 my @fct_done = (); 12679 push(@fct_done, @EXCLUDED_FUNCTION); 12680 while (my $row = $sth->fetch) { 12681 next if (grep(/^$row->[1].$row->[0]$/i, @fct_done)); 12682 push(@fct_done, "$row->[1].$row->[0]"); 12683 $self->{function_metadata}{$row->[1]}{'none'}{$row->[0]}{type} = $row->[2]; 12684 } 12685 $sth->finish(); 12686 12687 # Get content of package body 12688 my $sql = "SELECT NAME, OWNER, TYPE, TEXT FROM $self->{prefix}_SOURCE"; 12689 if ($owner) { 12690 $sql .= " WHERE OWNER = '$owner'"; 12691 } elsif (!$self->{schema}) { 12692 $sql .= " WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12693 } else { 12694 $sql .= " WHERE OWNER = '$self->{schema}'"; 12695 } 12696 $sql .= " AND TYPE <> 'PACKAGE'"; 12697 $sql .= " ORDER BY OWNER, NAME, LINE"; 12698 $sth = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12699 $sth->execute or $self->logit("FATAL: " . $sth->errstr . "\n", 0, 1); 12700 while (my $row = $sth->fetch) 12701 { 12702 next if (!exists $self->{function_metadata}{$row->[1]}{'none'}{$row->[0]}); 12703 $self->{function_metadata}{$row->[1]}{'none'}{$row->[0]}{text} .= $row->[3]; 12704 } 12705 $sth->finish(); 12706 12707 # For each schema in the Oracle instance 12708 foreach my $sch (sort keys %{ $self->{function_metadata} }) 12709 { 12710 next if ( ($owner && ($sch ne $owner)) || (!$owner && $self->{schema} && ($sch ne $self->{schema})) ); 12711 # Look for functions/procedures 12712 foreach my $name (sort keys %{$self->{function_metadata}{$sch}{'none'}}) 12713 { 12714 if ($self->{function_metadata}{$sch}{'none'}{$name}{type} ne 'PACKAGE BODY') 12715 { 12716 # Retrieve metadata for this function after removing comments 12717 $self->_remove_comments(\$self->{function_metadata}{$sch}{'none'}{$name}{text}, 1); 12718 $self->{comment_values} = (); 12719 $self->{function_metadata}{$sch}{'none'}{$name}{text} =~ s/\%ORA2PG_COMMENT\d+\%//gs; 12720 my %fct_detail = $self->_lookup_function($self->{function_metadata}{$sch}{'none'}{$name}{text}); 12721 if (!exists $fct_detail{name}) 12722 { 12723 delete $self->{function_metadata}{$sch}{'none'}{$name}; 12724 next; 12725 } 12726 delete $fct_detail{code}; 12727 delete $fct_detail{before}; 12728 %{$self->{function_metadata}{$sch}{'none'}{$name}{metadata}} = %fct_detail; 12729 delete $self->{function_metadata}{$sch}{'none'}{$name}{text}; 12730 } 12731 else 12732 { 12733 $self->_remove_comments(\$self->{function_metadata}{$sch}{'none'}{$name}{text}, 1); 12734 $self->{comment_values} = (); 12735 $self->{function_metadata}{$sch}{'none'}{$name}{text} =~ s/\%ORA2PG_COMMENT\d+\%//gs; 12736 my %infos = $self->_lookup_package($self->{function_metadata}{$sch}{'none'}{$name}{text}); 12737 delete $self->{function_metadata}{$sch}{'none'}{$name}; 12738 $name =~ s/"//g; 12739 foreach my $f (sort keys %infos) 12740 { 12741 next if (!$f); 12742 my $fn = lc($f); 12743 delete $infos{$f}{code}; 12744 delete $infos{$f}{before}; 12745 %{$self->{function_metadata}{$sch}{$name}{$fn}{metadata}} = %{$infos{$f}}; 12746 my $res_name = $f; 12747 $res_name =~ s/^([^\.]+)\.//; 12748 $f =~ s/^([^\.]+)\.//; 12749 if ($self->{package_as_schema}) { 12750 $res_name = $name . '.' . $res_name; 12751 } else { 12752 $res_name = $name . '_' . $res_name; 12753 } 12754 $res_name =~ s/"_"/_/g; 12755 $f =~ s/"//g; 12756 $self->{package_functions}{"\L$name\E"}{"\L$f\E"}{name} = $self->quote_object_name($res_name); 12757 $self->{package_functions}{"\L$name\E"}{"\L$f\E"}{package} = $name; 12758 } 12759 } 12760 } 12761 } 12762} 12763 12764 12765=head2 _get_package_function_list 12766 12767This function retrieve all function and procedure 12768defined on Oracle store procedure PACKAGE. 12769 12770Returns a hash of all package function names 12771 12772=cut 12773 12774sub _get_package_function_list 12775{ 12776 my $self = shift; 12777 my $owner = shift; 12778 12779 return Ora2Pg::MySQL::_get_package_function_list($self, $owner) if ($self->{is_mysql}); 12780 12781 # Retrieve all package information 12782 my $str = "SELECT DISTINCT OBJECT_NAME,OWNER FROM $self->{prefix}_OBJECTS WHERE OBJECT_TYPE = 'PACKAGE BODY'"; 12783 $str .= " AND STATUS='VALID'" if (!$self->{export_invalid}); 12784 if ($owner) { 12785 $str .= " AND OWNER = '$owner'"; 12786 $self->logit("Looking forward functions declaration in schema $owner.\n", 1) if (!$quiet); 12787 } elsif (!$self->{schema}) { 12788 $str .= " AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12789 $self->logit("Looking forward functions declaration in all schema.\n", 1) if (!$quiet); 12790 } else { 12791 $str .= " AND OWNER = '$self->{schema}'"; 12792 $self->logit("Looking forward functions declaration in schema $self->{schema}.\n", 1) if (!$quiet); 12793 } 12794 #$str .= " ORDER BY OBJECT_NAME"; 12795 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12796 $sth->execute or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12797 12798 my @packages = (); 12799 while (my $row = $sth->fetch) { 12800 next if (grep(/^$row->[0]$/i, @packages)); 12801 push(@packages, $row->[0]); 12802 } 12803 $sth->finish(); 12804 12805 # Get content of all packages definition 12806 my $sql = "SELECT NAME, OWNER, TYPE, TEXT FROM $self->{prefix}_SOURCE"; 12807 if ($owner) { 12808 $sql .= " WHERE OWNER = '$owner'"; 12809 } elsif (!$self->{schema}) { 12810 $sql .= " WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12811 } else { 12812 $sql .= " WHERE OWNER = '$self->{schema}'"; 12813 } 12814 $sql .= " AND TYPE <> 'PACKAGE'"; 12815 $sql .= " AND NAME IN ('" . join("','", @packages) . "')" if ($#packages >= 0); 12816 $sql .= " ORDER BY OWNER, NAME, LINE"; 12817 $sth = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12818 $sth->execute or $self->logit("FATAL: " . $sth->errstr . "\n", 0, 1); 12819 my %function_metadata = (); 12820 while (my $row = $sth->fetch) { 12821 $function_metadata{$row->[1]}{$row->[0]}{text} .= $row->[3]; 12822 } 12823 $sth->finish(); 12824 12825 my @fct_done = (); 12826 push(@fct_done, @EXCLUDED_FUNCTION); 12827 foreach my $sch (sort keys %function_metadata) 12828 { 12829 next if ( ($owner && ($sch ne $owner)) || (!$owner && $self->{schema} && ($sch ne $self->{schema})) ); 12830 foreach my $name (sort keys %{$function_metadata{$sch}}) 12831 { 12832 $self->_remove_comments(\$function_metadata{$sch}{$name}{text}, 1); 12833 $self->{comment_values} = (); 12834 $function_metadata{$sch}{$name}{text} =~ s/\%ORA2PG_COMMENT\d+\%//gs; 12835 my %infos = $self->_lookup_package($function_metadata{$sch}{$name}{text}); 12836 delete $function_metadata{$sch}{$name}; 12837 foreach my $f (sort keys %infos) 12838 { 12839 next if (!$f); 12840 my $fn = lc($f); 12841 my $res_name = $f; 12842 if ($res_name =~ s/^([^\.]+)\.//) { 12843 next if (lc($1) ne lc($name)); 12844 } 12845 if ($self->{package_as_schema}) { 12846 $res_name = $name . '.' . $res_name; 12847 } else { 12848 $res_name = $name . '_' . $res_name; 12849 } 12850 $res_name =~ s/"_"/_/g; 12851 $f =~ s/"//gs; 12852 if ($res_name) 12853 { 12854 $self->{package_functions}{"\L$name\E"}{"\L$f\E"}{name} = $self->quote_object_name($res_name); 12855 $self->{package_functions}{"\L$name\E"}{"\L$f\E"}{package} = $name; 12856 } 12857 } 12858 } 12859 } 12860} 12861 12862=head2 _get_functions 12863 12864This function implements an Oracle-native functions information. 12865 12866Returns a hash of all function names with their PLSQL code. 12867 12868=cut 12869 12870sub _get_functions 12871{ 12872 my $self = shift; 12873 12874 return Ora2Pg::MySQL::_get_functions($self) if ($self->{is_mysql}); 12875 12876 # Retrieve all functions 12877 my $str = "SELECT DISTINCT OBJECT_NAME,OWNER FROM $self->{prefix}_OBJECTS WHERE OBJECT_TYPE='FUNCTION'"; 12878 $str .= " AND STATUS='VALID'" if (!$self->{export_invalid}); 12879 if (!$self->{schema}) { 12880 $str .= " AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12881 } else { 12882 $str .= " AND OWNER = '$self->{schema}'"; 12883 } 12884 $str .= " " . $self->limit_to_objects('FUNCTION','OBJECT_NAME'); 12885 #$str .= " ORDER BY OBJECT_NAME"; 12886 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12887 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12888 12889 my %functions = (); 12890 my @fct_done = (); 12891 push(@fct_done, @EXCLUDED_FUNCTION); 12892 while (my $row = $sth->fetch) { 12893 if (!$self->{schema} && $self->{export_schema}) { 12894 $row->[0] = "$row->[1].$row->[0]"; 12895 } 12896 next if (grep(/^$row->[0]$/i, @fct_done)); 12897 push(@fct_done, $row->[0]); 12898 $functions{"$row->[0]"}{owner} = $row->[1]; 12899 } 12900 $sth->finish(); 12901 12902 my $sql = "SELECT NAME,OWNER,TEXT FROM $self->{prefix}_SOURCE"; 12903 if (!$self->{schema}) { 12904 $sql .= " WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12905 } else { 12906 $sql .= " WHERE OWNER = '$self->{schema}'"; 12907 } 12908 $sql .= " " . $self->limit_to_objects('FUNCTION','NAME'); 12909 $sql .= " ORDER BY OWNER,NAME,LINE"; 12910 $sth = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12911 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $sth->errstr . "\n", 0, 1); 12912 while (my $row = $sth->fetch) { 12913 if (!$self->{schema} && $self->{export_schema}) { 12914 $row->[0] = "$row->[1].$row->[0]"; 12915 } 12916 # Fix possible Malformed UTF-8 character 12917 $row->[2] = encode('UTF-8', $row->[2]); 12918 # Remove some bargage when migrating from 8i 12919 $row->[2] =~ s/\bAUTHID\s+[^\s]+\s+//is; 12920 if (exists $functions{"$row->[0]"}) { 12921 $functions{"$row->[0]"}{text} .= $row->[2]; 12922 } 12923 } 12924 12925 return \%functions; 12926} 12927 12928sub _get_functions2 12929{ 12930 my $self = shift; 12931 12932 return Ora2Pg::MySQL::_get_functions($self) if ($self->{is_mysql}); 12933 12934 # Retrieve all functions 12935 my $str = "SELECT DISTINCT OBJECT_NAME,OWNER FROM $self->{prefix}_OBJECTS WHERE OBJECT_TYPE='FUNCTION'"; 12936 $str .= " AND STATUS='VALID'" if (!$self->{export_invalid}); 12937 if (!$self->{schema}) { 12938 $str .= " AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12939 } else { 12940 $str .= " AND OWNER = '$self->{schema}'"; 12941 } 12942 $str .= " " . $self->limit_to_objects('FUNCTION','OBJECT_NAME'); 12943 #$str .= " ORDER BY OBJECT_NAME"; 12944 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12945 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12946 12947 my %functions = (); 12948 my @fct_done = (); 12949 push(@fct_done, @EXCLUDED_FUNCTION); 12950 while (my $row = $sth->fetch) { 12951 my $sql = "SELECT TEXT FROM $self->{prefix}_SOURCE WHERE OWNER='$row->[1]' AND NAME='$row->[0]' ORDER BY LINE"; 12952 if (!$self->{schema} && $self->{export_schema}) { 12953 $row->[0] = "$row->[1].$row->[0]"; 12954 } 12955 next if (grep(/^$row->[0]$/i, @fct_done)); 12956 push(@fct_done, $row->[0]); 12957 my $sth2 = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12958 $sth2->execute or $self->logit("FATAL: " . $sth2->errstr . "\n", 0, 1); 12959 while (my $r = $sth2->fetch) { 12960 $functions{"$row->[0]"}{text} .= $r->[0]; 12961 } 12962 $functions{"$row->[0]"}{owner} .= $row->[1]; 12963 } 12964 12965 return \%functions; 12966} 12967 12968=head2 _get_procedures 12969 12970This procedure implements an Oracle-native procedures information. 12971 12972Returns a hash of all procedure names with their PLSQL code. 12973 12974=cut 12975 12976sub _get_procedures 12977{ 12978 my $self = shift; 12979 12980 return Ora2Pg::MySQL::_get_functions($self) if ($self->{is_mysql}); 12981 12982 # Retrieve all functions 12983 my $str = "SELECT DISTINCT OBJECT_NAME,OWNER FROM $self->{prefix}_OBJECTS WHERE OBJECT_TYPE='PROCEDURE'"; 12984 $str .= " AND STATUS='VALID'" if (!$self->{export_invalid}); 12985 if (!$self->{schema}) { 12986 $str .= " AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 12987 } else { 12988 $str .= " AND OWNER = '$self->{schema}'"; 12989 } 12990 $str .= " " . $self->limit_to_objects('PROCEDURE','OBJECT_NAME'); 12991 #$str .= " ORDER BY OBJECT_NAME"; 12992 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12993 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 12994 12995 my %procedures = (); 12996 my @fct_done = (); 12997 push(@fct_done, @EXCLUDED_FUNCTION); 12998 while (my $row = $sth->fetch) { 12999 if (!$self->{schema} && $self->{export_schema}) { 13000 $row->[0] = "$row->[1].$row->[0]"; 13001 } 13002 next if (grep(/^$row->[0]$/i, @fct_done)); 13003 push(@fct_done, $row->[0]); 13004 $procedures{"$row->[0]"}{owner} = $row->[1]; 13005 } 13006 $sth->finish(); 13007 13008 my $sql = "SELECT NAME,OWNER,TEXT FROM $self->{prefix}_SOURCE"; 13009 if (!$self->{schema}) { 13010 $sql .= " WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 13011 } else { 13012 $sql .= " WHERE OWNER = '$self->{schema}'"; 13013 } 13014 $sql .= " " . $self->limit_to_objects('PROCEDURE','NAME'); 13015 $sql .= " ORDER BY OWNER,NAME,LINE"; 13016 $sth = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13017 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $sth->errstr . "\n", 0, 1); 13018 while (my $row = $sth->fetch) { 13019 if (!$self->{schema} && $self->{export_schema}) { 13020 $row->[0] = "$row->[1].$row->[0]"; 13021 } 13022 # Remove some bargage when migrating from 8i 13023 $row->[2] = encode('UTF-8', $row->[2]); 13024 $row->[2] =~ s/\bAUTHID\s+[^\s]+\s+//is; 13025 if (exists $procedures{"$row->[0]"}) { 13026 $procedures{"$row->[0]"}{text} .= $row->[2]; 13027 } 13028 } 13029 13030 return \%procedures; 13031} 13032 13033=head2 _get_packages 13034 13035This function implements an Oracle-native packages information. 13036 13037Returns a hash of all package names with their PLSQL code. 13038 13039=cut 13040 13041sub _get_packages 13042{ 13043 my ($self) = @_; 13044 13045 # Retrieve all indexes 13046 #my $str = "SELECT DISTINCT OBJECT_NAME,OWNER FROM $self->{prefix}_OBJECTS WHERE OBJECT_TYPE = 'PACKAGE BODY'"; 13047 my $str = "SELECT DISTINCT OBJECT_NAME,OWNER FROM $self->{prefix}_OBJECTS WHERE OBJECT_TYPE = 'PACKAGE'"; 13048 $str .= " AND STATUS='VALID'" if (!$self->{export_invalid}); 13049 if (!$self->{schema}) { 13050 $str .= " AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 13051 } else { 13052 $str .= " AND OWNER = '$self->{schema}'"; 13053 } 13054 $str .= " " . $self->limit_to_objects('PACKAGE','OBJECT_NAME'); 13055 #$str .= " ORDER BY OBJECT_NAME"; 13056 13057 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13058 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13059 13060 my %packages = (); 13061 my @fct_done = (); 13062 while (my $row = $sth->fetch) 13063 { 13064 $self->logit("\tFound Package: $row->[0]\n", 1); 13065 next if (grep(/^$row->[0]$/, @fct_done)); 13066 push(@fct_done, $row->[0]); 13067 # Get package definition first 13068 my $sql = "SELECT TEXT FROM $self->{prefix}_SOURCE WHERE OWNER='$row->[1]' AND NAME='$row->[0]' AND TYPE='PACKAGE' ORDER BY LINE"; 13069 my $sth2 = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13070 $sth2->execute or $self->logit("FATAL: " . $sth2->errstr . "\n", 0, 1); 13071 while (my $r = $sth2->fetch) 13072 { 13073 $packages{$row->[0]}{desc} .= 'CREATE OR REPLACE ' if ($r->[0] =~ /^PACKAGE\s+/is); 13074 $packages{$row->[0]}{desc} .= $r->[0]; 13075 } 13076 $sth2->finish(); 13077 $packages{$row->[0]}{desc} .= "\n" if (exists $packages{$row->[0]}); 13078 13079 # Then package body code 13080 $sql = "SELECT TEXT FROM $self->{prefix}_SOURCE WHERE OWNER='$row->[1]' AND NAME='$row->[0]' AND TYPE='PACKAGE BODY' ORDER BY LINE"; 13081 $sth2 = $self->{dbh}->prepare($sql) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13082 $sth2->execute or $self->logit("FATAL: " . $sth2->errstr . "\n", 0, 1); 13083 while (my $r = $sth2->fetch) { 13084 $packages{$row->[0]}{text} .= 'CREATE OR REPLACE ' if ($r->[0] =~ /^PACKAGE\s+/is); 13085 $packages{$row->[0]}{text} .= $r->[0]; 13086 } 13087 $packages{$row->[0]}{owner} = $row->[1]; 13088 } 13089 13090 return \%packages; 13091} 13092 13093=head2 _get_types 13094 13095This function implements an Oracle custom types information. 13096 13097Returns a hash of all type names with their code. 13098 13099=cut 13100 13101sub _get_types 13102{ 13103 my ($self, $name) = @_; 13104 13105 # Retrieve all user defined types 13106 my $str = "SELECT DISTINCT OBJECT_NAME,OWNER,OBJECT_ID FROM $self->{prefix}_OBJECTS WHERE OBJECT_TYPE='TYPE'"; 13107 $str .= " AND STATUS='VALID'" if (!$self->{export_invalid}); 13108 $str .= " AND OBJECT_NAME='$name'" if ($name); 13109 $str .= " AND GENERATED='N'"; 13110 if ($self->{schema}) { 13111 $str .= "AND OWNER='$self->{schema}' "; 13112 } else { 13113 $str .= "AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 13114 } 13115 if (!$name) { 13116 $str .= $self->limit_to_objects('TYPE', 'OBJECT_NAME'); 13117 } else { 13118 @{$self->{query_bind_params}} = (); 13119 } 13120 #$str .= " ORDER BY OBJECT_NAME"; 13121 13122 # use a separeate connection 13123 my $local_dbh = $self->_oracle_connection(); 13124 13125 my $sth = $local_dbh->prepare($str) or $self->logit("FATAL: " . $local_dbh->errstr . "\n", 0, 1); 13126 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $local_dbh->errstr . "\n", 0, 1); 13127 13128 my @types = (); 13129 my @fct_done = (); 13130 while (my $row = $sth->fetch) 13131 { 13132 next if ($row->[0] =~ /^(SDO_GEOMETRY|ST_|STGEOM_)/); 13133 my $sql = "SELECT TEXT FROM $self->{prefix}_SOURCE WHERE OWNER='$row->[1]' AND NAME='$row->[0]' AND (TYPE='TYPE' OR TYPE='TYPE BODY') ORDER BY TYPE, LINE"; 13134 if (!$self->{schema} && $self->{export_schema}) { 13135 $row->[0] = "$row->[1].$row->[0]"; 13136 } 13137 $self->logit("\tFound Type: $row->[0]\n", 1); 13138 next if (grep(/^$row->[0]$/, @fct_done)); 13139 push(@fct_done, $row->[0]); 13140 my %tmp = (); 13141 my $sth2 = $local_dbh->prepare($sql) or $self->logit("FATAL: " . $local_dbh->errstr . "\n", 0, 1); 13142 $sth2->execute or $self->logit("FATAL: " . $sth2->errstr . "\n", 0, 1); 13143 while (my $r = $sth2->fetch) { 13144 $tmp{code} .= $r->[0]; 13145 } 13146 $sth2->finish(); 13147 $tmp{name} = $row->[0]; 13148 $tmp{owner} = $row->[1]; 13149 $tmp{pos} = $row->[2]; 13150 if (!$self->{preserve_case}) { 13151 $tmp{code} =~ s/(TYPE\s+)"[^"]+"\."[^"]+"/$1\L$row->[0]\E/is; 13152 $tmp{code} =~ s/(TYPE\s+)"[^"]+"/$1\L$row->[0]\E/is; 13153 } 13154 push(@types, \%tmp); 13155 } 13156 $sth->finish(); 13157 13158 $local_dbh->disconnect() if ($local_dbh); 13159 13160 return \@types; 13161} 13162 13163=head2 _table_info 13164 13165This function retrieves all Oracle-native tables information. 13166 13167Returns a handle to a DB query statement. 13168 13169=cut 13170 13171sub _table_info 13172{ 13173 my $self = shift; 13174 my $do_real_row_count = shift; 13175 13176 return Ora2Pg::MySQL::_table_info($self) if ($self->{is_mysql}); 13177 13178 my $owner = ''; 13179 if ($self->{schema}) { 13180 $owner .= " A.OWNER='$self->{schema}' "; 13181 } else { 13182 $owner .= " A.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 13183 } 13184 13185 #### 13186 # Get name of all TABLE objects in ALL_OBJECTS loking at OBJECT_TYPE='TABLE' 13187 #### 13188 my $sql = "SELECT A.OWNER,A.OBJECT_NAME,A.OBJECT_TYPE FROM $self->{prefix}_OBJECTS A WHERE A.OBJECT_TYPE IN ('TABLE','VIEW') AND $owner"; 13189 $sql .= $self->limit_to_objects('TABLE', 'A.OBJECT_NAME'); 13190 $self->logit("DEBUG: $sql\n", 2); 13191 my $t0 = Benchmark->new; 13192 my $sth = $self->{dbh}->prepare( $sql ) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13193 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13194 my $nrows = 0; 13195 my %tbtype = (); 13196 while (my $row = $sth->fetch) 13197 { 13198 $self->{all_objects}{"$row->[0].$row->[1]"} = $row->[2]; 13199 $nrows++; 13200 } 13201 $sth->finish(); 13202 my $t1 = Benchmark->new; 13203 my $td = timediff($t1, $t0); 13204 $self->logit("Collecting $nrows tables in $self->{prefix}_OBJECTS took: " . timestr($td) . "\n", 1); 13205 13206 #### 13207 # Get comments for all tables 13208 #### 13209 my %comments = (); 13210 if ($self->{type} eq 'TABLE') 13211 { 13212 $sql = "SELECT A.TABLE_NAME,A.COMMENTS,A.TABLE_TYPE,A.OWNER FROM $self->{prefix}_TAB_COMMENTS A WHERE $owner"; 13213 if ($self->{db_version} !~ /Release 8/) { 13214 $sql .= $self->exclude_mviews('A.OWNER, A.TABLE_NAME'); 13215 } 13216 $sql .= $self->limit_to_objects('TABLE', 'A.TABLE_NAME'); 13217 $self->logit("DEBUG: $sql\n", 2); 13218 $t0 = Benchmark->new; 13219 $sth = $self->{dbh}->prepare( $sql ) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13220 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13221 $nrows = 0; 13222 my %tbtype = (); 13223 while (my $row = $sth->fetch) 13224 { 13225 next if (!exists $self->{all_objects}{"$row->[3].$row->[0]"} || $self->{all_objects}{"$row->[3].$row->[0]"} ne 'TABLE'); 13226 if (!$self->{schema} && $self->{export_schema}) { 13227 $row->[0] = "$row->[3].$row->[0]"; 13228 } 13229 $comments{$row->[0]}{comment} = $row->[1]; 13230 $comments{$row->[0]}{table_type} = $row->[2]; 13231 $tbtype{$row->[2]}++; 13232 $nrows++; 13233 } 13234 $sth->finish(); 13235 $t1 = Benchmark->new; 13236 $td = timediff($t1, $t0); 13237 $self->logit("Collecting $nrows tables comments in $self->{prefix}_TAB_COMMENTS took: " . timestr($td) . "\n", 1); 13238 } 13239 13240 #### 13241 # Get information about all tables 13242 #### 13243 $sql = "SELECT A.OWNER,A.TABLE_NAME,NVL(num_rows,1) NUMBER_ROWS,A.TABLESPACE_NAME,A.NESTED,A.LOGGING,A.PARTITIONED,A.PCT_FREE FROM $self->{prefix}_TABLES A WHERE $owner"; 13244 $sql .= " AND A.TEMPORARY='N' AND (A.NESTED != 'YES' OR A.LOGGING != 'YES') AND A.SECONDARY = 'N'"; 13245 if ($self->{db_version} !~ /Release [89]/) { 13246 $sql .= " AND (A.DROPPED IS NULL OR A.DROPPED = 'NO')"; 13247 } 13248 if ($self->{db_version} !~ /Release 8/) { 13249 $sql .= $self->exclude_mviews('A.OWNER, A.TABLE_NAME'); 13250 } 13251 $sql .= $self->limit_to_objects('TABLE', 'A.TABLE_NAME'); 13252 $sql .= " AND (A.IOT_TYPE IS NULL OR A.IOT_TYPE = 'IOT')"; 13253 #$sql .= " ORDER BY A.OWNER, A.TABLE_NAME"; 13254 13255 $self->logit("DEBUG: $sql\n", 2); 13256 $t0 = Benchmark->new; 13257 $sth = $self->{dbh}->prepare( $sql ) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13258 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13259 my %tables_infos = (); 13260 $nrows = 0; 13261 while (my $row = $sth->fetch) 13262 { 13263 next if (!exists $self->{all_objects}{"$row->[0].$row->[1]"} || $self->{all_objects}{"$row->[0].$row->[1]"} ne 'TABLE'); 13264 if (!$self->{schema} && $self->{export_schema}) { 13265 $row->[1] = "$row->[0].$row->[1]"; 13266 } 13267 $tables_infos{$row->[1]}{owner} = $row->[0] || ''; 13268 $tables_infos{$row->[1]}{num_rows} = $row->[2] || 0; 13269 $tables_infos{$row->[1]}{tablespace} = $row->[3] || 0; 13270 $tables_infos{$row->[1]}{comment} = $comments{$row->[1]}{comment} || ''; 13271 $tables_infos{$row->[1]}{type} = $comments{$row->[1]}{table_type} || ''; 13272 $tables_infos{$row->[1]}{nested} = $row->[4] || ''; 13273 if ($row->[5] eq 'NO') { 13274 $tables_infos{$row->[1]}{nologging} = 1; 13275 } else { 13276 $tables_infos{$row->[1]}{nologging} = 0; 13277 } 13278 if ($row->[6] eq 'NO') { 13279 $tables_infos{$row->[1]}{partitioned} = 0; 13280 } else { 13281 $tables_infos{$row->[1]}{partitioned} = 1; 13282 } 13283 # Only take care of PCTFREE upper than the Oracle default value 13284 if (($row->[7] || 0) > 10) { 13285 $tables_infos{$row->[1]}{fillfactor} = 100 - min(90, $row->[7]); 13286 } 13287 if ($do_real_row_count) 13288 { 13289 $self->logit("DEBUG: looking for real row count for table ($row->[0]) $row->[1] (aka using count(*))...\n", 1); 13290 $sql = "SELECT COUNT(*) FROM $row->[1]"; 13291 if ($self->{schema}) { 13292 $sql = "SELECT COUNT(*) FROM $row->[0].$row->[1]"; 13293 } 13294 my $sth2 = $self->{dbh}->prepare( $sql ) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13295 $sth2->execute or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13296 my $size = $sth2->fetch(); 13297 $sth2->finish(); 13298 $tables_infos{$row->[1]}{num_rows} = $size->[0]; 13299 } 13300 $nrows++; 13301 } 13302 $sth->finish(); 13303 $t1 = Benchmark->new; 13304 $td = timediff($t1, $t0); 13305 $self->logit("Collecting $nrows tables information in $self->{prefix}_TABLES took: " . timestr($td) . "\n", 1); 13306 13307 return %tables_infos; 13308} 13309 13310=head2 _global_temp_table_info 13311 13312This function retrieves all Oracle-native global temporary tables information. 13313 13314Returns a handle to a DB query statement. 13315 13316=cut 13317 13318sub _global_temp_table_info 13319{ 13320 my $self = shift; 13321 13322 return Ora2Pg::MySQL::_global_temp_table_info($self) if ($self->{is_mysql}); 13323 13324 my $owner = ''; 13325 if ($self->{schema}) { 13326 $owner .= "AND A.OWNER='$self->{schema}' "; 13327 } else { 13328 $owner .= "AND A.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 13329 } 13330 13331 # Get comment on global temporary table 13332 my %comments = (); 13333 if ($self->{type} eq 'TABLE') 13334 { 13335 my $sql = "SELECT A.TABLE_NAME,A.COMMENTS,A.TABLE_TYPE,A.OWNER FROM $self->{prefix}_TAB_COMMENTS A, $self->{prefix}_OBJECTS O WHERE A.OWNER=O.OWNER and A.TABLE_NAME=O.OBJECT_NAME and O.OBJECT_TYPE='TABLE' $owner"; 13336 if ($self->{db_version} !~ /Release 8/) { 13337 $sql .= $self->exclude_mviews('A.OWNER, A.TABLE_NAME'); 13338 } 13339 $sql .= $self->limit_to_objects('TABLE', 'A.TABLE_NAME'); 13340 my $sth = $self->{dbh}->prepare( $sql ) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13341 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13342 while (my $row = $sth->fetch) { 13343 if (!$self->{schema} && $self->{export_schema}) { 13344 $row->[0] = "$row->[3].$row->[0]"; 13345 } 13346 $comments{$row->[0]}{comment} = $row->[1]; 13347 $comments{$row->[0]}{table_type} = $row->[2]; 13348 } 13349 $sth->finish(); 13350 } 13351 13352 $sql = "SELECT A.OWNER,A.TABLE_NAME,NVL(num_rows,1) NUMBER_ROWS,A.TABLESPACE_NAME,A.NESTED,A.LOGGING FROM $self->{prefix}_TABLES A, $self->{prefix}_OBJECTS O WHERE A.OWNER=O.OWNER AND A.TABLE_NAME=O.OBJECT_NAME AND O.OBJECT_TYPE='TABLE' $owner"; 13353 $sql .= " AND A.TEMPORARY='Y'"; 13354 if ($self->{db_version} !~ /Release [89]/) { 13355 $sql .= " AND (A.DROPPED IS NULL OR A.DROPPED = 'NO')"; 13356 } 13357 $sql .= $self->limit_to_objects('TABLE', 'A.TABLE_NAME'); 13358 $sql .= " AND (A.IOT_TYPE IS NULL OR A.IOT_TYPE = 'IOT')"; 13359 #$sql .= " ORDER BY A.OWNER, A.TABLE_NAME"; 13360 13361 $sth = $self->{dbh}->prepare( $sql ) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13362 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13363 my %tables_infos = (); 13364 while (my $row = $sth->fetch) { 13365 if (!$self->{schema} && $self->{export_schema}) { 13366 $row->[1] = "$row->[0].$row->[1]"; 13367 } 13368 $tables_infos{$row->[1]}{owner} = $row->[0] || ''; 13369 $tables_infos{$row->[1]}{num_rows} = $row->[2] || 0; 13370 $tables_infos{$row->[1]}{tablespace} = $row->[3] || 0; 13371 $tables_infos{$row->[1]}{comment} = $comments{$row->[1]}{comment} || ''; 13372 $tables_infos{$row->[1]}{type} = $comments{$row->[1]}{table_type} || ''; 13373 $tables_infos{$row->[1]}{nested} = $row->[4] || ''; 13374 if ($row->[5] eq 'NO') { 13375 $tables_infos{$row->[1]}{nologging} = 1; 13376 } else { 13377 $tables_infos{$row->[1]}{nologging} = 0; 13378 } 13379 $tables_infos{$row->[1]}{num_rows} = 0; 13380 } 13381 $sth->finish(); 13382 13383 return %tables_infos; 13384} 13385 13386 13387=head2 _queries 13388 13389This function is used to retrieve all Oracle queries from DBA_AUDIT_TRAIL 13390 13391Sets the main hash $self->{queries}. 13392 13393=cut 13394 13395sub _queries 13396{ 13397 my ($self) = @_; 13398 13399 $self->logit("Retrieving audit queries information...\n", 1); 13400 %{$self->{queries}} = $self->_get_audit_queries(); 13401 13402} 13403 13404 13405=head2 _get_audit_queries 13406 13407This function extract SQL queries from dba_audit_trail 13408 13409Returns a hash of queries. 13410 13411=cut 13412 13413sub _get_audit_queries 13414{ 13415 my($self) = @_; 13416 13417 return if (!$self->{audit_user}); 13418 13419 # If the user is given as not DBA, do not look at tablespace 13420 if ($self->{user_grants}) { 13421 $self->logit("WARNING: Exporting audited queries as non DBA user is not allowed, see USER_GRANT\n", 0); 13422 return; 13423 } 13424 13425 return Ora2Pg::MySQL::_get_audit_queries($self) if ($self->{is_mysql}); 13426 13427 my @users = (); 13428 push(@users, split(/[,;\s]/, uc($self->{audit_user}))); 13429 13430 # Retrieve all object with tablespaces. 13431 my $str = "SELECT SQL_TEXT FROM DBA_AUDIT_TRAIL WHERE ACTION_NAME IN ('INSERT','UPDATE','DELETE','SELECT')"; 13432 if (($#users >= 0) && !grep(/^ALL$/, @users)) { 13433 $str .= " AND USERNAME IN ('" . join("','", @users) . "')"; 13434 } 13435 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13436 $sth->execute or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13437 13438 my %tmp_queries = (); 13439 while (my $row = $sth->fetch) { 13440 $self->_remove_comments(\$row->[0], 1); 13441 $self->{comment_values} = (); 13442 $row->[0] =~ s/\%ORA2PG_COMMENT\d+\%//gs; 13443 $row->[0] = $self->normalize_query($row->[0]); 13444 $tmp_queries{$row->[0]}++; 13445 } 13446 $sth->finish; 13447 13448 my %queries = (); 13449 my $i = 1; 13450 foreach my $q (keys %tmp_queries) { 13451 $queries{$i} = $q; 13452 $i++; 13453 } 13454 13455 return %queries; 13456} 13457 13458 13459=head2 _get_tablespaces 13460 13461This function implements an Oracle-native tablespaces information. 13462 13463Returns a hash of an array of tablespace names with their system file path. 13464 13465=cut 13466 13467sub _get_tablespaces 13468{ 13469 my($self) = @_; 13470 13471 # If the user is given as not DBA, do not look at tablespace 13472 if ($self->{user_grants}) { 13473 $self->logit("WARNING: Exporting tablespace as non DBA user is not allowed, see USER_GRANT\n", 0); 13474 return; 13475 } 13476 13477 return Ora2Pg::MySQL::_get_tablespaces($self) if ($self->{is_mysql}); 13478 13479 # Retrieve all object with tablespaces. 13480my $str = qq{ 13481SELECT a.SEGMENT_NAME,a.TABLESPACE_NAME,a.SEGMENT_TYPE,c.FILE_NAME, a.OWNER 13482FROM DBA_SEGMENTS a, $self->{prefix}_OBJECTS b, DBA_DATA_FILES c 13483WHERE a.SEGMENT_TYPE IN ('INDEX', 'TABLE', 'INDEX PARTITION', 'TABLE PARTITION') 13484AND a.SEGMENT_NAME = b.OBJECT_NAME 13485AND a.SEGMENT_TYPE = b.OBJECT_TYPE 13486AND a.OWNER = b.OWNER 13487AND a.TABLESPACE_NAME = c.TABLESPACE_NAME 13488}; 13489 if ($self->{schema}) { 13490 $str .= " AND a.OWNER='$self->{schema}'"; 13491 } else { 13492 $str .= " AND a.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 13493 } 13494 $str .= $self->limit_to_objects('TABLESPACE|TABLE', 'a.TABLESPACE_NAME|a.SEGMENT_NAME'); 13495 #$str .= " ORDER BY TABLESPACE_NAME"; 13496 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13497 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13498 13499 my %tbs = (); 13500 while (my $row = $sth->fetch) { 13501 # TYPE - TABLESPACE_NAME - FILEPATH - OBJECT_NAME 13502 if ($self->{export_schema} && !$self->{schema}) { 13503 $row->[0] = "$row->[4].$row->[0]"; 13504 } 13505 push(@{$tbs{$row->[2]}{$row->[1]}{$row->[3]}}, $row->[0]); 13506 } 13507 $sth->finish; 13508 13509 return \%tbs; 13510} 13511 13512sub _list_tablespaces 13513{ 13514 my($self) = @_; 13515 13516 # If the user is given as not DBA, do not look at tablespace 13517 if ($self->{user_grants}) { 13518 return; 13519 } 13520 13521 return Ora2Pg::MySQL::_list_tablespaces($self) if ($self->{is_mysql}); 13522 13523 # list tablespaces. 13524 my $str = qq{ 13525SELECT c.FILE_NAME, c.TABLESPACE_NAME, a.OWNER, ROUND(c.BYTES/1024000) MB 13526FROM DBA_DATA_FILES c, DBA_SEGMENTS a 13527WHERE a.TABLESPACE_NAME = c.TABLESPACE_NAME 13528}; 13529 if ($self->{schema}) { 13530 $str .= " AND a.OWNER='$self->{schema}'"; 13531 } else { 13532 $str .= " AND a.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 13533 } 13534 $str .= $self->limit_to_objects('TABLESPACE', 'c.TABLESPACE_NAME'); 13535 #$str .= " ORDER BY c.TABLESPACE_NAME"; 13536 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13537 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13538 13539 my %tbs = (); 13540 while (my $row = $sth->fetch) { 13541 $tbs{$row->[1]}{path} = $row->[0]; 13542 $tbs{$row->[1]}{owner} = $row->[2]; 13543 } 13544 $sth->finish; 13545 13546 return \%tbs; 13547} 13548 13549 13550=head2 _get_partitions 13551 13552This function implements an Oracle-native partitions information. 13553Return two hash ref with partition details and partition default. 13554=cut 13555 13556sub _get_partitions 13557{ 13558 my($self) = @_; 13559 13560 return Ora2Pg::MySQL::_get_partitions($self) if ($self->{is_mysql}); 13561 13562 my $highvalue = 'A.HIGH_VALUE'; 13563 if ($self->{db_version} =~ /Release [89]/) { 13564 $highvalue = "'' AS HIGH_VALUE"; 13565 } 13566 my $condition = ''; 13567 if ($self->{schema}) { 13568 $condition .= "AND A.TABLE_OWNER='$self->{schema}' "; 13569 } else { 13570 $condition .= " AND A.TABLE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 13571 } 13572 # Retrieve all partitions. 13573 my $str = qq{ 13574SELECT 13575 A.TABLE_NAME, 13576 A.PARTITION_POSITION, 13577 A.PARTITION_NAME, 13578 $highvalue, 13579 A.TABLESPACE_NAME, 13580 B.PARTITIONING_TYPE, 13581 C.NAME, 13582 C.COLUMN_NAME, 13583 C.COLUMN_POSITION, 13584 A.TABLE_OWNER 13585FROM $self->{prefix}_TAB_PARTITIONS A, $self->{prefix}_PART_TABLES B, $self->{prefix}_PART_KEY_COLUMNS C 13586WHERE 13587 a.table_name = b.table_name AND 13588 (b.partitioning_type = 'RANGE' OR b.partitioning_type = 'LIST' OR b.partitioning_type = 'HASH') 13589 AND a.table_name = c.name 13590 $condition 13591}; 13592 13593 if ($self->{db_version} !~ /Release 8/) { 13594 $str .= $self->exclude_mviews('A.TABLE_OWNER, A.TABLE_NAME'); 13595 } 13596 $str .= $self->limit_to_objects('TABLE|PARTITION', 'A.TABLE_NAME|A.PARTITION_NAME'); 13597 13598 if ($self->{prefix} ne 'USER') { 13599 if ($self->{schema}) { 13600 $str .= "\tAND A.TABLE_OWNER ='$self->{schema}' AND B.OWNER=A.TABLE_OWNER AND C.OWNER=A.TABLE_OWNER\n"; 13601 } else { 13602 $str .= "\tAND A.TABLE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') AND B.OWNER=A.TABLE_OWNER AND C.OWNER=A.TABLE_OWNER\n"; 13603 } 13604 } 13605 $str .= "ORDER BY A.TABLE_OWNER,A.TABLE_NAME,A.PARTITION_POSITION,C.COLUMN_POSITION\n"; 13606 13607 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13608 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13609 13610 my %parts = (); 13611 my %default = (); 13612 while (my $row = $sth->fetch) { 13613 if (!$self->{schema} && $self->{export_schema}) { 13614 $row->[0] = "$row->[9].$row->[0]"; 13615 } 13616 if ( ($row->[3] eq 'DEFAULT')) { 13617 $default{$row->[0]} = $row->[2]; 13618 next; 13619 } 13620 $parts{$row->[0]}{$row->[1]}{name} = $row->[2]; 13621 push(@{$parts{$row->[0]}{$row->[1]}{info}}, { 'type' => $row->[5], 'value' => $row->[3], 'column' => $row->[7], 'colpos' => $row->[8], 'tablespace' => $row->[4], 'owner' => $row->[9]}); 13622 } 13623 $sth->finish; 13624 13625 return \%parts, \%default; 13626} 13627 13628=head2 _get_subpartitions 13629 13630This function implements an Oracle-native subpartitions information. 13631Return two hash ref with partition details and partition default. 13632 13633=cut 13634 13635sub _get_subpartitions 13636{ 13637 my($self) = @_; 13638 13639 return Ora2Pg::MySQL::_get_subpartitions($self) if ($self->{is_mysql}); 13640 13641 my $highvalue = 'A.HIGH_VALUE'; 13642 if ($self->{db_version} =~ /Release [89]/) { 13643 $highvalue = "'' AS HIGH_VALUE"; 13644 } 13645 my $condition = ''; 13646 if ($self->{schema}) { 13647 $condition .= "AND A.TABLE_OWNER='$self->{schema}' "; 13648 } else { 13649 $condition .= " AND A.TABLE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 13650 } 13651 # Retrieve all partitions. 13652 my $str = qq{ 13653SELECT 13654 A.TABLE_NAME, 13655 A.SUBPARTITION_POSITION, 13656 A.SUBPARTITION_NAME, 13657 $highvalue, 13658 A.TABLESPACE_NAME, 13659 B.SUBPARTITIONING_TYPE, 13660 C.NAME, 13661 C.COLUMN_NAME, 13662 C.COLUMN_POSITION, 13663 A.TABLE_OWNER, 13664 A.PARTITION_NAME 13665FROM $self->{prefix}_tab_subpartitions A, $self->{prefix}_part_tables B, $self->{prefix}_subpart_key_columns C 13666WHERE 13667 a.table_name = b.table_name AND 13668 (b.subpartitioning_type = 'RANGE' OR b.subpartitioning_type = 'LIST' OR b.subpartitioning_type = 'HASH') 13669 AND a.table_name = c.name 13670 $condition 13671}; 13672 $str .= $self->limit_to_objects('TABLE|PARTITION', 'A.TABLE_NAME|A.SUBPARTITION_NAME'); 13673 13674 if ($self->{prefix} ne 'USER') { 13675 if ($self->{schema}) { 13676 $str .= "\tAND A.TABLE_OWNER ='$self->{schema}' AND B.OWNER=A.TABLE_OWNER AND C.OWNER=A.TABLE_OWNER\n"; 13677 } else { 13678 $str .= "\tAND A.TABLE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') AND B.OWNER=A.TABLE_OWNER AND C.OWNER=A.TABLE_OWNER\n"; 13679 } 13680 } 13681 if ($self->{db_version} !~ /Release 8/) { 13682 $str .= $self->exclude_mviews('A.TABLE_OWNER, A.TABLE_NAME'); 13683 } 13684 $str .= "ORDER BY A.TABLE_OWNER,A.TABLE_NAME,A.PARTITION_NAME,A.SUBPARTITION_POSITION,C.COLUMN_POSITION\n"; 13685 13686 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13687 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13688 13689 my %subparts = (); 13690 my %default = (); 13691 while (my $row = $sth->fetch) { 13692 if (!$self->{schema} && $self->{export_schema}) { 13693 $row->[0] = "$row->[9].$row->[0]"; 13694 } 13695 if ( ($row->[3] eq 'MAXVALUE') || ($row->[3] eq 'DEFAULT')) { 13696 $default{$row->[0]}{$row->[10]} = $row->[2]; 13697 next; 13698 } 13699 13700 $subparts{$row->[0]}{$row->[10]}{$row->[1]}{name} = $row->[2]; 13701 push(@{$subparts{$row->[0]}{$row->[10]}{$row->[1]}{info}}, { 'type' => $row->[5], 'value' => $row->[3], 'column' => $row->[7], 'colpos' => $row->[8], 'tablespace' => $row->[4], 'owner' => $row->[9]}); 13702 } 13703 $sth->finish; 13704 13705 return \%subparts, \%default; 13706} 13707 13708 13709=head2 _synonyms 13710 13711This function is used to retrieve all synonyms information. 13712 13713Sets the main hash of the synonyms definition $self->{synonyms}. 13714Keys are the names of all synonyms retrieved from the current 13715database. 13716 13717The synonyms hash is construct as follows: 13718 13719 $hash{SYNONYM_NAME}{owner} = Owner of the synonym 13720 $hash{SYNONYM_NAME}{table_owner} = Owner of the object referenced by the synonym. 13721 $hash{SYNONYM_NAME}{table_name} = Name of the object referenced by the synonym. 13722 $hash{SYNONYM_NAME}{dblink} = Name of the database link referenced, if any 13723 13724=cut 13725 13726sub _synonyms 13727{ 13728 my ($self) = @_; 13729 13730 # Get all synonyms information 13731 $self->logit("Retrieving synonyms information...\n", 1); 13732 %{$self->{synonyms}} = $self->_get_synonyms(); 13733} 13734 13735=head2 _get_synonyms 13736 13737This function implements an Oracle-native synonym information. 13738 13739=cut 13740 13741sub _get_synonyms 13742{ 13743 my($self) = @_; 13744 13745 return Ora2Pg::MySQL::_get_synonyms($self) if ($self->{is_mysql}); 13746 13747 # Retrieve all synonym 13748 my $str = "SELECT OWNER,SYNONYM_NAME,TABLE_OWNER,TABLE_NAME,DB_LINK FROM $self->{prefix}_SYNONYMS"; 13749 if ($self->{schema}) { 13750 $str .= " WHERE (owner='$self->{schema}' OR owner='PUBLIC') AND table_owner NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 13751 } else { 13752 $str .= " WHERE (owner='PUBLIC' OR owner NOT IN ('" . join("','", @{$self->{sysusers}}) . "')) AND table_owner NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 13753 } 13754 $str .= $self->limit_to_objects('SYNONYM','SYNONYM_NAME'); 13755 #$str .= " ORDER BY SYNONYM_NAME\n"; 13756 13757 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13758 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13759 13760 my %synonyms = (); 13761 while (my $row = $sth->fetch) { 13762 next if ($row->[1] =~ /^\//); # Some not fully deleted synonym start with a slash 13763 $synonyms{$row->[1]}{owner} = $row->[0]; 13764 $synonyms{$row->[1]}{table_owner} = $row->[2]; 13765 $synonyms{$row->[1]}{table_name} = $row->[3]; 13766 $synonyms{$row->[1]}{dblink} = $row->[4]; 13767 } 13768 $sth->finish; 13769 13770 return %synonyms; 13771} 13772 13773=head2 _get_partitions_list 13774 13775This function implements an Oracle-native partitions information. 13776Return a hash of the partition table_name => type 13777=cut 13778 13779sub _get_partitions_list 13780{ 13781 my($self) = @_; 13782 13783 return Ora2Pg::MySQL::_get_partitions_list($self) if ($self->{is_mysql}); 13784 13785 my $highvalue = 'A.HIGH_VALUE'; 13786 if ($self->{db_version} =~ /Release [89]/) { 13787 $highvalue = "'' AS HIGH_VALUE"; 13788 } 13789 my $condition = ''; 13790 if ($self->{schema}) { 13791 $condition .= "AND A.TABLE_OWNER='$self->{schema}' "; 13792 } else { 13793 $condition .= " AND A.TABLE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 13794 } 13795 # Retrieve all partitions. 13796 my $str = qq{ 13797SELECT 13798 A.TABLE_NAME, 13799 A.PARTITION_POSITION, 13800 A.PARTITION_NAME, 13801 $highvalue, 13802 A.TABLESPACE_NAME, 13803 B.PARTITIONING_TYPE, 13804 A.TABLE_OWNER 13805FROM $self->{prefix}_TAB_PARTITIONS A, $self->{prefix}_PART_TABLES B 13806WHERE A.TABLE_NAME = B.TABLE_NAME 13807$condition 13808}; 13809 if ($self->{db_version} !~ /Release 8/) { 13810 $str .= $self->exclude_mviews('A.TABLE_OWNER, A.TABLE_NAME'); 13811 } 13812 $str .= $self->limit_to_objects('TABLE|PARTITION','A.TABLE_NAME|A.PARTITION_NAME'); 13813 13814 if ($self->{prefix} ne 'USER') { 13815 if ($self->{schema}) { 13816 $str .= "\tAND A.TABLE_OWNER ='$self->{schema}'\n"; 13817 } else { 13818 $str .= "\tAND A.TABLE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')\n"; 13819 } 13820 } 13821 #$str .= "ORDER BY A.TABLE_NAME\n"; 13822 13823 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13824 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13825 13826 my %parts = (); 13827 while (my $row = $sth->fetch) { 13828 $parts{$row->[5]}++; 13829 } 13830 $sth->finish; 13831 13832 return %parts; 13833} 13834 13835=head2 _get_partitioned_table 13836 13837Return a hash of the partitioned table list with the number of partition. 13838 13839=cut 13840 13841sub _get_partitioned_table 13842{ 13843 my ($self, %subpart) = @_; 13844 13845 return Ora2Pg::MySQL::_get_partitioned_table($self) if ($self->{is_mysql}); 13846 13847 my $highvalue = 'A.HIGH_VALUE'; 13848 if ($self->{db_version} =~ /Release [89]/) { 13849 $highvalue = "'' AS HIGH_VALUE"; 13850 } 13851 my $condition = ''; 13852 if ($self->{schema}) { 13853 $condition .= "AND B.OWNER='$self->{schema}' "; 13854 } else { 13855 $condition .= " AND B.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 13856 } 13857 # Retrieve all partitions. 13858 my $str = "SELECT B.TABLE_NAME, B.PARTITIONING_TYPE, B.OWNER, B.PARTITION_COUNT, B.SUBPARTITIONING_TYPE"; 13859 if ($self->{type} !~ /SHOW|TEST/) 13860 { 13861 $str .= ", C.COLUMN_NAME, C.COLUMN_POSITION"; 13862 $str .= " FROM $self->{prefix}_PART_TABLES B, $self->{prefix}_PART_KEY_COLUMNS C"; 13863 $str .= " WHERE B.TABLE_NAME = C.NAME AND (B.PARTITIONING_TYPE = 'RANGE' OR B.PARTITIONING_TYPE = 'LIST' OR B.PARTITIONING_TYPE = 'HASH')"; 13864 } 13865 else 13866 { 13867 $str .= " FROM $self->{prefix}_PART_TABLES B WHERE (B.PARTITIONING_TYPE = 'RANGE' OR B.PARTITIONING_TYPE = 'LIST' OR B.PARTITIONING_TYPE = 'HASH') AND B.SUBPARTITIONING_TYPE <> 'SYSTEM' "; 13868 } 13869 $str .= $self->limit_to_objects('TABLE','B.TABLE_NAME'); 13870 13871 if ($self->{prefix} ne 'USER') 13872 { 13873 if ($self->{type} !~ /SHOW|TEST/) 13874 { 13875 if ($self->{schema}) { 13876 $str .= "\tAND B.OWNER ='$self->{schema}' AND C.OWNER=B.OWNER\n"; 13877 } else { 13878 $str .= "\tAND B.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') AND B.OWNER=C.OWNER\n"; 13879 } 13880 } else { 13881 if ($self->{schema}) { 13882 $str .= "\tAND B.OWNER ='$self->{schema}'\n"; 13883 } else { 13884 $str .= "\tAND B.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')\n"; 13885 } 13886 } 13887 } 13888 if ($self->{db_version} !~ /Release 8/) { 13889 $str .= $self->exclude_mviews('B.OWNER, B.TABLE_NAME'); 13890 } 13891 if ($self->{type} !~ /SHOW|TEST/) { 13892 $str .= "ORDER BY B.OWNER,B.TABLE_NAME,C.COLUMN_POSITION\n"; 13893 } else { 13894 $str .= "ORDER BY B.OWNER,B.TABLE_NAME\n"; 13895 } 13896 13897 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13898 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13899 13900 my %parts = (); 13901 while (my $row = $sth->fetch) 13902 { 13903 if (!$self->{schema} && $self->{export_schema}) { 13904 $row->[0] = "$row->[2].$row->[0]"; 13905 } 13906 # when this is not a composite partition the count is defined 13907 # when this is not the default number of subpartition 13908 $parts{"\L$row->[0]\E"}{count} = 0; 13909 $parts{"\L$row->[0]\E"}{composite} = 0; 13910 if (exists $subpart{"\L$row->[0]\E"}) 13911 { 13912 $parts{"\L$row->[0]\E"}{composite} = 1; 13913 foreach my $k (keys %{$subpart{"\L$row->[0]\E"}}) { 13914 $parts{"\L$row->[0]\E"}{count} += $subpart{"\L$row->[0]\E"}{$k}{count}; 13915 } 13916 $parts{"\L$row->[0]\E"}{count} = $row->[3] if (!$parts{"\L$row->[0]\E"}{count}); 13917 } else { 13918 $parts{"\L$row->[0]\E"}{count} = $row->[3]; 13919 } 13920 $parts{"\L$row->[0]\E"}{type} = $row->[1]; 13921 if ($self->{type} !~ /SHOW|TEST/) { 13922 push(@{ $parts{"\L$row->[0]\E"}{columns} }, $row->[5]); 13923 } 13924 } 13925 $sth->finish; 13926 13927 return %parts; 13928} 13929 13930=head2 _get_subpartitioned_table 13931 13932Return a hash of the partitioned table list with the number of partition. 13933 13934=cut 13935 13936sub _get_subpartitioned_table 13937{ 13938 my($self) = @_; 13939 13940 return Ora2Pg::MySQL::_get_subpartitioned_table($self) if ($self->{is_mysql}); 13941 13942 my $highvalue = 'A.HIGH_VALUE'; 13943 if ($self->{db_version} =~ /Release [89]/) { 13944 $highvalue = "'' AS HIGH_VALUE"; 13945 } 13946 my $condition = ''; 13947 if ($self->{schema}) { 13948 $condition .= "AND A.TABLE_OWNER='$self->{schema}' "; 13949 } else { 13950 $condition .= " AND A.TABLE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') "; 13951 } 13952 # Retrieve all partitions. 13953 my $str = "SELECT A.TABLE_NAME, A.PARTITION_NAME, A.SUBPARTITION_NAME, A.SUBPARTITION_POSITION, B.SUBPARTITIONING_TYPE, A.TABLE_OWNER, B.PARTITION_COUNT"; 13954 if ($self->{type} !~ /SHOW|TEST/) { 13955 $str .= ", C.COLUMN_NAME, C.COLUMN_POSITION"; 13956 $str .= " FROM $self->{prefix}_TAB_SUBPARTITIONS A, $self->{prefix}_PART_TABLES B, $self->{prefix}_SUBPART_KEY_COLUMNS C"; 13957 } else { 13958 $str .= " FROM $self->{prefix}_TAB_SUBPARTITIONS A, $self->{prefix}_PART_TABLES B"; 13959 } 13960 $str .= " WHERE A.TABLE_NAME = B.TABLE_NAME AND (B.SUBPARTITIONING_TYPE = 'RANGE' OR B.SUBPARTITIONING_TYPE = 'LIST' OR B.SUBPARTITIONING_TYPE = 'HASH')"; 13961 13962 $str .= " AND A.TABLE_NAME = C.NAME" if ($self->{type} !~ /SHOW|TEST/); 13963 13964 $str .= $self->limit_to_objects('TABLE|PARTITION','A.TABLE_NAME|A.PARTITION_NAME'); 13965 13966 if ($self->{prefix} ne 'USER') { 13967 if ($self->{type} !~ /SHOW|TEST/) { 13968 if ($self->{schema}) { 13969 $str .= "\tAND A.TABLE_OWNER ='$self->{schema}' AND B.OWNER=A.TABLE_OWNER AND C.OWNER=A.TABLE_OWNER\n"; 13970 } else { 13971 $str .= "\tAND A.TABLE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') AND B.OWNER=A.TABLE_OWNER AND C.OWNER=A.TABLE_OWNER\n"; 13972 } 13973 } else { 13974 if ($self->{schema}) { 13975 $str .= "\tAND A.TABLE_OWNER ='$self->{schema}' AND B.OWNER=A.TABLE_OWNER\n"; 13976 } else { 13977 $str .= "\tAND A.TABLE_OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') AND B.OWNER=A.TABLE_OWNER\n"; 13978 } 13979 } 13980 } 13981 if ($self->{db_version} !~ /Release 8/) { 13982 $str .= $self->exclude_mviews('A.TABLE_OWNER, A.TABLE_NAME'); 13983 } 13984 if ($self->{type} !~ /SHOW|TEST/) { 13985 $str .= "ORDER BY A.TABLE_OWNER,A.TABLE_NAME,A.PARTITION_NAME,A.SUBPARTITION_POSITION,C.COLUMN_POSITION\n"; 13986 } else { 13987 $str .= "ORDER BY A.TABLE_OWNER,A.TABLE_NAME,A.PARTITION_NAME,A.SUBPARTITION_POSITION\n"; 13988 } 13989 13990 my $sth = $self->{dbh}->prepare($str) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13991 $sth->execute(@{$self->{query_bind_params}}) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 13992 13993 my %parts = (); 13994 while (my $row = $sth->fetch) 13995 { 13996 if (!$self->{schema} && $self->{export_schema}) { 13997 $row->[0] = "$row->[5].$row->[0]"; 13998 } 13999 $parts{"\L$row->[0]\E"}{"\L$row->[1]\E"}{type} = $row->[4]; 14000 $parts{"\L$row->[0]\E"}{"\L$row->[1]\E"}{count}++; 14001 push(@{ $parts{"\L$row->[0]\E"}{"\L$row->[1]\E"}{columns} }, $row->[7]) if (!grep(/^$row->[7]$/, @{ $parts{"\L$row->[0]\E"}{"\L$row->[1]\E"}{columns} })); 14002 } 14003 $sth->finish; 14004 14005 return %parts; 14006} 14007 14008sub _get_custom_types 14009{ 14010 my ($self, $str, $parent) = @_; 14011 14012 # Copy the type translation hash 14013 my %all_types = %TYPE; 14014 # replace type double precision by single word double 14015 $all_types{'DOUBLE'} = $all_types{'DOUBLE PRECISION'}; 14016 delete $all_types{'DOUBLE PRECISION'}; 14017 # Remove any parenthesis after a type 14018 foreach my $t (keys %all_types) { 14019 $str =~ s/$t\s*\([^\)]+\)/$t/igs; 14020 } 14021 $str =~ s/^[^\(]+\(//s; 14022 $str =~ s/\s*\)\s*;$//s; 14023 $str =~ s/\/\*(.*?)\*\///gs; 14024 $str =~ s/\s*--[^\r\n]+//gs; 14025 my %types_found = (); 14026 my @type_def = split(/\s*,\s*/, $str); 14027 foreach my $s (@type_def) 14028 { 14029 my $cur_type = ''; 14030 if ($s =~ /\s+OF\s+([^\s;]+)/) { 14031 $cur_type = $1; 14032 } elsif ($s =~ /^\s*([^\s]+)\s+([^\s]+)/) { 14033 $cur_type = $2; 14034 } 14035 push(@{$types_found{src_types}}, $cur_type); 14036 if (exists $all_types{$cur_type}) { 14037 push(@{$types_found{pg_types}}, $all_types{$cur_type}); 14038 } 14039 else 14040 { 14041 my $custom_type = $self->_get_types($cur_type); 14042 foreach my $tpe (sort {length($a->{name}) <=> length($b->{name}) } @{$custom_type}) 14043 { 14044 last if (uc($tpe->{name}) eq $cur_type); # prevent infinit loop 14045 $self->logit("\tLooking inside nested custom type $tpe->{name} to extract values...\n", 1); 14046 my %types_def = $self->_get_custom_types($tpe->{code}, $cur_type); 14047 if ($#{$types_def{pg_types}} >= 0) 14048 { 14049 $self->logit("\t\tfound subtype description: $tpe->{name}(" . join(',', @{$types_def{pg_types}}) . ")\n", 1); 14050 push(@{$types_found{pg_types}}, \@{$types_def{pg_types}}); 14051 push(@{$types_found{src_types}}, \@{$types_def{src_types}}); 14052 } 14053 } 14054 } 14055 } 14056 14057 return %types_found; 14058} 14059 14060sub format_data_row 14061{ 14062 my ($self, $row, $data_types, $action, $src_data_types, $custom_types, $table, $colcond, $sprep) = @_; 14063 14064 for (my $idx = 0; $idx <= $#{$data_types}; $idx++) 14065 { 14066 my $data_type = $data_types->[$idx] || ''; 14067 if ($row->[$idx] && $src_data_types->[$idx] =~ /^(SDO_GEOMETRY|ST_|STGEOM_)/) 14068 { 14069 if ($self->{type} ne 'INSERT') 14070 { 14071 if (!$self->{is_mysql} && ($self->{geometry_extract_type} eq 'INTERNAL')) 14072 { 14073 use Ora2Pg::GEOM; 14074 my $geom_obj = new Ora2Pg::GEOM('srid' => $self->{spatial_srid}{$table}->[$idx]); 14075 $geom_obj->{geometry}{srid} = ''; 14076 $row->[$idx] = $geom_obj->parse_sdo_geometry($row->[$idx]); 14077 $row->[$idx] = 'SRID=' . $geom_obj->{geometry}{srid} . ';' . $row->[$idx]; 14078 } 14079 elsif ($self->{geometry_extract_type} eq 'WKB') 14080 { 14081 if ($self->{is_mysql}) { 14082 $row->[$idx] =~ s/^SRID=(\d+);//; 14083 $self->{spatial_srid}{$table}->[$idx] = $1; 14084 } 14085 $row->[$idx] = unpack('H*', $row->[$idx]); 14086 $row->[$idx] = 'SRID=' . $self->{spatial_srid}{$table}->[$idx] . ';' . $row->[$idx]; 14087 } 14088 } 14089 elsif ($self->{geometry_extract_type} eq 'WKB') 14090 { 14091 if ($self->{is_mysql}) 14092 { 14093 $row->[$idx] =~ s/^SRID=(\d+);//; 14094 $self->{spatial_srid}{$table}->[$idx] = $1; 14095 } 14096 $row->[$idx] = unpack('H*', $row->[$idx]); 14097 $row->[$idx] = "'SRID=" . $self->{spatial_srid}{$table}->[$idx] . ';' . $row->[$idx] . "'"; 14098 } 14099 elsif (($self->{geometry_extract_type} eq 'INTERNAL') || ($self->{geometry_extract_type} eq 'WKT')) 14100 { 14101 if (!$self->{is_mysql}) 14102 { 14103 if ($src_data_types->[$idx] =~ /SDO_GEOMETRY/i) 14104 { 14105 use Ora2Pg::GEOM; 14106 my $geom_obj = new Ora2Pg::GEOM('srid' => $self->{spatial_srid}{$table}->[$idx]); 14107 $geom_obj->{geometry}{srid} = ''; 14108 $row->[$idx] = $geom_obj->parse_sdo_geometry($row->[$idx]); 14109 $row->[$idx] = "ST_GeomFromText('" . $row->[$idx] . "', $geom_obj->{geometry}{srid})"; 14110 } 14111 else 14112 { 14113 $row->[$idx] = "ST_Geometry('" . $row->[$idx] . "', $self->{spatial_srid}{$table}->[$idx])"; 14114 } 14115 } 14116 else 14117 { 14118 $row->[$idx] =~ s/^SRID=(\d+);//; 14119 $row->[$idx] = "ST_GeomFromText('" . $row->[$idx] . "', $1)"; 14120 } 14121 } 14122 } 14123 elsif ($row->[$idx] =~ /^(?!(?!)\x{100})ARRAY\(0x/) 14124 { 14125 print STDERR "/!\\ WARNING /!\\: we should not be there !!!\n"; 14126 } 14127 else 14128 { 14129 14130 $row->[$idx] = $self->format_data_type($row->[$idx], $data_type, $action, $table, $src_data_types->[$idx], $idx, $colcond->[$idx], $sprep); 14131 14132 } 14133 } 14134} 14135 14136sub set_custom_type_value 14137{ 14138 my ($self, $data_type, $user_type, $rows, $dest_type, $no_quote) = @_; 14139 14140 my $has_array = 0; 14141 my @type_col = (); 14142 my $result = ''; 14143 my $col_ref = []; 14144 push(@$col_ref, @$rows); 14145 my $num_arr = -1; 14146 my $isnested = 0; 14147 14148 for (my $i = 0; $i <= $#{$col_ref}; $i++) 14149 { 14150 if ($col_ref->[$i] !~ /^ARRAY\(0x/) 14151 { 14152 if ($self->{type} eq 'COPY') 14153 { 14154 # Want to export the user defined type as a single array, not composite type 14155 if ($dest_type =~ /(text|char|varying)\[\d*\]$/i) 14156 { 14157 $has_array = 1; 14158 $col_ref->[$i] =~ s/"/\\\\"/gs; 14159 if ($col_ref->[$i] =~ /[,"]/) { 14160 $col_ref->[$i] = '"' . $col_ref->[$i] . '"'; 14161 }; 14162 # Data must be exported as an array of numeric types 14163 } elsif ($dest_type =~ /\[\d*\]$/) { 14164 $has_array = 1; 14165 } 14166 elsif ($dest_type =~ /(char|text)/) 14167 { 14168 $col_ref->[$i] =~ s/"/\\\\\\\\""/igs; 14169 if ($col_ref->[$i] =~ /[,"]/) { 14170 $col_ref->[$i] = '""' . $col_ref->[$i] . '""'; 14171 }; 14172 } else { 14173 $isnested = 1; 14174 } 14175 } 14176 else 14177 { 14178 # Want to export the user defined type as a single array, not composite type 14179 if ($dest_type =~ /(text|char|varying)\[\d*\]$/i) 14180 { 14181 $has_array = 1; 14182 $col_ref->[$i] =~ s/"/\\"/gs; 14183 $col_ref->[$i] =~ s/'/''/gs; 14184 if ($col_ref->[$i] =~ /[,"]/) { 14185 $col_ref->[$i] = '"' . $col_ref->[$i] . '"'; 14186 }; 14187 # Data must be exported as a simple array of numeric types 14188 } elsif ($dest_type =~ /\[\d*\]$/i) { 14189 $has_array = 1; 14190 } elsif ($dest_type =~ /(char|text)/) { 14191 $col_ref->[$i] = "'" . $col_ref->[$i] . "'" if ($col_ref->[0][$i] ne ''); 14192 } else { 14193 $isnested = 1; 14194 } 14195 } 14196 push(@type_col, $col_ref->[$i]); 14197 } 14198 else 14199 { 14200 $num_arr++; 14201 14202 my @arr_col = (); 14203 for (my $j = 0; $j <= $#{$col_ref->[$i]}; $j++) 14204 { 14205 # Look for data based on custom type to replace the reference by the value 14206 if ($col_ref->[$i][$j] =~ /^(?!(?!)\x{100})ARRAY\(0x/ 14207 && $user_type->{src_types}[$i][$j] !~ /SDO_GEOMETRY/i 14208 && $user_type->{src_types}[$i][$j] !~ /^(ST_|STGEOM_)/i #ArGis geometry types 14209 ) 14210 { 14211 my $dtype = uc($user_type->{src_types}[$i][$j]) || ''; 14212 $dtype =~ s/\(.*//; # remove any precision 14213 if (!exists $self->{data_type}{$dtype} && !exists $self->{user_type}{$dtype}) { 14214 %{ $self->{user_type}{$dtype} } = $self->custom_type_definition($dtype); 14215 } 14216 $col_ref->[$i][$j] = $self->set_custom_type_value($dtype, $self->{user_type}{$dtype}, $col_ref->[$i][$j], $user_type->{pg_types}[$i][$j], 1); 14217 if ($self->{type} ne 'COPY') { 14218 $col_ref->[$i][$j] =~ s/"/\\\\""/gs; 14219 } else { 14220 $col_ref->[$i][$j] =~ s/"/\\\\\\\\""/gs; 14221 } 14222 } 14223 14224 if ($self->{type} eq 'COPY') 14225 { 14226 # Want to export the user defined type as charaters array 14227 if ($dest_type =~ /(text|char|varying)\[\d*\]$/i) 14228 { 14229 $has_array = 1; 14230 $col_ref->[$i][$j] =~ s/"/\\\\"/gs; 14231 if ($col_ref->[$i][$j] =~ /[,"]/) { 14232 $col_ref->[$i][$j] = '"' . $col_ref->[$i][$j] . '"'; 14233 }; 14234 } 14235 # Data must be exported as an array of numeric types 14236 elsif ($dest_type =~ /\[\d*\]$/) { 14237 $has_array = 1; 14238 } 14239 } 14240 else 14241 { 14242 # Want to export the user defined type as array 14243 if ($dest_type =~ /(text|char|varying)\[\d*\]$/i) 14244 { 14245 $has_array = 1; 14246 $col_ref->[$i][$j] =~ s/"/\\"/gs; 14247 $col_ref->[$i][$j] =~ s/'/''/gs; 14248 if ($col_ref->[$i][$j] =~ /[,"]/) { 14249 $col_ref->[$i][$j] = '"' . $col_ref->[$i][$j] . '"'; 14250 }; 14251 } 14252 # Data must be exported as an array of numeric types 14253 elsif ($dest_type =~ /\[\d*\]$/) { 14254 $has_array = 1; 14255 } 14256 } 14257 if ($col_ref->[$i][$j] =~ /[\(\)]/ && $col_ref->[$i][$j] !~ /^[\\]+""/) 14258 { 14259 if ($self->{type} ne 'COPY') { 14260 $col_ref->[$i][$j] = "\\\\\"\"" . $col_ref->[$i][$j] . "\\\\\"\""; 14261 } else { 14262 $col_ref->[$i][$j] = "\\\\\\\\\"\"" . $col_ref->[$i][$j] . "\\\\\\\\\"\""; 14263 } 14264 } 14265 push(@arr_col, $col_ref->[$i][$j]); 14266 } 14267 push(@type_col, '(' . join(',', @arr_col) . ')'); 14268 } 14269 } 14270 14271 if ($has_array) { 14272 $result = '{' . join(',', @type_col) . '}'; 14273 } 14274 elsif ($isnested) 14275 { 14276 # ARRAY[ROW('B','C')] 14277 my $is_string = 0; 14278 foreach my $g (@{$self->{user_type}{$dest_type}->{pg_types}}) { 14279 $is_string = 1 if (grep(/(text|char|varying)/i, @$g)); 14280 } 14281 if ($is_string) { 14282 $result = '({"(' . join(',', @type_col) . ')"})'; 14283 } else { 14284 $result = '("{' . join(',', @type_col) . '}")'; 14285 } 14286 } 14287 else 14288 { 14289 # This is the root call of the function, no global quoting is required 14290 if (!$no_quote) 14291 { 14292 #map { s/^$/NULL/; } @type_col; 14293 #$result = 'ROW(ARRAY[ROW(' . join(',', @type_col) . ')])'; 14294 # With arrays of arrays the construction is different 14295 if ($num_arr > 1) 14296 { 14297 #### Expected 14298 # INSERT: '("{""(0,0,0,0,0,0,0,0,0,,,)"",""(0,0,0,0,0,0,0,0,0,,,)""}")' 14299 # COPY: ("{""(0,0,0,0,0,0,0,0,0,,,)"",""(0,0,0,0,0,0,0,0,0,,,)""}") 14300 #### 14301 $result = "(\"{\"\"" . join('"",""', @type_col) . "\"\"}\")"; 14302 } 14303 # When just one or none arrays are present 14304 else 14305 { 14306 #### Expected 14307 # INSERT: '("(1,1)",0,,)' 14308 # COPY: ("(1,1)",0,,) 14309 #### 14310 map { s/^\(([^\)]+)\)$/"($1)"/; } @type_col; 14311 $result = "(" . join(',', @type_col) . ")"; 14312 } 14313 # else we are in recusive call 14314 } else { 14315 $result = "\"(" . join(',', @type_col) . ")\""; 14316 } 14317 } 14318 if (!$no_quote && $self->{type} ne 'COPY') { 14319 $result = "'$result'"; 14320 } 14321 while ($result =~ s/,"""",/,NULL,/gs) {}; 14322 14323 return $result; 14324} 14325 14326sub format_data_type 14327{ 14328 my ($self, $col, $data_type, $action, $table, $src_type, $idx, $cond, $sprep, $isnested) = @_; 14329 14330 my $q = "'"; 14331 $q = '"' if ($isnested); 14332 14333 # Skip data type formatting when it has already been done in 14334 # set_custom_type_value(), aka when the data type is an array. 14335 next if ($data_type =~ /\[\d*\]/); 14336 14337 # Internal timestamp retrieves from custom type is as follow: 01-JAN-77 12.00.00.000000 AM (internal_date_max) 14338 if (($data_type eq 'char') && $col =~ /^(\d{2})-([A-Z]{3})-(\d{2}) (\d{2})\.(\d{2})\.(\d{2}\.\d+) (AM|PM)$/ ) 14339 { 14340 my $d = $1; 14341 my $m = $ORACLE_MONTHS{$2}; 14342 my $y = $3; 14343 my $h = $4; 14344 my $min = $5; 14345 my $s = $6; 14346 my $typeh = $7; 14347 if ($typeh eq 'PM') { 14348 $h += 12; 14349 } 14350 if ($d <= $self->{internal_date_max}) { 14351 $d += 2000; 14352 } else { 14353 $d += 1900; 14354 } 14355 $col = "$y-$m-$d $h:$min:$s"; 14356 $data_type = 'timestamp'; 14357 $src_type = 'internal timestamp'; 14358 } 14359 14360 # Workaround for a bug in DBD::Oracle with the ora_piece_lob option 14361 # (used when no_lob_locator is enabled) where null values fetch as 14362 # empty string for certain types. 14363 if ($self->{no_lob_locator} and ($cond->{clob} or $cond->{blob} or $cond->{long})) { 14364 $col = undef if (!length($col)); 14365 } 14366 14367 # Preparing data for output 14368 if ($action ne 'COPY') { 14369 if (!defined $col) { 14370 if (!$cond->{isnotnull} || ($self->{empty_lob_null} && ($cond->{clob} || $cond->{isbytea}))) { 14371 $col = 'NULL' if (!$sprep); 14372 } else { 14373 $col = "$q$q"; 14374 } 14375 } elsif ( ($src_type =~ /SDO_GEOMETRY/i) && ($self->{geometry_extract_type} eq 'WKB') ) { 14376 $col = "St_GeomFromWKB($q\\x" . unpack('H*', $col) . "$q, $self->{spatial_srid}{$table}->[$idx])"; 14377 } elsif ($cond->{isbytea}) { 14378 $col = $self->_escape_lob($col, $cond->{raw} ? 'RAW' : 'BLOB', $cond, $isnested); 14379 } elsif ($cond->{istext}) { 14380 if ($cond->{clob}) { 14381 $col = $self->_escape_lob($col, 'CLOB', $cond, $isnested); 14382 } elsif (!$sprep) { 14383 $col = $self->escape_insert($col, $isnested); 14384 } 14385 } elsif ($cond->{isbit}) { 14386 $col = "B$q" . $col . "$q"; 14387 } elsif ($cond->{isdate}) { 14388 if ($col =~ /^0000-00-00/) { 14389 $col = $self->{replace_zero_date} ? "$q$self->{replace_zero_date}$q" : 'NULL'; 14390 } elsif ($col =~ /^(\d+-\d+-\d+ \d+:\d+:\d+)\.$/) { 14391 $col = "$q$1$q"; 14392 } else { 14393 $col = "$q$col$q"; 14394 } 14395 } elsif ($data_type eq 'boolean') { 14396 if (exists $self->{ora_boolean_values}{lc($col)}) { 14397 $col = $q . $self->{ora_boolean_values}{lc($col)} . $q; 14398 } 14399 } 14400 else 14401 { 14402 if (!$self->{pg_dsn}) { 14403 $col =~ s/([\-]*)(\~|Inf)/'$1Infinity'/i; 14404 } else { 14405 $col =~ s/([\-]*)(\~|Inf)/$1Infinity/i; 14406 } 14407 if (!$sprep) { 14408 $col = 'NULL' if ($col eq ''); 14409 } else { 14410 $col = undef if ($col eq ''); 14411 } 14412 } 14413 } else { 14414 if (!defined $col) { 14415 if (!$cond->{isnotnull} || ($self->{empty_lob_null} && ($cond->{clob} || $cond->{isbytea}))) { 14416 $col = '\N'; 14417 } else { 14418 $col = ''; 14419 } 14420 } elsif ( $cond->{geometry} && ($self->{geometry_extract_type} eq 'WKB') ) { 14421 $col = 'SRID=' . $self->{spatial_srid}{$table}->[$idx] . ';' . unpack('H*', $col); 14422 } elsif ($data_type eq 'boolean') { 14423 if (exists $self->{ora_boolean_values}{lc($col)}) { 14424 $col = $self->{ora_boolean_values}{lc($col)}; 14425 } 14426 } elsif ($cond->{isnum}) { 14427 $col =~ s/([\-]*)(\~|Inf)/$1Infinity/i; 14428 $col = '\N' if ($col eq ''); 14429 } elsif ($cond->{isbytea}) { 14430 $col = $self->_escape_lob($col, $cond->{raw} ? 'RAW' : 'BLOB', $cond, $isnested); 14431 } elsif ($cond->{istext}) { 14432 $cond->{clob} ? $col = $self->_escape_lob($col, 'CLOB', $cond, $isnested) : $col = $self->escape_copy($col, $isnested); 14433 } elsif ($cond->{isdate}) { 14434 if ($col =~ /^0000-00-00/) { 14435 $col = $self->{replace_zero_date} || '\N'; 14436 } elsif ($col =~ /^(\d+-\d+-\d+ \d+:\d+:\d+)\.$/) { 14437 $col = $1; 14438 } 14439 } elsif ($cond->{isbit}) { 14440 $col = $col; 14441 } 14442 } 14443 return $col; 14444} 14445 14446sub hs_cond 14447{ 14448 my ($self, $data_types, $src_data_types, $table) = @_; 14449 14450 my $col_cond = []; 14451 for (my $idx = 0; $idx < scalar(@$data_types); $idx++) { 14452 my $hs={}; 14453 $hs->{geometry} = $src_data_types->[$idx] =~ /SDO_GEOMETRY/i ? 1 : 0; 14454 $hs->{isnum} = $data_types->[$idx] !~ /^(char|varchar|date|time|text|bytea|xml|uuid|citext)/i ? 1 :0; 14455 $hs->{isdate} = $data_types->[$idx] =~ /^(date|time)/i ? 1 : 0; 14456 $hs->{raw} = $src_data_types->[$idx] =~ /RAW/i ? 1 : 0; 14457 $hs->{clob} = $src_data_types->[$idx] =~ /CLOB/i ? 1 : 0; 14458 $hs->{blob} = $src_data_types->[$idx] =~ /BLOB/i ? 1 : 0; 14459 $hs->{long} = $src_data_types->[$idx] =~ /LONG/i ? 1 : 0; 14460 $hs->{istext} = $data_types->[$idx] =~ /(char|text|xml|uuid|citext)/i ? 1 : 0; 14461 $hs->{isbytea} = $data_types->[$idx] =~ /bytea/i ? 1 : 0; 14462 $hs->{isbit} = $data_types->[$idx] =~ /bit/i ? 1 : 0; 14463 $hs->{isnotnull} = 0; 14464 if ($self->{nullable}{$table}{$idx} =~ /^N/) { 14465 $hs->{isnotnull} = 1; 14466 } 14467 push @$col_cond, $hs; 14468 } 14469 return $col_cond; 14470} 14471 14472sub format_data 14473{ 14474 my ($self, $rows, $data_types, $action, $src_data_types, $custom_types, $table) = @_; 14475 14476 my $col_cond = $self->hs_cond($data_types,$src_data_types, $table); 14477 foreach my $row (@$rows) { 14478 $self->format_data_row($row,$data_types,$action,$src_data_types,$custom_types,$table,$col_cond); 14479 } 14480} 14481 14482=head2 dump 14483 14484This function dump data to the right export output (gzip file, file or stdout). 14485 14486=cut 14487 14488sub dump 14489{ 14490 my ($self, $data, $fh) = @_; 14491 14492 return if (!defined $data || $data eq ''); 14493 14494 if (!$self->{compress}) { 14495 if (defined $fh) { 14496 $fh->print($data); 14497 } elsif (defined $self->{fhout}) { 14498 $self->{fhout}->print($data); 14499 } else { 14500 print $data; 14501 } 14502 } elsif ($self->{compress} eq 'Zlib') { 14503 if (not defined $fh) { 14504 $self->{fhout}->gzwrite($data) or $self->logit("FATAL: error dumping compressed data\n", 0, 1); 14505 } else { 14506 $fh->gzwrite($data) or $self->logit("FATAL: error dumping compressed data\n", 0, 1); 14507 } 14508 } elsif (defined $self->{fhout}) { 14509 $self->{fhout}->print($data); 14510 } else { 14511 $self->logit("FATAL: no filehandle to write output, this may not happen\n", 0, 1); 14512 } 14513} 14514 14515=head2 data_dump 14516 14517This function dump data to the right output (gzip file, file or stdout) in multiprocess safety. 14518File is open and locked before writind data, it is closed at end. 14519 14520=cut 14521 14522sub data_dump 14523{ 14524 my ($self, $data, $tname, $pname) = @_; 14525 14526 return if ($self->{oracle_speed}); 14527 14528 # get out of here if there is no data to dump 14529 return if (not defined $data or $data eq ''); 14530 14531 my $dirprefix = ''; 14532 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 14533 my $filename = $self->{output}; 14534 my $rname = $pname || $tname; 14535 if ($self->{file_per_table}) { 14536 $filename = "${rname}_$self->{output}"; 14537 $filename = "tmp_$filename"; 14538 } 14539 # Set file temporary until the table export is done 14540 $self->logit("Dumping data from $rname to file: $filename\n", 1); 14541 14542 if ( ($self->{jobs} > 1) || ($self->{oracle_copies} > 1) ) 14543 { 14544 $self->close_export_file($self->{fhout}) if (defined $self->{fhout} && !$self->{file_per_table} && !$self->{pg_dsn}); 14545 my $fh = $self->append_export_file($filename); 14546 $self->set_binmode($fh) if (!$self->{compress}); 14547 flock($fh, 2) || die "FATAL: can't lock file $dirprefix$filename\n"; 14548 $fh->print($data); 14549 $self->close_export_file($fh); 14550 $self->logit("Written " . length($data) . " bytes to $dirprefix$filename\n", 1); 14551 # Reopen default output file 14552 $self->create_export_file() if (defined $self->{fhout} && !$self->{file_per_table} && !$self->{pg_dsn}); 14553 } 14554 elsif ($self->{file_per_table}) 14555 { 14556 if ($pname) 14557 { 14558 my $fh = $self->append_export_file($filename); 14559 $self->set_binmode($fh) if (!$self->{compress}); 14560 $fh->print($data); 14561 $self->close_export_file($fh); 14562 $self->logit("Written " . length($data) . " bytes to $dirprefix$filename\n", 1); 14563 } 14564 else 14565 { 14566 my $set_encoding = 0; 14567 if (!defined $self->{cfhout}) 14568 { 14569 $self->{cfhout} = $self->open_export_file($filename); 14570 $set_encoding = 1; 14571 } 14572 14573 if ($self->{compress} eq 'Zlib') 14574 { 14575 $self->{cfhout}->gzwrite($data) or $self->logit("FATAL: error writing compressed data into $filename :: $self->{cfhout}\n", 0, 1); 14576 } 14577 else 14578 { 14579 $self->set_binmode($self->{cfhout}) if (!$self->{compress} && $set_encoding); 14580 $self->{cfhout}->print($data); 14581 } 14582 } 14583 } 14584 else 14585 { 14586 $self->dump($data); 14587 } 14588} 14589 14590=head2 read_config 14591 14592This function read the specified configuration file. 14593 14594=cut 14595 14596sub read_config 14597{ 14598 my ($self, $file) = @_; 14599 14600 my $fh = new IO::File; 14601 $fh->open($file) or $self->logit("FATAL: can't read configuration file $file, $!\n", 0, 1); 14602 while (my $l = <$fh>) 14603 { 14604 chomp($l); 14605 $l =~ s/\r//gs; 14606 $l =~ s/^\s*\#.*$//g; 14607 next if (!$l || ($l =~ /^\s+$/)); 14608 $l =~ s/^\s*//; $l =~ s/\s*$//; 14609 my ($var, $val) = split(/\s+/, $l, 2); 14610 $var = uc($var); 14611 if ($var eq 'IMPORT') 14612 { 14613 if ($val) 14614 { 14615 $self->logit("Importing $val...\n", 1); 14616 $self->read_config($val); 14617 $self->logit("Done importing $val.\n",1); 14618 } 14619 } 14620 elsif ($var =~ /^SKIP/) 14621 { 14622 if ($val) 14623 { 14624 $self->logit("No extraction of \L$val\E\n",1); 14625 my @skip = split(/[\s;,]+/, $val); 14626 foreach my $s (@skip) 14627 { 14628 $s = 'indexes' if ($s =~ /^indices$/i); 14629 $AConfig{"skip_\L$s\E"} = 1; 14630 } 14631 } 14632 } 14633 # Should be a else statement but keep the list up to date to memorize the directives full list 14634 elsif (!grep(/^$var$/, 'TABLES','ALLOW','MODIFY_STRUCT','REPLACE_TABLES','REPLACE_COLS', 14635 'WHERE','EXCLUDE','VIEW_AS_TABLE','ORA_RESERVED_WORDS','SYSUSERS', 14636 'REPLACE_AS_BOOLEAN','BOOLEAN_VALUES','MODIFY_TYPE','DEFINED_PK', 14637 'ALLOW_PARTITION','REPLACE_QUERY','FKEY_ADD_UPDATE','DELETE', 14638 'LOOK_FORWARD_FUNCTION','ORA_INITIAL_COMMAND','PG_INITIAL_COMMAND', 14639 'ORACLE_FDW_TRANSFORM' 14640 )) 14641 { 14642 $AConfig{$var} = $val; 14643 if ($var eq 'NO_LOB_LOCATOR') { 14644 print STDERR "WARNING: NO_LOB_LOCATOR is deprecated, use USE_LOB_LOCATOR instead see documentation about the logic change.\n"; 14645 if ($val == 1) { 14646 $AConfig{USE_LOB_LOCATOR} = 0; 14647 } else { 14648 $AConfig{USE_LOB_LOCATOR} = 1; 14649 } 14650 } 14651 if ($var eq 'NO_BLOB_EXPORT') { 14652 print STDERR "WARNING: NO_BLOB_EXPORT is deprecated, use ENABLE_BLOB_EXPORT instead see documentation about the logic change.\n"; 14653 if ($val == 1) { 14654 $AConfig{ENABLE_BLOB_EXPORT} = 0; 14655 } else { 14656 $AConfig{ENABLE_BLOB_EXPORT} = 1; 14657 } 14658 } 14659 } elsif ($var eq 'VIEW_AS_TABLE') { 14660 push(@{$AConfig{$var}}, split(/[\s;,]+/, $val) ); 14661 } elsif ($var eq 'LOOK_FORWARD_FUNCTION') { 14662 push(@{$AConfig{$var}}, split(/[\s;,]+/, $val) ); 14663 } 14664 elsif ( ($var eq 'TABLES') || ($var eq 'ALLOW') || ($var eq 'EXCLUDE') 14665 || ($var eq 'ALLOW_PARTITION') ) 14666 { 14667 $var = 'ALLOW' if ($var eq 'TABLES'); 14668 if ($var eq 'ALLOW_PARTITION') 14669 { 14670 $var = 'ALLOW'; 14671 push(@{$AConfig{$var}{PARTITION}}, split(/[,\s]+/, $val) ); 14672 } 14673 else 14674 { 14675 # Syntax: TABLE[regex1 regex2 ...];VIEW[regex1 regex2 ...];glob_regex1 glob_regex2 ... 14676 # Global regex will be applied to the export type only 14677 my @vlist = split(/\s*;\s*/, $val); 14678 foreach my $a (@vlist) 14679 { 14680 if ($a =~ /^([^\[]+)\[(.*)\]$/) { 14681 push(@{$AConfig{$var}{"\U$1\E"}}, split(/[,\s]+/, $2) ); 14682 } else { 14683 push(@{$AConfig{$var}{ALL}}, split(/[,\s]+/, $a) ); 14684 } 14685 } 14686 } 14687 } 14688 elsif ( $var =~ /_INITIAL_COMMAND/ ) { 14689 push(@{$AConfig{$var}}, $val); 14690 } elsif ( $var eq 'SYSUSERS' ) { 14691 push(@{$AConfig{$var}}, split(/[\s;,]+/, $val) ); 14692 } elsif ( $var eq 'ORA_RESERVED_WORDS' ) { 14693 push(@{$AConfig{$var}}, split(/[\s;,]+/, $val) ); 14694 } 14695 elsif ( $var eq 'FKEY_ADD_UPDATE' ) 14696 { 14697 if (grep(/^$val$/i, @FKEY_OPTIONS)) { 14698 $AConfig{$var} = uc($val); 14699 } else { 14700 $self->logit("FATAL: invalid option, see FKEY_ADD_UPDATE in configuration file\n", 0, 1); 14701 } 14702 } 14703 elsif ($var eq 'MODIFY_STRUCT') 14704 { 14705 while ($val =~ s/([^\(\s]+)\s*\(([^\)]+)\)\s*//) { 14706 my $table = $1; 14707 my $fields = $2; 14708 $fields =~ s/^\s+//; 14709 $fields =~ s/\s+$//; 14710 push(@{$AConfig{$var}{$table}}, split(/[\s,]+/, $fields) ); 14711 } 14712 } 14713 elsif ($var eq 'MODIFY_TYPE') 14714 { 14715 $val =~ s/\\,/#NOSEP#/gs; 14716 my @modif_type = split(/[,;]+/, $val); 14717 foreach my $r (@modif_type) 14718 { 14719 $r =~ s/#NOSEP#/,/gs; 14720 my ($table, $col, $type) = split(/:/, lc($r)); 14721 $AConfig{$var}{$table}{$col} = $type; 14722 } 14723 } 14724 elsif ($var eq 'REPLACE_COLS') 14725 { 14726 while ($val =~ s/([^\(\s]+)\s*\(([^\)]+)\)[,;\s]*//) 14727 { 14728 my $table = $1; 14729 my $fields = $2; 14730 $fields =~ s/^\s+//; 14731 $fields =~ s/\s+$//; 14732 my @rel = split(/[,]+/, $fields); 14733 foreach my $r (@rel) 14734 { 14735 my ($old, $new) = split(/:/, $r); 14736 $AConfig{$var}{$table}{$old} = $new; 14737 } 14738 } 14739 } 14740 elsif ($var eq 'REPLACE_TABLES') 14741 { 14742 my @replace_tables = split(/[\s,;]+/, $val); 14743 foreach my $r (@replace_tables) 14744 { 14745 my ($old, $new) = split(/:/, $r); 14746 $AConfig{$var}{$old} = $new; 14747 } 14748 } 14749 elsif ($var eq 'REPLACE_AS_BOOLEAN') 14750 { 14751 my @replace_boolean = split(/[\s;]+/, $val); 14752 foreach my $r (@replace_boolean) 14753 { 14754 my ($table, $col) = split(/:/, $r); 14755 push(@{$AConfig{$var}{uc($table)}}, uc($col)); 14756 } 14757 } 14758 elsif ($var eq 'BOOLEAN_VALUES') 14759 { 14760 my @replace_boolean = split(/[\s,;]+/, $val); 14761 foreach my $r (@replace_boolean) 14762 { 14763 my ($yes, $no) = split(/:/, $r); 14764 $AConfig{$var}{lc($yes)} = 't'; 14765 $AConfig{$var}{lc($no)} = 'f'; 14766 } 14767 } 14768 elsif ($var eq 'DEFINED_PK') 14769 { 14770 my @defined_pk = split(/[\s,;]+/, $val); 14771 foreach my $r (@defined_pk) 14772 { 14773 my ($table, $col) = split(/:/, $r); 14774 $AConfig{$var}{lc($table)} = $col; 14775 } 14776 } 14777 elsif ($var eq 'WHERE') 14778 { 14779 while ($val =~ s/([^\[\s]+)\s*\[([^\]]+)\]\s*//) 14780 { 14781 my $table = $1; 14782 my $where = $2; 14783 $where =~ s/^\s+//; 14784 $where =~ s/\s+$//; 14785 $AConfig{$var}{$table} = $where; 14786 } 14787 if ($val) { 14788 $AConfig{"GLOBAL_WHERE"} = $val; 14789 } 14790 } 14791 elsif ($var eq 'ORACLE_FDW_TRANSFORM') 14792 { 14793 my @vals = split(/\s*;\s*/, $val); 14794 foreach my $v (@vals) 14795 { 14796 while ($v =~ s/([^\[\s]+)\s*\[\s*([^,]+)\s*,\s*([^\]]+)\s*\]\s*//) 14797 { 14798 my $table = $1; 14799 my $column = $2; 14800 my $clause = $3; 14801 $column =~ s/"//g; 14802 $AConfig{$var}{lc($table)}{lc($column)} = $clause; 14803 } 14804 } 14805 } 14806 elsif ($var eq 'DELETE') 14807 { 14808 while ($val =~ s/([^\[\s]+)\s*\[([^\]]+)\]\s*//) 14809 { 14810 my $table = $1; 14811 my $delete = $2; 14812 $delete =~ s/^\s+//; 14813 $delete =~ s/\s+$//; 14814 $AConfig{$var}{$table} = $delete; 14815 } 14816 if ($val) { 14817 $AConfig{"GLOBAL_DELETE"} = $val; 14818 } 14819 } 14820 elsif ($var eq 'REPLACE_QUERY') 14821 { 14822 while ($val =~ s/([^\[\s]+)\s*\[([^\]]+)\]\s*//) 14823 { 14824 my $table = lc($1); 14825 my $query = $2; 14826 $query =~ s/^\s+//; 14827 $query =~ s/\s+$//; 14828 $AConfig{$var}{$table} = $query; 14829 } 14830 } 14831 } 14832 $self->close_export_file($fh); 14833 14834} 14835 14836sub _extract_functions 14837{ 14838 my ($self, $content) = @_; 14839 14840 my @lines = split(/\n/s, $content); 14841 my @functions = (''); 14842 my $before = ''; 14843 my $fcname = ''; 14844 my $type = ''; 14845 for (my $i = 0; $i <= $#lines; $i++) { 14846 if ($lines[$i] =~ /^(?:CREATE|CREATE OR REPLACE)?\s*(?:NONEDITIONABLE|EDITIONABLE)?\s*(FUNCTION|PROCEDURE)\s+([a-z0-9_\-\."]+)(.*)/i) { 14847 $type = uc($1); 14848 $fcname = $2; 14849 $fcname =~ s/^.*\.//; 14850 $fcname =~ s/"//g; 14851 $type = 'FUNCTION' if (!$self->{pg_supports_procedure}); 14852 if ($before) { 14853 push(@functions, "$before\n"); 14854 $functions[-1] .= "$type $2 $3\n"; 14855 } else { 14856 push(@functions, "$type $fcname $3\n"); 14857 } 14858 $before = ''; 14859 } elsif ($fcname) { 14860 $functions[-1] .= "$lines[$i]\n"; 14861 } else { 14862 $before .= "$lines[$i]\n"; 14863 } 14864 $fcname = '' if ($lines[$i] =~ /^\s*END\s+$fcname\b/i); 14865 } 14866 14867 map { s/\bEND\s+(?!IF|LOOP|CASE|INTO|FROM|,)[a-z0-9_]+\s*;/END;/igs; } @functions; 14868 14869 return @functions; 14870} 14871 14872=head2 _convert_package 14873 14874This function is used to rewrite Oracle PACKAGE code to 14875PostgreSQL SCHEMA. Called only if PLSQL_PGSQL configuration directive 14876is set to 1. 14877 14878=cut 14879 14880sub _convert_package 14881{ 14882 my ($self, $pkg) = @_; 14883 14884 return if (!$pkg || !exists $self->{packages}{$pkg}); 14885 14886 my $owner = $self->{packages}{$pkg}{owner} || ''; 14887 14888 my $dirprefix = ''; 14889 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 14890 my $content = ''; 14891 14892 if ($self->{package_as_schema}) 14893 { 14894 my $pname = $self->quote_object_name($pkg); 14895 $pname =~ s/^[^\.]+\.//; 14896 $content .= "\nDROP SCHEMA $self->{pg_supports_ifexists} $pname CASCADE;\n"; 14897 $content .= "CREATE SCHEMA IF NOT EXISTS $pname;\n"; 14898 if ($self->{force_owner}) 14899 { 14900 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 14901 if ($owner) { 14902 $content .= "ALTER SCHEMA \L$pname\E OWNER TO " . $self->quote_object_name($owner) . ";\n"; 14903 } 14904 } 14905 } 14906 14907 # Grab global declaration from the package header 14908 if ($self->{packages}{$pkg}{desc} =~ /CREATE OR REPLACE PACKAGE\s+([^\s]+)(?:\s*\%ORA2PG_COMMENT\d+\%)*\s*((?:AS|IS)(?:\s*\%ORA2PG_COMMENT\d+\%)*)\s*(.*)/is) 14909 { 14910 my $pname = $1; 14911 my $type = $2; 14912 my $glob_declare = $3; 14913 $pname =~ s/"//g; 14914 $pname =~ s/^.*\.//g; 14915 $self->logit("Looking global declaration in package $pname...\n", 1); 14916 14917 # Process package spec to extract global variables 14918 $self->_remove_comments(\$glob_declare); 14919 if ($glob_declare) 14920 { 14921 my @cursors = (); 14922 ($glob_declare, @cursors) = $self->clear_global_declaration($pname, $glob_declare, 0); 14923 # Then dump custom type 14924 foreach my $tpe (sort {$a->{pos} <=> $b->{pos}} @{$self->{types}}) 14925 { 14926 $self->logit("Dumping type $tpe->{name}...\n", 1); 14927 if ($self->{plsql_pgsql}) { 14928 $tpe->{code} = $self->_convert_type($tpe->{code}, $tpe->{owner}, %{$self->{pkg_type}{$pname}}); 14929 } else { 14930 if ($tpe->{code} !~ /^SUBTYPE\s+/i) { 14931 $tpe->{code} = "CREATE$self->{create_or_replace} $tpe->{code}\n"; 14932 } 14933 } 14934 $tpe->{code} =~ s/REPLACE type/REPLACE TYPE/; 14935 $content .= $tpe->{code} . "\n"; 14936 $i++; 14937 } 14938 $content .= join("\n", @cursors) . "\n"; 14939 $glob_declare = $self->register_global_variable($pname, $glob_declare); 14940 } 14941 @{$self->{types}} = (); 14942 } 14943 14944 # Convert the package body part 14945 if ($self->{packages}{$pkg}{text} =~ /CREATE OR REPLACE PACKAGE\s+BODY\s*([^\s\%]+)(?:\s*\%ORA2PG_COMMENT\d+\%)*\s*(AS|IS)\s*(.*)/is) 14946 { 14947 14948 my $pname = $1; 14949 my $type = $2; 14950 my $ctt = $3; 14951 my $glob_declare = $3; 14952 14953 $pname =~ s/"//g; 14954 $pname =~ s/^.*\.//g; 14955 $self->logit("Dumping package $pname...\n", 1); 14956 14957 # Process package spec to extract global variables 14958 $self->_remove_comments(\$glob_declare); 14959 if ($glob_declare && $glob_declare !~ /^(?:\s*\%ORA2PG_COMMENT\d+\%)*(FUNCTION|PROCEDURE)/is) 14960 { 14961 my @cursors = (); 14962 ($glob_declare, @cursors) = $self->clear_global_declaration($pname, $glob_declare, 1); 14963 # Then dump custom type 14964 foreach my $tpe (sort {$a->{pos} <=> $b->{pos}} @{$self->{types}}) 14965 { 14966 next if (!exists $self->{pkg_type}{$pname}{$tpe->{name}}); 14967 $self->logit("Dumping type $tpe->{name}...\n", 1); 14968 if ($self->{plsql_pgsql}) { 14969 $tpe->{code} = $self->_convert_type($tpe->{code}, $tpe->{owner}, %{$self->{pkg_type}{$pname}}); 14970 } else { 14971 if ($tpe->{code} !~ /^SUBTYPE\s+/i) { 14972 $tpe->{code} = "CREATE$self->{create_or_replace} $tpe->{code}\n"; 14973 } 14974 } 14975 $tpe->{code} =~ s/REPLACE type/REPLACE TYPE/; 14976 $content .= $tpe->{code} . "\n"; 14977 $i++; 14978 } 14979 $content .= join("\n", @cursors) . "\n"; 14980 $glob_declare = $self->register_global_variable($pname, $glob_declare); 14981 } 14982 if ($self->{file_per_function}) 14983 { 14984 my $dir = lc("$dirprefix$pname"); 14985 if (!-d "$dir") { 14986 if (not mkdir($dir)) { 14987 $self->logit("Fail creating directory package : $dir - $!\n", 1); 14988 next; 14989 } else { 14990 $self->logit("Creating directory package: $dir\n", 1); 14991 } 14992 } 14993 } 14994 $ctt =~ s/\bEND[^;]*;$//is; 14995 14996 my @functions = $self->_extract_functions($ctt); 14997 14998 # Try to detect local function 14999 for (my $i = 0; $i <= $#functions; $i++) 15000 { 15001 my %fct_detail = $self->_lookup_function($functions[$i], $pname); 15002 if (!exists $fct_detail{name}) { 15003 $functions[$i] = ''; 15004 next; 15005 } 15006 $fct_detail{name} =~ s/^.*\.//; 15007 $fct_detail{name} =~ s/"//g; 15008 next if (!$fct_detail{name}); 15009 $fct_detail{name} = lc($fct_detail{name}); 15010 if (!exists $self->{package_functions}{"\L$pname\E"}{$fct_detail{name}}) 15011 { 15012 my $res_name = $fct_detail{name}; 15013 $res_name =~ s/^[^\.]+\.//; 15014 $fct_detail{name} =~ s/^([^\.]+)\.//; 15015 if ($self->{package_as_schema}) { 15016 $res_name = $pname . '.' . $res_name; 15017 } else { 15018 $res_name = $pname . '_' . $res_name; 15019 } 15020 $res_name =~ s/"_"/_/g; 15021 $self->{package_functions}{"\L$pname\E"}{"\L$fct_detail{name}\E"}{name} = $self->quote_object_name($res_name); 15022 $self->{package_functions}{"\L$pname\E"}{"\L$fct_detail{name}\E"}{package} = $pname; 15023 } 15024 } 15025 15026 $self->{pkgcost} = 0; 15027 foreach my $f (@functions) 15028 { 15029 next if (!$f); 15030 $content .= $self->_convert_function($owner, $f, $pkg || $pname); 15031 } 15032 if ($self->{estimate_cost}) { 15033 $self->{total_pkgcost} += $self->{pkgcost} || 0; 15034 } 15035 15036 } 15037 15038 @{$self->{types}} = (); 15039 15040 return $content; 15041} 15042 15043=head2 _restore_comments 15044 15045This function is used to restore comments into SQL code previously 15046remove for easy parsing 15047 15048=cut 15049 15050sub _restore_comments 15051{ 15052 my ($self, $content) = @_; 15053 15054 # Replace text values that was replaced in code 15055 $self->_restore_text_constant_part($content); 15056 15057 # Restore comments 15058 while ($$content =~ /(\%ORA2PG_COMMENT\d+\%)[\n]*/is) { 15059 my $id = $1; 15060 my $sep = "\n"; 15061 # Do not append newline if this is a hint 15062 $sep = '' if ($self->{comment_values}{$id} =~ /^\/\*\+/); 15063 $$content =~ s/$id[\n]*/$self->{comment_values}{$id}$sep/is; 15064 delete $self->{comment_values}{$id}; 15065 }; 15066 15067 # Restore start comment in a constant string 15068 $$content =~ s/\%OPEN_COMMENT\%/\/\*/gs; 15069 15070 if ($self->{string_constant_regexp}) { 15071 # Replace potential text values that was replaced in comments 15072 $self->_restore_text_constant_part($content); 15073 } 15074} 15075 15076=head2 _remove_comments 15077 15078This function is used to remove comments from SQL code 15079to allow easy parsing 15080 15081=cut 15082 15083sub _remove_comments 15084{ 15085 my ($self, $content, $no_constant) = @_; 15086 15087 # Fix comment in a string constant 15088 $$content = encode('UTF-8', $$content) if (!$self->{input_file}); 15089 while ($$content =~ s/('[^';\n]*)\/\*([^';\n]*')/$1\%OPEN_COMMENT\%$2/s) {}; 15090 15091 # Fix unterminated comment at end of the code 15092 $$content =~ s/(\/\*(?:(?!\*\/).)*)$/$1 \*\//s; 15093 15094 # Replace some other cases that are breaking the parser (presence of -- in constant string, etc.) 15095 my @lines = split(/([\n\r]+)/, $$content); 15096 for (my $i = 0; $i <= $#lines; $i++) 15097 { 15098 next if ($lines[$i] !~ /\S/); 15099 15100 # Single line comment --...-- */ is replaced by */ only 15101 $lines[$i] =~ s/^([\t ]*)\-[\-]+\s*\*\//$1\*\//; 15102 15103 # Single line comment -- 15104 if ($lines[$i] =~ s/^([\t ]*\-\-.*)$/$1\%ORA2PG_COMMENT$self->{idxcomment}\%/) 15105 { 15106 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $2; 15107 $self->{idxcomment}++; 15108 } 15109 15110 # Single line comment /* ... */ 15111 if ($lines[$i] =~ s/^([\t ]*\/\*.*\*\/)$/$1\%ORA2PG_COMMENT$self->{idxcomment}\%/) 15112 { 15113 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $2; 15114 $self->{idxcomment}++; 15115 } 15116 15117 # ex: v := 'literal' -- commentaire avec un ' guillemet 15118 if ($lines[$i] =~ s/^([^']+'[^']*'\s*)(\-\-.*)$/$1\%ORA2PG_COMMENT$self->{idxcomment}\%/) 15119 { 15120 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $2; 15121 $self->{idxcomment}++; 15122 } 15123 15124 # ex: ---/* REN 16.12.2010 ZKOUSKA TEST NA KOLURC 15125 if ($lines[$i] =~ s/^(\s*)(\-\-(?:(?!\*\/\s*$).)*)$/$1\%ORA2PG_COMMENT$self->{idxcomment}\%/) 15126 { 15127 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $2; 15128 $self->{idxcomment}++; 15129 } 15130 15131 # ex: var1 := SUBSTR(var2,1,28) || ' -- ' || var3 || ' -- ' || SUBSTR(var4,1,26) ; 15132 while ($lines[$i] =~ s/('[^;']*\-\-[^']*')/\?TEXTVALUE$self->{text_values_pos}\?/) 15133 { 15134 $self->{text_values}{$self->{text_values_pos}} = $1; 15135 $self->{text_values_pos}++; 15136 } 15137 } 15138 $$content =join('', @lines); 15139 15140 # First remove hints they are not supported in PostgreSQL and it break the parser 15141 while ($$content =~ s/(\/\*\+(?:.*?)\*\/)/\%ORA2PG_COMMENT$self->{idxcomment}\%/s) 15142 { 15143 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $1; 15144 $self->{idxcomment}++; 15145 } 15146 15147 # Replace /* */ comments by a placeholder and save the comment 15148 while ($$content =~ s/(\/\*(.*?)\*\/)/\%ORA2PG_COMMENT$self->{idxcomment}\%/s) 15149 { 15150 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $1; 15151 $self->{idxcomment}++; 15152 } 15153 15154 while ($$content =~ s/(\'[^\'\n\r]+\b(PROCEDURE|FUNCTION)\s+[^\'\n\r]+\')/\%ORA2PG_COMMENT$self->{idxcomment}\%/is) 15155 { 15156 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $1; 15157 $self->{idxcomment}++; 15158 } 15159 @lines = split(/\n/, $$content); 15160 for (my $j = 0; $j <= $#lines; $j++) 15161 { 15162 if (!$self->{is_mysql}) 15163 { 15164 # Extract multiline comments as a single placeholder 15165 my $old_j = $j; 15166 my $cmt = ''; 15167 while ($lines[$j] =~ /^(\s*\-\-.*)$/) 15168 { 15169 $cmt .= "$1\n"; 15170 $j++; 15171 } 15172 if ( $j > $old_j ) 15173 { 15174 chomp($cmt); 15175 $lines[$old_j] =~ s/^(\s*\-\-.*)$/\%ORA2PG_COMMENT$self->{idxcomment}\%/; 15176 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $cmt; 15177 $self->{idxcomment}++; 15178 $j--; 15179 while ($j > $old_j) 15180 { 15181 delete $lines[$j]; 15182 $j--; 15183 } 15184 } 15185 my $nocomment = ''; 15186 if ($lines[$j] =~ s/^([^']*)('[^\-\']*\-\-[^\-\']*')/$1\%NO_COMMENT\%/) { 15187 $nocomment = $2; 15188 } 15189 if ($lines[$j] =~ s/(\s*\-\-.*)$/\%ORA2PG_COMMENT$self->{idxcomment}\%/) 15190 { 15191 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $1; 15192 chomp($self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"}); 15193 $self->{idxcomment}++; 15194 } 15195 $lines[$j] =~ s/\%NO_COMMENT\%/$nocomment/; 15196 } 15197 else 15198 { 15199 # Mysql supports differents kinds of comment's starter 15200 if ( ($lines[$j] =~ s/(\s*\-\- .*)$/\%ORA2PG_COMMENT$self->{idxcomment}\%/) || 15201 (!grep(/^$self->{type}$/, 'FUNCTION', 'PROCEDURE') && $lines[$j] =~ s/(\s*COMMENT\s+'.*)$/\%ORA2PG_COMMENT$self->{idxcomment}\%/) || 15202 ($lines[$j] =~ s/(\s*\# .*)$/\%ORA2PG_COMMENT$self->{idxcomment}\%/) ) 15203 { 15204 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $1; 15205 chomp($self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"}); 15206 # Normalize start of comment 15207 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} =~ s/^(\s*)COMMENT/$1\-\- /; 15208 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} =~ s/^(\s*)\#/$1\-\- /; 15209 $self->{idxcomment}++; 15210 } 15211 } 15212 } 15213 $$content = join("\n", @lines); 15214 15215 # Replace subsequent comment by a single one 15216 while ($$content =~ s/(\%ORA2PG_COMMENT\d+\%\s*\%ORA2PG_COMMENT\d+\%)/\%ORA2PG_COMMENT$self->{idxcomment}\%/s) 15217 { 15218 $self->{comment_values}{"\%ORA2PG_COMMENT$self->{idxcomment}\%"} = $1; 15219 $self->{idxcomment}++; 15220 } 15221 15222 # Restore possible false positive constant replacement inside comment 15223 foreach my $k (keys %{ $self->{comment_values} } ) { 15224 $self->{comment_values}{$k} =~ s/\?TEXTVALUE(\d+)\?/$self->{text_values}{$1}/gs; 15225 } 15226 15227 # Then replace text constant part to prevent a split on a ; or -- inside a text 15228 if (!$no_constant) { 15229 $self->_remove_text_constant_part($content); 15230 } 15231} 15232 15233=head2 _convert_function 15234 15235This function is used to rewrite Oracle FUNCTION code to 15236PostgreSQL. Called only if PLSQL_PGSQL configuration directive 15237is set to 1. 15238 15239=cut 15240 15241sub _convert_function 15242{ 15243 my ($self, $owner, $plsql, $pname) = @_; 15244 15245 my $dirprefix = ''; 15246 $dirprefix = "$self->{output_dir}/" if ($self->{output_dir}); 15247 15248 my %fct_detail = $self->_lookup_function($plsql, $pname); 15249 if ($self->{is_mysql}) { 15250 $pname = ''; 15251 } 15252 return if (!exists $fct_detail{name}); 15253 15254 $fct_detail{name} =~ s/^.*\.//; 15255 $fct_detail{name} =~ s/"//gs; 15256 15257 my $sep = '.'; 15258 $sep = '_' if (!$self->{package_as_schema}); 15259 my $fname = $self->quote_object_name($fct_detail{name}); 15260 $fname = $self->quote_object_name("$pname$sep$fct_detail{name}") if ($pname && !$self->{is_mysql}); 15261 $fname =~ s/"_"/_/gs; 15262 15263 $fct_detail{args} =~ s/\s+IN\s+/ /igs; # Remove default IN keyword 15264 15265 # Replace DEFAULT EMPTY_BLOB() from function/procedure arguments by DEFAULT NULL 15266 $fct_detail{args} =~ s/\s+DEFAULT\s+EMPTY_[CB]LOB\(\)/DEFAULT NULL/igs; 15267 15268 # Input parameters after one with a default value must also have defaults 15269 # we add DEFAULT NULL to all remaining parameter without a default value. 15270 my @args_sorted = (); 15271 $fct_detail{args} =~ s/^\((.*)\)(\s*\%ORA2PG_COMMENT\d+\%)*\s*$/$1$2/gs; 15272 15273 # Preserve parameters with precision and scale 15274 my $h = 0; 15275 my %param_param = (); 15276 while ($fct_detail{args} =~ s/\(([^\)]+)\)/%%tmp$h%%/s) 15277 { 15278 $param_param{$h} = $1; 15279 $h++; 15280 } 15281 15282 if ($self->{use_default_null}) 15283 { 15284 my $has_default = 0; 15285 @args_sorted = split(',', $fct_detail{args}); 15286 for (my $i = 0; $i <= $#args_sorted; $i++) 15287 { 15288 $has_default = 1 if ($args_sorted[$i] =~ /\s+DEFAULT\s/i); 15289 if ($has_default && $args_sorted[$i] !~ /\s+DEFAULT\s/i) 15290 { 15291 # Add default null if this is not an OUT parameter 15292 if ( $args_sorted[$i] !~ /[,\(\s]OUT[\s,\)]/i && $args_sorted[$i] !~ /^OUT\s/i) { 15293 $args_sorted[$i] .= ' DEFAULT NULL'; 15294 } 15295 } 15296 } 15297 } 15298 else 15299 { 15300 # or we need to sort the arguments so the ones with default values will be on the bottom 15301 push(@args_sorted, grep {!/\sdefault\s/i} split ',', $fct_detail{args}); 15302 push(@args_sorted, grep {/\sdefault\s/i} split ',', $fct_detail{args}); 15303 my @orig_args = split(',', $fct_detail{args}); 15304 15305 # Show a warning when there is parameters reordering 15306 my $fct_warning = ''; 15307 for (my $i = 0; $i <= $#args_sorted; $i++) 15308 { 15309 if ($args_sorted[$i] ne $orig_args[$i]) 15310 { 15311 my $str = $fct_detail{args}; 15312 $str =~ s/\%ORA2PG_COMMENT\d+\%//sg; 15313 $str =~ s/[\n\r]+//gs; 15314 $str =~ s/\s+/ /g; 15315 $self->_restore_text_constant_part(\$str); 15316 $fct_warning = "\n-- WARNING: parameters order has been changed by Ora2Pg to move parameters with default values at end\n"; 15317 $fct_warning .= "-- Original order was: $fname($str)\n"; 15318 $fct_warning .= "-- You will need to manually reorder parameters in the function calls\n"; 15319 print STDERR $fct_warning; 15320 last; 15321 } 15322 } 15323 } 15324 15325 # Apply parameter list with translation for default values and reordering if needed 15326 for (my $i = 0; $i <= $#args_sorted; $i++) 15327 { 15328 if ($args_sorted[$i] =~ / DEFAULT ([^'].*)/i) 15329 { 15330 my $cod = Ora2Pg::PLSQL::convert_plsql_code($self, $1); 15331 $args_sorted[$i] =~ s/( DEFAULT )([^'].*)/$1$cod/i; 15332 } 15333 } 15334 $fct_detail{args} = '(' . join(',', @args_sorted) . ')'; 15335 $fct_detail{args} =~ s/\%\%tmp(\d+)\%\%/($param_param{$1})/gs; 15336 15337 # Set the return part 15338 my $func_return = ''; 15339 $fct_detail{setof} = ' SETOF' if ($fct_detail{setof}); 15340 15341 my $search_path = ''; 15342 if ($self->{export_schema} && !$self->{schema}) { 15343 $search_path = $self->set_search_path($owner); 15344 } 15345 15346 # PostgreSQL procedure do not support OUT parameter, translate them into INOUT params 15347 if (!$fct_detail{hasreturn} && $self->{pg_supports_procedure} && ($fct_detail{args} =~ /\bOUT\s+[^,\)]+/i)) { 15348 $fct_detail{args} =~ s/\bOUT(\s+[^,\)]+)/INOUT$1/igs; 15349 } 15350 15351 my @nout = $fct_detail{args} =~ /\bOUT\s+([^,\)]+)/igs; 15352 my @ninout = $fct_detail{args} =~ /\bINOUT\s+([^,\)]+)/igs; 15353 if ($fct_detail{hasreturn}) 15354 { 15355 my $nbout = $#nout+1 + $#ninout+1; 15356 # When there is one or more out parameter, let PostgreSQL 15357 # choose the right type with not using a RETURNS clause. 15358 if ($nbout > 0) { 15359 $func_return = " AS \$body\$\n"; 15360 } else { 15361 # Returns the right type 15362 $func_return = " RETURNS$fct_detail{setof} $fct_detail{func_ret_type} AS \$body\$\n"; 15363 } 15364 } 15365 elsif (!$self->{pg_supports_procedure}) 15366 { 15367 # Return void when there's no out parameters 15368 if (($#nout < 0) && ($#ninout < 0)) { 15369 $func_return = " RETURNS VOID AS \$body\$\n"; 15370 } else { 15371 # When there is one or more out parameter, let PostgreSQL 15372 # choose the right type with not using a RETURNS clause. 15373 $func_return = " AS \$body\$\n"; 15374 } 15375 } 15376 else 15377 { 15378 $func_return = " AS \$body\$\n"; 15379 } 15380 15381 # extract custom type declared in a stored procedure 15382 my $create_type = ''; 15383 while ($fct_detail{declare} =~ s/\s+TYPE\s+([^\s]+)\s+IS\s+RECORD\s*\(([^;]+)\)\s*;//is) 15384 { 15385 $create_type .= "DROP TYPE IF EXISTS $1;\n" if ($self->{drop_if_exists}); 15386 $create_type .= "CREATE TYPE $1 AS ($2);\n"; 15387 } 15388 15389 my @at_ret_param = (); 15390 my @at_ret_type = (); 15391 my $at_suffix = ''; 15392 my $at_inout = 0; 15393 if ($fct_detail{declare} =~ s/\s*(PRAGMA\s+AUTONOMOUS_TRANSACTION[\s;]*)/-- $1/is && $self->{autonomous_transaction}) 15394 { 15395 $at_suffix = '_atx'; 15396 # COMMIT is not allowed in PLPGSQL function 15397 $fct_detail{code} =~ s/\bCOMMIT\s*;//; 15398 # Remove the pragma when a conversion is done 15399 $fct_detail{declare} =~ s/--\s+PRAGMA\s+AUTONOMOUS_TRANSACTION[\s;]*//is; 15400 my @tmp = split(',', $fct_detail{args}); 15401 $tmp[0] =~ s/^\(//; 15402 $tmp[-1] =~ s/\)$//; 15403 foreach my $p (@tmp) 15404 { 15405 if ($p =~ s/\bOUT\s+//) 15406 { 15407 $at_inout++; 15408 push(@at_ret_param, $p); 15409 push(@at_ret_type, $p); 15410 } 15411 elsif ($p =~ s/\bINOUT\s+//) 15412 { 15413 $at_inout++; 15414 push(@at_ret_param, $p); 15415 push(@at_ret_type, $p); 15416 } 15417 } 15418 map { s/^(.*?) //; } @at_ret_type; 15419 if ($fct_detail{hasreturn} && $#at_ret_param < 0) 15420 { 15421 push(@at_ret_param, 'ret ' . $fct_detail{func_ret_type}); 15422 push(@at_ret_type, $fct_detail{func_ret_type}); 15423 } 15424 map { s/^\s+//; } @at_ret_param; 15425 map { s/\s+$//; } @at_ret_param; 15426 map { s/^\s+//; } @at_ret_type; 15427 map { s/\s+$//; } @at_ret_type; 15428 } 15429 15430 my $name = $fname; 15431 my $type = $fct_detail{type}; 15432 $type = 'FUNCTION' if (!$self->{pg_supports_procedure}); 15433 15434 my $function = "\n$create_type\n\n${fct_warning}CREATE$self->{create_or_replace} $type $fname$at_suffix $fct_detail{args}"; 15435 if (!$pname || !$self->{package_as_schema}) 15436 { 15437 if ($self->{export_schema} && !$self->{schema}) 15438 { 15439 $function = "\n${fct_warning}CREATE$self->{create_or_replace} $type " . $self->quote_object_name("$owner.$fname") . " $fct_detail{args}"; 15440 $name = $self->quote_object_name("$owner.$fname"); 15441 $self->logit("Parsing function " . $self->quote_object_name("$owner.$fname") . "...\n", 1); 15442 } 15443 elsif ($self->{export_schema} && $self->{schema}) 15444 { 15445 $function = "\n${fct_warning}CREATE$self->{create_or_replace} $type " . $self->quote_object_name("$self->{schema}.$fname") . " $fct_detail{args}"; 15446 $name = $self->quote_object_name("$self->{schema}.$fname"); 15447 $self->logit("Parsing function " . $self->quote_object_name("$self->{schema}.$fname") . "...\n", 1); 15448 } 15449 } 15450 else 15451 { 15452 $self->logit("Parsing function $fname...\n", 1); 15453 } 15454 15455 # Create a wrapper for the function if we found an autonomous transaction 15456 my $at_wrapper = ''; 15457 if ($at_suffix && !$self->{pg_background}) 15458 { 15459 $at_wrapper = qq{ 15460$search_path 15461-- 15462-- dblink wrapper to call function $name as an autonomous transaction 15463-- 15464CREATE EXTENSION IF NOT EXISTS dblink; 15465 15466}; 15467 $at_wrapper .= "CREATE$self->{create_or_replace} $type $name $fct_detail{args}$func_return"; 15468 my $params = ''; 15469 if ($#{$fct_detail{at_args}} >= 0) 15470 { 15471 map { s/(.+)/quote_nullable($1)/; } @{$fct_detail{at_args}}; 15472 $params = " ' || " . join(" || ',' || ", @{$fct_detail{at_args}}) . " || ' "; 15473 } 15474 my $dblink_conn = $self->{dblink_conn} || "'port=5432 dbname=testdb host=localhost user=pguser password=pgpass'"; 15475 $at_wrapper .= qq{DECLARE 15476 -- Change this to reflect the dblink connection string 15477 v_conn_str text := $dblink_conn; 15478 v_query text; 15479}; 15480 if ($#at_ret_param == 0) 15481 { 15482 my $varname = $at_ret_param[0]; 15483 $varname =~ s/\s+.*//; 15484 my $vartype = $at_ret_type[0]; 15485 $vartype =~ s/.*\s+//; 15486 if (!$fct_detail{hasreturn}) 15487 { 15488 $at_wrapper .= qq{ 15489BEGIN 15490 v_query := 'SELECT * FROM $fname$at_suffix ($params)'; 15491 SELECT v_ret INTO $varname FROM dblink(v_conn_str, v_query) AS p (v_ret $vartype); 15492}; 15493 } 15494 else 15495 { 15496 $at_ret_type[0] = $fct_detail{func_ret_type}; 15497 $at_ret_param[0] = 'ret ' . $fct_detail{func_ret_type}; 15498 $at_wrapper .= qq{ 15499 v_ret $at_ret_type[0]; 15500BEGIN 15501 v_query := 'SELECT * FROM $fname$at_suffix ($params)'; 15502 SELECT * INTO v_ret FROM dblink(v_conn_str, v_query) AS p ($at_ret_param[0]); 15503 RETURN v_ret; 15504}; 15505 } 15506 } 15507 elsif ($#at_ret_param > 0) 15508 { 15509 my $varnames = ''; 15510 my $vartypes = ''; 15511 for (my $i = 0; $i <= $#at_ret_param; $i++) 15512 { 15513 my $v = $at_ret_param[$i]; 15514 $v =~ s/\s+.*//; 15515 $varnames .= "$v, "; 15516 $vartypes .= "v_ret$i "; 15517 my $t = $at_ret_type[$i]; 15518 $t =~ s/.*\s+//; 15519 $vartypes .= "$t, "; 15520 } 15521 $varnames =~ s/, $//; 15522 $vartypes =~ s/, $//; 15523 if (!$fct_detail{hasreturn}) 15524 { 15525 $at_wrapper .= qq{ 15526BEGIN 15527 v_query := 'SELECT * FROM $fname$at_suffix ($params)'; 15528 SELECT * FROM dblink(v_conn_str, v_query) AS p ($vartypes) INTO $varnames; 15529}; 15530 } 15531 else 15532 { 15533 $at_ret_type[0] = $fct_detail{func_ret_type}; 15534 $at_ret_param[0] = 'ret ' . $fct_detail{func_ret_type}; 15535 $at_wrapper .= qq{ 15536 v_ret $at_ret_type[0]; 15537BEGIN 15538 v_query := 'SELECT * FROM $fname$at_suffix ($params)'; 15539 SELECT * INTO v_ret FROM dblink(v_conn_str, v_query) AS p ($at_ret_param[0]); 15540 RETURN v_ret; 15541}; 15542 } 15543 } 15544 elsif (!$fct_detail{hasreturn}) 15545 { 15546 $at_wrapper .= qq{ 15547BEGIN 15548 v_query := 'SELECT true FROM $fname$at_suffix ($params)'; 15549 PERFORM * FROM dblink(v_conn_str, v_query) AS p (ret boolean); 15550}; 15551 } 15552 else 15553 { 15554 print STDERR "WARNING: we should not be there, please send the Oracle code of the $self->{type} to the author for debuging.\n"; 15555 } 15556 $at_wrapper .= qq{ 15557END; 15558\$body\$ LANGUAGE plpgsql SECURITY DEFINER; 15559}; 15560 15561 } 15562 elsif ($at_suffix && $self->{pg_background}) 15563 { 15564 $at_wrapper = qq{ 15565$search_path 15566-- 15567-- pg_background wrapper to call function $name as an autonomous transaction 15568-- 15569CREATE EXTENSION IF NOT EXISTS pg_background; 15570 15571}; 15572 $at_wrapper .= "CREATE$self->{create_or_replace} $type $name $fct_detail{args}$func_return"; 15573 my $params = ''; 15574 if ($#{$fct_detail{at_args}} >= 0) 15575 { 15576 map { s/(.+)/quote_nullable($1)/; } @{$fct_detail{at_args}}; 15577 $params = " ' || " . join(" || ',' || ", @{$fct_detail{at_args}}) . " || ' "; 15578 } 15579 15580 $at_wrapper .= qq{ 15581DECLARE 15582 v_query text; 15583}; 15584 if (!$fct_detail{hasreturn}) 15585 { 15586 $at_wrapper .= qq{ 15587BEGIN 15588 v_query := 'SELECT true FROM $fname$at_suffix ($params)'; 15589 PERFORM * FROM pg_background_result(pg_background_launch(v_query)) AS p (ret boolean); 15590}; 15591 } 15592 elsif ($#at_ret_param == 0) 15593 { 15594 my $prm = join(',', @at_ret_param); 15595 $at_wrapper .= qq{ 15596 v_ret $at_ret_type[0]; 15597BEGIN 15598 v_query := 'SELECT * FROM $fname$at_suffix ($params)'; 15599 SELECT * INTO v_ret FROM pg_background_result(pg_background_launch(v_query)) AS p ($at_ret_param[0]); 15600 RETURN v_ret; 15601}; 15602 } 15603 $at_wrapper .= qq{ 15604END; 15605\$body\$ LANGUAGE plpgsql SECURITY DEFINER; 15606}; 15607 15608 15609 } 15610 15611 # Add the return part of the function declaration 15612 $function .= $func_return; 15613 if ($fct_detail{immutable}) { 15614 $fct_detail{immutable} = ' IMMUTABLE'; 15615 } elsif ($plsql =~ /^FUNCTION/i) 15616 { 15617 # Oracle function can't modify data so always mark them as stable 15618 if ($self->{function_stable}) { 15619 $fct_detail{immutable} = ' STABLE'; 15620 } 15621 } 15622 if ($language && ($language !~ /SQL/i)) { 15623 $function .= "AS '$fct_detail{library}', '$fct_detail{library_fct}'\nLANGUAGE $language$fct_detail{immutable};\n"; 15624 $function =~ s/AS \$body\$//; 15625 } 15626 15627 my $revoke = ''; 15628 if ($fct_detail{code}) 15629 { 15630 $fct_detail{declare} = '' if ($fct_detail{declare} !~ /[a-z]/is); 15631 $fct_detail{declare} =~ s/^\s*DECLARE//i; 15632 $fct_detail{declare} .= ';' if ($fct_detail{declare} && $fct_detail{declare} !~ /;\s*$/s && $fct_detail{declare} !~ /\%ORA2PG_COMMENT\d+\%\s*$/s); 15633 my $code_part = ''; 15634 $code_part .= "DECLARE\n$fct_detail{declare}\n" if ($fct_detail{declare}); 15635 $fct_detail{code} =~ s/^BEGIN\b//is; 15636 $code_part .= "BEGIN" . $fct_detail{code}; 15637 # Replace PL/SQL code into PL/PGSQL similar code 15638 $function .= Ora2Pg::PLSQL::convert_plsql_code($self, $code_part); 15639 $function .= ';' if ($function !~ /END\s*;\s*$/is && $fct_detail{code} !~ /\%ORA2PG_COMMENT\d+\%\s*$/); 15640 $function .= "\n\$body\$\nLANGUAGE PLPGSQL\n"; 15641 15642 # Remove parameters to RETURN call when the function has no RETURNS 15643 # clause which is the case when there is OUT parameters. 15644 if ($function !~ /\s+RETURNS\s+/s || ($function =~ /\s+RETURNS VOID\s+/s || ($type eq 'PROCEDURE' && $self->{pg_supports_procedures}))) { 15645 $self->_remove_text_constant_part(\$function); 15646 $function =~ s/(RETURN)\s*[^;]+;/$1;/igs; 15647 $self->_restore_text_constant_part(\$function); 15648 } 15649 $revoke = "-- REVOKE ALL ON $type $name $fct_detail{args} FROM PUBLIC;"; 15650 $revoke =~ s/[\n\r]+\s*/ /gs; 15651 $revoke .= "\n"; 15652 if ($self->{force_security_invoker}) { 15653 $function .= "SECURITY INVOKER\n"; 15654 } 15655 else 15656 { 15657 if ($self->{type} ne 'PACKAGE') 15658 { 15659 if (!$self->{is_mysql}) { 15660 $function .= "SECURITY DEFINER\n" if ($self->{security}{"\U$fct_detail{name}\E"}{security} eq 'DEFINER'); 15661 } else { 15662 $function .= "SECURITY DEFINER\n" if ($fct_detail{security} eq 'DEFINER'); 15663 } 15664 } 15665 else 15666 { 15667 $function .= "SECURITY DEFINER\n" if ($self->{security}{"\U$pname\E"}{security} eq 'DEFINER'); 15668 } 15669 } 15670 $fct_detail{immutable} = '' if ($fct_detail{code} =~ /\b(UPDATE|INSERT|DELETE)\b/is); 15671 $function .= "$fct_detail{immutable};\n"; 15672 $function = "\n$fct_detail{before}$function"; 15673 } 15674 15675 if ($self->{force_owner}) { 15676 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 15677 if ($owner) { 15678 $function .= "ALTER $type $fname $fct_detail{args} OWNER TO"; 15679 $function .= " " . $self->quote_object_name($owner) . ";\n"; 15680 } 15681 } 15682 $function .= "\nCOMMENT ON FUNCTION $fname$at_suffix $fct_detail{args} IS $fct_detail{comment};\n" if ($fct_detail{comment}); 15683 $function .= $revoke; 15684 $function = $at_wrapper . $function; 15685 15686 $fname =~ s/"//g; # Remove case sensitivity quoting 15687 $fname =~ s/^$pname\.//i; # remove package name 15688 if ($pname && $self->{file_per_function}) { 15689 $self->logit("\tDumping to one file per function: $dirprefix\L$pname/$fname\E_$self->{output}\n", 1); 15690 my $sql_header = "-- Generated by Ora2Pg, the Oracle database Schema converter, version $VERSION\n"; 15691 $sql_header .= "-- Copyright 2000-2021 Gilles DAROLD. All rights reserved.\n"; 15692 $sql_header .= "-- DATASOURCE: $self->{oracle_dsn}\n\n"; 15693 if ($self->{client_encoding}) { 15694 $sql_header .= "SET client_encoding TO '\U$self->{client_encoding}\E';\n"; 15695 } 15696 $sql_header .= $self->set_search_path(); 15697 $sql_header .= "SET check_function_bodies = false;\n\n" if (!$self->{function_check}); 15698 $sql_header = '' if ($self->{no_header}); 15699 15700 my $fhdl = $self->open_export_file("$dirprefix\L$pname/$fname\E_$self->{output}", 1); 15701 $self->set_binmode($fhdl) if (!$self->{compress}); 15702 $self->_restore_comments(\$function); 15703 $self->normalize_function_call(\$function); 15704 $function =~ s/(-- REVOKE ALL ON (?:FUNCTION|PROCEDURE) [^;]+ FROM PUBLIC;)/&remove_newline($1)/sge; 15705 $self->dump($sql_header . $function, $fhdl); 15706 $self->close_export_file($fhdl); 15707 my $f = "$dirprefix\L$pname/$fname\E_$self->{output}"; 15708 $f =~ s/\.(?:gz|bz2)$//i; 15709 $function = "\\i$self->{psql_relative_path} $f\n"; 15710 $self->save_filetoupdate_list(lc($pname), lc($fname), "$dirprefix\L$pname/$fname\E_$self->{output}"); 15711 return $function; 15712 } elsif ($pname) { 15713 $self->save_filetoupdate_list(lc($pname), lc($fname), "$dirprefix$self->{output}"); 15714 } 15715 15716 $function =~ s/\r//gs; 15717 my @lines = split(/\n/, $function); 15718 map { s/^\/$//; } @lines; 15719 15720 return join("\n", @lines); 15721} 15722 15723=head2 _convert_declare 15724 15725This function is used to rewrite Oracle FUNCTION declaration code 15726to PostgreSQL. Called only if PLSQL_PGSQL configuration directive 15727is set to 1. 15728 15729=cut 15730 15731sub _convert_declare 15732{ 15733 my ($self, $declare) = @_; 15734 15735 $declare =~ s/\s+$//s; 15736 15737 return if (!$declare); 15738 15739 my @allwithcomments = split(/(\%ORA2PG_COMMENT\d+\%\n*)/s, $declare); 15740 for (my $i = 0; $i <= $#allwithcomments; $i++) { 15741 next if ($allwithcomments[$i] =~ /ORA2PG_COMMENT/); 15742 my @pg_declare = (); 15743 foreach my $tmp_var (split(/;/,$allwithcomments[$i])) { 15744 # Not cursor declaration 15745 if ($tmp_var !~ /\bcursor\b/is) { 15746 # Extract default assignment 15747 my $tmp_assign = ''; 15748 if ($tmp_var =~ s/\s*(:=|DEFAULT)(.*)$//is) { 15749 $tmp_assign = " $1$2"; 15750 } 15751 # Extract variable name and type 15752 my $tmp_pref = ''; 15753 my $tmp_name = ''; 15754 my $tmp_type = ''; 15755 if ($tmp_var =~ /(\s*)([^\s]+)\s+(.*?)$/s) { 15756 $tmp_pref = $1; 15757 $tmp_name = $2; 15758 $tmp_type = $3; 15759 $tmp_type =~ s/\s+//gs; 15760 if ($tmp_type =~ /([^\(]+)\(([^\)]+)\)/) { 15761 my $type_name = $1; 15762 my ($prec, $scale) = split(/,/, $2); 15763 $scale ||= 0; 15764 my $len = $prec; 15765 $prec = 0 if (!$scale); 15766 $len =~ s/\D//g; 15767 $tmp_type = $self->_sql_type($type_name,$len,$prec,$scale,$tmp_assign); 15768 } else { 15769 $tmp_type = $self->_sql_type($tmp_type); 15770 } 15771 push(@pg_declare, "$tmp_pref$tmp_name $tmp_type$tmp_assign;"); 15772 } 15773 } else { 15774 push(@pg_declare, "$tmp_var;"); 15775 } 15776 } 15777 $allwithcomments[$i] = join("", @pg_declare); 15778 } 15779 15780 return join("", @allwithcomments); 15781} 15782 15783 15784=head2 _format_view 15785 15786This function is used to rewrite Oracle VIEW declaration code 15787to PostgreSQL. 15788 15789=cut 15790 15791sub _format_view 15792{ 15793 my ($self, $view, $sqlstr) = @_; 15794 15795 $self->_remove_comments(\$sqlstr); 15796 15797 # Retrieve the column part of the view to remove double quotes 15798 if (!$self->{preserve_case} && $sqlstr =~ s/^(.*?)\bFROM\b/FROM/is) { 15799 my $tmp = $1; 15800 $tmp =~ s/"//gs; 15801 $sqlstr = $tmp . $sqlstr; 15802 } 15803 15804 my @tbs = (); 15805 # Retrieve all tbs names used in view if possible 15806 if ($sqlstr =~ /\bFROM\b(.*)/is) { 15807 my $tmp = $1; 15808 $tmp =~ s/\%ORA2PG_COMMENT\d+\%//gs; 15809 $tmp =~ s/\s+/ /gs; 15810 $tmp =~ s/\bWHERE.*//is; 15811 # Remove all SQL reserved words of FROM STATEMENT 15812 $tmp =~ s/(LEFT|RIGHT|INNER|OUTER|NATURAL|CROSS|JOIN|\(|\))//igs; 15813 # Remove all ON join, if any 15814 $tmp =~ s/\bON\b[A-Z_\.\s]*=[A-Z_\.\s]*//igs; 15815 # Sub , with whitespace 15816 $tmp =~ s/,/ /g; 15817 my @tmp_tbs = split(/\s+/, $tmp); 15818 foreach my $p (@tmp_tbs) { 15819 push(@tbs, $p) if ($p =~ /^[A-Z_0-9\$]+$/i); 15820 } 15821 } 15822 foreach my $tb (@tbs) { 15823 next if (!$tb); 15824 my $regextb = $tb; 15825 $regextb =~ s/\$/\\\$/g; 15826 if (!$self->{preserve_case}) { 15827 # Escape column name 15828 $sqlstr =~ s/["']*\b$regextb\b["']*\.["']*([A-Z_0-9\$]+)["']*(,?)/$tb.$1$2/igs; 15829 # Escape table name 15830 $sqlstr =~ s/(^=\s?)["']*\b$regextb\b["']*/$tb/igs; 15831 } else { 15832 # Escape column name 15833 $sqlstr =~ s/["']*\b${regextb}["']*\.["']*([A-Z_0-9\$]+)["']*(,?)/"$tb"."$1"$2/igs; 15834 # Escape table name 15835 $sqlstr =~ s/(^=\s?)["']*\b$regextb\b["']*/"$tb"/igs; 15836 if ($tb =~ /(.*)\.(.*)/) { 15837 my $prefx = $1; 15838 my $sufx = $2; 15839 $sqlstr =~ s/"$regextb"/"$prefx"\."$sufx/g; 15840 } 15841 } 15842 } 15843 15844 # replace column name in view query definition if needed 15845 foreach my $c (sort { $b cmp $a } keys %{ $self->{replaced_cols}{"\L$view\E"} }) 15846 { 15847 my $nm = $self->{replaced_cols}{"\L$view\E"}{$c}; 15848 $sqlstr =~ s/([\(,\s\."])$c([,\s\.:"\)])/$1$nm$2/ig; 15849 } 15850 15851 if ($self->{plsql_pgsql}) { 15852 $sqlstr = Ora2Pg::PLSQL::convert_plsql_code($self, $sqlstr); 15853 } 15854 15855 $self->_restore_comments(\$sqlstr); 15856 15857 return $sqlstr; 15858} 15859 15860=head2 randpattern 15861 15862This function is used to replace the use of perl module String::Random 15863and is simply a cut & paste from this module. 15864 15865=cut 15866 15867sub randpattern 15868{ 15869 my $patt = shift; 15870 15871 my $string = ''; 15872 15873 my @upper=("A".."Z"); 15874 my @lower=("a".."z"); 15875 my @digit=("0".."9"); 15876 my %patterns = ( 15877 'C' => [ @upper ], 15878 'c' => [ @lower ], 15879 'n' => [ @digit ], 15880 ); 15881 for my $ch (split(//, $patt)) { 15882 if (exists $patterns{$ch}) { 15883 $string .= $patterns{$ch}->[int(rand(scalar(@{$patterns{$ch}})))]; 15884 } else { 15885 $string .= $ch; 15886 } 15887 } 15888 15889 return $string; 15890} 15891 15892=head2 logit 15893 15894This function log information to STDOUT or to a logfile 15895following a debug level. If critical is set, it dies after 15896writing to log. 15897 15898=cut 15899 15900sub logit 15901{ 15902 my ($self, $message, $level, $critical) = @_; 15903 15904 # Assessment report are dumped to stdin so avoid printing debug info 15905 return if (!$critical && $self->{type} eq 'SHOW_REPORT'); 15906 15907 $level ||= 0; 15908 15909 $message = '[' . strftime("%Y-%m-%d %H:%M:%S", localtime(time)) . '] ' . $message if ($self->{debug}); 15910 if ($self->{debug} >= $level) { 15911 if (defined $self->{fhlog}) { 15912 $self->{fhlog}->print($message); 15913 } else { 15914 print $message; 15915 } 15916 } 15917 if ($critical) 15918 { 15919 if ($self->{debug} < $level) 15920 { 15921 if (defined $self->{fhlog}) { 15922 $self->{fhlog}->print($message); 15923 } else { 15924 print "$message\n"; 15925 } 15926 } 15927 $self->{fhlog}->close() if (defined $self->{fhlog}); 15928 $self->{dbh}->disconnect() if ($self->{dbh}); 15929 $self->{dbhdest}->disconnect() if ($self->{dbhdest}); 15930 die "Aborting export...\n"; 15931 } 15932} 15933 15934=head2 logrep 15935 15936This function log report's information to STDOUT or to a logfile. 15937 15938=cut 15939 15940sub logrep 15941{ 15942 my ($self, $message) = @_; 15943 15944 if (defined $self->{fhlog}) { 15945 $self->{fhlog}->print($message); 15946 } else { 15947 print $message; 15948 } 15949} 15950 15951 15952=head2 _convert_type 15953 15954This function is used to rewrite Oracle TYPE DDL 15955 15956=cut 15957 15958sub _convert_type 15959{ 15960 my ($self, $plsql, $owner, %pkg_type) = @_; 15961 15962 my $unsupported = "-- Unsupported, please edit to match PostgreSQL syntax\n"; 15963 my $content = ''; 15964 my $type_name = ''; 15965 15966 # Replace SUBTYPE declaration into DOMAIN declaration 15967 if ($plsql =~ s/SUBTYPE\s+/CREATE DOMAIN /i) { 15968 $plsql =~ s/\s+IS\s+/ AS /; 15969 $plsql = Ora2Pg::PLSQL::replace_sql_type($plsql, $self->{pg_numeric_type}, $self->{default_numeric}, $self->{pg_integer_type}, %{$self->{data_type}}); 15970 return $plsql; 15971 } 15972 15973 $plsql =~ s/\s*INDEX\s+BY\s+([^\s;]+)//is; 15974 if ($plsql =~ /TYPE\s+([^\s]+)\s+(IS|AS)\s*TABLE\s*OF\s+(.*)/is) { 15975 $type_name = $1; 15976 my $type_of = $3; 15977 $type_name =~ s/"//g; 15978 my $internal_name = $type_name; 15979 if ($self->{export_schema} && !$self->{schema} && $owner) { 15980 $type_name = "$owner.$type_name"; 15981 } 15982 $internal_name =~ s/^[^\.]+\.//; 15983 $type_of =~ s/\s*NOT[\t\s]+NULL//is; 15984 $type_of =~ s/\s*;\s*$//s; 15985 $type_of =~ s/^\s+//s; 15986 if ($type_of !~ /\s/s) { 15987 $type_of = Ora2Pg::PLSQL::replace_sql_type($type_of, $self->{pg_numeric_type}, $self->{default_numeric}, $self->{pg_integer_type}, %{$self->{data_type}}); 15988 $self->{type_of_type}{'Nested Tables'}++; 15989 $content .= "DROP TYPE IF EXISTS \L$type_name\E;\n" if ($self->{drop_if_exists}); 15990 $content = "CREATE TYPE \L$type_name\E AS (\L$internal_name\E $type_of\[\]);\n"; 15991 } else { 15992 $self->{type_of_type}{'Associative Arrays'}++; 15993 $self->logit("WARNING: this kind of Nested Tables are not supported, skipping type $1\n", 1); 15994 return "${unsupported}CREATE$self->{create_or_replace} $plsql"; 15995 } 15996 } elsif ($plsql =~ /TYPE\s+([^\s]+)\s+(AS|IS)\s*REF\s+CURSOR/is) { 15997 $self->logit("WARNING: TYPE REF CURSOR are not supported, skipping type $1\n", 1); 15998 $plsql =~ s/\bREF\s+CURSOR/REFCURSOR/is; 15999 $self->{type_of_type}{'Type Ref Cursor'}++; 16000 return "${unsupported}CREATE$self->{create_or_replace} $plsql"; 16001 } elsif ($plsql =~ /TYPE\s+([^\s]+)\s+(AS|IS)\s*OBJECT\s*\((.*?)(TYPE BODY.*)/is) { 16002 $self->{type_of_type}{'Type Boby'}++; 16003 $self->logit("WARNING: TYPE BODY are not supported, skipping type $1\n", 1); 16004 return "${unsupported}CREATE$self->{create_or_replace} $plsql"; 16005 } elsif ($plsql =~ /TYPE\s+([^\s]+)\s+(AS|IS)\s*(?:OBJECT|RECORD)\s*\((.*)\)([^\)]*)/is) { 16006 $type_name = $1; 16007 my $description = $3; 16008 my $notfinal = $4; 16009 $notfinal =~ s/\s+/ /gs; 16010 if ($self->{export_schema} && !$self->{schema} && $owner) { 16011 $type_name = "$owner.$type_name"; 16012 } 16013 if ($description =~ /\s*(MAP MEMBER|MEMBER|CONSTRUCTOR)\s+(FUNCTION|PROCEDURE).*/is) { 16014 $self->{type_of_type}{'Type with member method'}++; 16015 $self->logit("WARNING: TYPE with CONSTRUCTOR and MEMBER FUNCTION are not supported, skipping type $type_name\n", 1); 16016 return "${unsupported}CREATE$self->{create_or_replace} $plsql"; 16017 } 16018 $description =~ s/^\s+//s; 16019 my $declar = Ora2Pg::PLSQL::replace_sql_type($description, $self->{pg_numeric_type}, $self->{default_numeric}, $self->{pg_integer_type}, %{$self->{data_type}}); 16020 $type_name =~ s/"//g; 16021 $type_name = $self->get_replaced_tbname($type_name); 16022 if ($notfinal =~ /FINAL/is) { 16023 $content = "-- Inherited types are not supported in PostgreSQL, replacing with inherited table\n"; 16024 $content .= qq{CREATE TABLE $type_name ( 16025$declar 16026); 16027}; 16028 $self->{type_of_type}{'Type inherited'}++; 16029 } else { 16030 $content = qq{ 16031CREATE TYPE $type_name AS ( 16032$declar 16033); 16034}; 16035 $self->{type_of_type}{'Object type'}++; 16036 } 16037 } elsif ($plsql =~ /TYPE\s+([^\s]+)\s+UNDER\s*([^\s]+)\s+\((.*)\)([^\)]*)/is) { 16038 $type_name = $1; 16039 my $type_inherit = $2; 16040 my $description = $3; 16041 if ($self->{export_schema} && !$self->{schema} && $owner) { 16042 $type_name = "$owner.$type_name"; 16043 } 16044 if ($description =~ /\s*(MAP MEMBER|MEMBER|CONSTRUCTOR)\s+(FUNCTION|PROCEDURE).*/is) { 16045 $self->logit("WARNING: TYPE with CONSTRUCTOR and MEMBER FUNCTION are not supported, skipping type $type_name\n", 1); 16046 $self->{type_of_type}{'Type with member method'}++; 16047 return "${unsupported}CREATE$self->{create_or_replace} $plsql"; 16048 } 16049 $description =~ s/^\s+//s; 16050 my $declar = Ora2Pg::PLSQL::replace_sql_type($description, $self->{pg_numeric_type}, $self->{default_numeric}, $self->{pg_integer_type}, %{$self->{data_type}}); 16051 $type_name =~ s/"//g; 16052 $type_name = $self->get_replaced_tbname($type_name); 16053 $content = qq{ 16054CREATE TABLE $type_name ( 16055$declar 16056) INHERITS (\L$type_inherit\E); 16057}; 16058 $self->{type_of_type}{'Subtype'}++; 16059 } elsif ($plsql =~ /TYPE\s+([^\s]+)\s+(AS|IS)\s*(VARRAY|VARYING ARRAY)\s*\((\d+)\)\s*OF\s*(.*)/is) { 16060 $type_name = $1; 16061 my $size = $4; 16062 my $tbname = $5; 16063 $type_name =~ s/"//g; 16064 $tbname =~ s/;//g; 16065 my $internal_name = $type_name; 16066 chomp($tbname); 16067 if ($self->{export_schema} && !$self->{schema} && $owner) { 16068 $type_name = "$owner.$type_name"; 16069 } 16070 $internal_name =~ s/^[^\.]+\.//; 16071 my $declar = Ora2Pg::PLSQL::replace_sql_type($tbname, $self->{pg_numeric_type}, $self->{default_numeric}, $self->{pg_integer_type}, %{$self->{data_type}}); 16072 $declar =~ s/[\n\r]+//s; 16073 $content = qq{ 16074CREATE TYPE \L$type_name\E AS ($internal_name $declar\[$size\]); 16075}; 16076 $self->{type_of_type}{Varrays}++; 16077 } else { 16078 $self->{type_of_type}{Unknown}++; 16079 $plsql =~ s/;$//s; 16080 $content = "${unsupported}CREATE$self->{create_or_replace} $plsql;" 16081 } 16082 16083 if ($self->{force_owner}) { 16084 $owner = $self->{force_owner} if ($self->{force_owner} ne "1"); 16085 if ($owner) { 16086 $content .= "ALTER TYPE " . $self->quote_object_name($type_name) 16087 . " OWNER TO " . $self->quote_object_name($owner) . ";\n"; 16088 } 16089 } 16090 16091 # Prefix type with their own package name 16092 foreach my $t (keys %pkg_type) { 16093 $content =~ s/(\s+)($t)\b/$1$pkg_type{$2}/igs; 16094 } 16095 16096 return $content; 16097} 16098 16099sub ask_for_data 16100{ 16101 my ($self, $table, $cmd_head, $cmd_foot, $s_out, $nn, $tt, $sprep, $stt, $part_name, $is_subpart) = @_; 16102 16103 # Build SQL query to retrieve data from this table 16104 if (!$part_name) { 16105 $self->logit("Looking how to retrieve data from $table...\n", 1); 16106 } elsif ($is_subpart) { 16107 $self->logit("Looking how to retrieve data from $table subpartition $part_name...\n", 1); 16108 } else { 16109 $self->logit("Looking how to retrieve data from $table partition $part_name...\n", 1); 16110 } 16111 my $query = $self->_howto_get_data($table, $nn, $tt, $stt, $part_name, $is_subpart); 16112 16113 # Query with no column 16114 if (!$query) { 16115 $self->logit("WARNING: can not extract data from $table, no column found...\n", 0); 16116 return 0; 16117 } 16118 16119 # Check for boolean rewritting 16120 for (my $i = 0; $i <= $#{$nn}; $i++) 16121 { 16122 my $colname = $nn->[$i]->[0]; 16123 $colname =~ s/["`]//g; 16124 my $typlen = $nn->[$i]->[5]; 16125 $typlen ||= $nn->[$i]->[2]; 16126 # Check if this column should be replaced by a boolean following table/column name 16127 if (grep(/^$colname$/i, @{$self->{'replace_as_boolean'}{uc($table)}})) { 16128 $tt->[$i] = 'boolean'; 16129 # Check if this column should be replaced by a boolean following type/precision 16130 } elsif (exists $self->{'replace_as_boolean'}{uc($nn->[$i]->[1])} && ($self->{'replace_as_boolean'}{uc($nn->[$i]->[1])}[0] == $typlen)) { 16131 $tt->[$i] = 'boolean'; 16132 } 16133 } 16134 16135 # check if destination column type must be changed 16136 for (my $i = 0; $i <= $#{$nn}; $i++) 16137 { 16138 my $colname = $nn->[$i]->[0]; 16139 $colname =~ s/["`]//g; 16140 $tt->[$i] = $self->{'modify_type'}{"\L$table\E"}{"\L$colname\E"} if (exists $self->{'modify_type'}{"\L$table\E"}{"\L$colname\E"}); 16141 } 16142 16143 # Look for user defined type 16144 if (!$self->{is_mysql}) 16145 { 16146 for (my $idx = 0; $idx < scalar(@$stt); $idx++) 16147 { 16148 my $data_type = uc($stt->[$idx]) || ''; 16149 $data_type =~ s/\(.*//; # remove any precision 16150 # in case of user defined type try to gather the underlying base types 16151 if (!exists $self->{data_type}{$data_type} && !exists $self->{user_type}{$data_type} 16152 && $data_type !~ /SDO_GEOMETRY/i 16153 && $data_type !~ /^(ST_|STGEOM_)/i #ArGis geometry types 16154 ) { 16155 %{ $self->{user_type}{$data_type} } = $self->custom_type_definition($data_type); 16156 } 16157 } 16158 } 16159 16160 if ( ($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"} ) 16161 { 16162 $self->{ora_conn_count} = 0; 16163 while ($self->{ora_conn_count} < $self->{oracle_copies}) 16164 { 16165 spawn sub { 16166 $self->logit("Creating new connection to database to extract data...\n", 1); 16167 $self->_extract_data($query, $table, $cmd_head, $cmd_foot, $s_out, $nn, $tt, $sprep, $stt, $part_name, $self->{ora_conn_count}); 16168 }; 16169 $self->{ora_conn_count}++; 16170 } 16171 # Wait for oracle connection terminaison 16172 while ($self->{ora_conn_count} > 0) 16173 { 16174 my $kid = waitpid(-1, WNOHANG); 16175 if ($kid > 0) 16176 { 16177 $self->{ora_conn_count}--; 16178 delete $RUNNING_PIDS{$kid}; 16179 } 16180 usleep(50000); 16181 } 16182 if (defined $pipe) 16183 { 16184 my $t_name = $part_name || $table; 16185 my $t_time = time(); 16186 $pipe->print("TABLE EXPORT ENDED: $t_name, end: $t_time, report all parts\n"); 16187 } 16188 } 16189 else 16190 { 16191 my $total_record = $self->_extract_data($query, $table, $cmd_head, $cmd_foot, $s_out, $nn, $tt, $sprep, $stt, $part_name); 16192 # Only useful for single process 16193 return $total_record; 16194 } 16195 16196 return; 16197} 16198 16199sub custom_type_definition 16200{ 16201 my ($self, $custom_type, $parent, $is_nested) = @_; 16202 16203 my %user_type = (); 16204 my $orig = $custom_type; 16205 16206 my $data_type = uc($custom_type) || ''; 16207 $data_type =~ s/\(.*//; # remove any precision 16208 if (!exists $self->{data_type}{$data_type}) 16209 { 16210 if (!$is_nested) { 16211 $self->logit("Data type $custom_type is not native, searching on custom types.\n", 1); 16212 } else { 16213 $self->logit("\tData type $custom_type nested from type $parent is not native, searching on custom types.\n", 1); 16214 } 16215 $custom_type = $self->_get_types($custom_type); 16216 foreach my $tpe (sort {length($a->{name}) <=> length($b->{name}) } @{$custom_type}) 16217 { 16218 $self->logit("\tLooking inside custom type $tpe->{name} to extract values...\n", 1); 16219 my %types_def = $self->_get_custom_types($tpe->{code}); 16220 if ($#{$types_def{pg_types}} >= 0) 16221 { 16222 $self->logit("\tfound type description: $tpe->{name}(" . join(',', @{$types_def{pg_types}}) . ")\n", 1); 16223 push(@{$user_type{pg_types}} , \@{$types_def{pg_types}}); 16224 push(@{$user_type{src_types}}, \@{$types_def{src_types}}); 16225 } 16226 else 16227 { 16228 if ($tpe->{code} =~ /AS\s+VARRAY\s*(.*?)\s+OF\s+([^\s;]+);/is) { 16229 return $self->custom_type_definition(uc($2), $orig, 1); 16230 } 16231 elsif ($tpe->{code} =~ /\s+([^\s]+)\s+AS\s+TABLE\s+OF\s+([^;]+);/is) 16232 { 16233 %types_def = $self->_get_custom_types("varname $2"); 16234 push(@{$user_type{pg_types}} , \@{$types_def{pg_types}}); 16235 push(@{$user_type{src_types}}, \@{$types_def{src_types}}); 16236 } 16237 else { 16238 $self->logit("\tCan not found subtype for $tpe->{name} into code: $tpe->{code}\n", 1); 16239 } 16240 } 16241 } 16242 } 16243 16244 return %user_type; 16245} 16246 16247sub _extract_data 16248{ 16249 my ($self, $query, $table, $cmd_head, $cmd_foot, $s_out, $nn, $tt, $sprep, $stt, $part_name, $proc) = @_; 16250 16251 $0 = "ora2pg - querying table $table"; 16252 16253 # Overwrite the query if REPLACE_QUERY is defined for this table 16254 if ($self->{replace_query}{"\L$table\E"}) 16255 { 16256 $query = $self->{replace_query}{"\L$table\E"}; 16257 if (($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"}) 16258 { 16259 my $colpk = $self->{defined_pk}{"\L$table\E"}; 16260 if ($self->{preserve_case}) { 16261 $colpk = '"' . $colpk . '"'; 16262 } 16263 my $cond = " ABS(MOD($colpk, $self->{oracle_copies})) = ?"; 16264 if ($query !~ s/\bWHERE\s+/WHERE $cond AND /) 16265 { 16266 if ($query !~ s/\b(ORDER\s+BY\s+.*)/WHERE $cond $1/) { 16267 $query .= " WHERE $cond"; 16268 } 16269 } 16270 } 16271 } 16272 16273 my %user_type = (); 16274 my $rname = $part_name || $table; 16275 my $dbh = 0; 16276 my $sth = 0; 16277 my @has_custom_type = (); 16278 $self->{data_cols}{$table} = (); 16279 16280 if ($self->{is_mysql}) 16281 { 16282 my %col_info = Ora2Pg::MySQL::_column_info($self, $rname); 16283 foreach my $col (keys %{$col_info{$rname}}) { 16284 push(@{$self->{data_cols}{$table}}, $col); 16285 } 16286 } 16287 16288 # Look for user defined type 16289 if (!$self->{is_mysql}) 16290 { 16291 for (my $idx = 0; $idx < scalar(@$stt); $idx++) 16292 { 16293 my $data_type = uc($stt->[$idx]) || ''; 16294 $data_type =~ s/\(.*//; # remove any precision 16295 # in case of user defined type try to gather the underlying base types 16296 if (!exists $self->{data_type}{$data_type} && exists $self->{user_type}{$stt->[$idx]}) 16297 { 16298 push(@has_custom_type, $idx); 16299 %{ $user_type{$idx} } = %{ $self->{user_type}{$stt->[$idx]} }; 16300 } 16301 } 16302 } 16303 16304 if ( ($self->{parallel_tables} > 1) || (($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"}) ) 16305 { 16306 $self->logit("DEBUG: cloning Oracle database connection.\n", 1); 16307 $dbh = $self->{dbh}->clone(); 16308 16309 # Force execution of initial command 16310 $self->_ora_initial_command($dbh); 16311 if (!$self->{is_mysql}) 16312 { 16313 # Force numeric format into the cloned session 16314 $self->_numeric_format($dbh); 16315 # Force datetime format into the cloned session 16316 $self->_datetime_format($dbh); 16317 # Set the action name on Oracle side to see which table is exported 16318 $dbh->do("CALL DBMS_APPLICATION_INFO.set_action('$table')") or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 16319 } 16320 16321 # Set row cache size 16322 $dbh->{RowCacheSize} = int($self->{data_limit}/10); 16323 if (exists $self->{local_data_limit}{$table}) { 16324 $dbh->{RowCacheSize} = $self->{local_data_limit}{$table}; 16325 } 16326 16327 # prepare the query before execution 16328 if (!$self->{is_mysql}) 16329 { 16330 if ($self->{no_lob_locator}) { 16331 $sth = $dbh->prepare($query,{ora_piece_lob => 1, ora_piece_size => $self->{longreadlen}, ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY, ora_check_sql => 1}) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 16332 } else { 16333 $sth = $dbh->prepare($query,{'ora_auto_lob' => 0, ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY, ora_check_sql => 1}) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 16334 } 16335 foreach (@{$sth->{NAME}}) { 16336 push(@{$self->{data_cols}{$table}}, $_); 16337 } 16338 } 16339 else 16340 { 16341 #$query .= " LIMIT ?, ?"; 16342 $query =~ s/^SELECT\s+/SELECT \/\*\!40001 SQL_NO_CACHE \*\/ /s; 16343 $sth = $dbh->prepare($query, { mysql_use_result => 1, mysql_use_row => 1 }) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 16344 } 16345 } 16346 else 16347 { 16348 16349 # Set row cache size 16350 $self->{dbh}->{RowCacheSize} = int($self->{data_limit}/10); 16351 if (exists $self->{local_data_limit}{$table}) { 16352 $self->{dbh}->{RowCacheSize} = $self->{local_data_limit}{$table}; 16353 } 16354 16355 # prepare the query before execution 16356 if (!$self->{is_mysql}) 16357 { 16358 # Set the action name on Oracle side to see which table is exported 16359 $self->{dbh}->do("CALL DBMS_APPLICATION_INFO.set_action('$table')") or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 16360 16361 if ($self->{no_lob_locator}) { 16362 $sth = $self->{dbh}->prepare($query,{ora_piece_lob => 1, ora_piece_size => $self->{longreadlen}, ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY, ora_check_sql => 1}); 16363 } else { 16364 $sth = $self->{dbh}->prepare($query,{'ora_auto_lob' => 0, ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY, ora_check_sql => 1}); 16365 } 16366 16367 if ($self->{dbh}->errstr =~ /ORA-00942/) 16368 { 16369 $self->logit("WARNING: table $table is not yet physically created and has no data.\n", 0, 0); 16370 16371 # Only useful for single process 16372 return 0; 16373 } elsif ($self->{dbh}->errstr) { 16374 $self->logit("FATAL: _extract_data() " . $self->{dbh}->errstr . "\n", 1, 1); 16375 } 16376 foreach (@{$sth->{NAME}}) { 16377 push(@{$self->{data_cols}{$table}}, $_); 16378 } 16379 } 16380 else 16381 { 16382 #$query .= " LIMIT ?, ?"; 16383 $query =~ s/^SELECT\s+/SELECT \/\*\!40001 SQL_NO_CACHE \*\/ /s; 16384 $sth = $self->{dbh}->prepare($query, { mysql_use_result => 1, mysql_use_row => 1 }) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 16385 } 16386 16387 } 16388 16389 # Extract data now by chunk of DATA_LIMIT and send them to a dedicated job 16390 $self->logit("Fetching all data from $rname tuples...\n", 1); 16391 16392 my $start_time = time(); 16393 my $total_record = 0; 16394 my $total_row = $self->{tables}{$table}{table_info}{num_rows}; 16395 16396 # Send current table in progress 16397 if (defined $pipe) { 16398 my $t_name = $part_name || $table; 16399 if ($proc ne '') { 16400 $pipe->print("TABLE EXPORT IN PROGESS: $t_name-part-$proc, start: $start_time, rows $total_row\n"); 16401 } else { 16402 $pipe->print("TABLE EXPORT IN PROGESS: $t_name, start: $start_time, rows $total_row\n"); 16403 } 16404 } 16405 16406 my @params = (); 16407 if (defined $proc) { 16408 unshift(@params, $proc); 16409 $self->logit("Parallelizing on core #$proc with query: $query\n", 1); 16410 } 16411 if ( ($self->{parallel_tables} > 1) || (($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"}) ) { 16412 $sth->execute(@params) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 16413 } else { 16414 $sth->execute(@params) or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 16415 } 16416 16417 my $col_cond = $self->hs_cond($tt,$stt, $table); 16418 16419 # Oracle allow direct retreiving of bchunk of data 16420 if (!$self->{is_mysql}) { 16421 16422 my $data_limit = $self->{data_limit}; 16423 if (exists $self->{local_data_limit}{$table}) { 16424 $data_limit = $self->{local_data_limit}{$table}; 16425 } 16426 my $has_blob = 0; 16427 $has_blob = 1 if (grep(/LOB|XMLTYPE/, @$stt)); 16428 16429 # With rows that not have custom type nor blob unless the user doesn't want to use lob locator 16430 if (($#has_custom_type == -1) && (!$has_blob || $self->{no_lob_locator})) { 16431 16432 while ( my $rows = $sth->fetchall_arrayref(undef,$data_limit)) { 16433 if ( ($self->{parallel_tables} > 1) || (($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"}) ) { 16434 if ($dbh->errstr) { 16435 $self->logit("ERROR: " . $dbh->errstr . "\n", 0, 0); 16436 last; 16437 } 16438 } elsif ( $self->{dbh}->errstr ) { 16439 $self->logit("ERROR: " . $self->{dbh}->errstr . "\n", 0, 0); 16440 last; 16441 } 16442 16443 $total_record += @$rows; 16444 $self->{current_total_row} += @$rows; 16445 $self->logit("DEBUG: number of rows $total_record extracted from table $table\n", 1); 16446 16447 # Do we just want to test Oracle output speed 16448 next if ($self->{oracle_speed} && !$self->{ora2pg_speed}); 16449 16450 if ( ($self->{jobs} > 1) || ($self->{oracle_copies} > 1) ) { 16451 while ($self->{child_count} >= $self->{jobs}) { 16452 my $kid = waitpid(-1, WNOHANG); 16453 if ($kid > 0) { 16454 $self->{child_count}--; 16455 delete $RUNNING_PIDS{$kid}; 16456 } 16457 usleep(50000); 16458 } 16459 spawn sub { 16460 $self->_dump_to_pg($proc, $rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $start_time, $part_name, $total_record, %user_type); 16461 }; 16462 $self->{child_count}++; 16463 } else { 16464 $self->_dump_to_pg($proc, $rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $start_time, $part_name, $total_record, %user_type); 16465 } 16466 } 16467 16468 } else { 16469 16470 my @rows = (); 16471 while ( my @row = $sth->fetchrow_array()) 16472 { 16473 if ( ($self->{parallel_tables} > 1) || (($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"}) ) { 16474 if ($dbh->errstr) { 16475 $self->logit("ERROR: " . $dbh->errstr . "\n", 0, 0); 16476 last; 16477 } 16478 } elsif ( $self->{dbh}->errstr ) { 16479 $self->logit("ERROR: " . $self->{dbh}->errstr . "\n", 0, 0); 16480 last; 16481 } 16482 16483 # Then foreach row use the returned lob locator to retrieve data 16484 # and all column with a LOB data type, extract data by chunk 16485 for (my $j = 0; $j <= $#$stt; $j++) 16486 { 16487 # Look for data based on custom type to replace the reference by the value 16488 if ($row[$j] =~ /^(?!(?!)\x{100})ARRAY\(0x/ && $stt->[$j] !~ /SDO_GEOMETRY/i) 16489 { 16490 my $data_type = uc($stt->[$j]) || ''; 16491 $data_type =~ s/\(.*//; # remove any precision 16492 $row[$j] = $self->set_custom_type_value($data_type, $user_type{$j}, $row[$j], $tt->[$j], 0); 16493 } 16494 # Retrieve LOB data from locator 16495 elsif (($stt->[$j] =~ /LOB|XMLTYPE/) && $row[$j]) 16496 { 16497 my $lob_content = ''; 16498 my $offset = 1; # Offsets start at 1, not 0 16499 if ( ($self->{parallel_tables} > 1) || (($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"}) ) 16500 { 16501 # Get chunk size 16502 my $chunk_size = $self->{lob_chunk_size} || $dbh->ora_lob_chunk_size($row[$j]) || 8192; 16503 while (1) 16504 { 16505 my $lobdata = $dbh->ora_lob_read($row[$j], $offset, $chunk_size ); 16506 if ($dbh->errstr) { 16507 $self->logit("ERROR: " . $dbh->errstr . "\n", 0, 0) if ($dbh->errstr !~ /ORA-22831/); 16508 last; 16509 } 16510 last unless (defined $lobdata && length $lobdata); 16511 $offset += $chunk_size; 16512 $lob_content .= $lobdata; 16513 } 16514 } 16515 else 16516 { 16517 # Get chunk size 16518 my $chunk_size = $self->{lob_chunk_size} || $self->{dbh}->ora_lob_chunk_size($row[$j]) || 8192; 16519 while (1) 16520 { 16521 my $lobdata = $self->{dbh}->ora_lob_read($row[$j], $offset, $chunk_size ); 16522 if ($self->{dbh}->errstr) 16523 { 16524 $self->logit("ERROR: " . $self->{dbh}->errstr . "\n", 0, 0) if ($dbh->errstr !~ /ORA-22831/); 16525 last; 16526 } 16527 last unless (defined $lobdata && length $lobdata); 16528 $offset += $chunk_size; 16529 $lob_content .= $lobdata; 16530 } 16531 } 16532 if ($lob_content ne '') { 16533 $row[$j] = $lob_content; 16534 } else { 16535 $row[$j] = undef; 16536 } 16537 16538 } 16539 elsif (($stt->[$j] =~ /LOB/) && !$row[$j]) 16540 { 16541 # This might handle case where the LOB is NULL and might prevent error: 16542 # DBD::Oracle::db::ora_lob_read: locator is not of type OCILobLocatorPtr 16543 $row[$j] = undef; 16544 } 16545 } 16546 $total_record++; 16547 $self->{current_total_row}++; 16548 16549 # Do we just want to test Oracle output speed 16550 next if ($self->{oracle_speed} && !$self->{ora2pg_speed}); 16551 16552 push(@rows, [ @row ] ); 16553 16554 if ($#rows == $data_limit) 16555 { 16556 if ( ($self->{jobs} > 1) || ($self->{oracle_copies} > 1) ) { 16557 while ($self->{child_count} >= $self->{jobs}) { 16558 my $kid = waitpid(-1, WNOHANG); 16559 if ($kid > 0) { 16560 $self->{child_count}--; 16561 delete $RUNNING_PIDS{$kid}; 16562 } 16563 usleep(50000); 16564 } 16565 spawn sub { 16566 $self->_dump_to_pg($proc, \@rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $start_time, $part_name, $total_record, %user_type); 16567 }; 16568 $self->{child_count}++; 16569 } else { 16570 $self->_dump_to_pg($proc, \@rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $start_time, $part_name, $total_record, %user_type); 16571 } 16572 @rows = (); 16573 } 16574 } 16575 16576 # Do we just want to test Oracle output speed 16577 next if ($self->{oracle_speed} && !$self->{ora2pg_speed}); 16578 16579 # Flush last extracted data 16580 if ( ($self->{jobs} > 1) || ($self->{oracle_copies} > 1) ) { 16581 while ($self->{child_count} >= $self->{jobs}) { 16582 my $kid = waitpid(-1, WNOHANG); 16583 if ($kid > 0) { 16584 $self->{child_count}--; 16585 delete $RUNNING_PIDS{$kid}; 16586 } 16587 usleep(50000); 16588 } 16589 spawn sub { 16590 $self->_dump_to_pg($proc, \@rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $start_time, $part_name, $total_record, %user_type); 16591 }; 16592 $self->{child_count}++; 16593 } else { 16594 $self->_dump_to_pg($proc, \@rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $start_time, $part_name, $total_record, %user_type); 16595 } 16596 @rows = (); 16597 16598 } 16599 16600 } else { 16601 16602 my @rows = (); 16603 my $num_row = 0; 16604 while (my @row = $sth->fetchrow()) 16605 { 16606 push(@rows, \@row); 16607 $num_row++; 16608 if ($num_row == $self->{data_limit}) 16609 { 16610 $num_row = 0; 16611 $total_record += @rows; 16612 $self->{current_total_row} += @rows; 16613 # Do we just want to test Oracle output speed 16614 next if ($self->{oracle_speed} && !$self->{ora2pg_speed}); 16615# if ( ($self->{parallel_tables} > 1) || (($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"}) ) { 16616# my $max_jobs = $self->{jobs}; 16617# while ($self->{child_count} >= $max_jobs) { 16618# my $kid = waitpid(-1, WNOHANG); 16619# if ($kid > 0) { 16620# $self->{child_count}--; 16621# delete $RUNNING_PIDS{$kid}; 16622# } 16623# usleep(50000); 16624# } 16625# spawn sub { 16626# $self->_dump_to_pg($proc, \@rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $start_time, $part_name, $total_record, %user_type); 16627# }; 16628# $self->{child_count}++; 16629# } else { 16630 $self->_dump_to_pg($proc, \@rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $start_time, $part_name, $total_record, %user_type); 16631# } 16632 @rows = (); 16633 } 16634 } 16635 16636 if (@rows && (!$self->{oracle_speed} || $self->{ora2pg_speed})) { 16637 $total_record += @rows; 16638 $self->{current_total_row} += @rows; 16639# if ( ($self->{parallel_tables} > 1) || (($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"}) ) { 16640# my $max_jobs = $self->{jobs}; 16641# while ($self->{child_count} >= $max_jobs) { 16642# my $kid = waitpid(-1, WNOHANG); 16643# if ($kid > 0) { 16644# $self->{child_count}--; 16645# delete $RUNNING_PIDS{$kid}; 16646# } 16647# usleep(50000); 16648# } 16649# spawn sub { 16650# $self->_dump_to_pg($proc, \@rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $start_time, $part_name, $total_record, %user_type); 16651# }; 16652# $self->{child_count}++; 16653# } else { 16654 $self->_dump_to_pg($proc, \@rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $start_time, $part_name, $total_record, %user_type); 16655# } 16656 } 16657 } 16658 16659 $sth->finish(); 16660 16661 # Close global data file in use when parallel table is used without output mutliprocess 16662 $self->close_export_file($self->{cfhout}) if (defined $self->{cfhout}); 16663 $self->{cfhout} = undef; 16664 16665 if ( ($self->{jobs} <= 1) && ($self->{oracle_copies} <= 1) && ($self->{parallel_tables} <= 1)) 16666 { 16667 my $end_time = time(); 16668 my $dt = $end_time - $self->{global_start_time}; 16669 my $rps = int($self->{current_total_row} / ($dt||1)); 16670 print STDERR "\n"; 16671 print STDERR $self->progress_bar($self->{current_total_row}, $self->{global_rows}, 25, '=', 'total rows', "- ($dt sec., avg: $rps recs/sec).") . "\n"; 16672 } 16673 16674 # Wait for all child end 16675 while ($self->{child_count} > 0) 16676 { 16677 my $kid = waitpid(-1, WNOHANG); 16678 if ($kid > 0) { 16679 $self->{child_count}--; 16680 delete $RUNNING_PIDS{$kid}; 16681 } 16682 usleep(50000); 16683 } 16684 16685 if (defined $pipe) 16686 { 16687 my $t_name = $part_name || $table; 16688 my $t_time = time(); 16689 if ($proc ne '') { 16690 $pipe->print("TABLE EXPORT ENDED: $t_name-part-$proc, end: $t_time, rows $total_record\n"); 16691 } else { 16692 $pipe->print("TABLE EXPORT ENDED: $t_name, end: $t_time, rows $total_record\n"); 16693 } 16694 } 16695 16696 $dbh->disconnect() if ($dbh); 16697 16698 # Only useful for single process 16699 return $total_record; 16700} 16701 16702sub log_error_copy 16703{ 16704 my ($self, $table, $s_out, $rows) = @_; 16705 16706 my $outfile = ''; 16707 if ($self->{output_dir} && !$noprefix) { 16708 $outfile = $self->{output_dir} . '/'; 16709 } 16710 $outfile .= $table . '_error.log'; 16711 16712 my $filehdl = new IO::File; 16713 $filehdl->open(">>$outfile") or $self->logit("FATAL: Can't write to $outfile: $!\n", 0, 1); 16714 $filehdl->print($s_out); 16715 foreach my $row (@$rows) { 16716 $filehdl->print(join("\t", @$row) . "\n"); 16717 } 16718 $filehdl->print("\\.\n"); 16719 $self->close_export_file($filehdl); 16720} 16721 16722sub log_error_insert 16723{ 16724 my ($self, $table, $sql_out) = @_; 16725 16726 my $outfile = ''; 16727 if ($self->{output_dir} && !$noprefix) { 16728 $outfile = $self->{output_dir} . '/'; 16729 } 16730 $outfile .= $table . '_error.log'; 16731 16732 my $filehdl = new IO::File; 16733 $filehdl->open(">>$outfile") or $self->logit("FATAL: Can't write to $outfile: $!\n", 0, 1); 16734 $filehdl->print("$sql_out\n"); 16735 $self->close_export_file($filehdl); 16736} 16737 16738 16739sub _dump_to_pg 16740{ 16741 my ($self, $procnum, $rows, $table, $cmd_head, $cmd_foot, $s_out, $tt, $sprep, $stt, $ora_start_time, $part_name, $glob_total_record, %user_type) = @_; 16742 16743 my @tempfiles = (); 16744 16745 if ($^O !~ /MSWin32|dos/i) { 16746 push(@tempfiles, [ tempfile('tmp_ora2pgXXXXXX', SUFFIX => '', DIR => $TMP_DIR, UNLINK => 1 ) ]); 16747 } 16748 16749 # Oracle source table or partition 16750 my $rname = $part_name || $table; 16751 # Destination PostgreSQL table (direct import to partition is not allowed with native partitioning) 16752 my $dname = $table; 16753 $dname = $part_name if (!$self->{pg_supports_partition}); 16754 16755 if ($self->{pg_dsn}) 16756 { 16757 $0 = "ora2pg - sending data from table $rname to table $dname"; 16758 } else { 16759 $0 = "ora2pg - writing to file data from table $rname to table $dname"; 16760 } 16761 16762 # Connect to PostgreSQL if direct import is enabled 16763 my $dbhdest = undef; 16764 if ($self->{pg_dsn} && !$self->{oracle_speed}) 16765 { 16766 $dbhdest = $self->_send_to_pgdb(); 16767 $self->logit("Dumping data from table $rname into PostgreSQL table $dname...\n", 1); 16768 $self->logit("Setting client_encoding to $self->{client_encoding}...\n", 1); 16769 my $s = $dbhdest->do( "SET client_encoding TO '\U$self->{client_encoding}\E';") or $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 16770 if (!$self->{synchronous_commit}) 16771 { 16772 $self->logit("Disabling synchronous commit when writing to PostgreSQL...\n", 1); 16773 $s = $dbhdest->do("SET synchronous_commit TO off") or $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 16774 } 16775 } 16776 16777 # Build header of the file 16778 my $h_towrite = ''; 16779 foreach my $cmd (@$cmd_head) 16780 { 16781 if ($self->{pg_dsn} && !$self->{oracle_speed}) 16782 { 16783 $self->logit("Executing pre command to PostgreSQL: $cmd\n", 1); 16784 my $s = $dbhdest->do("$cmd") or $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 16785 } else { 16786 $h_towrite .= "$cmd\n"; 16787 } 16788 } 16789 16790 # Build footer of the file 16791 my $e_towrite = ''; 16792 foreach my $cmd (@$cmd_foot) 16793 { 16794 if ($self->{pg_dsn} && !$self->{oracle_speed}) 16795 { 16796 my $s = $dbhdest->do("$cmd") or $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 16797 } else { 16798 $e_towrite .= "$cmd\n"; 16799 } 16800 } 16801 16802 # Preparing data for output 16803 if ( !$sprep && ($#{$rows} >= 0) ) { 16804 my $data_limit = $self->{data_limit}; 16805 if (exists $self->{local_data_limit}{$table}) { 16806 $data_limit = $self->{local_data_limit}{$table}; 16807 } 16808 my $len = @$rows; 16809 $self->logit("DEBUG: Formatting bulk of $data_limit data (real: $len rows) for PostgreSQL.\n", 1); 16810 $self->format_data($rows, $tt, $self->{type}, $stt, \%user_type, $table); 16811 } 16812 16813 # Add COPY header to the output 16814 my $sql_out = $s_out; 16815 16816 # Creating output 16817 my $data_limit = $self->{data_limit}; 16818 if (exists $self->{local_data_limit}{$table}) 16819 { 16820 $data_limit = $self->{local_data_limit}{$table}; 16821 } 16822 $self->logit("DEBUG: Creating output for $data_limit tuples\n", 1); 16823 if ($self->{type} eq 'COPY') 16824 { 16825 if ($self->{pg_dsn}) 16826 { 16827 $sql_out =~ s/;$//; 16828 if (!$self->{oracle_speed}) 16829 { 16830 $self->logit("DEBUG: Sending COPY bulk output directly to PostgreSQL backend\n", 1); 16831 $dbhdest->do($sql_out) or $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 16832 $sql_out = ''; 16833 my $skip_end = 0; 16834 foreach my $row (@$rows) 16835 { 16836 unless($dbhdest->pg_putcopydata(join("\t", @$row) . "\n")) 16837 { 16838 if ($self->{log_on_error}) 16839 { 16840 $self->logit("ERROR (log error enabled): " . $dbhdest->errstr . "\n", 0, 0); 16841 $self->log_error_copy($table, $s_out, $rows); 16842 $skip_end = 1; 16843 last; 16844 } else { 16845 $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 16846 } 16847 } 16848 } 16849 unless ($dbhdest->pg_putcopyend()) 16850 { 16851 if ($self->{log_on_error}) 16852 { 16853 $self->logit("ERROR (log error enabled): " . $dbhdest->errstr . "\n", 0, 0); 16854 $self->log_error_copy($table, $s_out, $rows) if (!$skip_end); 16855 } else { 16856 $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 16857 } 16858 } 16859 } 16860 else 16861 { 16862 foreach my $row (@$rows) { 16863 # do nothing, just add loop time nothing must be sent to PG 16864 } 16865 } 16866 } 16867 else 16868 { 16869 # then add data to the output 16870 map { $sql_out .= join("\t", @$_) . "\n"; } @$rows; 16871 $sql_out .= "\\.\n"; 16872 } 16873 } 16874 elsif (!$sprep) 16875 { 16876 $sql_out = ''; 16877 foreach my $row (@$rows) { 16878 $sql_out .= $s_out; 16879 $sql_out .= join(',', @$row) . ");\n"; 16880 } 16881 } 16882 16883 # Insert data if we are in online processing mode 16884 if ($self->{pg_dsn}) 16885 { 16886 if ($self->{type} ne 'COPY') 16887 { 16888 if (!$sprep && !$self->{oracle_speed}) { 16889 $self->logit("DEBUG: Sending INSERT output directly to PostgreSQL backend\n", 1); 16890 unless($dbhdest->do("BEGIN;\n" . $sql_out . "COMMIT;\n")) { 16891 if ($self->{log_on_error}) { 16892 $self->logit("WARNING (log error enabled): " . $dbhdest->errstr . "\n", 0, 0); 16893 $self->log_error_insert($table, "BEGIN;\n" . $sql_out . "COMMIT;\n"); 16894 } else { 16895 $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 16896 } 16897 } 16898 } else { 16899 my $ps = undef; 16900 if (!$self->{oracle_speed}) { 16901 $ps = $dbhdest->prepare($sprep) or $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 16902 } 16903 my @date_cols = (); 16904 my @bool_cols = (); 16905 for (my $i = 0; $i <= $#{$tt}; $i++) 16906 { 16907 if ($tt->[$i] eq 'bytea') { 16908 if (!$self->{oracle_speed}) { 16909 $ps->bind_param($i+1, undef, { pg_type => DBD::Pg::PG_BYTEA }); 16910 } 16911 } elsif ($tt->[$i] eq 'boolean') { 16912 push(@bool_cols, $i); 16913 } elsif ($tt->[$i] =~ /(date|time)/i) { 16914 push(@date_cols, $i); 16915 } 16916 } 16917 $self->logit("DEBUG: Sending INSERT bulk output directly to PostgreSQL backend\n", 1); 16918 my $col_cond = $self->hs_cond($tt, $stt, $table); 16919 foreach my $row (@$rows) 16920 { 16921 # Even with prepared statement we need to replace zero date 16922 foreach my $j (@date_cols) { 16923 if ($row->[$j] =~ /^0000-00-00/) { 16924 if (!$self->{replace_zero_date}) { 16925 $row->[$j] = undef; 16926 } else { 16927 $row->[$j] = $self->{replace_zero_date}; 16928 } 16929 } 16930 } 16931 # Format user defined type and geometry data 16932 $self->format_data_row($row,$tt,'INSERT', $stt, \%user_type, $table, $col_cond, 1); 16933 # Replace boolean 't' and 'f' by 0 and 1 for bind parameters. 16934 foreach my $j (@bool_cols) { 16935 ($row->[$j] eq "'f'") ? $row->[$j] = 0 : $row->[$j] = 1; 16936 } 16937 # Apply bind parmeters 16938 if (!$self->{oracle_speed}) 16939 { 16940 unless ($ps->execute(@$row) ) 16941 { 16942 if ($self->{log_on_error}) 16943 { 16944 $self->logit("ERROR (log error enabled): " . $ps->errstr . "\n", 0, 0); 16945 $s_out =~ s/\([,\?]+\)/\(/; 16946 $self->format_data_row($row,$tt,'INSERT', $stt, \%user_type, $table, $col_cond); 16947 $self->log_error_insert($table, $s_out . join(',', @$row) . ");\n"); 16948 } 16949 else 16950 { 16951 $self->logit("FATAL: " . $ps->errstr . "\n", 0, 1); 16952 } 16953 } 16954 } 16955 } 16956 if (!$self->{oracle_speed}) { 16957 $ps->finish(); 16958 } 16959 } 16960 } 16961 } 16962 else 16963 { 16964 if ($part_name && $self->{prefix_partition}) { 16965 $part_name = $table . '_' . $part_name; 16966 } 16967 $sql_out = $h_towrite . $sql_out . $e_towrite; 16968 if (!$self->{oracle_speed}) { 16969 $self->data_dump($sql_out, $table, $part_name); 16970 } 16971 } 16972 16973 my $total_row = $self->{tables}{$table}{table_info}{num_rows}; 16974 my $tt_record = @$rows; 16975 $dbhdest->disconnect() if ($dbhdest); 16976 16977 my $end_time = time(); 16978 $ora_start_time = $end_time if (!$ora_start_time); 16979 my $dt = $end_time - $ora_start_time; 16980 my $rps = int($glob_total_record / ($dt||1)); 16981 my $t_name = $part_name || $table; 16982 if (!$self->{quiet} && !$self->{debug}) 16983 { 16984 # Send current table in progress 16985 if (defined $pipe) 16986 { 16987 if ($procnum ne '') 16988 { 16989 $pipe->print("CHUNK $$ DUMPED: $t_name-part-$procnum, time: $end_time, rows $tt_record\n"); 16990 } 16991 else 16992 { 16993 $pipe->print("CHUNK $$ DUMPED: $t_name, time: $end_time, rows $tt_record\n"); 16994 } 16995 } 16996 else 16997 { 16998 print STDERR $self->progress_bar($glob_total_record, $total_row, 25, '=', 'rows', "Table $t_name ($rps recs/sec)"), "\r"; 16999 } 17000 } 17001 elsif ($self->{debug}) 17002 { 17003 $self->logit("Extracted records from table $t_name: total_records = $glob_total_record (avg: $rps recs/sec)\n", 1); 17004 } 17005 17006 if ($^O !~ /MSWin32|dos/i) 17007 { 17008 if (defined $tempfiles[0]->[0]) 17009 { 17010 close($tempfiles[0]->[0]); 17011 } 17012 unlink($tempfiles[0]->[1]) if (-e $tempfiles[0]->[1]); 17013 } 17014} 17015 17016sub _pload_to_pg 17017{ 17018 my ($self, $idx, $query, @settings) = @_; 17019 17020 if (!$self->{pg_dsn}) 17021 { 17022 $self->logit("FATAL: No connection to PostgreSQL database set, aborting...\n", 0, 1); 17023 } 17024 17025 my @tempfiles = (); 17026 17027 if ($^O !~ /MSWin32|dos/i) 17028 { 17029 push(@tempfiles, [ tempfile('tmp_ora2pgXXXXXX', SUFFIX => '', DIR => $TMP_DIR, UNLINK => 1 ) ]); 17030 } 17031 17032 # Open a connection to the postgreSQL database 17033 $0 = "ora2pg - sending query to PostgreSQL database"; 17034 17035 # Connect to PostgreSQL if direct import is enabled 17036 my $dbhdest = $self->_send_to_pgdb(); 17037 $self->logit("Loading query #$idx: $query\n", 1); 17038 if ($#settings == -1) 17039 { 17040 $self->logit("Applying settings from configuration\n", 1); 17041 # Apply setting from configuration 17042 $dbhdest->do( "SET client_encoding TO '\U$self->{client_encoding}\E';") or $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 17043 my $search_path = $self->set_search_path(); 17044 if ($search_path) 17045 { 17046 $self->logit("Setting search_path using: $search_path...\n", 1); 17047 $dbhdest->do($search_path) or $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 17048 } 17049 } 17050 else 17051 { 17052 $self->logit("Applying settings from input file\n", 1); 17053 # Apply setting from source file 17054 foreach my $set (@settings) { 17055 $dbhdest->do($set) or $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 17056 } 17057 } 17058 # Execute query 17059 $dbhdest->do("$query") or $self->logit("FATAL: " . $dbhdest->errstr . "\n", 0, 1); 17060 $dbhdest->disconnect() if ($dbhdest); 17061 17062 if ($^O !~ /MSWin32|dos/i) 17063 { 17064 if (defined $tempfiles[0]->[0]) 17065 { 17066 close($tempfiles[0]->[0]); 17067 } 17068 unlink($tempfiles[0]->[1]) if (-e $tempfiles[0]->[1]); 17069 } 17070} 17071 17072 17073# Global array, to store the converted values 17074my @bytea_array; 17075sub build_escape_bytea 17076{ 17077 foreach my $tmp (0..255) 17078 { 17079 my $out; 17080 if ($tmp >= 32 and $tmp <= 126) { 17081 if ($tmp == 92) { 17082 $out = '\\\\134'; 17083 } elsif ($tmp == 39) { 17084 $out = '\\\\047'; 17085 } else { 17086 $out = chr($tmp); 17087 } 17088 } else { 17089 $out = sprintf('\\\\%03o',$tmp); 17090 } 17091 $bytea_array[$tmp] = $out; 17092 } 17093} 17094 17095=head2 escape_bytea 17096 17097This function return an escaped bytea entry for Pg. 17098 17099=cut 17100 17101 17102sub escape_bytea 17103{ 17104 my $data = shift; 17105 17106 # In this function, we use the array built by build_escape_bytea 17107 my @array= unpack("C*", $data); 17108 foreach my $elt (@array) { 17109 $elt = $bytea_array[$elt]; 17110 } 17111 return join('', @array); 17112} 17113 17114=head2 _show_infos 17115 17116This function display a list of schema, table or column only to stdout. 17117 17118=cut 17119 17120sub _show_infos 17121{ 17122 my ($self, $type) = @_; 17123 17124 if ($type eq 'SHOW_ENCODING') 17125 { 17126 if ($self->{is_mysql}) 17127 { 17128 $self->logit("Current encoding settings that will be used by Ora2Pg:\n", 0); 17129 $self->logit("\tMySQL database and client encoding: $self->{nls_lang}\n", 0); 17130 $self->logit("\tMySQL collation encoding: $self->{nls_nchar}\n", 0); 17131 $self->logit("\tPostgreSQL CLIENT_ENCODING $self->{client_encoding}\n", 0); 17132 $self->logit("\tPerl output encoding '$self->{binmode}'\n", 0); 17133 my ($my_encoding, $my_client, $pg_encoding, $my_timestamp_format, $my_date_format) = &Ora2Pg::MySQL::_get_encoding($self, $self->{dbh}); 17134 $self->logit("Showing current MySQL encoding and possible PostgreSQL client encoding:\n", 0); 17135 $self->logit("\tMySQL database and client encoding: $my_encoding\n", 0); 17136 $self->logit("\tMySQL collation encoding: $my_client\n", 0); 17137 $self->logit("\tPostgreSQL CLIENT_ENCODING: $pg_encoding\n", 0); 17138 $self->logit("MySQL SQL mode: $self->{mysql_mode}\n", 0); 17139 } else { 17140 $self->logit("Current encoding settings that will be used by Ora2Pg:\n", 0); 17141 $self->logit("\tOracle NLS_LANG $self->{nls_lang}\n", 0); 17142 $self->logit("\tOracle NLS_NCHAR $self->{nls_nchar}\n", 0); 17143 if ($self->{enable_microsecond}) { 17144 $self->logit("\tOracle NLS_TIMESTAMP_FORMAT YYYY-MM-DD HH24:MI:SS.FF\n", 0); 17145 } else { 17146 $self->logit("\tOracle NLS_TIMESTAMP_FORMAT YYYY-MM-DD HH24:MI:SS\n", 0); 17147 } 17148 $self->logit("\tOracle NLS_DATE_FORMAT YYYY-MM-DD HH24:MI:SS\n", 0); 17149 $self->logit("\tPostgreSQL CLIENT_ENCODING $self->{client_encoding}\n", 0); 17150 $self->logit("\tPerl output encoding '$self->{binmode}'\n", 0); 17151 17152 my ($ora_encoding, $ora_charset, $pg_encoding, $nls_timestamp_format, $nls_date_format) = $self->_get_encoding($self->{dbh}); 17153 $self->logit("Showing current Oracle encoding and possible PostgreSQL client encoding:\n", 0); 17154 $self->logit("\tOracle NLS_LANG $ora_encoding\n", 0); 17155 $self->logit("\tOracle NLS_NCHAR $ora_charset\n", 0); 17156 $self->logit("\tOracle NLS_TIMESTAMP_FORMAT $nls_timestamp_format\n", 0); 17157 $self->logit("\tOracle NLS_DATE_FORMAT $nls_date_format\n", 0); 17158 $self->logit("\tPostgreSQL CLIENT_ENCODING $pg_encoding\n", 0); 17159 } 17160 } 17161 elsif ($type eq 'SHOW_VERSION') 17162 { 17163 $self->logit("Showing Database Version...\n", 1); 17164 $self->logit("$self->{db_version}\n", 0); 17165 } 17166 elsif ($type eq 'SHOW_REPORT') 17167 { 17168 print STDERR "Reporting Oracle Content...\n" if ($self->{debug}); 17169 my $uncovered_score = 'Ora2Pg::PLSQL::UNCOVERED_SCORE'; 17170 if ($self->{is_mysql}) { 17171 $uncovered_score = 'Ora2Pg::PLSQL::UNCOVERED_MYSQL_SCORE'; 17172 } 17173 # Get Oracle database version and size 17174 print STDERR "Looking at Oracle server version...\n" if ($self->{debug}); 17175 my $ver = $self->_get_version(); 17176 print STDERR "Looking at Oracle database size...\n" if ($self->{debug}); 17177 my $size = $self->_get_database_size(); 17178 # Get the list of all database objects 17179 print STDERR "Looking at Oracle defined objects...\n" if ($self->{debug}); 17180 my %objects = $self->_get_objects(); 17181 17182 # Extract all tables informations 17183 my %all_indexes = (); 17184 $self->{skip_fkeys} = $self->{skip_indices} = $self->{skip_indexes} = $self->{skip_checks} = 0; 17185 $self->{view_as_table} = (); 17186 print STDERR "Looking at table definition...\n" if ($self->{debug}); 17187 $self->_tables(1); 17188 my $total_index = 0; 17189 my $total_table_objects = 0; 17190 my $total_index_objects = 0; 17191 foreach my $table (sort keys %{$self->{tables}}) 17192 { 17193 $total_table_objects++; 17194 push(@exported_indexes, $self->_exportable_indexes($table, %{$self->{tables}{$table}{indexes}})); 17195 $total_index_objects += scalar keys %{$self->{tables}{$table}{indexes}}; 17196 foreach my $idx (sort keys %{$self->{tables}{$table}{idx_type}}) 17197 { 17198 next if (!grep(/^$idx$/i, @exported_indexes)); 17199 my $typ = $self->{tables}{$table}{idx_type}{$idx}{type}; 17200 push(@{$all_indexes{$typ}}, $idx); 17201 $total_index++; 17202 } 17203 } 17204 # Convert Oracle user defined type to PostgreSQL 17205 if (!$self->{is_mysql}) { 17206 $self->_types(); 17207 foreach my $tpe (sort { $a->{pos} <=> $b->{pos} } @{$self->{types}}) { 17208 # We dont want the result but only the array @{$self->{types}} 17209 # define in the _convert_type() function 17210 $self->_convert_type($tpe->{code}, $tpe->{owner}); 17211 } 17212 } 17213 print STDERR "Looking at views definition...\n" if ($self->{debug}); 17214 my %view_infos = (); 17215 %view_infos = $self->_get_views() if ($self->{estimate_cost}); 17216 17217 # Get definition of Database Link 17218 print STDERR "Looking at database links...\n" if ($self->{debug}); 17219 my %dblink = $self->_get_dblink(); 17220 $objects{'DATABASE LINK'} = scalar keys %dblink; 17221 print STDERR "\tFound $objects{'DATABASE LINK'} DATABASE LINK.\n" if ($self->{debug}); 17222 # Get Jobs 17223 print STDERR "Looking at jobs...\n" if ($self->{debug}); 17224 my %jobs = $self->_get_job(); 17225 $objects{'JOB'} = scalar keys %jobs; 17226 print STDERR "\tFound $objects{'JOB'} JOB.\n" if ($self->{debug}); 17227 # Get synonym information 17228 print STDERR "Looking at synonyms...\n" if ($self->{debug}); 17229 my %synonyms = $self->_synonyms(); 17230 $objects{'SYNONYM'} = scalar keys %synonyms; 17231 print STDERR "\tFound $objects{'SYNONYM'} SYNONYM.\n" if ($self->{debug}); 17232 # Get all global temporary tables 17233 print STDERR "Looking at global temporary table...\n" if ($self->{debug}); 17234 my %global_tables = $self->_global_temp_table_info(); 17235 $objects{'GLOBAL TEMPORARY TABLE'} = scalar keys %global_tables; 17236 print STDERR "\tFound $objects{'GLOBAL TEMPORARY TABLE'} GLOBAL TEMPORARY TABLE.\n" if ($self->{debug}); 17237 # Look for encrypted columns and identity columns 17238 my %encrypted_column = (); 17239 if ($self->{db_version} !~ /Release [89]/) { 17240 print STDERR "Looking at encrypted columns...\n" if ($self->{debug}); 17241 %encrypted_column = $self->_encrypted_columns('',$self->{schema}); 17242 print STDERR "\tFound ", scalar keys %encrypted_column, " encrypted column.\n" if ($self->{debug}); 17243 print STDERR "Looking at identity columns...\n" if ($self->{debug}); 17244 # Identity column are collected in call to sub _tables() above 17245 print STDERR "\tFound ", scalar keys %{$self->{identity_info}}, " identity column.\n" if ($self->{debug}); 17246 } 17247 17248 # Look at all database objects to compute report 17249 my %report_info = (); 17250 $report_info{'Version'} = $ver || 'Unknown'; 17251 $report_info{'Schema'} = $self->{schema} || ''; 17252 $report_info{'Size'} = $size || 'Unknown'; 17253 my $idx = 0; 17254 my $num_total_obj = scalar keys %objects; 17255 foreach my $typ (sort keys %objects) 17256 { 17257 $idx++; 17258 next if ($typ eq 'EVALUATION CONTEXT'); # Do not care about rule evaluation context 17259 next if ($self->{is_mysql} && $typ eq 'SYNONYM'); 17260 next if ($typ eq 'PACKAGE'); # Package are scanned with PACKAGE BODY not PACKAGE objects 17261 print STDERR "Building report for object $typ...\n" if ($self->{debug}); 17262 if (!$self->{quiet} && !$self->{debug}) { 17263 print STDERR $self->progress_bar($idx, $num_total_obj, 25, '=', 'objects types', "inspecting object $typ" ), "\r"; 17264 } 17265 $report_info{'Objects'}{$typ}{'number'} = 0; 17266 $report_info{'Objects'}{$typ}{'invalid'} = 0; 17267 if (!grep(/^$typ$/, 'DATABASE LINK', 'JOB', 'TABLE', 'INDEX', 17268 'SYNONYM','GLOBAL TEMPORARY TABLE')) 17269 { 17270 for (my $i = 0; $i <= $#{$objects{$typ}}; $i++) 17271 { 17272 $report_info{'Objects'}{$typ}{'number'}++; 17273 $report_info{'Objects'}{$typ}{'invalid'}++ if ($objects{$typ}[$i]->{invalid}); 17274 } 17275 } 17276 elsif ($typ eq 'TABLE') 17277 { 17278 $report_info{'Objects'}{$typ}{'number'} = $total_table_objects; 17279 } 17280 elsif ($typ eq 'INDEX') 17281 { 17282 $report_info{'Objects'}{$typ}{'number'} = $total_index_objects; 17283 } 17284 else 17285 { 17286 $report_info{'Objects'}{$typ}{'number'} = $objects{$typ}; 17287 } 17288 17289 $report_info{'total_object_invalid'} += $report_info{'Objects'}{$typ}{'invalid'}; 17290 $report_info{'total_object_number'} += $report_info{'Objects'}{$typ}{'number'}; 17291 17292 if ($report_info{'Objects'}{$typ}{'number'} > 0) 17293 { 17294 $report_info{'Objects'}{$typ}{'real_number'} = ($report_info{'Objects'}{$typ}{'number'} - $report_info{'Objects'}{$typ}{'invalid'}); 17295 $report_info{'Objects'}{$typ}{'real_number'} = $report_info{'Objects'}{$typ}{'number'} if ($self->{export_invalid}); 17296 } 17297 17298 if ($self->{estimate_cost}) 17299 { 17300 $report_info{'Objects'}{$typ}{'cost_value'} = ($report_info{'Objects'}{$typ}{'real_number'}*$Ora2Pg::PLSQL::OBJECT_SCORE{$typ}); 17301 # Minimal unit is 1 17302 $report_info{'Objects'}{$typ}{'cost_value'} = 1 if ($report_info{'Objects'}{$typ}{'cost_value'} =~ /^0\./); 17303 # For some object's type do not set migration unit upper than 2 days. 17304 if (grep(/^$typ$/, 'TABLE PARTITION', 'GLOBAL TEMPORARY TABLE', 'TRIGGER', 'VIEW')) 17305 { 17306 $report_info{'Objects'}{$typ}{'cost_value'} = 168 if ($report_info{'Objects'}{$typ}{'cost_value'} > 168); 17307 if (grep(/^$typ$/, 'TRIGGER', 'VIEW') && $report_info{'Objects'}{$typ}{'real_number'} > 500) { 17308 $report_info{'Objects'}{$typ}{'cost_value'} += 84 * int(($report_info{'Objects'}{$typ}{'real_number'} - 500) / 500); 17309 } 17310 } 17311 elsif (grep(/^$typ$/, 'TABLE', 'INDEX', 'SYNONYM')) 17312 { 17313 $report_info{'Objects'}{$typ}{'cost_value'} = 84 if ($report_info{'Objects'}{$typ}{'cost_value'} > 84); 17314 } 17315 } 17316 17317 if ($typ eq 'INDEX') 17318 { 17319 my $bitmap = 0; 17320 foreach my $t (sort keys %INDEX_TYPE) 17321 { 17322 my $len = ($#{$all_indexes{$t}}+1); 17323 $report_info{'Objects'}{$typ}{'detail'} .= "\L$len $INDEX_TYPE{$t} index(es)\E\n" if ($len); 17324 if ($self->{estimate_cost} && $len && 17325 ( ($t =~ /FUNCTION.*NORMAL/) || ($t eq 'FUNCTION-BASED BITMAP') ) ) 17326 { 17327 $report_info{'Objects'}{$typ}{'cost_value'} += ($len * $Ora2Pg::PLSQL::OBJECT_SCORE{'FUNCTION-BASED-INDEX'}); 17328 } 17329 if ($self->{estimate_cost} && $len && ($t =~ /REV/)) { 17330 $report_info{'Objects'}{$typ}{'cost_value'} += ($len * $Ora2Pg::PLSQL::OBJECT_SCORE{'REV-INDEX'}); 17331 } 17332 } 17333 $report_info{'Objects'}{$typ}{'cost_value'} += ($Ora2Pg::PLSQL::OBJECT_SCORE{$typ}*$total_index) if ($self->{estimate_cost}); 17334 $report_info{'Objects'}{$typ}{'comment'} = "$total_index index(es) are concerned by the export, others are automatically generated and will do so on PostgreSQL."; 17335 my $hash_index = ''; 17336 if ($self->{pg_version} < 10) 17337 { 17338 $hash_index = ' and hash index(es) will be exported as b-tree index(es) if any'; 17339 } 17340 if (!$self->{is_mysql}) { 17341 my $bitmap = 'Bitmap'; 17342 if ($self->{bitmap_as_gin}) { 17343 $bitmap = 'Bitmap will be exported as btree_gin index(es)'; 17344 } 17345 $report_info{'Objects'}{$typ}{'comment'} .= " $bitmap$hash_index. Domain index are exported as b-tree but commented to be edited to mainly use FTS. Cluster, bitmap join and IOT indexes will not be exported at all. Reverse indexes are not exported too, you may use a trigram-based index (see pg_trgm) or a reverse() function based index and search. Use 'varchar_pattern_ops', 'text_pattern_ops' or 'bpchar_pattern_ops' operators in your indexes to improve search with the LIKE operator respectively into varchar, text or char columns."; 17346 } else { 17347 $report_info{'Objects'}{$typ}{'comment'} .= "$hash_index. Use 'varchar_pattern_ops', 'text_pattern_ops' or 'bpchar_pattern_ops' operators in your indexes to improve search with the LIKE operator respectively into varchar, text or char columns. Fulltext search indexes will be replaced by using a dedicated tsvector column, Ora2Pg will set the DDL to create the column, function and trigger together with the index."; 17348 } 17349 } 17350 elsif ($typ eq 'MATERIALIZED VIEW') 17351 { 17352 $report_info{'Objects'}{$typ}{'comment'}= "All materialized view will be exported as snapshot materialized views, they are only updated when fully refreshed."; 17353 my %mview_infos = $self->_get_materialized_views(); 17354 my $oncommit = 0; 17355 foreach my $mview (sort keys %mview_infos) { 17356 if ($mview_infos{$mview}{refresh_mode} eq 'COMMIT') { 17357 $oncommit++; 17358 $report_info{'Objects'}{$typ}{'detail'} .= "$mview, "; 17359 } 17360 } 17361 if ($oncommit) { 17362 $report_info{'Objects'}{$typ}{'detail'} =~ s/, $//; 17363 $report_info{'Objects'}{$typ}{'detail'} = "$oncommit materialized views are refreshed on commit ($report_info{'Objects'}{$typ}{'detail'}), this is not supported by PostgreSQL, you will need to use triggers to have the same behavior or use a simple view."; 17364 } 17365 17366 17367 } 17368 elsif ($typ eq 'TABLE') 17369 { 17370 my $exttb = scalar keys %{$self->{external_table}}; 17371 if ($exttb) { 17372 if (!$self->{external_to_fdw}) { 17373 $report_info{'Objects'}{$typ}{'comment'} = "$exttb external table(s) will be exported as standard table. See EXTERNAL_TO_FDW configuration directive to export as file_fdw foreign tables or use COPY in your code if you just want to load data from external files."; 17374 } else { 17375 $report_info{'Objects'}{$typ}{'comment'} = "$exttb external table(s) will be exported as file_fdw foreign table. See EXTERNAL_TO_FDW configuration directive to export as standard table or use COPY in your code if you just want to load data from external files."; 17376 } 17377 } 17378 17379 my %table_detail = (); 17380 my $virt_column = 0; 17381 my @done = (); 17382 my $id = 0; 17383 my $total_check = 0; 17384 my $total_row_num = 0; 17385 # Set the table information for each class found 17386 foreach my $t (sort keys %{$self->{tables}}) 17387 { 17388 # Set the total number of rows 17389 $total_row_num += $self->{tables}{$t}{table_info}{num_rows}; 17390 17391 # Look at reserved words if tablename is found 17392 my $r = $self->is_reserved_words($t); 17393 if (($r > 0) && ($r != 3)) { 17394 $table_detail{'reserved words in table name'}++; 17395 $report_info{'Objects'}{$typ}{'cost_value'} += 12; # one hour to solve reserved keyword might be enough 17396 } 17397 # Get fields informations 17398 foreach my $k (sort {$self->{tables}{$t}{column_info}{$a}[11] <=> $self->{tables}{$t}{column_info}{$a}[11]} keys %{$self->{tables}{$t}{column_info}}) 17399 { 17400 $r = $self->is_reserved_words($self->{tables}{$t}{column_info}{$k}[0]); 17401 if (($r > 0) && ($r != 3)) { 17402 $table_detail{'reserved words in column name'}++; 17403 $report_info{'Objects'}{$typ}{'cost_value'} += 12; # one hour to solve reserved keyword might be enough 17404 } elsif ($r == 3) { 17405 $table_detail{'system columns in column name'}++; 17406 $report_info{'Objects'}{$typ}{'cost_value'} += 12; # one hour to solve reserved keyword might be enough 17407 } 17408 $self->{tables}{$t}{column_info}{$k}[1] =~ s/TIMESTAMP\(\d+\)/TIMESTAMP/i; 17409 if (!$self->{is_mysql}) { 17410 if (!exists $self->{data_type}{uc($self->{tables}{$t}{column_info}{$k}[1])}) { 17411 $table_detail{'unknown types'}++; 17412 } 17413 } else { 17414 if (!exists $Ora2Pg::MySQL::MYSQL_TYPE{uc($self->{tables}{$t}{column_info}{$k}[1])}) { 17415 $table_detail{'unknown types'}++; 17416 } 17417 } 17418 if ( (uc($self->{tables}{$t}{column_info}{$k}[1]) eq 'NUMBER') && ($self->{tables}{$t}{column_info}{$k}[2] eq '') ) { 17419 $table_detail{'numbers with no precision'}++; 17420 } 17421 if ( $self->{data_type}{uc($self->{tables}{$t}{column_info}{$k}[1])} eq 'bytea' ) { 17422 $table_detail{'binary columns'}++; 17423 } 17424 } 17425 # Get check constraints information related to this table 17426 my $constraints = $self->_count_check_constraint($self->{tables}{$t}{check_constraint}); 17427 $total_check += $constraints; 17428 if ($self->{estimate_cost} && $constraints >= 0) { 17429 $report_info{'Objects'}{$typ}{'cost_value'} += $constraints * $Ora2Pg::PLSQL::OBJECT_SCORE{'CHECK'}; 17430 } 17431 } 17432 $report_info{'Objects'}{$typ}{'comment'} .= " $total_check check constraint(s)." if ($total_check); 17433 foreach my $d (sort keys %table_detail) { 17434 $report_info{'Objects'}{$typ}{'comment'} .= "\L$table_detail{$d} $d\E.\n"; 17435 } 17436 $report_info{'Objects'}{$typ}{'detail'} .= "Total number of rows: $total_row_num\n"; 17437 $report_info{'Objects'}{$typ}{'detail'} .= "Top $self->{top_max} of tables sorted by number of rows:\n"; 17438 my $j = 1; 17439 foreach my $t (sort {$self->{tables}{$b}{table_info}{num_rows} <=> $self->{tables}{$a}{table_info}{num_rows}} keys %{$self->{tables}}) { 17440 $report_info{'Objects'}{$typ}{'detail'} .= "\L$t\E has $self->{tables}{$t}{table_info}{num_rows} rows\n"; 17441 $j++; 17442 last if ($j > $self->{top_max}); 17443 } 17444 my %largest_table = (); 17445 %largest_table = $self->_get_largest_tables() if ($self->{is_mysql}); 17446 if ((scalar keys %largest_table > 0) || !$self->{is_mysql}) { 17447 $i = 1; 17448 if (!$self->{is_mysql}) { 17449 $report_info{'Objects'}{$typ}{'detail'} .= "Top $self->{top_max} of largest tables:\n"; 17450 foreach my $t (sort { $largest_table{$b} <=> $largest_table{$a} } keys %largest_table) { 17451 $report_info{'Objects'}{$typ}{'detail'} .= "\L$t\E: $largest_table{$t} MB (" . $self->{tables}{$t}{table_info}{num_rows} . " rows)\n"; 17452 $i++; 17453 last if ($i > $self->{top_max}); 17454 } 17455 } else { 17456 $report_info{'Objects'}{$typ}{'detail'} .= "Top $self->{top_max} of largest tables:\n"; 17457 foreach my $t (sort {$self->{tables}{$b}{table_info}{size} <=> $self->{tables}{$a}{table_info}{size}} keys %{$self->{tables}}) { 17458 $report_info{'Objects'}{$typ}{'detail'} .= "\L$t\E: $self->{tables}{$t}{table_info}{size} MB (" . $self->{tables}{$t}{table_info}{num_rows} . " rows)\n"; 17459 $i++; 17460 last if ($i > $self->{top_max}); 17461 } 17462 } 17463 } 17464 $comment = "Nothing particular." if (!$comment); 17465 $report_info{'Objects'}{$typ}{'cost_value'} =~ s/(\.\d).*$/$1/; 17466 if (scalar keys %encrypted_column > 0) { 17467 $report_info{'Objects'}{$typ}{'comment'} .= "\n" . (scalar keys %encrypted_column) . " encrypted column(s).\n"; 17468 foreach my $k (sort keys %encrypted_column) { 17469 $report_info{'Objects'}{$typ}{'comment'} .= "\L$k\E ($encrypted_column{$k})\n"; 17470 } 17471 $report_info{'Objects'}{$typ}{'comment'} .= ". You must use the pg_crypto extension to use encryption.\n"; 17472 if ($self->{estimate_cost}) { 17473 $report_info{'Objects'}{$typ}{'cost_value'} += (scalar keys %encrypted_column) * $Ora2Pg::PLSQL::OBJECT_SCORE{'ENCRYPTED COLUMN'}; 17474 } 17475 } 17476 if (scalar keys %{$self->{identity_info}} > 0) { 17477 $report_info{'Objects'}{$typ}{'comment'} .= "\n" . (scalar keys %{$self->{identity_info}}) . " identity column(s).\n"; 17478 $report_info{'Objects'}{$typ}{'comment'} .= " Identity columns are fully supported since PG10.\n"; 17479 } 17480 } 17481 elsif ($typ eq 'TYPE') 17482 { 17483 my $total_type = $report_info{'Objects'}{'TYPE'}{'number'}; 17484 foreach my $t (sort keys %{$self->{type_of_type}}) 17485 { 17486 $total_type-- if (grep(/^$t$/, 'Associative Arrays','Type Boby','Type with member method', 'Type Ref Cursor')); 17487 $report_info{'Objects'}{$typ}{'detail'} .= "\L$self->{type_of_type}{$t} $t\E\n" if ($self->{type_of_type}{$t}); 17488 } 17489 $report_info{'Objects'}{$typ}{'cost_value'} = ($Ora2Pg::PLSQL::OBJECT_SCORE{$typ}*$total_type) if ($self->{estimate_cost}); 17490 $report_info{'Objects'}{$typ}{'comment'} = "$total_type type(s) are concerned by the export, others are not supported. Note that Type inherited and Subtype are converted as table, type inheritance is not supported."; 17491 } 17492 elsif ($typ eq 'TYPE BODY') 17493 { 17494 $report_info{'Objects'}{$typ}{'comment'} = "Export of type with member method are not supported, they will not be exported."; 17495 } 17496 elsif ($typ eq 'TRIGGER') 17497 { 17498 my $triggers = $self->_get_triggers(); 17499 my $total_size = 0; 17500 foreach my $trig (@{$triggers}) { 17501 $total_size += length($trig->[4]); 17502 if ($self->{estimate_cost}) { 17503 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $trig->[4]); 17504 $report_info{'Objects'}{$typ}{'cost_value'} += $cost; 17505 $report_info{'Objects'}{$typ}{'detail'} .= "\L$trig->[0]: $cost\E\n"; 17506 $report_info{full_trigger_details}{"\L$trig->[0]\E"}{count} = $cost; 17507 foreach my $d (sort { $cost_detail{$b} <=> $cost_detail{$a} } keys %cost_detail) { 17508 next if (!$cost_detail{$d}); 17509 $report_info{full_trigger_details}{"\L$trig->[0]\E"}{info} .= "\t$d => $cost_detail{$d}"; 17510 $report_info{full_trigger_details}{"\L$trig->[0]\E"}{info} .= " (cost: ${$uncovered_score}{$d})" if (${$uncovered_score}{$d}); 17511 $report_info{full_trigger_details}{"\L$trig->[0]\E"}{info} .= "\n"; 17512 push(@{$report_info{full_trigger_details}{"\L$trig->[0]\E"}{keywords}}, $d) if (($d ne 'SIZE') && ($d ne 'TEST')); 17513 } 17514 } 17515 } 17516 $report_info{'Objects'}{$typ}{'comment'} = "Total size of trigger code: $total_size bytes."; 17517 } 17518 elsif ($typ eq 'SEQUENCE') 17519 { 17520 $report_info{'Objects'}{$typ}{'comment'} = "Sequences are fully supported, but all call to sequence_name.NEXTVAL or sequence_name.CURRVAL will be transformed into NEXTVAL('sequence_name') or CURRVAL('sequence_name')."; 17521 } 17522 elsif ($typ eq 'FUNCTION') 17523 { 17524 my $functions = $self->_get_functions(); 17525 my $total_size = 0; 17526 foreach my $fct (keys %{$functions}) { 17527 $total_size += length($functions->{$fct}{text}); 17528 if ($self->{estimate_cost}) { 17529 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $functions->{$fct}{text}); 17530 $report_info{'Objects'}{$typ}{'cost_value'} += $cost; 17531 $report_info{'Objects'}{$typ}{'detail'} .= "\L$fct: $cost\E\n"; 17532 $report_info{full_function_details}{"\L$fct\E"}{count} = $cost; 17533 foreach my $d (sort { $cost_detail{$b} <=> $cost_detail{$a} } keys %cost_detail) { 17534 next if (!$cost_detail{$d}); 17535 $report_info{full_function_details}{"\L$fct\E"}{info} .= "\t$d => $cost_detail{$d}"; 17536 $report_info{full_function_details}{"\L$fct\E"}{info} .= " (cost: ${$uncovered_score}{$d})" if (${$uncovered_score}{$d}); 17537 $report_info{full_function_details}{"\L$fct\E"}{info} .= "\n"; 17538 push(@{$report_info{full_function_details}{"\L$fct\E"}{keywords}}, $d) if (($d ne 'SIZE') && ($d ne 'TEST')); 17539 } 17540 } 17541 } 17542 $report_info{'Objects'}{$typ}{'comment'} = "Total size of function code: $total_size bytes."; 17543 } 17544 elsif ($typ eq 'PROCEDURE') 17545 { 17546 my $procedures = $self->_get_procedures(); 17547 my $total_size = 0; 17548 foreach my $proc (keys %{$procedures}) 17549 { 17550 $total_size += length($procedures->{$proc}{text}); 17551 if ($self->{estimate_cost}) { 17552 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $procedures->{$proc}{text}); 17553 $report_info{'Objects'}{$typ}{'cost_value'} += $cost; 17554 $report_info{'Objects'}{$typ}{'detail'} .= "\L$proc: $cost\E\n"; 17555 $report_info{full_function_details}{"\L$proc\E"}{count} = $cost; 17556 foreach my $d (sort { $cost_detail{$b} <=> $cost_detail{$a} } keys %cost_detail) { 17557 next if (!$cost_detail{$d}); 17558 $report_info{full_function_details}{"\L$proc\E"}{info} .= "\t$d => $cost_detail{$d}"; 17559 $report_info{full_function_details}{"\L$proc\E"}{info} .= " (cost: ${$uncovered_score}{$d})" if (${$uncovered_score}{$d}); 17560 $report_info{full_function_details}{"\L$proc\E"}{info} .= "\n"; 17561 push(@{$report_info{full_function_details}{"\L$proc\E"}{keywords}}, $d) if (($d ne 'SIZE') && ($d ne 'TEST')); 17562 } 17563 } 17564 } 17565 $report_info{'Objects'}{$typ}{'comment'} = "Total size of procedure code: $total_size bytes."; 17566 } 17567 elsif ($typ eq 'PACKAGE BODY') 17568 { 17569 $self->{packages} = $self->_get_packages(); 17570 my $total_size = 0; 17571 my $number_fct = 0; 17572 my $number_pkg = 0; 17573 foreach my $pkg (sort keys %{$self->{packages}}) 17574 { 17575 next if (!$self->{packages}{$pkg}{text}); 17576 $number_pkg++; 17577 $total_size += length($self->{packages}{$pkg}{text}); 17578 # Remove comment and text constant, they are not useful in assessment 17579 $self->_remove_comments(\$self->{packages}{$pkg}{text}); 17580 $self->{comment_values} = (); 17581 $self->{text_values} = (); 17582 my @codes = split(/CREATE(?: OR REPLACE)?(?: EDITIONABLE| NONEDITIONABLE)? PACKAGE\s+/i, $self->{packages}{$pkg}{text}); 17583 foreach my $txt (@codes) 17584 { 17585 next if ($txt !~ /^BODY\s+/is); 17586 my %infos = $self->_lookup_package("CREATE OR REPLACE PACKAGE $txt"); 17587 foreach my $f (sort keys %infos) 17588 { 17589 next if (!$f); 17590 if ($self->{estimate_cost}) 17591 { 17592 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $infos{$f}{code}); 17593 $report_info{'Objects'}{$typ}{'cost_value'} += $cost; 17594 $report_info{'Objects'}{$typ}{'detail'} .= "\L$f: $cost\E\n"; 17595 $report_info{full_function_details}{"\L$f\E"}{count} = $cost; 17596 foreach my $d (sort { $cost_detail{$b} <=> $cost_detail{$a} } keys %cost_detail) 17597 { 17598 next if (!$cost_detail{$d}); 17599 $report_info{full_function_details}{"\L$f\E"}{info} .= "\t$d => $cost_detail{$d}"; 17600 $report_info{full_function_details}{"\L$f\E"}{info} .= " (cost: ${$uncovered_score}{$d})" if (${$uncovered_score}{$d}); 17601 $report_info{full_function_details}{"\L$f\E"}{info} .= "\n"; 17602 push(@{$report_info{full_function_details}{"\L$f\E"}{keywords}}, $d) if (($d ne 'SIZE') && ($d ne 'TEST')); 17603 } 17604 } 17605 $number_fct++; 17606 } 17607 } 17608 } 17609 $self->{packages} = (); 17610 if ($self->{estimate_cost}) { 17611 $report_info{'Objects'}{$typ}{'cost_value'} += ($number_pkg*$Ora2Pg::PLSQL::OBJECT_SCORE{'PACKAGE BODY'}); 17612 } 17613 $report_info{'Objects'}{$typ}{'comment'} = "Total size of package code: $total_size bytes. Number of procedures and functions found inside those packages: $number_fct."; 17614 } 17615 elsif ( ($typ eq 'SYNONYM') && !$self->{is_mysql} ) 17616 { 17617 foreach my $t (sort {$a cmp $b} keys %synonyms) { 17618 if ($synonyms{$t}{dblink}) { 17619 $report_info{'Objects'}{$typ}{'detail'} .= "\L$synonyms{$t}{owner}.$t\E is a link to \L$synonyms{$t}{table_owner}.$synonyms{$t}{table_name}\@$synonyms{$t}{dblink}\E\n"; 17620 } else { 17621 $report_info{'Objects'}{$typ}{'detail'} .= "\L$t\E is an alias to $synonyms{$t}{table_owner}.$synonyms{$t}{table_name}\n"; 17622 } 17623 } 17624 $report_info{'Objects'}{$typ}{'comment'} = "SYNONYMs will be exported as views. SYNONYMs do not exists with PostgreSQL but a common workaround is to use views or set the PostgreSQL search_path in your session to access object outside the current schema."; 17625 } 17626 elsif ($typ eq 'INDEX PARTITION') 17627 { 17628 $report_info{'Objects'}{$typ}{'comment'} = "Only local indexes partition are exported, they are build on the column used for the partitioning."; 17629 } 17630 elsif ($typ eq 'TABLE PARTITION') 17631 { 17632 my %partitions = $self->_get_partitions_list(); 17633 foreach my $t (sort keys %partitions) { 17634 $report_info{'Objects'}{$typ}{'detail'} .= " $partitions{$t} $t partitions.\n"; 17635 } 17636 $report_info{'Objects'}{$typ}{'comment'} = "Partitions are exported using table inheritance and check constraint. Hash and Key partitions are not supported by PostgreSQL and will not be exported."; 17637 } 17638 elsif ($typ eq 'GLOBAL TEMPORARY TABLE') 17639 { 17640 $report_info{'Objects'}{$typ}{'comment'} = "Global temporary table are not supported by PostgreSQL and will not be exported. You will have to rewrite some application code to match the PostgreSQL temporary table behavior."; 17641 foreach my $t (sort keys %global_tables) { 17642 $report_info{'Objects'}{$typ}{'detail'} .= "\L$t\E\n"; 17643 } 17644 } 17645 elsif ($typ eq 'CLUSTER') 17646 { 17647 $report_info{'Objects'}{$typ}{'comment'} = "Clusters are not supported by PostgreSQL and will not be exported."; 17648 } 17649 elsif ($typ eq 'VIEW') 17650 { 17651 if ($self->{estimate_cost}) 17652 { 17653 foreach my $view (sort keys %view_infos) 17654 { 17655 # Remove unsupported definitions from the ddl statement 17656 $view_infos{$view}{text} =~ s/\s*WITH\s+READ\s+ONLY//is; 17657 $view_infos{$view}{text} =~ s/\s*OF\s+([^\s]+)\s+(WITH|UNDER)\s+[^\)]+\)//is; 17658 $view_infos{$view}{text} =~ s/\s*OF\s+XMLTYPE\s+[^\)]+\)//is; 17659 $view_infos{$view}{text} = $self->_format_view($view, $view_infos{$view}{text}); 17660 17661 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $view_infos{$view}{text}, 'VIEW'); 17662 $report_info{'Objects'}{$typ}{'cost_value'} += $cost; 17663 # Do not show view that just have to be tested 17664 next if (!$cost); 17665 $cost += $Ora2Pg::PLSQL::OBJECT_SCORE{'VIEW'}; 17666 # Show detail about views that might need manual rewritting 17667 $report_info{'Objects'}{$typ}{'detail'} .= "\L$view: $cost\E\n"; 17668 $report_info{full_view_details}{"\L$view\E"}{count} = $cost; 17669 foreach my $d (sort { $cost_detail{$b} <=> $cost_detail{$a} } keys %cost_detail) 17670 { 17671 next if (!$cost_detail{$d}); 17672 $report_info{full_view_details}{"\L$view\E"}{info} .= "\t$d => $cost_detail{$d}"; 17673 $report_info{full_view_details}{"\L$view\E"}{info} .= " (cost: ${$uncovered_score}{$d})" if (${$uncovered_score}{$d}); 17674 $report_info{full_view_details}{"\L$view\E"}{info} .= "\n"; 17675 push(@{$report_info{full_view_details}{"\L$view\E"}{keywords}}, $d); 17676 } 17677 } 17678 } 17679 $report_info{'Objects'}{$typ}{'comment'} = "Views are fully supported but can use specific functions."; 17680 } 17681 elsif ($typ eq 'DATABASE LINK') 17682 { 17683 my $def_fdw = 'oracle_fdw'; 17684 $def_fdw = 'mysql_fdw' if ($self->{is_mysql}); 17685 $report_info{'Objects'}{$typ}{'comment'} = "Database links will be exported as SQL/MED PostgreSQL's Foreign Data Wrapper (FDW) extensions using $def_fdw."; 17686 if ($self->{estimate_cost}) { 17687 $report_info{'Objects'}{$typ}{'cost_value'} = ($Ora2Pg::PLSQL::OBJECT_SCORE{'DATABASE LINK'}*$objects{$typ}); 17688 } 17689 } 17690 elsif ($typ eq 'JOB') 17691 { 17692 $report_info{'Objects'}{$typ}{'comment'} = "Job are not exported. You may set external cron job with them."; 17693 if ($self->{estimate_cost}) { 17694 $report_info{'Objects'}{$typ}{'cost_value'} = ($Ora2Pg::PLSQL::OBJECT_SCORE{'JOB'}*$objects{$typ}); 17695 } 17696 } 17697 # Apply maximum cost per object type 17698 if (exists $MAX_SCORE{$typ} && $report_info{'Objects'}{$typ}{'cost_value'} > $MAX_SCORE{$typ}) { 17699 $report_info{'Objects'}{$typ}{'cost_value'} = $MAX_SCORE{$typ}; 17700 } 17701 $report_info{'total_cost_value'} += $report_info{'Objects'}{$typ}{'cost_value'}; 17702 $report_info{'Objects'}{$typ}{'cost_value'} = sprintf("%2.2f", $report_info{'Objects'}{$typ}{'cost_value'}); 17703 } 17704 17705 if (!$self->{quiet} && !$self->{debug}) 17706 { 17707 print STDERR $self->progress_bar($idx, $num_total_obj, 25, '=', 'objects types', 'end of objects auditing.'), "\n"; 17708 } 17709 17710 # DBA_AUDIT_TRAIL queries will not be count if no audit user is give 17711 if ($self->{audit_user}) 17712 { 17713 my $tbname = 'DBA_AUDIT_TRAIL'; 17714 $tbname = 'general_log' if ($self->{is_mysql}); 17715 $report_info{'Objects'}{'QUERY'}{'number'} = 0; 17716 $report_info{'Objects'}{'QUERY'}{'invalid'} = 0; 17717 $report_info{'Objects'}{'QUERY'}{'comment'} = "Normalized queries found in $tbname for user(s): $self->{audit_user}"; 17718 my %queries = $self->_get_audit_queries(); 17719 foreach my $q (sort {$a <=> $b} keys %queries) 17720 { 17721 $report_info{'Objects'}{'QUERY'}{'number'}++; 17722 my $sql_q = Ora2Pg::PLSQL::convert_plsql_code($self, $queries{$q}); 17723 if ($self->{estimate_cost}) 17724 { 17725 my ($cost, %cost_detail) = Ora2Pg::PLSQL::estimate_cost($self, $sql_q, 'QUERY'); 17726 $cost += $Ora2Pg::PLSQL::OBJECT_SCORE{'QUERY'}; 17727 $report_info{'Objects'}{'QUERY'}{'cost_value'} += $cost; 17728 $report_info{'total_cost_value'} += $cost; 17729 } 17730 } 17731 $report_info{'Objects'}{'QUERY'}{'cost_value'} = sprintf("%2.2f", $report_info{'Objects'}{'QUERY'}{'cost_value'}); 17732 } 17733 $report_info{'total_cost_value'} = sprintf("%2.2f", $report_info{'total_cost_value'}); 17734 17735 # Display report in the requested format 17736 $self->_show_report(%report_info); 17737 17738 } 17739 elsif ($type eq 'SHOW_SCHEMA') 17740 { 17741 # Get all tables information specified by the DBI method table_info 17742 $self->logit("Showing all schema...\n", 1); 17743 my $sth = $self->_schema_list() or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 17744 while ( my @row = $sth->fetchrow()) { 17745 my $warning = ''; 17746 my $ret = $self->is_reserved_words($row[0]); 17747 if ($ret == 1) { 17748 $warning = " (Warning: '$row[0]' is a reserved word in PostgreSQL)"; 17749 } elsif ($ret == 2) { 17750 $warning = " (Warning: '$row[0]' object name with numbers only must be double quoted in PostgreSQL)"; 17751 } 17752 if (!$self->{is_mysql}) { 17753 $self->logit("SCHEMA $row[0]$warning\n", 0); 17754 } else { 17755 $self->logit("DATABASE $row[0]$warning\n", 0); 17756 } 17757 } 17758 $sth->finish(); 17759 } 17760 elsif ( ($type eq 'SHOW_TABLE') || ($type eq 'SHOW_COLUMN') ) 17761 { 17762 17763 # Get all tables information specified by the DBI method table_info 17764 $self->logit("Showing table information...\n", 1); 17765 17766 # Retrieve tables informations 17767 my %tables_infos = $self->_table_info(); 17768 17769 # Retrieve column identity information 17770 $self->logit("Retrieving column identity information...\n", 1); 17771 %{ $self->{identity_info} } = $self->_get_identities(); 17772 17773 # Retrieve all columns information 17774 my %columns_infos = (); 17775 if ($type eq 'SHOW_COLUMN') 17776 { 17777 %columns_infos = $self->_column_info('',$self->{schema}, 'TABLE'); 17778 foreach my $tb (keys %columns_infos) { 17779 foreach my $c (keys %{$columns_infos{$tb}}) { 17780 push(@{$self->{tables}{$tb}{column_info}{$c}}, @{$columns_infos{$tb}{$c}}); 17781 } 17782 } 17783 %columns_infos = (); 17784 17785 # Look for encrypted columns 17786 %{$self->{encrypted_column}} = $self->_encrypted_columns('',$self->{schema}); 17787 17788 # Retrieve index informations 17789 my ($uniqueness, $indexes, $idx_type, $idx_tbsp) = $self->_get_indexes('',$self->{schema}); 17790 foreach my $tb (keys %{$indexes}) { 17791 next if (!exists $tables_infos{$tb}); 17792 %{$self->{tables}{$tb}{indexes}} = %{$indexes->{$tb}}; 17793 } 17794 foreach my $tb (keys %{$idx_type}) { 17795 next if (!exists $tables_infos{$tb}); 17796 %{$self->{tables}{$tb}{idx_type}} = %{$idx_type->{$tb}}; 17797 } 17798 } 17799 17800 # Get partition list to mark tables with partition. 17801 $self->logit("Looking to subpartition information...\n", 1); 17802 my %subpartitions_list = $self->_get_subpartitioned_table(); 17803 $self->logit("Looking to partitioned tables information...\n", 1); 17804 my %partitions = $self->_get_partitioned_table(%subpartitions_list); 17805 17806 # Look for external tables 17807 my %externals = (); 17808 if (!$self->{is_mysql} && ($self->{db_version} !~ /Release 8/)) { 17809 $self->logit("Looking to external tables information...\n", 1); 17810 %externals = $self->_get_external_tables(); 17811 } 17812 17813 # Ordering tables by name by default 17814 my @ordered_tables = sort { $a cmp $b } keys %tables_infos; 17815 if (lc($self->{data_export_order}) eq 'size') 17816 { 17817 @ordered_tables = sort { 17818 ($tables_infos{$b}{num_rows} || $tables_infos{$a}{num_rows}) ? 17819 $tables_infos{$b}{num_rows} <=> $tables_infos{$a}{num_rows} : 17820 $a cmp $b 17821 } keys %tables_infos; 17822 } 17823 17824 my @done = (); 17825 my $id = 0; 17826 # Set the table information for each class found 17827 my $i = 1; 17828 my $total_row_num = 0; 17829 foreach my $t (@ordered_tables) 17830 { 17831 # Jump to desired extraction 17832 if (grep(/^$t$/, @done)) { 17833 $self->logit("Duplicate entry found: $t\n", 1); 17834 next; 17835 } else { 17836 push(@done, $t); 17837 } 17838 my $warning = ''; 17839 17840 # Set the number of partition if any 17841 if (exists $partitions{"\L$t\E"}) { 17842 my $upto = ''; 17843 $upto = 'up to ' if ($partitions{"\L$t\E"}{count} == 1048575); 17844 $warning .= " - $upto" . $partitions{"\L$t\E"}{count} . " " . $partitions{"\L$t\E"}{type} . " partitions"; 17845 $warning .= " with subpartitions" if ($partitions{"\L$t\E"}{composite}); 17846 } 17847 17848 # Search for reserved keywords 17849 my $ret = $self->is_reserved_words($t); 17850 if ($ret == 1) { 17851 $warning .= " (Warning: '$t' is a reserved word in PostgreSQL)"; 17852 } elsif ($ret == 2) { 17853 $warning .= " (Warning: '$t' object name with numbers only must be double quoted in PostgreSQL)"; 17854 } 17855 17856 $total_row_num += $tables_infos{$t}{num_rows}; 17857 17858 # Show table information 17859 my $kind = ''; 17860 $kind = ' FOREIGN' if ($tables_infos{$t}{connection}); 17861 if ($tables_infos{$t}{partitioned}) { 17862 $kind = ' PARTITIONED'; 17863 } 17864 if (exists $externals{$t}) { 17865 $kind = ' EXTERNAL'; 17866 } 17867 if ($tables_infos{$t}{nologging}) { 17868 $kind .= ' UNLOGGED'; 17869 } 17870 my $tname = $t; 17871 if (!$self->{is_mysql}) { 17872 $tname = "$tables_infos{$t}{owner}.$t" if ($self->{debug}); 17873 $self->logit("[$i]$kind TABLE $tname (owner: $tables_infos{$t}{owner}, $tables_infos{$t}{num_rows} rows)$warning\n", 0); 17874 } else { 17875 $self->logit("[$i]$kind TABLE $tname ($tables_infos{$t}{num_rows} rows)$warning\n", 0); 17876 } 17877 17878 # Set the fields information 17879 if ($type eq 'SHOW_COLUMN') 17880 { 17881 # Collect column's details for the current table with attempt to preserve column declaration order 17882 foreach my $k (sort { 17883 if (!$self->{reordering_columns}) { 17884 $self->{tables}{$t}{column_info}{$a}[11] <=> $self->{tables}{$t}{column_info}{$b}[11]; 17885 } else { 17886 my $tmpa = $self->{tables}{$t}{column_info}{$a}; 17887 $tmpa->[2] =~ s/\D//g; 17888 my $typa = $self->_sql_type($tmpa->[1], $tmpa->[2], $tmpa->[5], $tmpa->[6], $tmpa->[4]); 17889 $typa =~ s/\(.*//; 17890 my $tmpb = $self->{tables}{$t}{column_info}{$b}; 17891 $tmpb->[2] =~ s/\D//g; 17892 my $typb = $self->_sql_type($tmpb->[1], $tmpb->[2], $tmpb->[5], $tmpb->[6], $tmpb->[4]); 17893 $typb =~ s/\(.*//; 17894 $TYPALIGN{$typb} <=> $TYPALIGN{$typa}; 17895 } 17896 } keys %{$self->{tables}{$t}{column_info}}) 17897 { 17898 # COLUMN_NAME,DATA_TYPE,DATA_LENGTH,NULLABLE,DATA_DEFAULT,DATA_PRECISION,DATA_SCALE,CHAR_LENGTH,TABLE_NAME,OWNER,VIRTUAL_COLUMN,POSITION,AUTO_INCREMENT,SRID,SDO_DIM,SDO_GTYPE 17899 my $d = $self->{tables}{$t}{column_info}{$k}; 17900 $d->[2] =~ s/\D//g; 17901 my $type1 = $self->_sql_type($d->[1], $d->[2], $d->[5], $d->[6], $d->[4]); 17902 $type1 = "$d->[1], $d->[2]" if (!$type1); 17903 17904 # Check if we need auto increment 17905 $warning = ''; 17906 if ($d->[12] eq 'auto_increment' || $d->[12] eq '1') 17907 { 17908 if ($type1 !~ s/bigint/bigserial/) 17909 { 17910 if ($type1 !~ s/smallint/smallserial/) { 17911 $type1 =~ s/integer/serial/; 17912 } 17913 } 17914 if ($type1 =~ /serial/) { 17915 $warning = " - Seq last value: $tables_infos{$t}{auto_increment}"; 17916 } 17917 } 17918 $type1 = $self->{'modify_type'}{"\L$t\E"}{"\L$k\E"} if (exists $self->{'modify_type'}{"\L$t\E"}{"\L$k\E"}); 17919 my $align = ''; 17920 my $len = $d->[2]; 17921 if (($d->[1] =~ /char/i) && ($d->[7] > $d->[2])) { 17922 $d->[2] = $d->[7]; 17923 } 17924 $self->logit("\t$d->[0] : $d->[1]"); 17925 if ($d->[1] !~ /SDO_GEOMETRY/) 17926 { 17927 if ($d->[2] && !$d->[5]) { 17928 $self->logit("($d->[2])"); 17929 } 17930 elsif ($d->[5] && ($d->[1] =~ /NUMBER/i) ) 17931 { 17932 $self->logit("($d->[5]"); 17933 $self->logit(",$d->[6]") if ($d->[6]); 17934 $self->logit(")"); 17935 } 17936 if ($self->{reordering_columns}) 17937 { 17938 my $typ = $type1; 17939 $typ =~ s/\(.*//; 17940 $align = " - typalign: $TYPALIGN{$typ}"; 17941 } 17942 } 17943 else 17944 { 17945 # 12:SRID,13:SDO_DIM,14:SDO_GTYPE 17946 # Set the dimension, array is (srid, dims, gtype) 17947 my $suffix = ''; 17948 if ($d->[13] == 3) { 17949 $suffix = 'Z'; 17950 } elsif ($d->[13] == 4) { 17951 $suffix = 'ZM'; 17952 } 17953 my $gtypes = ''; 17954 if (!$d->[14] || ($d->[14] =~ /,/) ) { 17955 $gtypes = $ORA2PG_SDO_GTYPE{0}; 17956 } else { 17957 $gtypes = $d->[14]; 17958 } 17959 $type1 = "geometry($gtypes$suffix"; 17960 if ($d->[12]) { 17961 $type1 .= ",$d->[12]"; 17962 } 17963 $type1 .= ")"; 17964 $type1 .= " - $d->[14]" if ($d->[14] =~ /,/); 17965 17966 } 17967 my $ret = $self->is_reserved_words($d->[0]); 17968 if ($ret == 1) { 17969 $warning .= " (Warning: '$d->[0]' is a reserved word in PostgreSQL)"; 17970 } elsif ($ret == 2) { 17971 $warning .= " (Warning: '$d->[0]' object name with numbers only must be double quoted in PostgreSQL)"; 17972 } elsif ($ret == 3) { 17973 $warning = " (Warning: '$d->[0]' is a system column in PostgreSQL)"; 17974 } 17975 # Check if this column should be replaced by a boolean following table/column name 17976 my $typlen = $d->[5]; 17977 $typlen ||= $d->[2]; 17978 if (grep(/^$d->[0]$/i, @{$self->{'replace_as_boolean'}{uc($t)}})) { 17979 $type1 = 'boolean'; 17980 # Check if this column should be replaced by a boolean following type/precision 17981 } elsif (exists $self->{'replace_as_boolean'}{uc($d->[1])} && ($self->{'replace_as_boolean'}{uc($d->[1])}[0] == $typlen)) { 17982 $type1 = 'boolean'; 17983 } 17984 17985 # Autoincremented columns 17986 if (!$self->{schema} && $self->{export_schema}) { 17987 $d->[8] = "$d->[9].$d->[8]"; 17988 } 17989 if (exists $self->{identity_info}{$d->[8]}{$d->[0]}) 17990 { 17991 if ($self->{pg_supports_identity}) 17992 { 17993 $type1 = 'bigint'; # Force bigint 17994 $type1 .= " GENERATED $self->{identity_info}{$d->[8]}{$d->[0]}{generation} AS IDENTITY"; 17995 $type1 .= " (" . $self->{identity_info}{$d->[8]}{$d->[0]}{options} . ')' if (exists $self->{identity_info}{$d->[8]}{$d->[0]}{options} && $self->{identity_info}{$d->[8]}{$d->[0]}{options} ne ''); 17996 } 17997 else 17998 { 17999 $type1 =~ s/bigint$/bigserial/; 18000 $type1 =~ s/smallint/smallserial/; 18001 $type1 =~ s/(integer|int)$/serial/; 18002 } 18003 } 18004 18005 my $encrypted = ''; 18006 $encrypted = " [encrypted]" if (exists $self->{encrypted_column}{"$t.$k"}); 18007 my $virtual = ''; 18008 $virtual = " [virtual column]" if ($d->[10] eq 'YES' && $d->[4]); 18009 $self->logit(" => $type1$warning$align$virtual$encrypted\n"); 18010 } 18011 } 18012 $i++; 18013 } 18014 $self->logit("----------------------------------------------------------\n", 0); 18015 $self->logit("Total number of rows: $total_row_num\n\n", 0); 18016 $self->logit("Top $self->{top_max} of tables sorted by number of rows:\n", 0); 18017 $i = 1; 18018 foreach my $t (sort {$tables_infos{$b}{num_rows} <=> $tables_infos{$a}{num_rows}} keys %tables_infos) { 18019 my $tname = $t; 18020 if (!$self->{is_mysql}) { 18021 $tname = "$tables_infos{$t}{owner}.$t" if ($self->{debug}); 18022 } 18023 $self->logit("\t[$i] TABLE $tname has $tables_infos{$t}{num_rows} rows\n", 0); 18024 $i++; 18025 last if ($i > $self->{top_max}); 18026 } 18027 $self->logit("Top $self->{top_max} of largest tables:\n", 0); 18028 $i = 1; 18029 if (!$self->{is_mysql}) { 18030 my %largest_table = $self->_get_largest_tables(); 18031 foreach my $t (sort { $largest_table{$b} <=> $largest_table{$a} } keys %largest_table) { 18032 last if ($i > $self->{top_max}); 18033 my $tname = $t; 18034 $tname = "$tables_infos{$t}{owner}.$t" if ($self->{debug}); 18035 $self->logit("\t[$i] TABLE $tname: $largest_table{$t} MB (" . $tables_infos{$t}{num_rows} . " rows)\n", 0); 18036 $i++; 18037 } 18038 } else { 18039 foreach my $t (sort {$tables_infos{$b}{size} <=> $tables_infos{$a}{size}} keys %tables_infos) { 18040 last if ($i > $self->{top_max}); 18041 my $tname = $t; 18042 $self->logit("\t[$i] TABLE $tname: $tables_infos{$t}{size} MB (" . $tables_infos{$t}{num_rows} . " rows)\n", 0); 18043 $i++; 18044 } 18045 } 18046 } 18047} 18048 18049sub show_test_errors 18050{ 18051 my ($self, $lbl_type, @errors) = @_; 18052 18053 print "[ERRORS \U$lbl_type\E COUNT]\n"; 18054 if ($#errors >= 0) 18055 { 18056 foreach my $msg (@errors) { 18057 print "$msg\n"; 18058 } 18059 } 18060 else 18061 { 18062 if ($self->{pg_dsn}) { 18063 print "OK, Oracle and PostgreSQL have the same number of $lbl_type.\n"; 18064 } else { 18065 print "No PostgreSQL connection, can not check number of $lbl_type.\n"; 18066 } 18067 } 18068} 18069 18070sub set_pg_relation_name 18071{ 18072 my ($self, $table) = @_; 18073 18074 my $tbmod = $self->get_replaced_tbname($table); 18075 my $cmptb = $tbmod; 18076 $cmptb =~ s/"//g; 18077 my $orig = ''; 18078 $orig = " (origin: $table)" if (lc($cmptb) ne lc($table)); 18079 my $tbname = $tbmod; 18080 $tbname =~ s/[^"\.]+\.//; 18081 if ($self->{pg_schema} && $self->{export_schema}) { 18082 return ($tbmod, $orig, $self->{pg_schema}, "$self->{pg_schema}.$tbname"); 18083 } elsif ($self->{schema} && $self->{export_schema}) { 18084 return ($tbmod, $orig, $self->{schema}, "$self->{schema}.$tbname"); 18085 } 18086 18087 return ($tbmod, $orig, '', $tbmod); 18088} 18089 18090sub get_schema_condition 18091{ 18092 my ($self, $attrname, $local_schema) = @_; 18093 18094 $attrname ||= 'n.nspname'; 18095 18096 if ($local_schema && $self->{export_schema}) { 18097 return " AND lower($attrname) = '\L$local_schema\E'"; 18098 } elsif ($self->{pg_schema} && $self->{export_schema}) { 18099 return " AND lower($attrname) IN ('" . join("','", split(/\s*,\s*/, lc($self->{pg_schema}))) . "')"; 18100 } elsif ($self->{schema} && $self->{export_schema}) { 18101 return "AND lower($attrname) = '\L$self->{schema}\E'"; 18102 } elsif ($self->{pg_schema}) { 18103 return "AND lower($attrname) = '\L$self->{pg_schema}\E'"; 18104 } 18105 18106 my $cond = " AND $attrname <> 'pg_catalog' AND $attrname <> 'information_schema' AND $attrname !~ '^pg_toast'"; 18107 18108 return $cond; 18109} 18110 18111 18112sub _table_row_count 18113{ 18114 my $self = shift; 18115 18116 my $lbl = 'ORACLEDB'; 18117 $lbl = 'MYSQL_DB' if ($self->{is_mysql}); 18118 18119 # Get all tables information specified by the DBI method table_info 18120 $self->logit("Looking for real row count in source database and PostgreSQL tables...\n", 1); 18121 18122 # Retrieve tables informations 18123 my %tables_infos = $self->_table_info($self->{count_rows}); 18124 18125 #### 18126 # Test number of row in tables 18127 #### 18128 my @errors = (); 18129 print "\n"; 18130 print "[TEST ROWS COUNT]\n"; 18131 foreach my $t (sort keys %tables_infos) 18132 { 18133 print "$lbl:$t:$tables_infos{$t}{num_rows}\n"; 18134 if ($self->{pg_dsn}) 18135 { 18136 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18137 my $s = $self->{dbhdest}->prepare("SELECT count(*) FROM $both;") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18138 if (not $s->execute) 18139 { 18140 push(@errors, "Table $both$orig does not exists in PostgreSQL database.") if ($s->state eq '42P01'); 18141 next; 18142 } 18143 while ( my @row = $s->fetchrow()) 18144 { 18145 print "POSTGRES:$both$orig:$row[0]\n"; 18146 if ($row[0] != $tables_infos{$t}{num_rows}) { 18147 push(@errors, "Table $both$orig doesn't have the same number of line in source database ($tables_infos{$t}{num_rows}) and in PostgreSQL ($row[0])."); 18148 } 18149 last; 18150 } 18151 $s->finish(); 18152 } 18153 } 18154 $self->show_test_errors('rows', @errors); 18155} 18156 18157sub _test_table 18158{ 18159 my $self = shift; 18160 18161 my @errors = (); 18162 18163 # Get all tables information specified by the DBI method table_info 18164 $self->logit("Looking for objects count related to source database and PostgreSQL tables...\n", 1); 18165 18166 # Retrieve tables informations 18167 my %tables_infos = $self->_table_info($self->{count_rows}); 18168 18169 my $lbl = 'ORACLEDB'; 18170 $lbl = 'MYSQL_DB' if ($self->{is_mysql}); 18171 18172 #### 18173 # Test number of index in tables 18174 #### 18175 print "[TEST INDEXES COUNT]\n"; 18176 my ($uniqueness, $indexes, $idx_type, $idx_tbsp) = $self->_get_indexes('', $self->{schema}, 1); 18177 if ($self->{is_mysql}) { 18178 $indexes = Ora2Pg::MySQL::_count_indexes($self, '', $self->{schema}); 18179 } 18180 $schema_cond = $self->get_schema_condition('pg_indexes.schemaname'); 18181 my $sql = qq{ 18182SELECT schemaname||'.'||tablename, count(*) 18183FROM pg_indexes 18184WHERE 1=1 $schema_cond 18185GROUP BY schemaname,tablename 18186}; 18187 my %pgret = (); 18188 if ($self->{pg_dsn}) 18189 { 18190 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18191 if (not $s->execute()) 18192 { 18193 push(@errors, "Can not extract information from catalog about indexes."); 18194 return; 18195 } 18196 while ( my @row = $s->fetchrow()) 18197 { 18198 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18199 $pgret{"\U$row[0]\E"} = $row[1]; 18200 } 18201 $s->finish; 18202 } 18203 # Initialize when there is not indexes in a table 18204 foreach my $t (keys %tables_infos) { 18205 $indexes->{$t} = {} if (not exists $indexes->{$t}); 18206 } 18207 18208 foreach my $t (sort keys %{$indexes}) 18209 { 18210 next if (!exists $tables_infos{$t}); 18211 my $numixd = scalar keys %{$indexes->{$t}}; 18212 print "$lbl:$t:$numixd\n"; 18213 if ($self->{pg_dsn}) 18214 { 18215 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18216 $pgret{"\U$both$orig\E"} ||= 0; 18217 print "POSTGRES:$both$orig:", $pgret{"\U$both$orig\E"}, "\n"; 18218 if ($pgret{"\U$both$orig\E"} != $numixd) { 18219 push(@errors, "Table $both$orig doesn't have the same number of indexes in source database ($numixd) and in PostgreSQL (" . $pgret{"\U$both$orig\E"} . ")."); 18220 } 18221 } 18222 } 18223 $self->show_test_errors('indexes', @errors); 18224 @errors = (); 18225 18226 #### 18227 # Test unique constraints (excluding primary keys) 18228 #### 18229 print "\n"; 18230 print "[TEST UNIQUE CONSTRAINTS COUNT]\n"; 18231 my %unique_keys = $self->_unique_key('',$self->{schema},'U'); 18232 $schema_cond = $self->get_schema_condition('pg_class.relnamespace::regnamespace::text'); 18233 $sql = qq{ 18234SELECT schemaname||'.'||tablename, count(*) 18235FROM pg_indexes 18236JOIN pg_class ON (pg_class.relname=pg_indexes.indexname) 18237JOIN pg_constraint ON (pg_constraint.conname=pg_class.relname AND pg_constraint.connamespace=pg_class.relnamespace) 18238WHERE pg_constraint.contype IN ('u') $schema_cond 18239GROUP BY schemaname,tablename 18240}; 18241 %pgret = (); 18242 if ($self->{pg_dsn}) 18243 { 18244 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18245 if (not $s->execute()) 18246 { 18247 push(@errors, "Can not extract information from catalog about unique constraints."); 18248 return; 18249 } 18250 while ( my @row = $s->fetchrow()) 18251 { 18252 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18253 $pgret{"\U$row[0]\E"} = $row[1]; 18254 } 18255 $s->finish; 18256 } 18257 # Initialize when there is not unique key in a table 18258 foreach my $t (keys %tables_infos) { 18259 $unique_keys{$t} = {} if (not exists $unique_keys{$t}); 18260 } 18261 18262 foreach my $t (sort keys %unique_keys) 18263 { 18264 next if (!exists $tables_infos{$t}); 18265 my $numixd = scalar keys %{$unique_keys{$t}}; 18266 print "$lbl:$t:$numixd\n"; 18267 if ($self->{pg_dsn}) 18268 { 18269 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18270 $pgret{"\U$both$orig\E"} ||= 0; 18271 print "POSTGRES:$both$orig:", $pgret{"\U$both$orig\E"}, "\n"; 18272 if ($pgret{"\U$both$orig\E"} != $numixd) { 18273 push(@errors, "Table $both$orig doesn't have the same number of unique constraints in source database ($numixd) and in PostgreSQL (" . $pgret{"\U$both$orig\E"} . ")."); 18274 } 18275 } 18276 } 18277 $self->show_test_errors('unique constraints', @errors); 18278 @errors = (); 18279 18280 #### 18281 # Test primary keys only 18282 #### 18283 print "\n"; 18284 print "[TEST PRIMARY KEYS COUNT]\n"; 18285 %unique_keys = $self->_unique_key('',$self->{schema},'P'); 18286 $schema_cond = $self->get_schema_condition('pg_class.relnamespace::regnamespace::text'); 18287 $sql = qq{ 18288SELECT schemaname||'.'||tablename, count(*) 18289FROM pg_indexes 18290JOIN pg_class ON (pg_class.relname=pg_indexes.indexname AND pg_class.relnamespace=pg_indexes.schemaname::regnamespace::oid) 18291JOIN pg_constraint ON (pg_constraint.conname=pg_class.relname AND pg_constraint.connamespace=pg_class.relnamespace) 18292WHERE pg_constraint.contype = 'p' $schema_cond 18293GROUP BY schemaname,tablename 18294}; 18295 %pgret = (); 18296 if ($self->{pg_dsn}) 18297 { 18298 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18299 if (not $s->execute()) 18300 { 18301 push(@errors, "Can not extract information from catalog about primary keys."); 18302 return; 18303 } 18304 while ( my @row = $s->fetchrow()) 18305 { 18306 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18307 $pgret{"\U$row[0]\E"} = $row[1]; 18308 } 18309 $s->finish; 18310 } 18311 # Initialize when there is not unique key in a table 18312 foreach my $t (keys %tables_infos) { 18313 $unique_keys{$t} = {} if (not exists $unique_keys{$t}); 18314 } 18315 18316 foreach my $t (sort keys %unique_keys) 18317 { 18318 next if (!exists $tables_infos{$t}); 18319 my $nbpk = 0; 18320 foreach my $c (keys %{$unique_keys{$t}}) { 18321 $nbpk++ if ($unique_keys{$t}{$c}{type} eq 'P'); 18322 } 18323 print "$lbl:$t:$nbpk\n"; 18324 if ($self->{pg_dsn}) 18325 { 18326 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18327 $pgret{"\U$both$orig\E"} ||= 0; 18328 print "POSTGRES:$both$orig:", $pgret{"\U$both$orig\E"}, "\n"; 18329 if ($pgret{"\U$both$orig\E"} != $nbpk) { 18330 push(@errors, "Table $both$orig doesn't have the same number of primary keys in source database ($nbpk) and in PostgreSQL (" . $pgret{"\U$both$orig\E"} . ")."); 18331 } 18332 } 18333 } 18334 %unique_keys = (); 18335 $self->show_test_errors('primary keys', @errors); 18336 @errors = (); 18337 18338 #### 18339 # Test check constraints 18340 #### 18341 if (!$self->{is_mysql}) 18342 { 18343 print "\n"; 18344 print "[TEST CHECK CONSTRAINTS COUNT]\n"; 18345 my %check_constraints = $self->_check_constraint('',$self->{schema}); 18346 $schema_cond = $self->get_schema_condition('n.nspname'); 18347 $sql = qq{ 18348SELECT n.nspname::regnamespace||'.'||r.conrelid::regclass, count(*) 18349FROM pg_catalog.pg_constraint r JOIN pg_class c ON (r.conrelid=c.oid) JOIN pg_namespace n ON (c.relnamespace=n.oid) 18350WHERE r.contype = 'c' $schema_cond 18351GROUP BY n.nspname,r.conrelid 18352}; 18353 %pgret = (); 18354 if ($self->{pg_dsn}) 18355 { 18356 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18357 if (not $s->execute()) 18358 { 18359 push(@errors, "Can not extract information from catalog about check constraints."); 18360 return; 18361 } 18362 while ( my @row = $s->fetchrow()) 18363 { 18364 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18365 $pgret{"\U$row[0]\E"} = $row[1]; 18366 } 18367 $s->finish; 18368 } 18369 # Initialize when there is not unique key in a table 18370 foreach my $t (keys %tables_infos) { 18371 $check_constraints{$t}{constraint} = {} if (not exists $check_constraints{$t}); 18372 } 18373 18374 foreach my $t (sort keys %check_constraints) 18375 { 18376 next if (!exists $tables_infos{$t}); 18377 my $nbcheck = 0; 18378 foreach my $cn (keys %{$check_constraints{$t}{constraint}}) { 18379 $nbcheck++ if ($check_constraints{$t}{constraint}{$cn}{condition} !~ /IS NOT NULL$/); 18380 } 18381 print "$lbl:$t:$nbcheck\n"; 18382 if ($self->{pg_dsn}) 18383 { 18384 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18385 $pgret{"\U$both$orig\E"} ||= 0; 18386 print "POSTGRES:$both$orig:", $pgret{"\U$both$orig\E"}, "\n"; 18387 if ($pgret{"\U$both$orig\E"} != $nbcheck) { 18388 push(@errors, "Table $both$orig doesn't have the same number of check constraints in source database ($nbcheck) and in PostgreSQL (" . $pgret{"\U$both$orig\E"} . ")."); 18389 } 18390 } 18391 } 18392 %check_constraints = (); 18393 $self->show_test_errors('check constraints', @errors); 18394 @errors = (); 18395 } 18396 18397 #### 18398 # Test NOT NULL constraints 18399 #### 18400 print "\n"; 18401 print "[TEST NOT NULL CONSTRAINTS COUNT]\n"; 18402 my %column_infos = $self->_column_attributes('', $self->{schema}, 'TABLE'); 18403 $schema_cond = $self->get_schema_condition('n.nspname'); 18404 $sql = qq{ 18405SELECT n.nspname||'.'||e.oid::regclass, count(*) 18406FROM pg_catalog.pg_attribute a 18407JOIN pg_class e ON (e.oid=a.attrelid) 18408JOIN pg_namespace n ON (e.relnamespace=n.oid) 18409WHERE a.attnum > 0 18410 AND e.relkind IN ('r') 18411 AND NOT a.attisdropped AND a.attnotnull 18412 $schema_cond 18413GROUP BY n.nspname,e.oid 18414}; 18415 %pgret = (); 18416 if ($self->{pg_dsn}) 18417 { 18418 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18419 if (not $s->execute()) 18420 { 18421 push(@errors, "Can not extract information from catalog about not null constraints."); 18422 return; 18423 } 18424 while ( my @row = $s->fetchrow()) 18425 { 18426 $row[0] =~ s/^[^\.]+\.([^\.]+\.)/$1/; # remove possible duplicate schema prefix 18427 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18428 $pgret{"\U$row[0]\E"} = $row[1]; 18429 } 18430 $s->finish; 18431 } 18432 foreach my $t (sort keys %column_infos) 18433 { 18434 next if (!exists $tables_infos{$t}); 18435 my $nbnull = 0; 18436 foreach my $cn (keys %{$column_infos{$t}}) 18437 { 18438 if ($column_infos{$t}{$cn}{nullable} =~ /^N/) { 18439 $nbnull++; 18440 } 18441 } 18442 print "$lbl:$t:$nbnull\n"; 18443 if ($self->{pg_dsn}) 18444 { 18445 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18446 $pgret{"\U$both$orig\E"} ||= 0; 18447 print "POSTGRES:$both$orig:", $pgret{"\U$both$orig\E"}, "\n"; 18448 if ($pgret{"\U$both$orig\E"} != $nbnull) { 18449 push(@errors, "Table $both$orig doesn't have the same number of not null constraints in source database ($nbnull) and in PostgreSQL (" . $pgret{"\U$both$orig\E"} . ")."); 18450 } 18451 } 18452 } 18453 $self->show_test_errors('not null constraints', @errors); 18454 @errors = (); 18455 18456 #### 18457 # Test column default values 18458 #### 18459 print "\n"; 18460 print "[TEST COLUMN DEFAULT VALUE COUNT]\n"; 18461 $schema_cond = $self->get_schema_condition('n.nspname'); 18462 # SELECT n.nspname||'.'||e.oid::regclass, 18463 $sql = qq{ 18464SELECT n.nspname||'.'||e.oid::regclass, 18465 count((SELECT substring(pg_catalog.pg_get_expr(d.adbin, d.adrelid) for 128) 18466 FROM pg_catalog.pg_attrdef d 18467 WHERE d.adrelid = a.attrelid AND d.adnum = a.attnum AND a.atthasdef)) "default value" 18468FROM pg_catalog.pg_attribute a JOIN pg_class e ON (e.oid=a.attrelid) JOIN pg_namespace n ON (e.relnamespace=n.oid) 18469WHERE a.attnum > 0 AND NOT a.attisdropped 18470$schema_cond 18471GROUP BY n.nspname,e.oid 18472}; 18473 %pgret = (); 18474 if ($self->{pg_dsn}) 18475 { 18476 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18477 if (not $s->execute()) 18478 { 18479 push(@errors, "Can not extract information from catalog about column default values."); 18480 return; 18481 } 18482 while ( my @row = $s->fetchrow()) 18483 { 18484 $row[0] =~ s/^[^\.]+\.([^\.]+\.)/$1/; # remove possible duplicate schema prefix 18485 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18486 $pgret{"\U$row[0]\E"} = $row[1]; 18487 } 18488 $s->finish; 18489 } 18490 my @seqs = (); 18491 if ($self->{is_mysql}) { 18492 @seqs = Ora2Pg::MySQL::_count_sequences($self); 18493 } 18494 foreach my $t (sort keys %column_infos) 18495 { 18496 next if (!exists $tables_infos{$t}); 18497 my $nbdefault = 0; 18498 foreach my $cn (keys %{$column_infos{$t}}) 18499 { 18500 if ($column_infos{$t}{$cn}{default} ne '' 18501 && uc($column_infos{$t}{$cn}{default}) ne 'NULL' 18502 # identity column 18503 && ( $column_infos{$t}{$cn}{default} !~ /ISEQ\$\$_.*nextval/i 18504 || $self->{is_mysql} || !$self->{pg_supports_identity}) 18505 18506 ) 18507 { 18508 $nbdefault++; 18509 } 18510 } 18511 if (grep(/^$t$/i, @seqs)) { 18512 $nbdefault++; 18513 } 18514 print "$lbl:$t:$nbdefault\n"; 18515 if ($self->{pg_dsn}) 18516 { 18517 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18518 $pgret{"\U$both$orig\E"} ||= 0; 18519 print "POSTGRES:$both$orig:", $pgret{"\U$both$orig\E"}, "\n"; 18520 if ($pgret{"\U$both$orig\E"} != $nbdefault) { 18521 push(@errors, "Table $both$orig doesn't have the same number of column default value in source database ($nbdefault) and in PostgreSQL (" . $pgret{"\U$both$orig\E"} . ")."); 18522 } 18523 } 18524 } 18525 %column_infos = (); 18526 $self->show_test_errors('column default value', @errors); 18527 @errors = (); 18528 18529 #### 18530 # Test identity columns 18531 #### 18532 if ($self->{is_mysql} || !$self->{pg_supports_identity}) 18533 { 18534 print "\n"; 18535 print "[TEST IDENTITY COLUMN COUNT]\n"; 18536 $schema_cond = $self->get_schema_condition('n.nspname'); 18537 $sql = qq{ 18538SELECT e.oid::regclass, 18539 count((SELECT substring(pg_catalog.pg_get_expr(d.adbin, d.adrelid) for 128) 18540 FROM pg_catalog.pg_attrdef d 18541 WHERE d.adrelid = a.attrelid AND d.adnum = a.attnum AND a.atthasdef)) "default value" 18542FROM pg_catalog.pg_attribute a JOIN pg_class e ON (e.oid=a.attrelid) JOIN pg_namespace n ON (e.relnamespace=n.oid) 18543WHERE a.attnum > 0 AND NOT a.attisdropped AND a.attidentity IN ('a', 'd') 18544$schema_cond 18545GROUP BY e.oid 18546}; 18547 %pgret = (); 18548 if ($self->{pg_dsn}) 18549 { 18550 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18551 if (not $s->execute()) 18552 { 18553 push(@errors, "Can not extract information from catalog about identity columns."); 18554 return; 18555 } 18556 while ( my @row = $s->fetchrow()) 18557 { 18558 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18559 $pgret{"\U$row[0]\E"} = $row[1]; 18560 } 18561 $s->finish; 18562 } 18563 @seqs = (); 18564 if ($self->{is_mysql}) { 18565 @seqs = Ora2Pg::MySQL::_count_sequences($self); 18566 } 18567 foreach my $t (sort keys %column_infos) 18568 { 18569 next if (!exists $tables_infos{$t}); 18570 my $nbidty = 0; 18571 foreach my $cn (keys %{$column_infos{$t}}) 18572 { 18573 if ($column_infos{$t}{$cn}{default} =~ /ISEQ\$\$_.*nextval/i) { 18574 $nbidty++; 18575 } 18576 } 18577 if (grep(/^$t$/i, @seqs)) { 18578 $nbidty++; 18579 } 18580 print "$lbl:$t:$nbidty\n"; 18581 if ($self->{pg_dsn}) 18582 { 18583 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18584 $pgret{"\U$both$orig\E"} ||= 0; 18585 print "POSTGRES:$both$orig:", $pgret{"\U$both$orig\E"}, "\n"; 18586 if ($pgret{"\U$both$orig\E"} != $nbidty) { 18587 push(@errors, "Table $both$orig doesn't have the same number of identity column in source database ($nbidty) and in PostgreSQL (" . $pgret{"\U$both$orig\E"} . ")."); 18588 } 18589 } 18590 } 18591 %column_infos = (); 18592 $self->show_test_errors('column default value', @errors); 18593 @errors = (); 18594 } 18595 18596 %column_infos = (); 18597 18598 #### 18599 # Test foreign keys 18600 #### 18601 print "\n"; 18602 print "[TEST FOREIGN KEYS COUNT]\n"; 18603 my ($foreign_link, $foreign_key) = $self->_foreign_key('',$self->{schema}); 18604 $schema_cond = $self->get_schema_condition('n.nspname'); 18605 $sql = qq{ 18606SELECT n.nspname||'.'||r.conrelid::regclass, count(*) 18607FROM pg_catalog.pg_constraint r JOIN pg_class c ON (r.conrelid=c.oid) JOIN pg_namespace n ON (c.relnamespace=n.oid) 18608WHERE r.contype = 'f' $schema_cond 18609GROUP BY n.nspname,r.conrelid 18610}; 18611 %pgret = (); 18612 if ($self->{pg_dsn}) 18613 { 18614 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18615 if (not $s->execute()) 18616 { 18617 push(@errors, "Can not extract information from catalog about foreign keys constraints."); 18618 return; 18619 } 18620 while ( my @row = $s->fetchrow()) 18621 { 18622 $row[0] =~ s/^[^\.]+\.([^\.]+\.)/$1/; # remove possible duplicate schema prefix 18623 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18624 $pgret{"\U$row[0]\E"} = $row[1]; 18625 } 18626 $s->finish; 18627 } 18628 # Initialize when there is not unique key in a table 18629 foreach my $t (keys %tables_infos) { 18630 $foreign_link->{$t} = {} if (not exists $foreign_link->{$t}); 18631 } 18632 18633 foreach my $t (sort keys %{$foreign_link}) 18634 { 18635 next if (!exists $tables_infos{$t}); 18636 my $nbfk = scalar keys %{$foreign_link->{$t}}; 18637 print "$lbl:$t:$nbfk\n"; 18638 if ($self->{pg_dsn}) 18639 { 18640 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18641 $pgret{"\U$both$orig\E"} ||= 0; 18642 print "POSTGRES:$both$orig:", $pgret{"\U$both$orig\E"}, "\n"; 18643 if ($pgret{"\U$both$orig\E"} != $nbfk) { 18644 push(@errors, "Table $both$orig doesn't have the same number of foreign key constraints in source database ($nbfk) and in PostgreSQL (" . $pgret{"\U$both$orig\E"} . ")."); 18645 } 18646 } 18647 } 18648 $self->show_test_errors('foreign keys', @errors); 18649 @errors = (); 18650 $foreign_link = undef; 18651 $foreign_key = undef; 18652 18653 #### 18654 # Test partitions 18655 #### 18656 print "\n"; 18657 print "[TEST PARTITION COUNT]\n"; 18658 my %partitions = $self->_get_partitioned_table(); 18659 $schema_cond = $self->get_schema_condition('nmsp_parent.nspname'); 18660 $schema_cond =~ s/^ AND/ WHERE/; 18661 $sql = qq{ 18662SELECT 18663 nmsp_parent.nspname AS parent_schema, 18664 parent.relname AS parent, 18665 COUNT(*) 18666FROM pg_inherits 18667 JOIN pg_class parent ON pg_inherits.inhparent = parent.oid 18668 JOIN pg_class child ON pg_inherits.inhrelid = child.oid 18669 JOIN pg_namespace nmsp_parent ON nmsp_parent.oid = parent.relnamespace 18670 JOIN pg_namespace nmsp_child ON nmsp_child.oid = child.relnamespace 18671$schema_cond 18672GROUP BY 18673 parent_schema, 18674 parent; 18675}; 18676 my %pg_part = (); 18677 if ($self->{pg_dsn}) 18678 { 18679 $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18680 if (not $s->execute()) 18681 { 18682 push(@errors, "Can not extract information from catalog about PARTITION."); 18683 next; 18684 } 18685 while ( my @row = $s->fetchrow()) 18686 { 18687 $row[1] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18688 $pg_part{$row[1]} = $row[2]; 18689 } 18690 $s->finish(); 18691 } 18692 foreach my $t (sort keys %partitions) 18693 { 18694 next if (!exists $tables_infos{$t}); 18695 print "$lbl:$t:", $partitions{"\L$t\E"}{count}, "\n"; 18696 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18697 if (exists $pg_part{$tbmod}) 18698 { 18699 print "POSTGRES:$both$orig:$pg_part{$tbmod}\n"; 18700 if ($pg_part{$tbmod} != $partitions{"\L$t\E"}{count}) { 18701 push(@errors, "Table $both$orig doesn't have the same number of partitions in source database (" . $partitions{"\L$t\E"}{count} . ") and in PostgreSQL ($pg_part{$tbmod})."); 18702 } 18703 } 18704 else 18705 { 18706 push(@errors, "Table $both$orig doesn't have the same number of partitions in source database (" . $partitions{"\L$t\E"}{count} . ") and in PostgreSQL (0)."); 18707 } 18708 } 18709 $self->show_test_errors('PARTITION', @errors); 18710 @errors = (); 18711 %partitions = (); 18712 18713 print "\n"; 18714 print "[TEST TABLE COUNT]\n"; 18715 my $nbobj = scalar keys %tables_infos; 18716 $schema_cond = $self->get_schema_condition(); 18717 $sql = qq{ 18718SELECT count(*) 18719FROM pg_catalog.pg_class c 18720 LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace 18721WHERE c.relkind IN ('r','') 18722 $schema_cond 18723}; 18724 18725 print "$lbl:TABLE:$nbobj\n"; 18726 if ($self->{pg_dsn}) 18727 { 18728 $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18729 if (not $s->execute()) 18730 { 18731 push(@errors, "Can not extract information from catalog about $obj_type."); 18732 next; 18733 } 18734 while ( my @row = $s->fetchrow()) 18735 { 18736 print "POSTGRES:TABLE:$row[0]\n"; 18737 if ($row[0] != $nbobj) { 18738 push(@errors, "TABLE does not have the same count in source database ($nbobj) and in PostgreSQL ($row[0])."); 18739 } 18740 last; 18741 } 18742 $s->finish(); 18743 } 18744 $self->show_test_errors('TABLE', @errors); 18745 @errors = (); 18746 18747 #### 18748 # Test triggers 18749 #### 18750 print "\n"; 18751 print "[TEST TABLE TRIGGERS COUNT]\n"; 18752 my %triggers = $self->_list_triggers(); 18753 $schema_cond = $self->get_schema_condition(); 18754 $sql = qq{ 18755SELECT n.nspname||'.'||c.relname, count(*) 18756FROM pg_catalog.pg_trigger t JOIN pg_class c ON (t.tgrelid=c.oid) JOIN pg_namespace n ON (c.relnamespace=n.oid) 18757WHERE (NOT t.tgisinternal OR (t.tgisinternal AND t.tgenabled = 'D')) 18758 $schema_cond 18759GROUP BY n.nspname,c.relname 18760}; 18761 %pgret = (); 18762 if ($self->{pg_dsn}) 18763 { 18764 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18765 if (not $s->execute()) 18766 { 18767 push(@errors, "Can not extract information from catalog about table triggrers."); 18768 return; 18769 } 18770 while ( my @row = $s->fetchrow()) 18771 { 18772 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18773 $pgret{"\U$row[0]\E"} = $row[1]; 18774 } 18775 $s->finish; 18776 } 18777 # Initialize when there is not unique key in a table 18778 foreach my $t (keys %tables_infos) { 18779 $triggers{$t} = () if (not exists $triggers{$t}); 18780 } 18781 18782 foreach my $t (sort keys %triggers) 18783 { 18784 next if (!exists $tables_infos{$t}); 18785 my $nbtrg = $#{$triggers{$t}}+1; 18786 print "$lbl:$t:$nbtrg\n"; 18787 if ($self->{pg_dsn}) 18788 { 18789 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($t); 18790 $pgret{"\U$both$orig\E"} ||= 0; 18791 print "POSTGRES:$both$orig:", $pgret{"\U$both$orig\E"}, "\n"; 18792 if ($pgret{"\U$both$orig\E"} != $nbtrg) { 18793 push(@errors, "Table $both$orig doesn't have the same number of triggers in source database ($nbtrg) and in PostgreSQL (" . $pgret{"\U$both$orig\E"} . ")."); 18794 } 18795 } 18796 } 18797 $s->finish() if ($self->{pg_dsn}); 18798 $self->show_test_errors('table triggers', @errors); 18799 @errors = (); 18800 18801 print "\n"; 18802 print "[TEST TRIGGER COUNT]\n"; 18803 $nbobj = 0; 18804 foreach my $t (keys %triggers) { 18805 next if (!exists $tables_infos{$t}); 18806 $nbobj += $#{$triggers{$t}}+1; 18807 } 18808 $schema_cond = $self->get_schema_condition(); 18809 $sql = qq{ 18810SELECT count(*) 18811FROM pg_catalog.pg_trigger t JOIN pg_class c ON (c.oid = t.tgrelid) JOIN pg_namespace n ON (c.relnamespace=n.oid) 18812WHERE (NOT t.tgisinternal OR (t.tgisinternal AND t.tgenabled = 'D')) 18813 $schema_cond 18814}; 18815 18816 print "$lbl:TRIGGER:$nbobj\n"; 18817 if ($self->{pg_dsn}) 18818 { 18819 $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18820 if (not $s->execute()) 18821 { 18822 push(@errors, "Can not extract information from catalog about $obj_type."); 18823 next; 18824 } 18825 while ( my @row = $s->fetchrow()) 18826 { 18827 print "POSTGRES:TRIGGER:$row[0]\n"; 18828 if ($row[0] != $nbobj) { 18829 push(@errors, "TRIGGER does not have the same count in source database ($nbobj) and in PostgreSQL ($row[0])."); 18830 } 18831 last; 18832 } 18833 $s->finish(); 18834 } 18835 $self->show_test_errors('TRIGGER', @errors); 18836 @errors = (); 18837} 18838 18839sub _unitary_test_views 18840{ 18841 my $self = shift; 18842 18843 # Get all tables information specified by the DBI method table_info 18844 $self->logit("Unitary test of views between source database and PostgreSQL...\n", 1); 18845 18846 # First of all extract all views from PostgreSQL database 18847 my $schema_clause = $self->get_schema_condition(); 18848 my $sql = qq{ 18849SELECT c.relname,n.nspname 18850FROM pg_catalog.pg_class c 18851 LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace 18852WHERE c.relkind IN ('v','') 18853 $schema_clause 18854}; 18855 my %list_views = (); 18856 if ($self->{pg_dsn}) { 18857 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18858 if (not $s->execute()) { 18859 push(@errors, "Can not extract information from catalog about views."); 18860 next; 18861 } 18862 while ( my @row = $s->fetchrow()) 18863 { 18864 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 18865 $list_views{$row[0]} = $row[1]; 18866 } 18867 $s->finish(); 18868 } 18869 18870 my $lbl = 'ORACLEDB'; 18871 $lbl = 'MYSQL_DB' if ($self->{is_mysql}); 18872 18873 print "[UNITARY TEST OF VIEWS]\n"; 18874 foreach my $v (sort keys %list_views) 18875 { 18876 # Execute init settings if any 18877 # Count rows returned by all view on the source database 18878 $sql = "SELECT count(*) FROM $v"; 18879 my $sth = $self->{dbh}->prepare($sql) or $self->logit("ERROR: " . $self->{dbh}->errstr . "\n", 0, 0); 18880 $sth->execute or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 0); 18881 my @row = $sth->fetchrow(); 18882 my $ora_ct = $row[0]; 18883 print "$lbl:$v:", join('|', @row), "\n"; 18884 $sth->finish; 18885 # Execute view in the PostgreSQL database 18886 $sql = "SELECT count(*) FROM $v;"; 18887 $sth = $self->{dbhdest}->prepare($sql) or $self->logit("ERROR: " . $self->{dbhdest}->errstr . "\n", 0, 0); 18888 $sth->execute or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 0); 18889 @row = $sth->fetchrow(); 18890 $sth->finish; 18891 my $pg_ct = $row[0]; 18892 print "POSTGRES:$v:", join('|', @row), "\n"; 18893 if ($pg_ct != $ora_ct) { 18894 print "ERROR: view $v returns different row count [oracle: $ora_ct, postgresql: $pg_ct]\n"; 18895 } 18896 } 18897} 18898 18899sub _count_object 18900{ 18901 my $self = shift; 18902 my $obj_type = shift; 18903 18904 # Get all tables information specified by the DBI method table_info 18905 $self->logit("Looking for source database and PostgreSQL objects count...\n", 1); 18906 18907 my $lbl = 'ORACLEDB'; 18908 $lbl = 'MYSQL_DB' if ($self->{is_mysql}); 18909 18910 my $schema_clause = $self->get_schema_condition(); 18911 my $nbobj = 0; 18912 my $sql = ''; 18913 if ($obj_type eq 'VIEW') 18914 { 18915 my %obj_infos = $self->_get_views(); 18916 $nbobj = scalar keys %obj_infos; 18917 $sql = qq{ 18918SELECT count(*) 18919FROM pg_catalog.pg_class c 18920 LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace 18921WHERE c.relkind IN ('v','') 18922 $schema_clause 18923}; 18924 } 18925 elsif ($obj_type eq 'MVIEW') 18926 { 18927 my %obj_infos = $self->_get_materialized_views(); 18928 $nbobj = scalar keys %obj_infos; 18929 $sql = qq{ 18930SELECT count(*) 18931FROM pg_catalog.pg_class c 18932 LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace 18933WHERE c.relkind IN ('m','') 18934 $schema_clause 18935}; 18936 } 18937 elsif ($obj_type eq 'SEQUENCE') 18938 { 18939 my $obj_infos = {}; 18940 if (!$self->{is_mysql}) { 18941 $obj_infos = $self->_get_sequences(); 18942 } else { 18943 $obj_infos = Ora2Pg::MySQL::_count_sequences($self); 18944 } 18945 $nbobj = scalar keys %$obj_infos; 18946 $sql = qq{ 18947SELECT count(*) 18948FROM pg_catalog.pg_class c 18949 LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace 18950WHERE c.relkind IN ('S','') 18951 $schema_clause 18952}; 18953 } 18954 elsif ($obj_type eq 'TYPE') 18955 { 18956 my $obj_infos = $self->_get_types(); 18957 $nbobj = $#{$obj_infos} + 1; 18958 $schema_clause .= " AND pg_catalog.pg_type_is_visible(t.oid)" if ($schema_clause =~ /information_schema/); 18959 $sql = qq{ 18960SELECT count(*) 18961FROM pg_catalog.pg_type t 18962 LEFT JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace 18963WHERE (t.typrelid = 0 OR (SELECT c.relkind = 'c' FROM pg_catalog.pg_class c WHERE c.oid = t.typrelid)) 18964 AND NOT EXISTS(SELECT 1 FROM pg_catalog.pg_type el WHERE el.oid = t.typelem AND el.typarray = t.oid) 18965 $schema_clause 18966}; 18967 } 18968 elsif ($obj_type eq 'FDW') 18969 { 18970 my %obj_infos = $self->_get_external_tables(); 18971 $nbobj = scalar keys %obj_infos; 18972 $sql = qq{ 18973SELECT count(*) 18974FROM pg_catalog.pg_class c 18975 LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace 18976WHERE c.relkind IN ('f','') 18977 $schema_clause 18978}; 18979 } 18980 else 18981 { 18982 return; 18983 } 18984 18985 print "\n"; 18986 print "[TEST $obj_type COUNT]\n"; 18987 18988 if ($self->{is_mysql} && ($obj_type eq 'SEQUENCE')) { 18989 print "$lbl:AUTOINCR:$nbobj\n"; 18990 } else { 18991 print "$lbl:$obj_type:$nbobj\n"; 18992 } 18993 if ($self->{pg_dsn}) 18994 { 18995 my $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 18996 if (not $s->execute()) 18997 { 18998 push(@errors, "Can not extract information from catalog about $obj_type."); 18999 next; 19000 } 19001 while ( my @row = $s->fetchrow()) 19002 { 19003 print "POSTGRES:$obj_type:$row[0]\n"; 19004 if ($row[0] != $nbobj) { 19005 push(@errors, "\U$obj_type\E does not have the same count in source database ($nbobj) and in PostgreSQL ($row[0])."); 19006 } 19007 last; 19008 } 19009 $s->finish(); 19010 } 19011 $self->show_test_errors($obj_type, @errors); 19012 @errors = (); 19013} 19014 19015sub _test_function 19016{ 19017 my $self = shift; 19018 19019 my @errors = (); 19020 19021 $self->logit("Looking for functions count related to source database and PostgreSQL functions...\n", 1); 19022 19023 my $lbl = 'ORACLEDB'; 19024 $lbl = 'MYSQL_DB' if ($self->{is_mysql}); 19025 19026 #### 19027 # Test number of function 19028 #### 19029 print "\n"; 19030 print "[TEST FUNCTION COUNT]\n"; 19031 my @fct_infos = $self->_list_all_funtions(); 19032 my $schema_clause = " AND n.nspname NOT IN ('pg_catalog','information_schema')"; 19033 $sql = qq{ 19034SELECT n.nspname,proname,prorettype 19035FROM pg_catalog.pg_proc p 19036 LEFT JOIN pg_catalog.pg_namespace n ON n.oid = p.pronamespace 19037 LEFT JOIN pg_catalog.pg_type t ON t.oid=p.prorettype 19038WHERE t.typname <> 'trigger' 19039$schema_clause 19040}; 19041 19042 my $nbobj = $#fct_infos + 1; 19043 print "$lbl:FUNCTION:$nbobj\n"; 19044 if ($self->{pg_dsn}) 19045 { 19046 $s = $self->{dbhdest}->prepare($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 19047 if (not $s->execute()) 19048 { 19049 push(@errors, "Can not extract information from catalog about $obj_type."); 19050 next; 19051 } 19052 my $pgfct = 0; 19053 my %pg_function = (); 19054 while ( my @row = $s->fetchrow()) 19055 { 19056 $pgfct++; 19057 my $fname = $row[1]; 19058 if ($row[0] ne 'public') { 19059 $fname = $row[0] . '.' . $row[1]; 19060 } 19061 $pg_function{lc($fname)} = 1; 19062 } 19063 print "POSTGRES:FUNCTION:$pgfct\n"; 19064 if ($pgfct != $nbobj) { 19065 push(@errors, "FUNCTION does not have the same count in source database ($nbobj) and in PostgreSQL ($pgfct)."); 19066 } 19067 $s->finish(); 19068 # search for missing funtion 19069 foreach my $f (@fct_infos) 19070 { 19071 my $found = 0; 19072 foreach my $pgf (keys %pg_function) 19073 { 19074 $found = 1, last if (lc($f) eq lc($pgf)); 19075 if ($f !~ /\./) { 19076 $found = 1, last if ($pgf =~ /^[^\.]+\.$f$/i); 19077 } else { 19078 $found = 1, last if ($pgf =~ /^$f$/i); 19079 } 19080 } 19081 push(@errors, "Function $f is missing in PostgreSQL database.") if (!$found); 19082 } 19083 } 19084 $self->show_test_errors('FUNCTION', @errors); 19085 @errors = (); 19086 print "\n"; 19087} 19088 19089sub _test_seq_values 19090{ 19091 my $self = shift; 19092 19093 my @errors = (); 19094 19095 $self->logit("Looking for last values related to source database and PostgreSQL sequences...\n", 1); 19096 19097 my $lbl = 'ORACLEDB'; 19098 $lbl = 'MYSQL_DB' if ($self->{is_mysql}); 19099 19100 #### 19101 # Test number of function 19102 #### 19103 print "\n"; 19104 print "[TEST SEQUENCE VALUES]\n"; 19105 my $obj_infos = []; 19106 if (!$self->{is_mysql}) { 19107 $obj_infos = $self->_get_sequences(); 19108 } else { 19109 $obj_infos = Ora2Pg::MySQL::_count_sequences($self); 19110 } 19111 19112 my %pgret = (); 19113 if ($self->{pg_dsn}) 19114 { 19115 # create a function to extract the last value of all sequences 19116 my $sql = qq{ 19117CREATE OR REPLACE FUNCTION get_sequence_last_values() RETURNS TABLE(seqname text,val bigint) AS 19118\$\$ 19119DECLARE 19120 seq_name varchar(128); 19121BEGIN 19122 FOR seq_name in SELECT quote_ident(relnamespace::regnamespace::text)||'.'||quote_ident(relname::text) FROM pg_class WHERE (relkind = 'S') 19123 LOOP 19124 RETURN QUERY EXECUTE 'SELECT ' || quote_literal(seq_name) || ',last_value FROM ' || seq_name; 19125 END LOOP; 19126 RETURN; 19127END 19128\$\$ 19129LANGUAGE 'plpgsql'; 19130}; 19131 $self->{dbhdest}->do($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 19132 my $s = $self->{dbhdest}->prepare("SELECT * FROM get_sequence_last_values()") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 19133 if (not $s->execute()) 19134 { 19135 push(@errors, "Can not extract information from catalog about last values of sequences."); 19136 return; 19137 } 19138 while ( my @row = $s->fetchrow()) 19139 { 19140 $row[0] =~ s/^[^\.]+\.// if (!$self->{export_schema}); 19141 $pgret{"\U$row[0]\E"} = $row[1]; 19142 } 19143 $s->finish; 19144 $self->{dbhdest}->do("DROP FUNCTION get_sequence_last_values") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 19145 } 19146 19147 foreach my $r (sort keys %$obj_infos) 19148 { 19149 $r =~ s/^[^\.]+\.// if (!$self->{export_schema}); 19150 print "$lbl:$r:$obj_infos->{$r}->[4]\n"; 19151 if ($self->{pg_dsn}) 19152 { 19153 my ($tbmod, $orig, $schema, $both) = $self->set_pg_relation_name($r); 19154 $pgret{"\U$both$orig\E"} ||= 0; 19155 print "POSTGRES:$both$orig:", $pgret{"\U$both$orig\E"}, "\n"; 19156 if ($pgret{"\U$both$orig\E"} != $obj_infos->{$r}->[4]) { 19157 push(@errors, "Sequence $both$orig doesn't have the same value in source database ($obj_infos->{$r}->[4]) and in PostgreSQL (" . $pgret{"\U$both$orig\E"} . "). Verify +/- cache size: $obj_infos->{$r}->[5]."); 19158 } 19159 } 19160 } 19161 $self->show_test_errors('sequence values', @errors); 19162 @errors = (); 19163 print "\n"; 19164} 19165 19166=head2 _get_version 19167 19168This function retrieves the Oracle version information 19169 19170=cut 19171 19172sub _get_version 19173{ 19174 my $self = shift; 19175 19176 return Ora2Pg::MySQL::_get_version($self) if ($self->{is_mysql}); 19177 19178 my $oraver = ''; 19179 my $sql = "SELECT BANNER FROM v\$version"; 19180 19181 my $sth = $self->{dbh}->prepare( $sql ) or return undef; 19182 $sth->execute or return undef; 19183 while ( my @row = $sth->fetchrow()) { 19184 $oraver = $row[0]; 19185 last; 19186 } 19187 $sth->finish(); 19188 19189 chomp($oraver); 19190 $oraver =~ s/ \- .*//; 19191 19192 return $oraver; 19193} 19194 19195=head2 _get_database_size 19196 19197This function retrieves the size of the Oracle database in MB 19198 19199=cut 19200 19201sub _get_database_size 19202{ 19203 my $self = shift; 19204 19205 return Ora2Pg::MySQL::_get_database_size($self) if ($self->{is_mysql}); 19206 19207 my $mb_size = ''; 19208 my $sql = "SELECT sum(bytes)/1024/1024 FROM USER_SEGMENTS"; 19209 if (!$self->{user_grants}) { 19210 $sql = "SELECT sum(bytes)/1024/1024 FROM DBA_SEGMENTS"; 19211 if ($self->{schema}) { 19212 $sql .= " WHERE OWNER='$self->{schema}' "; 19213 } else { 19214 $sql .= " WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 19215 } 19216 } 19217 my $sth = $self->{dbh}->prepare( $sql ) or return undef; 19218 $sth->execute or return undef; 19219 while ( my @row = $sth->fetchrow()) { 19220 $mb_size = sprintf("%.2f MB", $row[0]); 19221 last; 19222 } 19223 $sth->finish(); 19224 19225 return $mb_size; 19226} 19227 19228=head2 _get_objects 19229 19230This function retrieves all object the Oracle information 19231except SYNONYM and temporary objects 19232 19233=cut 19234 19235sub _get_objects 19236{ 19237 my $self = shift; 19238 19239 return Ora2Pg::MySQL::_get_objects($self) if ($self->{is_mysql}); 19240 19241 my $oraver = ''; 19242 # OWNER|OBJECT_NAME|SUBOBJECT_NAME|OBJECT_ID|DATA_OBJECT_ID|OBJECT_TYPE|CREATED|LAST_DDL_TIME|TIMESTAMP|STATUS|TEMPORARY|GENERATED|SECONDARY 19243 my $sql = "SELECT OBJECT_NAME,OBJECT_TYPE,STATUS FROM $self->{prefix}_OBJECTS WHERE TEMPORARY='N' AND GENERATED='N' AND SECONDARY='N' AND OBJECT_TYPE <> 'SYNONYM'"; 19244 if ($self->{schema}) { 19245 $sql .= " AND OWNER='$self->{schema}'"; 19246 } else { 19247 $sql .= " AND OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 19248 } 19249 my @infos = (); 19250 my $sth = $self->{dbh}->prepare( $sql ) or return undef; 19251 push(@infos, join('|', @{$sth->{NAME}})); 19252 $sth->execute or return undef; 19253 my %count = (); 19254 while ( my @row = $sth->fetchrow()) 19255 { 19256 my $valid = ($row[2] eq 'VALID') ? 0 : 1; 19257 push(@{$infos{$row[1]}}, { ( name => $row[0], invalid => $valid ) }); 19258 $count{$row[1]}{$valid}++; 19259 } 19260 $sth->finish(); 19261 19262 if ($self->{debug}) 19263 { 19264 foreach my $k (sort keys %count) 19265 { 19266 print STDERR "\tFound $count{$k}{0} valid and ", ($count{$k}{1}||0), " invalid object $k\n"; 19267 } 19268 } 19269 19270 return %infos; 19271} 19272 19273sub _list_all_funtions 19274{ 19275 my $self = shift; 19276 19277 return Ora2Pg::MySQL::_list_all_funtions($self) if ($self->{is_mysql}); 19278 19279 my $oraver = ''; 19280 # OWNER|OBJECT_NAME|PROCEDURE_NAME|OBJECT_TYPE 19281 my $sql = qq{ 19282SELECT p.owner,p.object_name,p.procedure_name,o.object_type 19283 FROM $self->{prefix}_PROCEDURES p 19284 JOIN $self->{prefix}_OBJECTS o ON p.owner = o.owner 19285 AND p.object_name = o.object_name 19286 WHERE o.object_type IN ('PROCEDURE','PACKAGE','FUNCTION') 19287 AND o.TEMPORARY='N' AND o.GENERATED='N' AND o.SECONDARY='N' 19288 AND o.STATUS = 'VALID' 19289}; 19290 if ($self->{db_version} =~ /Release 8/) { 19291 $sql = qq{ 19292SELECT p.owner,p.object_name,p.procedure_name,o.object_type 19293 FROM $self->{prefix}_PROCEDURES p, $self->{prefix}_OBJECTS o 19294 WHERE o.object_type IN ('PROCEDURE','PACKAGE','FUNCTION') 19295 AND p.owner = o.owner AND p.object_name = o.object_name 19296 AND o.TEMPORARY='N' AND o.GENERATED='N' AND o.SECONDARY='N' 19297 AND o.STATUS = 'VALID' 19298}; 19299 } 19300 if ($self->{schema}) { 19301 $sql .= " AND p.OWNER='$self->{schema}'"; 19302 } else { 19303 $sql .= " AND p.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 19304 } 19305 my @infos = (); 19306 my $sth = $self->{dbh}->prepare( $sql ) or return undef; 19307 $sth->execute or return undef; 19308 while ( my @row = $sth->fetchrow()) 19309 { 19310 next if (($row[3] eq 'PACKAGE') && !$row[2]); 19311 if ( $row[2] ) 19312 { 19313 # package_name.fct_name 19314 push(@infos, lc("$row[1].$row[2]")); 19315 } 19316 elsif ( $self->{export_schema} ) 19317 { 19318 # package_name.fct_name 19319 push(@infos, lc("$row[0].$row[1]")); 19320 } 19321 else 19322 { 19323 # owner.fct_name 19324 push(@infos, lc($row[1])); 19325 } 19326 } 19327 $sth->finish(); 19328 19329 return @infos; 19330} 19331 19332=head2 _schema_list 19333 19334This function retrieves all Oracle-native user schema. 19335 19336Returns a handle to a DB query statement. 19337 19338=cut 19339 19340sub _schema_list 19341{ 19342 my $self = shift; 19343 19344 return Ora2Pg::MySQL::_schema_list($self) if ($self->{is_mysql}); 19345 19346 my $sql = "SELECT DISTINCT OWNER FROM $self->{prefix}_TABLES WHERE OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "') ORDER BY OWNER"; 19347 19348 my $sth = $self->{dbh}->prepare( $sql ) or return undef; 19349 $sth->execute or return undef; 19350 $sth; 19351} 19352 19353=head2 _table_exists 19354 19355This function return the table name if the given table exists 19356else returns a empty string. 19357 19358=cut 19359 19360sub _table_exists 19361{ 19362 my ($self, $schema, $table) = @_; 19363 19364 return Ora2Pg::MySQL::_table_exists($self, $schema, $table) if ($self->{is_mysql}); 19365 19366 my $ret = ''; 19367 19368 my $sql = "SELECT TABLE_NAME FROM $self->{prefix}_TABLES WHERE OWNER = '$schema' AND TABLE_NAME = '$table'"; 19369 my $sth = $self->{dbh}->prepare( $sql ) or return undef; 19370 $sth->execute or return undef; 19371 while ( my @row = $sth->fetchrow()) { 19372 $ret = $row[0]; 19373 } 19374 $sth->finish(); 19375 return $ret; 19376} 19377 19378 19379 19380=head2 _get_largest_tables 19381 19382This function retrieves the list of largest table of the Oracle database in MB 19383 19384=cut 19385 19386sub _get_largest_tables 19387{ 19388 my $self = shift; 19389 19390 return Ora2Pg::MySQL::_get_largest_tables($self) if ($self->{is_mysql}); 19391 19392 my %table_size = (); 19393 19394 my $prefix = 'USER'; 19395 my $owner_segment = ''; 19396 $owner_segment = " AND A.OWNER='$self->{schema}'"; 19397 if (!$self->{user_grants}) { 19398 $prefix = 'DBA'; 19399 $owner_segment = ' AND S.OWNER=A.OWNER'; 19400 } 19401 19402 my $sql = "SELECT * FROM ( SELECT S.SEGMENT_NAME, ROUND(S.BYTES/1024/1024) SIZE_MB FROM ${prefix}_SEGMENTS S JOIN $self->{prefix}_TABLES A ON (S.SEGMENT_NAME=A.TABLE_NAME$owner_segment) WHERE S.SEGMENT_TYPE LIKE 'TABLE%' AND A.SECONDARY = 'N'"; 19403 if ($self->{db_version} =~ /Release 8/) { 19404 $sql = "SELECT * FROM ( SELECT A.SEGMENT_NAME, ROUND(A.BYTES/1024/1024) SIZE_MB FROM ${prefix}_SEGMENTS A WHERE A.SEGMENT_TYPE LIKE 'TABLE%'"; 19405 } 19406 if ($self->{db_version} !~ /Release 8/ || !$self->{user_grants}) { 19407 if ($self->{schema}) { 19408 $sql .= " AND A.OWNER='$self->{schema}'"; 19409 } else { 19410 $sql .= " AND A.OWNER NOT IN ('" . join("','", @{$self->{sysusers}}) . "')"; 19411 } 19412 } 19413 if ($self->{db_version} =~ /Release 8/) { 19414 $sql .= $self->limit_to_objects('TABLE', 'A.SEGMENT_NAME'); 19415 } else { 19416 $sql .= $self->limit_to_objects('TABLE', 'A.TABLE_NAME'); 19417 } 19418 19419 if ($self->{db_version} =~ /Release 8/) { 19420 $sql .= " ORDER BY A.BYTES DESC, A.SEGMENT_NAME ASC) WHERE ROWNUM <= $self->{top_max}"; 19421 } else { 19422 $sql .= " ORDER BY S.BYTES DESC, S.SEGMENT_NAME ASC) WHERE ROWNUM <= $self->{top_max}"; 19423 } 19424 19425 my $sth = $self->{dbh}->prepare( $sql ) or return undef; 19426 $sth->execute(@{$self->{query_bind_params}}) or return undef; 19427 while ( my @row = $sth->fetchrow()) { 19428 $table_size{$row[0]} = $row[1]; 19429 } 19430 $sth->finish(); 19431 19432 return %table_size; 19433} 19434 19435 19436=head2 _get_encoding 19437 19438This function retrieves the Oracle database encoding 19439 19440Returns a handle to a DB query statement. 19441 19442=cut 19443 19444sub _get_encoding 19445{ 19446 my ($self, $dbh) = @_; 19447 19448 my $sql = "SELECT * FROM NLS_DATABASE_PARAMETERS"; 19449 my $sth = $dbh->prepare($sql) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19450 $sth->execute() or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19451 my $language = ''; 19452 my $territory = ''; 19453 my $charset = ''; 19454 my $nls_timestamp_format = ''; 19455 my $nls_date_format = ''; 19456 while ( my @row = $sth->fetchrow()) { 19457 if ($row[0] eq 'NLS_LANGUAGE') { 19458 $language = $row[1]; 19459 } elsif ($row[0] eq 'NLS_TERRITORY') { 19460 $territory = $row[1]; 19461 } elsif ($row[0] eq 'NLS_CHARACTERSET') { 19462 $charset = $row[1]; 19463 } elsif ($row[0] eq 'NLS_TIMESTAMP_FORMAT') { 19464 $nls_timestamp_format = $row[1]; 19465 } elsif ($row[0] eq 'NLS_DATE_FORMAT') { 19466 $nls_date_format = $row[1]; 19467 } 19468 } 19469 $sth->finish(); 19470 $sql = "SELECT * FROM NLS_SESSION_PARAMETERS"; 19471 $sth = $dbh->prepare($sql) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19472 $sth->execute() or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19473 my $ora_encoding = ''; 19474 while ( my @row = $sth->fetchrow()) { 19475 #$self->logit("SESSION PARAMETERS: $row[0] $row[1]\n", 1); 19476 if ($row[0] eq 'NLS_LANGUAGE') { 19477 $language = $row[1]; 19478 } elsif ($row[0] eq 'NLS_TERRITORY') { 19479 $territory = $row[1]; 19480 } elsif ($row[0] eq 'NLS_TIMESTAMP_FORMAT') { 19481 $nls_timestamp_format = $row[1]; 19482 } elsif ($row[0] eq 'NLS_DATE_FORMAT') { 19483 $nls_date_format = $row[1]; 19484 } 19485 } 19486 $sth->finish(); 19487 19488 $ora_encoding = $language . '_' . $territory . '.' . $charset; 19489 my $pg_encoding = auto_set_encoding($charset); 19490 19491 return ($ora_encoding, $charset, $pg_encoding, $nls_timestamp_format, $nls_date_format); 19492} 19493 19494 19495=head2 _compile_schema 19496 19497This function force Oracle database to compile a schema and validate or 19498invalidate PL/SQL code. 19499 19500When parameter $schema is the name of a schema, only this schema is recompiled 19501When parameter $schema is equal to 1 and SCHEMA directive is set, only this schema is recompiled 19502When parameter $schema is equal to 1 and SCHEMA directive is unset, all schema will be recompiled 19503 19504=cut 19505 19506 19507sub _compile_schema 19508{ 19509 my ($self, $schema) = @_; 19510 19511 my @to_compile = (); 19512 19513 if ($schema and ($schema =~ /[a-z]/i)) { 19514 push(@to_compile, $schema); 19515 } elsif ($schema and $self->{schema}) { 19516 push(@to_compile, $self->{schema}); 19517 } elsif ($schema) { 19518 my $sth = $self->_schema_list() or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 19519 while ( my @row = $sth->fetchrow()) { 19520 push(@to_compile, $row[0]); 19521 } 19522 $sth->finish(); 19523 } 19524 19525 if ($#to_compile >= 0) { 19526 foreach my $schm (@to_compile) { 19527 $self->logit("Force Oracle to compile schema $schm before code extraction\n", 1); 19528 my $sth = $self->{dbh}->do("BEGIN\nDBMS_UTILITY.compile_schema(schema => '$schm', compile_all => FALSE);\nEND;") 19529 or $self->logit("FATAL: " . $self->{dbh}->errstr . "\n", 0, 1); 19530 } 19531 } 19532 19533} 19534 19535 19536=head2 _datetime_format 19537 19538This function force Oracle database to format the time correctly 19539 19540=cut 19541 19542sub _datetime_format 19543{ 19544 my ($self, $dbh) = @_; 19545 19546 $dbh = $self->{dbh} if (!$dbh); 19547 19548 if ($self->{enable_microsecond}) { 19549 my $dim = 6; 19550 $dim = '' if ($self->{db_version} =~ /Release [89]/); 19551 my $sth = $dbh->do("ALTER SESSION SET NLS_TIMESTAMP_FORMAT='YYYY-MM-DD HH24:MI:SS.FF$dim'") or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19552 } else { 19553 my $sth = $dbh->do("ALTER SESSION SET NLS_TIMESTAMP_FORMAT='YYYY-MM-DD HH24:MI:SS'") or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19554 } 19555 my $sth = $dbh->do("ALTER SESSION SET NLS_DATE_FORMAT='YYYY-MM-DD HH24:MI:SS'") or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19556 if ($self->{enable_microsecond}) { 19557 my $dim = 6; 19558 $dim = '' if ($self->{db_version} =~ /Release [89]/); 19559 $sth = $dbh->do("ALTER SESSION SET NLS_TIMESTAMP_TZ_FORMAT='YYYY-MM-DD HH24:MI:SS.FF$dim TZH:TZM'") or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19560 } else { 19561 $sth = $dbh->do("ALTER SESSION SET NLS_TIMESTAMP_TZ_FORMAT='YYYY-MM-DD HH24:MI:SS TZH:TZM'") or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19562 } 19563} 19564 19565sub _numeric_format 19566{ 19567 my ($self, $dbh) = @_; 19568 19569 $dbh = $self->{dbh} if (!$dbh); 19570 19571 my $sth = $dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'") or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19572} 19573 19574sub _ora_initial_command 19575{ 19576 my ($self, $dbh) = @_; 19577 19578 return if ($#{ $self->{ora_initial_command} } < 0); 19579 19580 $dbh = $self->{dbh} if (!$dbh); 19581 19582 19583 # Lookup if the user have provided some sessions settings 19584 foreach my $q (@{$self->{ora_initial_command}}) { 19585 next if (!$q); 19586 $self->logit("DEBUG: executing initial command to Oracle: $q\n", 1); 19587 my $sth = $dbh->do($q) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19588 } 19589 19590} 19591 19592sub _pg_initial_command 19593{ 19594 my ($self, $dbh) = @_; 19595 19596 return if ($#{ $self->{pg_initial_command} } < 0); 19597 19598 $dbh = $self->{dbhdest} if (!$dbh); 19599 19600 # Lookup if the user have provided some sessions settings 19601 foreach my $q (@{$self->{pg_initial_command}}) { 19602 $self->logit("DEBUG: executing initial command to PostgreSQL: $q\n", 1); 19603 my $sth = $dbh->do($q) or $self->logit("FATAL: " . $dbh->errstr . "\n", 0, 1); 19604 } 19605 19606} 19607 19608 19609 19610=head2 multiprocess_progressbar 19611 19612This function is used to display a progress bar during object scanning. 19613 19614=cut 19615 19616sub multiprocess_progressbar 19617{ 19618 my ($self) = @_; 19619 19620 $self->logit("Starting progressbar writer process\n", 1); 19621 19622 $0 = 'ora2pg logger'; 19623 19624 $| = 1; 19625 19626 my $DEBUG_PBAR = 0; 19627 my $width = 25; 19628 my $char = '='; 19629 my $kind = 'rows'; 19630 my $table_count = 0; 19631 my $table = ''; 19632 my $global_start_time = 0; 19633 my $total_rows = 0; 19634 my %table_progress = (); 19635 my $global_line_counter = 0; 19636 19637 my $refresh_time = 3; #Update progress bar each 3 seconds 19638 my $last_refresh = time(); 19639 my $refresh_rows = 0; 19640 19641 # Terminate the process when we doesn't read the complete file but must exit 19642 local $SIG{USR1} = sub 19643 { 19644 if ($global_line_counter) 19645 { 19646 my $end_time = time(); 19647 my $dt = $end_time - $global_start_time; 19648 $dt ||= 1; 19649 my $rps = int($global_line_counter / $dt); 19650 print STDERR $self->progress_bar($global_line_counter, $total_rows, 25, '=', 'rows', "on total estimated data ($dt sec., avg: $rps tuples/sec)"), "\n"; 19651 } 19652 exit 0; 19653 }; 19654 19655 $pipe->reader(); 19656 while ( my $r = <$pipe> ) 19657 { 19658 chomp($r); 19659 # When quit is received, then exit immediatly 19660 last if ($r eq 'quit'); 19661 19662 # Store data export start time 19663 if ($r =~ /^GLOBAL EXPORT START TIME: (\d+)/) 19664 { 19665print STDERR "GLOBAL EXPORT START TIME: $1\n" if ($DEBUG_PBAR); 19666 $global_start_time = $1; 19667 } 19668 # Store total number of tuples exported 19669 elsif ($r =~ /^GLOBAL EXPORT ROW NUMBER: (\d+)/) 19670 { 19671print STDERR "GLOBAL EXPORT ROW NUMBER: $1\n" if ($DEBUG_PBAR); 19672 $total_rows = $1; 19673 } 19674 # A table export is starting (can be called multiple time with -J option) 19675 elsif ($r =~ /TABLE EXPORT IN PROGESS: (.*?), start: (\d+), rows (\d+)/) 19676 { 19677print STDERR "TABLE EXPORT IN PROGESS: $1, start: $2, rows $3\n" if ($DEBUG_PBAR); 19678 $table_progress{$1}{start} = $2 if (!exists $table_progress{$1}{start}); 19679 $table_progress{$1}{rows} = $3 if (!exists $table_progress{$1}{rows}); 19680 } 19681 # A table export is ending 19682 elsif ($r =~ /TABLE EXPORT ENDED: (.*?), end: (\d+), rows (\d+)/) 19683 { 19684print STDERR "TABLE EXPORT ENDED: $1, end: $2, rows $3\n" if ($DEBUG_PBAR); 19685 # Store timestamp at end of table export 19686 $table_progress{$1}{end} = $2; 19687 19688 # Stores total number of rows exported when we do not used chunk of data 19689 if (!exists $table_progress{$1}{progress}) 19690 { 19691 $table_progress{$1}{progress} = $3; 19692 $global_line_counter += $3; 19693 } 19694 19695 # Display table progression 19696 my $dt = $table_progress{$1}{end} - $table_progress{$1}{start}; 19697 my $rps = int($table_progress{$1}{progress}/ ($dt||1)); 19698 print STDERR $self->progress_bar($table_progress{$1}{progress}, $table_progress{$1}{rows}, 25, '=', 'rows', "Table $1 ($dt sec., $rps recs/sec)"), "\n"; 19699 # Display global export progression 19700 my $cur_time = time(); 19701 $dt = $cur_time - $global_start_time; 19702 $rps = int($global_line_counter/ ($dt || 1)); 19703 print STDERR $self->progress_bar($global_line_counter, $total_rows, 25, '=', 'total rows', "- ($dt sec., avg: $rps recs/sec), $1 in progress."), "\r"; 19704 $last_refresh = $cur_time; 19705 } 19706 # A chunk of DATA_LIMIT row is exported 19707 elsif ($r =~ /CHUNK \d+ DUMPED: (.*?), time: (\d+), rows (\d+)/) 19708 { 19709print STDERR "CHUNK X DUMPED: $1, time: $2, rows $3\n" if ($DEBUG_PBAR); 19710 $table_progress{$1}{progress} += $3; 19711 $global_line_counter += $3; 19712 my $cur_time = time(); 19713 if ($cur_time >= ($last_refresh + $refresh_time)) 19714 { 19715 my $dt = $cur_time - $global_start_time; 19716 my $rps = int($global_line_counter/ ($dt || 1)); 19717 print STDERR $self->progress_bar($global_line_counter, $total_rows, 25, '=', 'total rows', "- ($dt sec., avg: $rps recs/sec), $1 in progress."), "\r"; 19718 $last_refresh = $cur_time; 19719 } 19720 } 19721 # A table export is ending 19722 elsif ($r =~ /TABLE EXPORT ENDED: (.*?), end: (\d+), report all parts/) 19723 { 19724print STDERR "TABLE EXPORT ENDED: $1, end: $2, report all parts\n" if ($DEBUG_PBAR); 19725 # Store timestamp at end of table export 19726 $table_progress{$1}{end} = $2; 19727 19728 # Get all statistics from multiple Oracle query 19729 for (my $i = 0; $i < $self->{oracle_copies}; $i++) { 19730 $table_progress{$1}{start} = $table_progress{"$1-part-$i"}{start} if (!exists $table_progress{$1}{start}); 19731 $table_progress{$1}{rows} = $table_progress{"$1-part-$i"}{rows}; 19732 delete $table_progress{"$1-part-$i"}; 19733 } 19734 19735 # Stores total number of rows exported when we do not used chunk of data 19736 if (!exists $table_progress{$1}{progress}) { 19737 $table_progress{$1}{progress} = $3; 19738 $global_line_counter += $3; 19739 } 19740 19741 # Display table progression 19742 my $dt = $table_progress{$1}{end} - $table_progress{$1}{start}; 19743 my $rps = int($table_progress{$1}{rows}/ ($dt||1)); 19744 print STDERR $self->progress_bar($table_progress{$1}{rows}, $table_progress{$1}{rows}, 25, '=', 'rows', "Table $1 ($dt sec., $rps recs/sec)"), "\n"; 19745 } 19746 else 19747 { 19748 print "PROGRESS BAR ERROR (unrecognized line sent to pipe): $r\n"; 19749 } 19750 19751 } 19752 19753 if ($global_line_counter) 19754 { 19755 my $end_time = time(); 19756 my $dt = $end_time - $global_start_time; 19757 $dt ||= 1; 19758 my $rps = int($global_line_counter / $dt); 19759 print STDERR $self->progress_bar($global_line_counter, $total_rows, 25, '=', 'rows', "on total estimated data ($dt sec., avg: $rps tuples/sec)"), "\n"; 19760 } 19761 19762 exit 0; 19763} 19764 19765 19766=head2 progress_bar 19767 19768This function is used to display a progress bar during object scanning. 19769 19770=cut 19771 19772sub progress_bar 19773{ 19774 my ($self, $got, $total, $width, $char, $kind, $msg) = @_; 19775 19776 $width ||= 25; 19777 $char ||= '='; 19778 $kind ||= 'rows'; 19779 my $num_width = length $total; 19780 my $ratio = 1; 19781 if ($total > 0) { 19782 $ratio = $got / +$total; 19783 } 19784 my $len = (($width - 1) * $ratio); 19785 $len = $width - 1 if ($len >= $width); 19786 my $str = sprintf( 19787 "[%-${width}s] %${num_width}s/%s $kind (%.1f%%) $msg", 19788 $char x $len . '>', 19789 $got, $total, 100 * $ratio 19790 ); 19791 $len = length($str); 19792 $self->{prgb_len} ||= $len; 19793 if ($len < $self->{prgb_len}) { 19794 $str .= ' ' x ($self->{prgb_len} - $len); 19795 } 19796 $self->{prgb_len} = $len; 19797 19798 return $str; 19799} 19800 19801=head2 auto_set_encoding 19802 19803This function is used to find the PostgreSQL charset corresponding to the 19804Oracle NLS_LANG value 19805 19806=cut 19807 19808sub auto_set_encoding 19809{ 19810 my $oracle_charset = shift; 19811 19812 my %ENCODING = ( 19813 "AL32UTF8" => "UTF8", 19814 "JA16EUC" => "EUC_JP", 19815 "JA16SJIS" => "EUC_JIS_2004", 19816 "ZHT32EUC" => "EUC_TW", 19817 "CL8ISO8859P5" => "ISO_8859_5", 19818 "AR8ISO8859P6" => "ISO_8859_6", 19819 "EL8ISO8859P7" => "ISO_8859_7", 19820 "IW8ISO8859P8" => "ISO_8859_8", 19821 "CL8KOI8R" => "KOI8R", 19822 "CL8KOI8U" => "KOI8U", 19823 "WE8ISO8859P1" => "LATIN1", 19824 "EE8ISO8859P2" => "LATIN2", 19825 "SE8ISO8859P3" => "LATIN3", 19826 "NEE8ISO8859P4"=> "LATIN4", 19827 "WE8ISO8859P9" => "LATIN5", 19828 "NE8ISO8859P10"=> "LATIN6", 19829 "BLT8ISO8859P13"=> "LATIN7", 19830 "CEL8ISO8859P14"=> "LATIN8", 19831 "WE8ISO8859P15" => "LATIN9", 19832 "RU8PC866" => "WIN866", 19833 "EE8MSWIN1250" => "WIN1250", 19834 "CL8MSWIN1251" => "WIN1251", 19835 "WE8MSWIN1252" => "WIN1252", 19836 "EL8MSWIN1253" => "WIN1253", 19837 "TR8MSWIN1254" => "WIN1254", 19838 "IW8MSWIN1255" => "WIN1255", 19839 "AR8MSWIN1256" => "WIN1256", 19840 "BLT8MSWIN1257"=> "WIN1257" 19841 ); 19842 19843 foreach my $k (keys %ENCODING) { 19844 return $ENCODING{$k} if (uc($oracle_charset) eq $k); 19845 } 19846 19847 return ''; 19848} 19849 19850# Construct a query to exclude or only include some object wanted by the user 19851# following the ALLOW and EXCLUDE configuration directive. The filter returned 19852# must be used with the bind parameters stored in the @{$self->{query_bind_params}} 19853# when calling the execute() function after the call of prepare(). 19854sub limit_to_objects 19855{ 19856 my ($self, $obj_type, $column) = @_; 19857 19858 # With reports we don't have object name limitation 19859 return if ($self->{type} eq 'SHOW_REPORT'); 19860 19861 my $str = ''; 19862 $obj_type ||= $self->{type}; 19863 $column ||= 'TABLE_NAME'; 19864 19865 my @cols = split(/\|/, $column); 19866 my @arr_type = split(/\|/, $obj_type); 19867 my @done = (); 19868 my $has_limitation = 0; 19869 $self->{query_bind_params} = (); 19870 19871 for (my $i = 0; $i <= $#arr_type; $i++) 19872 { 19873 my $colname = $cols[0]; 19874 $colname = $cols[$i] if (($#cols >= $i) && $cols[$i]); 19875 19876 # Do not double exclusion/inclusion when column name is the same 19877 next if (grep(/^$colname$/, @done) && ! exists $self->{limited}{$arr_type[$i]}); 19878 push(@done, $colname); 19879 19880 my $have_lookahead = 0; 19881 if ($#{$self->{limited}{$arr_type[$i]}} >= 0) 19882 { 19883 $str .= ' AND ('; 19884 if ($self->{db_version} =~ /Release [89]/) 19885 { 19886 for (my $j = 0; $j <= $#{$self->{limited}{$arr_type[$i]}}; $j++) 19887 { 19888 if ($self->{limited}{$arr_type[$i]}->[$j] =~ /^\!/) 19889 { 19890 $have_lookahead = 1; 19891 next; 19892 } 19893 $str .= "upper($colname) LIKE ?"; 19894 push(@{$self->{query_bind_params}}, uc($self->{limited}{$arr_type[$i]}->[$j])); 19895 if ($j < $#{$self->{limited}{$arr_type[$i]}}) { 19896 $str .= " OR "; 19897 } 19898 } 19899 $str =~ s/ OR $//; 19900 } 19901 else 19902 { 19903 for (my $j = 0; $j <= $#{$self->{limited}{$arr_type[$i]}}; $j++) 19904 { 19905 if ($self->{limited}{$arr_type[$i]}->[$j] =~ /^\!/) 19906 { 19907 $have_lookahead = 1; 19908 next; 19909 } 19910 if ($self->{is_mysql}) { 19911 $str .= "upper($colname) RLIKE ?" ; 19912 } else { 19913 $str .= "REGEXP_LIKE(upper($colname), ?)" ; 19914 } 19915 push(@{$self->{query_bind_params}}, uc("\^$self->{limited}{$arr_type[$i]}->[$j]\$")); 19916 if ($j < $#{$self->{limited}{$arr_type[$i]}}) { 19917 $str .= " OR "; 19918 } 19919 } 19920 $str =~ s/ OR $//; 19921 } 19922 $str .= ')'; 19923 $str =~ s/ AND \(\)//; 19924 19925 if ($have_lookahead) 19926 { 19927 if ($self->{db_version} =~ /Release [89]/) 19928 { 19929 for (my $j = 0; $j <= $#{$self->{limited}{$arr_type[$i]}}; $j++) 19930 { 19931 next if ($self->{limited}{$arr_type[$i]}->[$j] !~ /^\!(.+)/); 19932 $str .= " AND upper($colname) NOT LIKE ?"; 19933 push(@{$self->{query_bind_params}}, uc($1)); 19934 } 19935 } 19936 else 19937 { 19938 for (my $j = 0; $j <= $#{$self->{limited}{$arr_type[$i]}}; $j++) 19939 { 19940 next if ($self->{limited}{$arr_type[$i]}->[$j] !~ /^\!(.+)/); 19941 if ($self->{is_mysql}) { 19942 $str .= " AND upper($colname) NOT RLIKE ?" ; 19943 } else { 19944 $str .= " AND NOT REGEXP_LIKE(upper($colname), ?)" ; 19945 } 19946 push(@{$self->{query_bind_params}}, uc("\^$1\$")); 19947 } 19948 } 19949 19950 } 19951 $has_limitation = 1; 19952 19953 } 19954 elsif ($#{$self->{excluded}{$arr_type[$i]}} >= 0) 19955 { 19956 if ($self->{db_version} =~ /Release [89]/) 19957 { 19958 $str .= ' AND ('; 19959 for (my $j = 0; $j <= $#{$self->{excluded}{$arr_type[$i]}}; $j++) 19960 { 19961 $str .= "upper($colname) NOT LIKE ?" ; 19962 push(@{$self->{query_bind_params}}, uc($self->{excluded}{$arr_type[$i]}->[$j])); 19963 if ($j < $#{$self->{excluded}{$arr_type[$i]}}) { 19964 $str .= " AND "; 19965 } 19966 } 19967 $str .= ')'; 19968 } 19969 else 19970 { 19971 $str .= ' AND ('; 19972 for (my $j = 0; $j <= $#{$self->{excluded}{$arr_type[$i]}}; $j++) 19973 { 19974 if ($self->{is_mysql}) { 19975 $str .= "upper($colname) NOT RLIKE ?" ; 19976 } else { 19977 $str .= "NOT REGEXP_LIKE(upper($colname), ?)" ; 19978 } 19979 push(@{$self->{query_bind_params}}, uc("\^$self->{excluded}{$arr_type[$i]}->[$j]\$")); 19980 if ($j < $#{$self->{excluded}{$arr_type[$i]}}) { 19981 $str .= " AND "; 19982 } 19983 } 19984 $str .= ')'; 19985 } 19986 } 19987 19988 # Always exclude unwanted tables 19989 if (!$self->{is_mysql} && !$has_limitation && ($arr_type[$i] =~ /TABLE|SEQUENCE|VIEW|TRIGGER|TYPE|SYNONYM/)) 19990 { 19991 if ($self->{db_version} =~ /Release [89]/) 19992 { 19993 $str .= ' AND ('; 19994 foreach my $t (@EXCLUDED_TABLES_8I) 19995 { 19996 $str .= " AND upper($colname) NOT LIKE ?"; 19997 push(@{$self->{query_bind_params}}, uc($t)); 19998 } 19999 $str .= ')'; 20000 } 20001 else 20002 { 20003 $str .= ' AND ( '; 20004 for (my $j = 0; $j <= $#EXCLUDED_TABLES; $j++) 20005 { 20006 if ($self->{is_mysql}) { 20007 $str .= " upper($colname) NOT RLIKE ?" ; 20008 } else { 20009 $str .= " NOT REGEXP_LIKE(upper($colname), ?)" ; 20010 } 20011 push(@{$self->{query_bind_params}}, uc("\^$EXCLUDED_TABLES[$j]\$")); 20012 if ($j < $#EXCLUDED_TABLES){ 20013 $str .= " AND "; 20014 } 20015 } 20016 $str .= ')'; 20017 } 20018 } 20019 } 20020 20021 $str =~ s/ AND \( AND/ AND \(/g; 20022 $str =~ s/ AND \(\)//g; 20023 $str =~ s/ OR \(\)//g; 20024 20025 return uc($str); 20026} 20027 20028 20029# Preload the bytea array at lib init 20030BEGIN 20031{ 20032 build_escape_bytea(); 20033} 20034 20035 20036=head2 _lookup_check_constraint 20037 20038This function return an array of the SQL code of the check constraints of a table 20039 20040=cut 20041 20042sub _lookup_check_constraint 20043{ 20044 my ($self, $table, $check_constraint, $field_name, $nonotnull) = @_; 20045 20046 my @chk_constr = (); 20047 20048 my $tbsaved = $table; 20049 $table = $self->get_replaced_tbname($table); 20050 20051 # Set the check constraint definition 20052 foreach my $k (keys %{$check_constraint->{constraint}}) 20053 { 20054 my $chkconstraint = $check_constraint->{constraint}->{$k}{condition}; 20055 next if (!$chkconstraint); 20056 my $skip_create = 0; 20057 if (exists $check_constraint->{notnull}) { 20058 foreach my $col (@{$check_constraint->{notnull}}) { 20059 $skip_create = 1, last if (lc($chkconstraint) eq lc("\"$col\" IS NOT NULL")); 20060 } 20061 } 20062 if (!$skip_create) 20063 { 20064 if (exists $self->{replaced_cols}{"\L$tbsaved\E"} && $self->{replaced_cols}{"\L$tbsaved\E"}) 20065 { 20066 foreach my $c (keys %{$self->{replaced_cols}{"\L$tbsaved\E"}}) 20067 { 20068 $chkconstraint =~ s/"$c"/"$self->{replaced_cols}{"\L$tbsaved\E"}{"\L$c\E"}"/gsi; 20069 $chkconstraint =~ s/\b$c\b/$self->{replaced_cols}{"\L$tbsaved\E"}{"\L$c\E"}/gsi; 20070 } 20071 } 20072 if ($self->{plsql_pgsql}) { 20073 $chkconstraint = Ora2Pg::PLSQL::convert_plsql_code($self, $chkconstraint); 20074 } 20075 next if ($nonotnull && ($chkconstraint =~ /IS NOT NULL/)); 20076 foreach my $c (@$field_name) { 20077 # Force lower case 20078 my $ret = $self->quote_object_name($c); 20079 $chkconstraint =~ s/"$c"/$ret/igs; 20080 $chkconstraint =~ s/\b$c\b/$ret/igs; 20081 } 20082 $k = $self->quote_object_name($k); 20083 my $validate = ''; 20084 $validate = ' NOT VALID' if ($check_constraint->{constraint}->{$k}{validate} eq 'NOT VALIDATED'); 20085 push(@chk_constr, "ALTER TABLE $table ADD CONSTRAINT $k CHECK ($chkconstraint)$validate;\n"); 20086 } 20087 } 20088 20089 return @chk_constr; 20090} 20091 20092=head2 _count_check_constraint 20093 20094This function return the number of check constraints on a given table 20095excluding CHECK IS NOT NULL constraint. 20096 20097=cut 20098sub _count_check_constraint 20099{ 20100 my ($self, $check_constraint) = @_; 20101 20102 my $num_chk_constr = 0; 20103 20104 # Set the check constraint definition 20105 foreach my $k (keys %{$check_constraint->{constraint}}) 20106 { 20107 my $chkconstraint = $check_constraint->{constraint}->{$k}{condition}; 20108 next if (!$chkconstraint); 20109 my $skip_create = 0; 20110 if (exists $check_constraint->{notnull}) 20111 { 20112 foreach my $col (@{$check_constraint->{notnull}}) 20113 { 20114 $skip_create = 1, last if (lc($chkconstraint) eq lc("\"$col\" IS NOT NULL")); 20115 } 20116 } 20117 if (!$skip_create) 20118 { 20119 $num_chk_constr++; 20120 } 20121 } 20122 20123 return $num_chk_constr; 20124} 20125 20126 20127 20128=head2 _lookup_package 20129 20130This function is used to look at Oracle PACKAGE code to estimate the cost 20131of a migration. It return an hash: function name => function code 20132 20133=cut 20134 20135sub _lookup_package 20136{ 20137 my ($self, $plsql) = @_; 20138 20139 my $content = ''; 20140 my %infos = (); 20141 if ($plsql =~ /(?:CREATE|CREATE OR REPLACE)?\s*(?:EDITIONABLE|NONEDITIONABLE)?\s*PACKAGE\s+BODY\s*([^\s\%]+)((?:\s*\%ORA2PG_COMMENT\d+\%)*\s*(?:AS|IS))\s*(.*)/is) 20142 { 20143 my $pname = $1; 20144 my $type = $2; 20145 $content = $3; 20146 $pname =~ s/"//g; 20147 $self->logit("Looking at package $pname...\n", 1); 20148 $content =~ s/\bEND[^;]*;$//is; 20149 my @functions = $self->_extract_functions($content); 20150 foreach my $f (@functions) 20151 { 20152 next if (!$f); 20153 my %fct_detail = $self->_lookup_function($f, $pname); 20154 next if (!exists $fct_detail{name}); 20155 $fct_detail{name} =~ s/^.*\.//; 20156 $fct_detail{name} =~ s/"//g; 20157 %{$infos{"$pname.$fct_detail{name}"}} = %fct_detail; 20158 } 20159 } 20160 20161 return %infos; 20162} 20163 20164# Returns 1 if the function match a EXCLUDED clause, 0 otherwise 20165sub excluded_functions 20166{ 20167 my ($self, $fct_name) = @_; 20168 20169 my @done = (); 20170 20171 # Case where there is nothing to do here 20172 return 0 if (!$fct_name || (!exists $self->{excluded}{FUNCTION} && !exists $self->{excluded}{PROCEDURE})); 20173 push(@done, $fct_name); 20174 20175 foreach my $type ('FUNCTION', 'PROCEDURE') 20176 { 20177 for (my $j = 0; $j <= $#{$self->{excluded}{$type}}; $j++) 20178 { 20179 if ($self->{excluded}{$type}->[$j] =~ /^!$fct_name$/i) { 20180 return 0; 20181 } 20182 elsif ($self->{excluded}{$type}->[$j] =~ /^$fct_name$/i) { 20183 return 1; 20184 } 20185 } 20186 } 20187 20188 return 0; 20189} 20190 20191=head2 _lookup_function 20192 20193This function is used to look at Oracle FUNCTION code to extract 20194all parts of a fonction 20195 20196Return a hast with the details of the function 20197 20198=cut 20199 20200sub _lookup_function 20201{ 20202 my ($self, $plsql, $pname) = @_; 20203 20204 if ($self->{is_mysql}) { 20205 return Ora2Pg::MySQL::_lookup_function($self, $plsql, $pname); 20206 } 20207 20208 my %fct_detail = (); 20209 20210 $fct_detail{func_ret_type} = 'OPAQUE'; 20211 20212 # Split data into declarative and code part 20213 ($fct_detail{declare}, $fct_detail{code}) = split(/\bBEGIN\b/i, $plsql, 2); 20214 20215 return if (!$fct_detail{code}); 20216 20217 @{$fct_detail{param_types}} = (); 20218 $fct_detail{declare} =~ s/(\b(?:FUNCTION|PROCEDURE)\s+(?:[^\s\(]+))(\s*\%ORA2PG_COMMENT\d+\%\s*)+/$2$1 /is; 20219 if ( ($fct_detail{declare} =~ s/(.*?)\b(FUNCTION|PROCEDURE)\s+([^\s\(]+)\s*(\([^\)]*\))//is) || 20220 ($fct_detail{declare} =~ s/(.*?)\b(FUNCTION|PROCEDURE)\s+([^\s\(]+)\s+(RETURN|IS|AS)/$4/is) ) 20221 { 20222 $fct_detail{before} = $1; 20223 $fct_detail{type} = uc($2); 20224 $fct_detail{name} = $3; 20225 $fct_detail{args} = $4; 20226 20227 $fct_detail{fct_name} = $3; 20228 $fct_detail{fct_name} =~ s/^[^\.]+\.//; 20229 $fct_detail{fct_name} =~ s/"//g; 20230 20231 # When the function comes from a package remove global declaration 20232 # outside comments. They have already been extracted before. 20233 if ($pname && $fct_detail{before}) { 20234 $self->_remove_comments(\$fct_detail{before}); 20235 my $cmt = ''; 20236 while ($fct_detail{before} =~ s/(\s*\%ORA2PG_COMMENT\d+\%\s*)//is) { 20237 # only keep comment 20238 $cmt .= $1; 20239 } 20240 $fct_detail{before} = $cmt; 20241 } 20242 20243 if ($fct_detail{args} =~ /\b(RETURN|IS|AS)\b/is) { 20244 $fct_detail{args} = '()'; 20245 } 20246 my $clause = ''; 20247 my $code = ''; 20248 $fct_detail{name} =~ s/"//g; 20249 20250 $fct_detail{immutable} = 1 if ($fct_detail{declare} =~ s/\bDETERMINISTIC\b//is); 20251 $fct_detail{setof} = 1 if ($fct_detail{declare} =~ s/\bPIPELINED\b//is); 20252 $fct_detail{declare} =~ s/\bDEFAULT/:=/igs; 20253 if ($fct_detail{declare} =~ s/(.*?)RETURN\s+self\s+AS RESULT IS//is) { 20254 $fct_detail{args} .= $1; 20255 $fct_detail{hasreturn} = 1; 20256 $fct_detail{func_ret_type} = 'OPAQUE'; 20257 } elsif ($fct_detail{declare} =~ s/(.*?)RETURN\s+([^\s]+)//is) { 20258 $fct_detail{args} .= $1; 20259 $fct_detail{hasreturn} = 1; 20260 $fct_detail{func_ret_type} = $self->_sql_type($2) || 'OPAQUE'; 20261 } 20262 if ($fct_detail{declare} =~ s/(.*?)(USING|AS|IS)//is) { 20263 $fct_detail{args} .= $1 if (!$fct_detail{hasreturn}); 20264 $clause = $2; 20265 } 20266 $fct_detail{args} =~ s/;.*//s; 20267 20268 if ($fct_detail{declare} =~ /LANGUAGE\s+([^\s="'><\!\(\)]+)/is) { 20269 $fct_detail{language} = $1; 20270 if ($fct_detail{declare} =~ /LIBRARY\s+([^\s="'><\!\(\)]+)/is) { 20271 $fct_detail{library} = $1; 20272 } 20273 if ($fct_detail{declare} =~ /NAME\s+"([^"]+)"/is) { 20274 $fct_detail{library_fct} = $1; 20275 } 20276 } 20277 # rewrite argument syntax 20278 # Replace alternate syntax for default value 20279 $fct_detail{args} =~ s/:=/DEFAULT/igs; 20280 # NOCOPY not supported 20281 $fct_detail{args} =~ s/\s*NOCOPY//igs; 20282 # IN OUT should be INOUT 20283 $fct_detail{args} =~ s/\bIN\s+OUT/INOUT/igs; 20284 # Remove %ROWTYPE from arguments, we can use the table name as type 20285 $fct_detail{args} =~ s/\%ROWTYPE//igs; 20286 20287 # Replace DEFAULT EMPTY_BLOB() from function/procedure arguments by DEFAULT NULL 20288 $fct_detail{args} =~ s/\s+DEFAULT\s+EMPTY_[CB]LOB\(\)/DEFAULT NULL/igs; 20289 20290 # Now convert types 20291 $fct_detail{args} = Ora2Pg::PLSQL::replace_sql_type($fct_detail{args}, $self->{pg_numeric_type}, $self->{default_numeric}, $self->{pg_integer_type}, %{$self->{data_type}}); 20292 $fct_detail{declare} = Ora2Pg::PLSQL::replace_sql_type($fct_detail{declare}, $self->{pg_numeric_type}, $self->{default_numeric}, $self->{pg_integer_type}, %{$self->{data_type}}); 20293 20294 # Sometime variable used in FOR ... IN SELECT loop is not declared 20295 # Append its RECORD declaration in the DECLARE section. 20296 my $tmp_code = $fct_detail{code}; 20297 while ($tmp_code =~ s/\bFOR\s+([^\s]+)\s+IN(.*?)LOOP//is) 20298 { 20299 my $varname = quotemeta($1); 20300 my $clause = $2; 20301 if ($fct_detail{declare} !~ /\b$varname\s+/is) { 20302 chomp($fct_detail{declare}); 20303 # When the cursor is refereing to a statement, declare 20304 # it as record otherwise it don't need to be replaced 20305 if ($clause =~ /\bSELECT\b/is) { 20306 $fct_detail{declare} .= "\n $varname RECORD;\n"; 20307 } 20308 } 20309 } 20310 20311 # Set parameters for AUTONOMOUS TRANSACTION 20312 $fct_detail{args} =~ s/\s+/ /gs; 20313 push(@{$fct_detail{at_args}}, split(/\s*,\s*/, $fct_detail{args})); 20314 # Remove type parts to only get parameter's name 20315 push(@{$fct_detail{param_types}}, @{$fct_detail{at_args}}); 20316 map { s/\s(IN|OUT|INOUT)\s/ /i; } @{$fct_detail{at_args}}; 20317 map { s/^\(//; } @{$fct_detail{at_args}}; 20318 map { s/^\s+//; } @{$fct_detail{at_args}}; 20319 map { s/\s.*//; } @{$fct_detail{at_args}}; 20320 map { s/\)$//; } @{$fct_detail{at_args}}; 20321 @{$fct_detail{at_args}} = grep(/^.+$/, @{$fct_detail{at_args}}); 20322 # Store type used in parameter list to lookup later for custom types 20323 map { s/^\(//; } @{$fct_detail{param_types}}; 20324 map { s/\)$//; } @{$fct_detail{param_types}}; 20325 map { s/\%ORA2PG_COMMENT\d+\%//gs; } @{$fct_detail{param_types}}; 20326 map { s/^\s*[^\s]+\s+(IN|OUT|INOUT)/$1/i; s/^((?:IN|OUT|INOUT)\s+[^\s]+)\s+[^\s]*$/$1/i; s/\(.*//; s/\s*\)\s*$//; s/\s+$//; } @{$fct_detail{param_types}}; 20327 } else { 20328 delete $fct_detail{func_ret_type}; 20329 delete $fct_detail{declare}; 20330 $fct_detail{code} = $plsql; 20331 } 20332 20333 # PostgreSQL procedure do not support OUT parameter, translate them into INOUT params 20334 if (!$fct_detail{hasreturn} && $self->{pg_supports_procedure} && ($fct_detail{args} =~ /\bOUT\s+[^,\)]+/i)) { 20335 $fct_detail{args} =~ s/\bOUT(\s+[^,\)]+)/INOUT$1/igs; 20336 } 20337 20338 # Mark the function as having out parameters if any 20339 my @nout = $fct_detail{args} =~ /\bOUT\s+([^,\)]+)/igs; 20340 my @ninout = $fct_detail{args} =~ /\bINOUT\s+([^,\)]+)/igs; 20341 my $nbout = $#nout+1 + $#ninout+1; 20342 $fct_detail{inout} = 1 if ($nbout > 0); 20343 20344 # Mark function as having custom type in parameter list 20345 if ($fct_detail{inout} and $nbout > 1) { 20346 foreach my $t (@{$fct_detail{param_types}}) { 20347 # Consider column type reference to never be a composite type this 20348 # is clearly not right but the false positive case might be very low 20349 next if ($t =~ /\%TYPE/i || ($t !~ s/^(OUT|INOUT)\s+//i)); 20350 # Mark out parameter as using composite type 20351 if (!grep(/^\Q$t\E$/i, 'int', 'bigint', 'date', values %TYPE, values %ORA2PG_SDO_GTYPE)) { 20352 $fct_detail{inout}++; 20353 } 20354 } 20355 } 20356 20357 # Collect user defined function 20358 while ($fct_detail{declare} =~ s/\b([^\s]+)\s+EXCEPTION\s*;//) { 20359 my $e = lc($1); 20360 if (!exists $self->{custom_exception}{$e}) { 20361 $self->{custom_exception}{$e} = $self->{exception_id}++; 20362 } 20363 } 20364 $fct_detail{declare} =~ s/PRAGMA\s+EXCEPTION_INIT[^;]*;//igs; 20365 20366 # Replace call to global variables declared in this package 20367 foreach my $n (keys %{$self->{global_variables}}) { 20368 next if (!$n || ($pname && (uc($n) !~ /^\U$pname\E\./))); 20369 my $tmpname = $n; 20370 $tmpname =~ s/^$pname\.//i; 20371 next if ($fct_detail{code} !~ /\b$tmpname\b/is); 20372 my $i = 0; 20373 while ($fct_detail{code} =~ s/\b$n\s*:=\s*([^;]+)\s*;/PERFORM set_config('$n', $1, false);/is) { last if ($i++ > 100); }; 20374 $i = 0; 20375 while ($fct_detail{code} =~ s/([^\.]+)\b$self->{global_variables}{$n}{name}\s*:=\s*([^;]+);/$1PERFORM set_config('$n', $2, false);/is) { last if ($i++ > 100); }; 20376 $i = 0; 20377 while ($fct_detail{code} =~ s/([^']+)\b$n\b([^']+)/$1current_setting('$n')::$self->{global_variables}{$n}{type}$2/is) { last if ($i++ > 100); }; 20378 $i = 0; 20379 while ($fct_detail{code} =~ s/([^\.']+)\b$self->{global_variables}{$n}{name}\b([^']+)/$1current_setting('$n')::$self->{global_variables}{$n}{type}$2/is) { last if ($i++ > 100); }; 20380 } 20381 20382 # Replace call to raise exception 20383 foreach my $e (keys %{$self->{custom_exception}}) { 20384 $fct_detail{code} =~ s/\bRAISE\s+$e\b/RAISE EXCEPTION '$e' USING ERRCODE = '$self->{custom_exception}{$e}'/igs; 20385 $fct_detail{code} =~ s/(\s+WHEN\s+)$e\s+/$1SQLSTATE '$self->{custom_exception}{$e}' /igs; 20386 } 20387 20388 return %fct_detail; 20389} 20390 20391#### 20392# Return a string to set the current search path 20393#### 20394sub set_search_path 20395{ 20396 my $self = shift; 20397 my $owner = shift; 20398 20399 my $local_path = ''; 20400 if ($self->{postgis_schema}) { 20401 $local_path = ',' . $self->quote_object_name($self->{postgis_schema}); 20402 } 20403 if ($self->{data_type}{BFILE} eq 'efile') { 20404 $local_path .= ',external_file'; 20405 } 20406 my $orafce_path = ''; 20407 $orafce_path = ',oracle' if ($self->{'use_orafce'}); 20408 $local_path .= "$orafce_path,public"; 20409 20410 my $search_path = ''; 20411 if (!$self->{schema} && $self->{export_schema} && $owner) { 20412 $search_path = "SET search_path = " . $self->quote_object_name($owner) . "$local_path;"; 20413 } elsif (!$owner) { 20414 my @pathes = (); 20415 # When PG_SCHEMA is set, always take the value as search path 20416 if ($self->{pg_schema}) { 20417 @pathes = split(/\s*,\s*/, $self->{pg_schema}); 20418 } elsif ($self->{export_schema} && $self->{schema}) { 20419 # When EXPORT_SCHEMA is enable and we are working on a specific schema 20420 # set it as default search_path. Useful when object are not prefixed 20421 # with their destination schema. 20422 push(@pathes, $self->{schema}); 20423 } 20424 if ($#pathes >= 0) { 20425 map { $_ = $self->quote_object_name($_); } @pathes; 20426 $search_path = "SET search_path = " . join(',', @pathes) . "$local_path;"; 20427 } 20428 } 20429 20430 return "$search_path\n" if ($search_path); 20431} 20432 20433sub _get_human_cost 20434{ 20435 my ($self, $total_cost_value) = @_; 20436 20437 return 0 if (!$total_cost_value); 20438 20439 my $human_cost = $total_cost_value * $self->{cost_unit_value}; 20440 if ($human_cost >= 420) { 20441 my $tmp = $human_cost/420; 20442 $tmp++ if ($tmp =~ s/\.\d+//); 20443 $human_cost = "$tmp man-day(s)"; 20444 } else { 20445 #my $tmp = $human_cost/60; 20446 #$tmp++ if ($tmp =~ s/\.\d+//); 20447 #$human_cost = "$tmp man-hour(s)"; 20448 # mimimum to 1 day, hours are not really relevant 20449 $human_cost = "1 man-day(s)"; 20450 } 20451 20452 return $human_cost; 20453} 20454 20455sub difficulty_assessment 20456{ 20457 my ($self, %report_info) = @_; 20458 20459 # Migration that might be run automatically 20460 # 1 = trivial: no stored functions and no triggers 20461 # 2 = easy: no stored functions but with triggers 20462 # 3 = simple: stored functions and/or triggers 20463 # Migration that need code rewrite 20464 # 4 = manual: no stored functions but with triggers or view 20465 # 5 = difficult: with stored functions and/or triggers 20466 my $difficulty = 1; 20467 20468 my @stored_function = ( 20469 'FUNCTION', 20470 'PACKAGE BODY', 20471 'PROCEDURE' 20472 ); 20473 20474 foreach my $n (@stored_function) { 20475 if (exists $report_info{'Objects'}{$n} && $report_info{'Objects'}{$n}{'number'}) { 20476 $difficulty = 3; 20477 last; 20478 } 20479 } 20480 if ($difficulty < 3) { 20481 $difficulty += 1 if ( exists $report_info{'Objects'}{'TRIGGER'} && $report_info{'Objects'}{'TRIGGER'}{'number'}); 20482 } 20483 20484 20485 if ($difficulty < 3) { 20486 foreach my $fct (keys %{ $report_info{'full_trigger_details'} } ) { 20487 next if (!exists $report_info{'full_trigger_details'}{$fct}{keywords}); 20488 $difficulty = 4; 20489 last; 20490 } 20491 } 20492 if ($difficulty <= 3) { 20493 foreach my $fct (keys %{ $report_info{'full_view_details'} } ) { 20494 next if (!exists $report_info{'full_view_details'}{$fct}{keywords}); 20495 $difficulty = 4; 20496 last; 20497 } 20498 } 20499 if ($difficulty >= 3) { 20500 foreach my $fct (keys %{ $report_info{'full_function_details'} } ) { 20501 next if (!exists $report_info{'full_function_details'}{$fct}{keywords}); 20502 $difficulty = 5; 20503 last; 20504 } 20505 } 20506 20507 my $tmp = $report_info{'total_cost_value'}/84; 20508 $tmp++ if ($tmp =~ s/\.\d+//); 20509 20510 my $level = 'A'; 20511 $level = 'B' if ($difficulty > 3); 20512 $level = 'C' if ( ($difficulty > 3) && ($tmp > $self->{human_days_limit}) ); 20513 20514 return "$level-$difficulty"; 20515} 20516 20517sub _show_report 20518{ 20519 my ($self, %report_info) = @_; 20520 20521 my @ora_object_type = ( 20522 'DATABASE LINK', 20523 'DIRECTORY', 20524 'FUNCTION', 20525 'INDEX', 20526 'JOB', 20527 'MATERIALIZED VIEW', 20528 'PACKAGE BODY', 20529 'PROCEDURE', 20530 'QUERY', 20531 'SEQUENCE', 20532 'SYNONYM', 20533 'TABLE', 20534 'TABLE PARTITION', 20535 'TABLE SUBPARTITION', 20536 'TRIGGER', 20537 'TYPE', 20538 'VIEW', 20539 20540# Other object type 20541#CLUSTER 20542#CONSUMER GROUP 20543#DESTINATION 20544#DIMENSION 20545#EDITION 20546#EVALUATION CONTEXT 20547#INDEX PARTITION 20548#INDEXTYPE 20549#JAVA CLASS 20550#JAVA DATA 20551#JAVA RESOURCE 20552#JAVA SOURCE 20553#JOB CLASS 20554#LIBRARY 20555#LOB 20556#LOB PARTITION 20557#OPERATOR 20558#PACKAGE 20559#PROGRAM 20560#QUEUE 20561#RESOURCE PLAN 20562#RULE 20563#RULE SET 20564#SCHEDULE 20565#SCHEDULER GROUP 20566#TYPE BODY 20567#UNDEFINED 20568#UNIFIED AUDIT POLICY 20569#WINDOW 20570#XML SCHEMA 20571 ); 20572 20573 my $difficulty = $self->difficulty_assessment(%report_info); 20574 my $lbl_mig_type = qq{ 20575Migration levels: 20576 A - Migration that might be run automatically 20577 B - Migration with code rewrite and a human-days cost up to $self->{human_days_limit} days 20578 C - Migration with code rewrite and a human-days cost above $self->{human_days_limit} days 20579Technical levels: 20580 1 = trivial: no stored functions and no triggers 20581 2 = easy: no stored functions but with triggers, no manual rewriting 20582 3 = simple: stored functions and/or triggers, no manual rewriting 20583 4 = manual: no stored functions but with triggers or views with code rewriting 20584 5 = difficult: stored functions and/or triggers with code rewriting 20585}; 20586 # Generate report text report 20587 if (!$self->{dump_as_html} && !$self->{dump_as_csv} && !$self->{dump_as_sheet}) 20588 { 20589 my $cost_header = ''; 20590 $cost_header = "\tEstimated cost" if ($self->{estimate_cost}); 20591 $self->logrep("-------------------------------------------------------------------------------\n"); 20592 $self->logrep("Ora2Pg v$VERSION - Database Migration Report\n"); 20593 $self->logrep("-------------------------------------------------------------------------------\n"); 20594 $self->logrep("Version\t$report_info{'Version'}\n"); 20595 $self->logrep("Schema\t$report_info{'Schema'}\n"); 20596 $self->logrep("Size\t$report_info{'Size'}\n\n"); 20597 $self->logrep("-------------------------------------------------------------------------------\n"); 20598 $self->logrep("Object\tNumber\tInvalid$cost_header\tComments\tDetails\n"); 20599 $self->logrep("-------------------------------------------------------------------------------\n"); 20600 foreach my $typ (sort keys %{ $report_info{'Objects'} } ) { 20601 $report_info{'Objects'}{$typ}{'detail'} =~ s/\n/\. /gs; 20602 if ($self->{estimate_cost}) { 20603 $self->logrep("$typ\t$report_info{'Objects'}{$typ}{'number'}\t$report_info{'Objects'}{$typ}{'invalid'}\t$report_info{'Objects'}{$typ}{'cost_value'}\t$report_info{'Objects'}{$typ}{'comment'}\t$report_info{'Objects'}{$typ}{'detail'}\n"); 20604 } else { 20605 $self->logrep("$typ\t$report_info{'Objects'}{$typ}{'number'}\t$report_info{'Objects'}{$typ}{'invalid'}\t$report_info{'Objects'}{$typ}{'comment'}\t$report_info{'Objects'}{$typ}{'detail'}\n"); 20606 } 20607 } 20608 $self->logrep("-------------------------------------------------------------------------------\n"); 20609 if ($self->{estimate_cost}) { 20610 my $human_cost = $self->_get_human_cost($report_info{'total_cost_value'}); 20611 my $comment = "$report_info{'total_cost_value'} cost migration units means approximatively $human_cost. The migration unit was set to $self->{cost_unit_value} minute(s)\n"; 20612 $self->logrep("Total\t$report_info{'total_object_number'}\t$report_info{'total_object_invalid'}\t$report_info{'total_cost_value'}\t$comment\n"); 20613 } else { 20614 $self->logrep("Total\t$report_info{'total_object_number'}\t$report_info{'total_object_invalid'}\n"); 20615 } 20616 $self->logrep("-------------------------------------------------------------------------------\n"); 20617 if ($self->{estimate_cost}) { 20618 $self->logrep("Migration level : $difficulty\n"); 20619 $self->logrep("-------------------------------------------------------------------------------\n"); 20620 $self->logrep($lbl_mig_type); 20621 $self->logrep("-------------------------------------------------------------------------------\n"); 20622 if (scalar keys %{ $report_info{'full_function_details'} }) { 20623 $self->logrep("\nDetails of cost assessment per function\n"); 20624 foreach my $fct (sort { $report_info{'full_function_details'}{$b}{count} <=> $report_info{'full_function_details'}{$a}{count} } keys %{ $report_info{'full_function_details'} } ) { 20625 $self->logrep("Function $fct total estimated cost: $report_info{'full_function_details'}{$fct}{count}\n"); 20626 $self->logrep($report_info{'full_function_details'}{$fct}{info}); 20627 } 20628 $self->logrep("-------------------------------------------------------------------------------\n"); 20629 } 20630 if (scalar keys %{ $report_info{'full_trigger_details'} }) { 20631 $self->logrep("\nDetails of cost assessment per trigger\n"); 20632 foreach my $fct (sort { $report_info{'full_trigger_details'}{$b}{count} <=> $report_info{'full_trigger_details'}{$a}{count} } keys %{ $report_info{'full_trigger_details'} } ) { 20633 $self->logrep("Trigger $fct total estimated cost: $report_info{'full_trigger_details'}{$fct}{count}\n"); 20634 $self->logrep($report_info{'full_trigger_details'}{$fct}{info}); 20635 } 20636 $self->logrep("-------------------------------------------------------------------------------\n"); 20637 } 20638 if (scalar keys %{ $report_info{'full_view_details'} }) { 20639 $self->logrep("\nDetails of cost assessment per view\n"); 20640 foreach my $fct (sort { $report_info{'full_view_details'}{$b}{count} <=> $report_info{'full_view_details'}{$a}{count} } keys %{ $report_info{'full_view_details'} } ) { 20641 $self->logrep("View $fct total estimated cost: $report_info{'full_view_details'}{$fct}{count}\n"); 20642 $self->logrep($report_info{'full_view_details'}{$fct}{info}); 20643 } 20644 $self->logrep("-------------------------------------------------------------------------------\n"); 20645 } 20646 } 20647 } 20648 elsif ($self->{dump_as_csv}) 20649 { 20650 $self->logrep("-------------------------------------------------------------------------------\n"); 20651 $self->logrep("Ora2Pg v$VERSION - Database Migration Report\n"); 20652 $self->logrep("-------------------------------------------------------------------------------\n"); 20653 $self->logrep("Version\t$report_info{'Version'}\n"); 20654 $self->logrep("Schema\t$report_info{'Schema'}\n"); 20655 $self->logrep("Size\t$report_info{'Size'}\n\n"); 20656 $self->logrep("-------------------------------------------------------------------------------\n\n"); 20657 $self->logrep("Object;Number;Invalid;Estimated cost;Comments\n"); 20658 foreach my $typ (sort keys %{ $report_info{'Objects'} } ) { 20659 $report_info{'Objects'}{$typ}{'detail'} =~ s/\n/\. /gs; 20660 $self->logrep("$typ;$report_info{'Objects'}{$typ}{'number'};$report_info{'Objects'}{$typ}{'invalid'};$report_info{'Objects'}{$typ}{'cost_value'};$report_info{'Objects'}{$typ}{'comment'}\n"); 20661 } 20662 my $human_cost = $self->_get_human_cost($report_info{'total_cost_value'}); 20663 $difficulty = '' if (!$self->{estimate_cost}); 20664 $self->logrep("\n"); 20665 $self->logrep("Total Number;Total Invalid;Total Estimated cost;Human days cost;Migration level\n"); 20666 $self->logrep("$report_info{'total_object_number'};$report_info{'total_object_invalid'};$report_info{'total_cost_value'};$human_cost;$difficulty\n"); 20667 } 20668 elsif ($self->{dump_as_sheet}) 20669 { 20670 $difficulty = '' if (!$self->{estimate_cost}); 20671 my @header = ('Instance', 'Version', 'Schema', 'Size', 'Cost assessment', 'Migration type'); 20672 my $human_cost = $self->_get_human_cost($report_info{'total_cost_value'}); 20673 my @infos = ($self->{oracle_dsn}, $report_info{'Version'}, $report_info{'Schema'}, $report_info{'Size'}, $human_cost, $difficulty); 20674 foreach my $typ (sort @ora_object_type) { 20675 push(@header, $typ); 20676 $report_info{'Objects'}{$typ}{'number'} ||= 0; 20677 $report_info{'Objects'}{$typ}{'invalid'} ||= 0; 20678 $report_info{'Objects'}{$typ}{'cost_value'} ||= 0; 20679 push(@infos, "$report_info{'Objects'}{$typ}{'number'}/$report_info{'Objects'}{$typ}{'invalid'}/$report_info{'Objects'}{$typ}{'cost_value'}"); 20680 } 20681 push(@header, "Total assessment"); 20682 push(@infos, "$report_info{total_object_number}/$report_info{total_object_invalid}/$report_info{total_cost_value}"); 20683 if ($self->{print_header}) { 20684 $self->logrep('"' . join('";"', @header) . '"' . "\n"); 20685 } 20686 $self->logrep('"' . join('";"', @infos) . '"' . "\n"); 20687 } 20688 else 20689 { 20690 my $cost_header = ''; 20691 $cost_header = "<th>Estimated cost</th>" if ($self->{estimate_cost}); 20692 my $date = localtime(time); 20693 my $html_header = qq{<!DOCTYPE html> 20694<html> 20695 <head> 20696 <title>Ora2Pg - Database Migration Report</title> 20697 <meta HTTP-EQUIV="Generator" CONTENT="Ora2Pg v$VERSION"> 20698 <meta HTTP-EQUIV="Date" CONTENT="$date"> 20699 <style> 20700body { 20701 margin: 30px 0; 20702 padding: 0; 20703 background: #EFEFEF; 20704 font-size: 12px; 20705 color: #1e1e1e; 20706} 20707 20708h1 { 20709 margin-bottom: 20px; 20710 border-bottom: 1px solid #DFDFDF; 20711 font-size: 22px; 20712 padding: 0px; 20713 padding-bottom: 5px; 20714 font-weight: bold; 20715 color: #0094C7; 20716} 20717 20718h2 { 20719 margin-bottom: 10px; 20720 font-size: 18px; 20721 padding: 0px; 20722 padding-bottom: 5px; 20723 font-weight: bold; 20724 color: #0094C7; 20725} 20726 20727#header table { 20728 padding: 0 5px 0 5px; 20729 border: 1px solid #DBDBDB; 20730 margin-bottom: 20px; 20731 margin-left: 30px; 20732} 20733 20734#header th { 20735 padding: 0 5px 0 5px; 20736 text-decoration: none; 20737 font-size: 16px; 20738 color: #EC5800; 20739} 20740 20741#content table { 20742 padding: 0 5px 0 5px; 20743 border: 1px solid #DBDBDB; 20744 margin-bottom: 20px; 20745 margin-left: 10px; 20746 margin-right: 10px; 20747} 20748#content td { 20749 padding: 0 5px 0 5px; 20750 border-bottom: 1px solid #888888; 20751 margin-bottom: 20px; 20752 text-align: left; 20753 vertical-align: top; 20754} 20755 20756#content th { 20757 border-bottom: 1px solid #BBBBBB; 20758 padding: 0 5px 0 5px; 20759 text-decoration: none; 20760 font-size: 16px; 20761 color: #EC5800; 20762} 20763 20764.object_name { 20765 font-weight: bold; 20766 color: #0094C7; 20767 text-align: left; 20768 white-space: pre; 20769} 20770 20771.detail { 20772 white-space: pre; 20773} 20774 20775#footer { 20776 margin-right: 10px; 20777 text-align: right; 20778} 20779 20780#footer a { 20781 color: #EC5800; 20782} 20783 20784#footer a:hover { 20785 text-decoration: none; 20786} 20787 </style> 20788</head> 20789<body> 20790<div id="header"> 20791<h1>Ora2Pg - Database Migration Report</h1> 20792<table> 20793<tr><th>Version</th><td>$report_info{'Version'}</td></tr> 20794<tr><th>Schema</th><td>$report_info{'Schema'}</td></tr> 20795<tr><th>Size</th><td>$report_info{'Size'}</td></tr> 20796</table> 20797</div> 20798<div id="content"> 20799<table> 20800<tr><th>Object</th><th>Number</th><th>Invalid</th>$cost_header<th>Comments</th><th>Details</th></tr> 20801}; 20802 20803 $self->logrep($html_header); 20804 foreach my $typ (sort keys %{ $report_info{'Objects'} } ) { 20805 $report_info{'Objects'}{$typ}{'detail'} =~ s/\n/<br>/gs; 20806 $report_info{'Objects'}{$typ}{'detail'} = "<details><summary>See details</summary>$report_info{'Objects'}{$typ}{'detail'}</details>" if ($report_info{'Objects'}{$typ}{'detail'} ne ''); 20807 if ($self->{estimate_cost}) { 20808 $self->logrep("<tr><td class=\"object_name\">$typ</td><td style=\"text-align: center;\">$report_info{'Objects'}{$typ}{'number'}</td><td style=\"text-align: center;\">$report_info{'Objects'}{$typ}{'invalid'}</td><td style=\"text-align: center;\">$report_info{'Objects'}{$typ}{'cost_value'}</td><td>$report_info{'Objects'}{$typ}{'comment'}</td><td class=\"detail\">$report_info{'Objects'}{$typ}{'detail'}</td></tr>\n"); 20809 } else { 20810 $self->logrep("<tr><td class=\"object_name\">$typ</td><td style=\"text-align: center;\">$report_info{'Objects'}{$typ}{'number'}</td><td style=\"text-align: center;\">$report_info{'Objects'}{$typ}{'invalid'}</td><td>$report_info{'Objects'}{$typ}{'comment'}</td><td class=\"detail\">$report_info{'Objects'}{$typ}{'detail'}</td></tr>\n"); 20811 } 20812 } 20813 if ($self->{estimate_cost}) { 20814 my $human_cost = $self->_get_human_cost($report_info{'total_cost_value'}); 20815 my $comment = "$report_info{'total_cost_value'} cost migration units means approximatively $human_cost. The migration unit was set to $self->{cost_unit_value} minute(s)\n"; 20816 $self->logrep("<tr><th style=\"text-align: center; border-bottom: 0px; vertical-align: bottom;\">Total</th><td style=\"text-align: center; border-bottom: 0px; vertical-align: bottom;\">$report_info{'total_object_number'}</td><td style=\"text-align: center; border-bottom: 0px; vertical-align: bottom;\">$report_info{'total_object_invalid'}</td><td style=\"text-align: center; border-bottom: 0px; vertical-align: bottom;\">$report_info{'total_cost_value'}</td><td colspan=\"2\" style=\"border-bottom: 0px; vertical-align: bottom;\">$comment</td></tr>\n"); 20817 } else { 20818 $self->logrep("<tr><th style=\"text-align: center; border-bottom: 0px; vertical-align: bottom;\">Total</th><td style=\"text-align: center; border-bottom: 0px; vertical-align: bottom; border-bottom: 0px; vertical-align: bottom;\">$report_info{'total_object_number'}</td><td style=\"text-align: center; border-bottom: 0px; vertical-align: bottom;\">$report_info{'total_object_invalid'}</td><td colspan=\"3\" style=\"border-bottom: 0px; vertical-align: bottom;\"></td></tr>\n"); 20819 } 20820 $self->logrep("</table>\n</div>\n"); 20821 if ($self->{estimate_cost}) { 20822 $self->logrep("<h2>Migration level: $difficulty</h2>\n"); 20823 $lbl_mig_type = qq{ 20824<ul> 20825<li>Migration levels:</li> 20826 <ul> 20827 <li>A - Migration that might be run automatically</li> 20828 <li>B - Migration with code rewrite and a human-days cost up to $self->{human_days_limit} days</li> 20829 <li>C - Migration with code rewrite and a human-days cost above $self->{human_days_limit} days</li> 20830 </ul> 20831<li>Technical levels:</li> 20832 <ul> 20833 <li>1 = trivial: no stored functions and no triggers</li> 20834 <li>2 = easy: no stored functions but with triggers, no manual rewriting</li> 20835 <li>3 = simple: stored functions and/or triggers, no manual rewriting</li> 20836 <li>4 = manual: no stored functions but with triggers or views with code rewriting</li> 20837 <li>5 = difficult: stored functions and/or triggers with code rewriting</li> 20838 </ul> 20839</ul> 20840}; 20841 $self->logrep($lbl_mig_type); 20842 if (scalar keys %{ $report_info{'full_function_details'} }) { 20843 $self->logrep("<h2>Details of cost assessment per function</h2>\n"); 20844 $self->logrep("<details><summary>Show</summary><ul>\n"); 20845 foreach my $fct (sort { $report_info{'full_function_details'}{$b}{count} <=> $report_info{'full_function_details'}{$a}{count} } keys %{ $report_info{'full_function_details'} } ) { 20846 20847 $self->logrep("<li>Function $fct total estimated cost: $report_info{'full_function_details'}{$fct}{count}</li>\n"); 20848 $self->logrep("<ul>\n"); 20849 $report_info{'full_function_details'}{$fct}{info} =~ s/\t/<li>/gs; 20850 $report_info{'full_function_details'}{$fct}{info} =~ s/\n/<\/li>\n/gs; 20851 $self->logrep($report_info{'full_function_details'}{$fct}{info}); 20852 $self->logrep("</ul>\n"); 20853 } 20854 $self->logrep("</ul></details>\n"); 20855 } 20856 if (scalar keys %{ $report_info{'full_trigger_details'} }) { 20857 $self->logrep("<h2>Details of cost assessment per trigger</h2>\n"); 20858 $self->logrep("<details><summary>Show</summary><ul>\n"); 20859 foreach my $fct (sort { $report_info{'full_trigger_details'}{$b}{count} <=> $report_info{'full_trigger_details'}{$a}{count} } keys %{ $report_info{'full_trigger_details'} } ) { 20860 20861 $self->logrep("<li>Trigger $fct total estimated cost: $report_info{'full_trigger_details'}{$fct}{count}</li>\n"); 20862 $self->logrep("<ul>\n"); 20863 $report_info{'full_trigger_details'}{$fct}{info} =~ s/\t/<li>/gs; 20864 $report_info{'full_trigger_details'}{$fct}{info} =~ s/\n/<\/li>\n/gs; 20865 $self->logrep($report_info{'full_trigger_details'}{$fct}{info}); 20866 $self->logrep("</ul>\n"); 20867 } 20868 $self->logrep("</ul></details>\n"); 20869 } 20870 if (scalar keys %{ $report_info{'full_view_details'} }) { 20871 $self->logrep("<h2>Details of cost assessment per view</h2>\n"); 20872 $self->logrep("<details><summary>Show</summary><ul>\n"); 20873 foreach my $fct (sort { $report_info{'full_view_details'}{$b}{count} <=> $report_info{'full_view_details'}{$a}{count} } keys %{ $report_info{'full_view_details'} } ) { 20874 20875 $self->logrep("<li>View $fct total estimated cost: $report_info{'full_view_details'}{$fct}{count}</li>\n"); 20876 $self->logrep("<ul>\n"); 20877 $report_info{'full_view_details'}{$fct}{info} =~ s/\t/<li>/gs; 20878 $report_info{'full_view_details'}{$fct}{info} =~ s/\n/<\/li>\n/gs; 20879 $self->logrep($report_info{'full_view_details'}{$fct}{info}); 20880 $self->logrep("</ul>\n"); 20881 } 20882 $self->logrep("</ul></details>\n"); 20883 } 20884 } 20885 my $html_footer = qq{ 20886<div id="footer"> 20887Generated by <a href="http://ora2pg.darold.net/">Ora2Pg v$VERSION</a> 20888</div> 20889</body> 20890</html> 20891}; 20892 $self->logrep($html_footer); 20893 } 20894} 20895 20896sub get_kettle_xml 20897{ 20898 20899 return <<EOF 20900<transformation> 20901 <info> 20902 <name>template</name> 20903 <description/> 20904 <extended_description/> 20905 <trans_version/> 20906 <trans_type>Normal</trans_type> 20907 <trans_status>0</trans_status> 20908 <directory>/</directory> 20909 <parameters> 20910 </parameters> 20911 <log> 20912<trans-log-table><connection/> 20913<schema/> 20914<table/> 20915<size_limit_lines/> 20916<interval/> 20917<timeout_days/> 20918<field><id>ID_BATCH</id><enabled>Y</enabled><name>ID_BATCH</name></field><field><id>CHANNEL_ID</id><enabled>Y</enabled><name>CHANNEL_ID</name></field><field><id>TRANSNAME</id><enabled>Y</enabled><name>TRANSNAME</name></field><field><id>STATUS</id><enabled>Y</enabled><name>STATUS</name></field><field><id>LINES_READ</id><enabled>Y</enabled><name>LINES_READ</name><subject/></field><field><id>LINES_WRITTEN</id><enabled>Y</enabled><name>LINES_WRITTEN</name><subject/></field><field><id>LINES_UPDATED</id><enabled>Y</enabled><name>LINES_UPDATED</name><subject/></field><field><id>LINES_INPUT</id><enabled>Y</enabled><name>LINES_INPUT</name><subject/></field><field><id>LINES_OUTPUT</id><enabled>Y</enabled><name>LINES_OUTPUT</name><subject/></field><field><id>LINES_REJECTED</id><enabled>Y</enabled><name>LINES_REJECTED</name><subject/></field><field><id>ERRORS</id><enabled>Y</enabled><name>ERRORS</name></field><field><id>STARTDATE</id><enabled>Y</enabled><name>STARTDATE</name></field><field><id>ENDDATE</id><enabled>Y</enabled><name>ENDDATE</name></field><field><id>LOGDATE</id><enabled>Y</enabled><name>LOGDATE</name></field><field><id>DEPDATE</id><enabled>Y</enabled><name>DEPDATE</name></field><field><id>REPLAYDATE</id><enabled>Y</enabled><name>REPLAYDATE</name></field><field><id>LOG_FIELD</id><enabled>Y</enabled><name>LOG_FIELD</name></field></trans-log-table> 20919<perf-log-table><connection/> 20920<schema/> 20921<table/> 20922<interval/> 20923<timeout_days/> 20924<field><id>ID_BATCH</id><enabled>Y</enabled><name>ID_BATCH</name></field><field><id>SEQ_NR</id><enabled>Y</enabled><name>SEQ_NR</name></field><field><id>LOGDATE</id><enabled>Y</enabled><name>LOGDATE</name></field><field><id>TRANSNAME</id><enabled>Y</enabled><name>TRANSNAME</name></field><field><id>STEPNAME</id><enabled>Y</enabled><name>STEPNAME</name></field><field><id>STEP_COPY</id><enabled>Y</enabled><name>STEP_COPY</name></field><field><id>LINES_READ</id><enabled>Y</enabled><name>LINES_READ</name></field><field><id>LINES_WRITTEN</id><enabled>Y</enabled><name>LINES_WRITTEN</name></field><field><id>LINES_UPDATED</id><enabled>Y</enabled><name>LINES_UPDATED</name></field><field><id>LINES_INPUT</id><enabled>Y</enabled><name>LINES_INPUT</name></field><field><id>LINES_OUTPUT</id><enabled>Y</enabled><name>LINES_OUTPUT</name></field><field><id>LINES_REJECTED</id><enabled>Y</enabled><name>LINES_REJECTED</name></field><field><id>ERRORS</id><enabled>Y</enabled><name>ERRORS</name></field><field><id>INPUT_BUFFER_ROWS</id><enabled>Y</enabled><name>INPUT_BUFFER_ROWS</name></field><field><id>OUTPUT_BUFFER_ROWS</id><enabled>Y</enabled><name>OUTPUT_BUFFER_ROWS</name></field></perf-log-table> 20925<channel-log-table><connection/> 20926<schema/> 20927<table/> 20928<timeout_days/> 20929<field><id>ID_BATCH</id><enabled>Y</enabled><name>ID_BATCH</name></field><field><id>CHANNEL_ID</id><enabled>Y</enabled><name>CHANNEL_ID</name></field><field><id>LOG_DATE</id><enabled>Y</enabled><name>LOG_DATE</name></field><field><id>LOGGING_OBJECT_TYPE</id><enabled>Y</enabled><name>LOGGING_OBJECT_TYPE</name></field><field><id>OBJECT_NAME</id><enabled>Y</enabled><name>OBJECT_NAME</name></field><field><id>OBJECT_COPY</id><enabled>Y</enabled><name>OBJECT_COPY</name></field><field><id>REPOSITORY_DIRECTORY</id><enabled>Y</enabled><name>REPOSITORY_DIRECTORY</name></field><field><id>FILENAME</id><enabled>Y</enabled><name>FILENAME</name></field><field><id>OBJECT_ID</id><enabled>Y</enabled><name>OBJECT_ID</name></field><field><id>OBJECT_REVISION</id><enabled>Y</enabled><name>OBJECT_REVISION</name></field><field><id>PARENT_CHANNEL_ID</id><enabled>Y</enabled><name>PARENT_CHANNEL_ID</name></field><field><id>ROOT_CHANNEL_ID</id><enabled>Y</enabled><name>ROOT_CHANNEL_ID</name></field></channel-log-table> 20930<step-log-table><connection/> 20931<schema/> 20932<table/> 20933<timeout_days/> 20934<field><id>ID_BATCH</id><enabled>Y</enabled><name>ID_BATCH</name></field><field><id>CHANNEL_ID</id><enabled>Y</enabled><name>CHANNEL_ID</name></field><field><id>LOG_DATE</id><enabled>Y</enabled><name>LOG_DATE</name></field><field><id>TRANSNAME</id><enabled>Y</enabled><name>TRANSNAME</name></field><field><id>STEPNAME</id><enabled>Y</enabled><name>STEPNAME</name></field><field><id>STEP_COPY</id><enabled>Y</enabled><name>STEP_COPY</name></field><field><id>LINES_READ</id><enabled>Y</enabled><name>LINES_READ</name></field><field><id>LINES_WRITTEN</id><enabled>Y</enabled><name>LINES_WRITTEN</name></field><field><id>LINES_UPDATED</id><enabled>Y</enabled><name>LINES_UPDATED</name></field><field><id>LINES_INPUT</id><enabled>Y</enabled><name>LINES_INPUT</name></field><field><id>LINES_OUTPUT</id><enabled>Y</enabled><name>LINES_OUTPUT</name></field><field><id>LINES_REJECTED</id><enabled>Y</enabled><name>LINES_REJECTED</name></field><field><id>ERRORS</id><enabled>Y</enabled><name>ERRORS</name></field><field><id>LOG_FIELD</id><enabled>N</enabled><name>LOG_FIELD</name></field></step-log-table> 20935 </log> 20936 <maxdate> 20937 <connection/> 20938 <table/> 20939 <field/> 20940 <offset>0.0</offset> 20941 <maxdiff>0.0</maxdiff> 20942 </maxdate> 20943 <size_rowset>__rowset__</size_rowset> 20944 <sleep_time_empty>10</sleep_time_empty> 20945 <sleep_time_full>10</sleep_time_full> 20946 <unique_connections>N</unique_connections> 20947 <feedback_shown>Y</feedback_shown> 20948 <feedback_size>500000</feedback_size> 20949 <using_thread_priorities>Y</using_thread_priorities> 20950 <shared_objects_file/> 20951 <capture_step_performance>Y</capture_step_performance> 20952 <step_performance_capturing_delay>1000</step_performance_capturing_delay> 20953 <step_performance_capturing_size_limit>100</step_performance_capturing_size_limit> 20954 <dependencies> 20955 </dependencies> 20956 <partitionschemas> 20957 </partitionschemas> 20958 <slaveservers> 20959 </slaveservers> 20960 <clusterschemas> 20961 </clusterschemas> 20962 <created_user>-</created_user> 20963 <created_date>2013/02/28 14:04:49.560</created_date> 20964 <modified_user>-</modified_user> 20965 <modified_date>2013/03/01 12:35:39.999</modified_date> 20966 </info> 20967 <notepads> 20968 </notepads> 20969 <connection> 20970 <name>__oracle_db__</name> 20971 <server>__oracle_host__</server> 20972 <type>ORACLE</type> 20973 <access>Native</access> 20974 <database>__oracle_instance__</database> 20975 <port>__oracle_port__</port> 20976 <username>__oracle_username__</username> 20977 <password>__oracle_password__</password> 20978 <servername/> 20979 <data_tablespace/> 20980 <index_tablespace/> 20981 <attributes> 20982 <attribute><code>EXTRA_OPTION_ORACLE.defaultRowPrefetch</code><attribute>10000</attribute></attribute> 20983 <attribute><code>EXTRA_OPTION_ORACLE.fetchSize</code><attribute>1000</attribute></attribute> 20984 <attribute><code>FORCE_IDENTIFIERS_TO_LOWERCASE</code><attribute>N</attribute></attribute> 20985 <attribute><code>FORCE_IDENTIFIERS_TO_UPPERCASE</code><attribute>N</attribute></attribute> 20986 <attribute><code>IS_CLUSTERED</code><attribute>N</attribute></attribute> 20987 <attribute><code>PORT_NUMBER</code><attribute>__oracle_port__</attribute></attribute> 20988 <attribute><code>QUOTE_ALL_FIELDS</code><attribute>N</attribute></attribute> 20989 <attribute><code>SUPPORTS_BOOLEAN_DATA_TYPE</code><attribute>N</attribute></attribute> 20990 <attribute><code>USE_POOLING</code><attribute>N</attribute></attribute> 20991 </attributes> 20992 </connection> 20993 <connection> 20994 <name>__postgres_db__</name> 20995 <server>__postgres_host__</server> 20996 <type>POSTGRESQL</type> 20997 <access>Native</access> 20998 <database>__postgres_database_name__</database> 20999 <port>__postgres_port__</port> 21000 <username>__postgres_username__</username> 21001 <password>__postgres_password__</password> 21002 <servername/> 21003 <data_tablespace/> 21004 <index_tablespace/> 21005 <attributes> 21006 <attribute><code>FORCE_IDENTIFIERS_TO_LOWERCASE</code><attribute>N</attribute></attribute> 21007 <attribute><code>FORCE_IDENTIFIERS_TO_UPPERCASE</code><attribute>N</attribute></attribute> 21008 <attribute><code>IS_CLUSTERED</code><attribute>N</attribute></attribute> 21009 <attribute><code>PORT_NUMBER</code><attribute>__postgres_port__</attribute></attribute> 21010 <attribute><code>QUOTE_ALL_FIELDS</code><attribute>N</attribute></attribute> 21011 <attribute><code>SUPPORTS_BOOLEAN_DATA_TYPE</code><attribute>Y</attribute></attribute> 21012 <attribute><code>USE_POOLING</code><attribute>N</attribute></attribute> 21013 <attribute><code>EXTRA_OPTION_POSTGRESQL.synchronous_commit</code><attribute>__sync_commit_onoff__</attribute></attribute> 21014 </attributes> 21015 </connection> 21016 <order> 21017 <hop> <from>Table input</from><to>Modified Java Script Value</to><enabled>Y</enabled> </hop> <hop> <from>Modified Java Script Value</from><to>Table output</to><enabled>Y</enabled> </hop> 21018 21019 </order> 21020 <step> 21021 <name>Table input</name> 21022 <type>TableInput</type> 21023 <description/> 21024 <distribute>Y</distribute> 21025 <copies>__select_copies__</copies> 21026 <partitioning> 21027 <method>none</method> 21028 <schema_name/> 21029 </partitioning> 21030 <connection>__oracle_db__</connection> 21031 <sql>__select_query__</sql> 21032 <limit>0</limit> 21033 <lookup/> 21034 <execute_each_row>N</execute_each_row> 21035 <variables_active>N</variables_active> 21036 <lazy_conversion_active>N</lazy_conversion_active> 21037 <cluster_schema/> 21038 <remotesteps> <input> </input> <output> </output> </remotesteps> <GUI> 21039 <xloc>122</xloc> 21040 <yloc>160</yloc> 21041 <draw>Y</draw> 21042 </GUI> 21043 </step> 21044 21045 <step> 21046 <name>Table output</name> 21047 <type>TableOutput</type> 21048 <description/> 21049 <distribute>Y</distribute> 21050 <copies>__insert_copies__</copies> 21051 <partitioning> 21052 <method>none</method> 21053 <schema_name/> 21054 </partitioning> 21055 <connection>__postgres_db__</connection> 21056 <schema/> 21057 <table>__postgres_table_name__</table> 21058 <commit>__commit_size__</commit> 21059 <truncate>__truncate__</truncate> 21060 <ignore_errors>Y</ignore_errors> 21061 <use_batch>Y</use_batch> 21062 <specify_fields>N</specify_fields> 21063 <partitioning_enabled>N</partitioning_enabled> 21064 <partitioning_field/> 21065 <partitioning_daily>N</partitioning_daily> 21066 <partitioning_monthly>Y</partitioning_monthly> 21067 <tablename_in_field>N</tablename_in_field> 21068 <tablename_field/> 21069 <tablename_in_table>Y</tablename_in_table> 21070 <return_keys>N</return_keys> 21071 <return_field/> 21072 <fields> 21073 </fields> 21074 <cluster_schema/> 21075 <remotesteps> <input> </input> <output> </output> </remotesteps> <GUI> 21076 <xloc>369</xloc> 21077 <yloc>155</yloc> 21078 <draw>Y</draw> 21079 </GUI> 21080 </step> 21081 21082 <step> 21083 <name>Modified Java Script Value</name> 21084 <type>ScriptValueMod</type> 21085 <description/> 21086 <distribute>Y</distribute> 21087 <copies>__js_copies__</copies> 21088 <partitioning> 21089 <method>none</method> 21090 <schema_name/> 21091 </partitioning> 21092 <compatible>N</compatible> 21093 <optimizationLevel>9</optimizationLevel> 21094 <jsScripts> <jsScript> <jsScript_type>0</jsScript_type> 21095 <jsScript_name>Script 1</jsScript_name> 21096 <jsScript_script>for (var i=0;i<getInputRowMeta().size();i++) { 21097 var valueMeta = getInputRowMeta().getValueMeta(i); 21098 if (valueMeta.getTypeDesc().equals("String")) { 21099 row[i]=replace(row[i],"\\00",''); 21100 } 21101} </jsScript_script> 21102 </jsScript> </jsScripts> <fields> </fields> <cluster_schema/> 21103 <remotesteps> <input> </input> <output> </output> </remotesteps> <GUI> 21104 <xloc>243</xloc> 21105 <yloc>166</yloc> 21106 <draw>Y</draw> 21107 </GUI> 21108 </step> 21109 21110 <step_error_handling> 21111 </step_error_handling> 21112 <slave-step-copy-partition-distribution> 21113</slave-step-copy-partition-distribution> 21114 <slave_transformation>N</slave_transformation> 21115</transformation> 21116EOF 21117 21118} 21119 21120# Constants for creating kettle files from the template 21121sub create_kettle_output 21122{ 21123 my ($self, $table, $output_dir) = @_; 21124 21125 my $oracle_host = 'localhost'; 21126 if ($self->{oracle_dsn} =~ /host=([^;]+)/) { 21127 $oracle_host = $1; 21128 } 21129 my $oracle_port = 1521; 21130 if ($self->{oracle_dsn} =~ /port=(\d+)/) { 21131 $oracle_port = $1; 21132 } 21133 my $oracle_instance=''; 21134 if ($self->{oracle_dsn} =~ /sid=([^;]+)/) { 21135 $oracle_instance = $1; 21136 } elsif ($self->{oracle_dsn} =~ /dbi:Oracle:([^:]+)/) { 21137 $oracle_instance = $1; 21138 } 21139 if ($self->{oracle_dsn} =~ /\/\/([^:]+):(\d+)\/(.*)/) { 21140 $oracle_host = $1; 21141 $oracle_port = $2; 21142 $oracle_instance = $3; 21143 } elsif ($self->{oracle_dsn} =~ /\/\/([^\/]+)\/(.*)/) { 21144 $oracle_host = $1; 21145 $oracle_instance = $2; 21146 } 21147 21148 my $pg_host = 'localhost'; 21149 if ($self->{pg_dsn} =~ /host=([^;]+)/) { 21150 $pg_host = $1; 21151 } 21152 my $pg_port = 5432; 21153 if ($self->{pg_dsn} =~ /port=(\d+)/) { 21154 $pg_port = $1; 21155 } 21156 my $pg_dbname = ''; 21157 if ($self->{pg_dsn} =~ /dbname=([^;]+)/) { 21158 $pg_dbname = $1; 21159 } 21160 21161 my $select_query = "SELECT * FROM $table"; 21162 if ($self->{schema}) { 21163 $select_query = "SELECT * FROM $self->{schema}.$table"; 21164 } 21165 my $select_copies = $self->{oracle_copies} || 1; 21166 if (($self->{oracle_copies} > 1) && $self->{defined_pk}{"\L$table\E"}) { 21167 my $colpk = $self->{defined_pk}{"\L$table\E"}; 21168 if ($self->{preserve_case}) { 21169 $colpk = '"' . $colpk . '"'; 21170 } 21171 if ($self->{schema}) { 21172 $select_query = "SELECT * FROM $self->{schema}.$table WHERE ABS(MOD($colpk,\${Internal.Step.Unique.Count}))=\${Internal.Step.Unique.Number}"; 21173 } else { 21174 $select_query = "SELECT * FROM $table WHERE ABS(MOD($colpk,\${Internal.Step.Unique.Count}))=\${Internal.Step.Unique.Number}"; 21175 } 21176 } else { 21177 $select_copies = 1; 21178 } 21179 21180 my $insert_copies = $self->{jobs} || 4; 21181 my $js_copies = $insert_copies; 21182 my $rowset = $self->{data_limit} || 10000; 21183 if (exists $self->{local_data_limit}{$table}) { 21184 $rowset = $self->{local_data_limit}{$table}; 21185 } 21186 my $commit_size = 500; 21187 my $sync_commit_onoff = 'off'; 21188 my $truncate = 'Y'; 21189 $truncate = 'N' if (!$self->{truncate_table}); 21190 21191 my $pg_table = $table; 21192 if ($self->{export_schema}) { 21193 if ($self->{pg_schema}) { 21194 $pg_table = "$self->{pg_schema}.$table"; 21195 } elsif ($self->{schema}) { 21196 $pg_table = "$self->{schema}.$table"; 21197 } 21198 } 21199 21200 my $xml = &get_kettle_xml(); 21201 $xml =~ s/__oracle_host__/$oracle_host/gs; 21202 $xml =~ s/__oracle_instance__/$oracle_instance/gs; 21203 $xml =~ s/__oracle_port__/$oracle_port/gs; 21204 $xml =~ s/__oracle_username__/$self->{oracle_user}/gs; 21205 $xml =~ s/__oracle_password__/$self->{oracle_pwd}/gs; 21206 $xml =~ s/__postgres_host__/$pg_host/gs; 21207 $xml =~ s/__postgres_database_name__/$pg_dbname/gs; 21208 $xml =~ s/__postgres_port__/$pg_port/gs; 21209 $xml =~ s/__postgres_username__/$self->{pg_user}/gs; 21210 $xml =~ s/__postgres_password__/$self->{pg_pwd}/gs; 21211 $xml =~ s/__select_copies__/$select_copies/gs; 21212 $xml =~ s/__select_query__/$select_query/gs; 21213 $xml =~ s/__insert_copies__/$insert_copies/gs; 21214 $xml =~ s/__js_copies__/$js_copies/gs; 21215 $xml =~ s/__truncate__/$truncate/gs; 21216 $xml =~ s/__transformation_name__/$table/gs; 21217 $xml =~ s/__postgres_table_name__/$pg_table/gs; 21218 $xml =~ s/__rowset__/$rowset/gs; 21219 $xml =~ s/__commit_size__/$commit_size/gs; 21220 $xml =~ s/__sync_commit_onoff__/$sync_commit_onoff/gs; 21221 21222 my $fh = new IO::File; 21223 $fh->open(">$output_dir$table.ktr") or $self->logit("FATAL: can't write to $output_dir$table.ktr, $!\n", 0, 1); 21224 $fh->print($xml); 21225 $self->close_export_file($fh); 21226 21227 return "JAVAMAXMEM=4096 ./pan.sh -file \$KETTLE_TEMPLATE_PATH/$output_dir$table.ktr -level Detailed\n"; 21228} 21229 21230# Normalize SQL queries by removing parameters 21231sub normalize_query 21232{ 21233 my ($self, $orig_query) = @_; 21234 21235 return if (!$orig_query); 21236 21237 # Remove comments 21238 $orig_query =~ s/\/\*(.*?)\*\///gs; 21239 21240 # Set the entire query lowercase 21241 $orig_query = lc($orig_query); 21242 21243 # Remove extra space, new line and tab characters by a single space 21244 $orig_query =~ s/\s+/ /gs; 21245 21246 # Removed start of transaction 21247 if ($orig_query !~ /^\s*begin\s*;\s*$/) { 21248 $orig_query =~ s/^\s*begin\s*;\s*//gs 21249 } 21250 21251 # Remove string content 21252 $orig_query =~ s/\\'//g; 21253 $orig_query =~ s/'[^']*'/''/g; 21254 $orig_query =~ s/''('')+/''/g; 21255 21256 # Remove NULL parameters 21257 $orig_query =~ s/=\s*NULL/=''/g; 21258 21259 # Remove numbers 21260 $orig_query =~ s/([^a-z_\$-])-?([0-9]+)/${1}0/g; 21261 21262 # Remove hexadecimal numbers 21263 $orig_query =~ s/([^a-z_\$-])0x[0-9a-f]{1,10}/${1}0x/g; 21264 21265 # Remove IN values 21266 $orig_query =~ s/in\s*\([\'0x,\s]*\)/in (...)/g; 21267 21268 return $orig_query; 21269} 21270 21271sub _escape_lob 21272{ 21273 my ($self, $col, $generic_type, $cond, $isnested) = @_; 21274 21275 if ($self->{type} eq 'COPY') { 21276 if ( ($generic_type eq 'BLOB') || ($generic_type eq 'RAW') ) { 21277 # RAW data type is returned in hex 21278 $col = unpack("H*",$col) if ($generic_type ne 'RAW'); 21279 $col = "\\\\x" . $col; 21280 } elsif (($generic_type eq 'CLOB') || $cond->{istext}) { 21281 $col = $self->escape_copy($col, $isnested); 21282 } 21283 } else { 21284 if ( ($generic_type eq 'BLOB') || ($generic_type eq 'RAW') ) { 21285 #$col = escape_bytea($col); 21286 # RAW data type is returned in hex 21287 $col = unpack("H*",$col) if ($generic_type ne 'RAW'); 21288 if (!$self->{standard_conforming_strings}) { 21289 $col = "'$col'"; 21290 } else { 21291 $col = "E'$col'"; 21292 } 21293 $col = "decode($col, 'hex')"; 21294 } elsif (($generic_type eq 'CLOB') || $cond->{istext}) { 21295 $col = $self->escape_insert($col, $isnested); 21296 } 21297 } 21298 21299 return $col; 21300} 21301 21302sub escape_copy 21303{ 21304 my ($self, $col, $isnested) = @_; 21305 21306 my $q = "'"; 21307 $q = '"' if ($isnested); 21308 21309 if ($self->{has_utf8_fct}) { 21310 utf8::encode($col) if (!utf8::valid($col)); 21311 } 21312 # Escape some character for COPY output 21313 $col =~ s/(\0|\\|\r|\n|\t)/$ESCAPE_COPY->{$1}/gs; 21314 if (!$self->{noescape}) { 21315 $col =~ s/\f/\\f/gs; 21316 $col =~ s/([\1-\10\13-\14\16-\37])/sprintf("\\%03o", ord($1))/egs; 21317 } 21318 21319 return $col; 21320} 21321 21322sub escape_insert 21323{ 21324 my ($self, $col, $isnested) = @_; 21325 21326 my $q = "'"; 21327 $q = '"' if ($isnested); 21328 21329 if (!$self->{standard_conforming_strings}) { 21330 $col =~ s/'/''/gs; # double single quote 21331 if ($isnested) { 21332 $col =~ s/"/\\"/gs; # escape double quote 21333 } 21334 $col =~ s/\\/\\\\/gs; 21335 $col =~ s/\0//gs; 21336 $col = "$q$col$q"; 21337 } else { 21338 $col =~ s/\0//gs; 21339 $col =~ s/\\/\\\\/gs; 21340 $col =~ s/\r/\\r/gs; 21341 $col =~ s/\n/\\n/gs; 21342 if ($isnested) { 21343 $col =~ s/'/''/gs; # double single quote 21344 $col =~ s/"/\\"/gs; # escape double quote 21345 $col = "$q$col$q"; 21346 } else { 21347 $col =~ s/'/\\'/gs; # escape single quote 21348 $col = "E'$col'"; 21349 } 21350 } 21351 return $col; 21352} 21353 21354sub clear_global_declaration 21355{ 21356 my ($self, $pname, $str, $is_pkg_body) = @_; 21357 21358 # Remove comment 21359 $str =~ s/\%ORA2PG_COMMENT\d+\%//igs; 21360 21361 # remove pragma restrict_references 21362 $str =~ s/PRAGMA\s+RESTRICT_REFERENCES\s*\([^;]+;//igs; 21363 21364 # Remove all function/procedure declaration from the content 21365 if (!$is_pkg_body) { 21366 $str =~ s/\b(PROCEDURE|FUNCTION)\s+[^;]+;//igs; 21367 } else { 21368 while ($str =~ s/\b(PROCEDURE|FUNCTION)\s+.*?END[^;]*;((?:(?!\bEND\b).)*\s+(?:PROCEDURE|FUNCTION)\s+)/$2/is) { 21369 }; 21370 $str =~ s/(PROCEDURE|FUNCTION).*END[^;]*;//is; 21371 } 21372 # Remove end of the package declaration 21373 $str =~ s/\s+END[^;]*;\s*$//igs; 21374 # Eliminate extra newline 21375 $str =~ s/[\r\n]+/\n/isg; 21376 21377 my @cursors = (); 21378 while ($str =~ s/(CURSOR\s+[^;]+\s+RETURN\s+[^;]+;)//is) { 21379 push(@cursors, $1); 21380 } 21381 # Extract TYPE/SUBTYPE declaration 21382 my $i = 0; 21383 while ($str =~ s/\b(SUBTYPE|TYPE)\s+([^\s\(\)]+)\s+(AS|IS)\s+([^;]+;)//is) { 21384 $self->{pkg_type}{$pname}{$2} = "$pname.$2"; 21385 my $code = "$1 $self->{pkg_type}{$pname}{$2} AS $4"; 21386 push(@{$self->{types}}, { ('name' => $2, 'code' => $code, 'pos' => $i++) }); 21387 } 21388 21389 return ($str, @cursors); 21390} 21391 21392 21393sub register_global_variable 21394{ 21395 my ($self, $pname, $glob_vars) = @_; 21396 21397 $glob_vars = Ora2Pg::PLSQL::replace_sql_type($glob_vars, $self->{pg_numeric_type}, $self->{default_numeric}, $self->{pg_integer_type}, %{$self->{data_type}}); 21398 21399 # Replace PL/SQL code into PL/PGSQL similar code 21400 $glob_vars = Ora2Pg::PLSQL::convert_plsql_code($self, $glob_vars); 21401 21402 my @vars = split(/\s*(\%ORA2PG_COMMENT\d+\%|;)\s*/, $glob_vars); 21403 map { s/^\s+//; s/\s+$//; } @vars; 21404 my $ret = ''; 21405 foreach my $l (@vars) 21406 { 21407 if ($l eq ';' || $l =~ /ORA2PG_COMMENT/ || $l =~ /^CREATE\s+/i) { 21408 $ret .= $l if ($l ne ';'); 21409 next; 21410 } 21411 next if (!$l); 21412 $l =~ s/\-\-[^\r\n]+//sg; 21413 $l =~ s/\s*:=\s*/ := /igs; 21414 my ($n, $type, @others) = split(/\s+/, $l); 21415 $ret .= $l, next if (!$type); 21416 if (!$n) { 21417 $n = $type; 21418 $type = $others[0] || ''; 21419 } 21420 if (uc($type) eq 'EXCEPTION') { 21421 $n = lc($n); 21422 if (!exists $self->{custom_exception}{$n}) { 21423 $self->{custom_exception}{$n} = $self->{exception_id}++; 21424 } 21425 next; 21426 } 21427 next if (!$pname); 21428 my $v = lc($pname . '.' . $n); 21429 $self->{global_variables}{$v}{name} = lc($n); 21430 if (uc($type) eq 'CONSTANT') 21431 { 21432 $type = ''; 21433 $self->{global_variables}{$v}{constant} = 1; 21434 for (my $j = 0; $j < $#others; $j++) 21435 { 21436 $type .= $others[$j] if ($others[$j] ne ':=' and uc($others[$j]) ne 'DEFAULT'); 21437 } 21438 } 21439 # extract the default value from the declaration 21440 for (my $j = 0; $j < $#others; $j++) 21441 { 21442 $self->{global_variables}{$v}{default} = $others[$j+1] if ($others[$j] eq ':=' or uc($others[$j]) eq 'DEFAULT'); 21443 } 21444 if (exists $self->{global_variables}{$v}{default}) 21445 { 21446 $self->_restore_text_constant_part(\$self->{global_variables}{$v}{default}); 21447 $self->{global_variables}{$v}{default} =~ s/^'//s; 21448 $self->{global_variables}{$v}{default} =~ s/'$//s; 21449 } 21450 $self->{global_variables}{$v}{type} = $type; 21451 21452 # Handle Oracle user defined error code 21453 if ($self->{global_variables}{$v}{constant} && ($type =~ /bigint|int|numeric|double/) 21454 && $self->{global_variables}{$v}{default} <= -20000 && $self->{global_variables}{$v}{default} >= -20999) 21455 { 21456 # Change the type into char(5) for SQLSTATE type 21457 $self->{global_variables}{$v}{type} = 'char(5)'; 21458 # Transform the value to match PostgreSQL user defined exceptions starting with 45 21459 $self->{global_variables}{$v}{default} =~ s/^-20/45/; 21460 } 21461 } 21462 21463 return $ret; 21464} 21465 21466sub remove_newline 21467{ 21468 my $str = shift; 21469 21470 $str =~ s/[\n\r]+\s*/ /gs; 21471 21472 return $str; 21473} 21474 21475sub _ask_username { 21476 my $self = shift; 21477 my $target = shift; 21478 21479 print 'Enter ' . $target . ' username: '; 21480 my $username = ReadLine(0); 21481 chomp($username); 21482 21483 return $username; 21484} 21485 21486sub _ask_password { 21487 my $self = shift; 21488 my $target = shift; 21489 21490 print 'Enter ' . $target . ' password: '; 21491 ReadMode(2); 21492 my $password = ReadLine(0); 21493 ReadMode(0); 21494 chomp($password); 21495 print "\n"; 21496 21497 return $password; 21498} 21499 21500############## 21501# Prefix function calls with their package name when necessary 21502############## 21503sub normalize_function_call 21504{ 21505 my ($self, $str) = @_; 21506 21507 return if (!$self->{current_package}); 21508 21509 my $p = lc($self->{current_package}); 21510 21511 # foreach function declared in a package qualify its callis with the package name 21512 foreach my $f (keys %{$self->{package_functions}{$p}}) { 21513 # If the package is already prefixed to the function name in the hash take it from here 21514 if (lc($self->{package_functions}{$p}{$f}{name}) ne lc($f)) { 21515 $$str =~ s/([^\.])\b$f\s*([\(;])/$1$self->{package_functions}{$p}{$f}{name}$2/igs; 21516 } elsif (exists $self->{package_functions}{$p}{$f}{package}) { 21517 # otherwise use the package name from the hash and the function name from the string 21518 $$str =~ s/([^\.])\b($f\s*[\(;])/$1$self->{package_functions}{$p}{$f}{package}\.$2/igs; 21519 } 21520 21521 # Append parenthesis to functions without parameters 21522 $$str =~ s/\b($self->{package_functions}{$p}{$f}{package}\.$f)\b((?!\s*\())/$1()$2/igs; 21523 } 21524 # Fix unwanted double parenthesis 21525 #$$str =~ s/\(\)\s*(\()/ $1/gs; 21526 21527} 21528 21529############## 21530# Requalify function calls 21531############## 21532sub requalify_function_call 21533{ 21534 my ($self, $str) = @_; 21535 21536 # Loop through package 21537 foreach my $p (keys %{$self->{package_functions}}) { 21538 # foreach function declared in a package qualify its callis with the package name 21539 foreach my $f (keys %{$self->{package_functions}{$p}}) { 21540 $$str =~ s/\b$p\.$f\s*([\(;])/$self->{package_functions}{$p}{$f}{name}$1/igs; 21541 } 21542 } 21543} 21544 21545 21546sub _make_WITH 21547{ 21548 my ($with_oid, $table_info) = @_; 21549 my @withs =(); 21550 push @withs, 'OIDS' if ($with_oid); 21551 push @withs, 'fillfactor=' . $table_info->{fillfactor} if (exists $table_info->{fillfactor}); 21552 my $WITH=''; 21553 if (@withs>0) { 21554 $WITH .= 'WITH (' . join(",",@withs) . ')'; 21555 } 21556 return $WITH; 21557} 21558 21559sub min 21560{ 21561 return $_[0] if ($_[0] < $_[1]); 21562 21563 return $_[1]; 21564} 21565 21566sub _create_foreign_server 21567{ 21568 my $self = shift; 21569 21570 # Verify that the oracle_fdw extension is created, create it if not 21571 my $sth = $self->{dbhdest}->prepare("SELECT * FROM pg_extension WHERE extname=?") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 21572 $sth->execute('oracle_fdw') or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 21573 my $row = $sth->fetch; 21574 $sth->finish; 21575 if (not defined $row) 21576 { 21577 # try to create the extension 21578 $self->{dbhdest}->do("CREATE EXTENSION oracle_fdw") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 21579 } 21580 21581 # Check if the server already exists or need to be created 21582 $sth = $self->{dbhdest}->prepare("SELECT * FROM pg_foreign_server WHERE srvname=?") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 21583 $sth->execute($self->{fdw_server}) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 21584 $row = $sth->fetch; 21585 $sth->finish; 21586 if (not defined $row) 21587 { 21588 # try to create the foreign server 21589 if (!defined $self->{oracle_pwd}) 21590 { 21591 eval("use Term::ReadKey;") unless $self->{oracle_user} eq '/'; 21592 $self->{oracle_user} = $self->_ask_username('Oracle') unless (defined $self->{oracle_user}); 21593 $self->{oracle_pwd} = $self->_ask_password('Oracle') unless ($self->{oracle_user} eq '/'); 21594 } 21595 my $ora_session_mode = ($self->{oracle_user} eq "/" || $self->{oracle_user} eq "sys") ? 2 : undef; 21596 21597 $self->logit("ORACLE_HOME = $ENV{ORACLE_HOME}\n", 1); 21598 $self->logit("NLS_LANG = $ENV{NLS_LANG}\n", 1); 21599 $self->logit("NLS_NCHAR = $ENV{NLS_NCHAR}\n", 1); 21600 $self->logit("Trying to connect to database: $self->{oracle_dsn}\n", 1) if (!$quiet); 21601 21602 if (!$self->{fdw_server}) { 21603 $self->logit("FATAL: a foreign server name must be set using FWD_SERVER\n", 0, 1); 21604 } 21605 if ($self->{oracle_dsn} =~ /(\/\/.*\/.*)/) 21606 { 21607 $self->{oracle_fwd_dsn} = $1; 21608 } 21609 else 21610 { 21611 $self->{oracle_dsn} =~ /host=([^;]+)/; 21612 my $host = $1 || 'localhost'; 21613 $self->{oracle_dsn} =~ /port=(\d+)/; 21614 my $port = $1 || 1521; 21615 $self->{oracle_dsn} =~ /(service_name|sid)=([^;]+)/; 21616 my $sid = $2 || ''; 21617 $self->{oracle_fwd_dsn} = "//$host:$port/$sid"; 21618 } 21619 my $sql = "CREATE SERVER $self->{fdw_server} FOREIGN DATA WRAPPER oracle_fdw OPTIONS (dbserver '$self->{oracle_fwd_dsn}');"; 21620 $self->{dbhdest}->do($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 21621 } 21622 21623 # Create the user mapping if it not exists 21624 my $sql = "CREATE USER MAPPING IF NOT EXISTS FOR $self->{pg_user} SERVER $self->{fdw_server} OPTIONS (user '$self->{oracle_user}', password '$self->{oracle_pwd}');"; 21625 $self->{dbhdest}->do($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 21626} 21627 21628sub _select_foreign_objects 21629{ 21630 my $self = shift; 21631 21632 # With reports we don't have object name limitation 21633 return if ($self->{type} ne 'TEST_DATA'); 21634 21635 my $str = ''; 21636 my @limit_to = (); 21637 my @except = (); 21638 21639 for (my $j = 0; $j <= $#{$self->{limited}{TABLE}}; $j++) { 21640 push(@limit_to, '"' . uc($self->{limited}{TABLE}->[$j]) . '"'); 21641 } 21642 21643 if ($#limit_to == -1) 21644 { 21645 for (my $j = 0; $j <= $#{$self->{excluded}{TABLE}}; $j++) { 21646 push(@except, '"'. uc($self->{excluded}{TABLE}->[$j] . '"')); 21647 } 21648 if ($#except > -1) { 21649 $str = " EXCEPT ( " . join(', ', @except) . ")"; 21650 } 21651 } else { 21652 $str = " LIMIT TO ( " . join(', ', @limit_to) . ")"; 21653 } 21654 21655 return $str; 21656} 21657 21658sub _import_foreign_schema 21659{ 21660 my $self = shift; 21661 21662 # Drop and recreate the import schema 21663 $self->{dbhdest}->do("DROP SCHEMA IF EXISTS ora2pg_fdw_import CASCADE") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 21664 $self->{dbhdest}->do("CREATE SCHEMA ora2pg_fdw_import") or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 21665 # Import foreign table into the dedicated schema ora2pg_fdw_import 21666 my $sql = "IMPORT FOREIGN SCHEMA \"\U$self->{schema}\E\""; 21667 $sql .= $self->_select_foreign_objects(); 21668 $sql .= " FROM SERVER $self->{fdw_server} INTO ora2pg_fdw_import OPTIONS (case 'keep', readonly 'true')"; 21669 $self->{dbhdest}->do($sql) or $self->logit("FATAL: " . $self->{dbhdest}->errstr . "\n", 0, 1); 21670} 21671 216721; 21673 21674__END__ 21675 21676 21677=head1 AUTHOR 21678 21679Gilles Darold <gilles _AT_ darold _DOT_ net> 21680 21681 21682=head1 COPYRIGHT 21683 21684Copyright (c) 2000-2021 Gilles Darold - All rights reserved. 21685 21686 This program is free software: you can redistribute it and/or modify 21687 it under the terms of the GNU General Public License as published by 21688 the Free Software Foundation, either version 3 of the License, or 21689 any later version. 21690 21691 This program is distributed in the hope that it will be useful, 21692 but WITHOUT ANY WARRANTY; without even the implied warranty of 21693 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21694 GNU General Public License for more details. 21695 21696 You should have received a copy of the GNU General Public License 21697 along with this program. If not, see < http://www.gnu.org/licenses/ >. 21698 21699 21700=head1 SEE ALSO 21701 21702L<DBD::Oracle>, L<DBD::Pg> 21703 21704 21705=cut 21706