1package Ora2Pg::PLSQL; 2#------------------------------------------------------------------------------ 3# Project : Oracle to PostgreSQL database schema converter 4# Name : Ora2Pg/PLSQL.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 : Perl module used to convert Oracle PLSQL code into PL/PGSQL 9# Usage : See documentation 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 %OBJECT_SCORE $SIZE_SCORE $FCT_TEST_SCORE $QUERY_TEST_SCORE %UNCOVERED_SCORE %UNCOVERED_MYSQL_SCORE @ORA_FUNCTIONS @MYSQL_SPATIAL_FCT @MYSQL_FUNCTIONS %EXCEPTION_MAP %MAX_SCORE); 28use POSIX qw(locale_h); 29 30#set locale to LC_NUMERIC C 31setlocale(LC_NUMERIC,"C"); 32 33 34$VERSION = '22.1'; 35 36#---------------------------------------------------- 37# Cost scores used when converting PLSQL to PLPGSQL 38#---------------------------------------------------- 39 40# Scores associated to each database objects: 41%OBJECT_SCORE = ( 42 'CLUSTER' => 0, # Not supported and no equivalent 43 'FUNCTION' => 1, # read/adapt the header 44 'INDEX' => 0.1, # Read/adapt - use varcharops like operator ? 45 'FUNCTION-BASED-INDEX' => 0.2, # Check code of function call 46 'REV-INDEX' => 1, # Check/rewrite the index to use trigram 47 'CHECK' => 0.1, # Check/adapt the check constraint 48 'MATERIALIZED VIEW' => 3, # Read/adapt, will just concern automatic snapshot export 49 'PACKAGE BODY' => 3, # Look at globals variables and global 50 'PROCEDURE' => 1, # read/adapt the header 51 'SEQUENCE' => 0.1, # read/adapt to convert name.nextval() into nextval('name') 52 'TABLE' => 0.1, # read/adapt the column type/name 53 'TABLE PARTITION' => 0.1, # Read/check that table partitionning is ok 54 'TABLE SUBPARTITION' => 0.2, # Read/check that table sub partitionning is ok 55 'TRIGGER' => 1, # read/adapt the header 56 'TYPE' => 1, # read 57 'TYPE BODY' => 10, # Not directly supported need adaptation 58 'VIEW' => 1, # read/adapt 59 'DATABASE LINK' => 3, # Supported as FDW using oracle_fdw 60 'GLOBAL TEMPORARY TABLE' => 10, # supported, but not permanent in PostgreSQL 61 'DIMENSION' => 0, # Not supported and no equivalent 62 'JOB' => 2, # read/adapt 63 'SYNONYM' => 0.1, # read/adapt 64 'QUERY' => 0.2, # read/adapt 65 'ENCRYPTED COLUMN' => 20, ## adapt using pg_crypto 66); 67 68# Max score to applicate per type of object 69%MAX_SCORE = ( 70 'INDEX' => 288, # 3 man days 71 'SEQUENCE' => 288, # 3 man days 72 'TABLE' => 672, # 7 man days 73 'TABLE PARTITION' => 480, # 5 man days 74 'TABLE SUBPARTITION' => 480, # 5 man days 75 'GLOBAL TEMPORARY TABLE' => 288, # 3 man days 76 'SYNONYM' => 192, # 2 man days 77); 78 79# Scores following the number of characters: 1000 chars for one unit. 80# Note: his correspond to the global read time not to the difficulty. 81$SIZE_SCORE = 1000; 82 83# Cost to apply on each function or query for testing 84$FCT_TEST_SCORE = 2; 85$QUERY_TEST_SCORE = 0.1; 86 87# Scores associated to each code difficulties. 88%UNCOVERED_SCORE = ( 89 'TRUNC' => 0.1, 90 'IS TABLE OF' => 4, 91 'OUTER JOIN' => 2, 92 'CONNECT BY' => 3, 93 'BULK COLLECT' => 5, 94 'GOTO' => 2, 95 'FORALL' => 1, 96 'ROWNUM' => 1, 97 'NOTFOUND' => 0, 98 'ISOPEN' => 1, 99 'ROWCOUNT' => 1, 100 'ROWID' => 2, 101 'UROWID' => 2, 102 'IS RECORD' => 1, 103 'SQLCODE' => 1, 104 'TABLE' => 2, 105 'DBMS_' => 3, 106 'DBMS_OUTPUT.put' => 1, 107 'UTL_' => 3, 108 'CTX_' => 3, 109 'EXTRACT' => 0.1, 110 'EXCEPTION' => 2, 111 'TO_NUMBER' => 0.1, 112 'REGEXP_LIKE' => 0.1, 113 'REGEXP_COUNT' => 0.2, 114 'REGEXP_INSTR' => 1, 115 'REGEXP_SUBSTR' => 1, 116 'TG_OP' => 0, 117 'CURSOR' => 1, 118 'PIPE ROW' => 1, 119 'ORA_ROWSCN' => 3, 120 'SAVEPOINT' => 1, 121 'DBLINK' => 1, 122 'PLVDATE' => 2, 123 'PLVSTR' => 2, 124 'PLVCHR' => 2, 125 'PLVSUBST' => 2, 126 'PLVLEX' => 2, 127 'PLUNIT' => 2, 128 'ADD_MONTHS' => 0.1, 129 'LAST_DAY' => 1, 130 'NEXT_DAY' => 1, 131 'MONTHS_BETWEEN' => 1, 132 'SDO_' => 3, 133 'PRAGMA' => 3, 134 'MDSYS' => 1, 135 'MERGE INTO' => 3, 136 'COMMIT' => 1, 137 'CONTAINS' => 1, 138 'SCORE' => 1, 139 'FUZZY' => 1, 140 'NEAR' => 1, 141 'TO_CHAR' => 0.1, 142 'TO_NCHAR' => 0.1, 143 'ANYDATA' => 2, 144 'CONCAT' => 0.1, 145 'TIMEZONE' => 1, 146 'JSON' => 3, 147 'TO_CLOB' => 0.1 148); 149 150@ORA_FUNCTIONS = qw( 151 AsciiStr 152 Compose 153 Decompose 154 Dump 155 VSize 156 Bin_To_Num 157 CharToRowid 158 HexToRaw 159 NumToDSInterval 160 NumToYMInterval 161 RawToHex 162 To_Clob 163 To_DSInterval 164 To_Lob 165 To_Multi_Byte 166 To_NClob 167 To_Single_Byte 168 To_YMInterval 169 BFilename 170 Cardinality 171 Group_ID 172 LNNVL 173 NANVL 174 Sys_Context 175 Uid 176 UserEnv 177 Bin_To_Num 178 BitAnd 179 Cosh 180 Median 181 Remainder 182 Sinh 183 Tanh 184 DbTimeZone 185 New_Time 186 SessionTimeZone 187 Tz_Offset 188 Get_Env 189 From_Tz 190); 191 192@MYSQL_SPATIAL_FCT = ( 193 'AsBinary', 194 'AsText', 195 'Buffer', 196 'Centroid', 197 'Contains', 198 'Crosses', 199 'Dimension', 200 'Disjoint', 201 'EndPoint', 202 'Envelope', 203 'Equals', 204 'ExteriorRing', 205 'GeomCollFromText', 206 'GeomCollFromWKB', 207 'GeometryN', 208 'GeometryType', 209 'GeomFromText', 210 'GeomFromWKB', 211 'GLength', 212 'InteriorRingN', 213 'Intersects', 214 'IsClosed', 215 'IsSimple', 216 'LineFromText', 217 'LineFromWKB', 218 'MLineFromText', 219 'MPointFromText', 220 'MPolyFromText', 221 'NumGeometries', 222 'NumInteriorRings', 223 'NumPoints', 224 'Overlaps', 225 'Point', 226 'PointFromText', 227 'PointFromWKB', 228 'PointN', 229 'PolygonFromText', 230 'Polygon', 231 'SRID', 232 'StartPoint', 233 'Touches', 234 'Within', 235 'X', 236 'Y' 237); 238 239@MYSQL_FUNCTIONS = ( 240 'AES_DECRYPT', 241 'AES_ENCRYPT', 242 'ASYMMETRIC_DECRYPT', 243 'ASYMMETRIC_DERIVE', 244 'ASYMMETRIC_ENCRYPT', 245 'ASYMMETRIC_SIGN', 246 'ASYMMETRIC_VERIFY', 247 'CREATE_ASYMMETRIC_PRIV_KEY', 248 'CREATE_ASYMMETRIC_PUB_KEY', 249 'CREATE_DH_PARAMETERS', 250 'CREATE_DIGEST', 251 'DECODE', 252 'DES_DECRYPT', 253 'DES_ENCRYPT', 254 'ENCODE', 255 'ENCRYPT', 256 'SHA1', 257 'SHA2', 258 'COLLATION', 259 'COMPRESS', 260 'CONVERT', 261 'DEFAULT', 262 'FOUND_ROWS', 263 'GTID_SUBSET', 264 'GTID_SUBTRACT', 265 'INET6_ATON', 266 'INET6_NTOA', 267 'INTERVAL', 268 'IS_FREE_LOCK', 269 'IS_IPV4_COMPAT', 270 'IS_IPV4_MAPPED', 271 'IsEmpty', 272 'LAST_INSERT_ID', 273 'LOAD_FILE', 274 'MASTER_POS_WAIT', 275 'MATCH', 276 'OLD_PASSWORD', 277 'PERIOD_ADD', 278 'PERIOD_DIFF', 279 'RANDOM_BYTES', 280 'ROW_COUNT', 281 'SQL_THREAD_WAIT_AFTER_GTIDS', 282 'WAIT_UNTIL_SQL_THREAD_AFTER_GTIDS', 283 'UNCOMPRESS', 284 'UNCOMPRESSED_LENGTH', 285 'UpdateXML', 286 'UUID_SHORT', 287 'VALIDATE_PASSWORD_STRENGTH', 288 'WEIGHT_STRING', 289); 290 291# Scores associated to each code difficulties after replacement. 292%UNCOVERED_MYSQL_SCORE = ( 293 'ARRAY_AGG_DISTINCT' => 1, # array_agg(distinct 294 'SOUNDS LIKE' => 1, 295 'CHARACTER SET' => 1, 296 'COUNT(DISTINCT)' => 2, 297 'MATCH' => 2, 298 'JSON' => 2, 299 'LOCK' => 2, 300 '@VAR' => 0.1, 301); 302 303%EXCEPTION_MAP = ( 304 'INVALID_CURSOR' => 'invalid_cursor_state', 305 'ZERO_DIVIDE' => 'division_by_zero', 306 'STORAGE_ERROR' => 'out_of_memory', 307 'INTEGRITY_ERROR' => 'integrity_constraint_violation', 308 'VALUE_ERROR' => 'data_exception', 309 'INVALID_NUMBER' => 'data_exception', 310 'INVALID_CURSOR' => 'invalid_cursor_state', 311 'NO_DATA_FOUND' => 'no_data_found', 312 'LOGIN_DENIED' => 'connection_exception', 313 'TOO_MANY_ROWS'=> 'too_many_rows', 314 # 'PROGRAM_ERROR' => 'INTERNAL ERROR', 315 # 'ROWTYPE_MISMATCH' => 'DATATYPE MISMATCH' 316); 317 318 319=head1 NAME 320 321PSQL - Oracle to PostgreSQL procedural language converter 322 323 324=head1 SYNOPSIS 325 326 This external perl module is used to convert PLSQL code to PLPGSQL. 327 It is in an external code to allow easy editing and modification. 328 This converter is a work in progress and need your help. 329 330 It is called internally by Ora2Pg.pm when you set PLSQL_PGSQL 331 configuration option to 1. 332=cut 333 334=head2 convert_plsql_code 335 336Main function used to convert Oracle SQL and PL/SQL code into PostgreSQL 337compatible code 338 339=cut 340 341sub convert_plsql_code 342{ 343 my ($class, $str, @strings) = @_; 344 345 return if ($str eq ''); 346 347 # Replace outer join sign (+) with a placeholder 348 $class->{outerjoin_idx} //= 0; 349 while ( $str =~ s/\(\+\)/\%OUTERJOIN$class->{outerjoin_idx}\%/s ) { 350 $class->{outerjoin_idx}++; 351 } 352 353 # Do some initialization of variables 354 %{$class->{single_fct_call}} = (); 355 $class->{replace_out_params} = ''; 356 357 # Rewrite all decode() call before 358 $str = replace_decode($str) if (uc($class->{type}) ne 'SHOW_REPORT'); 359 360 # Replace array syntax arr(i).x into arr[i].x 361 $str =~ s/\b([a-z0-9_]+)\(([^\(\)]+)\)(\.[a-z0-9_]+)/$1\[$2\]$3/igs; 362 363 # Extract all block from the code by splitting it on the semi-comma 364 # character and replace all necessary function call 365 my @code_parts = split(/;/, $str); 366 for (my $i = 0; $i <= $#code_parts; $i++) 367 { 368 next if (!$code_parts[$i]); 369 370 # For mysql also replace if() statements in queries or views. 371 if ($class->{is_mysql} && grep(/^$class->{type}$/i, 'VIEW', 'QUERY', 'FUNCTION', 'PROCEDURE')) { 372 $code_parts[$i] = Ora2Pg::MySQL::replace_if($code_parts[$i]); 373 } 374 375 # Remove parenthesis from function parameters when they not belong to a function call 376 my %subparams = (); 377 my $p = 0; 378 while ($code_parts[$i] =~ s/(\(\s*)(\([^\(\)]*\))(\s*,)/$1\%SUBPARAMS$p\%$3/is) 379 { 380 $subparams{$p} = $2; 381 $p++; 382 } 383 while ($code_parts[$i] =~ s/(,\s*)(\([^\(\)]*\))(\s*[\),])/$1\%SUBPARAMS$p\%$3/is) 384 { 385 $subparams{$p} = $2; 386 $p++; 387 } 388 389 # Remove some noisy parenthesis for outer join replacement 390 if ($code_parts[$i] =~ /\%OUTERJOIN\d+\%/) 391 { 392 my %tmp_ph = (); 393 my $idx = 0; 394 while ($code_parts[$i] =~ s/\(([^\(\)]*\%OUTERJOIN\d+\%[^\(\)]*)\)/\%SUBPART$idx\%/s) 395 { 396 $tmp_ph{$idx} = $1; 397 $idx++; 398 } 399 foreach my $k (keys %tmp_ph) 400 { 401 if ($tmp_ph{$k} =~ /^\s*[^\s]+\s*(=|NOT LIKE|LIKE)\s*[^\s]+\s*$/i) { 402 $code_parts[$i] =~ s/\%SUBPART$k\%/$tmp_ph{$k}/s; 403 } else { 404 $code_parts[$i] =~ s/\%SUBPART$k\%/\($tmp_ph{$k}\)/s; 405 } 406 } 407 } 408 409 %{$class->{single_fct_call}} = (); 410 $code_parts[$i] = extract_function_code($class, $code_parts[$i], 0); 411 412 # Things that must ne done when functions are replaced with placeholder 413 $code_parts[$i] = replace_without_function($class, $code_parts[$i]); 414 415 foreach my $k (keys %{$class->{single_fct_call}}) 416 { 417 $class->{single_fct_call}{$k} = replace_oracle_function($class, $class->{single_fct_call}{$k}, @strings); 418 if ($class->{single_fct_call}{$k} =~ /^CAST\s*\(/i) 419 { 420 if (!$class->{is_mysql}) 421 { 422 $class->{single_fct_call}{$k} = Ora2Pg::PLSQL::replace_sql_type($class->{single_fct_call}{$k}, $class->{pg_numeric_type}, $class->{default_numeric}, $class->{pg_integer_type}, %{$class->{data_type}}); 423 } else { 424 $class->{single_fct_call}{$k} = Ora2Pg::MySQL::replace_sql_type($class->{single_fct_call}{$k}, $class->{pg_numeric_type}, $class->{default_numeric}, $class->{pg_integer_type}, %{$class->{data_type}}); 425 } 426 } 427 if ($class->{single_fct_call}{$k} =~ /^CAST\s*\(.*\%\%REPLACEFCT(\d+)\%\%/i) 428 { 429 if (!$class->{is_mysql}) { 430 $class->{single_fct_call}{$1} = Ora2Pg::PLSQL::replace_sql_type($class->{single_fct_call}{$1}, $class->{pg_numeric_type}, $class->{default_numeric}, $class->{pg_integer_type}, %{$class->{data_type}}); 431 } else { 432 $class->{single_fct_call}{$1} = Ora2Pg::MySQL::replace_sql_type($class->{single_fct_call}{$1}, $class->{pg_numeric_type}, $class->{default_numeric}, $class->{pg_integer_type}, %{$class->{data_type}}); 433 } 434 } 435 } 436 while ($code_parts[$i] =~ s/\%\%REPLACEFCT(\d+)\%\%/$class->{single_fct_call}{$1}/) {}; 437 $code_parts[$i] =~ s/\%SUBPARAMS(\d+)\%/$subparams{$1}/igs; 438 439 # Remove potential double affectation for function with out parameter 440 $code_parts[$i] =~ s/(\s*)[^\s=;]+\s*:=\s*(?:\%ORA2PG_COMMENT\d+\%)?(\s*[^\s;=]+\s*:=)/$1$2/gs; 441 $code_parts[$i] =~ s/(\s*)[^\s=;]+\s*:=\s*(SELECT\s+[^;]+INTO\s*)/$1$2/igs; 442 } 443 $str = join(';', @code_parts); 444 445 if ($class->{replace_out_params}) 446 { 447 if ($str !~ s/\b(DECLARE(?:\s+|\%ORA2PG_COMMENT\d+\%))/$1$class->{replace_out_params}\n/is) { 448 $str =~ s/\b(BEGIN(?:\s+|\%ORA2PG_COMMENT\d+\%))/DECLARE\n$class->{replace_out_params}\n$1/is; 449 } 450 $class->{replace_out_params} = ''; 451 } 452 453 # Apply code rewrite on other part of the code 454 $str = plsql_to_plpgsql($class, $str, @strings); 455 456 if ($class->{get_diagnostics}) 457 { 458 if ($str !~ s/\b(DECLARE\s+)/$1$class->{get_diagnostics}\n/is) { 459 $str =~ s/\b(BEGIN\s+)/DECLARE\n$class->{get_diagnostics}\n$1/is; 460 } 461 $class->{get_diagnostics} = ''; 462 } 463 464 return $str; 465} 466 467=head2 extract_function_code 468 469Recursive function used to extract call to function in Oracle SQL 470and PL/SQL code 471 472=cut 473 474sub clear_parenthesis 475{ 476 my $str = shift; 477 478 # Keep parenthesys with sub queries 479 if ($str =~ /\bSELECT\b/i) { 480 $str = '((' . $str . '))'; 481 } else { 482 $str =~ s/^\s+//s; 483 $str =~ s/\s+$//s; 484 $str = '(' . $str . ')'; 485 } 486 487 return $str; 488} 489 490sub extract_function_code 491{ 492 my ($class, $code, $idx) = @_; 493 494 # Remove some extra parenthesis for better parsing 495 $code =~ s/\(\s*\(([^\(\)]*)\)\s*\)/clear_parenthesis($1)/iges; 496 497 # Look for a function call that do not have an other function 498 # call inside, replace content with a marker and store the 499 # replaced string into a hask to rewritten later to convert pl/sql 500 if ($code =~ s/\b([a-zA-Z0-9\.\_]+)\s*\(([^\(\)]*)\)/\%\%REPLACEFCT$idx\%\%/s) { 501 my $fct_name = $1; 502 my $fct_code = $2; 503 my $space = ''; 504 $space = ' ' if (grep (/^$fct_name$/i, 'FROM', 'AS', 'VALUES', 'DEFAULT', 'OR', 'AND', 'IN', 'SELECT', 'OVER', 'WHERE', 'THEN', 'IF', 'ELSIF', 'ELSE', 'EXISTS', 'ON')); 505 506 # Move up any outer join inside a function otherwise it will not be detected 507 my $outerjoin = ''; 508 if ($fct_code =~ /\%OUTERJOIN(\d+)\%/s) { 509 my $idx_join = $1; 510 # only if the placeholder content is a function not a predicate 511 if ($fct_code !~ /(=|>|<|LIKE|NULL|BETWEEN)/i) { 512 $fct_code =~ s/\%OUTERJOIN$idx_join\%//s; 513 $outerjoin = "\%OUTERJOIN$idx_join\%"; 514 } 515 } 516 # recursively replace function 517 $class->{single_fct_call}{$idx} = $fct_name . $space . '(' . $fct_code . ')' . $outerjoin; 518 $code = extract_function_code($class, $code, ++$idx); 519 } 520 521 return $code; 522} 523 524sub append_alias_clause 525{ 526 my $str = shift; 527 528 # Divise code through UNION keyword marking a new query level 529 my @q = split(/\b(UNION\s+ALL|UNION)\b/i, $str); 530 for (my $j = 0; $j <= $#q; $j+=2) { 531 if ($q[$j] =~ s/\b(FROM\s+)(.*\%SUBQUERY.*?)(\s*)(WHERE|ORDER\s+BY|GROUP\s+BY|LIMIT|$)/$1\%FROM_CLAUSE\%$3$4/is) { 532 my $from_clause = $2; 533 if ($q[$j] !~ /\b(YEAR|MONTH|DAY|HOUR|MINUTE|SECOND|TIMEZONE_HOUR|TIMEZONE_MINUTE|TIMEZONE_ABBR|TIMEZONE_REGION|TIMEZONE_OFFSET)\s+FROM/is) { 534 my @parts = split(/\b(WHERE|ORDER\s+BY|GROUP\s+BY|LIMIT)\b/i, $from_clause); 535 $parts[0] =~ s/(?<!USING|[\s,]ONLY|[\s,]JOIN|..\sON|.\sAND|..\sOR)\s*\%SUBQUERY(\d+)\%(\s*,)/\%SUBQUERY$1\% alias$1$2/igs; 536 $parts[0] =~ s/(?<!USING|[\s,]ONLY|[\s,]JOIN|.\sON\s|\sAND\s|.\sOR\s)\s*\%SUBQUERY(\d+)\%(\s*)$/\%SUBQUERY$1\% alias$1$2/is; 537 # Remove unwanted alias appended with the REGEXP_SUBSTR translation 538 $parts[0] =~ s/(\%SUBQUERY\d+\%\s+AS\s+[^\s]+)\s+alias\d+/$1/ig; 539 # Remove unwanted alias appended with JOIN 540 $parts[0] =~ s/\bON\s*(\%SUBQUERY\d+\%)\s+alias\d+/ON $1/ig; 541 # Remove unwanted alias appended with the epoch translation 542 $parts[0] =~ s/\b(now\%SUBQUERY\d+\%) alias\d+/$1/ig; 543 $from_clause = join('', @parts); 544 } 545 $q[$j] =~ s/\%FROM_CLAUSE\%/$from_clause/s; 546 } 547 } 548 $str = join('', @q); 549 550 return $str; 551} 552 553sub remove_fct_name 554{ 555 my $str = shift; 556 557 if ($str !~ /(END\b\s*)(IF\b|LOOP\b|CASE\b|INTO\b|FROM\b|END\b|ELSE\b|AND\b|OR\b|WHEN\b|AS\b|,|\)|\(|\||[<>=]|NOT LIKE|LIKE|WHERE|GROUP|ORDER)/is) { 558 $str =~ s/(END\b\s*)[\w"\.]+\s*(?:;|$)/$1;/is; 559 } 560 561 return $str; 562} 563 564=head2 set_error_code 565 566Transform custom exception code by replacing the leading -20 by 45 567 568=cut 569 570sub set_error_code 571{ 572 my $code = shift; 573 574 my $orig_code = $code; 575 576 $code =~ s/-20(\d{3})/'45$1'/; 577 if ($code =~ s/-20(\d{2})/'450$1'/ || $code =~ s/-20(\d{1})/'4500$1'/) { 578 print STDERR "WARNING: exception code has less than 5 digit, proceeding to automatic adjustement.\n"; 579 $code .= " /* code was: $orig_code */"; 580 } 581 582 return $code; 583} 584 585# Fix case where the raise_application_error() parameters are named by removing them 586sub remove_named_parameters 587{ 588 my $str = shift; 589 590 $str =~ s/\w+\s*=>\s*//g; 591 592 return $str; 593} 594 595=head2 plsql_to_plpgsql 596 597This function return a PLSQL code translated to PLPGSQL code 598 599=cut 600 601sub plsql_to_plpgsql 602{ 603 my ($class, $str, @strings) = @_; 604 605 return if ($str eq ''); 606 607 return mysql_to_plpgsql($class, $str, @strings) if ($class->{is_mysql}); 608 609 my $field = '\s*([^\(\),]+)\s*'; 610 my $num_field = '\s*([\d\.]+)\s*'; 611 my $date_field = '\s*([^,\)\(]*(?:date|time)[^,\)\(]*)\s*'; 612 613 my $conv_current_time = 'clock_timestamp()'; 614 if (!grep(/$class->{type}/i, 'FUNCTION', 'PROCEDURE', 'PACKAGE')) { 615 $conv_current_time = 'LOCALTIMESTAMP'; 616 } 617 # Replace sysdate +/- N by localtimestamp - 1 day intervel 618 $str =~ s/\bSYSDATE\s*(\+|\-)\s*(\d+)/$conv_current_time $1 interval '$2 days'/igs; 619 620 # Replace special case : (sysdate - to_date('01-Jan-1970', 'dd-Mon-yyyy'))*24*60*60 621 # with: (extract(epoch from now()) 622 # When translating from code 623 while ($str =~ /\bSYSDATE\s*\-\s*to_date\(\s*\?TEXTVALUE(\d+)\?\s*,\s*\?TEXTVALUE(\d+)\?\s*\)\s*\)\s*\*\s*(24|60)\s*\*\s*(24|60)/is) 624 { 625 my $t1 = $1; 626 my $t2 = $2; 627 if ($class->{text_values}{$t1} =~ /'(Jan|01).(Jan|01).1970'/ 628 && $class->{text_values}{$t2} =~ /'(Mon|MM|dd).(Mon|MM|dd).yyyy'/i) { 629 $str =~ s/\bSYSDATE\s*\-\s*to_date\(\s*\?TEXTVALUE(\d+)\?\s*,\s*\?TEXTVALUE(\d+)\?\s*\)\s*\)\s*\*\s*(24|60)\s*\*\s*(24|60)\*\s*(24|60)/extract(epoch from now()))/is; 630 } 631 } 632 633 # When translating from default value (sysdate - to_date('01-01-1970','dd-MM-yyyy'))*24*60*60 634 $str =~ s/\bSYSDATE\s*\-\s*to_date\(\s*'(Jan|01).(Jan|01).1970'\s*,\s*'(Mon|MM|dd).(Mon|MM|dd).yyyy'\s*\)\s*\)\s*\*\s*(24|60)\s*\*\s*(24|60)\s*\*\s*(24|60)/extract(epoch from now()))/igs; 635 636 # Change SYSDATE to 'now' or current timestamp. 637 $str =~ s/\bSYSDATE\s*\(\s*\)/$conv_current_time/igs; 638 $str =~ s/\bSYSDATE\b/$conv_current_time/igs; 639 # Cast call to to_date with localtimestamp 640 $str =~ s/(TO_DATE\($conv_current_time)\s*,/$1::text,/igs; 641 642 # JSON validation mostly in CHECK contraints 643 $str =~ s/((?:\w+\.)?\w+)\s+IS\s+JSON\b/\(CASE WHEN $1::json IS NULL THEN true ELSE true END\)/igs; 644 645 # Drop temporary doesn't exist in PostgreSQL 646 $str =~ s/DROP\s+TEMPORARY/DROP/igs; 647 648 # Private temporary table doesn't exist in PostgreSQL 649 $str =~ s/PRIVATE\s+TEMPORARY/TEMPORARY/igs; 650 $str =~ s/ON\s+COMMIT\s+PRESERVE\s+DEFINITION/ON COMMIT PRESERVE ROWS/igs; 651 $str =~ s/ON\s+COMMIT\s+DROP\s+DEFINITION/ON COMMIT DROP/igs; 652 653 # Replace SYSTIMESTAMP 654 $str =~ s/\bSYSTIMESTAMP\b/CURRENT_TIMESTAMP/igs; 655 # remove FROM DUAL 656 $str =~ s/FROM\s+DUAL//igs; 657 $str =~ s/FROM\s+SYS\.DUAL//igs; 658 659 # DISTINCT and UNIQUE are synonym on Oracle 660 $str =~ s/SELECT\s+UNIQUE\s+([^,])/SELECT DISTINCT $1/igs; 661 662 # Remove space between operators 663 $str =~ s/=\s+>/=>/gs; 664 $str =~ s/<\s+=/<=/gs; 665 $str =~ s/>\s+=/>=/gs; 666 $str =~ s/!\s+=/!=/gs; 667 $str =~ s/<\s+>/<>/gs; 668 $str =~ s/:\s+=/:=/gs; 669 $str =~ s/\|\s+\|/\|\|/gs; 670 $str =~ s/!=([+\-])/!= $1/gs; 671 672 # replace operator for named parameters in function calls 673 if (!$class->{pg_supports_named_operator}) { 674 $str =~ s/([^<])=>/$1:=/gs; 675 } 676 677 # Replace listagg() call 678 $str =~ s/\bLISTAGG\s*\((.*?)(?:\s*ON OVERFLOW [^\)]+)?\)\s+WITHIN\s+GROUP\s*\((.*?)\)/string_agg($1 $2)/igs; 679 # Try to fix call to string_agg with a single argument (allowed in oracle) 680 $str =~ s/\bstring_agg\(([^,\(\)]+)\s+(ORDER\s+BY)/string_agg($1, '' $2/igs; 681 682 # There's no such things in PostgreSQL 683 $str =~ s/PRAGMA RESTRICT_REFERENCES[^;]+;//igs; 684 $str =~ s/PRAGMA SERIALLY_REUSABLE[^;]*;//igs; 685 $str =~ s/PRAGMA INLINE[^;]+;//igs; 686 687 # Remove the extra TRUNCATE clauses not available in PostgreSQL 688 $str =~ s/TRUNCATE\s+TABLE\s+(.*?)\s+(REUSE|DROP)\s+STORAGE/TRUNCATE TABLE $1/igs; 689 $str =~ s/TRUNCATE\s+TABLE\s+(.*?)\s+(PRESERVE|PURGE)\s+MATERIALIZED\s+VIEW\s+LOG/TRUNCATE TABLE $1/igs; 690 691 # Converting triggers 692 # :new. -> NEW. 693 $str =~ s/:new\./NEW\./igs; 694 # :old. -> OLD. 695 $str =~ s/:old\./OLD\./igs; 696 697 # Change NVL to COALESCE 698 $str =~ s/NVL\s*\(/coalesce(/isg; 699 $str =~ s/NVL2\s*\($field,$field,$field\)/(CASE WHEN $1 IS NOT NULL THEN $2 ELSE $3 END)/isg; 700 701 # NLSSORT to COLLATE 702 while ($str =~ /NLSSORT\($field,$field[\)]?/is) 703 { 704 my $col = $1; 705 my $nls_sort = $2; 706 if ($nls_sort =~ s/\%\%string(\d+)\%\%/$strings[$1]/s) { 707 $nls_sort =~ s/NLS_SORT=([^']+)[']*/COLLATE "$1"/is; 708 $nls_sort =~ s/\%\%ESCAPED_STRING\%\%//ig; 709 $str =~ s/NLSSORT\($field,$field[\)]?/$1 $nls_sort/is; 710 } elsif ($nls_sort =~ s/\?TEXTVALUE(\d+)\?/$class->{text_values}{$1}/s) { 711 $nls_sort =~ s/\s*'NLS_SORT=([^']+)'/COLLATE "$1"/is; 712 $nls_sort =~ s/\%\%ESCAPED_STRING\%\%//ig; 713 $str =~ s/NLSSORT\($field,$field[\)]?/$1 $nls_sort/is; 714 } else { 715 $str =~ s/NLSSORT\($field,['\s]*NLS_SORT=([^']+)[']*/$1 COLLATE "$2"/is; 716 } 717 } 718 719 # Replace EXEC function into variable, ex: EXEC :a := test(:r,1,2,3); 720 $str =~ s/\bEXEC\s+:([^\s:]+)\s*:=/SELECT INTO $2/igs; 721 722 # Replace simple EXEC function call by SELECT function 723 $str =~ s/\bEXEC(\s+)/SELECT$1/igs; 724 725 # Remove leading : on Oracle variable taking care of regex character class 726 $str =~ s/([^\w:]+):(\d+)/$1\$$2/igs; 727 $str =~ s/([^\w:]+):((?!alpha:|alnum:|blank:|cntrl:|digit:|graph:|lower:|print:|punct:|space:|upper:|xdigit:)\w+)/$1$2/igs; 728 729 # INSERTING|DELETING|UPDATING -> TG_OP = 'INSERT'|'DELETE'|'UPDATE' 730 $str =~ s/\bINSERTING\b/TG_OP = 'INSERT'/igs; 731 $str =~ s/\bDELETING\b/TG_OP = 'DELETE'/igs; 732 $str =~ s/\bUPDATING\b/TG_OP = 'UPDATE'/igs; 733 # Replace Oracle call to column in trigger event 734 $str =~ s/TG_OP = '([^']+)'\s*\(\s*([^\)]+)\s*\)/TG_OP = '$1' AND NEW.$2 IS DISTINCT FROM OLD.$2/igs; 735 736 # EXECUTE IMMEDIATE => EXECUTE 737 $str =~ s/EXECUTE IMMEDIATE/EXECUTE/igs; 738 739 # SELECT without INTO should be PERFORM. Exclude select of view when prefixed with AS ot IS 740 if ( ($class->{type} ne 'QUERY') && ($class->{type} ne 'VIEW') ) 741 { 742 $str =~ s/(\s+)(?<!AS|IS)(\s+)SELECT((?![^;]+\bINTO\b)[^;]+;)/$1$2PERFORM$3/isg; 743 $str =~ s/\bSELECT\b((?![^;]+\bINTO\b)[^;]+;)/PERFORM$1/isg; 744 $str =~ s/(AS|IS|FOR|UNION ALL|UNION|MINUS|INTERSECT|\()(\s*)(\%ORA2PG_COMMENT\d+\%)?(\s*)PERFORM/$1$2$3$4SELECT/isg; 745 $str =~ s/(INSERT\s+INTO\s+[^;]+\s+)PERFORM/$1SELECT/isg; 746 } 747 748 # Change nextval on sequence 749 # Oracle's sequence grammar is sequence_name.nextval. 750 # Postgres's sequence grammar is nextval('sequence_name'). 751 if (!$class->{export_schema}) 752 { 753 if (!$class->{preserve_case}) 754 { 755 $str =~ s/\b(\w+)\.(\w+)\.nextval/nextval('\L$2\E')/isg; 756 $str =~ s/\b(\w+)\.(\w+)\.currval/currval('\L$2\E')/isg; 757 } 758 else 759 { 760 $str =~ s/\b(\w+)\.(\w+)\.nextval/nextval('"$2"')/isg; 761 $str =~ s/\b(\w+)\.(\w+)\.currval/currval('"$2"')/isg; 762 } 763 } 764 else 765 { 766 my $sch = $class->{pg_schema} || $class->{schema}; 767 if (!$class->{preserve_case}) 768 { 769 $str =~ s/\b(\w+)\.(\w+)\.nextval/nextval('\L$sch.$2\E')/isg; 770 $str =~ s/\b(\w+)\.(\w+)\.currval/currval('\L$sch.$2\E')/isg; 771 } 772 else 773 { 774 $str =~ s/\b(\w+)\.(\w+)\.nextval/nextval('"$sch"."$2"')/isg; 775 $str =~ s/\b(\w+)\.(\w+)\.currval/currval('"$sch"."$2"')/isg; 776 } 777 } 778 if (!$class->{preserve_case}) 779 { 780 $str =~ s/\b(\w+)\.nextval/nextval('\L$1\E')/isg; 781 $str =~ s/\b(\w+)\.currval/currval('\L$1\E')/isg; 782 } 783 else 784 { 785 $str =~ s/\b(\w+)\.nextval/nextval('"$1"')/isg; 786 $str =~ s/\b(\w+)\.currval/currval('"$1"')/isg; 787 } 788 789 # Oracle MINUS can be replaced by EXCEPT as is 790 $str =~ s/\bMINUS\b/EXCEPT/igs; 791 # Comment DBMS_OUTPUT.ENABLE calls 792 $str =~ s/(DBMS_OUTPUT.ENABLE[^;]+;)/-- $1/isg; 793 # DBMS_LOB.GETLENGTH can be replaced by binary length. 794 $str =~ s/DBMS_LOB.GETLENGTH/octet_length/igs; 795 # DBMS_LOB.SUBSTR can be replaced by SUBSTR() 796 $str =~ s/DBMS_LOB.SUBSTR/substr/igs; 797 # TO_CLOB(), we just remove it 798 $str =~ s/TO_CLOB\s*\(/\(/igs; 799 800 # Raise information to the client 801 $str =~ s/DBMS_OUTPUT\.(put_line|put|new_line)\s*\((.*?)\)\s*;/&raise_output($class, $2) . ';'/isge; 802 803 # Simply remove this as not supported 804 $str =~ s/\bDEFAULT\s+NULL\b//igs; 805 806 # Replace DEFAULT empty_blob() and empty_clob() 807 my $empty = "''"; 808 $empty = 'NULL' if ($class->{empty_lob_null}); 809 $str =~ s/(empty_blob|empty_clob)\s*\(\s*\)/$empty/is; 810 $str =~ s/(empty_blob|empty_clob)\b/$empty/is; 811 812 # dup_val_on_index => unique_violation : already exist exception 813 $str =~ s/\bdup_val_on_index\b/unique_violation/igs; 814 815 # Replace raise_application_error by PG standard RAISE EXCEPTION 816 $str =~ s/\braise_application_error\s*\(\s*([^,]+)\s*,\s*([^;]+),\s*(true|false)\s*\)\s*;/"RAISE EXCEPTION '%', " . remove_named_parameters($2) . " USING ERRCODE = " . set_error_code(remove_named_parameters($1)) . ";"/iges; 817 $str =~ s/\braise_application_error\s*\(\s*([^,]+)\s*,\s*([^;]+)\)\s*;/"RAISE EXCEPTION '%', " . remove_named_parameters($2) . " USING ERRCODE = " . set_error_code(remove_named_parameters($1)) . ";"/iges; 818 $str =~ s/DBMS_STANDARD\.RAISE EXCEPTION/RAISE EXCEPTION/igs; 819 820 # Translate cursor declaration 821 $str = replace_cursor_def($str); 822 823 # Remove remaining %ROWTYPE in other prototype declaration 824 #$str =~ s/\%ROWTYPE//isg; 825 826 # Normalize HAVING ... GROUP BY into GROUP BY ... HAVING clause 827 $str =~ s/\bHAVING\b((?:(?!SELECT|INSERT|UPDATE|DELETE|WHERE|FROM).)*?)\bGROUP BY\b((?:(?!SELECT|INSERT|UPDATE|DELETE|WHERE|FROM).)*?)((?=UNION|ORDER BY|LIMIT|INTO |FOR UPDATE|PROCEDURE|\)\s+(?:AS)*[a-z0-9_]+\s+)|$)/GROUP BY$2 HAVING$1/gis; 828 829 # Add STRICT keyword when select...into and an exception with NO_DATA_FOUND/TOO_MANY_ROW is present 830 #$str =~ s/\b(SELECT\b[^;]*?INTO)(.*?)(EXCEPTION.*?(?:NO_DATA_FOUND|TOO_MANY_ROW))/$1 STRICT $2 $3/igs; 831 # Add STRICT keyword when SELECT...INTO or EXECUTE ... INTO even if there's not EXCEPTION block 832 $str =~ s/\b((?:SELECT|EXECUTE)\s+[^;]*?\s+INTO)(\s+(?!STRICT))/$1 STRICT$2/igs; 833 $str =~ s/(INSERT\s+INTO\s+)STRICT\s+/$1/igs; 834 835 # Remove the function name repetion at end 836 $str =~ s/\b(END\s*[^;\s]+\s*(?:;|$))/remove_fct_name($1)/iges; 837 838 # Rewrite comment in CASE between WHEN and THEN 839 $str =~ s/(\s*)(WHEN\s+[^\s]+\s*)(\%ORA2PG_COMMENT\d+\%)(\s*THEN)/$1$3$1$2$4/igs; 840 841 # Replace SQLCODE by SQLSTATE 842 $str =~ s/\bSQLCODE\b/SQLSTATE/igs; 843 844 # Revert order in FOR IN REVERSE 845 $str =~ s/\bFOR(.*?)IN\s+REVERSE\s+([^\.\s]+)\s*\.\.\s*([^\s]+)/FOR$1IN REVERSE $3..$2/isg; 846 847 # Comment call to COMMIT or ROLLBACK in the code if allowed 848 if ($class->{comment_commit_rollback}) 849 { 850 $str =~ s/\b(COMMIT|ROLLBACK)\s*;/-- $1;/igs; 851 $str =~ s/(ROLLBACK\s+TO\s+[^;]+);/-- $1;/igs; 852 } 853 854 # Comment call to SAVEPOINT in the code if allowed 855 if ($class->{comment_savepoint}) { 856 $str =~ s/(SAVEPOINT\s+[^;]+);/-- $1;/igs; 857 } 858 859 # Replace exit at end of cursor 860 $str =~ s/EXIT\s+WHEN\s+([^\%;]+)\%\s*NOTFOUND\s*;/EXIT WHEN NOT FOUND; \/\* apply on $1 \*\//isg; 861 $str =~ s/EXIT\s+WHEN\s+\(\s*([^\%;]+)\%\s*NOTFOUND\s*\)\s*;/EXIT WHEN NOT FOUND; \/\* apply on $1 \*\//isg; 862 # Same but with additional conditions 863 $str =~ s/EXIT\s+WHEN\s+([^\%;]+)\%\s*NOTFOUND\s+([^;]+);/EXIT WHEN NOT FOUND $2; \/\* apply on $1 \*\//isg; 864 $str =~ s/EXIT\s+WHEN\s+\(\s*([^\%;]+)\%\s*NOTFOUND\s+([^\)]+)\)\s*;/EXIT WHEN NOT FOUND $2; \/\* apply on $1 \*\//isg; 865 # Replacle call to SQL%NOTFOUND and SQL%FOUND 866 $str =~ s/SQL\s*\%\s*NOTFOUND/NOT FOUND/isg; 867 $str =~ s/SQL\s*\%\s*FOUND/FOUND/isg; 868 869 # Replace UTL_MATH function by fuzzymatch function 870 $str =~ s/UTL_MATCH.EDIT_DISTANCE/levenshtein/igs; 871 872 # Replace known EXCEPTION equivalent ERROR code 873 foreach my $e (keys %EXCEPTION_MAP) { 874 $str =~ s/\b$e\b/$EXCEPTION_MAP{"\U$e\L"}/igs; 875 } 876 877 # Replace special IEEE 754 values for not a number and infinity 878 $str =~ s/BINARY_(FLOAT|DOUBLE)_NAN/'NaN'/igs; 879 $str =~ s/([\-]*)BINARY_(FLOAT|DOUBLE)_INFINITY/'$1Infinity'/igs; 880 $str =~ s/'([\-]*)Inf'/'$1Infinity'/igs; 881 882 # Replace PIPE ROW by RETURN NEXT 883 $str =~ s/PIPE\s+ROW\s*/RETURN NEXT /igs; 884 $str =~ s/(RETURN NEXT )\(([^\)]+)\)/$1$2/igs; 885 886 # Convert all x <> NULL or x != NULL clauses to x IS NOT NULL. 887 $str =~ s/\s*(<>|\!=)\s*NULL/ IS NOT NULL/igs; 888 # Convert all x = NULL clauses to x IS NULL. 889 $str =~ s/(?!:)(.)=\s*NULL/$1 IS NULL/igs; 890 891 # Add missing FROM clause in DELETE statements minus MERGE and FK ON DELETE 892 $str =~ s/(\bDELETE\s+)(?!FROM|WHERE|RESTRICT|CASCADE|NO ACTION)\b/$1FROM /igs; 893 894 # Revert changes on update queries for IS NULL transaltion in the target list only 895 while ($str =~ s/\b(UPDATE\s+((?!WHERE|;).)*)\s+IS NULL/$1 = NULL/is) {}; 896 897 # Rewrite all IF ... IS NULL with coalesce because for Oracle empty and NULL is the same 898 if ($class->{null_equal_empty}) { 899 # Form: column IS NULL 900 $str =~ s/([a-z0-9_\."]+)\s*IS NULL/coalesce($1::text, '') = ''/igs; 901 $str =~ s/([a-z0-9_\."]+)\s*IS NOT NULL/($1 IS NOT NULL AND $1::text <> '')/igs; 902 # Form: fct(expression) IS NULL 903 $str =~ s/([a-z0-9_\."]+\s*\([^\)\(]*\))\s*IS NULL/coalesce($1::text, '') = ''/igs; 904 $str =~ s/([a-z0-9_\."]+\s*\([^\)\(]*\))\s*IS NOT NULL/($1 IS NOT NULL AND ($1)::text <> '')/igs; 905 } 906 907 # Replace type in sub block 908 if (!$class->{is_mysql}) { 909 $str =~ s/(BEGIN.*?DECLARE\s+)(.*?)(\s+BEGIN)/$1 . Ora2Pg::PLSQL::replace_sql_type($2, $class->{pg_numeric_type}, $class->{default_numeric}, $class->{pg_integer_type}, %{$class->{data_type}}) . $3/iges; 910 } else { 911 $str =~ s/(BEGIN.*?DECLARE\s+)(.*?)(\s+BEGIN)/$1 . Ora2Pg::MySQL::replace_sql_type($2, $class->{pg_numeric_type}, $class->{default_numeric}, $class->{pg_integer_type}, %{$class->{data_type}}) . $3/iges; 912 } 913 914 # Remove any call to MDSYS schema in the code 915 $str =~ s/\bMDSYS\.//igs; 916 917 # Oracle doesn't require parenthesis after VALUES, PostgreSQL has 918 # similar proprietary syntax but parenthesis are mandatory 919 $str =~ s/(INSERT\s+INTO\s+(?:.*?)\s+VALUES\s+)([^\(\)\s]+)\s*;/$1\($2.*\);/igs; 920 921 # Replace some windows function issues with KEEP (DENSE_RANK FIRST ORDER BY ...) 922 $str =~ s/\b(MIN|MAX|SUM|AVG|COUNT|VARIANCE|STDDEV)\s*\(([^\)]+)\)\s+KEEP\s*\(DENSE_RANK\s+(FIRST|LAST)\s+(ORDER\s+BY\s+[^\)]+)\)\s*(OVER\s*\(PARTITION\s+BY\s+[^\)]+)\)/$3_VALUE($2) $5 $4)/igs; 923 924 $class->{sub_queries} = (); 925 $class->{sub_queries_idx} = 0; 926 927 #### 928 # Replace ending ROWNUM with LIMIT or row_number() and replace (+) outer join 929 #### 930 # Catch potential subquery first and replace rownum in subqueries 931 my @statements = split(/;/, $str); 932 for ( my $i = 0; $i <= $#statements; $i++ ) 933 { 934 # Remove any unecessary parenthesis in code 935 $statements[$i] = remove_extra_parenthesis($statements[$i]); 936 937 $class->{sub_parts} = (); 938 $class->{sub_parts_idx} = 0; 939 extract_subpart($class, \$statements[$i]); 940 941 # Translate all sub parts of the query before applying translation on the main query 942 foreach my $z (sort {$a <=> $b } keys %{$class->{sub_parts}}) 943 { 944 if ($class->{sub_parts}{$z} =~ /\S/is) 945 { 946 $class->{sub_parts}{$z} = translate_statement($class, $class->{sub_parts}{$z}, 1); 947 if ($class->{sub_parts}{$z} =~ /SELECT/is) 948 { 949 $class->{sub_parts}{$z} .= $class->{limit_clause}; 950 $class->{limit_clause} = ''; 951 } 952 # Try to append aliases of subqueries in the from clause 953 $class->{sub_parts}{$z} = append_alias_clause($class->{sub_parts}{$z}); 954 } 955 # If subpart is not empty after transformation 956 if ($class->{sub_parts}{$z} =~ /\S/is) 957 { 958 # add open and closed parenthesis 959 $class->{sub_parts}{$z} = '(' . $class->{sub_parts}{$z} . ')'; 960 } 961 elsif ($statements[$i] !~ /\s+(WHERE|AND|OR)\s*\%SUBQUERY$z\%/is) 962 { 963 # otherwise do not report the empty parenthesis when this is not a function 964 $class->{sub_parts}{$z} = '(' . $class->{sub_parts}{$z} . ')'; 965 } 966 } 967 968 # Try to append aliases of subqueries in the from clause 969 $statements[$i] = append_alias_clause($statements[$i]); 970 971 $statements[$i] .= $class->{limit_clause}; 972 $class->{limit_clause} = ''; 973 974 # Apply translation on the full query 975 $statements[$i] = translate_statement($class, $statements[$i]); 976 977 $statements[$i] .= $class->{limit_clause}; 978 $class->{limit_clause} = ''; 979 980 # then restore subqueries code into the main query 981 while ($statements[$i] =~ s/\%SUBQUERY(\d+)\%/$class->{sub_parts}{$1}/is) {}; 982 983 # Remove unnecessary offset to position 0 which is the default 984 $statements[$i] =~ s/\s+OFFSET 0//igs; 985 986 } 987 988 map { s/[ ]+([\r\n]+)/$1/s; } @statements; 989 map { s/[ ]+$//; } @statements; 990 $str = join(';', @statements); 991 992 # Rewrite some garbadged resulting from the transformation 993 while ($str =~ s/(\s+AND)\s+AND\b/$1/is) {}; 994 while ($str =~ s/(\s+OR)\s+OR\b/$1/is) {}; 995 while ($str =~ s/\s+AND(\s+\%ORA2PG_COMMENT\d+\%\s+)+(AND)\b/$1$2/is) {}; 996 while ($str =~ s/\s+OR(\s+\%ORA2PG_COMMENT\d+\%\s+)+(OR)\b/$1$2/is) {}; 997 $str =~ s/\(\s*(AND|OR)\b/\(/igs; 998 $str =~ s/(\s+WHERE)\s+(AND|OR)\b/$1/igs; 999 $str =~ s/(\s+WHERE)(\s+\%ORA2PG_COMMENT\d+\%\s+)+(AND|OR)\b/$1$2/igs; 1000 1001 # Attempt to remove some extra parenthesis in simple case only 1002 $str = remove_extra_parenthesis($str); 1003 1004 # Remove cast in partition range 1005 $str =~ s/TIMESTAMP\s*('[^']+')/$1/igs; 1006 1007 # Replace call to SQL%ROWCOUNT 1008 $str =~ s/([^\s]+)\s*:=\s*SQL\%ROWCOUNT/GET DIAGNOSTICS $1 = ROW_COUNT/igs; 1009 if ($str =~ s/(IF\s+)SQL\%ROWCOUNT/GET DIAGNOSTICS ora2pg_rowcount = ROW_COUNT;\n$1ora2pg_rowcount/igs) { 1010 $class->{get_diagnostics} = 'ora2pg_rowcount int;'; 1011 } 1012 1013 # Sometime variable used in FOR ... IN SELECT loop is not declared 1014 # Append its RECORD declaration in the DECLARE section. 1015 my $tmp_code = $str; 1016 while ($tmp_code =~ s/\bFOR\s+([^\s]+)\s+IN(.*?)LOOP//is) 1017 { 1018 my $varname = $1; 1019 my $clause = $2; 1020 my @code = split(/\bBEGIN\b/i, $str); 1021 if ($code[0] !~ /\bDECLARE\s+.*\b$varname\s+/is) 1022 { 1023 # When the cursor is refereing to a statement, declare 1024 # it as record otherwise it don't need to be replaced 1025 if ($clause =~ /\bSELECT\b/is) 1026 { 1027 # append variable declaration to declare section 1028 if ($str !~ s/\bDECLARE\b/DECLARE\n $varname RECORD;/is) 1029 { 1030 # No declare section 1031 $str = "DECLARE\n $varname RECORD;\n" . $str; 1032 } 1033 } 1034 } 1035 } 1036 1037 # Rewrite direct call to function without out parameters using PERFORM 1038 $str = perform_replacement($class, $str); 1039 1040 # Restore non converted outer join 1041 $str =~ s/\%OUTERJOIN\d+\%/\(\+\)/igs; 1042 1043 return $str; 1044} 1045 1046############## 1047# Rewrite direct call to function without out parameters using PERFORM 1048############## 1049sub perform_replacement 1050{ 1051 my ($class, $str) = @_; 1052 1053 if (uc($class->{type}) =~ /^(PACKAGE|FUNCTION|PROCEDURE|TRIGGER)$/) 1054 { 1055 foreach my $sch ( keys %{ $class->{function_metadata} }) 1056 { 1057 foreach my $p ( keys %{ $class->{function_metadata}{$sch} }) 1058 { 1059 foreach my $k (keys %{$class->{function_metadata}{$sch}{$p}}) 1060 { 1061 my $fct_name = $class->{function_metadata}{$sch}{$p}{$k}{metadata}{fct_name} || ''; 1062 next if (!$fct_name); 1063 next if ($p ne 'none' && $str !~ /\b$p\.$fct_name\b/is && $str !~ /(^|[^\.])\b$fct_name\b/is); 1064 next if ($p eq 'none' && $str !~ /\b$fct_name\b/is); 1065 if (!$class->{function_metadata}{$sch}{$p}{$k}{metadata}{inout}) 1066 { 1067 if ($sch ne 'unknown' and $str =~ /\b$sch.$k\b/is) 1068 { 1069 # Look if we need to use PERFORM to call the function 1070 $str =~ s/(BEGIN|LOOP|;)((?:\s*%ORA2PG_COMMENT\d+\%\s*|\s*\/\*(?:.*?)\*\/\s*)*\s*)($sch\.$k\s*[\(;])/$1$2PERFORM $3/igs; 1071 while ($str =~ s/(EXCEPTION(?:(?!CASE|THEN).)*?THEN)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)($sch\.$k\s*[\(;])/$1$2PERFORM $3/is) {}; 1072 $str =~ s/(IF(?:(?!CASE|THEN).)*?THEN)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)($sch\.$k\s*[\(;])/$1$2PERFORM $3/isg; 1073 $str =~ s/(IF(?:(?!CASE|ELSE).)*?ELSE)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)($sch\.$k\s*[\(;])/$1$2PERFORM $3/isg; 1074 $str =~ s/(PERFORM $sch\.$k);/$1\(\);/igs; 1075 } 1076 elsif ($str =~ /\b($k|$fct_name)\b/is) 1077 { 1078 # Look if we need to use PERFORM to call the function 1079 $str =~ s/(BEGIN|LOOP|CALL|;)((?:\s*%ORA2PG_COMMENT\d+\%\s*|\s*\/\*(?:.*?)\*\/\s*)*\s*)((?:$k|$fct_name)\s*[\(;])/$1$2PERFORM $3/igs; 1080 while ($str =~ s/(EXCEPTION(?:(?!CASE).)*?THEN)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)((?:$k|$fct_name)\s*[\(;])/$1$2PERFORM $3/is) {}; 1081 $str =~ s/(IF(?:(?!CASE|THEN).)*?THEN)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)((?:$k|$fct_name)\s*[\(;])/$1$2PERFORM $3/isg; 1082 $str =~ s/(IF(?:(?!CASE|ELSE).)*?ELSE)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)((?:$k|$fct_name)\s*[\(;])/$1$2PERFORM $3/isg; 1083 $str =~ s/(PERFORM (?:$k|$fct_name));/$1\(\);/igs; 1084 } 1085 } 1086 else 1087 { 1088 # Recover call to function with OUT parameter with double affectation 1089 $str =~ s/([^:\s]+\s*:=\s*)[^:\s]*\s+:=\s*((?:[^\s\.]+\.)?\b$fct_name\s*\()/$1$2/isg; 1090 } 1091 # Remove package name and try to replace call to function name only 1092 if (!$class->{function_metadata}{$sch}{$p}{$k}{metadata}{inout} && $k =~ s/^[^\.]+\.// && lc($p) eq lc($class->{current_package}) ) 1093 { 1094 if ($sch ne 'unknown' and $str =~ /\b$sch\.$k\b/is) 1095 { 1096 $str =~ s/(BEGIN|LOOP|;)((?:\s*%ORA2PG_COMMENT\d+\%\s*|\s*\/\*(?:.*?)\*\/\s*)*\s*)($sch\.$k\s*[\(;])/$1$2PERFORM $3/igs; 1097 while ($str =~ s/(EXCEPTION(?:(?!CASE).)*?THEN)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)($sch\.$k\s*[\(;])/$1$2PERFORM $3/is) {}; 1098 $str =~ s/(IF(?:(?!CASE|THEN).)*?THEN)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)($sch\.$k\s*[\(;])/$1$2PERFORM $3/isg; 1099 $str =~ s/(IF(?:(?!CASE|ELSE).)*?ELSE)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)($sch\.$k\s*[\(;])/$1$2PERFORM $3/isg; 1100 $str =~ s/(PERFORM $sch\.$k);/$1\(\);/igs; 1101 } 1102 elsif ($str =~ /\b(?:$k|$fct_name)\b/is) 1103 { 1104 $str =~ s/(BEGIN|LOOP|CALL|;)((?:\s*%ORA2PG_COMMENT\d+\%\s*|\s*\/\*(?:.*?)\*\/\s*)*\s*)((?:$k|$fct_name)\s*[\(;])/$1$2PERFORM $3/igs; 1105 while ($str =~ s/(EXCEPTION(?:(?!CASE).)*?THEN)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)((?:$k|$fct_name)\s*[\(;])/$1$2PERFORM $3/is) {}; 1106 $str =~ s/(IF(?:(?!CASE|THEN).)*?THEN)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)((?:$k|$fct_name)\s*[\(;])/$1$2PERFORM $3/isg; 1107 $str =~ s/(IF(?:(?!CASE|ELSE).)*?ELSE)((?:\s*%ORA2PG_COMMENT\d+\%\s*)*\s*)((?:$k|$fct_name)\s*[\(;])/$1$2PERFORM $3/isg; 1108 $str =~ s/(PERFORM (?:$k|$fct_name));/$1\(\);/igs; 1109 } 1110 } 1111 } 1112 } 1113 } 1114 } 1115 1116 # Fix call to procedure changed above 1117 if ($class->{pg_supports_procedure}) { 1118 $str =~ s/\bCALL\s+PERFORM/CALL/igs; 1119 } else { 1120 $str =~ s/\bCALL\s+PERFORM/PERFORM/igs; 1121 } 1122 1123 return $str; 1124} 1125 1126sub translate_statement 1127{ 1128 my ($class, $stmt, $is_subpart) = @_; 1129 1130 # Divise code through UNION keyword marking a new query level 1131 my @q = split(/\b(UNION\s+ALL|UNION)\b/i, $stmt); 1132 for (my $j = 0; $j <= $#q; $j++) { 1133 next if ($q[$j] =~ /^UNION/); 1134 1135 # Replace call to right outer join obsolete syntax 1136 $q[$j] = replace_outer_join($class, $q[$j], 'right'); 1137 1138 # Replace call to left outer join obsolete syntax 1139 $q[$j] = replace_outer_join($class, $q[$j], 'left'); 1140 1141 if ($q[$j] =~ /\bROWNUM\b/i) 1142 { 1143 # Replace ROWNUM after the WHERE clause by a LIMIT clause 1144 $q[$j] = replace_rownum_with_limit($class, $q[$j]); 1145 # Replace ROWNUM by row_number() when used in the target list 1146 $q[$j] =~ s/((?!WHERE\s.*|LIMIT\s.*)[\s,]+)ROWNUM([\s,]+)/$1row_number() OVER () AS rownum$2/is; 1147 # Aliases before + or - will generate an error 1148 $q[$j] =~ s/row_number\(\) OVER \(\) AS rownum\s*([+\-])/row_number() OVER () $1/is; 1149 # Try to replace AS rownnum with alias if there is one already defined 1150 $q[$j] =~ s/(row_number\(\) OVER \(\) AS)\s+rownum\s+((?!FROM\s+|[,+\-]\s*)[^\s]+)/$1 $2/is; 1151 $q[$j] =~ s/\s+AS(\s+AS\s+)/$1/is; 1152 # The form "UPDATE mytbl SET col1 = ROWNUM;" is not yet translated 1153 # and mus be manually rewritten as follow: 1154 # WITH cte AS (SELECT *, ROW_NUMBER() OVER() AS rn FROM mytbl) 1155 # UPDATE mytbl SET col1 = (SELECT rn FROM cte WHERE cte.pk = mytbl.pk); 1156 } 1157 1158 } 1159 $stmt = join("\n", @q); 1160 1161 # Rewrite some invalid ending form after rewriting 1162 $stmt =~ s/(\s+WHERE)\s+AND/$1/igs; 1163 1164 $stmt =~ s/(\s+)(?:WHERE|AND)\s+(LIMIT\s+)/$1$2/igs; 1165 $stmt =~ s/\s+WHERE\s*$//is; 1166 $stmt =~ s/\s+WHERE\s*\)/\)/is; 1167 1168 # Remove unnecessary offset to position 0 which is the default 1169 $stmt =~ s/\s+OFFSET 0//igs; 1170 1171 # Replacement of connect by with CTE 1172 $stmt = replace_connect_by($class, $stmt); 1173 1174 return $stmt; 1175} 1176 1177sub remove_extra_parenthesis 1178{ 1179 my $str = shift; 1180 1181 while ($str =~ s/\(\s*\(((?!\s*SELECT)[^\(\)]+)\)\s*\)/($1)/gs) {}; 1182 my %store_clause = (); 1183 my $i = 0; 1184 while ($str =~ s/\(\s*\(([^\(\)]+)\)\s*AND\s*\(([^\(\)]+)\)\s*\)/\%PARENTHESIS$i\%/is) { 1185 $store_clause{$i} = find_or_parenthesis($1, $2); 1186 $i++ 1187 } 1188 $str =~ s/\%PARENTHESIS(\d+)\%/$store_clause{$1}/gs; 1189 while ($str =~ s/\(\s*\(\s*\(([^\(\)]+\)[^\(\)]+\([^\(\)]+)\)\s*\)\s*\)/(($1))/gs) {}; 1190 1191 return $str; 1192} 1193 1194# When the statement include OR keep parenthesisœ 1195sub find_or_parenthesis 1196{ 1197 my ($left, $right) = @_; 1198 1199 if ($left =~ /\s+OR\s+/i) { 1200 $left = "($left)"; 1201 } 1202 if ($right =~ /\s+OR\s+/i) { 1203 $right = "($right)"; 1204 } 1205 1206 return "($left AND $right)"; 1207} 1208 1209 1210sub extract_subpart 1211{ 1212 my ($class, $str) = @_; 1213 1214 while ($$str =~ s/\(([^\(\)]*)\)/\%SUBQUERY$class->{sub_parts_idx}\%/s) { 1215 $class->{sub_parts}{$class->{sub_parts_idx}} = $1; 1216 $class->{sub_parts_idx}++; 1217 } 1218 my @done = (); 1219 foreach my $k (sort { $b <=> $a } %{$class->{sub_parts}}) { 1220 if ($class->{sub_parts}{$k} =~ /\%OUTERJOIN\d+\%/ && $class->{sub_parts}{$k} !~ /\b(SELECT|FROM|WHERE)\b/i) { 1221 $$str =~ s/\%SUBQUERY$k\%/\($class->{sub_parts}{$k}\)/s; 1222 push(@done, $k); 1223 } 1224 } 1225 foreach (@done) { 1226 delete $class->{sub_parts}{$_}; 1227 } 1228} 1229 1230 1231sub extract_subqueries 1232{ 1233 my ($class, $str) = @_; 1234 1235 return if ($class->{sub_queries_idx} == 100); 1236 1237 my $cur_idx = $class->{sub_queries_idx}; 1238 if ($$str =~ s/\((\s*(?:SELECT|WITH).*)/\%SUBQUERY$class->{sub_queries_idx}\%/is) { 1239 my $stop_learning = 0; 1240 my $idx = 1; 1241 my $sub_query = ''; 1242 foreach my $c (split(//, $1)) { 1243 $idx++ if (!$stop_learning && $c eq '('); 1244 $idx-- if (!$stop_learning && $c eq ')'); 1245 if ($idx == 0) { 1246 # Do not copy last parenthesis in the output string 1247 $c = '' if (!$stop_learning); 1248 # Increment storage position for the next subquery 1249 $class->{sub_queries_idx}++ if (!$stop_learning); 1250 # Inform the loop that we don't want to process any charater anymore 1251 $stop_learning = 1; 1252 # We have reach the end of the subquery all next 1253 # characters must be restored to the final string. 1254 $$str .= $c; 1255 } elsif ($idx > 0) { 1256 # Append character to the current substring storage 1257 $class->{sub_queries}{$class->{sub_queries_idx}} .= $c; 1258 } 1259 } 1260 1261 # Each subquery could have subqueries too, so call the 1262 # function recursively on each extracted subquery 1263 if ($class->{sub_queries}{$class->{sub_queries_idx}-1} =~ /\(\s*(?:SELECT|WITH)/is) { 1264 extract_subqueries($class, \$class->{sub_queries}{$class->{sub_queries_idx}-1}); 1265 } 1266 } 1267 1268} 1269 1270sub replace_rownum_with_limit 1271{ 1272 my ($class, $str) = @_; 1273 1274 my $offset = ''; 1275 if ($str =~ s/\s+(WHERE)\s+(?:\(\s*)?ROWNUM\s*=\s*([^\s\)]+)(\s*\)\s*)?([^;]*)/ $1 $3$4/is) { 1276 $offset = $2; 1277 ($offset =~ /[^0-9]/) ? $offset = "($offset)" : $offset -= 1; 1278 $class->{limit_clause} = ' LIMIT 1 OFFSET ' . $offset; 1279 1280 } 1281 if ($str =~ s/\s+AND\s+(?:\(\s*)?ROWNUM\s*=\s*([^\s\)]+)(\s*\)\s*)?([^;]*)/ $2$3/is) { 1282 $offset = $1; 1283 ($offset =~ /[^0-9]/) ? $offset = "($offset)" : $offset -= 1; 1284 $class->{limit_clause} = ' LIMIT 1 OFFSET ' . $offset; 1285 } 1286 1287 if ($str =~ s/\s+(WHERE)\s+(?:\(\s*)?ROWNUM\s*>=\s*([^\s\)]+)(\s*\)\s*)?([^;]*)/ $1 $3$4/is) { 1288 $offset = $2; 1289 ($offset =~ /[^0-9]/) ? $offset = "($offset)" : $offset -= 1; 1290 $class->{limit_clause} = ' LIMIT ALL OFFSET ' . $offset; 1291 } 1292 if ($str =~ s/\s+(WHERE)\s+(?:\(\s*)?ROWNUM\s*>\s*([^\s\)]+)(\s*\)\s*)?([^;]*)/ $1 $3$4/is) { 1293 $offset = $2; 1294 $offset = "($offset)" if ($offset =~ /[^0-9]/); 1295 $class->{limit_clause} = ' LIMIT ALL OFFSET ' . $offset; 1296 } 1297 if ($str =~ s/\s+AND\s+(?:\(\s*)?ROWNUM\s*>=\s*([^\s\)]+)(\s*\)\s*)?([^;]*)/ $2$3/is) { 1298 $offset = $1; 1299 ($offset =~ /[^0-9]/) ? $offset = "($offset)" : $offset -= 1; 1300 $class->{limit_clause} = ' LIMIT ALL OFFSET ' . $offset; 1301 } 1302 if ($str =~ s/\s+AND\s+(?:\(\s*)?ROWNUM\s*>\s*([^\s\)]+)(\s*\)\s*)?([^;]*)/ $2$3/is) { 1303 $offset = $1; 1304 $offset = "($offset)" if ($offset =~ /[^0-9]/); 1305 $class->{limit_clause} = ' LIMIT ALL OFFSET ' . $offset; 1306 } 1307 1308 my $tmp_val = ''; 1309 if ($str =~ s/\s+(WHERE)\s+(?:\(\s*)?ROWNUM\s*<=\s*([^\s\)]+)(\s*\)\s*)?([^;]*)/ $1 $3$4/is) { 1310 $tmp_val = $2; 1311 } 1312 if ($str =~ s/\s+(WHERE)\s+(?:\(\s*)?ROWNUM\s*<\s*([^\s\)]+)(\s*\)\s*)?([^;]*)/ $1 $3$4/is) { 1313 $tmp_val = $2 - 1; 1314 } 1315 if ($str =~ s/\s+AND\s+(?:\(\s*)?ROWNUM\s*<=\s*([^\s\)]+)(\s*\)\s*)?([^;]*)/ $2$3/is) { 1316 $tmp_val = $1; 1317 } 1318 if ($str =~ s/\s+AND\s+(?:\(\s*)?ROWNUM\s*<\s*([^\s\)]+)(\s*\)\s*)?([^;]*)/ $2$3/is) { 1319 $tmp_val = $1 - 1; 1320 } 1321 1322 if ($tmp_val) { 1323 if ($class->{limit_clause} =~ /LIMIT ALL OFFSET ([^\s]+)/is) { 1324 my $tmp_offset = $1; 1325 if ($tmp_offset !~ /[^0-9]/ && $tmp_val !~ /[^0-9]/) { 1326 $tmp_val -= $tmp_offset; 1327 } else { 1328 $tmp_val = "($tmp_val - $tmp_offset)"; 1329 } 1330 $class->{limit_clause} =~ s/LIMIT ALL/LIMIT $tmp_val/is; 1331 } else { 1332 $tmp_val = "($tmp_val)" if ($tmp_val =~ /[^0-9]/); 1333 $class->{limit_clause} = ' LIMIT ' . $tmp_val; 1334 } 1335 } 1336 1337 # Rewrite some invalid ending form after rewriting 1338 $str =~ s/(\s+WHERE)\s+AND/$1/igs; 1339 $str =~ s/\s+WHERE\s*$//is; 1340 $str =~ s/\s+WHERE\s*\)/\)/is; 1341 1342 # Remove unnecessary offset to position 0 which is the default 1343 $str =~ s/\s+OFFSET 0//igs; 1344 1345 return $str; 1346} 1347 1348# Translation of REGEX_SUBSTR( string, pattern, [pos], [nth]) converted into 1349# (SELECT array_to_string(a, '') FROM regexp_matches(substr(string, pos), pattern, 'g') AS foo(a) LIMIT 1 OFFSET (nth - 1))"; 1350# Optional fith parameter of match_parameter is appended to 'g' when present 1351sub convert_regex_substr 1352{ 1353 ($class, $str) = @_; 1354 1355 my @params = split(/\s*,\s*/, $str); 1356 my $mod = ''; 1357 if ($#params == 4) { 1358 # Restore constant string to look into date format 1359 while ($params[4] =~ s/\?TEXTVALUE(\d+)\?/$class->{text_values}{$1}/is) { 1360 delete $class->{text_values}{$1}; 1361 } 1362 $params[4] =~ s/'//g; 1363 $mod = $params[4] if ($params[4] ne 'g'); 1364 } 1365 if ($#params < 2) { 1366 push(@params, 1, 1); 1367 } elsif ($#params < 3) { 1368 push(@params, 1); 1369 } 1370 if ($params[2] == 1) { 1371 $str = "(SELECT array_to_string(a, '') FROM regexp_matches($params[0], $params[1], 'g$mod') AS foo(a) LIMIT 1 OFFSET ($params[3] - 1))"; 1372 } else { 1373 $str = "(SELECT array_to_string(a, '') FROM regexp_matches(substr($params[0], $params[2]), $params[1], 'g$mod') AS foo(a) LIMIT 1 OFFSET ($params[3] - 1))"; 1374 } 1375 1376 return $str; 1377} 1378 1379sub convert_from_tz 1380{ 1381 my ($class, $date) = @_; 1382 1383 # Restore constant string to look into date format 1384 while ($date =~ s/\?TEXTVALUE(\d+)\?/$class->{text_values}{$1}/is) { 1385 delete $class->{text_values}{$1}; 1386 } 1387 1388 my $tz = '00:00'; 1389 if ($date =~ /^[^']*'([^']+)'\s*,\s*'([^']+)'/) { 1390 $date = $1; 1391 $tz = $2; 1392 $date = $date . ' '; 1393 if ($tz =~ /^\d+:\d+$/) { 1394 $date .= '+' . $tz; 1395 } else { 1396 $date .= $tz; 1397 } 1398 $date = "'$date'"; 1399 } elsif ($date =~ /^(.*),\s*'([^']+)'$/) { 1400 $date = $1; 1401 $tz = $2; 1402 if ($tz =~ /^\d+:\d+$/) { 1403 $tz .= '+' . $tz; 1404 } 1405 $date = $date . ' AT TIME ZONE ' . "'$tz'"; 1406 } 1407 1408 # Replace constant strings 1409 while ($date =~ s/('[^']+')/\?TEXTVALUE$class->{text_values_pos}\?/s) { 1410 $class->{text_values}{$class->{text_values_pos}} = $1; 1411 $class->{text_values_pos}++; 1412 } 1413 1414 return $date; 1415} 1416 1417sub convert_date_format 1418{ 1419 my ($class, $fields, @strings) = @_; 1420 1421 # Restore constant string to look into date format 1422 while ($fields =~ s/\?TEXTVALUE(\d+)\?/$class->{text_values}{$1}/is) { 1423 delete $class->{text_values}{$1}; 1424 } 1425 1426 for ($i = 0; $i <= $#strings; $i++) { 1427 $fields =~ s/\%\%string$i\%\%/'$strings[$i]'/; 1428 } 1429 1430 # Truncate time to microsecond 1431 $fields =~ s/(\d{2}:\d{2}:\d{2}[,\.]\d{6})\d{3}/$1/s; 1432 1433 # Replace round year with two digit year format. 1434 $fields =~ s/RR/YY/sg; 1435 1436 # Convert fractional seconds to milli (MS) or micro (US) seconds 1437 $fields =~ s/FF[123]/MS/s; 1438 $fields =~ s/FF\d*/US/s; 1439 1440 # Remove any timezone format 1441 $fields =~ s/\s*TZ[DHMR]//gs; 1442 1443 # Replace constant strings 1444 while ($str =~ s/('[^']+')/\?TEXTVALUE$class->{text_values_pos}\?/s) { 1445 $class->{text_values}{$class->{text_values_pos}} = $1; 1446 $class->{text_values_pos}++; 1447 } 1448 return $fields; 1449} 1450 1451 1452#------------------------------------------------------------------------------ 1453# Set the correspondance between Oracle and PostgreSQL regexp modifiers 1454# Oracle default: 1455# 1) The default case sensitivity is determined by the NLS_SORT parameter. 1456# Ora2pg assuming case sensitivy 1457# 2) A period (.) does not match the newline character. 1458# 3) The source string is treated as a single line. 1459# PostgreSQL default: 1460# 1) Default to case sensitivity 1461# 2) A period match the newline character. 1462# 3) The source string is treated as a single line. 1463# Oracle only supports the following modifiers 1464# 'i' specifies case-insensitive matching. Same for PG. 1465# 'c' specifies case-sensitive matching. Same for PG. 1466# 'x' Ignores whitespace characters in the search pattern. Same for PG. 1467# 'n' allows the period (.) to match the newline character. PG => s. 1468# 'm' treats the source string as multiple lines. PG => n. 1469#------------------------------------------------------------------------------ 1470sub regex_flags 1471{ 1472 my ($class, $modifier, $append) = @_; 1473 1474 my $nconst = ''; 1475 my $flags = $append || ''; 1476 1477 if ($modifier =~ /\?TEXTVALUE(\d+)\?/) 1478 { 1479 $nconst = $1; 1480 $modifier =~ s/\?TEXTVALUE$nconst\?/$class->{text_values}{$nconst}/; 1481 } 1482 # These flags have the same behavior 1483 if ($modifier =~ /([icx]+)/) { 1484 $flags .= $1; 1485 } 1486 # Oracle: 1487 # m : treats the source string as multiple lines. 1488 # SELECT '1' FROM DUAL WHERE REGEXP_LIKE('Hello'||CHR(10)||'world!', '^world!$', 'm'); => 1 1489 # PostgreSQL: 1490 # m : historical synonym for n => m : newline-sensitive matching 1491 # SELECT regexp_match('Hello'||chr(10)||'world!', '^world!$', 'm'); => match 1492 if ($modifier =~ /m/) { 1493 $flags .= 'n'; 1494 } 1495 # Oracle: 1496 # n: allows the period (.) to match the newline character. 1497 # SELECT '1' FROM DUAL WHERE REGEXP_LIKE('a'||CHR(10)||'d', 'a.d', 'n'); => 1 1498 # SELECT '1' FROM DUAL WHERE REGEXP_LIKE('a'||CHR(10)||'d', '^d$', 'n'); => not match 1499 # PostgreSQL: 1500 # s: non-newline-sensitive matching (default) 1501 # SELECT regexp_match('a'||chr(10)||'d', 'a.d', 's'); => match 1502 # SELECT regexp_match('a'||chr(10)||'d', '^d$', 's'); => not match 1503 if ($modifier =~ /n/) { 1504 $flags .= 's'; 1505 } 1506 1507 # By default PG is non-newline-sensitive whereas Oracle is newline-sensitive 1508 # Oracle: 1509 # SELECT '1' FROM DUAL WHERE REGEXP_LIKE('a'||CHR(10)||'d', 'a.d'); => not match 1510 # PostgreSQL: 1511 # SELECT regexp_match('a'||chr(10)||'d', 'a.d'); => match 1512 # Add 'n' to force the same behavior like Oracle 1513 $flags .= 'n' if ($flags !~ /n|s/); 1514 1515 if ($nconst ne '') 1516 { 1517 $class->{text_values}{$nconst} = "'$flags'"; 1518 return "?TEXTVALUE$nconst?"; 1519 } 1520 1521 return "'$flags'"; 1522} 1523 1524sub replace_oracle_function 1525{ 1526 my ($class, $str, @strings) = @_; 1527 1528 my @xmlelt = (); 1529 my $field = '\s*([^\(\),]+)\s*'; 1530 my $num_field = '\s*([\d\.]+)\s*'; 1531 my $date_field = '\s*([^,\)\(]*(?:date|time)[^,\)\(]*)\s*'; 1532 1533 #-------------------------------------------- 1534 # PL/SQL to PL/PGSQL code conversion 1535 # Feel free to add your contribution here. 1536 #-------------------------------------------- 1537 1538 if ($class->{is_mysql}) { 1539 $str = mysql_to_plpgsql($class, $str); 1540 } 1541 1542 # Change NVL to COALESCE 1543 $str =~ s/NVL\s*\(/coalesce(/is; 1544 $str =~ s/NVL2\s*\($field,$field,$field\)/(CASE WHEN $1 IS NOT NULL THEN $2 ELSE $3 END)/is; 1545 1546 # Replace DEFAULT empty_blob() and empty_clob() 1547 my $empty = "''"; 1548 $empty = 'NULL' if ($class->{empty_lob_null}); 1549 $str =~ s/(empty_blob|empty_clob)\s*\(\s*\)/$empty/is; 1550 $str =~ s/(empty_blob|empty_clob)\b/$empty/is; 1551 1552 # DBMS_LOB.GETLENGTH can be replaced by binary length. 1553 $str =~ s/DBMS_LOB.GETLENGTH/octet_length/igs; 1554 # DBMS_LOB.SUBSTR can be replaced by SUBSTR() 1555 $str =~ s/DBMS_LOB.SUBSTR/substr/igs; 1556 # TO_CLOB(), we just remove it 1557 $str =~ s/TO_CLOB\s*\(/\(/igs; 1558 1559 # Replace call to SYS_GUID() function 1560 $str =~ s/\bSYS_GUID\s*\(\s*\)/$class->{uuid_function}()/igs; 1561 $str =~ s/\bSYS_GUID\b/$class->{uuid_function}()/igs; 1562 1563 # Rewrite TO_DATE formating call 1564 $str =~ s/TO_DATE\s*\(\s*('[^\']+')\s*,\s*('[^\']+')[^\)]*\)/to_date($1,$2)/igs; 1565 1566 # When the date format is ISO and we have a constant we can remove the call to to_date() 1567 if ($class->{type} eq 'PARTITION' && $class->{pg_supports_partition}) { 1568 $str =~ s/to_date\(\s*('\s*\d+-\d+-\d+ \d+:\d+:\d+')\s*,\s*'[S]*YYYY-MM-DD HH24:MI:SS'[^\)]*\)/$1/igs; 1569 } 1570 1571 # Translate to_timestamp_tz Oracle function 1572 $str =~ s/TO_TIMESTAMP_TZ\s*\((.*)\)/'to_timestamp(' . convert_date_format($class, $1, @strings) . ')'/iegs; 1573 1574 # Translate from_tz Oracle function 1575 $str =~ s/FROM_TZ\s*\(\s*([^\)]+)\s*\)/'(' . convert_from_tz($class,$1) . ')::timestamp with time zone'/iegs; 1576 1577 # Replace call to trim into btrim 1578 $str =~ s/\bTRIM\s*\(([^\(\)]+)\)/trim(both $1)/igs; 1579 1580 # Do some transformation when Orafce is not used 1581 if (!$class->{use_orafce}) 1582 { 1583 # Replace to_nchar() without format by a simple cast to text 1584 $str =~ s/\bTO_NCHAR\s*\(\s*([^,\)]+)\)/($1)::varchar/igs; 1585 # Replace to_char() without format by a simple cast to text 1586 $str =~ s/\bTO_CHAR\s*\(\s*([^,\)]+)\)/($1)::varchar/igs; 1587 # Fix format for to_char() with format 1588 $str =~ s/\b(TO_CHAR\s*\(\s*[^,\)]+\s*),(\s*[^,\)]+\s*)\)/"$1," . convert_date_format($class, $2, @strings) . ")"/iegs; 1589 if ($class->{type} ne 'TABLE') { 1590 $str =~ s/\(([^\s]+)\)(::varchar)/$1$2/igs; 1591 } else { 1592 $str =~ s/\(([^\s]+)\)(::varchar)/($1$2)/igs; 1593 } 1594 1595 # Change trunc() to date_trunc('day', field) 1596 # Trunc is replaced with date_trunc if we find date in the name of 1597 # the value because Oracle have the same trunc function on number 1598 # and date type 1599 $str =~ s/\bTRUNC\s*\($date_field\)/date_trunc('day', $1)/is; 1600 if ($str =~ s/\bTRUNC\s*\($date_field,$field\)/date_trunc($2, $1)/is || 1601 # Case where the parameters are obfuscated by function and string placeholders 1602 $str =~ s/\bTRUNC\((\%\%REPLACEFCT\d+\%\%)\s*,\s*(\?TEXTVALUE\d+\?)\)/date_trunc($2, $1)/is 1603 ) 1604 { 1605 if ($str =~ /date_trunc\(\?TEXTVALUE(\d+)\?/) 1606 { 1607 my $k = $1; 1608 $class->{text_values}{$k} =~ s/'(SYYYY|SYEAR|YEAR|[Y]+)'/'year'/is; 1609 $class->{text_values}{$k} =~ s/'Q'/'quarter'/is; 1610 $class->{text_values}{$k} =~ s/'(MONTH|MON|MM|RM)'/'month'/is; 1611 $class->{text_values}{$k} =~ s/'(IW|DAY|DY|D)'/'week'/is; 1612 $class->{text_values}{$k} =~ s/'(DDD|DD|J)'/'day'/is; 1613 $class->{text_values}{$k} =~ s/'(HH|HH12|HH24)'/'hour'/is; 1614 $class->{text_values}{$k} =~ s/'MI'/'minute'/is; 1615 } 1616 } 1617 1618 # Convert the call to the Oracle function add_months() into Pg syntax 1619 $str =~ s/ADD_MONTHS\s*\(([^,]+),\s*(\d+)\s*\)/$1 + '$2 month'::interval/si; 1620 $str =~ s/ADD_MONTHS\s*\(([^,]+),\s*([^,\(\)]+)\s*\)/$1 + $2*'1 month'::interval/si; 1621 1622 # Convert the call to the Oracle function add_years() into Pg syntax 1623 $str =~ s/ADD_YEARS\s*\(([^,]+),\s*(\d+)\s*\)/$1 + '$2 year'::interval/si; 1624 $str =~ s/ADD_YEARS\s*\(([^,]+),\s*([^,\(\)]+)\s*\)/$1 + $2*' year'::interval/si; 1625 1626 # Translate numtodsinterval Oracle function 1627 $str =~ s/(?:NUMTODSINTERVAL|NUMTOYMINTERVAL)\s*\(\s*([^,]+)\s*,\s*([^\)]+)\s*\)/($1 * ('1'||$2)::interval)/is; 1628 1629 # REGEX_LIKE( string, pattern, flags ) 1630 $str =~ s/REGEXP_LIKE\s*\(\s*([^,]+)\s*,\s*([^,]+)\s*,\s*([^\)]+)\s*\)/"regexp_match($1, $2," . regex_flags($class, $3) . ") IS NOT NULL"/iges; 1631 # REGEX_LIKE( string, pattern ) 1632 $str =~ s/REGEXP_LIKE\s*\(\s*([^,]+)\s*,\s*([^\)]+)\s*\)/"regexp_match($1, $2," . regex_flags($class, '') . ") IS NOT NULL"/iges; 1633 1634 # REGEX_COUNT( string, pattern, position, flags ) 1635 $str =~ s/REGEXP_COUNT\s*\(\s*([^,]+)\s*,\s*([^,]+)\s*,\s*(\d+)\s*,\s*([^\)]+)\s*\)/"(SELECT count(*) FROM regexp_matches(substr($1, $3), $2, " . regex_flags($class, $4, 'g') . "))"/iges; 1636 # REGEX_COUNT( string, pattern, position ) 1637 $str =~ s/REGEXP_COUNT\s*\(\s*([^,]+)\s*,\s*([^,]+)\s*,\s*(\d+)\s*\)/(SELECT count(*) FROM regexp_matches(substr($1, $3), $2, 'g'))/igs; 1638 # REGEX_COUNT( string, pattern ) 1639 $str =~ s/REGEXP_COUNT\s*\(\s*([^,]+)\s*,\s*([^\)]+)\s*\)/(SELECT count(*) FROM regexp_matches($1, $2, 'g'))/igs; 1640 # REGEX_SUBSTR( string, pattern, pos, num ) translation 1641 $str =~ s/REGEXP_SUBSTR\s*\(\s*([^\)]+)\s*\)/convert_regex_substr($class, $1)/iges; 1642 1643 # LAST_DAY( date ) translation 1644 $str =~ s/\bLAST_DAY\(\s*([^\(\)]+)\s*\)/((date_trunc('month',($1)::timestamp + interval '1 month'))::date - 1)/igs; 1645 } 1646 1647 # Replace INSTR by POSITION 1648 $str =~ s/\bINSTR\s*\(\s*([^,]+),\s*([^\),]+)\s*\)/position($2 in $1)/is; 1649 $str =~ s/\bINSTR\s*\(\s*([^,]+),\s*([^,]+)\s*,\s*1\s*\)/position($2 in $1)/is; 1650 1651 # The to_number() function reclaim a second argument under postgres which is the format. 1652 # Replace to_number with a cast when no specific format is given 1653 if (lc($class->{to_number_conversion}) ne 'none') 1654 { 1655 if ($class->{to_number_conversion} =~ /(numeric|bigint|integer|int)/i) 1656 { 1657 my $cast = lc($1); 1658 if ($class->{type} ne 'TABLE') { 1659 $str =~ s/\bTO_NUMBER\s*\(\s*([^,\)]+)\s*\)\s?/($1)\:\:$cast /is; 1660 } else { 1661 $str =~ s/\bTO_NUMBER\s*\(\s*([^,\)]+)\s*\)\s?/($1\:\:$cast) /is; 1662 } 1663 } 1664 else 1665 { 1666 $str =~ s/\bTO_NUMBER\s*\(\s*([^,\)]+)\s*\)/to_number\($1,'$class->{to_number_conversion}'\)/is; 1667 } 1668 } 1669 1670 # Replace the UTC convertion with the PG syntaxe 1671 $str =~ s/SYS_EXTRACT_UTC\s*\(([^\)]+)\)/($1 AT TIME ZONE 'UTC')/is; 1672 1673 # Remove call to XMLCDATA, there's no such function with PostgreSQL 1674 $str =~ s/XMLCDATA\s*\(([^\)]+)\)/'<![CDATA[' || $1 || ']]>'/is; 1675 # Remove call to getClobVal() or getStringVal, no need of that 1676 $str =~ s/\.(getClobVal|getStringVal)\s*\(\s*\)//is; 1677 # Add the name keyword to XMLELEMENT 1678 $str =~ s/XMLELEMENT\s*\(\s*/XMLELEMENT(name /is; 1679 1680 # Cast round() call as numeric 1681 $str =~ s/round\s*\(([^,]+),([\s\d]+)\)/round\(($1)::numeric,$2\)/is; 1682 1683 if ($str =~ /SDO_/is) 1684 { 1685 # Replace SDO_GEOM to the postgis equivalent 1686 $str = &replace_sdo_function($str); 1687 1688 # Replace Spatial Operator to the postgis equivalent 1689 $str = &replace_sdo_operator($str); 1690 } 1691 1692 # Rewrite replace(a,b) with three argument 1693 $str =~ s/REPLACE\s*\($field,$field\)/replace($1, $2, '')/is; 1694 1695 # Replace Oracle substr(string, start_position, length) with 1696 # PostgreSQL substring(string from start_position for length) 1697 $str =~ s/\bsubstrb\s*\(/substr\(/igs; 1698 if (!$class->{pg_supports_substr}) 1699 { 1700 $str =~ s/\bsubstr\s*\($field,$field,$field\)/substring($1 from $2 for $3)/is; 1701 $str =~ s/\bsubstr\s*\($field,$field\)/substring($1 from $2)/is; 1702 } 1703 1704 # Replace call to function with out parameters 1705 $str = replace_out_param_call($class, $str); 1706 1707 # Replace some sys_context call to the postgresql equivalent 1708 if ($str =~ /SYS_CONTEXT/is) { 1709 replace_sys_context($str); 1710 } 1711 1712 return $str; 1713} 1714 1715############## 1716# Replace call to function with out parameters 1717############## 1718sub replace_out_param_call 1719{ 1720 my ($class, $str) = @_; 1721 1722 if (uc($class->{type}) =~ /^(PACKAGE|FUNCTION|PROCEDURE|TRIGGER)$/) 1723 { 1724 foreach my $sch (sort keys %{$class->{function_metadata}}) 1725 { 1726 foreach my $p (sort keys %{$class->{function_metadata}{$sch}}) 1727 { 1728 foreach my $k (sort keys %{$class->{function_metadata}{$sch}{$p}}) 1729 { 1730 if ($class->{function_metadata}{$sch}{$p}{$k}{metadata}{inout}) 1731 { 1732 my $fct_name = $class->{function_metadata}{$sch}{$p}{$k}{metadata}{fct_name} || ''; 1733 next if (!$fct_name); 1734 next if ($p eq 'none' && $str !~ /\b$fct_name\b/is); 1735 next if ($p ne 'none' && $str !~ /\b$p\.$fct_name\b/is && $str !~ /(^|[^\.])\b$fct_name\b/is); 1736 1737 # Prevent replacement with same function name from an other package 1738 next if ($class->{current_package} && lc($p) ne lc($class->{current_package}) && $str =~ /(^|[^\.])\b$fct_name\b/is); 1739 1740 my %replace_out_parm = (); 1741 my $idx = 0; 1742 while ($str =~ s/((?:[^\s\.]+\.)?\b$fct_name)\s*\(([^\(\)]+)\)/\%FCTINOUTPARAM$idx\%/is) 1743 { 1744 my $fname = $1; 1745 my $fparam = $2; 1746 if ($fname =~ /\./ && lc($fname) ne lc($k)) 1747 { 1748 $replace_out_parm{$idx} = "$fname($fparam)"; 1749 next; 1750 } 1751 $replace_out_parm{$idx} = "$fname("; 1752 # Extract position of out parameters 1753 my @params = split(/\s*,\s*/, $class->{function_metadata}{$sch}{$p}{$k}{metadata}{args}); 1754 my @cparams = split(/\s*,\s*/s, $fparam); 1755 my $call_params = ''; 1756 my @out_pos = (); 1757 my @out_fields = (); 1758 for (my $i = 0; $i <= $#params; $i++) 1759 { 1760 if (!$class->{is_mysql} && $params[$i] =~ /\s*([^\s]+)\s+(OUT|INOUT)\s/is) 1761 { 1762 push(@out_fields, $1); 1763 push(@out_pos, $i); 1764 $call_params .= $cparams[$i] if ($params[$i] =~ /\bINOUT\b/is); 1765 } 1766 elsif ($class->{is_mysql} && $params[$i] =~ /\s*(OUT|INOUT)\s+([^\s]+)\s/is) 1767 { 1768 push(@out_fields, $2); 1769 push(@out_pos, $i); 1770 $call_params .= $cparams[$i] if ($params[$i] =~ /\bINOUT\b/is); 1771 } 1772 else 1773 { 1774 $call_params .= $cparams[$i]; 1775 } 1776 $call_params .= ', ' if ($i < $#params); 1777 } 1778 map { s/^\(//; } @out_fields; 1779 $call_params =~ s/(\s*,\s*)+$//s; 1780 while ($call_params =~ s/\s*,\s*,\s*/, /s) {}; 1781 $call_params =~ s/^(\s*,\s*)+//s; 1782 $replace_out_parm{$idx} .= "$call_params)"; 1783 my @out_param = (); 1784 foreach my $i (@out_pos) { 1785 push(@out_param, $cparams[$i]); 1786 } 1787 if ($class->{function_metadata}{$sch}{$p}{$k}{metadata}{inout} == 1) 1788 { 1789 if ($#out_param == 0) { 1790 $replace_out_parm{$idx} = "$out_param[0] := $replace_out_parm{$idx}"; 1791 } else { 1792 $replace_out_parm{$idx} = "SELECT * FROM $replace_out_parm{$idx} INTO " . join(', ', @out_param); 1793 } 1794 } 1795 elsif ($class->{function_metadata}{$sch}{$p}{$k}{metadata}{inout} > 1) 1796 { 1797 $class->{replace_out_params} = "_ora2pg_r RECORD;" if (!$class->{replace_out_params}); 1798 $replace_out_parm{$idx} = "SELECT * FROM $replace_out_parm{$idx} INTO _ora2pg_r;"; 1799 my $out_field_pos = 0; 1800 foreach $param (@out_param) { 1801 $replace_out_parm{$idx} .= " $param := _ora2pg_r.$out_fields[$out_field_pos++];"; 1802 } 1803 $replace_out_parm{$idx} =~ s/;$//s; 1804 } 1805 $idx++; 1806 } 1807 $str =~ s/\%FCTINOUTPARAM(\d+)\%/$replace_out_parm{$1}/gs; 1808 } 1809 } 1810 } 1811 } 1812 } 1813 return $str; 1814} 1815 1816# Replace decode("user_status",'active',"username",null) 1817# PostgreSQL (CASE WHEN "user_status"='ACTIVE' THEN "username" ELSE NULL END) 1818sub replace_decode 1819{ 1820 my $str = shift; 1821 1822 while ($str =~ s/\bDECODE\s*\((.*)$/\%DECODE\%/is) { 1823 my @decode_params = (''); 1824 my $stop_learning = 0; 1825 my $idx = 1; 1826 foreach my $c (split(//, $1)) { 1827 $idx++ if (!$stop_learning && $c eq '('); 1828 $idx-- if (!$stop_learning && $c eq ')'); 1829 1830 if ($idx == 0) { 1831 # Do not copy last parenthesis in the output string 1832 $c = '' if (!$stop_learning); 1833 # Inform the loop that we don't want to process any charater anymore 1834 $stop_learning = 1; 1835 # We have reach the end of the decode() parameter 1836 # next character must be restored to the final string. 1837 $str .= $c; 1838 } elsif ($idx > 0) { 1839 # We are parsing the decode() parameter part, append 1840 # the caracter to the right part of the param array. 1841 if ($c eq ',' && ($idx - 1) == 0) { 1842 # we are switching to a new parameter 1843 push(@decode_params, ''); 1844 } elsif ($c ne "\n") { 1845 $decode_params[-1] .= $c; 1846 } 1847 } 1848 } 1849 my $case_str = 'CASE '; 1850 for (my $i = 1; $i <= $#decode_params; $i+=2) { 1851 $decode_params[$i] =~ s/^\s+//gs; 1852 $decode_params[$i] =~ s/\s+$//gs; 1853 if ($i < $#decode_params) { 1854 $case_str .= "WHEN $decode_params[0]=$decode_params[$i] THEN $decode_params[$i+1] "; 1855 } else { 1856 $case_str .= " ELSE $decode_params[$i] "; 1857 } 1858 } 1859 $case_str .= 'END '; 1860 $str =~ s/\%DECODE\%/$case_str/s; 1861 } 1862 1863 return $str; 1864} 1865 1866# Function to replace call to SYS_CONTECT('USERENV', ...) 1867# List of Oracle environment variables: http://docs.oracle.com/cd/B28359_01/server.111/b28286/functions172.htm 1868# Possibly corresponding PostgreSQL variables: http://www.postgresql.org/docs/current/static/functions-info.html 1869sub replace_sys_context 1870{ 1871 my $str = shift; 1872 1873 $str =~ s/SYS_CONTEXT\s*\(\s*'USERENV'\s*,\s*'(OS_USER|SESSION_USER|AUTHENTICATED_IDENTITY)'\s*\)/session_user/is; 1874 $str =~ s/SYS_CONTEXT\s*\(\s*'USERENV'\s*,\s*'BG_JOB_ID'\s*\)/pg_backend_pid()/is; 1875 $str =~ s/SYS_CONTEXT\s*\(\s*'USERENV'\s*,\s*'(CLIENT_IDENTIFIER|PROXY_USER)'\s*\)/session_user/is; 1876 $str =~ s/SYS_CONTEXT\s*\(\s*'USERENV'\s*,\s*'CURRENT_SCHEMA'\s*\)/current_schema/is; 1877 $str =~ s/SYS_CONTEXT\s*\(\s*'USERENV'\s*,\s*'CURRENT_USER'\s*\)/current_user/is; 1878 $str =~ s/SYS_CONTEXT\s*\(\s*'USERENV'\s*,\s*'(DB_NAME|DB_UNIQUE_NAME)'\s*\)/current_database/is; 1879 $str =~ s/SYS_CONTEXT\s*\(\s*'USERENV'\s*,\s*'(HOST|IP_ADDRESS)'\s*\)/inet_client_addr()/is; 1880 $str =~ s/SYS_CONTEXT\s*\(\s*'USERENV'\s*,\s*'SERVER_HOST'\s*\)/inet_server_addr()/is; 1881 1882 return $str; 1883} 1884 1885sub replace_sdo_function 1886{ 1887 my $str = shift; 1888 1889 $str =~ s/SDO_GEOM\.RELATE/ST_Relate/igs; 1890 $str =~ s/SDO_GEOM\.VALIDATE_GEOMETRY_WITH_CONTEXT/ST_IsValidReason/igs; 1891 $str =~ s/SDO_GEOM\.WITHIN_DISTANCE/ST_DWithin/igs; 1892 $str =~ s/SDO_GEOM\.//igs; 1893 $str =~ s/SDO_DISTANCE/ST_Distance/igs; 1894 $str =~ s/SDO_BUFFER/ST_Buffer/igs; 1895 $str =~ s/SDO_CENTROID/ST_Centroid/igs; 1896 $str =~ s/SDO_UTIL\.GETVERTICES/ST_DumpPoints/igs; 1897 $str =~ s/SDO_TRANSLATE/ST_Translate/igs; 1898 $str =~ s/SDO_SIMPLIFY/ST_Simplify/igs; 1899 $str =~ s/SDO_AREA/ST_Area/igs; 1900 $str =~ s/SDO_CONVEXHULL/ST_ConvexHull/igs; 1901 $str =~ s/SDO_DIFFERENCE/ST_Difference/igs; 1902 $str =~ s/SDO_INTERSECTION/ST_Intersection/igs; 1903 $str =~ s/SDO_LENGTH/ST_Length/igs; 1904 $str =~ s/SDO_POINTONSURFACE/ST_PointOnSurface/igs; 1905 $str =~ s/SDO_UNION/ST_Union/igs; 1906 $str =~ s/SDO_XOR/ST_SymDifference/igs; 1907 1908 # Note that with ST_DumpPoints and : 1909 # TABLE(SDO_UTIL.GETVERTICES(C.GEOLOC)) T 1910 # T.X, T.Y, T.ID must be replaced manually as ST_X(T.geom) X, ST_Y(T.geom) Y, (T).path[1] ID 1911 my $field = '\s*[^\(\),]+\s*'; 1912 my $num_field = '\s*[\d\.]+\s*'; 1913 1914 # SDO_GEOM.RELATE(geom1 IN SDO_GEOMETRY,mask IN VARCHAR2,geom2 IN SDO_GEOMETRY,tol IN NUMBER) 1915 $str =~ s/(ST_Relate\s*\($field),$field,($field),($field)\)/$1,$2\)/is; 1916 # SDO_GEOM.RELATE(geom1 IN SDO_GEOMETRY,dim1 IN SDO_DIM_ARRAY,mask IN VARCHAR2,geom2 IN SDO_GEOMETRY,dim2 IN SDO_DIM_ARRAY) 1917 $str =~ s/(ST_Relate\s*\($field),$field,$field,($field),$field\)/$1,$2\)/is; 1918 # SDO_GEOM.SDO_AREA(geom IN SDO_GEOMETRY, tol IN NUMBER [, unit IN VARCHAR2]) 1919 # SDO_GEOM.SDO_AREA(geom IN SDO_GEOMETRY,dim IN SDO_DIM_ARRAY [, unit IN VARCHAR2]) 1920 $str =~ s/(ST_Area\s*\($field),[^\)]+\)/$1\)/is; 1921 # SDO_GEOM.SDO_BUFFER(geom IN SDO_GEOMETRY,dist IN NUMBER, tol IN NUMBER [, params IN VARCHAR2]) 1922 $str =~ s/(ST_Buffer\s*\($field,$num_field),[^\)]+\)/$1\)/is; 1923 # SDO_GEOM.SDO_BUFFER(geom IN SDO_GEOMETRY,dim IN SDO_DIM_ARRAY,dist IN NUMBER [, params IN VARCHAR2]) 1924 $str =~ s/(ST_Buffer\s*\($field),$field,($num_field)[^\)]*\)/$1,$2\)/is; 1925 # SDO_GEOM.SDO_CENTROID(geom1 IN SDO_GEOMETRY,tol IN NUMBER) 1926 # SDO_GEOM.SDO_CENTROID(geom1 IN SDO_GEOMETRY,dim1 IN SDO_DIM_ARRAY) 1927 $str =~ s/(ST_Centroid\s*\($field),$field\)/$1\)/is; 1928 # SDO_GEOM.SDO_CONVEXHULL(geom1 IN SDO_GEOMETRY,tol IN NUMBER) 1929 # SDO_GEOM.SDO_CONVEXHULL(geom1 IN SDO_GEOMETRY,dim1 IN SDO_DIM_ARRAY) 1930 $str =~ s/(ST_ConvexHull\s*\($field),$field\)/$1\)/is; 1931 # SDO_GEOM.SDO_DIFFERENCE(geom1 IN SDO_GEOMETRY,geom2 IN SDO_GEOMETRY,tol IN NUMBER) 1932 $str =~ s/(ST_Difference\s*\($field,$field),$field\)/$1\)/is; 1933 # SDO_GEOM.SDO_DIFFERENCE(geom1 IN SDO_GEOMETRY,dim1 IN SDO_DIM_ARRAY,geom2 IN SDO_GEOMETRY,dim2 IN SDO_DIM_ARRAY) 1934 $str =~ s/(ST_Difference\s*\($field),$field,($field),$field\)/$1,$2\)/is; 1935 # SDO_GEOM.SDO_DISTANCE(geom1 IN SDO_GEOMETRY,geom2 IN SDO_GEOMETRY,tol IN NUMBER [, unit IN VARCHAR2]) 1936 $str =~ s/(ST_Distance\s*\($field,$field),($num_field)[^\)]*\)/$1\)/is; 1937 # SDO_GEOM.SDO_DISTANCE(geom1 IN SDO_GEOMETRY,dim1 IN SDO_DIM_ARRAY,geom2 IN SDO_GEOMETRY,dim2 IN SDO_DIM_ARRAY [, unit IN VARCHAR2]) 1938 $str =~ s/(ST_Distance\s*\($field),$field,($field),($field)[^\)]*\)/$1,$2\)/is; 1939 # SDO_GEOM.SDO_INTERSECTION(geom1 IN SDO_GEOMETRY,geom2 IN SDO_GEOMETRY,tol IN NUMBER) 1940 $str =~ s/(ST_Intersection\s*\($field,$field),$field\)/$1\)/is; 1941 # SDO_GEOM.SDO_INTERSECTION(geom1 IN SDO_GEOMETRY,dim1 IN SDO_DIM_ARRAY,geom2 IN SDO_GEOMETRY,dim2 IN SDO_DIM_ARRAY) 1942 $str =~ s/(ST_Intersection\s*\($field),$field,($field),$field\)/$1,$2\)/is; 1943 # SDO_GEOM.SDO_LENGTH(geom IN SDO_GEOMETRY, dim IN SDO_DIM_ARRAY [, unit IN VARCHAR2]) 1944 # SDO_GEOM.SDO_LENGTH(geom IN SDO_GEOMETRY, tol IN NUMBER [, unit IN VARCHAR2]) 1945 $str =~ s/(ST_Length\s*\($field),($field)[^\)]*\)/$1\)/is; 1946 # SDO_GEOM.SDO_POINTONSURFACE(geom1 IN SDO_GEOMETRY, tol IN NUMBER) 1947 # SDO_GEOM.SDO_POINTONSURFACE(geom1 IN SDO_GEOMETRY, dim1 IN SDO_DIM_ARRAY) 1948 $str =~ s/(ST_PointOnSurface\s*\($field),$field\)/$1\)/is; 1949 # SDO_GEOM.SDO_UNION(geom1 IN SDO_GEOMETRY, geom2 IN SDO_GEOMETRY, tol IN NUMBER) 1950 $str =~ s/(ST_Union\s*\($field,$field),$field\)/$1\)/is; 1951 # SDO_GEOM.SDO_UNION(geom1 IN SDO_GEOMETRY,dim1 IN SDO_DIM_ARRAY,geom2 IN SDO_GEOMETRY,dim2 IN SDO_DIM_ARRAY) 1952 $str =~ s/(ST_Union\s*\($field),$field,($field),$field\)/$1,$2\)/is; 1953 # SDO_GEOM.SDO_XOR(geom1 IN SDO_GEOMETRY,geom2 IN SDO_GEOMETRY, tol IN NUMBER) 1954 $str =~ s/(ST_SymDifference\s*\($field,$field),$field\)/$1\)/is; 1955 # SDO_GEOM.SDO_XOR(geom1 IN SDO_GEOMETRY,dim1 IN SDO_DIM_ARRAY,geom2 IN SDO_GEOMETRY,dim2 IN SDO_DIM_ARRAY) 1956 $str =~ s/(ST_SymDifference\s*\($field),$field,($field),$field\)/$1,$2\)/is; 1957 # SDO_GEOM.VALIDATE_GEOMETRY_WITH_CONTEXT(geom1 IN SDO_GEOMETRY, tol IN NUMBER) 1958 # SDO_GEOM.VALIDATE_GEOMETRY_WITH_CONTEXT(geom1 IN SDO_GEOMETRY, dim1 IN SDO_DIM_ARRAY) 1959 $str =~ s/(ST_IsValidReason\s*\($field),$field\)/$1\)/is; 1960 # SDO_GEOM.WITHIN_DISTANCE(geom1 IN SDO_GEOMETRY,dim1 IN SDO_DIM_ARRAY,dist IN NUMBER,geom2 IN SDO_GEOMETRY,dim2 IN SDO_DIM_ARRAY [, units IN VARCHAR2]) 1961 $str =~ s/(ST_DWithin\s*\($field),$field,($field),($field),($field)[^\)]*\)/$1,$3,$2\)/is; 1962 # SDO_GEOM.WITHIN_DISTANCE(geom1 IN SDO_GEOMETRY,dist IN NUMBER,geom2 IN SDO_GEOMETRY, tol IN NUMBER [, units IN VARCHAR2]) 1963 $str =~ s/(ST_DWithin\s*\($field)(,$field)(,$field),($field)[^\)]*\)/$1$3$2\)/is; 1964 1965 return $str; 1966} 1967 1968sub replace_sdo_operator 1969{ 1970 my $str = shift; 1971 1972 # SDO_CONTAINS(geometry1, geometry2) = 'TRUE' 1973 $str =~ s/SDO_CONTAINS\s*\((.*?)\)\s*=\s*[']+TRUE[']+/ST_Contains($1)/is; 1974 $str =~ s/SDO_CONTAINS\s*\((.*?)\)\s*=\s*[']+FALSE[']+/NOT ST_Contains($1)/is; 1975 $str =~ s/SDO_CONTAINS\s*\(([^\)]+)\)/ST_Contains($1)/is; 1976 # SDO_RELATE(geometry1, geometry2, param) = 'TRUE' 1977 $str =~ s/SDO_RELATE\s*\((.*?)\)\s*=\s*[']+TRUE[']+/ST_Relate($1)/is; 1978 $str =~ s/SDO_RELATE\s*\((.*?)\)\s*=\s*[']+FALSE[']+/NOT ST_Relate($1)/is; 1979 $str =~ s/SDO_RELATE\s*\(([^\)]+)\)/ST_Relate($1)/is; 1980 # SDO_WITHIN_DISTANCE(geometry1, aGeom, params) = 'TRUE' 1981 $str =~ s/SDO_WITHIN_DISTANCE\s*\((.*?)\)\s*=\s*[']+TRUE[']+/ST_DWithin($1)/is; 1982 $str =~ s/SDO_WITHIN_DISTANCE\s*\((.*?)\)\s*=\s*[']+FALSE[']+/NOT ST_DWithin($1)/is; 1983 $str =~ s/SDO_WITHIN_DISTANCE\s*\(([^\)]+)\)/ST_DWithin($1)/is; 1984 # SDO_TOUCH(geometry1, geometry2) = 'TRUE' 1985 $str =~ s/SDO_TOUCH\s*\((.*?)\)\s*=\s*[']+TRUE[']+/ST_Touches($1)/is; 1986 $str =~ s/SDO_TOUCH\s*\((.*?)\)\s*=\s*[']+FALSE[']+/NOT ST_Touches($1)/is; 1987 $str =~ s/SDO_TOUCH\s*\(([^\)]+)\)/ST_Touches($1)/is; 1988 # SDO_OVERLAPS(geometry1, geometry2) = 'TRUE' 1989 $str =~ s/SDO_OVERLAPS\s*\((.*?)\)\s*=\s*[']+TRUE[']+/ST_Overlaps($1)/is; 1990 $str =~ s/SDO_OVERLAPS\s*\((.*?)\)\s*=\s*[']+FALSE[']+/NOT ST_Overlaps($1)/is; 1991 $str =~ s/SDO_OVERLAPS\s*\(([^\)]+)\)/ST_Overlaps($1)/is; 1992 # SDO_INSIDE(geometry1, geometry2) = 'TRUE' 1993 $str =~ s/SDO_INSIDE\s*\((.*?)\)\s*=\s*[']+TRUE[']+/ST_Within($1)/is; 1994 $str =~ s/SDO_INSIDE\s*\((.*?)\)\s*=\s*[']+FALSE[']+/NOT ST_Within($1)/is; 1995 $str =~ s/SDO_INSIDE\s*\(([^\)]+)\)/ST_Within($1)/is; 1996 # SDO_EQUAL(geometry1, geometry2) = 'TRUE' 1997 $str =~ s/SDO_EQUAL\s*\((.*?)\)\s*=\s*[']+TRUE[']+/ST_Equals($1)/is; 1998 $str =~ s/SDO_EQUAL\s*\((.*?)\)\s*=\s*[']+FALSE[']+/NOT ST_Equals($1)/is; 1999 $str =~ s/SDO_EQUAL\s*\(([^\)]+)\)/ST_Equals($1)/is; 2000 # SDO_COVERS(geometry1, geometry2) = 'TRUE' 2001 $str =~ s/SDO_COVERS\s*\((.*?)\)\s*=\s*[']+TRUE[']+/ST_Covers($1)/is; 2002 $str =~ s/SDO_COVERS\s*\((.*?)\)\s*=\s*[']+FALSE[']+/NOT ST_Covers($1)/is; 2003 $str =~ s/SDO_COVERS\s*\(([^\)]+)\)/ST_Covers($1)/is; 2004 # SDO_COVEREDBY(geometry1, geometry2) = 'TRUE' 2005 $str =~ s/SDO_COVEREDBY\s*\((.*?)\)\s*=\s*[']+TRUE[']+/ST_CoveredBy($1)/is; 2006 $str =~ s/SDO_COVEREDBY\s*\((.*?)\)\s*=\s*[']+FALSE[']+/NOT ST_CoveredBy($1)/is; 2007 $str =~ s/SDO_COVEREDBY\s*\(([^\)]+)\)/ST_CoveredBy($1)/is; 2008 # SDO_ANYINTERACT(geometry1, geometry2) = 'TRUE' 2009 $str =~ s/SDO_ANYINTERACT\s*\((.*?)\)\s*=\s*[']+TRUE[']+/ST_Intersects($1)/is; 2010 $str =~ s/SDO_ANYINTERACT\s*\((.*?)\)\s*=\s*[']+FALSE[']+/NOT ST_Intersects($1)/is; 2011 $str =~ s/SDO_ANYINTERACT\s*\(([^\)]+)\)/ST_Intersects($1)/is; 2012 2013 return $str; 2014} 2015 2016# Function used to rewrite dbms_output.put, dbms_output.put_line and 2017# dbms_output.new_line by a plpgsql code 2018sub raise_output 2019{ 2020 my ($class, $str) = @_; 2021 2022 my @strings = split(/\s*\|\|\s*/s, $str); 2023 2024 my @params = (); 2025 my @pattern = (); 2026 foreach my $el (@strings) { 2027 $el =~ s/\?TEXTVALUE(\d+)\?/$class->{text_values}{$1}/gs; 2028 $el =~ s/ORA2PG_ESCAPE2_QUOTE/''/gs; 2029 $el =~ s/ORA2PG_ESCAPE1_QUOTE'/\\'/gs; 2030 if ($el =~ /^\s*'(.*)'\s*$/s) { 2031 push(@pattern, $1); 2032 } else { 2033 push(@pattern, '%'); 2034 push(@params, $el); 2035 } 2036 } 2037 #my $ret = "RAISE NOTICE '$pattern'"; 2038 my $ret = "'" . join('', @pattern) . "'"; 2039 $ret =~ s/\%\%/\% \%/gs; 2040 if ($#params >= 0) { 2041 $ret .= ', ' . join(', ', @params); 2042 } 2043 2044 return 'RAISE NOTICE ' . $ret; 2045} 2046 2047sub replace_sql_type 2048{ 2049 my ($str, $pg_numeric_type, $default_numeric, $pg_integer_type, %data_type) = @_; 2050 2051 2052 $str =~ s/with local time zone/with time zone/igs; 2053 $str =~ s/([A-Z])\%ORA2PG_COMMENT/$1 \%ORA2PG_COMMENT/igs; 2054 2055 # Replace MySQL type UNSIGNED in cast 2056 $str =~ s/UNSIGNED\s*\)/bigint)/is; 2057 2058 # Remove precision for RAW|BLOB as type modifier is not allowed for type "bytea" 2059 $str =~ s/\b(RAW|BLOB)\s*\(\s*\d+\s*\)/$1/igs; 2060 2061 # Replace type with precision 2062 my @ora_type = keys %data_type; 2063 map { s/\(/\\\(/; s/\)/\\\)/; } @ora_type; 2064 my $oratype_regex = join('|', @ora_type); 2065 2066 while ($str =~ /(.*)\b($oratype_regex)\s*\(([^\)]+)\)/i) 2067 { 2068 my $backstr = $1; 2069 my $type = uc($2); 2070 my $args = $3; 2071 2072 # Remove extra CHAR or BYTE information from column type 2073 $args =~ s/\s*(CHAR|BYTE)\s*$//i; 2074 if ($backstr =~ /_$/) 2075 { 2076 $str =~ s/\b($oratype_regex)\s*\(([^\)]+)\)/$1\%\|$2\%\|\%/is; 2077 next; 2078 } 2079 2080 my ($precision, $scale) = split(/\s*,\s*/, $args); 2081 $precision = 38 if ($precision eq '*'); # case of NUMBER(*,10) or NUMBER(*) 2082 $len = $precision if ($len eq '*'); 2083 $scale ||= 0; 2084 my $len = $precision || 0; 2085 $len =~ s/\D//; 2086 if ( $type =~ /CHAR|STRING/i ) 2087 { 2088 # Type CHAR have default length set to 1 2089 # Type VARCHAR(2) must have a specified length 2090 $len = 1 if (!$len && (($type eq "CHAR") || ($type eq "NCHAR"))); 2091 $str =~ s/\b$type\b\s*\([^\)]+\)/$data_type{$type}\%\|$len\%\|\%/is; 2092 } 2093 elsif ($type =~ /TIMESTAMP/i) 2094 { 2095 $len = 6 if ($len > 6); 2096 $str =~ s/\b$type\b\s*\([^\)]+\)/timestamp\%\|$len%\|\%/is; 2097 } 2098 elsif ($type =~ /INTERVAL/i) 2099 { 2100 # Interval precision for year/month/day is not supported by PostgreSQL 2101 $str =~ s/(INTERVAL\s+YEAR)\s*\(\d+\)/$1/is; 2102 $str =~ s/(INTERVAL\s+YEAR\s+TO\s+MONTH)\s*\(\d+\)/$1/is; 2103 $str =~ s/(INTERVAL\s+DAY)\s*\(\d+\)/$1/is; 2104 # maximum precision allowed for seconds is 6 2105 if ($str =~ /INTERVAL\s+DAY\s+TO\s+SECOND\s*\((\d+)\)/) 2106 { 2107 if ($1 > 6) { 2108 $str =~ s/(INTERVAL\s+DAY\s+TO\s+SECOND)\s*\(\d+\)/$1(6)/i; 2109 } 2110 } 2111 } 2112 elsif ($type eq "NUMBER") 2113 { 2114 # This is an integer 2115 if (!$scale) 2116 { 2117 if ($precision) 2118 { 2119 if ($pg_integer_type) 2120 { 2121 if ($precision < 5) { 2122 $str =~ s/\b$type\b\s*\([^\)]+\)/smallint/is; 2123 } elsif ($precision <= 9) { 2124 $str =~ s/\b$type\b\s*\([^\)]+\)/integer/is; 2125 } else { 2126 $str =~ s/\b$type\b\s*\([^\)]+\)/bigint/is; 2127 } 2128 } else { 2129 $str =~ s/\b$type\b\s*\([^\)]+\)/numeric\%\|$precision\%\|\%/i; 2130 } 2131 } 2132 elsif ($pg_integer_type) 2133 { 2134 my $tmp = $default_numeric || 'bigint'; 2135 $str =~ s/\b$type\b\s*\([^\)]+\)/$tmp/is; 2136 } 2137 } 2138 else 2139 { 2140 if ($pg_numeric_type) 2141 { 2142 if ($precision eq '') { 2143 $str =~ s/\b$type\b\s*\([^\)]+\)/decimal(38, $scale)/is; 2144 } elsif ($precision <= 6) { 2145 $str =~ s/\b$type\b\s*\([^\)]+\)/real/is; 2146 } else { 2147 $str =~ s/\b$type\b\s*\([^\)]+\)/double precision/is; 2148 } 2149 } 2150 else 2151 { 2152 if ($precision eq '') { 2153 $str =~ s/\b$type\b\s*\([^\)]+\)/decimal(38, $scale)/is; 2154 } else { 2155 $str =~ s/\b$type\b\s*\([^\)]+\)/decimal\%\|$precision,$scale\%\|\%/is; 2156 } 2157 } 2158 } 2159 } 2160 elsif ($type eq "NUMERIC") { 2161 $str =~ s/\b$type\b\s*\([^\)]+\)/numeric\%\|$args\%\|\%/is; 2162 } elsif ( ($type eq "DEC") || ($type eq "DECIMAL") ) { 2163 $str =~ s/\b$type\b\s*\([^\)]+\)/decimal\%\|$args\%\|\%/is; 2164 } 2165 else 2166 { 2167 # Prevent from infinit loop 2168 $str =~ s/\(/\%\|/s; 2169 $str =~ s/\)/\%\|\%/s; 2170 } 2171 } 2172 $str =~ s/\%\|\%/\)/gs; 2173 $str =~ s/\%\|/\(/gs; 2174 2175 # Replace datatype without precision 2176 my $number = $data_type{'NUMBER'}; 2177 $number = $default_numeric if ($pg_integer_type); 2178 $str =~ s/\bNUMBER\b/$number/igs; 2179 2180 # Set varchar without length to text 2181 $str =~ s/\bVARCHAR2\b/VARCHAR/igs; 2182 $str =~ s/\bSTRING\b/VARCHAR/igs; 2183 $str =~ s/\bVARCHAR(\s*(?!\())/text$1/igs; 2184 2185 foreach my $t ('DATE','LONG RAW','LONG','NCLOB','CLOB','BLOB','BFILE','RAW','ROWID','UROWID','FLOAT','DOUBLE PRECISION','INTEGER','INT','REAL','SMALLINT','BINARY_FLOAT','BINARY_DOUBLE','BINARY_INTEGER','BOOLEAN','XMLTYPE','SDO_GEOMETRY','PLS_INTEGER') { 2186 $str =~ s/\b$t\b/$data_type{$t}/igs; 2187 } 2188 2189 # Translate cursor declaration 2190 $str = replace_cursor_def($str); 2191 2192 # Remove remaining %ROWTYPE in other prototype declaration 2193 #$str =~ s/\%ROWTYPE//isg; 2194 2195 $str =~ s/;[ ]+/;/gs; 2196 2197 return $str; 2198} 2199 2200sub replace_cursor_def 2201{ 2202 my $str = shift; 2203 2204 # Remove IN information from cursor declaration 2205 while ($str =~ s/(\bCURSOR\b[^\(]+)\(([^\)]+\bIN\b[^\)]+)\)/$1\(\%\%CURSORREPLACE\%\%\)/is) { 2206 my $args = $2; 2207 $args =~ s/\bIN\b//igs; 2208 $str =~ s/\%\%CURSORREPLACE\%\%/$args/is; 2209 } 2210 2211 # Replace %ROWTYPE ref cursor 2212 $str =~ s/\bTYPE\s+([^\s]+)\s+(IS\s+REF\s+CURSOR|REFCURSOR)\s+RETURN\s+[^\s\%]+\%ROWTYPE;/$1 REFCURSOR;/isg; 2213 2214 2215 # Replace local type ref cursor 2216 my %locatype = (); 2217 my $i = 0; 2218 while ($str =~ s/\bTYPE\s+([^\s]+)\s+(IS\s+REF\s+CURSOR|REFCURSOR)\s*;/\%LOCALTYPE$i\%/is) { 2219 $localtype{$i} = "TYPE $1 IS REF CURSOR;"; 2220 my $local_type = $1; 2221 if ($str =~ s/\b([^\s]+)\s+$local_type\s*;/$1 REFCURSOR;/igs) { 2222 $str =~ s/\%LOCALTYPE$i\%//igs; 2223 } 2224 $i++; 2225 } 2226 $str =~ s/\%LOCALTYPE(\d+)\%/$localtype{$1}/gs; 2227 2228 # Retrieve cursor names 2229 #my @cursor_names = $str =~ /\bCURSOR\b\s*([A-Z0-9_\$]+)/isg; 2230 # Reorder cursor declaration 2231 $str =~ s/\bCURSOR\b\s*([A-Z0-9_\$]+)/$1 CURSOR/isg; 2232 2233 # Replace call to cursor type if any 2234 #foreach my $c (@cursor_names) { 2235 # $str =~ s/\b$c\%ROWTYPE/RECORD/isg; 2236 #} 2237 2238 # Replace REF CURSOR as Pg REFCURSOR 2239 $str =~ s/\bIS(\s*)REF\s+CURSOR/REFCURSOR/isg; 2240 $str =~ s/\bREF\s+CURSOR/REFCURSOR/isg; 2241 2242 # Replace SYS_REFCURSOR as Pg REFCURSOR 2243 $str =~ s/\bSYS_REFCURSOR\b/REFCURSOR/isg; 2244 2245 # Replace CURSOR IS SELECT by CURSOR FOR SELECT 2246 $str =~ s/\bCURSOR(\s+)IS(\s+)(\%ORA2PG_COMMENT\d+\%)?(\s*)SELECT/CURSOR$1FOR$2$3$4SELECT/isg; 2247 # Replace CURSOR (param) IS SELECT by CURSOR FOR SELECT 2248 $str =~ s/\bCURSOR(\s*\([^\)]+\)\s*)IS(\s*)(\%ORA2PG_COMMENT\d+\%)?(\s*)SELECT/CURSOR$1FOR$2$3$4SELECT/isg; 2249 2250 # Replace REF CURSOR as Pg REFCURSOR 2251 $str =~ s/\bIS(\s*)REF\s+CURSOR/REFCURSOR/isg; 2252 $str =~ s/\bREF\s+CURSOR/REFCURSOR/isg; 2253 2254 # Replace SYS_REFCURSOR as Pg REFCURSOR 2255 $str =~ s/\bSYS_REFCURSOR\b/REFCURSOR/isg; 2256 2257 # Replace OPEN cursor FOR with dynamic query 2258 $str =~ s/(OPEN\s+(?:[^;]+?)\s+FOR)((?:[^;]+?)USING)/$1 EXECUTE$2/isg; 2259 #$str =~ s/(OPEN\s+(?:[^;]+?)\s+FOR)\s+((?!EXECUTE)(?:[^;]+?)\|\|)/$1 EXECUTE $2/isg; 2260 $str =~ s/(OPEN\s+(?:[^;]+?)\s+FOR)\s+([^\s]+\s*;)/$1 EXECUTE $2/isg; 2261 # Remove empty parenthesis after an open cursor 2262 $str =~ s/(OPEN\s+[^\(\s;]+)\s*\(\s*\)/$1/isg; 2263 2264 # Invert FOR CURSOR call 2265 $str =~ s/\bFOR\s+CURSOR(\s+)/CURSOR FOR$1/igs; 2266 2267 return $str; 2268} 2269 2270sub estimate_cost 2271{ 2272 my ($class, $str, $type) = @_; 2273 2274 return mysql_estimate_cost($str, $type) if ($class->{is_mysql}); 2275 2276 my %cost_details = (); 2277 2278 # Remove some unused pragma from the cost assessment 2279 $str =~ s/PRAGMA RESTRICT_REFERENCES[^;]+;//igs; 2280 $str =~ s/PRAGMA SERIALLY_REUSABLE[^;]*;//igs; 2281 $str =~ s/PRAGMA INLINE[^;]+;//igs; 2282 2283 # Default cost is testing that mean it at least must be tested 2284 my $cost = $FCT_TEST_SCORE; 2285 # When evaluating queries size must not be included here 2286 if ($type eq 'QUERY' || $type eq 'VIEW') { 2287 $cost = 0; 2288 } 2289 $cost_details{'TEST'} = $cost; 2290 2291 # Set cost following code length 2292 my $cost_size = int(length($str)/$SIZE_SCORE) || 1; 2293 # When evaluating queries size must not be included here 2294 if ($type eq 'QUERY' || $type eq 'VIEW') { 2295 $cost_size = 0; 2296 } 2297 $cost += $cost_size; 2298 $cost_details{'SIZE'} = $cost_size; 2299 2300 # Try to figure out the manual work 2301 my $n = () = $str =~ m/\bIS\s+TABLE\s+OF\b/igs; 2302 $cost_details{'IS TABLE OF'} += $n; 2303 $n = () = $str =~ m/\(\+\)/igs; 2304 $cost_details{'OUTER JOIN'} += $n; 2305 $n = () = $str =~ m/\bCONNECT\s+BY\b/igs; 2306 $cost_details{'CONNECT BY'} += $n; 2307 $n = () = $str =~ m/\bBULK\s+COLLECT\b/igs; 2308 $cost_details{'BULK COLLECT'} += $n; 2309 $n = () = $str =~ m/\bFORALL\b/igs; 2310 $cost_details{'FORALL'} += $n; 2311 $n = () = $str =~ m/\bGOTO\b/igs; 2312 $cost_details{'GOTO'} += $n; 2313 $n = () = $str =~ m/\bROWNUM\b/igs; 2314 $cost_details{'ROWNUM'} += $n; 2315 $n = () = $str =~ m/\bNOTFOUND\b/igs; 2316 $cost_details{'NOTFOUND'} += $n; 2317 $n = () = $str =~ m/\bROWID\b/igs; 2318 $cost_details{'ROWID'} += $n; 2319 $n = () = $str =~ m/\bUROWID\b/igs; 2320 $cost_details{'UROWID'} += $n; 2321 $n = () = $str =~ m/\bSQLSTATE\b/igs; 2322 $cost_details{'SQLCODE'} += $n; 2323 $n = () = $str =~ m/\bIS RECORD\b/igs; 2324 $cost_details{'IS RECORD'} += $n; 2325 $n = () = $str =~ m/FROM[^;]*\bTABLE\s*\(/igs; 2326 $cost_details{'TABLE'} += $n; 2327 $n = () = $str =~ m/PIPE\s+ROW/igs; 2328 $cost_details{'PIPE ROW'} += $n; 2329 $n = () = $str =~ m/DBMS_\w/igs; 2330 $cost_details{'DBMS_'} += $n; 2331 $n = () = $str =~ m/DBMS_OUTPUT\.(put_line|new_line|put)/igs; 2332 $cost_details{'DBMS_'} -= $n; 2333 $n = () = $str =~ m/DBMS_STANDARD\.RAISE EXCEPTION/igs; 2334 $cost_details{'DBMS_'} -= $n; 2335 $n = () = $str =~ m/UTL_\w/igs; 2336 $cost_details{'UTL_'} += $n; 2337 $n = () = $str =~ m/CTX_\w/igs; 2338 $cost_details{'CTX_'} += $n; 2339 $n = () = $str =~ m/\bEXTRACT\s*\(/igs; 2340 $cost_details{'EXTRACT'} += $n; 2341 $n = () = $str =~ m/\bTO_NUMBER\s*\(/igs; 2342 $cost_details{'TO_NUMBER'} += $n; 2343 # See: http://www.postgresql.org/docs/9.0/static/errcodes-appendix.html#ERRCODES-TABLE 2344 $n = () = $str =~ m/\b(DUP_VAL_ON_INDEX|TIMEOUT_ON_RESOURCE|TRANSACTION_BACKED_OUT|NOT_LOGGED_ON|LOGIN_DENIED|INVALID_NUMBER|PROGRAM_ERROR|VALUE_ERROR|ROWTYPE_MISMATCH|CURSOR_ALREADY_OPEN|ACCESS_INTO_NULL|COLLECTION_IS_NULL)\b/igs; 2345 $cost_details{'EXCEPTION'} += $n; 2346 $n = () = $str =~ m/PLUNIT/igs; 2347 $cost_details{'PLUNIT'} += $n; 2348 if (!$class->{use_orafce}) 2349 { 2350 $n = () = $str =~ m/ADD_MONTHS/igs; 2351 $cost_details{'ADD_MONTHS'} += $n; 2352 $n = () = $str =~ m/LAST_DAY/igs; 2353 $cost_details{'LAST_DAY'} += $n; 2354 $n = () = $str =~ m/NEXT_DAY/igs; 2355 $cost_details{'NEXT_DAY'} += $n; 2356 $n = () = $str =~ m/MONTHS_BETWEEN/igs; 2357 $cost_details{'MONTHS_BETWEEN'} += $n; 2358 $n = () = $str =~ m/DBMS_OUTPUT\.put\(/igs; 2359 $cost_details{'DBMS_OUTPUT.put'} += $n; 2360 $n = () = $str =~ m/\bTRUNC\s*\(/igs; 2361 $cost_details{'TRUNC'} += $n; 2362 $n = () = $str =~ m/REGEXP_LIKE/igs; 2363 $cost_details{'REGEXP_LIKE'} += $n; 2364 $n = () = $str =~ m/REGEXP_SUBSTR/igs; 2365 $cost_details{'REGEXP_SUBSTR'} += $n; 2366 $n = () = $str =~ m/REGEXP_COUNT/igs; 2367 $cost_details{'REGEXP_COUNT'} += $n; 2368 $n = () = $str =~ m/REGEXP_INSTR/igs; 2369 $cost_details{'REGEXP_INSTR'} += $n; 2370 $n = () = $str =~ m/PLVDATE/igs; 2371 $cost_details{'PLVDATE'} += $n; 2372 $n = () = $str =~ m/PLVSTR/igs; 2373 $cost_details{'PLVSTR'} += $n; 2374 $n = () = $str =~ m/PLVCHR/igs; 2375 $cost_details{'PLVCHR'} += $n; 2376 $n = () = $str =~ m/PLVSUBST/igs; 2377 $cost_details{'PLVSUBST'} += $n; 2378 $n = () = $str =~ m/PLVLEX/igs; 2379 $cost_details{'PLVLEX'} += $n; 2380 } 2381 else 2382 { 2383 $n = () = $str =~ m/UTL_FILE/igs; 2384 $cost_details{'UTL_'} -= $n; 2385 $n = () = $str =~ m/DBMS_PIPE/igs; 2386 $cost_details{'DBMS_'} -= $n; 2387 $n = () = $str =~ m/DBMS_ALERT/igs; 2388 $cost_details{'DBMS_'} -= $n; 2389 $n = () = $str =~ m/DMS_UTILITY.FORMAT_CALL_STACK/igs; 2390 $cost_details{'DBMS_'} -= $n; 2391 $n = () = $str =~ m/DBMS_ASSERT/igs; 2392 $cost_details{'DBMS_'} -= $n; 2393 $n = () = $str =~ m/DBMS_STRING/igs; 2394 $cost_details{'DBMS_'} -= $n; 2395 $n = () = $str =~ m/PLUNIT.ASSERT/igs; 2396 $cost_details{'PLUNIT'} -= $n; 2397 } 2398 $n = () = $str =~ m/\b(INSERTING|DELETING|UPDATING)\b/igs; 2399 $cost_details{'TG_OP'} += $n; 2400 $n = () = $str =~ m/REF\s*CURSOR/igs; 2401 $cost_details{'CURSOR'} += $n; 2402 $n = () = $str =~ m/ORA_ROWSCN/igs; 2403 $cost_details{'ORA_ROWSCN'} += $n; 2404 $n = () = $str =~ m/SAVEPOINT/igs; 2405 $cost_details{'SAVEPOINT'} += $n; 2406 $n = () = $str =~ m/(FROM|EXEC)((?!WHERE).)*\b[\w\_]+\@[\w\_]+\b/igs; 2407 $cost_details{'DBLINK'} += $n; 2408 $n = () = $str =~ m/\%ISOPEN\b/igs; 2409 $cost_details{'ISOPEN'} += $n; 2410 $n = () = $str =~ m/\%ROWCOUNT\b/igs; 2411 $cost_details{'ROWCOUNT'} += $n; 2412 $n = () = $str =~ m/NVL2/igs; 2413 $cost_details{'NVL2'} += $n; 2414 $str =~ s/MDSYS\.(["]*SDO_)/$1/igs; 2415 $n = () = $str =~ m/SDO_\w/igs; 2416 $cost_details{'SDO_'} += $n; 2417 $n = () = $str =~ m/PRAGMA/igs; 2418 $cost_details{'PRAGMA'} += $n; 2419 $n = () = $str =~ m/MDSYS\./igs; 2420 $cost_details{'MDSYS'} += $n; 2421 $n = () = $str =~ m/MERGE\sINTO/igs; 2422 $cost_details{'MERGE'} += $n; 2423 $n = () = $str =~ m/\bCONTAINS\(/igs; 2424 $cost_details{'CONTAINS'} += $n; 2425 $n = () = $str =~ m/\bSCORE\((?:.*)?\bCONTAINS\(/igs; 2426 $cost_details{'SCORE'} += $n; 2427 $n = () = $str =~ m/CONTAINS\((?:.*)?\bFUZZY\(/igs; 2428 $cost_details{'FUZZY'} += $n; 2429 $n = () = $str =~ m/CONTAINS\((?:.*)?\bNEAR\(/igs; 2430 $cost_details{'NEAR'} += $n; 2431 $n = () = $str =~ m/TO_CHAR\([^,\)]+\)/igs; 2432 $cost_details{'TO_CHAR'} += $n; 2433 $n = () = $str =~ m/TO_NCHAR\([^,\)]+\)/igs; 2434 $cost_details{'TO_NCHAR'} += $n; 2435 $n = () = $str =~ m/\s+ANYDATA/igs; 2436 $cost_details{'ANYDATA'} += $n; 2437 $n = () = $str =~ m/\|\|/igs; 2438 $cost_details{'CONCAT'} += $n; 2439 $n = () = $str =~ m/TIMEZONE_(REGION|ABBR)/igs; 2440 $cost_details{'TIMEZONE'} += $n; 2441 $n = () = $str =~ m/IS\s+(NOT)?\s*JSON/igs; 2442 $cost_details{'JSON'} += $n; 2443 $n = () = $str =~ m/TO_CLOB\([^,\)]+\)/igs; 2444 $cost_details{'TO_CLOB'} += $n; 2445 2446 foreach my $f (@ORA_FUNCTIONS) { 2447 if ($str =~ /\b$f\b/igs) { 2448 $cost += 1; 2449 $cost_details{$f} += 1; 2450 } 2451 } 2452 foreach my $t (keys %UNCOVERED_SCORE) { 2453 $cost += $UNCOVERED_SCORE{$t}*$cost_details{$t}; 2454 } 2455 2456 return $cost, %cost_details; 2457} 2458 2459=head2 mysql_to_plpgsql 2460 2461This function turn a MySQL function code into a PLPGSQL code 2462 2463=cut 2464 2465sub mysql_to_plpgsql 2466{ 2467 my ($class, $str) = @_; 2468 2469 # remove FROM DUAL 2470 $str =~ s/FROM\s+DUAL//igs; 2471 2472 # Simply remove this as not supported 2473 $str =~ s/\bDEFAULT\s+NULL\b//igs; 2474 2475 # Change mysql variable affectation 2476 $str =~ s/\bSET\s+([^\s:=]+\s*)=([^;\n]+;)/$1:=$2/igs; 2477 2478 # remove declared handler 2479 $str =~ s/[^\s]+\s+HANDLER\s+FOR\s+[^;]+;//igs; 2480 2481 # Fix call to unsigned 2482 $str =~ s/UNSIGNED\sINTEGER/bigint/g; 2483 $str =~ s/UNSIGNED\sINT/bigint/g; 2484 $str =~ s/UNSIGNED/bigint/g; 2485 2486 # Drop temporary doesn't exist in PostgreSQL 2487 $str =~ s/DROP\s+TEMPORARY/DROP/gs; 2488 2489 # Private temporary table doesn't exist in PostgreSQL 2490 $str =~ s/PRIVATE\s+TEMPORARY/TEMPORARY/igs; 2491 $str =~ s/ON\s+COMMIT\s+PRESERVE\s+DEFINITION/ON COMMIT PRESERVE ROWS/igs; 2492 $str =~ s/ON\s+COMMIT\s+DROP\s+DEFINITION/ON COMMIT DROP/igs; 2493 2494 # Remove extra parenthesis in join in some possible cases 2495 # ... INNER JOIN(services s) ON ... 2496 $str =~ s/\bJOIN\s*\(([^\s]+\s+[^\s]+)\)/JOIN $1/igs; 2497 2498 # Rewrite MySQL JOIN with WHERE clause instead of ON 2499 $str =~ s/\((\s*[^\s]+(?:\s+[^\s]+)?\s+JOIN\s+[^\s]+(?:\s+[^\s]+)?\s*)\)\s+WHERE\s+/$1 ON /igs; 2500 2501 # Try to replace LEAVE label by EXIT label 2502 my %repl_leave = (); 2503 my $i = 0; 2504 while ($str =~ s/\bLEAVE\s+([^\s;]+)\s*;/%REPEXITLBL$i%/igs) { 2505 my $label = $1; 2506 if ( $str =~ /\b$label:/is) { 2507 $repl_leave{$i} = "EXIT $label;"; 2508 } else { 2509 # This is a main block label 2510 $repl_leave{$i} = "RETURN;"; 2511 } 2512 } 2513 foreach $i (keys %repl_leave) { 2514 $str =~ s/\%REPEXITLBL$i\%/$repl_leave{$i}/gs; 2515 } 2516 %repl_leave = (); 2517 $str =~ s/\bLEAVE\s*;/EXIT;/igs; 2518 2519 # Try to replace ITERATE label by CONTINUE label 2520 my %repl_iterate = (); 2521 $i = 0; 2522 while ($str =~ s/\bITERATE\s+([^\s;]+)\s*;/%REPITERLBL$i%/igs) { 2523 my $label = $1; 2524 $repl_iterate{$i} = "CONTINUE $label;"; 2525 } 2526 foreach $i (keys %repl_iterate) { 2527 $str =~ s/\%REPITERLBL$i\%/$repl_iterate{$i}/gs; 2528 } 2529 %repl_iterate = (); 2530 $str =~ s/\bITERATE\s*;/CONTINUE;/igs; 2531 2532 # Replace now() with CURRENT_TIMESTAMP even if this is the same 2533 # because parenthesis can break the following regular expressions 2534 $str =~ s/\bNOW\(\s*\)/CURRENT_TIMESTAMP/igs; 2535 # Replace call to CURRENT_TIMESTAMP() to special variable 2536 $str =~ s/\bCURRENT_TIMESTAMP\s*\(\)/CURRENT_TIMESTAMP/igs; 2537 2538 # Replace EXTRACT() with unit not supported by PostgreSQL 2539 if ($class->{mysql_internal_extract_format}) { 2540 $str =~ s/\bEXTRACT\(\s*YEAR_MONTH\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'YYYYMM')::integer/igs; 2541 $str =~ s/\bEXTRACT\(\s*DAY_HOUR\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'DDHH24')::integer/igs; 2542 $str =~ s/\bEXTRACT\(\s*DAY_MINUTE\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'DDHH24MI')::integer/igs; 2543 $str =~ s/\bEXTRACT\(\s*DAY_SECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'DDHH24MISS')::integer/igs; 2544 $str =~ s/\bEXTRACT\(\s*DAY_MICROSECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'DDHH24MISSUS')::bigint/igs; 2545 $str =~ s/\bEXTRACT\(\s*HOUR_MINUTE\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'HH24MI')::integer/igs; 2546 $str =~ s/\bEXTRACT\(\s*HOUR_SECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'HH24MISS')::integer/igs; 2547 $str =~ s/\bEXTRACT\(\s*HOUR_MICROSECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'HH24MISSUS')::bigint/igs; 2548 $str =~ s/\bEXTRACT\(\s*MINUTE_SECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'MISS')::integer/igs; 2549 $str =~ s/\bEXTRACT\(\s*MINUTE_MICROSECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'MISSUS')::bigint/igs; 2550 $str =~ s/\bEXTRACT\(\s*SECOND_MICROSECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'SSUS')::integer/igs; 2551 } else { 2552 $str =~ s/\bEXTRACT\(\s*YEAR_MONTH\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'YYYY-MM')/igs; 2553 $str =~ s/\bEXTRACT\(\s*DAY_HOUR\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'DD HH24')/igs; 2554 $str =~ s/\bEXTRACT\(\s*DAY_MINUTE\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'DD HH24:MI')/igs; 2555 $str =~ s/\bEXTRACT\(\s*DAY_SECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'DD HH24:MI:SS')/igs; 2556 $str =~ s/\bEXTRACT\(\s*DAY_MICROSECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'DD HH24:MI:SS.US')/igs; 2557 $str =~ s/\bEXTRACT\(\s*HOUR_MINUTE\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'HH24:MI')/igs; 2558 $str =~ s/\bEXTRACT\(\s*HOUR_SECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'HH24:MI:SS')/igs; 2559 $str =~ s/\bEXTRACT\(\s*HOUR_MICROSECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'HH24:MI:SS.US')/igs; 2560 $str =~ s/\bEXTRACT\(\s*MINUTE_SECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'MI:SS')/igs; 2561 $str =~ s/\bEXTRACT\(\s*MINUTE_MICROSECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'MI:SS.US')/igs; 2562 $str =~ s/\bEXTRACT\(\s*SECOND_MICROSECOND\s+FROM\s+([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'SS.US')/igs; 2563 } 2564 2565 # Replace operators 2566 if (!$class->{mysql_pipes_as_concat}) { 2567 $str =~ s/\|\|/ OR /igs; 2568 $str =~ s/\&\&/ AND /igs; 2569 } 2570 $str =~ s/BIT_XOR\(\s*([^,]+)\s*,\s*(\d+)\s*\)/$1 # coalesce($2, 0)/igs; 2571 $str =~ s/\bXOR\b/#/igs; 2572 $str =~ s/\b\^\b/#/igs; 2573 2574 #### 2575 # Replace some function with their PostgreSQL syntax 2576 #### 2577 2578 # Math related fucntion 2579 $str =~ s/\bATAN\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/atan2($1, $2)/igs; 2580 $str =~ s/\bLOG\(/ln\(/igs; 2581 $str =~ s/\bLOG10\(\s*([^\(\)]+)\s*\)/log\(10, $1\)/igs; 2582 $str =~ s/\bLOG2\(\s*([^\(\)]+)\s*\)/log\(2, $1\)/igs; 2583 $str =~ s/([^\s]+)\s+MOD\s+([^\s]+)/mod\($1, $2\)/igs; 2584 $str =~ s/\bPOW\(/power\(/igs; 2585 $str =~ s/\bRAND\(\s*\)/random\(\)/igs; 2586 2587 # Misc function 2588 $str =~ s/\bCHARSET\(\s*([^\(\)]+)\s*\)/current_setting('server_encoding')/igs; 2589 $str =~ s/\bCOLLATION\(\s*([^\(\)]+)\s*\)/current_setting('lc_collate')/igs; 2590 $str =~ s/\bCONNECTION_ID\(\s*\)/pg_backend_pid()/igs; 2591 $str =~ s/\b(DATABASE|SCHEMA)\(\s*\)/current_database()/igs; 2592 $str =~ s/\bSLEEP\(/pg_sleep\(/igs; 2593 $str =~ s/\bSYSTEM_USER\(\s*\)/CURRENT_USER/igs; 2594 $str =~ s/\bSESSION_USER\(\s*\)/SESSION_USER/igs; 2595 $str =~ s/\bTRUNCATE\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/trunc\($1, $2\)/igs; 2596 $str =~ s/\bUSER\(\s*\)/CURRENT_USER/igs; 2597 2598 # Date/time related function 2599 $str =~ s/\b(CURDATE|CURRENT_DATE)\(\s*\)/CURRENT_DATE/igs; 2600 $str =~ s/\b(CURTIME|CURRENT_TIME)\(\s*\)/LOCALTIME(0)/igs; 2601 $str =~ s/\bCURRENT_TIMESTAMP\(\s*\)/CURRENT_TIMESTAMP::timestamp(0) without time zone/igs; 2602 $str =~ s/\b(LOCALTIMESTAMP|LOCALTIME)\(\s*\)/CURRENT_TIMESTAMP::timestamp(0) without time zone/igs; 2603 $str =~ s/\b(LOCALTIMESTAMP|LOCALTIME)\b/CURRENT_TIMESTAMP::timestamp(0) without time zone/igs; 2604 $str =~ s/\bSYSDATE\(\s*\)/timeofday()::timestamp(0) without time zone/igs; 2605 $str =~ s/\bUNIX_TIMESTAMP\(\s*\)/floor(extract(epoch from CURRENT_TIMESTAMP::timestamp with time zone))/igs; 2606 $str =~ s/\bUNIX_TIMESTAMP\(\s*([^\)]+)\s*\)/floor(extract(epoch from ($1)::timestamp with time zone))/igs; 2607 $str =~ s/\bUTC_DATE\(\s*\)/(CURRENT_TIMESTAMP AT TIME ZONE 'UTC')::date/igs; 2608 $str =~ s/\bUTC_TIME\(\s*\)/(CURRENT_TIMESTAMP AT TIME ZONE 'UTC')::time(0)/igs; 2609 $str =~ s/\bUTC_TIMESTAMP\(\s*\)/(CURRENT_TIMESTAMP AT TIME ZONE 'UTC')::timestamp(0)/igs; 2610 2611 $str =~ s/\bCONVERT_TZ\(\s*([^,]+)\s*,\s*([^,]+)\s*,\s*([^\(\),]+)\s*\)/(($1)::timestamp without time zone AT TIME ZONE ($2)::text) AT TIME ZONE ($3)::text/igs; 2612 $str =~ s/\bDATEDIFF\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/extract(day from (date_trunc('day', ($1)::timestamp) - date_trunc('day', ($2)::timestamp)))/igs; 2613 $str =~ s/\bDATE_FORMAT\(\s*(.*?)\s*,\s*('[^'\(\)]+'|\?TEXTVALUE\d+\?)\s*\)/_mysql_dateformat_to_pgsql($class, $1, $2)/iges; 2614 $str =~ s/\b(?:ADDDATE|DATE_ADD)\(\s*(.*?)\s*,\s*INTERVAL\s*([^\(\),]+)\s*\)/"($1)::timestamp " . _replace_dateadd($2)/iges; 2615 $str =~ s/\bADDDATE\(\s*([^,]+)\s*,\s*(\d+)\s*\)/($1)::timestamp + ($2 * interval '1 day')/igs; 2616 $str =~ s/\bADDTIME\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/($1)::timestamp + ($2)::interval/igs; 2617 2618 2619 $str =~ s/\b(DAY|DAYOFMONTH)\(\s*([^\(\)]+)\s*\)/extract(day from date($1))::integer/igs; 2620 $str =~ s/\bDAYNAME\(\s*([^\(\)]+)\s*\)/to_char(($1)::date, 'FMDay')/igs; 2621 $str =~ s/\bDAYOFWEEK\(\s*([^\(\)]+)\s*\)/extract(dow from date($1))::integer + 1/igs; # start on sunday = 1 2622 $str =~ s/\bDAYOFYEAR\(\s*([^\(\)]+)\s*\)/extract(doy from date($1))::integer/igs; 2623 $str =~ s/\bFORMAT\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/to_char(round($1, $2), 'FM999,999,999,999,999,999,990'||case when $2 > 0 then '.'||repeat('0', $2) else '' end)/igs; 2624 $str =~ s/\bFROM_DAYS\(\s*([^\(\)]+)\s*\)/'0001-01-01bc'::date + ($1)::integer/igs; 2625 $str =~ s/\bFROM_UNIXTIME\(\s*([^\(\),]+)\s*\)/to_timestamp($1)::timestamp without time zone/igs; 2626 $str =~ s/\bFROM_UNIXTIME\(\s*(.*?)\s*,\s*('[^\(\)]+'|\?TEXTVALUE\d+\?)\s*\)/FROM_UNIXTIME2(to_timestamp($1), $2)/igs; 2627 $str =~ s/\bFROM_UNIXTIME2\(\s*(.*?)\s*,\s*('[^'\(\)]+'|\?TEXTVALUE\d+\?)\s*\)/_mysql_dateformat_to_pgsql($class, $1, $2)/eigs; 2628 $str =~ s/\bGET_FORMAT\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/_mysql_getformat_to_pgsql($1, $2)/eigs; 2629 $str =~ s/\bHOUR\(\s*([^\(\)]+)\s*\)/extract(hour from ($1)::interval)::integer/igs; 2630 $str =~ s/\bLAST_DAY\(\s*([^\(\)]+)\s*\)/((date_trunc('month',($1)::timestamp + interval '1 month'))::date - 1)/igs; 2631 $str =~ s/\bMAKEDATE\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/(date($1||'-01-01') + ($2 - 1) * interval '1 day')::date/igs; 2632 $str =~ s/\bMAKETIME\(\s*([^,]+)\s*,\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/($1 * interval '1 hour' + $2 * interval '1 min' + $3 * interval '1 sec')/igs; 2633 $str =~ s/\bMICROSECOND\(\s*([^\(\)]+)\s*\)/extract(microsecond from ($1)::time)::integer/igs; 2634 $str =~ s/\bMINUTE\(\s*([^\(\)]+)\s*\)/extract(minute from ($1)::time)::integer/igs; 2635 $str =~ s/\bMONTH\(\s*([^\(\)]+)\s*\)/extract(month from date($1))::integer/igs; 2636 $str =~ s/\bMONTHNAME\(\s*([^\(\)]+)\s*\)/to_char(($1)::date, 'FMMonth')/igs; 2637 $str =~ s/\bQUARTER\(\s*([^\(\)]+)\s*\)/extract(quarter from date($1))::integer/igs; 2638 $str =~ s/\bSECOND\(\s*([^\(\)]+)\s*\)/extract(second from ($1)::interval)::integer/igs; 2639 $str =~ s/\bSEC_TO_TIME\(\s*([^\(\)]+)\s*\)/($1 * interval '1 second')/igs; 2640 $str =~ s/\bSTR_TO_DATE\(\s*(.*?)\s*,\s*('[^'\(\),]+'|\?TEXTVALUE\d+\?)\s*\)/_mysql_strtodate_to_pgsql($class, $1, $2)/eigs; 2641 $str =~ s/\b(SUBDATE|DATE_SUB)\(\s*([^,]+)\s*,\s*INTERVAL ([^\(\)]+)\s*\)/($2)::timestamp - interval '$3'/igs; 2642 $str =~ s/\bSUBDATE\(\s*([^,]+)\s*,\s*(\d+)\s*\)/($1)::timestamp - ($2 * interval '1 day')/igs; 2643 $str =~ s/\bSUBTIME\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/($1)::timestamp - ($2)::interval/igs; 2644 $str =~ s/\bTIME(\([^\(\)]+\))/($1)::time/igs; 2645 $str =~ s/\bTIMEDIFF\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/($1)::timestamp - ($2)::timestamp/igs; 2646 $str =~ s/\bTIMESTAMP\(\s*([^\(\)]+)\s*\)/($1)::timestamp/igs; 2647 $str =~ s/\bTIMESTAMP\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/($1)::timestamp + ($2)::time/igs; 2648 $str =~ s/\bTIMESTAMPADD\(\s*([^,]+)\s*,\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/($3)::timestamp + ($1 * interval '1 $2')/igs; 2649 $str =~ s/\bTIMESTAMPDIFF\(\s*YEAR\s*,\s*([^,]+)\s*,\s*([^\(\),]+)\s*\)/extract(year from ($2)::timestamp) - extract(year from ($1)::timestamp)/igs; 2650 $str =~ s/\bTIMESTAMPDIFF\(\s*MONTH\s*,\s*([^,]+)\s*,\s*([^\(\),]+)\s*\)/(extract(year from ($2)::timestamp) - extract(year from ($1)::timestamp))*12 + (extract(month from ($2)::timestamp) - extract(month from ($1)::timestamp))/igs; 2651 $str =~ s/\bTIMESTAMPDIFF\(\s*WEEK\s*,\s*([^,]+)\s*,\s*([^\(\),]+)\s*\)/floor(extract(day from ( ($2)::timestamp - ($1)::timestamp))\/7)/igs; 2652 $str =~ s/\bTIMESTAMPDIFF\(\s*DAY\s*,\s*([^,]+)\s*,\s*([^\(\),]+)\s*\)/extract(day from ( ($2)::timestamp - ($1)::timestamp))/igs; 2653 $str =~ s/\bTIMESTAMPDIFF\(\s*HOUR\s*,\s*([^,]+)\s*,\s*([^\(\),]+)\s*\)/floor(extract(epoch from ( ($2)::timestamp - ($1)::timestamp))\/3600)/igs; 2654 $str =~ s/\bTIMESTAMPDIFF\(\s*MINUTE\s*,\s*([^,]+)\s*,\s*([^\(\),]+)\s*\)/floor(extract(epoch from ( ($2)::timestamp - ($1)::timestamp))\/60)/igs; 2655 $str =~ s/\bTIMESTAMPDIFF\(\s*SECOND\s*,\s*([^,]+)\s*,\s*([^\(\),]+)\s*\)/extract(epoch from ($2)::timestamp) - extract(epoch from ($1)::timestamp))/igs; 2656 $str =~ s/\bTIME_FORMAT\(\s*(.*?)\s*,\s*('[^'\(\),]+'|\?TEXTVALUE\d+\?)\s*\)/_mysql_timeformat_to_pgsql($class, $1, $2)/eigs; 2657 $str =~ s/\bTIME_TO_SEC\(\s*([^\(\)]+)\s*\)/(extract(hours from ($1)::time)*3600 + extract(minutes from ($1)::time)*60 + extract(seconds from ($1)::time))::bigint/igs; 2658 $str =~ s/\bTO_DAYS\(\s*([^\(\)]+)\s*\)/(($1)::date - '0001-01-01bc')::integer/igs; 2659 $str =~ s/\bWEEK(\([^\(\)]+\))/extract(week from date($1)) - 1/igs; 2660 $str =~ s/\bWEEKOFYEAR(\([^\(\)]+\))/extract(week from date($2))/igs; 2661 $str =~ s/\bWEEKDAY\(\s*([^\(\)]+)\s*\)/to_char(($1)::timestamp, 'ID')::integer - 1/igs; # MySQL: Monday = 0, PG => 1 2662 $str =~ s/\bYEAR\(\s*([^\(\)]+)\s*\)/extract(year from date($1))/igs; 2663 2664 # String functions 2665 $str =~ s/\bBIN\(\s*([^\(\)]+)\s*\)/ltrim(textin(bit_out($1::bit(64))), '0')/igs; 2666 $str =~ s/\bBINARY\(\s*([^\(\)]+)\s*\)/($1)::bytea/igs; 2667 $str =~ s/\bBIT_COUNT\(\s*([^\(\)]+)\s*\)/length(replace(ltrim(textin(bit_out($1::bit(64))),'0'),'0',''))/igs; 2668 $str =~ s/\bCHAR\(\s*([^\(\),]+)\s*\)/array_to_string(ARRAY(SELECT chr(unnest($1))),'')/igs; 2669 $str =~ s/\bELT\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/(ARRAY[$2])[$1]/igs; 2670 $str =~ s/\bFIELD\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/(SELECT i FROM generate_subscripts(array[$2], 1) g(i) WHERE $1 = (array[$2])[i] UNION ALL SELECT 0 LIMIT 1)/igs; 2671 $str =~ s/\bFIND_IN_SET\(\s*([^,]+)\s*,\s*([^\(\)]+)\s*\)/(SELECT i FROM generate_subscripts(string_to_array($2,','), 1) g(i) WHERE $1 = (string_to_array($2,','))[i] UNION ALL SELECT 0 LIMIT 1)/igs; 2672 $str =~ s/\bFROM_BASE64\(\s*([^\(\),]+)\s*\)/decode(($1)::bytea, 'base64')/igs; 2673 $str =~ s/\bHEX\(\s*([^\(\),]+)\s*\)/upper(encode($1::bytea, 'hex'))/igs; 2674 $str =~ s/\bINSTR\s*\(\s*([^,]+),\s*('[^']+')\s*\)/position($2 in $1)/igs; 2675 if (!$class->{pg_supports_substr}) { 2676 $str =~ s/\bLOCATE\(\s*([^\(\),]+)\s*,\s*([^\(\),]+)\s*,\s*([^\(\),]+)\s*\)/position($1 in substring ($2 from $3)) + $3 - 1/igs; 2677 $str =~ s/\bMID\(/substring\(/igs; 2678 } else { 2679 $str =~ s/\bLOCATE\(\s*([^\(\),]+)\s*,\s*([^\(\),]+)\s*,\s*([^\(\),]+)\s*\)/position($1 in substr($2, $3)) + $3 - 1/igs; 2680 $str =~ s/\bMID\(/substr\(/igs; 2681 } 2682 $str =~ s/\bLOCATE\(\s*([^\(\),]+)\s*,\s*([^\(\),]+)\s*\)/position($1 in $2)/igs; 2683 $str =~ s/\bLCASE\(/lower\(/igs; 2684 $str =~ s/\bORD\(/ascii\(/igs; 2685 $str =~ s/\bQUOTE\(/quote_literal\(/igs; 2686 $str =~ s/\bSPACE\(\s*([^\(\),]+)\s*\)/repeat(' ', $1)/igs; 2687 $str =~ s/\bSTRCMP\(\s*([^\(\),]+)\s*,\s*([^\(\),]+)\s*\)/CASE WHEN $1 < $2 THEN -1 WHEN $1 > $2 THEN 1 ELSE 0 END/igs; 2688 $str =~ s/\bTO_BASE64\(\s*([^\(\),]+)\s*\)/encode($1, 'base64')/igs; 2689 $str =~ s/\bUCASE\(/upper\(/igs; 2690 $str =~ s/\bUNHEX\(\s*([^\(\),]+)\s*\)/decode($1, 'hex')::text/igs; 2691 $str =~ s/\bIS_IPV6\(\s*([^\(\)]+)\s*\)/CASE WHEN family($1) = 6 THEN 1 ELSE 0 END/igs; 2692 $str =~ s/\bIS_IPV4\(\s*([^\(\)]+)\s*\)/CASE WHEN family($1) = 4 THEN 1 ELSE 0 END/igs; 2693 $str =~ s/\bISNULL\(\s*([^\(\)]+)\s*\)/$1 IS NULL/igs; 2694 $str =~ s/\bRLIKE/REGEXP/igs; 2695 $str =~ s/\bSTD\(/STDDEV_POP\(/igs; 2696 $str =~ s/\bSTDDEV\(/STDDEV_POP\(/igs; 2697 $str =~ s/\bUUID\(/$class->{uuid_function}\(/igs; 2698 $str =~ s/\bNOT REGEXP BINARY/\!\~/igs; 2699 $str =~ s/\bREGEXP BINARY/\~/igs; 2700 $str =~ s/\bNOT REGEXP/\!\~\*/igs; 2701 $str =~ s/\bREGEXP/\~\*/igs; 2702 2703 $str =~ s/\bGET_LOCK/pg_advisory_lock/igs; 2704 $str =~ s/\bIS_USED_LOCK/pg_try_advisory_lock/igs; 2705 $str =~ s/\bRELEASE_LOCK/pg_advisory_unlock/igs; 2706 2707 # GROUP_CONCAT doesn't exist, it must be replaced by calls to array_to_string() and array_agg() functions 2708 $str =~ s/GROUP_CONCAT\((.*?)\s+ORDER\s+BY\s+([^\s]+)\s+(ASC|DESC)\s+SEPARATOR\s+(\?TEXTVALUE\d+\?|'[^']+')\s*\)/array_to_string(array_agg($1 ORDER BY $2 $3), $4)/igs; 2709 $str =~ s/GROUP_CONCAT\((.*?)\s+ORDER\s+BY\s+([^\s]+)\s+SEPARATOR\s+(\?TEXTVALUE\d+\?|'[^']+')\s*\)/array_to_string(array_agg($1 ORDER BY $2 ASC), $3)/igs; 2710 $str =~ s/GROUP_CONCAT\((.*?)\s+SEPARATOR\s+(\?TEXTVALUE\d+\?|'[^']+')\s*\)/array_to_string(array_agg($1), $2)/igs; 2711 $str =~ s/GROUP_CONCAT\((.*?)\s+ORDER\s+BY\s+([^\s]+)\s+(ASC|DESC)\s*\)/array_to_string(array_agg($1 ORDER BY $2 $3), ',')/igs; 2712 $str =~ s/GROUP_CONCAT\((.*?)\s+ORDER\s+BY\s+([^\s]+)\s*\)/array_to_string(array_agg($1 ORDER BY $2), ',')/igs; 2713 $str =~ s/GROUP_CONCAT\(([^\)]+)\)/array_to_string(array_agg($1), ',')/igs; 2714 2715 # Replace IFNULL() MySQL function in a query 2716 while ($str =~ s/\bIFNULL\(\s*([^,]+)\s*,\s*([^\)]+\s*)\)/COALESCE($1, $2)/is) {}; 2717 2718 # Rewrite while loop 2719 $str =~ s/\bWHILE\b(.*?)\bEND\s+WHILE\s*;/WHILE $1END LOOP;/igs; 2720 $str =~ s/\bWHILE\b(.*?)\bDO\b/WHILE $1LOOP/igs; 2721 2722 # Rewrite REPEAT loop 2723 my %repl_repeat = (); 2724 $i = 0; 2725 while ($str =~ s/\bREPEAT\s+(.*?)\bEND REPEAT\s*;/%REPREPEATLBL$i%/igs) { 2726 my $code = $1; 2727 $code =~ s/\bUNTIL(.*)//; 2728 $repl_repeat{$i} = "LOOP ${code}EXIT WHEN $1;\nEND LOOP;"; 2729 } 2730 foreach $i (keys %repl_repeat) { 2731 $str =~ s/\%REPREPEATLBL$i\%/$repl_repeat{$i}/gs; 2732 } 2733 %repl_repeat = (); 2734 2735 # Fix some charset encoding call in cast function 2736 #$str =~ s/(CAST\s*\((?:.*?)\s+AS\s+(?:[^\s]+)\s+)CHARSET\s+([^\s\)]+)\)/$1) COLLATE "\U$2\E"/igs; 2737 $str =~ s/(CAST\s*\((?:.*?)\s+AS\s+(?:[^\s]+)\s+)(CHARSET|CHARACTER\s+SET)\s+([^\s\)]+)\)/$1)/igs; 2738 $str =~ s/CONVERT\s*(\((?:[^,]+)\s+,\s+(?:[^\s]+)\s+)(CHARSET|CHARACTER\s+SET)\s+([^\s\)]+)\)/CAST$1)/igs; 2739 $str =~ s/CONVERT\s*\((.*?)\s+USING\s+([^\s\)]+)\)/CAST($1 AS text)/igs; 2740 # Set default UTF8 collation to postgreSQL equivalent C.UTF-8 2741 #$str =~ s/COLLATE "UTF8"/COLLATE "C.UTF-8"/gs; 2742 $str =~ s/\bCHARSET(\s+)/COLLATE$1/igs; 2743 2744 # Remove call to start transaction 2745 $str =~ s/\sSTART\s+TRANSACTION\s*;/-- START TRANSACTION;/igs; 2746 2747 # Comment call to COMMIT or ROLLBACK in the code if allowed 2748 if ($class->{comment_commit_rollback}) { 2749 $str =~ s/\b(COMMIT|ROLLBACK)\s*;/-- $1;/igs; 2750 $str =~ s/(ROLLBACK\s+TO\s+[^;]+);/-- $1;/igs; 2751 } 2752 2753 # Translate call to CREATE TABLE ... SELECT 2754 $str =~ s/CREATE\s+PRIVATE\s+TEMPORARY/CREATE TEMPORARY/; 2755 $str =~ s/(CREATE(?:\s+TEMPORARY)?\s+TABLE\s+[^\s]+)(\s+SELECT)/$1 AS $2/igs; 2756 $str =~ s/ON\s+COMMIT\s+PRESERVE\s+DEFINITION/ON COMMIT PRESERVE ROWS/igs; 2757 $str =~ s/ON\s+COMMIT\s+DROP\s+DEFINITION/ON COMMIT DROP/igs; 2758 2759 # Remove @ from variables and rewrite SET assignement in QUERY mode 2760 if ($class->{type} eq 'QUERY') { 2761 $str =~ s/\@([^\s]+)\b/$1/gs; 2762 $str =~ s/:=/=/gs; 2763 } 2764 2765 # Replace spatial related lines 2766 $str = replace_mysql_spatial($str); 2767 2768 # Rewrite direct call to function without out parameters using PERFORM 2769 $str = perform_replacement($class, $str); 2770 2771 # Remove CALL from all statements if not supported 2772 if (!$class->{pg_supports_procedure}) { 2773 $str =~ s/\bCALL\s+//igs; 2774 } 2775 2776 return $str; 2777} 2778 2779sub _replace_dateadd 2780{ 2781 my $str = shift; 2782 my $dd = shift; 2783 2784 my $op = '+'; 2785 if ($str =~ s/^\-[\s]*//) { 2786 $op = '-'; 2787 } 2788 if ($str =~ s/^(\d+)\s+([^\(\),\s]+)$/ $op $1*interval '1 $2'/s) { 2789 return $str; 2790 } elsif ($str =~ s/^([^\s]+)\s+([^\(\),\s]+)$/ $op $1*interval '1 $2'/s) { 2791 return $str; 2792 } elsif ($str =~ s/^([^\(\),]+)$/ $op interval '$1'/s) { 2793 return $str; 2794 } 2795 2796 return $str; 2797} 2798 2799 2800sub replace_mysql_spatial 2801{ 2802 my $str = shift; 2803 2804 $str =~ s/AsWKB\(/AsBinary\(/igs; 2805 $str =~ s/AsWKT\(/AsText\(/igs; 2806 $str =~ s/GeometryCollectionFromText\(/GeomCollFromText\(/igs; 2807 $str =~ s/GeometryCollectionFromWKB\(/GeomCollFromWKB\(/igs; 2808 $str =~ s/GeometryFromText\(/GeomFromText\(/igs; 2809 $str =~ s/GLength\(/ST_Length\(/igs; 2810 $str =~ s/LineStringFromWKB\(/LineFromWKB\(/igs; 2811 $str =~ s/MultiLineStringFromText\(/MLineFromText\(/igs; 2812 $str =~ s/MultiPointFromText\(/MPointFromText\(/igs; 2813 $str =~ s/MultiPolygonFromText\(/MPolyFromText\(/igs; 2814 $str =~ s/PolyFromText\(/PolygonFromText\(/igs; 2815 $str =~ s/MBRContains\(/ST_Contains\(/igs; 2816 $str =~ s/MBRDisjoint\(/ST_Disjoint\(/igs; 2817 $str =~ s/MBREqual\(/ST_Equals\(/igs; 2818 $str =~ s/MBRIntersects\(/ST_Intersects\(/igs; 2819 $str =~ s/MBROverlaps\(/ST_Overlaps\(/igs; 2820 $str =~ s/MBRTouches\(/ST_Touches\(/igs; 2821 $str =~ s/MBRWithin\(/ST_Within\(/igs; 2822 $str =~ s/MLineFromWKB\(/MultiLineStringFromWKB\(/igs; 2823 $str =~ s/MPointFromWKB\(/MultiPointFromWKB\(/igs; 2824 $str =~ s/MPolyFromWKB\(/MultiPolygonFromWKB\(/igs; 2825 $str =~ s/PolyFromWKB\(/PolygonFromWKB\(/igs; 2826 2827 # Replace FromWKB functions 2828 foreach my $fct ('MultiLineStringFromWKB', 'MultiPointFromWKB', 'MultiPolygonFromWKB', 'PolygonFromWKB') { 2829 $str =~ s/\b$fct\(/ST_GeomFromWKB\(/igs; 2830 } 2831 2832 # Add ST_ prefix to function alias 2833 foreach my $fct (@MYSQL_SPATIAL_FCT) { 2834 $str =~ s/\b$fct\(/ST_$fct\(/igs; 2835 } 2836 2837 return $str; 2838} 2839 2840sub _mysql_getformat_to_pgsql 2841{ 2842 my ($type, $format) = @_; 2843 2844 if (uc($type) eq 'DATE') { 2845 if (uc($format) eq "'USA'") { 2846 $format = "'%m.%d.%Y'"; 2847 } elsif (uc($format) eq "'EUR'") { 2848 $format = "'%d.%m.%Y'"; 2849 } elsif (uc($format) eq "'INTERNAL'") { 2850 $format = "'%Y%m%d'"; 2851 } else { 2852 # ISO and JIS 2853 $format = "'%Y-%m-%d'"; 2854 } 2855 } elsif (uc($type) eq 'TIME') { 2856 if (uc($format) eq "'USA'") { 2857 $format = "'%h:%i:%s %p'"; 2858 } elsif (uc($format) eq "'EUR'") { 2859 $format = "'%H.%i.%s'"; 2860 } elsif (uc($format) eq "'INTERNAL'") { 2861 $format = "'%H%i%s'"; 2862 } else { 2863 # ISO and JIS 2864 $format = "'%H:%i:%s'"; 2865 } 2866 } else { 2867 if ( (uc($format) eq "'USA'") || (uc($format) eq "'EUR'") ) { 2868 $format = "'%Y-%m-%d %H.%i.%s'"; 2869 } elsif (uc($format) eq "'INTERNAL'") { 2870 $format = "'%Y%m%d%H%i%s'"; 2871 } else { 2872 # ISO and JIS 2873 $format = "'%Y-%m-%d %H:%i:%s'"; 2874 } 2875 } 2876 2877 return $format; 2878} 2879 2880sub _mysql_strtodate_to_pgsql 2881{ 2882 my ($class, $datetime, $format) = @_; 2883 2884 my $str = _mysql_dateformat_to_pgsql($class, $datetime, $format, 1); 2885 2886 return $str; 2887} 2888 2889sub _mysql_timeformat_to_pgsql 2890{ 2891 my ($class, $datetime, $format) = @_; 2892 2893 my $str = _mysql_dateformat_to_pgsql($class, $datetime, $format, 0, 1); 2894 2895 return $str; 2896} 2897 2898 2899sub _mysql_dateformat_to_pgsql 2900{ 2901 my ($class, $datetime, $format, $todate, $totime) = @_; 2902 2903# Not supported: 2904# %X Year for the week where Sunday is the first day of the week, numeric, four digits; used with %V 2905 2906 if ($format =~ s/\?TEXTVALUE(\d+)\?/$class->{text_values}{$1}/) { 2907 delete $class->{text_values}{$1}; 2908 } 2909 2910 $format =~ s/\%a/Dy/g; 2911 $format =~ s/\%b/Mon/g; 2912 $format =~ s/\%c/FMMM/g; 2913 $format =~ s/\%D/FMDDth/g; 2914 $format =~ s/\%e/FMDD/g; 2915 $format =~ s/\%f/US/g; 2916 $format =~ s/\%H/HH24/g; 2917 $format =~ s/\%h/HH12/g; 2918 $format =~ s/\%I/HH/g; 2919 $format =~ s/\%i/MI/g; 2920 $format =~ s/\%j/DDD/g; 2921 $format =~ s/\%k/FMHH24/g; 2922 $format =~ s/\%l/FMHH12/g; 2923 $format =~ s/\%m/MM/g; 2924 $format =~ s/\%p/AM/g; 2925 $format =~ s/\%r/HH12:MI:SS AM/g; 2926 $format =~ s/\%s/SS/g; 2927 $format =~ s/\%S/SS/g; 2928 $format =~ s/\%T/HH24:MI:SS/g; 2929 $format =~ s/\%U/WW/g; 2930 $format =~ s/\%u/IW/g; 2931 $format =~ s/\%V/WW/g; 2932 $format =~ s/\%v/IW/g; 2933 $format =~ s/\%x/YYYY/g; 2934 $format =~ s/\%X/YYYY/g; 2935 $format =~ s/\%Y/YYYY/g; 2936 $format =~ s/\%y/YY/g; 2937 $format =~ s/\%W/Day/g; 2938 $format =~ s/\%M/Month/g; 2939 $format =~ s/\%(\d+)/$1/g; 2940 2941 # Replace constant strings 2942 if ($format =~ s/('[^']+')/\?TEXTVALUE$class->{text_values_pos}\?/s) { 2943 $class->{text_values}{$class->{text_values_pos}} = $1; 2944 $class->{text_values_pos}++; 2945 } 2946 2947 if ($todate) { 2948 return "to_date($datetime, $format)"; 2949 } elsif ($totime) { 2950 return "to_char(($datetime)::time, $format)"; 2951 } 2952 2953 return "to_char(($datetime)::timestamp, $format)"; 2954} 2955 2956sub mysql_estimate_cost 2957{ 2958 my $str = shift; 2959 my $type = shift; 2960 2961 my %cost_details = (); 2962 2963 # Default cost is testing that mean it at least must be tested 2964 my $cost = $FCT_TEST_SCORE; 2965 # When evaluating queries tests must not be included here 2966 if ($type eq 'QUERY') { 2967 $cost = 0; 2968 } 2969 $cost_details{'TEST'} = $cost; 2970 2971 # Set cost following code length 2972 my $cost_size = int(length($str)/$SIZE_SCORE) || 1; 2973 # When evaluating queries size must not be included here 2974 if ($type eq 'QUERY') { 2975 $cost_size = 0; 2976 } 2977 2978 $cost += $cost_size; 2979 $cost_details{'SIZE'} = $cost_size; 2980 2981 # Try to figure out the manual work 2982 my $n = () = $str =~ m/(ARRAY_AGG|GROUP_CONCAT)\(\s*DISTINCT/igs; 2983 $cost_details{'ARRAY_AGG_DISTINCT'} += $n; 2984 $n = () = $str =~ m/\bSOUNDS\s+LIKE\b/igs; 2985 $cost_details{'SOUNDS LIKE'} += $n; 2986 $n = () = $str =~ m/CHARACTER\s+SET/igs; 2987 $cost_details{'CHARACTER SET'} += $n; 2988 $n = () = $str =~ m/\bCOUNT\(\s*DISTINCT\b/igs; 2989 $cost_details{'COUNT(DISTINCT)'} += $n; 2990 $n = () = $str =~ m/\bMATCH.*AGAINST\b/igs; 2991 $cost_details{'MATCH'} += $n; 2992 $n = () = $str =~ m/\bJSON_[A-Z\_]+\(/igs; 2993 $cost_details{'JSON FUNCTION'} += $n; 2994 $n = () = $str =~ m/_(un)?lock\(/igs; 2995 $cost_details{'LOCK'} += $n; 2996 $n = () = $str =~ m/\b\@+[A-Z0-9\_]+/igs; 2997 $cost_details{'@VAR'} += $n; 2998 2999 foreach my $t (keys %UNCOVERED_MYSQL_SCORE) { 3000 $cost += $UNCOVERED_MYSQL_SCORE{$t}*$cost_details{$t}; 3001 } 3002 foreach my $f (@MYSQL_FUNCTIONS) { 3003 if ($str =~ /\b$f\b/igs) { 3004 $cost += 2; 3005 $cost_details{$f} += 2; 3006 } 3007 } 3008 3009 return $cost, %cost_details; 3010} 3011 3012sub replace_outer_join 3013{ 3014 my ($class, $str, $type) = @_; 3015 3016 if (!grep(/^$type$/, 'left', 'right')) { 3017 die "FATAL: outer join type must be 'left' or 'right' in call to replace_outer_join().\n"; 3018 } 3019 3020 # When we have a right outer join, just rewrite it as a left join to simplify the translation work 3021 if ($type eq 'right') { 3022 $str =~ s/(\s+)([^\s]+)\s*(\%OUTERJOIN\d+\%)\s*(!=|<>|>=|<=|=|>|<|NOT LIKE|LIKE)\s*([^\s]+)/$1$5 $4 $2$3/isg; 3023 return $str; 3024 } 3025 3026 my $regexp1 = qr/((?:!=|<>|>=|<=|=|>|<|NOT LIKE|LIKE)\s*[^\s]+\s*\%OUTERJOIN\d+\%)/is; 3027 my $regexp2 = qr/\%OUTERJOIN\d+\%\s*(?:!=|<>|>=|<=|=|>|<|NOT LIKE|LIKE)/is; 3028 3029 # process simple form of outer join 3030 my $nbouter = $str =~ $regexp1; 3031 3032 # Check that we don't have right outer join too 3033 if ($nbouter >= 1 && $str !~ $regexp2) 3034 { 3035 # Extract tables in the FROM clause 3036 $str =~ s/(.*)\bFROM\s+(.*?)\s+WHERE\s+(.*?)$/$1FROM FROM_CLAUSE WHERE $3/is; 3037 my $from_clause = $2; 3038 $from_clause =~ s/"//gs; 3039 my @tables = split(/\s*,\s*/, $from_clause); 3040 3041 # Set a hash for alias to table mapping 3042 my %from_clause_list = (); 3043 my %from_order = (); 3044 my $fidx = 0; 3045 foreach my $table (@tables) 3046 { 3047 $table =~ s/^\s+//s; 3048 $table =~ s/\s+$//s; 3049 my $cmt = ''; 3050 while ($table =~ s/(\s*\%ORA2PG_COMMENT\d+\%\s*)//is) { 3051 $cmt .= $1; 3052 } 3053 my ($t, $alias, @others) = split(/\s+/, lc($table)); 3054 $alias = $others[0] if (uc($alias) eq 'AS'); 3055 $alias = "$t" if (!$alias); 3056 $from_clause_list{$alias} = "$cmt$t"; 3057 $from_order{$alias} = $fidx++; 3058 } 3059 3060 # Extract all Oracle's outer join syntax from the where clause 3061 my @outer_clauses = (); 3062 my %final_outer_clauses = (); 3063 my %final_from_clause = (); 3064 my @tmp_from_list = (); 3065 my $start_query = ''; 3066 my $end_query = ''; 3067 if ($str =~ s/^(.*FROM FROM_CLAUSE WHERE)//is) { 3068 $start_query = $1; 3069 } 3070 if ($str =~ s/\s+((?:START WITH|CONNECT BY|ORDER SIBLINGS BY|GROUP BY|ORDER BY).*)$//is) { 3071 $end_query = $1; 3072 } 3073 3074 # Extract predicat from the WHERE clause 3075 my @predicat = split(/\s*(\bAND\b|\bOR\b|\%ORA2PG_COMMENT\d+\%)\s*/i, $str); 3076 my $id = 0; 3077 my %other_join_clause = (); 3078 # Process only predicat with a obsolete join syntax (+) for now 3079 for (my $i = 0; $i <= $#predicat; $i++) 3080 { 3081 next if ($predicat[$i] !~ /\%OUTERJOIN\d+\%/i); 3082 my $where_clause = $predicat[$i]; 3083 $where_clause =~ s/"//gs; 3084 $where_clause =~ s/^\s+//s; 3085 $where_clause =~ s/[\s;]+$//s; 3086 $where_clause =~ s/\s*(\%OUTERJOIN\d+\%)//gs; 3087 3088 $predicat[$i] = "WHERE_CLAUSE$id "; 3089 3090 # Split the predicat to retrieve left part, operator and right part 3091 my ($l, $o, $r) = split(/\s*(!=|>=|<=|=|<>|<|>|NOT LIKE|LIKE)\s*/i, $where_clause); 3092 3093 # NEW / OLD pseudo table in triggers can not be part of a join 3094 # clause. Move them int to the WHERE clause. 3095 if ($l =~ /^(NEW|OLD)\./is) 3096 { 3097 $predicat[$i] =~ s/WHERE_CLAUSE$id / $l $o $r /s; 3098 next; 3099 } 3100 $id++; 3101 3102 # Extract the tablename part of the left clause 3103 my $lbl1 = ''; 3104 my $table_decl1 = $l; 3105 if ($l =~ /^([^\.\s]+\.[^\.\s]+)\..*/ || $l =~ /^([^\.\s]+)\..*/) 3106 { 3107 $lbl1 = lc($1); 3108 # If the table/alias is not part of the from clause 3109 if (!exists $from_clause_list{$lbl1}) { 3110 $from_clause_list{$lbl1} = $lbl1; 3111 $from_order{$lbl1} = $fidx++; 3112 } 3113 $table_decl1 = $from_clause_list{$lbl1}; 3114 $table_decl1 .= " $lbl1" if ($lbl1 ne $from_clause_list{$lbl1}); 3115 } 3116 elsif ($l =~ /\%SUBQUERY(\d+)\%/) 3117 { 3118 # Search for table.column in the subquery or function code 3119 my $tmp_str = $l; 3120 while ($tmp_str =~ s/\%SUBQUERY(\d+)\%/$class->{sub_parts}{$1}/is) 3121 { 3122 if ($tmp_str =~ /\b([^\.\s]+\.[^\.\s]+)\.[^\.\s]+/ 3123 || $tmp_str =~ /\b([^\.\s]+)\.[^\.\s]+/) 3124 { 3125 $lbl1 = lc($1); 3126 # If the table/alias is not part of the from clause 3127 if (!exists $from_clause_list{$lbl1}) 3128 { 3129 $from_clause_list{$lbl1} = $lbl1; 3130 $from_order{$lbl1} = $fidx++; 3131 } 3132 $table_decl1 = $from_clause_list{$lbl1}; 3133 $table_decl1 .= " $lbl1" if ($lbl1 ne $from_clause_list{$lbl1}); 3134 last; 3135 } 3136 } 3137 } 3138 3139 # Extract the tablename part of the right clause 3140 my $lbl2 = ''; 3141 my $table_decl2 = $r; 3142 if ($r =~ /^([^\.\s]+\.[^\.\s]+)\..*/ || $r =~ /^([^\.\s]+)\..*/) 3143 { 3144 $lbl2 = lc($1); 3145 if (!$lbl1) { 3146 push(@{$other_join_clause{$lbl2}}, "$l $o $r"); 3147 next; 3148 } 3149 # If the table/alias is not part of the from clause 3150 if (!exists $from_clause_list{$lbl2}) { 3151 $from_clause_list{$lbl2} = $lbl2; 3152 $from_order{$lbl2} = $fidx++; 3153 } 3154 $table_decl2 = $from_clause_list{$lbl2}; 3155 $table_decl2 .= " $lbl2" if ($lbl2 ne $from_clause_list{$lbl2}); 3156 } 3157 elsif ($lbl1) 3158 { 3159 # Search for table.column in the subquery or function code 3160 my $tmp_str = $r; 3161 while ($tmp_str =~ s/\%SUBQUERY(\d+)\%/$class->{sub_parts}{$1}/is) 3162 { 3163 if ($tmp_str =~ /\b([^\.\s]+\.[^\.\s]+)\.[^\.\s]+/ 3164 || $tmp_str =~ /\b([^\.\s]+)\.[^\.\s]+/) 3165 { 3166 $lbl2 = lc($1); 3167 # If the table/alias is not part of the from clause 3168 if (!exists $from_clause_list{$lbl2}) 3169 { 3170 $from_clause_list{$lbl2} = $lbl2; 3171 $from_order{$lbl2} = $fidx++; 3172 } 3173 $table_decl2 = $from_clause_list{$lbl2}; 3174 $table_decl2 .= " $lbl2" if ($lbl2 ne $from_clause_list{$lbl2}); 3175 } 3176 } 3177 if (!$lbl2 ) 3178 { 3179 push(@{$other_join_clause{$lbl1}}, "$l $o $r"); 3180 next; 3181 } 3182 } 3183 3184 # When this is the first join parse add the left tablename 3185 # first then the outer join with the right table 3186 if (scalar keys %final_from_clause == 0) 3187 { 3188 $from_clause = $table_decl1; 3189 $table_decl1 =~ s/\s*\%ORA2PG_COMMENT\d+\%\s*//igs; 3190 push(@outer_clauses, (split(/\s/, $table_decl1))[1] || $table_decl1); 3191 $final_from_clause{"$lbl1;$lbl2"}{position} = $i; 3192 push(@{$final_from_clause{"$lbl1;$lbl2"}{clause}{$table_decl2}{predicat}}, "$l $o $r"); 3193 } 3194 else 3195 { 3196 $final_from_clause{"$lbl1;$lbl2"}{position} = $i; 3197 push(@{$final_from_clause{"$lbl1;$lbl2"}{clause}{$table_decl2}{predicat}}, "$l $o $r"); 3198 if (!exists $final_from_clause{"$lbl1;$lbl2"}{clause}{$table_decl2}{$type}) { 3199 $final_from_clause{"$lbl1;$lbl2"}{clause}{$table_decl2}{$type} = $table_decl1; 3200 } 3201 } 3202 if ($type eq 'left') { 3203 $final_from_clause{"$lbl1;$lbl2"}{clause}{$table_decl2}{position} = $i; 3204 } else { 3205 $final_from_clause{"$lbl1;$lbl2"}{clause}{$table_decl1}{position} = $i; 3206 } 3207 } 3208 $str = $start_query . join(' ', @predicat) . ' ' . $end_query; 3209 3210 # Remove part from the WHERE clause that will be moved into the FROM clause 3211 $str =~ s/\s*(AND\s+)?WHERE_CLAUSE\d+ / /igs; 3212 $str =~ s/WHERE\s+(AND|OR)\s+/WHERE /is; 3213 $str =~ s/WHERE[\s;]+$//i; 3214 $str =~ s/(\s+)WHERE\s+(ORDER|GROUP)\s+BY/$1$2 BY/is; 3215 $str =~ s/\s+WHERE(\s+)/\nWHERE$1/igs; 3216 3217 my %associated_clause = (); 3218 foreach my $t (sort { $final_from_clause{$a}{position} <=> $final_from_clause{$b}{position} } keys %final_from_clause) 3219 { 3220 foreach my $j (sort { $final_from_clause{$t}{clause}{$a}{position} <=> $final_from_clause{$t}{clause}{$b}{position} } keys %{$final_from_clause{$t}{clause}}) 3221 { 3222 next if ($#{$final_from_clause{$t}{clause}{$j}{predicat}} < 0); 3223 3224 if (exists $final_from_clause{$t}{clause}{$j}{$type} && $j !~ /\%SUBQUERY\d+\%/i && $from_clause !~ /\b\Q$final_from_clause{$t}{clause}{$j}{$type}\E\b/) 3225 { 3226 $from_clause .= ",$final_from_clause{$t}{clause}{$j}{$type}"; 3227 push(@outer_clauses, (split(/\s/, $final_from_clause{$t}{clause}{$j}{$type}))[1] || $final_from_clause{$t}{clause}{$j}{$type}); 3228 } 3229 my ($l,$r) = split(/;/, $t); 3230 my $tbl = $j; 3231 $tbl =~ s/\s*\%ORA2PG_COMMENT\d+\%\s*//isg; 3232 $from_clause .= "\n\U$type\E OUTER JOIN $tbl ON (" . join(' AND ', @{$final_from_clause{$t}{clause}{$j}{predicat}}) . ")"; 3233 push(@{$final_outer_clauses{$l}{join}}, "\U$type\E OUTER JOIN $tbl ON (" . join(' AND ', @{$final_from_clause{$t}{clause}{$j}{predicat}}, @{$other_join_clause{$r}}) . ")"); 3234 push(@{$final_outer_clauses{$l}{position}}, $final_from_clause{$t}{clause}{$j}{position}); 3235 push(@{$associated_clause{$l}}, $r); 3236 } 3237 } 3238 3239 $from_clause = ''; 3240 my @clause_done = (); 3241 foreach my $c (sort { $from_order{$a} <=> $from_order{$b} } keys %from_order) 3242 { 3243 next if (!grep(/^\Q$c\E$/i, @outer_clauses)); 3244 my @output = (); 3245 for (my $j = 0; $j <= $#{$final_outer_clauses{$c}{join}}; $j++) { 3246 push(@output, $final_outer_clauses{$c}{join}[$j]); 3247 } 3248 3249 find_associated_clauses($c, \@output, \%associated_clause, \%final_outer_clauses); 3250 3251 if (!grep(/\QJOIN $from_clause_list{$c} $c \E/is, @clause_done)) 3252 { 3253 $from_clause .= "\n, $from_clause_list{$c}"; 3254 $from_clause .= " $c" if ($c ne $from_clause_list{$c}); 3255 } 3256 foreach (@output) { 3257 $from_clause .= "\n" . $_; 3258 } 3259 push(@clause_done, @output); 3260 delete $from_order{$c}; 3261 delete $final_outer_clauses{$c}; 3262 delete $associated_clause{$c}; 3263 } 3264 $from_clause =~ s/^\s*,\s*//s; 3265 3266 # Append tables to from clause that was not involved into an outer join 3267 foreach my $a (sort keys %from_clause_list) 3268 { 3269 my $table_decl = "$from_clause_list{$a}"; 3270 $table_decl .= " $a" if ($a ne $from_clause_list{$a}); 3271 # Remove comment before searching it inside the from clause 3272 my $tmp_tbl = $table_decl; 3273 my $comment = ''; 3274 while ($tmp_tbl =~ s/(\s*\%ORA2PG_COMMENT\d+\%\s*)//is) { 3275 $comment .= $1; 3276 } 3277 3278 if ($from_clause !~ /(^|\s|,)\Q$tmp_tbl\E\b/is) { 3279 $from_clause = "$table_decl, " . $from_clause; 3280 } elsif ($comment) { 3281 $from_clause = "$comment " . $from_clause; 3282 } 3283 } 3284 $from_clause =~ s/\b(new|old)\b/\U$1\E/gs; 3285 $from_clause =~ s/,\s*$/ /s; 3286 $str =~ s/FROM FROM_CLAUSE/FROM $from_clause/s; 3287 } 3288 3289 return $str; 3290} 3291 3292sub find_associated_clauses 3293{ 3294 my ($c, $output, $associated_clause, $final_outer_clauses) = @_; 3295 3296 foreach my $f (@{$associated_clause->{$c}}) { 3297 for (my $j = 0; $j <= $#{$final_outer_clauses->{$f}{join}}; $j++) { 3298 push(@$output, $final_outer_clauses->{$f}{join}[$j]); 3299 } 3300 delete $final_outer_clauses->{$f}; 3301 find_associated_clauses($f, $output, $associated_clause, $final_outer_clauses); 3302 } 3303 delete $associated_clause->{$c}; 3304} 3305 3306 3307sub replace_connect_by 3308{ 3309 my ($class, $str) = @_; 3310 3311 return $str if ($str !~ /\bCONNECT\s+BY\b/is); 3312 3313 my $final_query = "WITH RECURSIVE cte AS (\n"; 3314 3315 # Remove NOCYCLE, not supported at now 3316 $str =~ s/\s+NOCYCLE//is; 3317 3318 # Remove SIBLINGS keywords and enable siblings rewrite 3319 my $siblings = 0; 3320 if ($str =~ s/\s+SIBLINGS//is) { 3321 $siblings = 1; 3322 } 3323 3324 # Extract UNION part of the query to past it at end 3325 my $union = ''; 3326 if ($str =~ s/(CONNECT BY.*)(\s+UNION\s+.*)/$1/is) { 3327 $union = $2; 3328 } 3329 3330 # Extract order by to past it to the query at end 3331 my $order_by = ''; 3332 if ($str =~ s/\s+ORDER BY(.*)//is) { 3333 $order_by = $1; 3334 } 3335 3336 # Extract group by to past it to the query at end 3337 my $group_by = ''; 3338 if ($str =~ s/(\s+GROUP BY.*)//is) { 3339 $group_by = $1; 3340 } 3341 3342 # Extract the starting node or level of the tree 3343 my $where_clause = ''; 3344 my $start_with = ''; 3345 if ($str =~ s/WHERE\s+(.*?)\s+START\s+WITH\s*(.*?)\s+CONNECT BY\s*//is) { 3346 $where_clause = " WHERE $1"; 3347 $start_with = $2; 3348 } elsif ($str =~ s/WHERE\s+(.*?)\s+CONNECT BY\s+(.*?)\s+START\s+WITH\s*(.*)/$2/is) { 3349 $where_clause = " WHERE $1"; 3350 $start_with = $3; 3351 } elsif ($str =~ s/START\s+WITH\s*(.*?)\s+CONNECT BY\s*//is) { 3352 $start_with = $1; 3353 } elsif ($str =~ s/\s+CONNECT BY\s+(.*?)\s+START\s+WITH\s*(.*)/ $1 /is) { 3354 $start_with = $2; 3355 } else { 3356 $str =~ s/CONNECT BY\s*//is; 3357 } 3358 3359 # remove alias from where clause 3360 $where_clause =~ s/\b[^\.]\.([^\s]+)\b/$1/gs; 3361 3362 # Extract the CONNECT BY clause in the hierarchical query 3363 my $prior_str = ''; 3364 my @prior_clause = ''; 3365 if ($str =~ s/([^\s]+\s*=\s*PRIOR\s+.*)//is) { 3366 $prior_str = $1; 3367 } elsif ($str =~ s/(\s*PRIOR\s+.*)//is) { 3368 $prior_str = $1; 3369 } else { 3370 # look inside subqueries if we have a prior clause 3371 my @ids = $str =~ /\%SUBQUERY(\d+)\%/g; 3372 my $sub_prior_str = ''; 3373 foreach my $i (@ids) { 3374 if ($class->{sub_parts}{$i} =~ s/([^\s]+\s*=\s*PRIOR\s+.*)//is) { 3375 $sub_prior_str = $1; 3376 $str =~ s/\%SUBQUERY$i\%//; 3377 } elsif ($class->{sub_parts}{$i} =~ s/(\s*PRIOR\s+.*)//is) { 3378 $sub_prior_str = $1; 3379 $str =~ s/\%SUBQUERY$i\%//; 3380 } 3381 $sub_prior_str =~ s/^\(//; 3382 $sub_prior_str =~ s/\)$//; 3383 ($prior_str ne '' || $sub_prior_str eq '') ? $prior_str .= ' ' . $sub_prior_str : $prior_str = $sub_prior_str; 3384 } 3385 } 3386 if ($prior_str) { 3387 # Try to extract the prior clauses 3388 my @tmp_prior = split(/\s*AND\s*/, $prior_str); 3389 $tmp_prior[-1] =~ s/\s*;\s*//s; 3390 my @tmp_prior2 = (); 3391 foreach my $p (@tmp_prior) { 3392 if ($p =~ /\bPRIOR\b/is) { 3393 push(@prior_clause, split(/\s*=\s*/i, $p)); 3394 } else { 3395 $where_clause .= " AND $p"; 3396 } 3397 } 3398 if ($siblings) { 3399 if ($prior_clause[-1] !~ /PRIOR/i) { 3400 $siblings = $prior_clause[-1]; 3401 } else { 3402 $siblings = $prior_clause[-2]; 3403 } 3404 $siblings =~ s/\s+//g; 3405 } 3406 shift(@prior_clause) if ($prior_clause[0] eq ''); 3407 my @rebuild_prior = (); 3408 # Place PRIOR in the left part if necessary 3409 for (my $i = 0; $i < $#prior_clause; $i+=2) { 3410 if ($prior_clause[$i+1] =~ /PRIOR\s+/i) { 3411 my $tmp = $prior_clause[$i]; 3412 $prior_clause[$i] = $prior_clause[$i+1]; 3413 $prior_clause[$i+1] = $tmp; 3414 } 3415 push(@rebuild_prior, "$prior_clause[$i] = $prior_clause[$i+1]"); 3416 } 3417 @prior_clause = @rebuild_prior; 3418 # Remove table aliases from prior clause 3419 map { s/\s*PRIOR\s*//s; s/[^\s\.=<>!]+\.//s; } @prior_clause; 3420 } 3421 my $bkup_query = $str; 3422 # Construct the initialization query 3423 $str =~ s/(SELECT\s+)(.*?)(\s+FROM)/$1COLUMN_ALIAS$3/is; 3424 my @columns = split(/\s*,\s*/, $2); 3425 # When the pseudo column LEVEL is used in the where clause 3426 # and not used in columns list, add the pseudo column 3427 if ($where_clause =~ /\bLEVEL\b/is && !grep(/\bLEVEL\b/i, @columns)) { 3428 push(@columns, 'level'); 3429 } 3430 my @tabalias = (); 3431 my %connect_by_path = (); 3432 for (my $i = 0; $i <= $#columns; $i++) { 3433 my $found = 0; 3434 while ($columns[$i] =~ s/\%SUBQUERY(\d+)\%/$class->{sub_parts}{$1}/is) { 3435 # Get out of here next run when a call to SYS_CONNECT_BY_PATH is found 3436 # This will prevent opening too much subquery in the function parameters 3437 last if ($found); 3438 $found = 1 if ($columns[$i]=~ /SYS_CONNECT_BY_PATH/is); 3439 }; 3440 # Replace LEVEL call by a counter, there is no direct equivalent in PostgreSQL 3441 if (lc($columns[$i]) eq 'level') { 3442 $columns[$i] = "1 as level"; 3443 } elsif ($columns[$i] =~ /\bLEVEL\b/is) { 3444 $columns[$i] =~ s/\bLEVEL\b/1/is; 3445 } 3446 # Replace call to SYS_CONNECT_BY_PATH by the right concatenation string 3447 if ($columns[$i] =~ s/SYS_CONNECT_BY_PATH\s*[\(]*\s*([^,]+),\s*([^\)]+)\s*\)/$1/is) { 3448 my $col = $1; 3449 $connect_by_path{$col}{sep} = $2; 3450 # get the column alias 3451 if ($columns[$i] =~ /\s+([^\s]+)\s*$/s) { 3452 $connect_by_path{$col}{alias} = $1; 3453 } 3454 } 3455 if ($columns[$i] =~ /([^\.]+)\./s) { 3456 push(@tabalias, $1) if (!grep(/^\Q$1\E$/i, @tabalias)); 3457 } 3458 extract_subpart($class, \$columns[$i]); 3459 3460 # Append parenthesis on new subqueries values 3461 foreach my $z (sort {$a <=> $b } keys %{$class->{sub_parts}}) { 3462 next if ($class->{sub_parts}{$z} =~ /^\(/); 3463 # If subpart is not empty after transformation 3464 if ($class->{sub_parts}{$z} =~ /\S/is) { 3465 # add open and closed parenthesis 3466 $class->{sub_parts}{$z} = '(' . $class->{sub_parts}{$z} . ')'; 3467 } elsif ($statements[$i] !~ /\s+(WHERE|AND|OR)\s*\%SUBQUERY$z\%/is) { 3468 # otherwise do not report the empty parenthesis when this is not a function 3469 $class->{sub_parts}{$z} = '(' . $class->{sub_parts}{$z} . ')'; 3470 } 3471 } 3472 } 3473 3474 # Extraction of the table aliases in the FROM clause 3475 my $cols = join(',', @columns); 3476 $str =~ s/COLUMN_ALIAS/$cols/s; 3477 if ($str =~ s/(\s+FROM\s+)(.*)/$1FROM_CLAUSE/is) { 3478 my $from_clause = $2; 3479 $str =~ s/FROM_CLAUSE/$from_clause/; 3480 } 3481 3482 # Now append the UNION ALL query that will be called recursively 3483 $final_query .= $str; 3484 $final_query .= ' WHERE ' . $start_with . "\n" if ($start_with); 3485 #$where_clause =~ s/^\s*WHERE\s+/ AND /is; 3486 #$final_query .= $where_clause . "\n"; 3487 $final_query .= " UNION ALL\n"; 3488 if ($siblings && !$order_by) { 3489 $final_query =~ s/(\s+FROM\s+)/,ARRAY[ row_number() OVER (ORDER BY $siblings) ] as hierarchy$1/is; 3490 } elsif ($siblings) { 3491 3492 $final_query =~ s/(\s+FROM\s+)/,ARRAY[ row_number() OVER (ORDER BY $order_by) ] as hierarchy$1/is; 3493 } 3494 $bkup_query =~ s/(SELECT\s+)(.*?)(\s+FROM)/$1COLUMN_ALIAS$3/is; 3495 @columns = split(/\s*,\s*/, $2); 3496 # When the pseudo column LEVEL is used in the where clause 3497 # and not used in columns list, add the pseudo column 3498 if ($where_clause =~ /\bLEVEL\b/is && !grep(/\bLEVEL\b/i, @columns)) { 3499 push(@columns, 'level'); 3500 } 3501 for (my $i = 0; $i <= $#columns; $i++) { 3502 my $found = 0; 3503 while ($columns[$i] =~ s/\%SUBQUERY(\d+)\%/$class->{sub_parts}{$1}/is) { 3504 # Get out of here when a call to SYS_CONNECT_BY_PATH is found 3505 # This will prevent opening subquery in the function parameters 3506 last if ($found); 3507 $found = 1 if ($columns[$i]=~ /SYS_CONNECT_BY_PATH/is); 3508 }; 3509 if ($columns[$i] =~ s/SYS_CONNECT_BY_PATH\s*[\(]*\s*([^,]+),\s*([^\)]+)\s*\)/$1/is) { 3510 $columns[$i] = "c.$connect_by_path{$1}{alias} || $connect_by_path{$1}{sep} || " . $columns[$i]; 3511 } 3512 if ($columns[$i] !~ s/\b[^\.]+\.LEVEL\b/(c.level+1)/igs) { 3513 $columns[$i] =~ s/\bLEVEL\b/(c.level+1)/igs; 3514 } 3515 extract_subpart($class, \$columns[$i]); 3516 3517 # Append parenthesis on new subqueries values 3518 foreach my $z (sort {$a <=> $b } keys %{$class->{sub_parts}}) { 3519 next if ($class->{sub_parts}{$z} =~ /^\(/); 3520 # If subpart is not empty after transformation 3521 if ($class->{sub_parts}{$z} =~ /\S/is) { 3522 # add open and closed parenthesis 3523 $class->{sub_parts}{$z} = '(' . $class->{sub_parts}{$z} . ')'; 3524 } elsif ($statements[$i] !~ /\s+(WHERE|AND|OR)\s*\%SUBQUERY$z\%/is) { 3525 # otherwise do not report the empty parenthesis when this is not a function 3526 $class->{sub_parts}{$z} = '(' . $class->{sub_parts}{$z} . ')'; 3527 } 3528 } 3529 } 3530 $cols = join(',', @columns); 3531 $bkup_query =~ s/COLUMN_ALIAS/$cols/s; 3532 my $prior_alias = ''; 3533 if ($bkup_query =~ s/(\s+FROM\s+)(.*)/$1FROM_CLAUSE/is) { 3534 my $from_clause = $2; 3535 if ($from_clause =~ /\b[^\s]+\s+(?:AS\s+)?([^\s]+)\b/) { 3536 my $a = $1; 3537 $prior_alias = "$a." if (!grep(/\b$a\.[^\s]+$/, @prior_clause)); 3538 } 3539 $bkup_query =~ s/FROM_CLAUSE/$from_clause/; 3540 } 3541 3542 # Remove last subquery alias in the from clause to put our own 3543 $bkup_query =~ s/(\%SUBQUERY\d+\%)\s+[^\s]+\s*$/$1/is; 3544 if ($siblings && $order_by) { 3545 $bkup_query =~ s/(\s+FROM\s+)/, array_append(c.hierarchy, row_number() OVER (ORDER BY $order_by)) as hierarchy$1/is; 3546 } elsif ($siblings) { 3547 $bkup_query =~ s/(\s+FROM\s+)/, array_append(c.hierarchy, row_number() OVER (ORDER BY $siblings)) as hierarchy$1/is; 3548 } 3549 $final_query .= $bkup_query; 3550 map { s/^\s*(.*?)(=\s*)(.*)/c\.$1$2$prior_alias$3/s; } @prior_clause; 3551 $final_query .= " JOIN cte c ON (" . join(' AND ', @prior_clause) . ")\n"; 3552 if ($siblings) { 3553 $order_by = " ORDER BY hierarchy"; 3554 } elsif ($order_by) { 3555 $order_by =~ s/^, //s; 3556 $order_by = " ORDER BY $order_by"; 3557 } 3558 $final_query .= "\n) SELECT * FROM cte$where_clause$union$group_by$order_by;\n"; 3559 3560 return $final_query; 3561} 3562 3563sub replace_without_function 3564{ 3565 my ($class, $str) = @_; 3566 3567 # Code disabled because it break other complex GROUP BY clauses 3568 # Keeping it just in case some light help me to solve this problem 3569 # Reported in issue #496 3570 # Remove text constant in GROUP BY clause, this is not allowed 3571 # GROUP BY ?TEXTVALUE10?, %%REPLACEFCT1%%, DDI.LEGAL_ENTITY_ID 3572 #if ($str =~ s/(\s+GROUP\s+BY\s+)(.*?)((?:(?=\bUNION\b|\bORDER\s+BY\b|\bLIMIT\b|\bINTO\s+|\bFOR\s+UPDATE\b|\bPROCEDURE\b).)+|$)/$1\%GROUPBY\% $3/is) { 3573 # my $tmp = $2; 3574 # $tmp =~ s/\?TEXTVALUE\d+\?[,]*\s*//gs; 3575 # $tmp =~ s/(\s*,\s*),\s*/$1/gs; 3576 # $tmp =~ s/\s*,\s*$//s; 3577 # $str =~ s/\%GROUPBY\%/$tmp/s; 3578 #} 3579 3580 return $str; 3581} 3582 35831; 3584 3585__END__ 3586 3587 3588=head1 AUTHOR 3589 3590Gilles Darold <gilles@darold.net> 3591 3592 3593=head1 COPYRIGHT 3594 3595Copyright (c) 2000-2021 Gilles Darold - All rights reserved. 3596 3597This program is free software; you can redistribute it and/or modify it under 3598the same terms as Perl itself. 3599 3600 3601=head1 BUGS 3602 3603This perl module is in the same state as my knowledge regarding database, 3604it can move and not be compatible with older version so I will do my best 3605to give you official support for Ora2Pg. Your volontee to help construct 3606it and your contribution are welcome. 3607 3608 3609=head1 SEE ALSO 3610 3611L<Ora2Pg> 3612 3613=cut 3614 3615