# TODO: gets all indexes on all tables # TODO: select * from pg_stat_all_indexes where schemaname not like 'pg_catalog' # TODO: (07/09/2010 02:50:40 PM) Nut: might be useful later on for cleaning up the db... # TODO: making indexes and stuff for tables that dont have any package PostgresInfo; use strict; use warnings; use feature 'say'; use Data::Dumper; use Sort::Versions; use JSON; use Carp qw(verbose); use SimpleDB4; use SimpleSPI; my %keywords = ( 'A' => 1, 'ABORT' => 1, 'ABS' => 1, 'ABSOLUTE' => 1, 'ACCESS' => 1, 'ACTION' => 1, 'ADA' => 1, 'ADD' => 1, 'ADMIN' => 1, 'AFTER' => 1, 'AGGREGATE' => 1, 'ALIAS' => 1, 'ALL' => 1, 'ALLOCATE' => 1, 'ALSO' => 1, 'ALTER' => 1, 'ALWAYS' => 1, 'ANALYSE' => 1, 'ANALYZE' => 1, 'AND' => 1, 'ANY' => 1, 'ARE' => 1, 'ARRAY' => 1, 'AS' => 1, 'ASC' => 1, 'ASENSITIVE' => 1, 'ASSERTION' => 1, 'ASSIGNMENT' => 1, 'ASYMMETRIC' => 1, 'AT' => 1, 'ATOMIC' => 1, 'ATTRIBUTE' => 1, 'ATTRIBUTES' => 1, 'AUTHORIZATION' => 1, 'AVG' => 1, 'BACKWARD' => 1, 'BASE64' => 1, 'BEFORE' => 1, 'BEGIN' => 1, 'BERNOULLI' => 1, 'BETWEEN' => 1, 'BIGINT' => 1, 'BINARY' => 1, 'BIT' => 1, 'BITVAR' => 1, 'BIT_LENGTH' => 1, 'BLOB' => 1, 'BOOLEAN' => 1, 'BOTH' => 1, 'BREADTH' => 1, 'BY' => 1, 'C' => 1, 'CACHE' => 1, 'CALL' => 1, 'CALLED' => 1, 'CARDINALITY' => 1, 'CASCADE' => 1, 'CASCADED' => 1, 'CASE' => 1, 'CAST' => 1, 'CATALOG' => 1, 'CATALOG_NAME' => 1, 'CEIL' => 1, 'CEILING' => 1, 'CHAIN' => 1, 'CHAR' => 1, 'CHARACTER' => 1, 'CHARACTERISTICS' => 1, 'CHARACTERS' => 1, 'CHARACTER_LENGTH' => 1, 'CHARACTER_SET_CATALOG' => 1, 'CHARACTER_SET_NAME' => 1, 'CHARACTER_SET_SCHEMA' => 1, 'CHAR_LENGTH' => 1, 'CHECK' => 1, 'CHECKED' => 1, 'CHECKPOINT' => 1, 'CLASS' => 1, 'CLASS_ORIGIN' => 1, 'CLOB' => 1, 'CLOSE' => 1, 'CLUSTER' => 1, 'COALESCE' => 1, 'COBOL' => 1, 'COLLATE' => 1, 'COLLATION' => 1, 'COLLATION_CATALOG' => 1, 'COLLATION_NAME' => 1, 'COLLATION_SCHEMA' => 1, 'COLLECT' => 1, 'COLUMN' => 1, 'COLUMN_NAME' => 1, 'COMMAND_FUNCTION' => 1, 'COMMAND_FUNCTION_CODE' => 1, 'COMMENT' => 1, 'COMMIT' => 1, 'COMMITTED' => 1, 'COMPLETION' => 1, 'CONCURRENTLY' => 1, 'CONDITION' => 1, 'CONDITION_NUMBER' => 1, 'CONFIGURATION' => 1, 'CONNECT' => 1, 'CONNECTION' => 1, 'CONNECTION_NAME' => 1, 'CONSTRAINT' => 1, 'CONSTRAINTS' => 1, 'CONSTRAINT_CATALOG' => 1, 'CONSTRAINT_NAME' => 1, 'CONSTRAINT_SCHEMA' => 1, 'CONSTRUCTOR' => 1, 'CONTAINS' => 1, 'CONTENT' => 1, 'CONTINUE' => 1, 'CONVERSION' => 1, 'CONVERT' => 1, 'COPY' => 1, 'CORR' => 1, 'CORRESPONDING' => 1, 'COST' => 1, 'COUNT' => 1, 'COVAR_POP' => 1, 'COVAR_SAMP' => 1, 'CREATE' => 1, 'CREATEDB' => 1, 'CREATEROLE' => 1, 'CREATEUSER' => 1, 'CROSS' => 1, 'CSV' => 1, 'CUBE' => 1, 'CUME_DIST' => 1, 'CURRENT' => 1, 'CURRENT_DATE' => 1, 'CURRENT_DEFAULT_TRANSFORM_GROUP' => 1, 'CURRENT_PATH' => 1, 'CURRENT_ROLE' => 1, 'CURRENT_TIME' => 1, 'CURRENT_TIMESTAMP' => 1, 'CURRENT_TRANSFORM_GROUP_FOR_TYPE' => 1, 'CURRENT_USER' => 1, 'CURSOR' => 1, 'CURSOR_NAME' => 1, 'CYCLE' => 1, 'DATA' => 1, 'DATABASE' => 1, 'DATE' => 1, 'DATETIME_INTERVAL_CODE' => 1, 'DATETIME_INTERVAL_PRECISION' => 1, 'DAY' => 1, 'DEALLOCATE' => 1, 'DEC' => 1, 'DECIMAL' => 1, 'DECLARE' => 1, 'DEFAULT' => 1, 'DEFAULTS' => 1, 'DEFERRABLE' => 1, 'DEFERRED' => 1, 'DEFINED' => 1, 'DEFINER' => 1, 'DEGREE' => 1, 'DELETE' => 1, 'DELIMITER' => 1, 'DELIMITERS' => 1, 'DENSE_RANK' => 1, 'DEPTH' => 1, 'DEREF' => 1, 'DERIVED' => 1, 'DESC' => 1, 'DESCRIBE' => 1, 'DESCRIPTOR' => 1, 'DESTROY' => 1, 'DESTRUCTOR' => 1, 'DETERMINISTIC' => 1, 'DIAGNOSTICS' => 1, 'DICTIONARY' => 1, 'DISABLE' => 1, 'DISCARD' => 1, 'DISCONNECT' => 1, 'DISPATCH' => 1, 'DISTINCT' => 1, 'DO' => 1, 'DOCUMENT' => 1, 'DOMAIN' => 1, 'DOUBLE' => 1, 'DROP' => 1, 'DYNAMIC' => 1, 'DYNAMIC_FUNCTION' => 1, 'DYNAMIC_FUNCTION_CODE' => 1, 'EACH' => 1, 'ELEMENT' => 1, 'ELSE' => 1, 'ENABLE' => 1, 'ENCODING' => 1, 'ENCRYPTED' => 1, 'END' => 1, 'END-EXEC' => 1, 'ENUM' => 1, 'EQUALS' => 1, 'ESCAPE' => 1, 'EVERY' => 1, 'EXCEPT' => 1, 'EXCEPTION' => 1, 'EXCLUDE' => 1, 'EXCLUDING' => 1, 'EXCLUSIVE' => 1, 'EXEC' => 1, 'EXECUTE' => 1, 'EXISTING' => 1, 'EXISTS' => 1, 'EXP' => 1, 'EXPLAIN' => 1, 'EXTERNAL' => 1, 'EXTRACT' => 1, 'FALSE' => 1, 'FAMILY' => 1, 'FETCH' => 1, 'FILTER' => 1, 'FINAL' => 1, 'FIRST' => 1, 'FLOAT' => 1, 'FLOOR' => 1, 'FOLLOWING' => 1, 'FOR' => 1, 'FORCE' => 1, 'FOREIGN' => 1, 'FORTRAN' => 1, 'FORWARD' => 1, 'FOUND' => 1, 'FREE' => 1, 'FREEZE' => 1, 'FROM' => 1, 'FULL' => 1, 'FUNCTION' => 1, 'FUSION' => 1, 'G' => 1, 'GENERAL' => 1, 'GENERATED' => 1, 'GET' => 1, 'GLOBAL' => 1, 'GO' => 1, 'GOTO' => 1, 'GRANT' => 1, 'GRANTED' => 1, 'GREATEST' => 1, 'GROUP' => 1, 'GROUPING' => 1, 'HANDLER' => 1, 'HAVING' => 1, 'HEADER' => 1, 'HEX' => 1, 'HIERARCHY' => 1, 'HOLD' => 1, 'HOST' => 1, 'HOUR' => 1, 'IDENTITY' => 1, 'IF' => 1, 'IGNORE' => 1, 'ILIKE' => 1, 'IMMEDIATE' => 1, 'IMMUTABLE' => 1, 'IMPLEMENTATION' => 1, 'IMPLICIT' => 1, 'IN' => 1, 'INCLUDING' => 1, 'INCREMENT' => 1, 'INDEX' => 1, 'INDEXES' => 1, 'INDICATOR' => 1, 'INFIX' => 1, 'INHERIT' => 1, 'INHERITS' => 1, 'INITIALIZE' => 1, 'INITIALLY' => 1, 'INNER' => 1, 'INOUT' => 1, 'INPUT' => 1, 'INSENSITIVE' => 1, 'INSERT' => 1, 'INSTANCE' => 1, 'INSTANTIABLE' => 1, 'INSTEAD' => 1, 'INT' => 1, 'INTEGER' => 1, 'INTERSECT' => 1, 'INTERSECTION' => 1, 'INTERVAL' => 1, 'INTO' => 1, 'INVOKER' => 1, 'IS' => 1, 'ISNULL' => 1, 'ISOLATION' => 1, 'ITERATE' => 1, 'JOIN' => 1, 'K' => 1, 'KEY' => 1, 'KEY_MEMBER' => 1, 'KEY_TYPE' => 1, 'LANCOMPILER' => 1, 'LANGUAGE' => 1, 'LARGE' => 1, 'LAST' => 1, 'LATERAL' => 1, 'LEADING' => 1, 'LEAST' => 1, 'LEFT' => 1, 'LENGTH' => 1, 'LESS' => 1, 'LEVEL' => 1, 'LIKE' => 1, 'LIMIT' => 1, 'LISTEN' => 1, 'LN' => 1, 'LOAD' => 1, 'LOCAL' => 1, 'LOCALTIME' => 1, 'LOCALTIMESTAMP' => 1, 'LOCATION' => 1, 'LOCATOR' => 1, 'LOCK' => 1, 'LOGIN' => 1, 'LOWER' => 1, 'M' => 1, 'MAP' => 1, 'MAPPING' => 1, 'MATCH' => 1, 'MATCHED' => 1, 'MAX' => 1, 'MAXVALUE' => 1, 'MEMBER' => 1, 'MERGE' => 1, 'MESSAGE_LENGTH' => 1, 'MESSAGE_OCTET_LENGTH' => 1, 'MESSAGE_TEXT' => 1, 'METHOD' => 1, 'MIN' => 1, 'MINUTE' => 1, 'MINVALUE' => 1, 'MOD' => 1, 'MODE' => 1, 'MODIFIES' => 1, 'MODIFY' => 1, 'MODULE' => 1, 'MONTH' => 1, 'MORE' => 1, 'MOVE' => 1, 'MULTISET' => 1, 'MUMPS' => 1, 'NAME' => 1, 'NAMES' => 1, 'NATIONAL' => 1, 'NATURAL' => 1, 'NCHAR' => 1, 'NCLOB' => 1, 'NESTING' => 1, 'NEW' => 1, 'NEXT' => 1, 'NO' => 1, 'NOCREATEDB' => 1, 'NOCREATEROLE' => 1, 'NOCREATEUSER' => 1, 'NOINHERIT' => 1, 'NOLOGIN' => 1, 'NONE' => 1, 'NORMALIZE' => 1, 'NORMALIZED' => 1, 'NOSUPERUSER' => 1, 'NOT' => 1, 'NOTHING' => 1, 'NOTIFY' => 1, 'NOTNULL' => 1, 'NOWAIT' => 1, 'NULL' => 1, 'NULLABLE' => 1, 'NULLIF' => 1, 'NULLS' => 1, 'NUMBER' => 1, 'NUMERIC' => 1, 'OBJECT' => 1, 'OCTETS' => 1, 'OCTET_LENGTH' => 1, 'OF' => 1, 'OFF' => 1, 'OFFSET' => 1, 'OIDS' => 1, 'OLD' => 1, 'ON' => 1, 'ONLY' => 1, 'OPEN' => 1, 'OPERATION' => 1, 'OPERATOR' => 1, 'OPTION' => 1, 'OPTIONS' => 1, 'OR' => 1, 'ORDER' => 1, 'ORDERING' => 1, 'ORDINALITY' => 1, 'OTHERS' => 1, 'OUT' => 1, 'OUTER' => 1, 'OUTPUT' => 1, 'OVER' => 1, 'OVERLAPS' => 1, 'OVERLAY' => 1, 'OVERRIDING' => 1, 'OWNED' => 1, 'OWNER' => 1, 'PAD' => 1, 'PARAMETER' => 1, 'PARAMETERS' => 1, 'PARAMETER_MODE' => 1, 'PARAMETER_NAME' => 1, 'PARAMETER_ORDINAL_POSITION' => 1, 'PARAMETER_SPECIFIC_CATALOG' => 1, 'PARAMETER_SPECIFIC_NAME' => 1, 'PARAMETER_SPECIFIC_SCHEMA' => 1, 'PARSER' => 1, 'PARTIAL' => 1, 'PARTITION' => 1, 'PASCAL' => 1, 'PASSWORD' => 1, 'PATH' => 1, 'PERCENTILE_CONT' => 1, 'PERCENTILE_DISC' => 1, 'PERCENT_RANK' => 1, 'PLACING' => 1, 'PLANS' => 1, 'PLI' => 1, 'POSITION' => 1, 'POSTFIX' => 1, 'POWER' => 1, 'PRECEDING' => 1, 'PRECISION' => 1, 'PREFIX' => 1, 'PREORDER' => 1, 'PREPARE' => 1, 'PREPARED' => 1, 'PRESERVE' => 1, 'PRIMARY' => 1, 'PRIOR' => 1, 'PRIVILEGES' => 1, 'PROCEDURAL' => 1, 'PROCEDURE' => 1, 'PUBLIC' => 1, 'QUOTE' => 1, 'RANGE' => 1, 'RANK' => 1, 'READ' => 1, 'READS' => 1, 'REAL' => 1, 'REASSIGN' => 1, 'RECHECK' => 1, 'RECURSIVE' => 1, 'REF' => 1, 'REFERENCES' => 1, 'REFERENCING' => 1, 'REGR_AVGX' => 1, 'REGR_AVGY' => 1, 'REGR_COUNT' => 1, 'REGR_INTERCEPT' => 1, 'REGR_R2' => 1, 'REGR_SLOPE' => 1, 'REGR_SXX' => 1, 'REGR_SXY' => 1, 'REGR_SYY' => 1, 'REINDEX' => 1, 'RELATIVE' => 1, 'RELEASE' => 1, 'RENAME' => 1, 'REPEATABLE' => 1, 'REPLACE' => 1, 'REPLICA' => 1, 'RESET' => 1, 'RESTART' => 1, 'RESTRICT' => 1, 'RESULT' => 1, 'RETURN' => 1, 'RETURNED_CARDINALITY' => 1, 'RETURNED_LENGTH' => 1, 'RETURNED_OCTET_LENGTH' => 1, 'RETURNED_SQLSTATE' => 1, 'RETURNING' => 1, 'RETURNS' => 1, 'REVOKE' => 1, 'RIGHT' => 1, 'ROLE' => 1, 'ROLLBACK' => 1, 'ROLLUP' => 1, 'ROUTINE' => 1, 'ROUTINE_CATALOG' => 1, 'ROUTINE_NAME' => 1, 'ROUTINE_SCHEMA' => 1, 'ROW' => 1, 'ROWS' => 1, 'ROW_COUNT' => 1, 'ROW_NUMBER' => 1, 'RULE' => 1, 'SAVEPOINT' => 1, 'SCALE' => 1, 'SCHEMA' => 1, 'SCHEMA_NAME' => 1, 'SCOPE' => 1, 'SCOPE_CATALOG' => 1, 'SCOPE_NAME' => 1, 'SCOPE_SCHEMA' => 1, 'SCROLL' => 1, 'SEARCH' => 1, 'SECOND' => 1, 'SECTION' => 1, 'SECURITY' => 1, 'SELECT' => 1, 'SELF' => 1, 'SENSITIVE' => 1, 'SEQUENCE' => 1, 'SERIALIZABLE' => 1, 'SERVER_NAME' => 1, 'SESSION' => 1, 'SESSION_USER' => 1, 'SET' => 1, 'SETOF' => 1, 'SETS' => 1, 'SHARE' => 1, 'SHOW' => 1, 'SIMILAR' => 1, 'SIMPLE' => 1, 'SIZE' => 1, 'SMALLINT' => 1, 'SOME' => 1, 'SOURCE' => 1, 'SPACE' => 1, 'SPECIFIC' => 1, 'SPECIFICTYPE' => 1, 'SPECIFIC_NAME' => 1, 'SQL' => 1, 'SQLCODE' => 1, 'SQLERROR' => 1, 'SQLEXCEPTION' => 1, 'SQLSTATE' => 1, 'SQLWARNING' => 1, 'SQRT' => 1, 'STABLE' => 1, 'STANDALONE' => 1, 'START' => 1, 'STATE' => 1, 'STATEMENT' => 1, 'STATIC' => 1, 'STATISTICS' => 1, 'STDDEV_POP' => 1, 'STDDEV_SAMP' => 1, 'STDIN' => 1, 'STDOUT' => 1, 'STORAGE' => 1, 'STRICT' => 1, 'STRIP' => 1, 'STRUCTURE' => 1, 'STYLE' => 1, 'SUBCLASS_ORIGIN' => 1, 'SUBLIST' => 1, 'SUBMULTISET' => 1, 'SUBSTRING' => 1, 'SUM' => 1, 'SUPERUSER' => 1, 'SYMMETRIC' => 1, 'SYSID' => 1, 'SYSTEM' => 1, 'SYSTEM_USER' => 1, 'TABLE' => 1, 'TABLESAMPLE' => 1, 'TABLESPACE' => 1, 'TABLE_NAME' => 1, 'TEMP' => 1, 'TEMPLATE' => 1, 'TEMPORARY' => 1, 'TERMINATE' => 1, 'TEXT' => 1, 'THAN' => 1, 'THEN' => 1, 'TIES' => 1, 'TIME' => 1, 'TIMESTAMP' => 1, 'TIMEZONE_HOUR' => 1, 'TIMEZONE_MINUTE' => 1, 'TO' => 1, 'TOP_LEVEL_COUNT' => 1, 'TRAILING' => 1, 'TRANSACTION' => 1, 'TRANSACTIONS_COMMITTED' => 1, 'TRANSACTIONS_ROLLED_BACK' => 1, 'TRANSACTION_ACTIVE' => 1, 'TRANSFORM' => 1, 'TRANSFORMS' => 1, 'TRANSLATE' => 1, 'TRANSLATION' => 1, 'TREAT' => 1, 'TRIGGER' => 1, 'TRIGGER_CATALOG' => 1, 'TRIGGER_NAME' => 1, 'TRIGGER_SCHEMA' => 1, 'TRIM' => 1, 'TRUE' => 1, 'TRUNCATE' => 1, 'TRUSTED' => 1, 'TYPE' => 1, 'UESCAPE' => 1, 'UNBOUNDED' => 1, 'UNCOMMITTED' => 1, 'UNDER' => 1, 'UNENCRYPTED' => 1, 'UNION' => 1, 'UNIQUE' => 1, 'UNKNOWN' => 1, 'UNLISTEN' => 1, 'UNNAMED' => 1, 'UNNEST' => 1, 'UNTIL' => 1, 'UPDATE' => 1, 'UPPER' => 1, 'USAGE' => 1, 'USER' => 1, 'USER_DEFINED_TYPE_CATALOG' => 1, 'USER_DEFINED_TYPE_CODE' => 1, 'USER_DEFINED_TYPE_NAME' => 1, 'USER_DEFINED_TYPE_SCHEMA' => 1, 'USING' => 1, 'VACUUM' => 1, 'VALID' => 1, 'VALIDATOR' => 1, 'VALUE' => 1, 'VALUES' => 1, 'VARCHAR' => 1, 'VARIABLE' => 1, 'VARYING' => 1, 'VAR_POP' => 1, 'VAR_SAMP' => 1, 'VERBOSE' => 1, 'VERSION' => 1, 'VIEW' => 1, 'VOLATILE' => 1, 'WHEN' => 1, 'WHENEVER' => 1, 'WHERE' => 1, 'WHITESPACE' => 1, 'WIDTH_BUCKET' => 1, 'WINDOW' => 1, 'WITH' => 1, 'WITHIN' => 1, 'WITHOUT' => 1, 'WORK' => 1, 'WRITE' => 1, 'XML' => 1, 'XMLAGG' => 1, 'XMLATTRIBUTES' => 1, 'XMLBINARY' => 1, 'XMLCOMMENT' => 1, 'XMLCONCAT' => 1, 'XMLELEMENT' => 1, 'XMLFOREST' => 1, 'XMLNAMESPACES' => 1, 'XMLPARSE' => 1, 'XMLPI' => 1, 'XMLROOT' => 1, 'XMLSERIALIZE' => 1, 'YEAR' => 1, 'YES' => 1, 'ZONE' => 1, ); sub GetVersion { my (%opts) = @_; my $db = $opts{db}; my $result = DbGetSingleValue(db => $db, query => "SELECT version() as version"); $result =~ /PostgreSQL ([^ ]+) on/; my $ver = $1; return $ver; } sub GetMajorVersion { my (%opts) = @_; my $db = $opts{db}; my $ver = GetVersion(db => $db); $ver =~ /^(\d+\.\d+)/; my $major = $1; return $major; } sub IsKeyword { my ($keyword) = @_; if (exists($keywords{uc($keyword)})) { return 1; } # 'SELECT * FROM pg_get_keywords() WHERE word = ?', [$keyword]; return 0; } sub DbGetSingleRow { my (%opts) = @_; my $db = $opts{db}; my $query = $opts{query}; my $opts_more = $opts{opts} // {}; # If running within postgres stored procs if ( main->can('spi_exec_query') ) { return main::spi_exec_query($query)->{rows}[0]; } return (ref($db) eq 'SimpleDB4') ? $db->select($query, { singleRow => 1, enforce => 1, %$opts_more }) : $db->SelectSingleRowHash($query); } sub DbGetSingleValue { my (%opts) = @_; my $db = $opts{db}; my $query = $opts{query}; my $enforce = ($opts{enforce} ? 1 : ''); my $debug = $opts{debug}; # If running within postgres stored procs if ( main->can('spi_exec_query') ) { my $ret = main::spi_exec_query($query)->{rows}[0]; return $ret && (values(%$ret))[0]; } return (ref($db) eq 'SimpleDB4') ? $db->select($query, { singleValue => 1, enforce => $enforce, debug => $debug }) : $db->SelectSingleValue($query); } sub DbSelectHash { my (%opts) = @_; my $db = $opts{db}; my $query = $opts{query}; my $bind = $opts{bind}; # If running within postgres stored procs if ( main->can('spi_exec_query') ) { my $ret; eval { $ret = SimpleSPI::select($query, $bind, $opts{opts}); }; if ( $@ ) { Carp::croak "$@: $query"; } return $ret; } Carp::croak("DbSelectHash no db handle") if (!defined($db)); return $db->select($query, $bind, $opts{opts}); } sub GetSchemaOid { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $schema_oid = DbGetSingleValue(db => $db, query => "SELECT oid from pg_namespace WHERE nspname = '$schema'", enforce => 0); return $schema_oid; } sub SchemaExists { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $result = 0; eval { $result = GetSchemaOid(db => $db, schema => $schema); }; return ($result && ($result > 0)); } sub GetTableOid { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; my $table_oid = DbGetSingleValue(db => $db, query => " SELECT relowner FROM pg_class c JOIN pg_namespace n ON (c.relnamespace = n.oid) WHERE n.nspname = '$schema' AND relname = '$table'", enforce => 0); return $table_oid; } sub TableExists { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; if (!defined($schema)) { warn("PostgresInfo::TableExists() \$schema not defined"); return 0; } if (!defined($table)) { warn("PostgresInfo::TableExists() \$table not defined"); return 0; } my $result = 0; eval { $result = GetTableOid(db => $db, schema => $schema, table => $table); }; return ($result && ($result > 0)); } sub GetType { my (%opts) = @_; my $db = $opts{db}; my $typeId = $opts{typeId}; my $result = DbSelectHash(db => $db, query => " SELECT n.nspname as schema, t.typname as type FROM pg_type t LEFT JOIN pg_namespace n ON (t.typnamespace = n.oid) WHERE t.typelem = $typeId"); if (!$result || !scalar(@$result)) { return 'anyelement'; } $result->[0]{type} = substr($result->[0]{type}, 1); # hack off the leading _ if ($result->[0]{schema} eq 'pg_catalog') { # Built in type return 'double precision' if ($result->[0]{type} eq 'oint'); return $result->[0]{type}; } return "$result->[0]{schema}.$result->[0]{type}"; } # Options: db, schema, table # # attname = column name # # Return Example: # $VAR1 = [ # { # 'attnum' => '1', # 'relname' => 'test', # 'conname' => 'test_pkey', # 'oid' => '17648', # 'attname' => 'id', # 'conkey' => [ 1, 2 ] # }, # { # 'attnum' => '2', # 'relname' => 'test', # 'conname' => 'test_pkey', # 'oid' => '17648', # 'attname' => 'item', # 'conkey' => [ 1, 2 ] # } # ]; # sub GetPrimaryKeyInfo { my (%opts) = @_; # NOTE: Incorporated the GetSchemaOid query directly into this query # TODO: Maybe include atttypid (the type of the column) # TODO: Throws exception and quits when table has no primary key. my $pki = DbSelectHash(db => $opts{db}, query => " SELECT rel.oid, relname, c.conname, c.conkey, a.attname, a.attnum FROM pg_class rel LEFT OUTER JOIN pg_constraint c ON c.conrelid=rel.oid AND c.contype='p' INNER JOIN pg_attribute a ON (rel.oid = a.attrelid) WHERE -- r = ordinary table, i = index, S = sequence, v = view, c = composite type, t = TOAST table relkind = 'r' AND relnamespace = (SELECT oid from pg_namespace WHERE nspname = '$opts{schema}') AND relname = '$opts{table}' ORDER BY relname"); return if (!scalar(@$pki)); # pkey positions can be negative and all kinds of numbers my %keys_by_pos; foreach my $key (@$pki) { $keys_by_pos{$key->{attnum}} = $key; } my @keys; my $key_cols = $pki->[0]{conkey}; foreach my $key (@$key_cols) { push(@keys, $keys_by_pos{$key}); } return \@keys; } sub GetColumnsFromRelation { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $relation = $opts{relation}; my $hashify = $opts{hashify}; my $list = $opts{list}; my $columns = DbSelectHash(db => $db, query => " SELECT attnum, attname, atttypid::regtype, format_type(atttypid, atttypmod) FROM pg_attribute WHERE attnum > 0 AND attisdropped = false AND attrelid = '$schema.$relation'::regclass ORDER BY attnum "); if ($hashify) { return SimpleDB4::hashify_result($columns, 'attname'); } if ($list) { my $hash = SimpleDB4::hashify_result($columns, 'attname'); return keys(%$hash); } return $columns; } sub EscapeString { my ($col_data) = @_; my $export = ''; if (defined($col_data)) { my $escaped = 0; $escaped = 1 if ($col_data =~ s/\\/\\\\/g); $escaped = 1 if ($col_data =~ s/'/''/g); $export .= "'$col_data'," if (!$escaped); $export .= "E'$col_data'," if ($escaped); } else { $export .= "NULL,"; } return $export; } sub ExportDataFromRelation { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $relation = $opts{relation}; my $order = $opts{order} // ''; my $json = $opts{json} // 0; my $raw = $opts{raw} // 0; $order = qq{ORDER BY $order COLLATE "C"} if $order; my ($schema_name, $table_name) = @_; my $result = $db->select("SELECT * FROM \"${schema}\".\"${relation}\" $order"); return $result if ($raw); return JSON::to_json($result, {pretty => 1}) if ($json); return "\n" if (!scalar(@$result)); my @cols = sort keys %{$result->[0]}; my $export = "INSERT INTO \"${schema}\".\"${relation}\" (\"" . join('","', @cols) . "\") VALUES \n"; foreach my $row (@$result) { $export .= ' ('; foreach my $col_name (sort keys %$row) { my $col_data = $row->{$col_name}; if (defined($col_data)) { my $escaped = 0; $escaped = 1 if ($col_data =~ s/\\/\\\\/g); $escaped = 1 if ($col_data =~ s/'/''/g); $export .= "'$col_data'," if (!$escaped); $export .= "E'$col_data'," if ($escaped); } else { $export .= "NULL,"; } } chop($export); $export .= "),\n"; } chop($export); chop($export); $export .= ";\n\n"; return $export; } sub FunctionExists { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $func_name = $opts{func_name}; my $found = GetFunctionsFromSchema(db => $db, schema => $schema, func_name => $func_name); return (scalar(@$found) > 0); } sub GetTriggersFromSchema { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; my $name = $opts{trigger_name}; my $extra = ''; my $ver = GetMajorVersion(db => $db); if ($ver eq '8.4') { if ($schema) { $extra .= "AND (n.nspname = '$schema')"; } if ($table) { $extra .= " AND (c.relname = '$table')"; } if ($name) { $extra .= "AND (pr.proname = '$name')"; } my $triggers = DbSelectHash(db => $db, query => " SELECT t.oid, (current_database())::information_schema.sql_identifier AS trigger_catalog, (n.nspname)::information_schema.sql_identifier AS trigger_schema, (t.tgname)::information_schema.sql_identifier AS trigger_name, (pr.proname)::information_schema.sql_identifier AS trigger_function_name, (prons.nspname)::information_schema.sql_identifier AS trigger_function_schema, (em.text)::information_schema.character_data AS event_manipulation, (current_database())::information_schema.sql_identifier AS event_object_catalog, (n.nspname)::information_schema.sql_identifier AS event_object_schema, (c.relname)::information_schema.sql_identifier AS event_object_table, (NULL::information_schema.cardinal_number)::information_schema.cardinal_number AS action_order, (NULL::information_schema.character_data)::information_schema.character_data AS action_condition, ( \"substring\"(pg_get_triggerdef(t.oid), (\"position\"(\"substring\"(pg_get_triggerdef(t.oid), 48),'EXECUTE PROCEDURE'::text) + 47)) )::information_schema.character_data AS action_statement, (CASE WHEN (((t.tgtype)::integer & 1) = 1) THEN 'ROW'::text ELSE 'STATEMENT'::text END)::information_schema.character_data AS action_orientation, (CASE WHEN (((t.tgtype)::integer & 2) = 2) THEN 'BEFORE'::text ELSE 'AFTER'::text END)::information_schema.character_data AS condition_timing, (NULL::information_schema.sql_identifier)::information_schema.sql_identifier AS condition_reference_old_table, (NULL::information_schema.sql_identifier)::information_schema.sql_identifier AS condition_reference_new_table, obj_description(t.oid), t.tgenabled FROM pg_namespace n, pg_class c, pg_trigger t JOIN pg_proc pr ON t.tgfoid = pr.oid JOIN pg_namespace prons ON prons.oid = pr.pronamespace, pg_user u, ((SELECT 4, 'INSERT' UNION ALL SELECT 8, 'DELETE') UNION ALL SELECT 16, 'UPDATE') em(num, text) WHERE (n.oid = c.relnamespace) AND (c.oid = t.tgrelid) AND (c.relowner = u.usesysid) AND (((t.tgtype)::integer & em.num) <> 0) AND (NOT t.tgisconstraint) AND NOT (prons.nspname LIKE 'pg_%') AND (prons.nspname != 'information_schema') $extra ORDER BY trigger_schema, event_object_table, trigger_name, trigger_function_name, trigger_def"); return $triggers; } if ($schema) { $extra .= "AND (n.nspname = '$schema')"; } if ($table) { $extra .= " AND (c.relname = '$table')"; } if ($name) { $extra .= "AND (pr.proname = '$name')"; } my $triggers = DbSelectHash(db => $db, query => qq{ WITH data as ( SELECT t.oid, pg_catalog.pg_get_triggerdef(t.oid) as trigger_def, (n.nspname)::information_schema.sql_identifier AS trigger_schema, (t.tgname)::information_schema.sql_identifier AS trigger_name, (pr.proname)::information_schema.sql_identifier AS trigger_function_name, (prons.nspname)::information_schema.sql_identifier AS trigger_function_schema, (current_database())::information_schema.sql_identifier AS event_object_catalog, (n.nspname)::information_schema.sql_identifier AS event_object_schema, (c.relname)::information_schema.sql_identifier AS event_object_table, obj_description(t.oid), t.tgenabled FROM pg_namespace n, pg_class c, pg_trigger t JOIN pg_proc pr ON t.tgfoid = pr.oid JOIN pg_namespace prons ON prons.oid = pr.pronamespace, pg_user u WHERE (n.oid = c.relnamespace) AND (c.oid = t.tgrelid) AND (c.relowner = u.usesysid) AND NOT (prons.nspname LIKE 'pg_%') AND (prons.nspname != 'information_schema') $extra ) SELECT * FROM data ORDER BY trigger_schema COLLATE "C", event_object_table COLLATE "C", trigger_name COLLATE "C", trigger_function_name COLLATE "C", trigger_def COLLATE "C"}); foreach my $trg (@$triggers) { # Backwards compat to avoid excessive diffing # Note: Postgres 12+ exports triggers with EXECUTE FUNCTION, but this CREATE TRIGGER syntax will not work on less than PG 12 # But, EXECUTE PROCEDURE is forwards-compatible with 12+ $trg->{trigger_def} =~ s/EXECUTE FUNCTION/EXECUTE PROCEDURE/g; } return $triggers; } sub GetViewsFromSchema { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $view = $opts{view}; # specify a single view to get my $hashify = $opts{hashify}; my $extra = ''; $opts{singleRow} = 1 if ($opts{singleView}); if ($schema) { # my $schema_oid = GetSchemaOid(db => $db, schema => $schema); # if (!defined($schema_oid) || ($schema_oid eq '')) { # return []; # } # # $extra .= "AND relnamespace = ${schema_oid}::oid" $extra .= "AND nsp.nspname = '$schema'"; } if ($view) { $extra .= "AND c.relname LIKE '$view'"; } my $views = DbSelectHash(db => $db, query => " SELECT c.oid, c.xmin, c.relname, pg_get_userbyid(c.relowner) AS viewowner, c.relacl, description, pg_get_viewdef(c.oid, true) AS definition, nsp.nspname FROM pg_class c LEFT OUTER JOIN pg_description des ON (des.objoid=c.oid and des.objsubid=0) JOIN pg_namespace nsp ON (c.relnamespace = nsp.oid) WHERE nsp.nspname != 'information_schema' AND nsp.nspname NOT LIKE 'pg_%' AND ( (c.relhasrules AND EXISTS ( SELECT r.rulename FROM pg_rewrite r WHERE (r.ev_class = c.oid) AND (bpchar(r.ev_type) = '1'::bpchar) ) ) OR c.relkind = 'v'::char ) $extra ORDER BY c.relname ", opts => \%opts ); if ($hashify) { return SimpleDB4::hashify_result($views, 'relname'); } return $views; } ## # Given a view, what views use it? # sub ViewGetDependentViews { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $view = $opts{view}; # view to check (can take any valid LIKE query ie: wildcards %) my $hashify = $opts{hashify}; my $views; goto done if (!ViewExists(db => $db, schema => $schema, view => $view)); $views = DbSelectHash(db => $db, query => qq{ SELECT DISTINCT v.oid::regclass AS view FROM pg_depend AS d -- objects that depend on the table JOIN pg_rewrite AS r ON r.oid = d.objid -- rules depending on the table JOIN pg_class AS v ON v.oid = r.ev_class -- views for the rules WHERE v.relkind = 'v' -- only interested in views -- dependency must be a rule depending on a relation AND d.classid = 'pg_rewrite'::regclass AND d.refclassid = 'pg_class'::regclass AND d.deptype = 'n' -- normal dependency AND d.refobjid = (? || '.' || ?)::regclass AND v.oid::regclass != (? || '.' || ?)::regclass -- Not us! We only want dependent views }, bind => [qq{"$schema"}, qq{"$view"}, qq{"$schema"}, qq{"$view"}], opts => {debug => 0} ); done: if ($hashify) { return SimpleDB4::hashify_result($views, 'view'); } return $views; } ## # Given a view, what views does it use for itself? # sub ViewGetViewsReferenced { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $view = $opts{view}; # view to check (can take any valid LIKE query ie: wildcards %) my $hashify = $opts{hashify}; my $views; goto done if (!ViewExists(db => $db, schema => $schema, view => $view)); $views = DbSelectHash(db => $db, query => qq{ SELECT DISTINCT d.refobjid::regclass as dep FROM pg_depend d JOIN pg_rewrite r ON (r.oid = d.objid) JOIN pg_class v ON (v.oid = r.ev_class) JOIN pg_class dv ON (d.refobjid = dv.oid) JOIN pg_namespace nsp ON (dv.relnamespace = nsp.oid) WHERE dv.relkind = 'v' -- only interested in views AND d.classid = 'pg_rewrite'::regclass AND d.refclassid = 'pg_class'::regclass AND d.deptype = 'n' -- normal dependency AND v.oid = (? || '.' || ?)::regclass AND d.refobjid::regclass != (? || '.' || ?)::regclass -- Not us! We only want dependent views AND nsp.nspname != 'pg_catalog' -- We only care about user-defined dependencies not build-in postgres views like pg_catalog.pg_user }, bind => [qq{"$schema"}, qq{"$view"}, qq{"$schema"}, qq{"$view"}], opts => {debug => 0} ); done: if ($hashify) { return SimpleDB4::hashify_result($views, 'view'); } return $views; } sub ViewExists { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $view = $opts{view}; # view to check (can take any valid LIKE query ie: wildcards %) my $views = GetViewsFromSchema(db => $db, schema => $schema, view => $view); return scalar(@$views) ? 1 : 0; } ## # Get all queries that are currently processing. # This will skip showing connected sessions that are not currently executing a query # # opts # where - Extra condition to add to the SELECT FROM pg_stat_activity # apps - Only return queries that match this application_name in pg_stat_activity # sub GetAllRunningQueries { my (%opts) = @_; my $db = $opts{db}; my $where = $opts{where} // ''; my $count = $opts{count} // 0; my $apps = $opts{apps} // []; my $version = '8.4'; my $version_info = $db->select("SELECT version()", {singleValue => 1}); if ($version_info =~ /^PostgreSQL ([\d\.]+) on/) { $version = $1; } if (scalar(@$apps)) { my $apps_list = join("','", @$apps); $where = "application_name IN ('$apps_list')"; } my $gt_9_6 = Sort::Versions::versioncmp($version, '9.6'); # returns 1 if our version > 9.6 if ($version eq '9.6' || ($gt_9_6 == 1)) { # Only >= 9.6 if ($where) { $where =~ s/{current_query}/query/g; $where = "AND $where"; } if ($count) { return $db->select(" SELECT count(*) FROM pg_stat_activity WHERE query != '' AND pid != pg_backend_pid() AND state != 'idle' $where ", {singleValue => 1}); } return $db->select(" SELECT pid, application_name, state_change, xact_start, query_start, NOW() - query_start as query_duration, wait_event, wait_event_type, client_addr, datname, usename, query, (now()-query_start)::interval(0) as query_duration FROM pg_stat_activity WHERE query != '' AND pid != pg_backend_pid() AND state != 'idle' $where ORDER BY state_change, (now()-query_start)::interval(0) ", {debug => 0}); } my $gt_9_2 = Sort::Versions::versioncmp($version, '9.2'); # returns 1 if our version > 9.2 if ($version eq '9.2' || ($gt_9_2 == 1)) { # Only >= 9.2 if ($where) { $where =~ s/{current_query}/query/g; $where = "AND $where"; } if ($count) { return $db->select(" SELECT count(*) FROM pg_stat_activity WHERE query != '' AND pid != pg_backend_pid() AND state != 'idle' $where ", {singleValue => 1}); } return $db->select(" SELECT pid, waiting, client_addr, datname, usename, query, xact_start, query_start, (now()-query_start)::interval(0) as query_duration FROM pg_stat_activity WHERE query != '' AND pid != pg_backend_pid() AND state != 'idle' $where ORDER BY waiting, (now()-query_start)::interval(0) "); } if ($where) { $where =~ s/{current_query}/current_query/g; $where = "AND $where"; } if ($count) { return $db->select(" SELECT count(*) FROM pg_stat_activity WHERE current_query != '' AND procpid != pg_backend_pid() $where ORDER BY xact_start ", {singleValue => 1}); } return $db->select(" SELECT procpid, waiting, client_addr, datname, usename, current_query as query, xact_start, query_start, (now()-query_start)::interval(0) as query_duration FROM pg_stat_activity WHERE current_query != '' AND procpid != pg_backend_pid() $where ORDER BY waiting, xact_start "); } sub GetAllFunctionNames { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $func = $opts{func_name}; # view to check (can take any valid LIKE query ie: wildcards %) my $extra = ''; $extra .= " AND (na.nspname = '$schema')" if defined($schema); $extra .= " AND (pr.proname = '$func')" if defined($func); my $functions; my $ver = GetVersion(db => $db); my $gt_11 = Sort::Versions::versioncmp($ver, '11'); # returns 1 if our version > 11 if (($gt_11 >= 0)) { $functions = DbSelectHash(db => $db, query => " SELECT (na.nspname || '.' || pr.proname) AS func_name FROM pg_proc pr JOIN pg_namespace na ON na.oid = pr.pronamespace WHERE NOT (na.nspname LIKE 'pg_%') AND (na.nspname != 'information_schema') AND (pr.prokind != 'a') $extra GROUP BY na.nspname,pr.proname ORDER BY na.nspname, pr.proname ", opts => {debug => 0}); } else { $functions = DbSelectHash(db => $db, query => " SELECT (na.nspname || '.' || pr.proname) AS func_name FROM pg_proc pr JOIN pg_namespace na ON na.oid = pr.pronamespace WHERE NOT (na.nspname LIKE 'pg_%') AND (na.nspname != 'information_schema') AND (pr.proisagg = FALSE) $extra GROUP BY na.nspname,pr.proname ORDER BY na.nspname, pr.proname ", opts => {debug => 0}); } return return_array_hash_helper(\%opts, $functions, 'func_name'); } sub GetFunctionsFromSchema { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $func_name = $opts{func_name}; my $extra = ''; if ($schema) { my $schema_oid = GetSchemaOid(db => $db, schema => $schema); if (!defined($schema_oid) || ($schema_oid eq '')) { return []; } $extra .= "AND pronamespace = ${schema_oid}::oid" } if ($func_name) { $extra .= " AND proname = '$func_name'"; } my $funcs; my $ver = GetVersion(db => $db); my $gt_11 = Sort::Versions::versioncmp($ver, '11'); # returns 1 if our version > 11 if ($gt_11 >= 0 ) { $funcs = DbSelectHash(db => $db, query => " SELECT pns.nspname, pr.oid, pr.xmin, quote_ident(pr.proname) as proname_quoted, -- If the function name needs to be quoted pr.proname, pr.*, format_type(TYP.oid, NULL) AS typname, typns.nspname AS typnsp, lanname, proargnames, proargtypes, proconfig, pg_get_userbyid(proowner) as funcowner, description, pg_catalog.pg_get_functiondef(pr.oid) || ';' as function_def, pg_catalog.pg_get_function_result(pr.oid) as return_signature, pg_catalog.pg_get_function_arguments(pr.oid) as function_arguments, pg_catalog.pg_get_function_arguments(pr.oid) as args_types_list, -- for backwards compatability pg_catalog.pg_get_function_arguments(pr.oid) as full_args -- for backwards compatability FROM pg_proc pr JOIN pg_type typ ON typ.oid=prorettype JOIN pg_namespace typns ON typns.oid=typ.typnamespace JOIN pg_language lng ON lng.oid=prolang LEFT OUTER JOIN pg_description des ON des.objoid=pr.oid LEFT JOIN pg_namespace pns ON (pr.pronamespace = pns.oid) WHERE prokind != 'a' AND pns.nspname NOT LIKE 'pg_%' AND pns.nspname NOT LIKE 'information_schema' $extra ORDER BY pns.nspname, pr.proname, pg_catalog.pg_get_function_result(pr.oid)"); # the 3rd item is the function_signature includes args } else { $funcs = DbSelectHash(db => $db, query => " SELECT pns.nspname, pr.oid, pr.xmin, quote_ident(pr.proname) as proname_quoted, -- If the function name needs to be quoted pr.proname, pr.*, format_type(TYP.oid, NULL) AS typname, typns.nspname AS typnsp, lanname, proargnames, proargtypes, proconfig, pg_get_userbyid(proowner) as funcowner, description, pg_catalog.pg_get_functiondef(pr.oid) || ';' as function_def, pg_catalog.pg_get_function_result(pr.oid) as return_signature, pg_catalog.pg_get_function_arguments(pr.oid) as function_arguments, pg_catalog.pg_get_function_arguments(pr.oid) as args_types_list, -- for backwards compatability pg_catalog.pg_get_function_arguments(pr.oid) as full_args -- for backwards compatability FROM pg_proc pr JOIN pg_type typ ON typ.oid=prorettype JOIN pg_namespace typns ON typns.oid=typ.typnamespace JOIN pg_language lng ON lng.oid=prolang LEFT OUTER JOIN pg_description des ON des.objoid=pr.oid LEFT JOIN pg_namespace pns ON (pr.pronamespace = pns.oid) WHERE proisagg = FALSE AND pns.nspname NOT LIKE 'pg_%' AND pns.nspname NOT LIKE 'information_schema' $extra ORDER BY pns.nspname, pr.proname, pg_catalog.pg_get_function_result(pr.oid)"); # the 3rd item is the function_signature includes args } foreach my $func (@$funcs) { ####################################################################### # See: http://www.postgresql.org/docs/8.4/static/catalog-pg-proc.html # ####################################################################### my $args = ''; my $num_function_arguments = $func->{pronargs}; my $num_total_types = defined($func->{proallargtypes}) ? scalar(@{$func->{proallargtypes}}) : $num_function_arguments; my $num_output_arguments = $num_total_types - $num_function_arguments; ########################## # Process Output Arguments if ($func->{proretset}) { $func->{typname} = "SETOF $func->{typname}"; } my $return_type = $func->{typname}; # If this function returns an in-line defined set (RETURNS TABLE) if ($num_output_arguments) { my @return_types; # Skip past the function arguments, and start at the return for (my $i = $num_function_arguments; $i < $num_total_types; $i++) { my $arg_name = $func->{proargnames}[$i]; my $type_id = $func->{proallargtypes}[$i]; push(@return_types, "\"$arg_name\" " . GetType(db => $db, typeId => $type_id)); } $return_type = 'TABLE (' . join(',', @return_types) . ')'; } ############### # if ($func->{typname} eq 'opaque') { $func->{function_body} = "'$func->{probin}', '$func->{prosrc}'"; next; } else { $func->{function_body} = "\$BODY\$$func->{prosrc}\$BODY\$"; } my $volatility = 'VOLATILE'; if ($func->{provolatile} eq 'i') { $volatility = 'IMMUTABLE'; } elsif ($func->{provolatile} eq 's') { $volatility = 'STABLE'; } $func->{function_signature} = "\"$func->{nspname}\".\"$func->{proname}\"($func->{function_arguments})"; $func->{func_schema} = $func->{nspname}; my $inner_proto_body = ''; if ($func->{lanname} eq 'plpgsql') { if ($return_type ne 'void') { $inner_proto_body = 'BEGIN RETURN NULL; END;'; } else { $inner_proto_body = 'BEGIN RETURN; END;'; } } $func->{function_proto} = "CREATE OR REPLACE FUNCTION $func->{function_signature} "; $func->{function_proto} .= "RETURNS $func->{return_signature} AS \$BODY\$${inner_proto_body}\$BODY\$\n"; $func->{function_proto} .= " LANGUAGE '$func->{lanname}' $volatility\n"; $func->{function_proto} .= " ROWS $func->{prorows}\n" if $func->{prorows}; $func->{function_proto} .= " COST $func->{procost};\n"; $func->{function_proto} .= "ALTER FUNCTION $func->{function_signature} OWNER TO $func->{funcowner};"; $func->{function_sql} = "$func->{function_def}\n"; $func->{function_sql} .= "ALTER FUNCTION $func->{function_signature} OWNER TO $func->{funcowner};\n"; $func->{function_sql} .= "COMMENT ON FUNCTION $func->{function_signature} IS \$DESC\$$func->{description}\$DESC\$;\n" if ($func->{description}); } @$funcs = sort {$a->{function_signature} cmp $b->{function_signature}} @$funcs; return $funcs; } sub GetTriggerFunctionsFromSchema { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $additional_where = ''; my $schema_oid = GetSchemaOid(db => $db, schema => $schema); if (!defined($schema_oid) || ($schema_oid eq '')) { return (); } my $trigger_funcs; my $ver = GetVersion(db => $db); my $gt_11 = Sort::Versions::versioncmp($ver, '11'); # returns 1 if our version > 11 if ($gt_11 >= 0) { $trigger_funcs = DbSelectHash(db => $db, query => " SELECT pr.oid, pr.xmin, pr.*, quote_ident(pr.proname) as proname_quoted, -- If the function name needs to be quoted format_type(TYP.oid, NULL) AS typname, typns.nspname AS typnsp, lanname, proargnames, proconfig, pg_get_userbyid(proowner) as funcowner, description FROM pg_proc pr JOIN pg_type typ ON typ.oid=prorettype JOIN pg_namespace typns ON typns.oid=typ.typnamespace JOIN pg_language lng ON lng.oid=prolang LEFT OUTER JOIN pg_description des ON des.objoid=pr.oid WHERE pr.prokind != 'a' AND pronamespace = ${schema_oid}::oid AND typname = 'trigger' AND lanname != 'edbspl' ORDER BY proname"); } else { $trigger_funcs = DbSelectHash(db => $db, query => " SELECT pr.oid, pr.xmin, pr.*, quote_ident(pr.proname) as proname_quoted, -- If the function name needs to be quoted format_type(TYP.oid, NULL) AS typname, typns.nspname AS typnsp, lanname, proargnames, proconfig, pg_get_userbyid(proowner) as funcowner, description FROM pg_proc pr JOIN pg_type typ ON typ.oid=prorettype JOIN pg_namespace typns ON typns.oid=typ.typnamespace JOIN pg_language lng ON lng.oid=prolang LEFT OUTER JOIN pg_description des ON des.objoid=pr.oid WHERE proisagg = FALSE AND pronamespace = ${schema_oid}::oid AND typname = 'trigger' AND lanname != 'edbspl' ORDER BY proname"); } return $trigger_funcs; } sub GetAllAggregatesDetail { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $extra = ''; if (defined($schema)) { $extra = "AND ag.aggfnoid::text LIKE '$schema.%' OR ag.aggfnoid::text LIKE '\"$schema\".%'"; } my $agg_funcs = DbSelectHash(db => $db, query => " SELECT ag.aggfnoid AS fullname, aggfnoid::oid, proname AS aggname, pg_get_userbyid(proowner) AS aggowner, aggtransfn, aggfinalfn, proargtypes, aggtranstype, CASE WHEN (tt.typlen = -1 AND tt.typelem != 0) THEN (SELECT at.typname FROM pg_type at WHERE at.oid = tt.typelem) || '[]' ELSE tt.typname END as transname, prorettype AS aggfinaltype, CASE WHEN (tf.typlen = -1 AND tf.typelem != 0) THEN (SELECT at.typname FROM pg_type at WHERE at.oid = tf.typelem) || '[]' ELSE tf.typname END as finalname, agginitval, description, oprname, opn.nspname as oprnsp, pg_catalog.pg_get_function_arguments(pr.oid) as function_arguments, pg_catalog.pg_get_function_arguments(pr.oid) as args_types_list, -- for backwards compatability pg_catalog.pg_get_function_arguments(pr.oid) as full_args -- for backwards compatability FROM pg_aggregate ag LEFT OUTER JOIN pg_operator op ON op.oid=aggsortop LEFT OUTER JOIN pg_namespace opn ON opn.oid=op.oprnamespace JOIN pg_proc pr ON pr.oid = ag.aggfnoid JOIN pg_type tt on tt.oid=aggtranstype JOIN pg_type tf on tf.oid=prorettype LEFT OUTER JOIN pg_description des ON des.objoid=aggfnoid::oid WHERE ag.aggfnoid::text NOT LIKE 'pg_%' AND pg_get_userbyid(proowner) != 'postgres' $extra ORDER BY aggname"); return $agg_funcs; } sub GetDependenciesForOid { my (%opts) = @_; my $db = $opts{db}; my $oid = $opts{oid}; my $deps = DbSelectHash(db => $db, query => " SELECT DISTINCT dep.deptype, dep.classid, cl.relkind, ad.adbin, CASE WHEN cl.relkind IS NOT NULL THEN cl.relkind || COALESCE(dep.objsubid::text, '') WHEN tg.oid IS NOT NULL THEN 'T'::text WHEN ty.oid IS NOT NULL THEN 'y'::text WHEN ns.oid IS NOT NULL THEN 'n'::text WHEN pr.oid IS NOT NULL THEN 'p'::text WHEN la.oid IS NOT NULL THEN 'l'::text WHEN rw.oid IS NOT NULL THEN 'R'::text WHEN co.oid IS NOT NULL THEN 'C'::text || contype WHEN ad.oid IS NOT NULL THEN 'A'::text WHEN fs.oid IS NOT NULL THEN 'F'::text WHEN fdw.oid IS NOT NULL THEN 'f'::text ELSE '' END AS type, COALESCE(coc.relname, clrw.relname) AS ownertable, CASE WHEN cl.relname IS NOT NULL AND att.attname IS NOT NULL THEN cl.relname || '.' || att.attname ELSE COALESCE(cl.relname, co.conname, pr.proname, tg.tgname, ty.typname, la.lanname, rw.rulename, ns.nspname, fs.srvname, fdw.fdwname) END AS refname, COALESCE(nsc.nspname, nso.nspname, nsp.nspname, nst.nspname, nsrw.nspname) AS nspname FROM pg_depend dep LEFT JOIN pg_class cl ON dep.objid=cl.oid LEFT JOIN pg_attribute att ON dep.objid=att.attrelid AND dep.objsubid=att.attnum LEFT JOIN pg_namespace nsc ON cl.relnamespace=nsc.oid LEFT JOIN pg_proc pr ON dep.objid=pr.oid LEFT JOIN pg_namespace nsp ON pr.pronamespace=nsp.oid LEFT JOIN pg_trigger tg ON dep.objid=tg.oid LEFT JOIN pg_type ty ON dep.objid=ty.oid LEFT JOIN pg_namespace nst ON ty.typnamespace=nst.oid LEFT JOIN pg_constraint co ON dep.objid=co.oid LEFT JOIN pg_class coc ON co.conrelid=coc.oid LEFT JOIN pg_namespace nso ON co.connamespace=nso.oid LEFT JOIN pg_rewrite rw ON dep.objid=rw.oid LEFT JOIN pg_class clrw ON clrw.oid=rw.ev_class LEFT JOIN pg_namespace nsrw ON clrw.relnamespace=nsrw.oid LEFT JOIN pg_language la ON dep.objid=la.oid LEFT JOIN pg_namespace ns ON dep.objid=ns.oid LEFT JOIN pg_attrdef ad ON ad.oid=dep.objid LEFT JOIN pg_foreign_server fs ON fs.oid=dep.objid LEFT JOIN pg_foreign_data_wrapper fdw ON fdw.oid=dep.objid WHERE dep.refobjid = ${oid}::oid AND classid IN ( SELECT oid FROM pg_class WHERE relname IN ('pg_class', 'pg_constraint', 'pg_conversion', 'pg_language', 'pg_proc', 'pg_rewrite', 'pg_namespace', 'pg_trigger', 'pg_type', 'pg_attrdef', 'pg_event_trigger', 'pg_foreign_server', 'pg_foreign_data_wrapper')) ORDER BY classid, cl.relkind" ); # print Dumper($deps); # my @additional_deps; # # foreach my $dep (@$deps) { # next if (!$dep->{oid}); # # my $new_deps = GetDependenciesForOid(db => $db, oid => $dep->{oid}); # # push(@additional_deps, @$new_deps); # } # # push(@$deps, @additional_deps); return $deps; } # Get databases along with some info and sizes # sub GetDatabases { my (%opts) = @_; my $db = $opts{db}; my $result = DbSelectHash(db => $db, query => " SELECT db.oid, datname, db.dattablespace AS spcoid, spcname, db.datcollate, db.datctype, db.datconnlimit, datallowconn, datconfig, datacl, pg_encoding_to_char(encoding) AS serverencoding, pg_get_userbyid(datdba) AS datowner, has_database_privilege(db.oid, 'CREATE') as cancreate, current_setting('default_tablespace') AS default_tablespace, db.datname, pg_database_size(db.datname) as db_size, pg_size_pretty(pg_database_size(db.datname)) AS db_size_formatted, des.description FROM pg_database db LEFT OUTER JOIN pg_tablespace ta ON (db.dattablespace = ta.OID) LEFT OUTER JOIN pg_shdescription des ON des.objoid=db.oid ORDER BY db.datname"); return $result; } # Options: db sub GetSchemas { my (%opts) = @_; my $result = DbSelectHash(db => $opts{db}, query => " SELECT schema_name FROM information_schema.schemata WHERE (NOT schema_name LIKE 'pg_%') AND (schema_name != 'information_schema') ORDER BY schema_name "); return return_array_hash_helper(\%opts, $result, 'schema_name'); } ## # Get all relations in a schema # # Note: this also returns VIEWS # # Options: db, schema # This returns views as well # sub GetTables { my (%opts) = @_; my $additional_where = ''; if ($opts{views_only}) { $additional_where = " AND table_type != 'BASE TABLE'"; } if ($opts{like}) { $additional_where = " AND table_name LIKE '$opts{like}'"; } my $result = DbSelectHash(db => $opts{db}, query => " SELECT table_name FROM information_schema.tables WHERE table_schema = '$opts{schema}' $additional_where ORDER BY table_name "); return return_array_hash_helper(\%opts, $result, 'table_name'); } ## # Get all tables in a scema # # Note: this only returns real tables # # Returns an array or hash of 'schema.table' items. # # Options: db, schema(optional) # sub GetAllTables { my (%opts) = @_; my $schema = $opts{schema}; my $table = $opts{table}; my $filter_table = $opts{filter_table}; my $extra = ''; my $additional_select = ''; if (defined($schema)) { $extra .= " AND (table_schema = '$schema')"; } if (defined($table)) { $extra .= " AND (table_name = '$table')"; } if ($opts{split_table_schema}) { $additional_select = ", table_schema, table_name"; } if ($filter_table) { $extra .= " AND table_name LIKE '$filter_table'"; } my $result = DbSelectHash(db => $opts{db}, query => " SELECT (table_schema || '.' || table_name) AS schema_table $additional_select FROM information_schema.tables WHERE (NOT table_schema LIKE 'pg_%') AND (table_schema != 'information_schema') AND table_type = 'BASE TABLE' $extra ORDER BY table_schema, table_name "); return return_array_hash_helper(\%opts, $result, 'schema_table'); } # Options: db, schema, table (required for now) # TODO: Make this general and accept no value for schema and table, thus populating a hash similar to other functions in PostgresInfo sub GetTableInfo { my (%opts) = @_; my $schema = $opts{schema}; my $table = $opts{table}; my $extra = ''; $extra .= " AND na.nspname = '$schema'" if defined($schema); $extra .= " AND rel.relname = '$table'" if defined($table); my $result = DbSelectHash(db => $opts{db}, query => " SELECT rel.oid, relname, na.nspname, relnamespace, rel.reltablespace AS spcoid, spcname, pg_get_userbyid(relowner) AS relowner, relacl, -- relhasoids, -- TODO: This field is not available in pg12 relhassubclass, reltuples, description, conname, conkey, EXISTS( SELECT 1 FROM pg_trigger JOIN pg_proc pt ON pt.oid=tgfoid AND pt.proname='logtrigger' JOIN pg_proc pc ON pc.pronamespace=pt.pronamespace AND pc.proname='slonyversion' WHERE tgrelid=rel.oid ) AS isrepl, substring(array_to_string(rel.reloptions, ',') from 'fillfactor=([0-9]*)') AS fillfactor, substring(array_to_string(rel.reloptions, ',') FROM 'autovacuum_enabled=([a-z|0-9]*)') AS autovacuum_enabled, substring(array_to_string(rel.reloptions, ',') FROM 'autovacuum_vacuum_threshold=([0-9]*)') AS autovacuum_vacuum_threshold, substring(array_to_string(rel.reloptions, ',') FROM 'autovacuum_vacuum_scale_factor=([0-9]*[.][0-9]*)') AS autovacuum_vacuum_scale_factor, substring(array_to_string(rel.reloptions, ',') FROM 'autovacuum_analyze_threshold=([0-9]*)') AS autovacuum_analyze_threshold, substring(array_to_string(rel.reloptions, ',') FROM 'autovacuum_analyze_scale_factor=([0-9]*[.][0-9]*)') AS autovacuum_analyze_scale_factor, substring(array_to_string(rel.reloptions, ',') FROM 'autovacuum_vacuum_cost_delay=([0-9]*)') AS autovacuum_vacuum_cost_delay, substring(array_to_string(rel.reloptions, ',') FROM 'autovacuum_vacuum_cost_limit=([0-9]*)') AS autovacuum_vacuum_cost_limit, substring(array_to_string(rel.reloptions, ',') FROM 'autovacuum_freeze_min_age=([0-9]*)') AS autovacuum_freeze_min_age, substring(array_to_string(rel.reloptions, ',') FROM 'autovacuum_freeze_max_age=([0-9]*)') AS autovacuum_freeze_max_age, substring(array_to_string(rel.reloptions, ',') FROM 'autovacuum_freeze_table_age=([0-9]*)') AS autovacuum_freeze_table_age, rel.reloptions AS reloptions, ( CASE WHEN rel.reltoastrelid = 0 THEN false ELSE true END ) AS hastoasttable FROM pg_class rel LEFT OUTER JOIN pg_tablespace ta on ta.oid=rel.reltablespace LEFT OUTER JOIN pg_namespace na on na.oid = rel.relnamespace LEFT OUTER JOIN pg_description des ON (des.objoid=rel.oid AND des.objsubid=0) LEFT OUTER JOIN pg_constraint c ON c.conrelid=rel.oid AND c.contype='p' WHERE relkind IN ('r','s','t') $extra ORDER BY na.nspname,rel.relname"); return $result; } # Options: db, schema, table sub GetColumnNames { my (%opts) = @_; my $result = DbSelectHash(db => $opts{db}, query => " SELECT a.attname as column_name FROM pg_class rel INNER JOIN pg_attribute a ON (rel.oid = a.attrelid) WHERE -- r = ordinary table, i = index, S = sequence, v = view, c = composite type, t = TOAST table relkind = 'r' AND relnamespace = (SELECT oid from pg_namespace WHERE nspname = '$opts{schema}') AND relname = '$opts{table}' AND attnum > 0 ORDER BY attnum "); return return_array_hash_helper(\%opts, $result, 'column_name'); } # This fn helps query functions which return exactly 1 column # in order to nicely return the exact data that you want, either # condensed array, or condensed hash or the unmodified select hash result sub return_array_hash_helper { my ($subOpts, $sqlResult, $keyName) = @_; # New data # [ 'value1', 'value2' ] if ( $subOpts->{array} ) { return [ map { $_->{$keyName} } @$sqlResult ]; } # New data # { value1 => 1, value2 => 1 } if ( $subOpts->{hash} ) { return { map { ($_->{$keyName} => 1) } @$sqlResult }; } # Original data # [ {$keyName => 'value1'}, {$keyName => 'value2'}] return $sqlResult; } ################################### # Mass Exports sub GetAllCastsDetail { my (%opts) = @_; my $result = DbSelectHash(db => $opts{db}, query => " SELECT ca.oid, ca.*, format_type(st.oid,NULL) AS srctyp, format_type(tt.oid,tt.typtypmod) AS trgtyp, ns.nspname AS srcnspname, nt.nspname AS trgnspname, proname, np.nspname AS pronspname, description FROM pg_cast ca JOIN pg_type st ON st.oid=castsource JOIN pg_namespace ns ON ns.oid=st.typnamespace JOIN pg_type tt ON tt.oid=casttarget JOIN pg_namespace nt ON nt.oid=tt.typnamespace LEFT JOIN pg_proc pr ON pr.oid=castfunc LEFT JOIN pg_namespace np ON np.oid=pr.pronamespace LEFT OUTER JOIN pg_description des ON des.objoid=ca.oid AND des.objsubid=0 WHERE nt.nspname != 'pg_catalog' ORDER BY st.typname, tt.typname"); return $result; } sub GetAllLanguagesDetail { my (%opts) = @_; my $result = DbSelectHash(db => $opts{db}, query => " SELECT lan.oid, lan.lanname, lanpltrusted, lan.lanispl, lanacl, hp.proname as lanproc, vp.proname as lanval, description, pg_get_userbyid(lan.lanowner) as languageowner FROM pg_language lan JOIN pg_proc hp on hp.oid=lanplcallfoid LEFT OUTER JOIN pg_proc vp on vp.oid=lanvalidator LEFT OUTER JOIN pg_description des ON des.objoid=lan.oid AND des.objsubid=0 WHERE lanispl IS TRUE ORDER BY lanname"); return $result; } # ACL data (ex: nspacl) # rolename=xxxx -- privileges granted to a role # =xxxx -- privileges granted to PUBLIC # # r -- SELECT ("read") # w -- UPDATE ("write") # a -- INSERT ("append") # d -- DELETE # D -- TRUNCATE # x -- REFERENCES # t -- TRIGGER # X -- EXECUTE # U -- USAGE # C -- CREATE # c -- CONNECT # T -- TEMPORARY # arwdDxt -- ALL PRIVILEGES (for tables, varies for other objects) # * -- grant option for preceding privilege # # /yyyy -- role that granted this privilege # # rolename=priv/who_granted # # Example: pbx_manager=U/root sub GetAllSchemaDetail { my (%opts) = @_; my $schema = $opts{schema}; my $extra = ''; $extra .= " AND nsp.nspname = '$schema'" if defined($schema); my $result = DbSelectHash(db => $opts{db}, query => " SELECT CASE WHEN nspname LIKE E'pg\\_temp\\_%' THEN 1 WHEN (nspname LIKE E'pg\\_%') THEN 0 ELSE 3 END AS nsptyp, nsp.nspname, nsp.oid, pg_get_userbyid(nspowner) AS namespaceowner, nspacl, description, has_schema_privilege(nsp.oid, 'CREATE') as cancreate FROM pg_namespace nsp LEFT OUTER JOIN pg_description des ON des.objoid=nsp.oid WHERE NOT ( (nspname = 'pg_catalog' AND EXISTS (SELECT 1 FROM pg_class WHERE relname = 'pg_class' AND relnamespace = nsp.oid LIMIT 1)) OR (nspname = 'pgagent' AND EXISTS (SELECT 1 FROM pg_class WHERE relname = 'pga_job' AND relnamespace = nsp.oid LIMIT 1)) OR (nspname = 'information_schema' AND EXISTS (SELECT 1 FROM pg_class WHERE relname = 'tables' AND relnamespace = nsp.oid LIMIT 1)) OR (nspname LIKE '_%' AND EXISTS (SELECT 1 FROM pg_proc WHERE proname='slonyversion' AND pronamespace = nsp.oid LIMIT 1)) OR (nspname = 'dbo' AND EXISTS (SELECT 1 FROM pg_class WHERE relname = 'systables' AND relnamespace = nsp.oid LIMIT 1)) OR (nspname = 'sys' AND EXISTS (SELECT 1 FROM pg_class WHERE relname = 'all_tables' AND relnamespace = nsp.oid LIMIT 1)) ) AND nspname NOT LIKE 'pg_%' $extra ORDER BY nspname"); return $result; } sub GetAllSequenceDetail { my (%opts) = @_; my $schema = $opts{schema}; my $extra = ''; $extra .= " AND nsp.nspname = '$schema'" if defined($schema); my $result = DbSelectHash(db => $opts{db}, query => " SELECT cl.oid, nsp.nspname, relname, pg_get_userbyid(relowner) AS seqowner, relacl, description FROM pg_class cl LEFT OUTER JOIN pg_description des ON des.objoid=cl.oid JOIN pg_namespace nsp ON (cl.relnamespace = nsp.oid) WHERE relkind = 'S' $extra ORDER BY nsp.nspname,relname"); foreach my $row (@$result) { my $value_result = DbSelectHash(db => $opts{db}, query => " SELECT start_value, last_value, min_value, max_value, cache_value, is_cycled, increment_by, is_called FROM \"$row->{nspname}\".\"$row->{relname}\""); $row->{seqdata} = $value_result->[0]; } return $result; } sub GetSequenceDetail { my (%opts) = @_; my $schema = $opts{schema}; my $sequence = $opts{sequence}; my $result = DbSelectHash(db => $opts{db}, query => " SELECT start_value, last_value, min_value, max_value, cache_value, is_cycled, increment_by, is_called FROM \"${schema}\".\"${sequence}\""); return $result->[0] if ($result); } sub GetAllTypeDetail { my (%opts) = @_; my $schema = $opts{schema}; my $type = $opts{type}; # Name of the type within the schema, ie: t_physical_phone_button_type my $extra = ''; $extra .= " AND nsp.nspname = '$schema'" if defined($schema); $extra .= " AND t.typname = '$type'" if defined($type); my $result = DbSelectHash(db => $opts{db}, query => " SELECT t.oid, t.typrelid, nsp.nspname, t.*, format_type(t.oid, null) AS alias, pg_get_userbyid(t.typowner) as typeowner, e.typname as element, description, ct.oid AS taboid FROM pg_type t LEFT OUTER JOIN pg_type e ON e.oid=t.typelem LEFT OUTER JOIN pg_class ct ON ct.oid=t.typrelid AND ct.relkind <> 'c' LEFT OUTER JOIN pg_description des ON des.objoid=t.oid JOIN pg_namespace nsp ON (t.typnamespace = nsp.oid) WHERE nsp.nspname NOT LIKE 'pg_%' AND t.typcategory IN ('E', 'C') AND t.typtype != 'd' AND ct.oid IS NULL $extra ORDER BY nsp.nspname,t.typname", opts => {debug => 0}); foreach my $row (@$result) { if ($row->{typcategory} eq 'E') { my $enum_result = DbSelectHash(db => $opts{db}, query => " SELECT enumlabel FROM pg_enum WHERE enumtypid = $row->{oid} ORDER by oid"); $row->{enum_data} = $enum_result; } elsif ($row->{typcategory} eq 'C') { my $comp_result = DbSelectHash(db => $opts{db}, query => " SELECT attname, format_type(t.oid,NULL) AS typname, attndims, atttypmod, nspname, ((SELECT COUNT(1) from pg_type t2 WHERE t2.typname=t.typname) > 1) AS isdup FROM pg_attribute att JOIN pg_type t ON t.oid=atttypid JOIN pg_namespace nsp ON t.typnamespace=nsp.oid LEFT OUTER JOIN pg_type b ON t.typelem=b.oid WHERE att.attrelid = $row->{typrelid} ORDER by attnum"); $row->{comp_data} = $comp_result; } } return $result; } # Get all columns for all tables for all schemas returned in the following format # You can get a single schema by specifying opts{schema} # You can get a single table by specifying opts{schema} and opts{table} # # $result = { # 'schemaName' => { # 'tableName' => { # 'colInfo' => [ # {colInfo}, # {colInfo}, # ], # 'attInfo' => [ # {colInfo}, # {colInfo}, # ] # } # } # } # # NOTE: For less detail, and columns for views as well, use GetColumnsFromRelation() # sub GetAllTableColumnsDetail { my (%opts) = @_; my $schema = $opts{schema}; my $table = $opts{table}; my $hashify = $opts{hashify}; my $extra = ""; $extra .= " AND cl.relname = '$table'" if defined($table); $extra .= " AND na.nspname = '$schema'" if defined($schema); $extra .= " AND (cs.relname IS NOT NULL OR pg_get_expr(adbin, adrelid) LIKE 'nextval%')" if defined($opts{serials}); my $result = DbSelectHash(db => $opts{db}, query => qq{ SELECT att.*, def.*, pg_catalog.pg_get_expr(def.adbin, def.adrelid) AS defval, CASE WHEN att.attndims > 0 THEN 1 ELSE 0 END AS isarray, format_type(ty.oid,NULL) AS typname, format_type(ty.oid,att.atttypmod) AS displaytypname, tn.nspname as typnspname, et.typname as elemtypname, ty.typstorage AS defaultstorage, cl.relname, na.nspname, d.refobjsubid AS colownseq, att.attstattarget, description, pg_get_expr(adbin, adrelid) as the_pg_get_expr, CASE WHEN cs.relname IS NOT NULL THEN na.nspname WHEN pg_get_expr(adbin, adrelid) LIKE 'nextval%' THEN COALESCE( substring(pg_get_expr(adbin, adrelid), 'nextval\\(''(.*)\\..*''::regclass\\)'), -- nextval('log_asterisk.calls_call_segment_id_seq'::regclass) na.nspname -- nextval('calls_call_segment_id_seq'::regclass) -- Schema name is in our search path ) END AS serschema, -- serial schema CASE WHEN cs.relname IS NOT NULL THEN cs.relname WHEN pg_get_expr(adbin, adrelid) LIKE 'nextval%' THEN COALESCE( substring(pg_get_expr(adbin, adrelid), 'nextval\\(''.*\\.(.*)''::regclass\\)'), -- nextval('log_asterisk.calls_call_segment_id_seq'::regclass) substring(pg_get_expr(adbin, adrelid), 'nextval\\(''(.*)''::regclass\\)') -- nextval('calls_call_segment_id_seq'::regclass) -- Schema name is in our search path ) END AS sername, -- serial name (SELECT count(1) FROM pg_type t2 WHERE t2.typname=ty.typname) > 1 AS isdup, indkey, CASE WHEN EXISTS( SELECT inhparent FROM pg_inherits WHERE inhrelid=att.attrelid ) THEN att.attrelid::regclass ELSE NULL END AS inhrelname, EXISTS(SELECT 1 FROM pg_constraint WHERE conrelid=att.attrelid AND contype='f' AND att.attnum=ANY(conkey)) As isfk FROM pg_attribute att JOIN pg_type ty ON ty.oid=atttypid JOIN pg_namespace tn ON tn.oid=ty.typnamespace JOIN pg_class cl ON cl.oid=att.attrelid JOIN pg_namespace na ON na.oid=cl.relnamespace LEFT OUTER JOIN pg_type et ON et.oid=ty.typelem LEFT OUTER JOIN pg_attrdef def ON adrelid=att.attrelid AND adnum=att.attnum LEFT OUTER JOIN pg_description des ON des.objoid=att.attrelid AND des.objsubid=att.attnum LEFT OUTER JOIN (pg_depend d JOIN pg_class cs ON objid=cs.oid AND cs.relkind='S') ON refobjid=att.attrelid AND refobjsubid=att.attnum LEFT OUTER JOIN pg_namespace ns ON ns.oid=cs.relnamespace LEFT OUTER JOIN pg_index pi ON pi.indrelid=att.attrelid AND indisprimary WHERE att.attnum > 0 AND att.attisdropped IS FALSE AND cl.relkind = 'r' -- ordinary table (pg_class) AND na.nspname != 'pg_catalog' AND na.nspname != 'information_schema' $extra ORDER BY na.nspname, cl.relname, att.attname}, opts => {debug => 0}); # Use attname for sorting instead of att.attnum (order created) # Only interested in serial info if ( $opts{serials} ) { my @result; # Probably the easiest way to work with the serials is just a straight array foreach my $row (@$result) { push(@result, { schema => $row->{serschema}, table => $row->{relname}, serial => $row->{sername}, col => $row->{attname}, type => $row->{typname}, }); } #die Dumper(\@result); return \@result; } # pg_dump pbx --section=pre-data -t asterisk.autoanswer_group_includes # pg_dump pbx --section=post-data -t asterisk.autoanswer_group_includes my %result; foreach my $row (@$result) { my $schema = $row->{nspname}; my $table = $row->{relname}; my $nullable = ''; my $default = ''; $nullable = ' NOT NULL' if ($row->{attnotnull}); $default = " DEFAULT $row->{defval}" if ($row->{defval}); $row->{column_create} = qq{ALTER TABLE "$schema"."$table" ADD COLUMN "$row->{attname}" $row->{typname}${nullable}${default}}; push(@{$result{$schema}{$table}{colInfo}}, $row); $result{$schema}{$table}{attInfo}[$row->{attnum}] = $row; if ($hashify) { $result{$schema}{$table}{col_names}{$row->{attname}} = $row; } } return \%result; } ## # Get all primary keys for all schemas and tables # You can get a single schema by specifying opts{schema} # You can get a single table by specifying opts{schema} and opts{table} # # $result = { # 'schemaName' => { # 'tableName' => {pkinfo}, # 'tableName' => {pkinfo}, # } # } # # Options: db, schema, table sub GetAllPrimaryKeyDetail { my (%opts) = @_; my $schema = $opts{schema}; my $table = $opts{table}; my $single = $opts{single_table}; my $extra = ''; $extra .= " AND tab.relname = '$table'" if defined($table); $extra .= " AND n.nspname = '$schema'" if defined($schema); my $result = DbSelectHash(db => $opts{db}, query => " SELECT DISTINCT ON(n.nspname, tab.relname, cls.relname) cls.oid, cls.relname as idxname, indrelid, indkey, indisclustered, indisunique, indisprimary, n.nspname, indnatts, cls.reltablespace AS spcoid, spcname, tab.relname as tabname, indclass, con.oid AS conoid, CASE contype WHEN 'p' THEN desp.description WHEN 'u' THEN desp.description ELSE des.description END AS description, pg_get_expr(indpred, indrelid, true) as indconstraint, contype, condeferrable, condeferred, amname, substring(array_to_string(cls.reloptions, ',') from 'fillfactor=([0-9]*)') AS fillfactor FROM pg_index idx JOIN pg_class cls ON cls.oid=indexrelid JOIN pg_class tab ON tab.oid=indrelid LEFT OUTER JOIN pg_tablespace ta on ta.oid=cls.reltablespace JOIN pg_namespace n ON n.oid=tab.relnamespace JOIN pg_am am ON am.oid=cls.relam LEFT JOIN pg_depend dep ON (dep.classid = cls.tableoid AND dep.objid = cls.oid AND dep.refobjsubid = '0') LEFT OUTER JOIN pg_constraint con ON (con.tableoid = dep.refclassid AND con.oid = dep.refobjid) LEFT OUTER JOIN pg_description des ON des.objoid=cls.oid LEFT OUTER JOIN pg_description desp ON (desp.objoid=con.oid AND desp.objsubid = 0) WHERE contype = 'p' $extra ORDER BY n.nspname, tab.relname, cls.relname"); return $result->[0] if ($single); # Only one PRIMARY key for table! my %result; foreach my $row (@$result) { $result{$row->{nspname}}{$row->{tabname}} = $row; } return \%result; } ## # Get all unique keys for all schemas and tables # You can get a single schema by specifying opts{schema} # You can get a single table by specifying opts{schema} and opts{table} # # $result = { # 'schemaName' => { # 'tableName' => [ # {ukinfo}, # {ukinfo}, # } # } # # Options: db, schema, table sub GetAllUniqueKeyDetail { my (%opts) = @_; my $schema = $opts{schema}; my $table = $opts{table}; my $flat_array = $opts{flat_array}; # Useful if only returning keys from a single scheme+table my $extra = ''; $extra .= " AND tab.relname = '$table'" if defined($table); $extra .= " AND nspname = '$schema'" if defined($schema); my $table_col_data = $opts{table_col_data} // GetAllTableColumnsDetail(db => $opts{db}, schema => $schema, table => $table); my $result = DbSelectHash(db => $opts{db}, query => " SELECT DISTINCT ON(n.nspname, tab.relname, cls.relname) cls.oid, cls.relname as idxname, indrelid, indkey, indisclustered, indisunique, indisprimary, n.nspname, indnatts, cls.reltablespace AS spcoid, spcname, tab.relname as tabname, indclass, con.oid AS conoid, CASE contype WHEN 'p' THEN desp.description WHEN 'u' THEN desp.description ELSE des.description END AS description, pg_get_expr(indpred, indrelid, true) as indconstraint, contype, condeferrable, condeferred, amname, substring(array_to_string(cls.reloptions, ',') from 'fillfactor=([0-9]*)') AS fillfactor FROM pg_index idx JOIN pg_class cls ON cls.oid=indexrelid JOIN pg_class tab ON tab.oid=indrelid LEFT OUTER JOIN pg_tablespace ta on ta.oid=cls.reltablespace JOIN pg_namespace n ON n.oid=tab.relnamespace JOIN pg_am am ON am.oid=cls.relam LEFT JOIN pg_depend dep ON (dep.classid = cls.tableoid AND dep.objid = cls.oid AND dep.refobjsubid = '0') LEFT OUTER JOIN pg_constraint con ON (con.tableoid = dep.refclassid AND con.oid = dep.refobjid) LEFT OUTER JOIN pg_description des ON des.objoid=cls.oid LEFT OUTER JOIN pg_description desp ON (desp.objoid=con.oid AND desp.objsubid = 0) WHERE contype='u' $extra ORDER BY n.nspname, tab.relname, cls.relname"); foreach my $row (@$result) { my @index_cols; my @index_col_ids = split(/ /, $row->{indkey}); foreach my $col_id (@index_col_ids) { push(@index_cols, $table_col_data->{$schema}{$table}{attInfo}[$col_id]{attname}); } $row->{index_cols} = \@index_cols; } return $result if ($flat_array); my %result; foreach my $row (@$result) { push(@{$result{$row->{nspname}}{$row->{tabname}}}, $row); } return \%result; } ## # Get all check constraints for all schemas and tables # You can get a single schema by specifying opts{schema} # You can get a single table by specifying opts{schema} and opts{table} # # $result = { # 'schemaName' => { # 'tableName' => [ # {ckinfo}, # {ckinfo}, # } # } # # Options: db, schema, table sub GetAllCheckConstraintDetail { my (%opts) = @_; my $schema = $opts{schema}; my $table = $opts{table}; my $extra = ''; $extra .= " AND relname = '$table'" if defined($table); $extra .= " AND nspname = '$schema'" if defined($schema); my $result = DbSelectHash(db => $opts{db}, query => " SELECT c.oid, conname, relname, nspname, description, pg_get_expr(conbin, conrelid, true) as consrc FROM pg_constraint c JOIN pg_class cl ON cl.oid=conrelid JOIN pg_namespace nl ON nl.oid=relnamespace LEFT OUTER JOIN pg_description des ON des.objoid=c.oid WHERE contype = 'c' $extra ORDER BY conname"); my %result; foreach my $row (@$result) { push(@{$result{$row->{nspname}}{$row->{relname}}}, $row); } return \%result; } sub GetAllConstraintDetail { return getAllConstraintDetail(@_); } sub getAllConstraintDetail { my (%opts) = @_; my $schema = $opts{schema}; my $table = $opts{table}; my $constraint = $opts{constraint}; my $hashify_con = $opts{hashify_constraints}; my $extra = ''; $extra .= " AND relname = '$table'" if defined($table); $extra .= " AND nspname = '$schema'" if defined($schema); $extra .= " AND conname = '$constraint'" if defined($constraint); my $result = DbSelectHash(db => $opts{db}, query => " SELECT c.oid, conname, relname, nspname, description, pg_get_expr(conbin, conrelid, true) as consrc FROM pg_constraint c JOIN pg_class cl ON cl.oid=conrelid JOIN pg_namespace nl ON nl.oid=relnamespace LEFT OUTER JOIN pg_description des ON des.objoid=c.oid WHERE 1=1 $extra ORDER BY conname"); my %result; if ($opts{hashify_constraints}) { foreach my $row (@$result) { $result{$row->{nspname}}{$row->{relname}}{$row->{conname}} = $row; } } else { foreach my $row (@$result) { push(@{$result{$row->{nspname}}{$row->{relname}}}, $row); } } return \%result; } ## # Get all foreign keys for all schemas and tables # You can get a single schema by specifying opts{schema} # You can get a single table by specifying opts{schema} and opts{table} # # Default Return # $result = { # 'schemaName' => { # 'tableName' => [ # {fkinfo}, # {fkinfo}, # } # } # # opts{return_unprocessed} # Returns: # [ # {fkInfo}, # {fkInfo}, # ] # # Options: db, schema, table # sub GetAllForeignKeyDetail { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; my $fkey = $opts{fkey}; my $extra = ''; $extra .= " AND cl.relname = '$table'" if defined($table); $extra .= " AND nl.nspname = '$schema'" if defined($schema); $extra .= " AND conname = '$fkey'" if defined($fkey); my $result = DbSelectHash(db => $db, query => " SELECT ct.oid, conname, condeferrable, condeferred, confupdtype, confdeltype, confmatchtype, conkey, confkey, confrelid, nl.nspname as fknsp, cl.relname as fktab, nr.nspname as refnsp, cr.relname as reftab, description, pg_get_constraintdef(ct.oid,false) as def FROM pg_constraint ct JOIN pg_class cl ON cl.oid=conrelid JOIN pg_namespace nl ON nl.oid=cl.relnamespace JOIN pg_class cr ON cr.oid=confrelid JOIN pg_namespace nr ON nr.oid=cr.relnamespace LEFT OUTER JOIN pg_description des ON des.objoid=ct.oid WHERE contype ='f' $extra ORDER BY nl.nspname, cl.relname, conkey[0]"); if ( $opts{return_unprocessed} ) { return $result; } my %result; foreach my $row (@$result) { push(@{$result{$row->{fknsp}}{$row->{fktab}}}, $row); } return \%result; } sub getAllConstraintDetailConcise { my (%opts) = @_; my $schema = $opts{schema}; my $table = $opts{table}; my $fkey = $opts{fkey}; my $extra = ''; # $extra .= " AND cl.relname = '$table'" if defined($table); $extra .= " AND sch.nspname = '$schema'" if defined($schema); $extra .= " AND c.conname = '$fkey'" if defined($fkey); my $result = DbSelectHash(db => $opts{db}, query => qq{ SELECT sch.nspname AS schema_name, tbl.relname AS primary_table_name, c.conname AS constraint_name, c.contype AS constraint_type, ARRAY_AGG(col.attname ORDER BY u.attposition) AS "columns", f_sch.nspname AS "foreign_schema_name", f_tbl.relname AS "foreign_table_name", ARRAY_AGG(f_col.attname ORDER BY f_u.attposition) AS "foreign_columns", 'ALTER TABLE ' || quote_ident(sch.nspname) || '.' || quote_ident(tbl.relname) || E'\n DROP CONSTRAINT ' || quote_ident(c.conname) AS constraint_drop, 'ALTER TABLE ' || quote_ident(sch.nspname) || '.' || quote_ident(tbl.relname) || E'\n ADD CONSTRAINT ' || quote_ident(c.conname) || E'\n ' || pg_get_constraintdef(c.oid, false) AS constraint_definition, pg_get_constraintdef(c.oid) AS inner_definition FROM pg_constraint c LEFT JOIN LATERAL UNNEST(c.conkey) WITH ORDINALITY AS u(attnum, attposition) ON TRUE LEFT JOIN LATERAL UNNEST(c.confkey) WITH ORDINALITY AS f_u(attnum, attposition) ON f_u.attposition = u.attposition JOIN pg_class tbl ON tbl.oid = c.conrelid JOIN pg_namespace sch ON sch.oid = tbl.relnamespace LEFT JOIN pg_attribute col ON (col.attrelid = tbl.oid AND col.attnum = u.attnum) LEFT JOIN pg_class f_tbl ON f_tbl.oid = c.confrelid LEFT JOIN pg_namespace f_sch ON f_sch.oid = f_tbl.relnamespace LEFT JOIN pg_attribute f_col ON (f_col.attrelid = f_tbl.oid AND f_col.attnum = f_u.attnum) WHERE 1=1 $extra GROUP BY constraint_name, constraint_type, schema_name, primary_table_name, constraint_definition, inner_definition, foreign_schema_name, foreign_table_name ORDER BY schema_name, primary_table_name }, opts => {debug => 0}); if ( $opts{return_unprocessed} ) { return $result; } my %result; foreach my $row (@$result) { push(@{$result{$row->{schema_name}}{$row->{primary_table_name}}}, $row); } return \%result; } ## # Get all indexes for all schemas and tables # You can get a single schema by specifying opts{schema} # You can get a single table by specifying opts{schema} and opts{table} # # $result = { # 'schemaName' => { # 'tableName' => [ # {indinfo}, # {indnfo}, # } # } # # Options: db, schema, table sub GetAllIndexDetail { my (%opts) = @_; my $schema = $opts{schema}; my $table = $opts{table}; my $extra = ''; $extra .= " AND tab.relname = '$table'" if defined($table); $extra .= " AND n.nspname = '$schema'" if defined($schema); my $result = DbSelectHash(db => $opts{db}, query => " SELECT DISTINCT ON(n.nspname, tab.relname, cls.relname) cls.oid, cls.relname as idxname, indrelid, indkey, indisclustered, indisunique, indisprimary, n.nspname, indnatts, cls.reltablespace AS spcoid, spcname, tab.relname as tabname, indclass, con.oid AS conoid, CASE contype WHEN 'p' THEN desp.description WHEN 'u' THEN desp.description ELSE des.description END AS description, pg_get_expr(indpred, indrelid, true) as indconstraint, contype, condeferrable, condeferred, amname, substring(array_to_string(cls.reloptions, ',') from 'fillfactor=([0-9]*)') AS fillfactor FROM pg_index idx JOIN pg_class cls ON cls.oid=indexrelid JOIN pg_class tab ON tab.oid=indrelid LEFT OUTER JOIN pg_tablespace ta on ta.oid=cls.reltablespace JOIN pg_namespace n ON n.oid=tab.relnamespace JOIN pg_am am ON am.oid=cls.relam LEFT JOIN pg_depend dep ON (dep.classid = cls.tableoid AND dep.objid = cls.oid AND dep.refobjsubid = '0') LEFT OUTER JOIN pg_constraint con ON (con.tableoid = dep.refclassid AND con.oid = dep.refobjid) LEFT OUTER JOIN pg_description des ON des.objoid=cls.oid LEFT OUTER JOIN pg_description desp ON (desp.objoid=con.oid AND desp.objsubid = 0) WHERE NOT (n.nspname LIKE 'pg_%') AND (n.nspname != 'information_schema') AND conname IS NULL $extra ORDER BY n.nspname, tab.relname, cls.relname"); my %result; foreach my $row (@$result) { push(@{$result{$row->{nspname}}{$row->{tabname}}}, $row); } return \%result; } ## # Get all Rules for all schemas and tables # You can get a single schema by specifying opts{schema} # You can get a single table by specifying opts{schema} and opts{table} # # $result = { # 'schemaName' => { # 'tableName' => [ # {Rule info}, # {Rule info}, # } # } # # Options: db, schema, table sub GetAllRulesDetail { my (%opts) = @_; my $schema = $opts{schema}; my $table = $opts{table}; my $extra = ''; $extra .= " AND cl.relname = '$table'" if defined($table); $extra .= " AND nsp.nspname = '$schema'" if defined($schema); my $result = DbSelectHash(db => $opts{db}, query => " SELECT rw.oid, rw.*, relname, CASE WHEN relkind = 'r' THEN TRUE ELSE FALSE END AS parentistable, nspname, description, pg_get_ruledef(rw.oid, true) AS definition FROM pg_rewrite rw JOIN pg_class cl ON cl.oid=rw.ev_class JOIN pg_namespace nsp ON nsp.oid=cl.relnamespace LEFT OUTER JOIN pg_description des ON des.objoid=rw.oid WHERE relname IS NOT NULL AND NOT (nsp.nspname LIKE 'pg_%') AND (nsp.nspname != 'information_schema') $extra ORDER BY nsp.nspname, cl.relname, rw.rulename"); my %result; foreach my $row (@$result) { push(@{$result{$row->{nspname}}{$row->{relname}}}, $row); } return \%result; } ################################################################################################ # Exporters capable of creation/diffing/reimporting of complete databases or parts thereof ################################################################################################ ## # Generate a CREATE script for a given database # Currently commented because we usecreatedb program # sub ExportDatabases { my (%opts) = @_; my $db = $opts{db}; my $Export = ''; my $database_info = GetDatabases(db => $db); my @database = grep { $_->{datname} eq $db->{options}{Name} } @$database_info; $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- Start Database Definition for $db->{options}{Name}\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; $Export .= "-- CREATE DATABASE \"$db->{options}{Name}\"\n"; $Export .= "-- WITH OWNER = $database[0]{datowner}\n"; $Export .= "-- ENCODING = '$database[0]{serverencoding}'\n"; $Export .= "-- TABLESPACE = '$database[0]{spcname}'\n"; $Export .= "-- LC_COLLATE = '$database[0]{datcollate}'\n"; $Export .= "-- LC_CTYPE = '$database[0]{datctype}'\n"; $Export .= "-- CONNECTION_LIMIT = '$database[0]{datconnlimit}';\n"; $Export .= "-- COMMENT ON DATABASE $db->{options}{Name} IS \$DESC\$$database[0]{description}\$DESC\$;\n" if ($database[0]{description}); $Export .= "\n-- ------------------------------------------------------------------------\n"; $Export .= "-- End Database Definition for $db->{options}{Name}\n"; $Export .= "-- ------------------------------------------------------------------------\n"; return $Export; } sub ExportCasts { my (%opts) = @_; my $db = $opts{db}; my $casts_info = GetAllCastsDetail(%opts); my $Export = ''; foreach my $cast (@$casts_info) { $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- Start Cast Definition for $cast->{srctyp} -> $cast->{trgtyp}\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; $Export .= "CREATE CAST ($cast->{srctyp} AS $cast->{trgtyp})"; $Export .= " WITH FUNCTION $cast->{proname}($cast->{srctyp}) "; if ($cast->{description}) { $Export .= "COMMENT ON"; $Export .= " CAST ($cast->{srctyp} AS $cast->{trgtyp}) IS \$DESC\$cast->{description}\$DESC\$;\n" } $Export .= "\n-- ------------------------------------------------------------------------\n"; $Export .= "-- End Cast Definition for $cast->{srctyp} -> $cast->{trgtyp}\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } return $Export; } ## # Generate CREATE script for all languages in a given database # sub ExportLanguages { my (%opts) = @_; my $db = $opts{db}; my $languages_info = GetAllLanguagesDetail(%opts); my $Export = ''; foreach my $language (@$languages_info) { $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- Start Language Definition for $language->{lanname}\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; $Export .= " CREATE"; $Export .= " TRUSTED" if ($language->{lanpltrusted}); $Export .= " PROCEDURAL" if ($language->{lanispl}); $Export .= " LANGUAGE '$language->{lanname}'\n"; $Export .= " HANDLER $language->{lanproc}\n"; $Export .= " VALIDATOR $language->{lanval};\n"; $Export .= "ALTER LANGUAGE $language->{lanname} OWNER TO $language->{languageowner};\n"; if ($language->{description}) { $Export .= "COMMENT ON"; $Export .= " PROCEDURAL" if ($language->{lanispl}); $Export .= " LANGUAGE $language->{lanname} IS \$DESC\$$language->{description}\$DESC\$;\n" } $Export .= "\n-- ------------------------------------------------------------------------\n"; $Export .= "-- End Language Definition for $language->{lanname}\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } return $Export; } ## # Generate CREATE script for all (or specified) schemas in a given database # sub ExportSchemas { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $schemas_info = GetAllSchemaDetail(%opts); my $Export = ''; foreach my $schemadef (@$schemas_info) { $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- Start Schema Definition for $schemadef->{nspname}\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; $Export .= "CREATE SCHEMA \"$schemadef->{nspname}\"\n"; $Export .= " AUTHORIZATION \"$schemadef->{namespaceowner}\";\n"; foreach my $acl (@{$schemadef->{nspacl}}) { my ($user, $perms) = split(/=/, $acl); $user = 'public' if !$user; $perms = (split(/\//, $perms))[0]; $Export .= "GRANT "; $Export .= "ALL " if ($perms eq 'UC'); $Export .= "CREATE " if ($perms eq 'C'); $Export .= "USAGE " if ($perms eq 'U'); $Export .= "ON SCHEMA \"$schemadef->{nspname}\" TO \"$user\";\n"; } $Export .= "COMMENT ON SCHEMA \"$schemadef->{nspname}\" IS \$DESC\$$schemadef->{description}\$DESC\$;\n" if ($schemadef->{description}); $Export .= "\n-- ------------------------------------------------------------------------\n"; $Export .= "-- End Schema Definition for $schemadef->{nspname}\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } return $Export; } ## # Generate CREATE script for all types in a given database or schema # sub ExportTypes { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $types_info = GetAllTypeDetail(%opts); my $Export = ''; foreach my $type (@$types_info) { $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start Type Definition for $type->{alias}\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; $Export .= "CREATE TYPE $type->{alias} AS"; $Export .= " ENUM" if ($type->{typcategory} eq 'E'); $Export .= "\n ("; if (exists($type->{enum_data})) { my $first_enum = 1; foreach my $enum (@{$type->{enum_data}}) { $Export .= ",\n" unless ($first_enum); $Export .= " " unless ($first_enum); $Export .= "'$enum->{enumlabel}'"; $first_enum = 0; } } if (exists($type->{comp_data})) { my $i=0; foreach my $comp (@{$type->{comp_data}}) { $Export .= ",\n" if ($i); $Export .= " " if ($i); $Export .= "\"$comp->{attname}\" $comp->{typname}"; $i = 1; } } $Export .= ");\n"; $Export .= "ALTER TYPE $type->{alias} OWNER TO $type->{typeowner};\n"; $Export .= "COMMENT ON TYPE $type->{alias} IS \$DESC\$$type->{description}\$DESC\$;\n" if ($type->{description}); $Export .= "\n-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End Type Definition for $type->{alias}\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } return $Export; } ## # Generate CREATE script for all sequences in a given database or schema # sub ExportSequences { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $seqs_info = GetAllSequenceDetail(%opts); my $Export = ''; foreach my $seq (@$seqs_info) { $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start Sequence Definition for $seq->{nspname}.$seq->{relname}\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; $Export .= "CREATE SEQUENCE \"$seq->{nspname}\".\"$seq->{relname}\""; $Export .= "\n INCREMENT $seq->{seqdata}{increment_by}" if (exists($seq->{seqdata}) && exists($seq->{seqdata}{increment_by})); $Export .= "\n MINVALUE $seq->{seqdata}{min_value}" if (exists($seq->{seqdata}) && exists($seq->{seqdata}{min_value})); $Export .= "\n MAXVALUE $seq->{seqdata}{max_value}" if (exists($seq->{seqdata}) && exists($seq->{seqdata}{max_value})); $Export .= "\n START $seq->{seqdata}{start_value}" if (exists($seq->{seqdata}) && exists($seq->{seqdata}{last_value})); $Export .= "\n CACHE $seq->{seqdata}{cache_value}" if (exists($seq->{seqdata}) && exists($seq->{seqdata}{cache_value})); $Export .= "\n CYCLE" if (exists($seq->{seqdata}) && exists($seq->{seqdata}{is_cycled}) && $seq->{seqdata}{is_cycled}); $Export .= ";\n"; $Export .= "ALTER SEQUENCE \"$seq->{nspname}\".\"$seq->{relname}\" OWNER TO $seq->{seqowner};\n"; $Export .= "SELECT pg_catalog.setval('\"$seq->{nspname}\".\"$seq->{relname}\"', $seq->{seqdata}{last_value}, " . ( $seq->{seqdata}{is_called} ? 'true' : 'false' ) . ");\n"; $Export .= "COMMENT ON SEQUENCE \"$seq->{nspname}\".\"$seq->{relname}\" IS \$DESC\$$seq->{description}\$DESC\$;\n" if ($seq->{description}); $Export .= "\n-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End Sequence Definition for $seq->{nspname}.$seq->{relname}\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } return $Export; } ## # Generate CREATE script for all aggregates in a given database or schema # sub ExportAggregates { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $aggs_info = GetAllAggregatesDetail(%opts); my $Export = ''; foreach my $agg (@$aggs_info) { $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start Aggregate Definition for $agg->{fullname}($agg->{args_types_list})\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; $Export .= "CREATE AGGREGATE $agg->{fullname}($agg->{args_types_list}) (\n"; $Export .= " SFUNC=$agg->{aggtransfn},\n" if ($agg->{aggtransfn}); $Export .= " STYPE=$agg->{transname},\n" if ($agg->{transname}); $Export .= " INITCOND='$agg->{agginitval}',\n" if (defined($agg->{agginitval})); $Export .= " FINALFUNC=$agg->{aggfinalfn},\n" if ($agg->{aggfinalfn} ne '-'); $Export .= " SORTOP='$agg->{oprname}',\n" if ($agg->{oprname}); chop $Export; chop $Export; $Export .= "\n);\n"; $Export .= "ALTER AGGREGATE $agg->{fullname}($agg->{args_types_list}) OWNER TO $agg->{aggowner};\n"; $Export .= "COMMENT ON AGGREGATE $agg->{fullname}($agg->{args_types_list}) IS \$DESC\$$agg->{description}\$DESC\$;\n" if ($agg->{description}); $Export .= "\n-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End Aggregate Definition for $agg->{fullname}($agg->{args_types_list})\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } return $Export; } ## # Generate CREATE script for all given views or all views in a given database or schema # Retrieves View definitions. Basicly, only the _RETURN rule. sub ExportViews { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $view = $opts{view}; my $views = $opts{views}; # @$views is a list of 'schema.view' items. my $views_info; my $Export = ''; if (defined($views)) { # A friendly header showing the specific views that were inteded for this dump, if provided. $Export .= "-- -----------------------\n"; $Export .= "-- Views:\n"; foreach my $view (@$views) { my ($schema_name,$view_name) = split(/\./,$view); my $view_info = GetViewsFromSchema(db => $db, schema => $schema_name, view => $view_name); if (!scalar(@$view_info)) { $Export .= "-- WARNING: the View: $schema_name.$view_name() DOES NOT EXIST\n"; print STDERR "The View given by: $schema_name.$view_name does not exist in the datase\n"; next; } $Export .= "-- $schema_name.$view_name\n"; push @$views_info, @$view_info; } $Export .= "-- -----------------------\n"; $Export .= "\n"; } else { $views_info = GetViewsFromSchema(%opts); } foreach my $view_def (@$views_info) { my $schema_name = $view_def->{nspname}; my $view_name = $view_def->{relname}; $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start View: $schema_name.$view_name\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; $Export .= "SET SEARCH_PATH TO '$schema_name','public';\n"; $Export .= "CREATE OR REPLACE VIEW \"$schema_name\".\"$view_name\" AS\n$view_def->{definition}\n"; # We are a view, so add the ownership and view comments to the CREATE RULE. $Export .= "ALTER TABLE \"$schema_name\".\"$view_name\" OWNER TO $view_def->{viewowner};\n"; $Export .= "COMMENT ON VIEW \"$schema_name\".\"$view_name\" IS \$DESC\$$view_def->{description}\$DESC\$;\n" if ($view_def->{description}); $Export .= "\n-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End View: $schema_name.$view_name\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } return $Export; } ## # Generate SQL script for all check constraints in a given database or schema, or list of tables. # sub ExportChecks { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; my $tables = $opts{tables}; # @$tables is a list of 'schema.table' items. my $check_consts; my $Export = ''; if (defined($tables)) { foreach my $table (@$tables) { my ($schema_name,$table_name) = split(/\./,$table); my $ck_data = GetAllCheckConstraintDetail(db => $db, schema => $schema_name, table => $table_name); $check_consts->{$schema_name}{$table_name} = $ck_data->{$schema_name}{$table_name}; } } else { $check_consts = GetAllCheckConstraintDetail(%opts); } foreach my $schema_name (sort keys %{$check_consts}) { foreach my $table_name (sort keys %{$check_consts->{$schema_name}}) { my $constraint = $check_consts->{$schema_name}{$table_name}; next unless defined($constraint); $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start Check Constraints For: $schema_name.$table_name\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; foreach my $row (@$constraint) { $Export .= "ALTER TABLE \"$schema_name\".\"$table_name\"\n ADD CONSTRAINT \"$row->{conname}\" CHECK ($row->{consrc});\n"; $Export .= "COMMENT ON CONSTRAINT \"$row->{conname}\" ON \"$schema_name\".\"$table_name\" IS \$DESC\$$row->{description}\$DESC\$;\n" if ($row->{description}); } $Export .= "\n-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End Check Constraints For: $schema_name.$table_name\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } } return $Export; } ## # Generate SQL CREATE script for all indexes in a given database or schema, or list of tables. # sub ExportIndexes { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; my $tables = $opts{tables}; # @$tables is a list of 'schema.table' items. my $raw_info = $opts{raw_info}; # raw output from GetAllIndexDetail/GetAllTableColumnsDetail() to be used for export instead of SQL DDL -- NOT YET IMPLEMENTED, see ExportFunctions() my $indexes; my $Export = ''; if (defined($tables)) { foreach my $table (@$tables) { my ($schema_name,$table_name) = split(/\./,$table); my $ind_data = GetAllIndexDetail(db => $db, schema => $schema_name, table => $table_name); $indexes->{$schema_name}{$table_name} = $ind_data->{$schema_name}{$table_name}; } } else { $indexes = GetAllIndexDetail(%opts); } foreach my $schema_name (sort keys %{$indexes}) { foreach my $table_name (sort keys %{$indexes->{$schema_name}}) { my $index = $indexes->{$schema_name}{$table_name}; next unless defined($index); my $table_col_data = GetAllTableColumnsDetail(db => $db, schema => $schema_name, table => $table_name); $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start Indexes For: $schema_name.$table_name\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; foreach my $row (@$index) { my @index_cols; my @index_col_ids = split(/ /, $row->{indkey}); foreach my $col_id (@index_col_ids) { my $index_val = $table_col_data->{$schema_name}{$table_name}{attInfo}[$col_id]{attname}; push(@index_cols, $index_val) if (defined($index_val)); } my $index_cols = join('","', @index_cols); # TODO: Support all possible postgres create index invocations $Export .= "CREATE "; $Export .= "UNIQUE " if $row->{indisunique}; $Export .= "INDEX \"$row->{idxname}\"\n"; $Export .= " ON \"$row->{nspname}\".\"$row->{tabname}\"\n"; $Export .= " USING $row->{amname}\n" if (defined ($row->{amname})); $Export .= " (\"$index_cols\");\n"; $Export .= "COMMENT ON INDEX \"$row->{nspname}\".\"$row->{idxname}\" IS \$DESC\$$row->{description}\$DESC\$;\n" if ($row->{description}); $Export .= "\n"; } $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End Indexes For: $schema_name.$table_name\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } } return $Export; } ## # Generate SQL CREATE script for all triggers in a given database or schema, or list of tables. # sub ExportTriggers { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; my $tables = $opts{tables}; # @$tables is a list of 'schema.table' items. my $triggers = $opts{tgdetail}; # Pass in already populated data from GetTriggersFromSchema() my $Export = ''; if (!$triggers) { if (defined($tables)) { foreach my $table (@$tables) { my ($schema_name,$table_name) = split(/\./,$table); my $trg_data = GetTriggersFromSchema(db => $db, schema => $schema_name, table => $table_name); push @$triggers, @$trg_data; } } else { $triggers = GetTriggersFromSchema(%opts); } } $Export .= "-- -----------------------\n"; $Export .= "-- Triggers\n"; $Export .= "-- -----------------------\n"; foreach my $trg (@$triggers) { $Export .= "$trg->{trigger_def};"; $Export .= "\nCOMMENT ON TRIGGER \"$trg->{trigger_name}\" ON \"$trg->{event_object_schema}\".\"$trg->{event_object_table}\" IS \$DESC\$$trg->{obj_description}\$DESC\$;" if ($trg->{obj_description}); $Export .= "\nALTER TABLE \"$trg->{event_object_schema}\".\"$trg->{event_object_table}\" DISABLE TRIGGER \"$trg->{trigger_name}\";" if ($trg->{tgenabled} eq 'D'); $Export .= "\n"; } if ($tables) { $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End Triggers\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } else { $Export .= "-- ------------------------------------------------------------------------\n"; if ($table) { $Export .= "-- ---- End Triggers for: $schema.$table\n"; } else { $Export .= "-- ---- End Triggers for: $schema\n"; } $Export .= "-- ------------------------------------------------------------------------\n"; } return $Export; } ## # Generate SQL CREATE script for all Rules (not including _RETURN) in a given database or schema, or list of tables. # sub ExportRules { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; my $tables = $opts{tables}; # @$tables is a list of 'schema.table' items. my $rules; my $Export = ''; if (defined($tables)) { foreach my $table (@$tables) { my ($schema_name,$table_name) = split(/\./,$table); my $rule_data = GetAllRulesDetail(db => $db, schema => $schema_name, table => $table_name); # print Dumper ($schema_name, $table_name,$rule_data);exit; $rules->{$schema_name}{$table_name} = $rule_data->{$schema_name}{$table_name}; } } else { $rules = GetAllRulesDetail(%opts); } foreach my $schema_name (sort keys %{$rules}) { foreach my $table_name (sort keys %{$rules->{$schema_name}}) { my $rule = $rules->{$schema_name}{$table_name}; next unless defined($rule); $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start Rules for: $schema_name.$table_name\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; foreach my $row (@$rule) { my $ruledef = $row->{definition}; # S# select live_queue.create_views('rebuild'); # select live_dialer.create_views(''); #kip the _RETURN rule if there is one. That is taken care of in the view prototyping. next if ( $ruledef =~ m{"_RETURN"}is ); $Export .= "SET SEARCH_PATH TO '$schema_name','public';\n"; $Export .= $ruledef; $Export .= "\nCOMMENT ON RULE \"$row->{rulename}\" ON \"$schema_name\".\"$table_name\" IS \$DESC\$$row->{description}\$DESC\$;" if ($row->{description}); $Export .= "\n\n"; } $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End Rules for: $schema_name.$table_name\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } } return $Export // ''; } ## # Generate SQL script for all Foreign Key constraints in a given database or schema, or list of tables. # sub ExportForeignKeys { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; my $tables = $opts{tables}; # @$tables is a list of 'schema.table' items. my $fks = $opts{fkdetail}; # Pass in already populated data from GetAllForeignKeyDetail() my $detail_pass = $opts{detail_pass}; # Instad of a purely textual export, populate the export data as members of resulting fkdetail hash of {schema}{table}[x] my $sql_export = $opts{sql_export}; # If specified, we'll write out the plain SQL export of what we were given, in terms of schema/table match (or fkdetail) # So we don't have to do lots of nesting syntax to pass in a single table's FK data. we do it here # This is used for example, by FailoverControl if ($opts{fkdetailflat}) { $fks = {}; $fks->{$schema}{$table} = $opts{fkdetailflat}; } my $Export = ''; if (!$fks) { if (defined($tables)) { foreach my $table (@$tables) { my ($schema_name,$table_name) = split(/\./,$table); my $fk_data = GetAllForeignKeyDetail(db => $db, schema => $schema_name, table => $table_name); $fks->{$schema_name}{$table_name} = $fk_data->{$schema_name}{$table_name}; } } else { $fks = GetAllForeignKeyDetail(%opts); } } # Get everything... because we also need to check references... and any schema can reference a table in any other schema my $table_col_data = GetAllTableColumnsDetail(db => $db); foreach my $schema_name (sort keys %{$fks}) { foreach my $table_name (sort keys %{$fks->{$schema_name}}) { my $keys = $fks->{$schema_name}{$table_name}; next if !defined($keys); my @keys_in_order = sort {$a->{conname} cmp $b->{conname}} @$keys; $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start Foreign Key Constraints for: $schema_name.$table_name\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; foreach my $fk (@keys_in_order) { my $export_fk = ''; my @local_cols; foreach my $col_id (@{$fk->{conkey}}) { push(@local_cols, $table_col_data->{$fk->{fknsp}}{$fk->{fktab}}{attInfo}[$col_id]{attname}); } my @ref_cols; foreach my $col_id (@{$fk->{confkey}}) { push(@ref_cols, $table_col_data->{$fk->{refnsp}}{$fk->{reftab}}{attInfo}[$col_id]{attname}); } my $local_cols = join('","', @local_cols); my $ref_cols = join('","', @ref_cols); map { $fk->{local_cols}{$_} = 1; } @local_cols; map { $fk->{ref_cols}{$_} = 1; } @ref_cols; $export_fk .= "ALTER TABLE \"$fk->{fknsp}\".\"$fk->{fktab}\"\n ADD CONSTRAINT \"$fk->{conname}\" $fk->{def};"; $export_fk .= "\n"; $export_fk .= "COMMENT ON CONSTRAINT \"$fk->{conname}\" ON \"$schema_name\".\"$table_name\" IS \$DESC\$$fk->{description}\$DESC\$;\n" if ($fk->{description}); $export_fk .= "\n"; $Export .= $export_fk; $fk->{export} = $export_fk; } $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End Foreign Key Constraints for: $schema_name.$table_name\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } } # If specified, we'll write out the plain SQL export of what we were given, in terms of schema/table match (or fkdetail) $$sql_export = $Export if ($sql_export); return $fks if ($opts{detail_pass}); return $Export; } ## # Generate SQL CREATE script for all Tables in a given database or schema, or list of tables. # - Will include primary keys, unique constraints, with_oids and comments/ownership on the above. sub ExportTables { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; my $tables = $opts{tables}; # @$tables is a list of 'schema.table' items. my $Export = ''; my $tables_names; if (defined($tables)) { # A friendly header showing the specific tables that were inteded for this dump, if provided. # $Export .= "\n"; $Export .= "-- -----------------------\n"; $Export .= "-- Tables:\n"; foreach my $table (@$tables) { my ($schema_name,$table_name) = split(/\./,$table); my $table_info = GetAllTables(db=> $db, schema => $schema_name, table => $table_name, array => 1); if (!scalar(@$table_info)) { $Export .= "-- WARNING: the Table: $schema_name.$table_name DOES NOT EXIST\n"; print STDERR "The Table given by: $schema_name.$table_name does not exist in the datase\n"; next; } $Export .= "-- $schema_name.$table_name\n"; push @$tables_names, @$table_info; } $Export .= "-- -----------------------\n"; $Export .= "\n"; } else { # array will control the data being returned from GetAllTables $opts{array} = 1; $tables_names = GetAllTables(%opts); } # Output anyway even if the table isn't found to maintain a "stable output" for comparing two different systems # Each system may not have all of the tables, so by outputting this, the diff is easier to follow if ( ! $tables_names || (scalar(@$tables_names) == 0) && $schema && $table ) { $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start Table: $schema.$table\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End Table: $schema.$table\n"; $Export .= "-- ------------------------------------------------------------------------\n"; return $Export; } foreach my $schemtab (@$tables_names) { my ($schema_name, $table_name) = split(/\./, $schemtab); $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start Table: $schema_name.$table_name\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; my $table_col_data = PostgresInfo::GetAllTableColumnsDetail(db => $db, schema => $schema_name, table => $table_name); my $table_settings = PostgresInfo::GetTableInfo (db => $db, schema => $schema_name, table => $table_name); my $pk_col_data = PostgresInfo::GetAllPrimaryKeyDetail (db => $db, schema => $schema_name, table => $table_name); my $uk_col_data = PostgresInfo::GetAllUniqueKeyDetail (db => $db, schema => $schema_name, table => $table_name); # print Dumper({col_data => $table_col_data, settings => $table_settings});exit; my $Seqxport = ''; my $Rowcomments = ''; ################### # Table Definition # Columns (TODO: we should add support for tables without columns) my $cols = $table_col_data->{$schema_name}{$table_name}{colInfo}; # CREATE TABLE is not needed for views. We will use the _RETURN rule definition below $Export .= "CREATE TABLE \"${schema_name}\".\"${table_name}\" (\n"; foreach my $row (@$cols) { $Export .= " \"$row->{attname}\" $row->{displaytypname}"; $Export .= " NOT NULL" if ($row->{attnotnull}); if (defined($row->{defval})) { if( ($row->{defval} =~ m{nextval[(]'(.+?)'::regclass[)]}) ) { # Table has a column set to a sequence. Also check if sequence is owned by column. $Seqxport .= "ALTER TABLE \"$schema_name\".\"$table_name\" ALTER COLUMN \"$row->{attname}\" SET DEFAULT nextval('$1'::regclass);\n"; $Seqxport .= "ALTER SEQUENCE $1 OWNED BY \"$schema_name\".\"$table_name\".\"$row->{attname}\";\n" if defined($row->{colownseq}); } else { $Export .= " DEFAULT $row->{defval}"; } } $Export .= ",\n"; $Rowcomments .= "COMMENT ON COLUMN \"$schema_name\".\"$table_name\".\"$row->{attname}\" IS \$DESC\$$row->{description}\$DESC\$;\n" if defined($row->{description}); } my $pk = $pk_col_data->{$schema_name}{$table_name}; if (defined($pk)) { $Export .= "\n"; my @key_cols; my @key_col_ids = split(/ /, $pk->{indkey}); foreach my $col_id (@key_col_ids) { push(@key_cols, $table_col_data->{$schema_name}{$table_name}{attInfo}[$col_id]{attname}); } my $key_cols = join('","', @key_cols); $Export .= " CONSTRAINT \"$pk->{idxname}\" PRIMARY KEY (\"$key_cols\"),\n"; } #################### # Unique Constraints my $uniques_result = $uk_col_data->{$schema_name}{$table_name}; if (defined($uniques_result) && scalar(@$uniques_result)) { chop($Export); chop($Export); $Export .= ",\n\n"; } # sort the unique key results so that the output is consistent @$uniques_result = sort { $a->{idxname} cmp $b->{idxname} } @$uniques_result if $uniques_result; foreach my $row (@$uniques_result) { my @unique_cols; my @unique_col_ids = split(/ /, $row->{indkey}); foreach my $col_id (@unique_col_ids) { push(@unique_cols, $table_col_data->{$schema_name}{$table_name}{attInfo}[$col_id]{attname}); } my $unique_cols = join('","', @unique_cols); $Export .= " CONSTRAINT \"$row->{idxname}\" UNIQUE (\"$unique_cols\"),\n"; } #################### # OIDS, COMMENTS and OWNERSHIP chop($Export); chop($Export); $Export .= "\n)\n"; $Export .= "WITH (\n OIDS="; $Export .= $table_settings->[0]{relhasoids} ? "TRUE" : "FALSE"; $Export .= "\n);\n"; $Export .= "ALTER TABLE \"$schema_name\".\"$table_name\" OWNER TO $table_settings->[0]{relowner};\n"; $Export .= $Seqxport if $Seqxport; $Export .= "COMMENT ON TABLE \"$schema_name\".\"$table_name\" IS \$DESC\$$table_settings->[0]{description}\$DESC\$;\n" if ($table_settings->[0]{description}); $Export .= $Rowcomments if $Rowcomments; $Export .= "COMMENT ON CONSTRAINT \"$pk->{idxname}\" ON \"$schema_name\".\"$table_name\" IS \$DESC\$$pk->{description}\$DESC\$;\n" if ($pk->{description}); foreach my $unique (@$uniques_result) { $Export .= "COMMENT ON CONSTRAINT \"$unique->{idxname}\" ON \"$schema_name\".\"$table_name\" IS \$DESC\$$unique->{description}\$DESC\$;\n" if ($unique->{description}); } $Export .= "\n"; $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- End Table: $schema_name.$table_name\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } return $Export; } ## # Generate SQL CREATE script for all Tables in a given database or schema, or list of schema.function items. # sub ExportFunctions { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $function = $opts{func_name}; my $functions = $opts{functions}; # @$functions is a list of 'schema.table' items. my $funcs_info = $opts{raw_info} // $opts{funcs_info}; # raw output from GetFunctionsFromSchema() to be used for export instead of SQL DDL # funcs_info for backwards compat my $Export = ''; if (!defined($funcs_info) && defined($functions)) { # A friendly header showing the specific functions that were inteded for this dump, if provided. $Export .= "-- ----------------------------------\n"; $Export .= "-- Functions:\n"; foreach my $func (@$functions) { my ($schema_name,$func_name) = split(/\./,$func); my $func_info = GetFunctionsFromSchema(db => $db, schema => $schema_name, func_name => $func_name); if (!scalar(@$func_info)) { $Export .= "-- WARNING: the Function: $schema_name.$func_name DOES NOT EXIST\n"; print STDERR "The Function given by: $schema_name.$func_name does not exist in the database\n"; next; } $Export .= "-- $schema_name.$func_name\n"; push @$funcs_info, @$func_info; } $Export .= "-- -----------------------\n"; $Export .= "\n"; } elsif (!defined($funcs_info)) { $funcs_info = GetFunctionsFromSchema(%opts); } # Add an element 'args_types_list' to each function data that is the comma separated list of the argument types for that function. used for sorting and comments. @$funcs_info = sort { "$a->{nspname}.$a->{proname}($a->{args_types_list})" cmp "$b->{nspname}.$b->{proname}($b->{args_types_list})" } @$funcs_info; foreach my $func (@$funcs_info) { $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- ---- Start Function: $func->{nspname}.$func->{proname}($func->{args_types_list})\n"; $Export .= "-- ------------------------------------------------------------------------\n\n"; $Export .= $func->{function_sql} . "\n"; $Export .= "-- -----------------------------------------------------------------------\n"; $Export .= "-- ---- End Function: $func->{nspname}.$func->{proname}($func->{args_types_list})\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } return $Export; } sub ExportTablesWithAlterations { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; my $tables = $opts{tables}; # @$functions is a list of 'schema.table' items. my $Export = ''; foreach my $schemtab (@$tables) { my ($schema_name, $table_name) = split(/\./,$schemtab); $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- -- Start Table Dump ($schema_name.$table_name) with all alterations\n"; $Export .= "-- ------------------------------------------------------------------------\n"; if (ViewExists(db => $db, schema => $schema_name, view => $table_name)) { # the table is a view. treat it accordingly. $Export .= PostgresInfo::ExportViews (db => $db, schema => $schema_name, view => $table_name); $Export .= PostgresInfo::ExportRules (db => $db, schema => $schema_name, table => $table_name); } else { $Export .= PostgresInfo::ExportTables (db => $db, schema => $schema_name, table => $table_name); $Export .= PostgresInfo::ExportChecks (db => $db, schema => $schema_name, table => $table_name); $Export .= PostgresInfo::ExportIndexes (db => $db, schema => $schema_name, table => $table_name); $Export .= PostgresInfo::ExportTriggers (db => $db, schema => $schema_name, table => $table_name); $Export .= PostgresInfo::ExportRules (db => $db, schema => $schema_name, table => $table_name); $Export .= PostgresInfo::ExportForeignKeys(db => $db, schema => $schema_name, table => $table_name); } $Export .= "-- ------------------------------------------------------------------------\n"; $Export .= "-- -- End Table Dump ($schema_name.$table_name) with all alterations\n"; $Export .= "-- ------------------------------------------------------------------------\n"; } if ( $schema ) { $Export .= PostgresInfo::ExportFunctions(db => $db, schema => $schema); $Export .= PostgresInfo::ExportViews (db => $db, schema => $schema); } return $Export; } ################################################################################ # Action/Utility Functions ## # Given a schema.table, find all the serials that its columns use, and make sure they are up to date # sub UpdateSerials { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; $opts{LoggerFunc} //= sub {}; my $cols = PostgresInfo::GetAllTableColumnsDetail(db => $db, schema => $schema, table => $table, serials => 1); my @updates; foreach my $col (@$cols) { if ($col->{type} eq 'text') { $opts{LoggerFunc}->("--- Not Updating Serial: $schema.$table -- $col->{serial} [$col->{col}] -> Text ID Col (PreFixed)"); next; } # say "GET last_value FROM $schema.$table (Because Sequence: $col->{schema}.$col->{serial})"; my $table_exists = GetTableInfo(db => $db, schema => $schema, table => $table); if (!scalar(@$table_exists)) { $opts{LoggerFunc}->("--- Not Updating Serial: $schema.$table -- Table does not exist!"); next; } if (!defined($col->{serial})) { $opts{LoggerFunc}->("--- Not Updating Serial: $schema.$table -- No serials ??"); next; } my $seq = $db->select(qq{SELECT $col->{col} as last_value FROM "$schema"."$table" ORDER BY $col->{col} DESC LIMIT 1}, {singleRow => 1}); if (!defined($seq->{last_value})) { $opts{LoggerFunc}->("--- Not Updating Serial: $schema.$table -- $col->{serial} [$col->{col}] -> No Last Value"); next; } if (!defined($col->{schema}) || !defined($col->{serial})) { $opts{LoggerFunc}->("--- Not Updating Serial: $schema.$table -- COULT NOT FIND SERIAL"); print Dumper($col); next; } if ($seq->{last_value} <= 0) { $opts{LoggerFunc}->("--- Not Updating Serial: $schema.$table -- Detected new serial at $seq->{last_value} ??"); print Dumper($col); next; } $opts{LoggerFunc}->("($schema.$table) $col->{schema}.$col->{serial} = $seq->{last_value}"); $db->select('SELECT setval(?::regclass, ?)', ["$col->{schema}.$col->{serial}", $seq->{last_value}]); $opts{LoggerFunc}->("--> Updated Table: $schema.$table -- Serial: $col->{schema}.$col->{serial} [$col->{col}] -> $seq->{last_value}"); push(@updates, {schema => $schema, col => $col->{col}, new_value => $seq->{last_value}}); } return \@updates; } ## # Disable Triggers in given schema/table # or all triggers in scheme if only schema specified, # or all triggers, if schema/table unspecified # sub DoDisableTriggers { my (%opts) = @_; my $db = $opts{db}; my $schema = $opts{schema}; my $table = $opts{table}; # Disable triggers now, re-enable them later my $triggers_detail = PostgresInfo::GetTriggersFromSchema(db => $db, schema => $schema, table => $table); my $triggers_enable = ''; foreach my $trg (@$triggers_detail) { next if (!$trg->{tgenabled}); next if ($trg->{event_object_table} =~ /^v_/); # Don't need to worry about view triggers $db->execute("ALTER TABLE \"$trg->{event_object_schema}\".\"$trg->{event_object_table}\" DISABLE TRIGGER \"$trg->{trigger_name}\";"); $triggers_enable .= "ALTER TABLE \"$trg->{event_object_schema}\".\"$trg->{event_object_table}\" ENABLE TRIGGER \"$trg->{trigger_name}\";\n"; } return $triggers_enable; } 1;