granicus.if.org Git - postgresql/blob - contrib/adddepend/adddepend

   1 #!/usr/bin/perl
   2 # $Id: adddepend,v 1.3 2002/12/02 00:28:29 tgl Exp $
   3
   4 # Project exists to assist PostgreSQL users with their structural upgrade
   5 # from 7.2 (or prior) to 7.3 (possibly later).  Must be run against a 7.3
   6 # database system (dump, upgrade daemon, restore, run this script)
   7 #
   8 # - Replace old style Foreign Keys with new style
   9 # - Replace old SERIAL columns with new ones
  10 # - Replace old style Unique Indexes with new style Unique Constraints
  11
  12
  13 # License
  14 # -------
  15 # Copyright (c) 2001, Rod Taylor
  16 # All rights reserved.
  17 #
  18 # Redistribution and use in source and binary forms, with or without
  19 # modification, are permitted provided that the following conditions
  20 # are met:
  21 #
  22 # 1.   Redistributions of source code must retain the above copyright
  23 #      notice, this list of conditions and the following disclaimer.
  24 #
  25 # 2.   Redistributions in binary form must reproduce the above
  26 #      copyright notice, this list of conditions and the following
  27 #      disclaimer in the documentation and/or other materials provided
  28 #      with the distribution.
  29 #
  30 # 3.   Neither the name of the InQuent Technologies Inc. nor the names
  31 #      of its contributors may be used to endorse or promote products
  32 #      derived from this software without specific prior written
  33 #      permission.
  34 #
  35 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  36 # ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  37 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  38 # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FREEBSD
  39 # PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  40 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  41 # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  42 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  43 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  44 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  45 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  46
  47
  48 use DBI;
  49 use strict;
  50
  51
  52 # Fetch the connection information from the local environment
  53 my $dbuser = $ENV{'PGUSER'};
  54 $dbuser ||= $ENV{'USER'};
  55
  56 my $database = $ENV{'PGDATABASE'};
  57 $database ||= $dbuser;
  58 my $dbisset = 0;
  59
  60 my $dbhost = $ENV{'PGHOST'};
  61 $dbhost ||= "";
  62
  63 my $dbport = $ENV{'PGPORT'};
  64 $dbport ||= "";
  65
  66 my $dbpass = "";
  67
  68 # Yes to all?
  69 my $yes = 0;
  70
  71 # Whats the name of the binary?
  72 my $basename = $0;
  73 $basename =~ s|.*/([^/]+)$|$1|;
  74
  75 ## Process user supplied arguments.
  76 for( my $i=0; $i <= $#ARGV; $i++ ) {
  77         ARGPARSE: for ( $ARGV[$i] ) {
  78                 /^-d$/                  && do { $database = $ARGV[++$i];
  79                                                         $dbisset = 1;
  80                                                         last;
  81                                                 };
  82
  83                 /^-[uU]$/               && do { $dbuser = $ARGV[++$i];
  84                                                         if (! $dbisset) {
  85                                                                 $database = $dbuser;
  86                                                         }
  87                                                         last;
  88                                                 };
  89
  90                 /^-h$/                  && do { $dbhost = $ARGV[++$i]; last; };
  91                 /^-p$/                  && do { $dbport = $ARGV[++$i]; last; };
  92
  93                 /^--password=/  && do { $dbpass = $ARGV[$i];
  94                                                         $dbpass =~ s/^--password=//g;
  95                                                         last;
  96                                                 };
  97
  98                 /^-Y$/                  && do { $yes = 1; last; };
  99
 100                 /^-\?$/                 && do { usage(); last; };
 101                 /^--help$/              && do { usage(); last; };
 102         }
 103 }
 104
 105 # If no arguments were set, then tell them about usage
 106 if ($#ARGV <= 0) {
 107         print <<MSG
 108
 109 No arguments set.  Use '$basename --help' for help
 110
 111 Connecting to database '$database' as user '$dbuser'
 112
 113 MSG
 114 ;
 115 }
 116
 117 my $dsn = "dbi:Pg:dbname=$database";
 118 $dsn .= ";host=$dbhost" if ( "$dbhost" ne "" );
 119 $dsn .= ";port=$dbport" if ( "$dbport" ne "" );
 120
 121 # Database Connection
 122 # -------------------
 123 my $dbh = DBI->connect($dsn, $dbuser, $dbpass);
 124
 125 # We want to control commits
 126 $dbh->{'AutoCommit'} = 0;
 127
 128 # turn on autocommit
 129 my $sql = qq{
 130     SET search_path = public;
 131 };
 132 my $sth = $dbh->prepare($sql);
 133 $sth->execute();
 134
 135 # turn on autocommit
 136 my $sql2 = qq{
 137     SET autocommit TO 'on';
 138 };
 139 my $sth2 = $dbh->prepare($sql2);
 140 $sth2->execute();
 141
 142 END {
 143         $dbh->disconnect() if $dbh;
 144 }
 145
 146 findUniqueConstraints();
 147 findSerials();
 148 findForeignKeys();
 149
 150 # Find old style Foreign Keys based on:
 151 #
 152 # - Group of 3 triggers of the appropriate types
 153 # -
 154 sub findForeignKeys
 155 {
 156         my $sql = qq{
 157             SELECT tgargs
 158                  , tgnargs
 159               FROM pg_trigger
 160              WHERE NOT EXISTS (SELECT *
 161                                  FROM pg_depend
 162                                  JOIN pg_constraint as c ON (refobjid = c.oid)
 163                                 WHERE objid = pg_trigger.oid
 164                                   AND deptype = 'i'
 165                                   AND contype = 'f'
 166                               )
 167           GROUP BY tgargs
 168                  , tgnargs
 169             HAVING count(*) = 3;
 170         };
 171         my $sth = $dbh->prepare($sql);
 172         $sth->execute() || triggerError($!);
 173
 174         while (my $row = $sth->fetchrow_hashref)
 175         {
 176                 # Fetch vars
 177                 my $fkeynargs = $row->{'tgnargs'};
 178                 my $fkeyargs = $row->{'tgargs'};
 179                 my $matchtype = "MATCH SIMPLE";
 180                 my $updatetype = "";
 181                 my $deletetype = "";
 182
 183                 if ($fkeynargs % 2 == 0 && $fkeynargs >= 6) {
 184                         my ( $keyname
 185                            , $table
 186                            , $ftable
 187                            , $unspecified
 188                            , $lcolumn_name
 189                            , $fcolumn_name
 190                            , @junk
 191                            ) = split(/\000/, $fkeyargs);
 192
 193                         # Account for old versions which don't seem to handle NULL
 194                         # but instead return a string.  Newer DBI::Pg drivers
 195                         # don't have this problem
 196                         if (!defined($ftable)) {
 197                                 ( $keyname
 198                                 , $table
 199                                 , $ftable
 200                                 , $unspecified
 201                                 , $lcolumn_name
 202                                 , $fcolumn_name
 203                                 , @junk
 204                                 ) = split(/\\000/, $fkeyargs);
 205                         }
 206                         else
 207                         {
 208                                 # Clean up the string for further manipulation.  DBD doesn't deal well with
 209                                 # strings with NULLs in them
 210                                 $fkeyargs =~ s|\000|\\000|g;
 211                         }
 212
 213                         # Catch and record MATCH FULL
 214                         if ($unspecified eq "FULL")
 215                         {
 216                                 $matchtype = "MATCH FULL";
 217                         }
 218
 219                         # Start off our column lists
 220                         my $key_cols = "$lcolumn_name";
 221                         my $ref_cols = "$fcolumn_name";
 222
 223                         # Perhaps there is more than a single column
 224                         while ($lcolumn_name = shift(@junk) and $fcolumn_name = shift(@junk)) {
 225                                 $key_cols .= ", $lcolumn_name";
 226                                 $ref_cols .= ", $fcolumn_name";
 227                         }
 228
 229                         my $trigsql = qq{
 230                           SELECT tgname
 231                                , relname
 232                                , proname
 233                             FROM pg_trigger
 234                             JOIN pg_proc ON (pg_proc.oid = tgfoid)
 235                             JOIN pg_class ON (pg_class.oid = tgrelid)
 236                            WHERE tgargs = ?;
 237                         };
 238
 239                         my $tgsth = $dbh->prepare($trigsql);
 240                         $tgsth->execute($fkeyargs) || triggerError($!);
 241                         my $triglist = "";
 242                         while (my $tgrow = $tgsth->fetchrow_hashref)
 243                         {
 244                                 my $trigname = $tgrow->{'tgname'};
 245                                 my $tablename = $tgrow->{'relname'};
 246                                 my $fname = $tgrow->{'proname'};
 247
 248                                 for ($fname)
 249                                 {
 250                                 /^RI_FKey_cascade_del$/         && do {$deletetype = "ON DELETE CASCADE"; last;};
 251                                 /^RI_FKey_cascade_upd$/         && do {$updatetype = "ON UPDATE CASCADE"; last;};
 252                                 /^RI_FKey_restrict_del$/        && do {$deletetype = "ON DELETE RESTRICT"; last;};
 253                                 /^RI_FKey_restrict_upd$/        && do {$updatetype = "ON UPDATE RESTRICT"; last;};
 254                                 /^RI_FKey_setnull_del$/         && do {$deletetype = "ON DELETE SET NULL"; last;};
 255                                 /^RI_FKey_setnull_upd$/         && do {$updatetype = "ON UPDATE SET NULL"; last;};
 256                                 /^RI_FKey_setdefault_del$/      && do {$deletetype = "ON DELETE SET DEFAULT"; last;};
 257                                 /^RI_FKey_setdefault_upd$/      && do {$updatetype = "ON UPDATE SET DEFAULT"; last;};
 258                                 /^RI_FKey_noaction_del$/        && do {$deletetype = "ON DELETE NO ACTION"; last;};
 259                                 /^RI_FKey_noaction_upd$/        && do {$updatetype = "ON UPDATE NO ACTION"; last;};
 260                                 }
 261
 262                                 $triglist .= "  DROP TRIGGER \"$trigname\" ON $tablename;\n";
 263                         }
 264
 265
 266                         my $constraint = "";
 267                         if ($keyname ne "<unnamed>")
 268                         {
 269                                 $constraint = "CONSTRAINT \"$keyname\"";
 270                         }
 271
 272                         my $fkey = qq{
 273 $triglist
 274         ALTER TABLE $table ADD $constraint FOREIGN KEY ($key_cols)
 275                  REFERENCES $ftable($ref_cols) $matchtype $updatetype $deletetype;
 276                         };
 277
 278                         # Does the user want to upgrade this sequence?
 279                         print <<MSG
 280 The below commands will upgrade the foreign key style.  Shall I execute them?
 281 $fkey
 282 MSG
 283 ;
 284                         if (userConfirm())
 285                         {
 286                                 my $sthfkey = $dbh->prepare($fkey);
 287                                 $sthfkey->execute() || $dbh->rollback();
 288                                 $dbh->commit() || $dbh->rollback();
 289                         }
 290                 }
 291         }
 292
 293 }
 294
 295 # Find possible old style Serial columns based on:
 296 #
 297 # - Process unique constraints. Unique indexes without
 298 #   the corresponding entry in pg_constraint)
 299 sub findUniqueConstraints
 300 {
 301         my $sql = qq{
 302             SELECT ci.relname AS index_name
 303              , ct.relname AS table_name
 304              , pg_catalog.pg_get_indexdef(indexrelid) AS constraint_definition
 305           FROM pg_class AS ci
 306           JOIN pg_index ON (ci.oid = indexrelid)
 307           JOIN pg_class AS ct ON (ct.oid = indrelid)
 308               JOIN pg_catalog.pg_namespace ON (ct.relnamespace = pg_namespace.oid)
 309          WHERE indisunique
 310            AND NOT EXISTS (SELECT TRUE
 311                              FROM pg_catalog.pg_depend
 312                                  JOIN pg_catalog.pg_constraint ON (refobjid = pg_constraint.oid)
 313                             WHERE objid = indexrelid
 314                               AND objsubid = 0)
 315                AND nspname NOT IN ('pg_catalog', 'pg_toast');
 316         };
 317
 318         my $sth = $dbh->prepare($sql) || triggerError($!);
 319         $sth->execute();
 320
 321         while (my $row = $sth->fetchrow_hashref)
 322         {
 323                 # Fetch vars
 324                 my $constraint_name = $row->{'index_name'};
 325                 my $table = $row->{'table_name'};
 326                 my $columns = $row->{'constraint_definition'};
 327
 328                 # Extract the columns from the index definition
 329                 $columns =~ s|.*\(([^\)]+)\).*|$1|g;
 330                 $columns =~ s|([^\s]+)[^\s]+_ops|$1|g;
 331
 332                 my $upsql = qq{
 333 DROP INDEX $constraint_name RESTRICT;
 334 ALTER TABLE $table ADD CONSTRAINT $constraint_name UNIQUE ($columns);
 335                 };
 336
 337
 338                 # Does the user want to upgrade this sequence?
 339                 print <<MSG
 340
 341
 342 Upgrade the Unique Constraint style via:
 343 $upsql
 344 MSG
 345 ;
 346                 if (userConfirm())
 347                 {
 348                         # Drop the old index and create a new constraint by the same name
 349                         # to replace it.
 350                         my $upsth = $dbh->prepare($upsql);
 351                         $upsth->execute() || $dbh->rollback();
 352
 353                         $dbh->commit() || $dbh->rollback();
 354                 }
 355         }
 356 }
 357
 358
 359 # Find possible old style Serial columns based on:
 360 #
 361 # - Column is int or bigint
 362 # - Column has a nextval() default
 363 # - The sequence name includes the tablename, column name, and ends in _seq
 364 #   or includes the tablename and is 40 or more characters in length.
 365 sub findSerials
 366 {
 367         my $sql = qq{
 368             SELECT nspname
 369                  , relname
 370                  , attname
 371                  , adsrc
 372               FROM pg_catalog.pg_class as c
 373
 374               JOIN pg_catalog.pg_attribute as a
 375                    ON (c.oid = a.attrelid)
 376
 377               JOIN pg_catalog.pg_attrdef as ad
 378                    ON (a.attrelid = ad.adrelid
 379                    AND a.attnum = ad.adnum)
 380
 381               JOIN pg_catalog.pg_type as t
 382                    ON (t.typname IN ('int4', 'int8')
 383                    AND t.oid = a.atttypid)
 384
 385               JOIN pg_catalog.pg_namespace as n
 386                    ON (c.relnamespace = n.oid)
 387
 388              WHERE n.nspname = 'public'
 389                AND adsrc LIKE 'nextval%'
 390                AND adsrc LIKE '%'|| relname ||'_'|| attname ||'_seq%'
 391                AND NOT EXISTS (SELECT *
 392                                  FROM pg_catalog.pg_depend as sd
 393                                  JOIN pg_catalog.pg_class as sc
 394                                       ON (sc.oid = sd.objid)
 395                                 WHERE sd.refobjid = a.attrelid
 396                                   AND sd.refobjsubid = a.attnum
 397                                   AND sd.objsubid = 0
 398                                   AND deptype = 'i'
 399                                   AND sc.relkind = 'S'
 400                                   AND sc.relname = c.relname ||'_'|| a.attname || '_seq'
 401                               );
 402         };
 403
 404         my $sth = $dbh->prepare($sql) || triggerError($!);
 405         $sth->execute();
 406
 407         while (my $row = $sth->fetchrow_hashref)
 408         {
 409                 # Fetch vars
 410                 my $table = $row->{'relname'};
 411                 my $column = $row->{'attname'};
 412                 my $seq = $row->{'adsrc'};
 413
 414                 # Extract the sequence name from the default
 415                 $seq =~ s|^nextval\(["']+([^'"\)]+)["']+.*\)$|$1|g;
 416
 417                 # Does the user want to upgrade this sequence?
 418                 print <<MSG
 419 Do you wish to upgrade Sequence '$seq' to SERIAL?
 420 Found on column $table.$column
 421 MSG
 422 ;
 423                 if (userConfirm())
 424                 {
 425                         # Add the pg_depend entry for the serial column.  Should be enough
 426                         # to fool pg_dump into recreating it properly next time.  The default
 427                         # is still slightly different than a fresh serial, but close enough.
 428                         my $upsql = qq{
 429                           INSERT INTO pg_catalog.pg_depend
 430                                     ( classid
 431                                     , objid
 432                                     , objsubid
 433                                     , refclassid
 434                                     , refobjid
 435                                     , refobjsubid
 436                                     , deptype
 437                            ) VALUES ( (SELECT c.oid            -- classid
 438                                          FROM pg_class as c
 439                                          JOIN pg_namespace as n
 440                                               ON (n.oid = c.relnamespace)
 441                                         WHERE n.nspname = 'pg_catalog'
 442                                           AND c.relname = 'pg_class')
 443
 444                                     , (SELECT c.oid            -- objid
 445                                          FROM pg_class as c
 446                                          JOIN pg_namespace as n
 447                                               ON (n.oid = c.relnamespace)
 448                                         WHERE n.nspname = 'public'
 449                                           AND c.relname = '$seq')
 450
 451                                     , 0                        -- objsubid
 452
 453                                     , (SELECT c.oid            -- refclassid
 454                                          FROM pg_class as c
 455                                          JOIN pg_namespace as n
 456                                               ON (n.oid = c.relnamespace)
 457                                         WHERE n.nspname = 'pg_catalog'
 458                                           AND c.relname = 'pg_class')
 459
 460                                     , (SELECT c.oid            -- refobjid
 461                                          FROM pg_class as c
 462                                          JOIN pg_namespace as n
 463                                               ON (n.oid = c.relnamespace)
 464                                         WHERE n.nspname = 'public'
 465                                           AND c.relname = '$table')
 466
 467                                     , (SELECT a.attnum         -- refobjsubid
 468                                          FROM pg_class as c
 469                                          JOIN pg_namespace as n
 470                                               ON (n.oid = c.relnamespace)
 471                                          JOIN pg_attribute as a
 472                                               ON (a.attrelid = c.oid)
 473                                         WHERE n.nspname = 'public'
 474                                           AND c.relname = '$table'
 475                                           AND a.attname = '$column')
 476
 477                                     , 'i'                      -- deptype
 478                                     );
 479                         };
 480
 481                         my $upsth = $dbh->prepare($upsql);
 482                         $upsth->execute() || $dbh->rollback();
 483
 484                         $dbh->commit() || $dbh->rollback();
 485                 }
 486         }
 487 }
 488
 489
 490 #######
 491 # userConfirm
 492 #       Wait for a key press
 493 sub userConfirm
 494 {
 495         my $ret = 0;
 496         my $key = "";
 497
 498         # Sleep for key unless -Y was used
 499         if ($yes == 1)
 500         {
 501                 $ret = 1;
 502                 $key = 'Y';
 503         }
 504
 505         # Wait for a keypress
 506         while ($key eq "")
 507         {
 508                 print "\n << 'Y'es or 'N'o >> : ";
 509                 $key = <STDIN>;
 510
 511                 chomp $key;
 512
 513                 # If it's not a Y or N, then ask again
 514                 $key =~ s/[^YyNn]//g;
 515         }
 516
 517         if ($key =~ /[Yy]/)
 518         {
 519                 $ret = 1;
 520         }
 521
 522         return $ret;
 523 }
 524
 525 #######
 526 # triggerError
 527 #       Exit nicely, but print a message as we go about an error
 528 sub triggerError
 529 {
 530         my $msg = shift;
 531
 532         # Set a default message if one wasn't supplied
 533         if (!defined($msg))
 534         {
 535                 $msg = "Unknown error";
 536         }
 537
 538         print $msg;
 539
 540         exit 1;
 541 }
 542
 543
 544 #######
 545 # usage
 546 #   Script usage
 547 sub usage
 548 {
 549         print <<USAGE
 550 Usage:
 551   $basename [options] [dbname [username]]
 552
 553 Options:
 554   -d <dbname>     Specify database name to connect to (default: $database)
 555   -h <host>       Specify database server host (default: localhost)
 556   -p <port>       Specify database server port (default: 5432)
 557   -u <username>   Specify database username (default: $dbuser)
 558   --password=<pw> Specify database password (default: blank)
 559
 560   -Y              The script normally asks whether the user wishes to apply
 561                   the conversion for each item found.  This forces YES to all
 562                   questions.
 563
 564 USAGE
 565 ;
 566         exit 0;
 567 }