--- /dev/null
+#!/usr/bin/perl
+# $Id: adddepend,v 1.1 2002/09/18 20:38:59 momjian Exp $
+
+# Project exists to assist PostgreSQL users with their structural upgrade
+# from 7.2 (or prior) to 7.3 (possibly later). Must be run against a 7.3
+# database system (dump, upgrade daemon, restore, run this script)
+#
+# - Replace old style Foreign Keys with new style
+# - Replace old SERIAL columns with new ones
+# - Replace old style Unique Indexes with new style Unique Constraints
+
+
+# License
+# -------
+# Copyright (c) 2001, Rod Taylor
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+#
+# 2. Redistributions in binary form must reproduce the above
+# copyright notice, this list of conditions and the following
+# disclaimer in the documentation and/or other materials provided
+# with the distribution.
+#
+# 3. Neither the name of the InQuent Technologies Inc. nor the names
+# of its contributors may be used to endorse or promote products
+# derived from this software without specific prior written
+# permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FREEBSD
+# PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+use DBI;
+use strict;
+
+
+# Fetch the connection information from the local environment
+my $dbuser = $ENV{'PGUSER'};
+$dbuser ||= $ENV{'USER'};
+
+my $database = $ENV{'PGDATABASE'};
+$database ||= $dbuser;
+my $dbisset = 0;
+
+my $dbhost = $ENV{'PGHOST'};
+$dbhost ||= "";
+
+my $dbport = $ENV{'PGPORT'};
+$dbport ||= "";
+
+my $dbpass = "";
+
+# Yes to all?
+my $yes = 0;
+
+# Whats the name of the binary?
+my $basename = $0;
+$basename =~ s|.*/([^/]+)$|$1|;
+
+## Process user supplied arguments.
+for( my $i=0; $i <= $#ARGV; $i++ ) {
+ ARGPARSE: for ( $ARGV[$i] ) {
+ /^-d$/ && do { $database = $ARGV[++$i];
+ $dbisset = 1;
+ last;
+ };
+
+ /^-[uU]$/ && do { $dbuser = $ARGV[++$i];
+ if (! $dbisset) {
+ $database = $dbuser;
+ }
+ last;
+ };
+
+ /^-h$/ && do { $dbhost = $ARGV[++$i]; last; };
+ /^-p$/ && do { $dbport = $ARGV[++$i]; last; };
+
+ /^--password=/ && do { $dbpass = $ARGV[$i];
+ $dbpass =~ s/^--password=//g;
+ last;
+ };
+
+ /^-Y$/ && do { $yes = 1; last; };
+
+ /^-\?$/ && do { usage(); last; };
+ /^--help$/ && do { usage(); last; };
+ }
+}
+
+# If no arguments were set, then tell them about usage
+if ($#ARGV <= 0) {
+ print <<MSG
+
+No arguments set. Use '$basename --help' for help
+
+Connecting to database '$database' as user '$dbuser'
+
+MSG
+;
+}
+
+my $dsn = "dbi:Pg:dbname=$database";
+$dsn .= ";host=$dbhost" if ( "$dbhost" ne "" );
+$dsn .= ";port=$dbport" if ( "$dbport" ne "" );
+
+# Database Connection
+# -------------------
+my $dbh = DBI->connect($dsn, $dbuser, $dbpass);
+
+# We want to control commits
+$dbh->{'AutoCommit'} = 0;
+
+END {
+ $dbh->disconnect() if $dbh;
+}
+
+findUniqueConstraints();
+findSerials();
+findForeignKeys();
+
+# Find old style Foreign Keys based on:
+#
+# - Group of 3 triggers of the appropriate types
+# -
+sub findForeignKeys
+{
+ my $sql = qq{
+ SELECT tgargs
+ , tgnargs
+ FROM pg_trigger
+ WHERE NOT EXISTS (SELECT *
+ FROM pg_depend
+ JOIN pg_constraint as c ON (refobjid = c.oid)
+ WHERE objid = pg_trigger.oid
+ AND deptype = 'i'
+ AND contype = 'f'
+ )
+ GROUP BY tgargs
+ , tgnargs
+ HAVING count(*) = 3;
+ };
+ my $sth = $dbh->prepare($sql);
+ $sth->execute() || triggerError($!);
+
+ while (my $row = $sth->fetchrow_hashref)
+ {
+ # Fetch vars
+ my $fkeynargs = $row->{'tgnargs'};
+ my $fkeyargs = $row->{'tgargs'};
+ my $matchtype = "MATCH SIMPLE";
+ my $updatetype = "";
+ my $deletetype = "";
+
+ if ($fkeynargs % 2 == 0 && $fkeynargs >= 6) {
+ my ( $keyname
+ , $table
+ , $ftable
+ , $unspecified
+ , $lcolumn_name
+ , $fcolumn_name
+ , @junk
+ ) = split(/\000/, $fkeyargs);
+
+ # Account for old versions which don't seem to handle NULL
+ # but instead return a string. Newer DBI::Pg drivers
+ # don't have this problem
+ if (!defined($ftable)) {
+ ( $keyname
+ , $table
+ , $ftable
+ , $unspecified
+ , $lcolumn_name
+ , $fcolumn_name
+ , @junk
+ ) = split(/\\000/, $fkeyargs);
+ }
+ else
+ {
+ # Clean up the string for further manipulation. DBD doesn't deal well with
+ # strings with NULLs in them
+ $fkeyargs =~ s|\000|\\000|g;
+ }
+
+ # Catch and record MATCH FULL
+ if ($unspecified eq "FULL")
+ {
+ $matchtype = "MATCH FULL";
+ }
+
+ # Start off our column lists
+ my $key_cols = "$lcolumn_name";
+ my $ref_cols = "$fcolumn_name";
+
+ # Perhaps there is more than a single column
+ while ($lcolumn_name = pop(@junk) and $fcolumn_name = pop(@junk)) {
+ $key_cols .= ", $lcolumn_name";
+ $ref_cols .= ", $fcolumn_name";
+ }
+
+ my $trigsql = qq{
+ SELECT tgname
+ , relname
+ , proname
+ FROM pg_trigger
+ JOIN pg_proc ON (pg_proc.oid = tgfoid)
+ JOIN pg_class ON (pg_class.oid = tgrelid)
+ WHERE tgargs = ?;
+ };
+
+ my $tgsth = $dbh->prepare($trigsql);
+ $tgsth->execute($fkeyargs) || triggerError($!);
+ my $triglist = "";
+ while (my $tgrow = $tgsth->fetchrow_hashref)
+ {
+ my $trigname = $tgrow->{'tgname'};
+ my $tablename = $tgrow->{'relname'};
+ my $fname = $tgrow->{'proname'};
+
+ for ($fname)
+ {
+ /^RI_FKey_cascade_del$/ && do {$deletetype = "ON DELETE CASCADE"; last;};
+ /^RI_FKey_cascade_upd$/ && do {$updatetype = "ON UPDATE CASCADE"; last;};
+ /^RI_FKey_restrict_del$/ && do {$deletetype = "ON DELETE RESTRICT"; last;};
+ /^RI_FKey_restrict_upd$/ && do {$updatetype = "ON UPDATE RESTRICT"; last;};
+ /^RI_FKey_setnull_del$/ && do {$deletetype = "ON DELETE SET NULL"; last;};
+ /^RI_FKey_setnull_upd$/ && do {$updatetype = "ON UPDATE SET NULL"; last;};
+ /^RI_FKey_setdefault_del$/ && do {$deletetype = "ON DELETE SET DEFAULT"; last;};
+ /^RI_FKey_setdefault_upd$/ && do {$updatetype = "ON UPDATE SET DEFAULT"; last;};
+ /^RI_FKey_noaction_del$/ && do {$deletetype = "ON DELETE NO ACTION"; last;};
+ /^RI_FKey_noaction_upd$/ && do {$updatetype = "ON UPDATE NO ACTION"; last;};
+ }
+
+ $triglist .= " DROP TRIGGER \"$trigname\" ON $tablename;\n";
+ }
+
+
+ my $constraint = "";
+ if ($keyname ne "<unnamed>")
+ {
+ $constraint = "CONSTRAINT \"$keyname\"";
+ }
+
+ my $fkey = qq{
+$triglist
+ ALTER TABLE $table ADD $constraint FOREIGN KEY ($key_cols)
+ REFERENCES $ftable($ref_cols) $matchtype $updatetype $deletetype;
+ };
+
+ # Does the user want to upgrade this sequence?
+ print <<MSG
+The below commands will upgrade the foreign key style. Shall I execute them?
+$fkey
+MSG
+;
+ if (userConfirm())
+ {
+ my $sthfkey = $dbh->prepare($fkey);
+ $sthfkey->execute() || $dbh->rollback();
+ $dbh->commit() || $dbh->rollback();
+ }
+ }
+ }
+
+}
+
+# Find possible old style Serial columns based on:
+#
+# - Process unique constraints. Unique indexes without
+# the corresponding entry in pg_constraint)
+sub findUniqueConstraints
+{
+ my $sql = qq{
+ SELECT ci.relname AS index_name
+ , ct.relname AS table_name
+ , pg_catalog.pg_get_indexdef(indexrelid) AS constraint_definition
+ FROM pg_class AS ci
+ JOIN pg_index ON (ci.oid = indexrelid)
+ JOIN pg_class AS ct ON (ct.oid = indrelid)
+ JOIN pg_catalog.pg_namespace ON (ct.relnamespace = pg_namespace.oid)
+ WHERE indisunique
+ AND NOT EXISTS (SELECT TRUE
+ FROM pg_catalog.pg_depend
+ JOIN pg_catalog.pg_constraint ON (refobjid = pg_constraint.oid)
+ WHERE objid = indexrelid
+ AND objsubid = 0)
+ AND nspname NOT IN ('pg_catalog', 'pg_toast');
+ };
+
+ my $sth = $dbh->prepare($sql) || triggerError($!);
+ $sth->execute();
+
+ while (my $row = $sth->fetchrow_hashref)
+ {
+ # Fetch vars
+ my $constraint_name = $row->{'index_name'};
+ my $table = $row->{'table_name'};
+ my $columns = $row->{'constraint_definition'};
+
+ # Extract the columns from the index definition
+ $columns =~ s|.*\(([^\)]+)\).*|$1|g;
+ $columns =~ s|([^\s]+)[^\s]+_ops|$1|g;
+
+ my $upsql = qq{
+DROP INDEX $constraint_name RESTRICT;
+ALTER TABLE $table ADD CONSTRAINT $constraint_name UNIQUE ($columns);
+ };
+
+
+ # Does the user want to upgrade this sequence?
+ print <<MSG
+
+
+Upgrade the Unique Constraint style via:
+$upsql
+MSG
+;
+ if (userConfirm())
+ {
+ # Drop the old index and create a new constraint by the same name
+ # to replace it.
+ my $upsth = $dbh->prepare($upsql);
+ $upsth->execute() || $dbh->rollback();
+
+ $dbh->commit() || $dbh->rollback();
+ }
+ }
+}
+
+
+# Find possible old style Serial columns based on:
+#
+# - Column is int or bigint
+# - Column has a nextval() default
+# - The sequence name includes the tablename, column name, and ends in _seq
+# or includes the tablename and is 40 or more characters in length.
+sub findSerials
+{
+ my $sql = qq{
+ SELECT nspname
+ , relname
+ , attname
+ , adsrc
+ FROM pg_catalog.pg_class as c
+
+ JOIN pg_catalog.pg_attribute as a
+ ON (c.oid = a.attrelid)
+
+ JOIN pg_catalog.pg_attrdef as ad
+ ON (a.attrelid = ad.adrelid
+ AND a.attnum = ad.adnum)
+
+ JOIN pg_catalog.pg_type as t
+ ON (t.typname IN ('int4', 'int8')
+ AND t.oid = a.atttypid)
+
+ JOIN pg_catalog.pg_namespace as n
+ ON (c.relnamespace = n.oid)
+
+ WHERE n.nspname = 'public'
+ AND adsrc LIKE 'nextval%'
+ AND adsrc LIKE '%'|| relname ||'_'|| attname ||'_seq%'
+ AND NOT EXISTS (SELECT *
+ FROM pg_catalog.pg_depend as sd
+ JOIN pg_catalog.pg_class as sc
+ ON (sc.oid = sd.objid)
+ WHERE sd.refobjid = a.attrelid
+ AND sd.refobjsubid = a.attnum
+ AND sd.objsubid = 0
+ AND deptype = 'i'
+ AND sc.relkind = 'S'
+ AND sc.relname = c.relname ||'_'|| a.attname || '_seq'
+ );
+ };
+
+ my $sth = $dbh->prepare($sql) || triggerError($!);
+ $sth->execute();
+
+ while (my $row = $sth->fetchrow_hashref)
+ {
+ # Fetch vars
+ my $table = $row->{'relname'};
+ my $column = $row->{'attname'};
+ my $seq = $row->{'adsrc'};
+
+ # Extract the sequence name from the default
+ $seq =~ s|^nextval\(["']+([^'"\)]+)["']+.*\)$|$1|g;
+
+ # Does the user want to upgrade this sequence?
+ print <<MSG
+Do you wish to upgrade Sequence '$seq' to SERIAL?
+Found on column $table.$column
+MSG
+;
+ if (userConfirm())
+ {
+ # Add the pg_depend entry for the serial column. Should be enough
+ # to fool pg_dump into recreating it properly next time. The default
+ # is still slightly different than a fresh serial, but close enough.
+ my $upsql = qq{
+ INSERT INTO pg_catalog.pg_depend
+ ( classid
+ , objid
+ , objsubid
+ , refclassid
+ , refobjid
+ , refobjsubid
+ , deptype
+ ) VALUES ( (SELECT c.oid -- classid
+ FROM pg_class as c
+ JOIN pg_namespace as n
+ ON (n.oid = c.relnamespace)
+ WHERE n.nspname = 'pg_catalog'
+ AND c.relname = 'pg_class')
+
+ , (SELECT c.oid -- objid
+ FROM pg_class as c
+ JOIN pg_namespace as n
+ ON (n.oid = c.relnamespace)
+ WHERE n.nspname = 'public'
+ AND c.relname = '$seq')
+
+ , 0 -- objsubid
+
+ , (SELECT c.oid -- refclassid
+ FROM pg_class as c
+ JOIN pg_namespace as n
+ ON (n.oid = c.relnamespace)
+ WHERE n.nspname = 'pg_catalog'
+ AND c.relname = 'pg_class')
+
+ , (SELECT c.oid -- refobjid
+ FROM pg_class as c
+ JOIN pg_namespace as n
+ ON (n.oid = c.relnamespace)
+ WHERE n.nspname = 'public'
+ AND c.relname = '$table')
+
+ , (SELECT a.attnum -- refobjsubid
+ FROM pg_class as c
+ JOIN pg_namespace as n
+ ON (n.oid = c.relnamespace)
+ JOIN pg_attribute as a
+ ON (a.attrelid = c.oid)
+ WHERE n.nspname = 'public'
+ AND c.relname = '$table'
+ AND a.attname = '$column')
+
+ , 'i' -- deptype
+ );
+ };
+
+ my $upsth = $dbh->prepare($upsql);
+ $upsth->execute() || $dbh->rollback();
+
+ $dbh->commit() || $dbh->rollback();
+ }
+ }
+}
+
+
+#######
+# userConfirm
+# Wait for a key press
+sub userConfirm
+{
+ my $ret = 0;
+ my $key = "";
+
+ # Sleep for key unless -Y was used
+ if ($yes == 1)
+ {
+ $ret = 1;
+ $key = 'Y';
+ }
+
+ # Wait for a keypress
+ while ($key eq "")
+ {
+ print "\n << 'Y'es or 'N'o >> : ";
+ $key = <STDIN>;
+
+ chomp $key;
+
+ # If it's not a Y or N, then ask again
+ $key =~ s/[^YyNn]//g;
+ }
+
+ if ($key =~ /[Yy]/)
+ {
+ $ret = 1;
+ }
+
+ return $ret;
+}
+
+#######
+# triggerError
+# Exit nicely, but print a message as we go about an error
+sub triggerError
+{
+ my $msg = shift;
+
+ # Set a default message if one wasn't supplied
+ if (!defined($msg))
+ {
+ $msg = "Unknown error";
+ }
+
+ print $msg;
+
+ exit 1;
+}
+
+
+#######
+# usage
+# Script usage
+sub usage
+{
+ print <<USAGE
+Usage:
+ $basename [options] [dbname [username]]
+
+Options:
+ -d <dbname> Specify database name to connect to (default: $database)
+ -h <host> Specify database server host (default: localhost)
+ -p <port> Specify database server port (default: 5432)
+ -u <username> Specify database username (default: $dbuser)
+ --password=<pw> Specify database password (default: blank)
+
+ -Y The script normally asks whether the user wishes to apply
+ the conversion for each item found. This forces YES to all
+ questions.
+
+USAGE
+;
+ exit 0;
+}
projects / postgresql / commitdiff