# $Id: Oracle.pm,v 1.51 2002/05/22 15:26:01 rvsutherland Exp $ # # Copyright (c) 2000, 2001 Richard Sutherland - United States of America # # See COPYRIGHT section in pod text below for usage and distribution rights. # require 5.004; BEGIN { $DDL::Oracle::VERSION = "1.11"; # Also update version in pod text below! } package DDL::Oracle; use strict; my $block_size; my $dbh; my $ddl; my $host; my $instance; my $isasnapindx; my $isasnaptabl; my $oracle_major; my $oracle_minor; my $oracle_release; my $sth; my @size_arr; my %attr; my %compile = ( 'function' => \&_compile, 'package' => \&_compile_package, 'procedure' => \&_compile, 'trigger' => \&_compile, 'view' => \&_compile, ); my %create = ( 'comments' => \&_create_comments, 'components' => \&_create_components, 'constraint' => \&_create_constraint, 'database link' => \&_create_db_link, 'exchange index' => \&_create_exchange_index, 'exchange table' => \&_create_exchange_table, 'function' => \&_create_function, 'index' => \&_create_index, 'materialized view' => \&_create_materialized_view, 'materialized view log' => \&_create_materialized_view_log, 'package' => \&_create_package, 'package body' => \&_create_package_body, 'procedure' => \&_create_procedure, 'profile' => \&_create_profile, 'role' => \&_create_role, 'rollback segment' => \&_create_rollback_segment, 'schema' => \&_create_schema, 'sequence' => \&_create_sequence, 'snapshot' => \&_create_snapshot, 'snapshot log' => \&_create_snapshot_log, 'synonym' => \&_create_synonym, 'table' => \&_create_table, 'table family' => \&_create_table_family, 'tablespace' => \&_create_tablespace, 'trigger' => \&_create_trigger, 'type' => \&_create_type, 'user' => \&_create_user, 'view' => \&_create_view, ); my %drop = ( 'constraint' => \&_drop_constraint, 'database link' => \&_drop_database_link, 'dimension' => \&_drop_schema_object, 'directory' => \&_drop_object, 'function' => \&_drop_schema_object, 'index' => \&_drop_schema_object, 'library' => \&_drop_object, 'materialized view' => \&_drop_schema_object, 'materialized view log' => \&_drop_materialized_view_log, 'package' => \&_drop_schema_object, 'procedure' => \&_drop_schema_object, 'profile' => \&_drop_profile, 'role' => \&_drop_object, 'rollback segment' => \&_drop_object, 'sequence' => \&_drop_schema_object, 'snapshot' => \&_drop_schema_object, 'snapshot log' => \&_drop_snapshot_log, 'synonym' => \&_drop_synonym, 'table' => \&_drop_table, 'tablespace' => \&_drop_tablespace, 'trigger' => \&_drop_schema_object, 'type' => \&_drop_schema_object, 'user' => \&_drop_user, 'view' => \&_drop_schema_object, ); my %show_space = ( 'index' => \&_show_free_space, 'table' => \&_show_free_space, 'cluster' => \&_show_free_space, ); my %resize = ( 'index' => \&_resize_index, 'table' => \&_resize_table, ); ############################# Class Methods ############################ sub configure { my ( $class, %args ) = @_; # Turn warnings off $^W = 0; $dbh = $args{ 'dbh' }; $attr{ 'view' } = ( "\U$args{ 'view' }" eq 'USER' ) ? 'USER' : 'DBA'; $attr{ 'schema' } = ( exists $args{ 'schema' } ) ? $args{ 'schema' } : 1; $attr{ 'resize' } = ( exists $args{ 'resize' } ) ? $args{ 'resize' } : 1; $attr{ 'prompt' } = ( exists $args{ 'prompt' } ) ? $args{ 'prompt' } : 1; $attr{ 'grants' } = ( exists $args{ 'grants' } ) ? $args{ 'grants' } : 0; $attr{ 'heading' } = ( exists $args{ 'heading' } ) ? $args{ 'heading' } : 1; $attr{ 'storage' } = ( exists $args{ 'storage' } ) ? $args{ 'storage' } : 1; $attr{ 'tblspace'} = ( exists $args{ 'tblspace'} ) ? $args{ 'tblspace'} : 1; _set_sizing(); _get_oracle_release(); } sub new { my ( $class, %args ) = @_; my $self = {}; $self->{ type } = $args{ type } || die "\nAttribute 'type' is required " . "in call to method 'new'.\n\n";; $self->{ list } = $args{ list } || die "\nAttribute 'list' is required " . "in call to method 'new'.\n\n";; return bless $self, $class; } ########################### Instance Methods ########################### sub compile { my $self = shift; my $type = lc( $self->{ type } ); die "\nObject type '$type' is invalid for 'compile' method.\n\n" unless $compile{ $type }; my $list = $self->{ list }; my $class = ref( $self ); _generate_heading( $class, 'COMPILE', $type, $list ); foreach my $row ( @$list ) { my ( $owner, $name ) = @$row; my $schema = _set_schema( $owner ); $ddl .= $compile{ $type }->( $schema, $owner, $name, $attr{ view }, $type, ); } _scratch_prompts() unless $attr{ prompt }; return $ddl; } sub create { my $self = shift; my $type = lc( $self->{ type } ); die "\nObject type '$type' is invalid for 'create' method.\n\n" unless $create{ $type }; my $list = $self->{ list }; my $class = ref( $self ); _generate_heading( $class, 'CREATE', $type, $list ); foreach my $row ( @$list ) { my ( $owner, $name ) = @$row; my $schema = _set_schema( $owner ); $ddl .= $create{ $type }->( $schema, $owner, $name, $attr{ view } ); } _scratch_prompts() unless $attr{ prompt }; return $ddl; } sub drop { my $self = shift; my $type = lc( $self->{ type } ); die "\nObject type '$type' is invalid for 'drop' method.\n\n" unless $drop{ $type }; my $list = $self->{ list }; my $class = ref( $self ); _generate_heading( $class, 'DROP', $type, $list ); foreach my $row ( @{ $self->{ list } } ) { my ( $owner, $name ) = @$row; my $schema = _set_schema( $owner ); $ddl .= $drop{ $type }->( $schema, $name, $type, $owner, $attr{ view } ); } _scratch_prompts() unless $attr{ prompt }; return $ddl; } sub show_space { my $self = shift; my $type = lc( $self->{ type } ); die "\nObject type '$type' is invalid for 'show_space' method.\n\n" unless $show_space{ $type }; my $list = $self->{ list }; my $class = ref( $self ); _generate_heading( $class, 'FREE SPACE', $type, $list ); foreach my $row ( @{ $self->{ list } } ) { my ( $owner, $name ) = @$row; $ddl .= $show_space{ $type }->( $owner, $name, $type, $attr{ view } ); } _scratch_prompts() unless $attr{ prompt }; return $ddl; } sub resize { my $self = shift; my $type = lc( $self->{ type } ); die "\nObject type '$type' is invalid for 'resize' method.\n\n" unless $resize{ $type }; my $list = $self->{ list }; my $class = ref( $self ); _generate_heading( $class, 'ALTER', $type, $list ); foreach my $row ( @{ $self->{ list } } ) { my ( $owner, $name ) = @$row; my $schema = _set_schema( $owner ); $ddl .= $resize{ $type }->( $schema, $owner, $name, $attr{ view } ); } _scratch_prompts() unless $attr{ prompt }; return $ddl; } ############################ Private Methods ########################### # sub _compile # # Returns DDL to compile the named object in the form of: # # ALTER [schema.] COMPILE [PACKAGE|BODY] # sub _compile { my ( $schema, $owner, $name, $view, $type ) = @_; $type = uc( $type ); my $type1 = ( $type eq 'PACKAGE BODY' ) ? 'PACKAGE' : $type; my $type2 = ( $type eq 'PACKAGE BODY' ) ? ' BODY' : ( $type eq 'PACKAGE' ) ? ' PACKAGE' : undef; my $stmt = " SELECT 'Standing tall with my boots on!' FROM ${view}_objects WHERE object_name = UPPER( ? ) AND object_type = ? "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $type ); my @row = $sth->fetchrow_array; die "\u\L$type \U$name \Ldoes not exist.\n\n" unless @row; return "PROMPT " . "ALTER $type1 \L$schema$name \UCOMPILE$type2 \n\n" . "ALTER $type1 \L$schema$name \UCOMPILE$type2 ;\n\n"; } # sub _compile_package # # Returns DDL to compile the named object in the form of: # # ALTER [schema.] COMPILE [PACKAGE|BODY] # sub _compile_package { my ( $schema, $owner, $name, $view, $type ) = @_; my $sql; my $stmt = " SELECT 'Standing around with only my socks on!' FROM ${view}_objects WHERE object_name = UPPER( ? ) AND object_type = ? "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name, 'PACKAGE' ); my @row = $sth->fetchrow_array; die "Package \U$name \Ldoes not exist.\n\n" unless @row; $sql = _compile( @_ ); $sth->execute( $name, 'PACKAGE BODY' ); @row = $sth->fetchrow_array; $sql .= _compile( $schema, $owner, $name, $view, 'PACKAGE BODY' ) if @row; return $sql; } #sub _constraint_columns # # Returns a formatted string containing the constraint columns. # sub _constraint_columns { my ( $owner, $name, $view, ) = @_; my $stmt = " SELECT LOWER(column_name) FROM ${view}_cons_columns WHERE owner = UPPER( ? ) AND constraint_name = UPPER( ? ) ORDER BY position "; $sth = $dbh->prepare( $stmt ); $sth->execute( $owner, $name ); my $aref = $sth->fetchall_arrayref; my @cols; foreach my $row ( @$aref ) { push @cols, $row->[0]; } return "(\n " . join ( "\n , ", @cols ) . "\n)\n"; } # sub _create_comments # # Returns DDL to create the comments on the named table and its columns # in the form of: # # COMMENT ON TABLE [schema.] IS '' # COMMENT ON COLUMN [schema.]. IS '' # sub _create_comments { my ( $schema, $owner, $name, $view ) = @_; my $sql; my $stmt = " SELECT comments FROM ${view}_tab_comments WHERE table_name = UPPER( ? ) AND comments IS NOT null "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { @$row->[0] =~ s/'/''/g; $sql .= "PROMPT " . "COMMENT ON TABLE \L$schema$name \UIS \E'@$row->[0]' \n\n" . "COMMENT ON TABLE \L$schema$name \UIS \E'@$row->[0]' ;\n\n"; } $stmt = " SELECT column_name , comments FROM ${view}_col_comments WHERE table_name = UPPER( ? ) AND comments IS NOT null "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { @$row->[1] =~ s/'/''/g; $sql .= "PROMPT " . "COMMENT ON COLUMN \L$schema$name.@$row->[0] " . "IS '@$row->[1]' \n\n" . "COMMENT ON COLUMN \L$schema$name.@$row->[0] " . "IS '@$row->[1]' ;\n\n"; } return $sql; } # sub _create_components # # Returns DDL to create ALL objects of the following object types: # # TABLESPACE # ROLLBACK SEGMENT # PUBLIC DATABASE LINK # PUBLIC SYNONYM # PROFILE # ROLE # USER # sub _create_components { ( undef, undef, undef, my $view ) = @_; die "\nYou must use the DBA views in order to CREATE COMPONENTS\n\n" unless $view eq 'DBA'; my $sql; my $stmt; my $aref; my $row; # Get tablespaces $stmt = " SELECT tablespace_name FROM dba_tablespaces ORDER BY tablespace_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach $row ( @$aref ) { $sql .= _create_tablespace( undef, undef, @$row->[0], $view ); } # Get rollback segments $stmt = " SELECT segment_name FROM dba_rollback_segs ORDER BY segment_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach $row ( @$aref ) { $sql .= _create_rollback_segment( undef, undef, @$row->[0], $view ); } # Get PUBLIC database links $stmt = " SELECT db_link FROM dba_db_links WHERE owner = 'PUBLIC' ORDER BY db_link "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach $row ( @$aref ) { $sql .= _create_db_link( 'PUBLIC ', 'PUBLIC', @$row->[0], $view ); } # Get PUBLIC synonyms $stmt = " SELECT owner , synonym_name FROM dba_synonyms WHERE owner = 'PUBLIC' ORDER BY owner , synonym_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach $row ( @$aref ) { my ( $owner, $name ) = @$row; my $schema = _set_schema( $owner ); $sql .= _create_synonym( $schema, $owner, $name, $view ); } # Get profiles $stmt = " SELECT DISTINCT profile FROM dba_profiles ORDER BY profile "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach $row ( @$aref ) { $sql .= _create_profile( undef, undef, @$row->[0], $view ); } # Get roles $stmt = " SELECT role FROM dba_roles ORDER BY role "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach $row ( @$aref ) { $sql .= _create_role( undef, undef, @$row->[0], $view ); } # Get users $stmt = " SELECT username FROM dba_users WHERE username NOT IN ( 'NEXT_USER' , 'PUBLIC' , 'SYS' , 'SYSTEM' ) ORDER BY username "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach $row ( @$aref ) { $sql .= _create_user( undef, undef, @$row->[0], $view ); } return $sql; } # # # sub _create_constraint # # Returns DDL to create the named constraint in the form of: # # ALTER TABLE [schema.] ADD CONSTRAINT # [ # sub _create_constraint { my ( $schema, $owner, $name, $view ) = @_; my $sql; my $stmt; if ( $oracle_major == 7 ) { $stmt = " SELECT table_name , constraint_type , search_condition , r_owner , r_constraint_name , delete_rule , DECODE( status ,'ENABLED','ENABLE' , 'DISABLE' ) as enagle FROM ${view}_constraints cn WHERE owner = UPPER( ? ) AND constraint_name = UPPER( ? ) "; } else { $stmt = " SELECT table_name , constraint_type , search_condition , r_owner , r_constraint_name , delete_rule , DECODE( status ,'ENABLED','ENABLE' , 'DISABLE' ) as enagle , deferrable , deferred FROM ${view}_constraints cn WHERE owner = UPPER( ? ) AND constraint_name = UPPER( ? ) "; } $dbh->{ LongReadLen } = 8192; # Allows SEARCH_CONDITION length of 8K $dbh->{ LongTruncOk } = 1; $sth = $dbh->prepare( $stmt ); $sth->execute( $owner, $name ); my @row = $sth->fetchrow_array; my ( $table, $cons_type, $condition, $r_owner, $r_cons_name, $delete_rule, $enable, $deferrable, $deferred, ) = @row; $sql = "PROMPT " . "ALTER TABLE \L$schema$table \UADD CONSTRAINT \L$name "; $sql .= ( $cons_type eq 'P' ) ? "PRIMARY KEY\n\n" : ( $cons_type eq 'U' ) ? "UNIQUE\n\n" : ( $cons_type eq 'R' ) ? "FOREIGN KEY\n\n" : "CHECK\n\n"; $sql .= "ALTER TABLE \L$schema$table \UADD CONSTRAINT \L$name " ; $sql .= ( $cons_type eq 'P' ) ? "PRIMARY KEY\n" : ( $cons_type eq 'U' ) ? "UNIQUE\n" : ( $cons_type eq 'R' ) ? "FOREIGN KEY\n" : "\nCHECK ($condition)\n"; if ( $cons_type ne 'C' ) { $sql .= _constraint_columns( $owner, $name, $view, ); } if ( $cons_type eq 'R' ) { $stmt = " SELECT table_name FROM ${view}_constraints WHERE constraint_name = UPPER( ? ) AND owner = UPPER( ? ) "; $sth = $dbh->prepare( $stmt ); $sth->execute( $r_cons_name, $r_owner ); my ( $table_name ) = $sth->fetchrow_array; $sql .= "REFERENCES \L$r_owner\.$table_name\n" . _constraint_columns( $r_owner, $r_cons_name, $view ); if ( $delete_rule eq 'CASCADE' ) { $sql .= "ON DELETE CASCADE\n"; } } if ( $oracle_major < 8 ) { # Syntax for Oracle7 doesn't like the ENABLE clause $sql .= "$enable\n" unless $enable eq 'ENABLE'; } else { $sql .= "$deferrable\n" . "INITIALLY $deferred\n"; if ( $enable eq 'ENABLE' ) { $sql .= "ENABLE NOVALIDATE\n"; } else { $sql .= "DISABLE\n"; } } return $sql . ";\n\n"; } # sub _create_db_link # # Returns DDL to create the named database link in the form of: # # CREATE [PUBLIC] DATABASE LINK # CONNECT TO IDENTIFIED BY # USING '' # sub _create_db_link { my ( $schema, $owner, $name, $view ) = @_; my $msg = "\nYou must use the DBA views in order to " . "CREATE a PUBLIC DATABASE LINK\n\n"; if ( "\U$owner" eq 'PUBLIC' and $view ne 'DBA' ) { die $msg; } my $sql; my $stmt; if ( $view eq 'DBA' ) { $stmt = " SELECT l.userid , l.password , l.host FROM sys.link\$ l , sys.user\$ u WHERE u.name = UPPER('$owner') AND l.owner\# = u.user\# AND l.name LIKE UPPER('${name}%') "; } else # view is USER { $stmt = " SELECT username , password , host FROM user_db_links WHERE db_link LIKE UPPER('${name}%') "; } $sth = $dbh->prepare( $stmt ); $sth->execute; my @row = $sth->fetchrow_array; die "Database Link \U$name \Ldoes not exist.\n\n" unless @row; my ( $user, $password, $host ) = @row; my $is_public = ( "\U$owner" eq 'PUBLIC' ) ? ' PUBLIC' : ''; return "PROMPT " . "CREATE$is_public DATABASE LINK \L$name\n\n" . "CREATE$is_public DATABASE LINK \L$name\n" . "CONNECT TO \L$user \UIDENTIFIED BY \L$password\n" . "USING '$host'\n" . ";\n\n"; } # sub _create_exchange_index # # Returns DDL to create a temporary table as a mirror of the named partition. # See sub _create_table for the format. Physical attributes come from the # partition. # sub _create_exchange_index { my ( $schema, $owner, $name, $view ) = @_; ( $name, my $partition ) = split /:/, $name; my $sql; my $stmt = " SELECT SUBSTR(segment_type,7) AS type , blocks FROM ${view}_segments WHERE segment_name = UPPER( ? ) AND partition_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $partition ); my @row = $sth->fetchrow_array; die "Partition \U$partition \Lof \EIndex \U$name \Ldoes not exist,\n" unless @row; my ( $type, $blocks, ) = @row; $stmt = " SELECT LTRIM(i.degree) , LTRIM(i.instances) , i.table_name , DECODE( i.uniqueness ,'UNIQUE',' UNIQUE' ,null ) AS uniqueness , DECODE( i.index_type ,'BITMAP',' BITMAP' ,null ) AS index_type -- Physical Properties , 'INDEX' AS organization -- Segment Attributes , 'N/A' AS cache , 'N/A' AS pct_used , p.pct_free , DECODE( p.ini_trans ,0,1 ,null,1 ,p.ini_trans ) AS ini_trans , DECODE( p.max_trans ,0,255 ,null,255 ,p.max_trans ) AS max_trans -- Storage Clause , p.initial_extent , p.next_extent , p.min_extent , DECODE( p.max_extent ,2147483645,'unlimited' , p.max_extent ) AS max_extent , p.pct_increase , NVL(p.freelists,1) , NVL(p.freelist_groups,1) , LOWER(p.buffer_pool) AS buffer_pool , DECODE( p.logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(p.tablespace_name) AS tablespace_name , $blocks AS blocks FROM ${view}_indexes i , ${view}_ind_${type}s p WHERE p.index_name = UPPER( ? ) AND p.${type}_name = UPPER( ? ) AND i.index_name = p.index_name "; if ( $view eq 'DBA' ) { $stmt .= " AND p.index_owner = UPPER('$owner') AND i.owner = p.index_owner "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $partition ); @row = $sth->fetchrow_array; my $degree = shift @row; my $instances = shift @row; my $table = shift @row; my $unique = shift @row; my $bitmap = shift @row; $sql = "PROMPT " . "CREATE$unique$bitmap INDEX \L$schema$name \UON \L$schema$table\n\n" . "CREATE$unique$bitmap INDEX \L$schema$name \UON \L$schema$table\n" . _index_columns( '', $owner, $name, $view, ) . "PARALLEL\n" . "(\n" . " DEGREE $degree\n" . " INSTANCES $instances\n" . ")\n"; unshift @row, ( '' ); # Indent (none) $sql .= _segment_attributes( \@row ) . ";\n\n"; return $sql; } # sub _create_exchange_table # # Returns DDL to create a temporary table as a mirror of the named partition. # See sub _create_table for the format. Physical attributes come from the # partition. # sub _create_exchange_table { my ( $schema, $owner, $name, $view ) = @_; ( $name, my $partition ) = split /:/, $name; my $stmt = " SELECT SUBSTR(segment_type,7) AS type , blocks FROM ${view}_segments WHERE segment_name = UPPER( '$name' ) AND partition_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $partition ); my @row = $sth->fetchrow_array; die "Partition \U$partition \Lof \ETable \U$name \Ldoes not exist,\n" unless @row; my ( $type, $blocks, ) = @row; $stmt = " SELECT DECODE( t.monitoring ,'NO','NOMONITORING' , 'MONITORING' ) AS monitoring , t.table_name , LTRIM(t.degree) AS degree , LTRIM(t.instances) AS instances , 'HEAP' AS organization , DECODE( t.cache ,'y','CACHE' , 'NOCACHE' ) AS cache , p.pct_used , p.pct_free , p.ini_trans , p.max_trans , p.initial_extent , p.next_extent , p.min_extent , DECODE( p.max_extent ,2147483645,'unlimited' ,p.max_extent ) AS max_extents , p.pct_increase , p.freelists , p.freelist_groups , LOWER(p.buffer_pool) AS buffer_pool , DECODE( p.logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(p.tablespace_name) AS tablespace_name , $blocks - NVL(p.empty_blocks,0) AS blocks FROM dba_tables t , dba_tab_${type}s p WHERE p.table_name = UPPER('$name') AND p.${type}_name = UPPER('$partition') AND t.table_name = p.table_name "; if ( $view eq 'DBA' ) { $stmt .= " AND p.table_owner = UPPER('$owner') AND t.owner = p.table_owner "; } return _create_table_text( $stmt, $schema, $owner, $name, $view ) . ";\n\n"; } # sub _create_function # # Returns DDL to create the named procedure in the form of: # # CREATE OR REPLACE FUNCTION [schema.] # AS # # # by calling _display_source # sub _create_function { my ( $schema, $owner, $name, $view ) = @_; my $sql = _display_source( $schema, $owner, $name, $view, 'FUNCTION' ); if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $owner, $name, $view ); } return $sql ; } # sub _create_index # # Returns DDL to create the named index and its partition(s) in the form of: # # CREATE INDEX [schema1.] ON [schema2.] # ( # # ) # INDEXTYPE IS -- for domain indexes # PARAMETERS -- for domain indexes # [NO]MONIOTORING # PARALLEL # ( # DEGREE # INSTANCES # ) # PCTFREE # INITRANS # MAXTRANS # STORAGE # ( # # ) # [NO]LOGING # TABLESPACE # [] # sub _create_index { my ( $schema, $owner, $name, $view ) = @_; my $sql; my $stmt; if ( $oracle_major == 7 ) { $stmt = " SELECT 'N/A' AS partitioned , table_name , table_owner , DECODE( uniqueness ,'UNIQUE',' UNIQUE' ,null ) , null AS bitmap , null AS domain FROM ${view}_indexes WHERE index_name = UPPER( ? ) "; } else # We're Oracle8 or newer { $stmt = " SELECT partitioned , table_name , table_owner , DECODE( uniqueness ,'UNIQUE',' UNIQUE' ,null ) , DECODE( index_type ,'BITMAP',' BITMAP' ,null ) , DECODE( index_type ,'DOMAIN','DOMAIN' ,null ) FROM ${view}_indexes WHERE index_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my @row = $sth->fetchrow_array; die "Index \U$name \Ldoes not exist.\n\n" unless @row; my ( $partitioned, $table, $table_owner, $unique, $bitmap, $domain, ) = @row; my ( $dom_owner, $dom_name, $dom_param ); if ( $domain eq 'DOMAIN') { $stmt = " SELECT ityp_owner , ityp_name , parameters FROM ${view}_indexes WHERE index_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my @row = $sth->fetchrow_array; ( $dom_owner, $dom_name, $dom_param ) = @row; } if ( $oracle_major == 7 ) { $stmt = " SELECT 'N/A' AS degree , 'N/A' AS instances , 0 AS compressed -- Physical Properties , 'INDEX' AS organization -- Segment Attributes , 'N/A' AS cache , 'N/A' AS pct_used , i.pct_free , DECODE( i.ini_trans ,0,1 ,null,1 ,i.ini_trans ) AS ini_trans , DECODE( i.max_trans ,0,255 ,null,255 ,i.max_trans ) AS max_trans -- Storage Clause , i.initial_extent , i.next_extent , i.min_extents , DECODE( i.max_extents ,2147483645,'unlimited' , i.max_extents ) AS max_extents , i.pct_increase , NVL(i.freelists,1) , NVL(i.freelist_groups,1) , 'N/A' AS buffer_pool , 'N/A' AS logging , LOWER(i.tablespace_name) AS tablespace_name , s.blocks FROM ${view}_indexes i , ${view}_segments s WHERE i.index_name = UPPER( ? ) AND s.segment_name = i.index_name "; } elsif ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT LTRIM(i.degree) , LTRIM(i.instances) , 0 AS compressed -- Physical Properties , 'INDEX' AS organization -- Segment Attributes , 'N/A' AS cache , 'N/A' AS pct_used , i.pct_free , DECODE( i.ini_trans ,0,1 ,null,1 ,i.ini_trans ) AS ini_trans , DECODE( i.max_trans ,0,255 ,null,255 ,i.max_trans ) AS max_trans -- Storage Clause , i.initial_extent , i.next_extent , i.min_extents , DECODE( i.max_extents ,2147483645,'unlimited' , i.max_extents ) AS max_extents , i.pct_increase , NVL(i.freelists,1) , NVL(i.freelist_groups,1) , LOWER(i.buffer_pool) AS buffer_pool , DECODE( i.logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(i.tablespace_name) AS tablespace_name , s.blocks FROM ${view}_indexes i , ${view}_segments s WHERE i.index_name = UPPER( ? ) AND s.segment_name = i.index_name "; } else # We're Oracle8i or newer { $stmt = " SELECT LTRIM(i.degree) , LTRIM(i.instances) , DECODE( i.compression ,'ENABLED',i.prefix_length ,0 ) AS compressed -- Physical Properties , 'INDEX' AS organization -- Segment Attributes , 'N/A' AS cache , 'N/A' AS pct_used , i.pct_free , DECODE( i.ini_trans ,0,1 ,null,1 ,i.ini_trans ) AS ini_trans , DECODE( i.max_trans ,0,255 ,null,255 ,i.max_trans ) AS max_trans -- Storage Clause , i.initial_extent , i.next_extent , i.min_extents , DECODE( i.max_extents ,2147483645,'unlimited' , i.max_extents ) AS max_extents , i.pct_increase , NVL(i.freelists,1) , NVL(i.freelist_groups,1) , LOWER(i.buffer_pool) AS buffer_pool , DECODE( i.logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(i.tablespace_name) AS tablespace_name , s.blocks FROM ${view}_indexes i , ${view}_segments s WHERE i.index_name = UPPER( ? ) AND s.segment_name = i.index_name "; } if ( $view eq 'DBA' ) { $stmt .= " AND i.owner = UPPER('$owner') AND s.owner = i.owner "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); @row = $sth->fetchrow_array; my $degree = shift @row; my $instances = shift @row; my $compressed = shift @row; my $schema2 = _set_schema( $table_owner ); $sql = "PROMPT " . "CREATE$unique$bitmap INDEX \L$schema$name \UON \L$schema2$table\n\n" . "CREATE$unique$bitmap INDEX \L$schema$name \UON \L$schema2$table\n" . _index_columns( '', $owner, $name, $view, ); if ( $domain eq 'DOMAIN' ) { return $sql . qq!INDEXTYPE IS "$dom_owner"."$dom_name"\nPARAMETERS ('$dom_param') ;\n\n!; } if ( $oracle_major > 7 ) { $sql .= "PARALLEL\n" . "(\n" . " DEGREE $degree\n" . " INSTANCES $instances\n" . ")\n"; } if ( $partitioned eq 'YES' ) { return _create_partitioned_index( $schema, $owner, $name, $view, $sql ) } else # Plain ol' non-partitioned index { unshift @row, ( '' ); # Indent (none) $sql .= _segment_attributes( \@row ); if ( $compressed ) { $sql .= "COMPRESS $compressed\n"; } return $sql .= ";\n\n"; } } # sub _create_iot # # Returns DDL to create the index organized table and its partition(s). # See _create_table for format. # sub _create_iot { my ( $schema, $owner, $name, $view ) = @_; my $stmt; if ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT 'N/A' AS monitoring , logging , blocks - NVL(empty_blocks,0) FROM ${view}_all_tables WHERE table_name = UPPER( ? ) "; } else { $stmt = " SELECT DECODE( monitoring ,'NO','NOMONITORING' , 'MONITORING' ) AS monitoring , logging , blocks - NVL(empty_blocks,0) FROM ${view}_all_tables WHERE table_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } my $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my ( $monitoring, $logging, $blocks, ) = $sth->fetchrow_array; if ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT -- Table Properties 'N/A' AS monitoring , 'N/A' AS table_name -- Parallel Clause , LTRIM(degree) , LTRIM(instances) -- Physical Properties , 'INDEX' AS organization -- Segment Attributes , 'N/A' AS cache , 'N/A' AS pct_used , pct_free , DECODE( ini_trans ,0,1 ,null,1 ,ini_trans ) AS ini_trans , DECODE( max_trans ,0,255 ,null,255 ,max_trans ) AS max_trans -- Storage Clause , initial_extent , next_extent , min_extents , DECODE( max_extents ,2147483645,'unlimited' , max_extents ) AS max_extents , pct_increase , NVL(freelists,1) , NVL(freelist_groups,1) , LOWER(buffer_pool) AS buffer_pool , DECODE( '$logging' ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(tablespace_name) AS tablespace_name , DECODE( '$blocks' ,null,GREATEST(initial_extent,next_extent) / ($block_size * 1024) ,'0' ,GREATEST(initial_extent,next_extent) / ($block_size * 1024) ,'$blocks' ) AS blocks FROM ${view}_indexes WHERE table_name = UPPER('$name') "; } else { $stmt = " SELECT -- Table Properties DECODE( '$monitoring' ,'NO','NOMONITORING' , 'MONITORING' ) , 'N/A' AS table_name -- Parallel Clause , LTRIM(degree) , LTRIM(instances) -- Physical Properties , 'INDEX' AS organization -- Segment Attributes , 'N/A' AS cache , 'N/A' AS pct_used , pct_free , DECODE( ini_trans ,0,1 ,null,1 ,ini_trans ) AS ini_trans , DECODE( max_trans ,0,255 ,null,255 ,max_trans ) AS max_trans -- Storage Clause , initial_extent , next_extent , min_extents , DECODE( max_extents ,2147483645,'unlimited' , max_extents ) AS max_extents , pct_increase , NVL(freelists,1) , NVL(freelist_groups,1) , LOWER(buffer_pool) AS buffer_pool , DECODE( '$logging' ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(tablespace_name) AS tablespace_name , DECODE( '$blocks' ,null,GREATEST(initial_extent,next_extent) / ($block_size * 1024) ,'0' ,GREATEST(initial_extent,next_extent) / ($block_size * 1024) ,'$blocks' ) AS blocks FROM ${view}_indexes WHERE table_name = UPPER('$name') "; } if ( $view eq 'DBA' ) { $stmt .= " AND table_owner = UPPER('$owner') "; } my $sql = _create_table_text( $stmt, $schema, $owner, $name, $view ) . "; \n\n" . _create_comments( $schema, $owner, $name, $view ); if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $owner, $name, $view ); } return $sql; } # sub _create_materialized_view # # Returns DDL to create the named materialized view # by calling _create_mview (which is shared with # _create_snapshot) # sub _create_materialized_view { _create_mview( @_, 'MATERIALIZED VIEW' ); } # sub _create_materialized_view_log # # Returns DDL to create the named materialized view log # by calling _create_mview_log (which is shared with # _create_snapshot_log) # sub _create_materialized_view_log { _create_mview_log( @_, 'MATERIALIZED VIEW' ); } # sub _create_mview # # Returns DDL to create the named snapshot or materialized view # in the form of: # # CREATE {MATERIALIZED VIEW|SNAPSHOT} [schema.] #
# sub _create_mview { my ( $schema, $owner, $name, $view, $type ) = @_; my $sql; my $stmt; if ( $oracle_major == 7 ) { $stmt = " SELECT table_name , null AS build_mode , null AS refresh_method ,DECODE( type ,null,null ,'REFRESH ' || type || CHR(10) ) AS refresh_mode , TO_CHAR(start_with, 'DD-MON-YYYY HH24:MI:SS') AS start_with , next , null AS using_pk , null AS master_rollback_seg , DECODE( updatable ,'TRUE','FOR UPDATE' ,null ) AS updatable , query FROM ${view}_snapshots WHERE name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') " } } elsif ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT table_name , null AS build_mode , null AS refresh_method ,DECODE( type ,null,null ,'REFRESH ' || type || CHR(10) ) AS refresh_mode , TO_CHAR(start_with, 'DD-MON-YYYY HH24:MI:SS') AS start_with , next , DECODE( refresh_method ,'PRIMARY KEY','WITH PRIMARY KEY' ,'ROWID' ,'WITH ROWID' ,null ) AS using_pk , master_rollback_seg , DECODE( updatable ,'YES','FOR UPDATE' ,null ) AS updatable , query FROM ${view}_snapshots WHERE name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') " } } else { $stmt = " SELECT m.container_name , DECODE( m.build_mode ,'YES','USING PREBUILT TABLE' ,DECODE( m.last_refresh_date ,null,'BUILD DEFERRED' ,'BUILD IMMEDIATE' ) ) || CHR(10) AS build_mode , DECODE( m.refresh_method ,'NEVER','NEVER REFRESH' ,'REFRESH ' || m.refresh_method ) AS refresh_method , DECODE( m.refresh_mode ,'NEVER',CHR(10) ,'ON ' || m.refresh_mode || CHR(10) ) AS refresh_mode , TO_CHAR(s.start_with, 'DD-MON-YYYY HH24:MI:SS') AS start_with , s.next , DECODE( s.refresh_method ,'PRIMARY KEY','WITH PRIMARY KEY' ,'ROWID' ,'WITH ROWID' ,null ) AS using_pk , s.master_rollback_seg , DECODE( m.updatable ,'N',null ,DECODE( m.rewrite_enabled ,'Y','FOR UPDATE ENABLE QUERY REWRITE' ,'N','FOR UPDATE DISABLE QUERY REWRITE' ) ) AS updatable , s.query FROM ${view}_mviews m , ${view}_snapshots s WHERE m.mview_name = UPPER( ? ) AND s.name = m.mview_name "; if ( $view eq 'DBA' ) { $stmt .= " AND m.owner = UPPER('$owner') AND s.owner = m.owner " } } $dbh->{ LongReadLen } = 65536; # Allows Query to be 64K $dbh->{ LongTruncOk } = 1; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my @row = $sth->fetchrow_array; my $lctype = ( $type eq 'SNAPSHOT' ) ? 'Snapshpt' : 'Materialized View'; die "\n$lctype \U$name \Ldoes not exist.\n\n" unless @row; my ( $table, $build_mode, $refresh_method, $refresh_mode, $start_with, $next, $using_pk, $master_rb_seg, $updatable, $query, ) = @row; $stmt = " SELECT index_name FROM ${view}_indexes WHERE table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $table ); @row = $sth->fetchrow_array; my ( $index ) = @row; $sql = "PROMPT " . "CREATE $type \L$schema$name\n\n" . "CREATE $type \L$schema$name \n" . _create_mview_table( $owner, $owner, $table, $view ) . "$build_mode" . "USING INDEX\n" . _create_mview_index( $schema, $owner, $index, $view ); $sql .= "$refresh_method " if $refresh_method; $sql .= $refresh_mode; if ( $refresh_method ne 'NEVER REFRESH' ) { $sql .= "START WITH TO_DATE('$start_with','DD-MON-YYYY HH24:MI:SS')\n" if $start_with; $sql .= "NEXT $next\n" if $next; $sql .= "$using_pk\n" if $using_pk; $sql .= "USING MASTER ROLLBACK SEGMENT \L$master_rb_seg\n" if $master_rb_seg; } $sql .= "$updatable\n" if $updatable; $sql .= "AS\n" . $query; $sql =~ s/\n+\Z//; $sql .= " ;\n\n"; if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $owner, $name, $view ); } return $sql; } # sub _create_mview_index # # Returns DDL for the USING INDEX definition part of: # # CREATE MATERIALIZED VIEW # CREATE SNAPSHOT # # statements. This is created by calling _create_index, and # then stripping off the PROMPT and CREATE INDEX portions and the # column list, leaving just the physical attributes and partitioning clauses # sub _create_mview_index { # Snapshots don't use attributes PCTUSED and PCTFREE. # This will prevent sub _segment_attributes from including them. $isasnapindx = 1; my $done; my $started; my @lines_in = split /\n/, _create_index( @_ ); my @lines_out; LINE: foreach my $line ( @lines_in ) { # Ignore everything before the INITRANS clause. # This includes REMs, CREATE INDEX, columns, etc. $started++ if $line =~ /^INITRANS/; next LINE if not $started; # Set $done when we hit a semicolon $done = $line =~ s/\;$//; # But keep everything in between except blank lines # and any [NO]LOGGINING clauses push @lines_out, $line unless $line =~ /^$|LOGGING/; # Exit when we get to the semicolon and ignore the rest. # This eliminates the ';' and any COMMENTs. last LINE if $done; } my $sql = join "\n", @lines_out; $isasnapindx = 0; return $sql . "\n"; } # sub _create_mview_log # # Returns DDL to create the named log (snapshot or materialized view) # in the form of: # # CREATE {MATERIALIZED VIEW|SNAPSHOT} LOG [schema.] #
# WITH {PRIMARY KEY|ROWID|PRIMARY KEY, ROWID} # [] # sub _create_mview_log { my ( $schema, $owner, $name, $view, $type ) = @_; my $sql; my $stmt = " SELECT log_table , rowids , primary_key , filter_columns FROM ${view}_snapshot_logs WHERE master = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND log_owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my @row = $sth->fetchrow_array; my $lctype = ( $type eq 'SNAPSHOT' ) ? 'Snapshpt' : 'Materialized View'; die "\n$lctype Log on \U$name \Ldoes not exist.\n\n" unless @row; my ( $table, $rowids, $primary_key, $filter_columns, $refreshable ) = @row; $sql = "PROMPT " . "CREATE $type LOG ON \L$schema$name\n\n" . "CREATE $type LOG ON \L$schema$name \n" . _create_mview_table( $schema, $owner, $table, $view ); if ( $rowids eq 'YES' and $primary_key eq 'YES' ) { $sql .= "WITH PRIMARY KEY, ROWID " } elsif ( $rowids eq 'YES' ) { $sql .= "WITH ROWID " } elsif ( $primary_key eq 'YES' ) { $sql .= "WITH PRIMARY KEY " } $stmt = " SELECT column_name FROM dba_snapshot_log_filter_cols WHERE name = UPPER( ? ) AND owner = UPPER( ? ) MINUS SELECT column_name FROM ${view}_cons_columns c , ${view}_constraints d WHERE d.table_name = UPPER( ? ) AND d.constraint_type = 'P' AND c.table_name = d.table_name AND c.constraint_name = d.constraint_name "; if ( $view eq 'DBA' ) { $stmt .= " AND d.owner = UPPER('$owner') AND c.owner = d.owner "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $owner, $name ); my $aref = $sth->fetchall_arrayref; if ( @$aref ) { my $comma = ' '; $sql .= "\n(\n"; foreach my $row ( @$aref ) { $sql .= "$comma \L$row->[0]\n"; $comma = ' ,' } $sql .= ") "; } return $sql . ";\n\n"; } # sub _create_mview_table # # Returns DDL for the table definition part of: # # CREATE MATERIALIZED VIEW # CREATE MATERIALIZED VIEW LOG # CREATE SNAPSHOT # CREATE SNAPSHOT LOG # # statements. This is created by calling _create_table, and # then stripping off the PROMPT and CREATE TABLE portions and the # column list, leaving just the physical attributes and partitioning clauses # sub _create_mview_table { # Snapshots and their logs don't use attribute INITRANS. # Prior to 8i, they don't use FREELISTS and FREELIST GROUPS, either. # This will prevent sub _segment_attributes from including it. $isasnaptabl = 1; my $done; my $started; my @lines_in = split /\n/, _create_table( @_ ); my @lines_out; LINE: foreach my $line( @lines_in ) { # Ignore everything before the PARALLEL clause. # This includes REMs, CREATE TABLE, column definitions, etc. $started++ if $line =~ /^PARALLEL/; next LINE if not $started; # Set $done when we hit a semicolon $done = $line =~ s/\;$//; # But keep everything in between push @lines_out, $line unless $line =~ /^$/; # Exit when we get to the semicolon and ignore the rest. # This eliminates the ';' and any COMMENTs. last LINE if $done; } my $sql = join "\n", @lines_out; $isasnaptabl = 0; return $sql . "\n"; } # sub _create_package # # Returns DDL to create the named package in the form of: # # CREATE OR REPLACE PACKAGE [schema.] # AS # # # by calling _display_source # sub _create_package { my ( $schema, $owner, $name, $view ) = @_; my $sql = _display_source( $schema, $owner, $name, $view, 'PACKAGE' ); if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $owner, $name, $view ); } return $sql ; } # sub _create_package_body # # Returns DDL to create the named procedure in the form of: # # CREATE OR REPLACE PACKAGE BODY [schema.] # AS # # # by calling _display_source # sub _create_package_body { return _display_source( @_, 'PACKAGE BODY' ); } # sub _create_partitioned_index # # Creates the GLOBAL/LOCAL partition syntax part of a CREATE INDEX statement. # sub _create_partitioned_index { my ( $schema, $owner, $name, $view, $sql ) = @_; my $stmt; if ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT -- 8.0 Indexes may partition only by RANGE i.partitioning_type , 'N/A' AS subpartitioning_type , i.locality , 0 AS compressed -- Physical Properties , 'INDEX' AS organization -- Segment Attributes , 'N/A' AS cache , 'N/A' AS pct_used , i.def_pct_free , DECODE( i.def_ini_trans ,0,1 ,null,1 ,i.def_ini_trans ) AS ini_trans , DECODE( i.def_max_trans ,0,255 ,null,255 ,i.def_max_trans ) AS max_trans -- Storage Clause ,DECODE( i.def_initial_extent ,'DEFAULT',s.initial_extent ,i.def_initial_extent * $block_size * 1024 ) AS initial_extent ,DECODE( i.def_next_extent ,'DEFAULT',s.next_extent ,i.def_next_extent * $block_size * 1024 ) AS next_extent , DECODE( i.def_min_extents ,'DEFAULT',s.min_extents ,i.def_min_extents ) AS min_extents , DECODE( i.def_max_extents ,'DEFAULT',DECODE( s.max_extents ,2147483645,'unlimited' ,s.max_extents ) ,2147483645,'unlimited' ,i.def_max_extents ) AS max_extents , DECODE( i.def_pct_increase ,'DEFAULT',s.pct_increase ,i.def_pct_increase ) AS pct_increase , DECODE( i.def_freelists ,0,1 ,null,1 ,i.def_freelists ) AS freelists , DECODE( i.def_freelist_groups ,0,1 ,null,1 ,i.def_freelist_groups ) AS freelist_groups , 'N/A' AS buffer_pool , DECODE( i.def_logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(NVL(i.def_tablespace_name,s.tablespace_name)) -- Don't have default blocks, so use larger of initial/next , GREATEST( DECODE( i.def_initial_extent ,'DEFAULT',s.initial_extent / $block_size / 1024 ,i.def_initial_extent ) ,DECODE( i.def_next_extent ,'DEFAULT',s.next_extent / $block_size / 1024 ,i.def_next_extent ) ) AS blocks FROM ${view}_part_indexes i , ${view}_indexes n , ${view}_tablespaces s , ${view}_part_tables t WHERE -- def_tablspace is sometimes NULL in PART_INDEXES, -- we'll have to go over to the table for the defaults i.index_name = UPPER( ? ) AND n.index_name = UPPER( ? ) AND t.table_name = n.table_name AND s.tablespace_name = t.def_tablespace_name "; } else # We're Oracle8i or newer { $stmt = " SELECT -- Indexes may partition only by RANGE or RANGE/HASH i.partitioning_type , i.subpartitioning_type , i.locality , DECODE( n.compression ,'ENABLED',n.prefix_length ,0 ) AS compressed -- Physical Properties , 'INDEX' AS organization -- Segment Attributes , 'N/A' AS cache , 'N/A' AS pct_used , i.def_pct_free , DECODE( i.def_ini_trans ,0,1 ,null,1 ,i.def_ini_trans ) AS ini_trans , DECODE( i.def_max_trans ,0,255 ,null,255 ,i.def_max_trans ) AS max_trans -- Storage Clause ,DECODE( i.def_initial_extent ,'DEFAULT',s.initial_extent ,i.def_initial_extent * $block_size * 1024 ) AS initial_extent ,DECODE( i.def_next_extent ,'DEFAULT',s.next_extent ,i.def_next_extent * $block_size * 1024 ) AS next_extent , DECODE( i.def_min_extents ,'DEFAULT',s.min_extents ,i.def_min_extents ) AS min_extents , DECODE( i.def_max_extents ,'DEFAULT',DECODE( s.max_extents ,2147483645,'unlimited' ,s.max_extents ) ,2147483645,'unlimited' ,i.def_max_extents ) AS max_extents , DECODE( i.def_pct_increase ,'DEFAULT',s.pct_increase ,i.def_pct_increase ) AS pct_increase , DECODE( i.def_freelists ,0,1 ,null,1 ,i.def_freelists ) AS freelists , DECODE( i.def_freelist_groups ,0,1 ,null,1 ,i.def_freelist_groups ) AS freelist_groups , LOWER(i.def_buffer_pool) AS buffer_pool , DECODE( i.def_logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(NVL(i.def_tablespace_name,s.tablespace_name)) -- Don't have default blocks, so use larger of initial/next , GREATEST( DECODE( i.def_initial_extent ,'DEFAULT',s.initial_extent / $block_size / 1024 ,i.def_initial_extent ) ,DECODE( i.def_next_extent ,'DEFAULT',s.next_extent / $block_size / 1024 ,i.def_next_extent ) ) AS blocks FROM ${view}_part_indexes i , ${view}_indexes n , ${view}_tablespaces s , ${view}_part_tables t WHERE -- def_tablspace is sometimes NULL in PART_INDEXES, -- we'll have to go over to the table for the defaults i.index_name = UPPER( ? ) AND n.index_name = UPPER( ? ) AND t.table_name = i.table_name AND s.tablespace_name = t.def_tablespace_name "; } if ( $view eq 'DBA' ) { $stmt .= " AND i.owner = UPPER('$owner') AND n.owner = UPPER('$owner') AND t.owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $name ); my @row = $sth->fetchrow_array; my $partitioning_type = shift @row; my $subpartitioning_type = shift @row; my $locality = shift @row; my $compressed = shift @row; unshift @row, ( '' ); #indent (none) $sql .= _segment_attributes( \@row ); if ( $compressed ) { $sql .= "COMPRESS $compressed\n"; } if ( $locality eq 'GLOBAL' ) { $sql .= "GLOBAL PARTITION BY RANGE\n" . # Only RANGE on global indexes "(\n " . _partition_key_columns( $owner, $name, 'INDEX', $view ) . "\n)\n" . _range_partitions($owner, $name, $view, $subpartitioning_type, 'GLOBAL' ); } else # Must be partitione by RANGE or RANGE/HASH { $sql .= "LOCAL\n"; if ( $partitioning_type eq 'RANGE' ) { $sql .= _range_partitions( $owner, $name, $view, $subpartitioning_type, 'LOCAL' ); } } return $sql; } # sub _create_partitioned_iot # # Returns DDL to create the partitioned index organized table # and its partition(s). # See _create_table for format. # sub _create_partitioned_iot { my ( $schema, $owner, $name, $view ) = @_; my $stmt; if ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT -- Table Properties 'N/A' AS monitoring , t.table_name -- Parallel Clause , LTRIM(t.degree) AS degree , LTRIM(t.instances) AS instances -- Physical Properties , 'INDEX' AS organization -- Segment Attributes , DECODE( LTRIM(t.cache) ,'Y','CACHE' , 'NOCACHE' ) AS cache , 'N/A' AS pct_used , p.def_pct_free AS pct_free , p.def_ini_trans AS ini_trans , p.def_max_trans AS max_trans -- Storage Clause ,DECODE( p.def_initial_extent ,'DEFAULT',s.initial_extent ,p.def_initial_extent * $block_size * 1024 ) AS initial_extent ,DECODE( p.def_next_extent ,'DEFAULT',s.next_extent ,p.def_next_extent * $block_size * 1024 ) AS next_extent , DECODE( p.def_min_extents ,'DEFAULT',s.min_extents ,p.def_min_extents ) AS min_extents , DECODE( p.def_max_extents ,'DEFAULT',DECODE( s.max_extents ,2147483645,'unlimited' ,s.max_extents ) ,2147483645,'unlimited' ,p.def_max_extents ) AS max_extents , DECODE( p.def_pct_increase ,'DEFAULT',s.pct_increase ,p.def_pct_increase ) AS pct_increase , DECODE( p.def_freelists ,0,1 ,NVL(p.def_freelists,1) ) AS freelists , DECODE( p.def_freelist_groups ,0,1 ,NVL(p.def_freelist_groups,1) ) AS freelist_groups , 'N/A' AS buffer_pool , DECODE( p.def_logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(p.def_tablespace_name) AS tablespace_name , t.blocks - NVL(t.empty_blocks,0) FROM ${view}_all_tables t , ${view}_part_indexes p , ${view}_tablespaces s WHERE t.table_name = UPPER('$name') AND p.table_name = t.table_name AND s.tablespace_name = p.def_tablespace_name "; } else # We're Oracle8i or newer { $stmt = " SELECT -- Table Properties DECODE( t.monitoring ,'NO','NOMONITORING' , 'MONITORING' ) AS monitoring , t.table_name -- Parallel Clause , LTRIM(t.degree) AS degree , LTRIM(t.instances) AS instances -- Physical Properties , 'INDEX' AS organization -- Segment Attributes , DECODE( LTRIM(t.cache) ,'Y','CACHE' , 'NOCACHE' ) AS cache , 'N/A' AS pct_used , p.def_pct_free AS pct_free , p.def_ini_trans AS ini_trans , p.def_max_trans AS max_trans -- Storage Clause ,DECODE( p.def_initial_extent ,'DEFAULT',s.initial_extent ,p.def_initial_extent * $block_size * 1024 ) AS initial_extent ,DECODE( p.def_next_extent ,'DEFAULT',s.next_extent ,p.def_next_extent * $block_size * 1024 ) AS next_extent , DECODE( p.def_min_extents ,'DEFAULT',s.min_extents ,p.def_min_extents ) AS min_extents , DECODE( p.def_max_extents ,'DEFAULT',DECODE( s.max_extents ,2147483645,'unlimited' ,s.max_extents ) ,2147483645,'unlimited' ,p.def_max_extents ) AS max_extents , DECODE( p.def_pct_increase ,'DEFAULT',s.pct_increase ,p.def_pct_increase ) AS pct_increase , DECODE( p.def_freelists ,0,1 ,NVL(p.def_freelists,1) ) AS freelists , DECODE( p.def_freelist_groups ,0,1 ,NVL(p.def_freelist_groups,1) ) AS freelist_groups , LOWER(p.def_buffer_pool) AS buffer_pool , DECODE( p.def_logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(p.def_tablespace_name) AS tablespace_name , t.blocks - NVL(t.empty_blocks,0) FROM ${view}_all_tables t , ${view}_part_indexes p , ${view}_tablespaces s WHERE t.table_name = UPPER('$name') AND p.table_name = t.table_name AND s.tablespace_name = p.def_tablespace_name "; } if ( $view eq 'DBA' ) { $stmt .= " AND t.owner = UPPER('$owner') AND p.owner = t.owner "; } my $sql = _create_table_text( $stmt, $schema, $owner, $name, $view ); $stmt = " SELECT constraint_name FROM ${view}_constraints WHERE table_name = UPPER( ? ) AND constraint_type = 'P' "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } my $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my ( $index ) = $sth->fetchrow_array; $sql .= "PARTITION BY RANGE\n" . # Only RANGE allowed on IOT's "(\n " . _partition_key_columns( $owner, $name, 'TABLE', $view ) . "\n)\n" . _range_partitions( $owner, $index, $view, 'NONE', 'IOT' ) . _create_comments( $schema, $owner, $name, $view ); if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $owner, $name, $view ); } return $sql; } # sub _create_partitioned_table # # Returns DDL to create the partitioned table and its partition(s). # See _create_table for format. # sub _create_partitioned_table { my ( $schema, $owner, $name, $view ) = @_; my $stmt; if ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT -- Table Properties 'N/A' AS monitoring , t.table_name -- Parallel Clause , LTRIM(t.degree) AS degree , LTRIM(t.instances) AS instances -- Physical Properties , DECODE( t.iot_type ,'IOT','INDEX' , 'HEAP' ) AS organization -- Segment Attributes , DECODE( LTRIM(t.cache) ,'Y','CACHE' , 'NOCACHE' ) AS cache , p.def_pct_used , p.def_pct_free AS pct_free , p.def_ini_trans AS ini_trans , p.def_max_trans AS max_trans -- Storage Clause ,DECODE( p.def_initial_extent ,'DEFAULT',s.initial_extent ,p.def_initial_extent * $block_size * 1024 ) AS initial_extent ,DECODE( p.def_next_extent ,'DEFAULT',s.next_extent ,p.def_next_extent * $block_size * 1024 ) AS next_extent , DECODE( p.def_min_extents ,'DEFAULT',s.min_extents ,p.def_min_extents ) AS min_extents , DECODE( p.def_max_extents ,'DEFAULT',DECODE( s.max_extents ,2147483645,'unlimited' ,s.max_extents ) ,2147483645,'unlimited' ,p.def_max_extents ) AS max_extents , DECODE( p.def_pct_increase ,'DEFAULT',s.pct_increase ,p.def_pct_increase ) AS pct_increase , DECODE( p.def_freelists ,0,1 ,NVL(p.def_freelists,1) ) AS freelists , DECODE( p.def_freelist_groups ,0,1 ,NVL(p.def_freelist_groups,1) ) AS freelist_groups , 'N/A' AS buffer_pool , DECODE( p.def_logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(p.def_tablespace_name) AS tablespace_name , t.blocks - NVL(t.empty_blocks,0) FROM ${view}_all_tables t , ${view}_part_tables p , ${view}_tablespaces s WHERE t.table_name = UPPER('$name') AND p.table_name = t.table_name AND s.tablespace_name = p.def_tablespace_name "; } else # We're Oracle8i or newer { $stmt = " SELECT -- Table Properties DECODE( t.monitoring ,'NO','NOMONITORING' , 'MONITORING' ) AS monitoring , t.table_name -- Parallel Clause , LTRIM(t.degree) AS degree , LTRIM(t.instances) AS instances -- Physical Properties , DECODE( t.iot_type ,'IOT','INDEX' , 'HEAP' ) AS organization -- Segment Attributes , DECODE( LTRIM(t.cache) ,'Y','CACHE' , 'NOCACHE' ) AS cache , p.def_pct_used , p.def_pct_free AS pct_free , p.def_ini_trans AS ini_trans , p.def_max_trans AS max_trans -- Storage Clause ,DECODE( p.def_initial_extent ,'DEFAULT',s.initial_extent ,p.def_initial_extent * $block_size * 1024 ) AS initial_extent ,DECODE( p.def_next_extent ,'DEFAULT',s.next_extent ,p.def_next_extent * $block_size * 1024 ) AS next_extent , DECODE( p.def_min_extents ,'DEFAULT',s.min_extents ,p.def_min_extents ) AS min_extents , DECODE( p.def_max_extents ,'DEFAULT',DECODE( s.max_extents ,2147483645,'unlimited' ,s.max_extents ) ,2147483645,'unlimited' ,p.def_max_extents ) AS max_extents , DECODE( p.def_pct_increase ,'DEFAULT',s.pct_increase ,p.def_pct_increase ) AS pct_increase , DECODE( p.def_freelists ,0,1 ,NVL(p.def_freelists,1) ) AS freelists , DECODE( p.def_freelist_groups ,0,1 ,NVL(p.def_freelist_groups,1) ) AS freelist_groups , LOWER(p.def_buffer_pool) AS buffer_pool , DECODE( p.def_logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(p.def_tablespace_name) AS tablespace_name , t.blocks - NVL(t.empty_blocks,0) FROM ${view}_all_tables t , ${view}_part_tables p , ${view}_tablespaces s WHERE t.table_name = UPPER('$name') AND p.table_name = t.table_name AND s.tablespace_name = p.def_tablespace_name "; } if ( $view eq 'DBA' ) { $stmt .= " AND t.owner = UPPER('$owner') AND p.owner = t.owner "; } my $sql = _create_table_text( $stmt, $schema, $owner, $name, $view ); $sql =~ /ORGANIZATION\s+(\w+)/gm; my $organization = $1; if ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT partitioning_type , partition_count , 'N/A' AS subpartitioning_type , 'N/A' AS def_subpartition_count FROM ${view}_part_tables WHERE table_name = UPPER( ? ) "; } else # We're Oracle8i or newer { $stmt = " SELECT partitioning_type , partition_count , subpartitioning_type , def_subpartition_count FROM ${view}_part_tables WHERE table_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } my $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my ( $partitioning_type, $partition_count, $subpartitioning_type, $subpartition_count ) = $sth->fetchrow_array; $sql .= "PARTITION BY $partitioning_type\n" . "(\n " . _partition_key_columns( $owner, $name, 'TABLE', $view ) . "\n)\n"; if ( $partitioning_type eq 'RANGE' ) { if ( $subpartitioning_type eq 'HASH' ) { $sql .= "SUBPARTITION BY HASH\n" . "(\n " . _subpartition_key_columns( $owner, $name, 'TABLE', $view ) . "\n)\n" . "SUBPARTITIONS $subpartition_count" . "\n"; } $sql .= "(\n"; if ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT partition_name , high_value , 'N/A' , pct_used , pct_free , ini_trans , max_trans -- Storage Clause , initial_extent , next_extent , min_extent , DECODE( max_extent ,2147483645,'unlimited' , max_extent ) AS max_extents , pct_increase , NVL(freelists,1) , NVL(freelist_groups,1) , 'N/A' AS buffer_pool , DECODE( logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(tablespace_name) , blocks - NVL(empty_blocks,0) FROM ${view}_tab_partitions WHERE table_name = UPPER( ? ) "; } else # We're Oracle8i or newer { $stmt = " SELECT partition_name , high_value , 'N/A' , pct_used , pct_free , ini_trans , max_trans -- Storage Clause , initial_extent , next_extent , min_extent , DECODE( max_extent ,2147483645,'unlimited' , max_extent ) AS max_extents , pct_increase , NVL(freelists,1) , NVL(freelist_groups,1) , LOWER(buffer_pool) , DECODE( logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(tablespace_name) , blocks - NVL(empty_blocks,0) FROM ${view}_tab_partitions WHERE table_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND table_owner = UPPER('$owner') "; } $stmt .= " ORDER BY partition_name "; $dbh->{ LongReadLen } = 8192; # Allows HIGH_VALUE length of 8K $dbh->{ LongTruncOk } = 1; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; my $comma = ' '; foreach my $row ( @$aref ) { my $partition = shift @$row; my $high_value = shift @$row; $sql .= "${comma}PARTITION \L$partition \UVALUES LESS THAN\n" . " (\n" . " $high_value\n" . " )\n"; unshift @$row, ( ' ', $organization ); $sql .= _segment_attributes( $row ); $comma = ' , '; if ( $subpartitioning_type eq 'HASH' ) { $stmt = " SELECT subpartition_name , tablespace_name FROM ${view}_tab_subpartitions WHERE table_name = UPPER( ? ) AND partition_name = '$partition' "; if ( $view eq 'DBA' ) { $stmt .= " AND table_owner = UPPER('$owner') "; } $stmt .= " ORDER BY subpartition_name "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; $sql .= " (\n "; my @cols; foreach my $row ( @$aref ) { push @cols, "SUBPARTITION \L$row->[0] \UTABLESPACE \L$row->[1]"; } $sql .= join ( "\n , ", @cols ); $sql .= "\n )\n"; } } $sql .= ");\n\n"; } else # It's HASH partitioning { $sql .= "(\n "; $stmt = " SELECT partition_name , tablespace_name FROM ${view}_tab_partitions WHERE table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND table_owner= UPPER('$owner') "; } $stmt .= " ORDER BY partition_name "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; my @cols; foreach my $row ( @$aref ) { push @cols, "PARTITION \L$row->[0] \UTABLESPACE \L$row->[1]"; } $sql .= join ( "\n , ", @cols ); $sql .= "\n) ;\n\n"; } $sql .= _create_comments( $schema, $owner, $name, $view ); if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $owner, $name, $view ); } return $sql ; } # sub _create_procedure # # Returns DDL to create the named procedure in the form of: # # CREATE OR REPLACE PROCEDURE [schema.] # AS # # # by calling _display_source # sub _create_procedure { my ( $schema, $owner, $name, $view ) = @_; my $sql = _display_source( $schema, $owner, $name, $view, 'PROCEDURE' ); if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $owner, $name, $view ); } return $sql ; } # sub _create_profile # # Returns DDL to create the named profile in the form of: # # CREATE PROFILE # LIMIT # SESSIONS_PER_USER # CPU_PER_SESSION # CPU_PER_CALL # etc # sub _create_profile { my ( $schema, $owner, $name, $view ) = @_; $sth = $dbh->prepare( " SELECT RPAD(resource_name,27) , DECODE( RESOURCE_NAME ,'PASSWORD_VERIFY_FUNCTION',DECODE( limit ,'UNLIMITED','null' ,LOWER(limit) ) , LOWER(limit) ) FROM dba_profiles WHERE profile = UPPER( ? ) ORDER BY DECODE( SUBSTR(resource_name,1,8) ,'FAILED_L',2 ,'PASSWORD',2 ,1 ) , resource_name "); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; die "\nProfile '\U$name' \Ldoes not exist.\n\n" unless @$aref; my $sql = "PROMPT " . "CREATE PROFILE \L$name\n\n" . "CREATE PROFILE \L$name\n" . "LIMIT\n"; foreach my $row ( @$aref ) { $sql .= " $row->[0]$row->[1]\n"; } $sql .= ";\n\n"; return $sql; } # sub _create_role # # Returns DDL to create the named role in the form of: # # CREATE ROLE IDENTIFIED {EXTERNALLY|BY VALUES ''} # or # CREATE ROLE NOT IDENTIFIED # sub _create_role { my ( $schema, $owner, $name, $view ) = @_; die "\nYou must use the DBA views in order to CREATE ROLE\n\n" unless $view eq 'DBA'; my $stmt = " SELECT DECODE( r.password_required ,'YES', DECODE( u.password ,'EXTERNAL','IDENTIFIED EXTERNALLY' ,'IDENTIFIED BY VALUES ''' || u.password || '''' ) ,'NOT IDENTIFIED' ) AS password FROM dba_roles r , sys.user\$ u WHERE r.role = UPPER( ? ) AND u.name = UPPER( ? ) "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $name ); my @row = $sth->fetchrow_array; die "\nRole \U$name \Ldoes not exist.\n\n" unless @row; my ( $password ) = @row; my $sql = "PROMPT " . "CREATE ROLE \L$name\n\n" . "CREATE ROLE \L$name \U$password;\n\n"; $sql .= _granted_privs( $name ); return $sql; } # sub _create_rollback_segment # # Returns DDL to create the named rollback segment in the form of: # # CREATE [PUBLIC] ROLLBACK SEGMENT # STORAGE # ( # storage clause # ) # TABLESPACE tablespace # sub _create_rollback_segment { my ( $schema, $owner, $name, $view ) = @_; $sth = $dbh->prepare( " SELECT DECODE( r.owner ,'PUBLIC',' PUBLIC ' , ' ' ) AS is_public , r.tablespace_name , NVL(r.initial_extent,t.initial_extent) AS initial_extent , NVL(r.next_extent,t.next_extent) AS next_extent , r.min_extents , DECODE( r.max_extents ,2147483645,'unlimited' , r.max_extents ) AS max_extents FROM dba_rollback_segs r , ${view}_tablespaces t WHERE r.segment_name = UPPER( ? ) AND t.tablespace_name = r.tablespace_name "); $sth->execute( $name ); my @row = $sth->fetchrow_array; die "\nRollback Segment '\U$name' \Ldoes not exist.\n\n" unless @row; my ( $is_public, $tablespace_name, $initial_extent, $next_extent, $min_extents, $max_extents, ) = @row; return "PROMPT " . "CREATE${is_public}ROLLBACK SEGMENT \L$name\n\n" . "CREATE${is_public}ROLLBACK SEGMENT \L$name\n" . "STORAGE\n" . "(\n" . " INITIAL $initial_extent\n" . " NEXT $next_extent\n" . " MINEXTENTS $min_extents\n" . " MAXEXTENTS $max_extents\n" . ")\n" . "TABLESPACE \L$tablespace_name\n" . ";\n\n" ; } # sub _create_schema # # Returns DDL to create all objects of the following type: # # TYPE # TABLE # INDEX # CONSTRAINT # TRIGGER # VIEW # SNAPSHOT # SNAPSHOT LOG # SYNONYM # DATABASE LINK # FUNCTION # PROCEDURE # PACKAGE # PACKAGE BODY # SEQUENCE # sub _create_schema { my ( $schema, $owner, $name, $view ) = @_; my $sql; my $aref; my $stmt; # # Start with schema's types (they may be a data type in CREATE TABLE) # $stmt = " SELECT object_name FROM ${view}_objects WHERE object_type = 'TYPE' "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY object_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_type( $schema, $owner, @$row->[0], $view ); } # # Add schema's tables # $stmt = " SELECT table_name FROM ${view}_tables "; if ( $view eq 'DBA' ) { $stmt .= " WHERE owner = UPPER('$owner') "; } if ( $oracle_major > 7 ) { $stmt .= " MINUS SELECT table_name FROM ${view}_tables WHERE iot_type = 'IOT_OVERFLOW' "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } } $stmt .= " MINUS SELECT log_table FROM ${view}_snapshot_logs "; if ( $view eq 'DBA' ) { $stmt .= " WHERE log_owner = UPPER('$owner') "; } $stmt .= " MINUS SELECT table_name FROM ${view}_snapshots "; if ( $view eq 'DBA' ) { $stmt .= " WHERE owner = UPPER('$owner') "; } $stmt .= " ORDER BY 1 "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_table( $schema, $owner, @$row->[0], $view ); } # # Add schema's indexes # # If we're an IOT (Oracle8 or newer), skip the PK index # because it was in the CREATE TABLE if ( $oracle_major == 7 ) { $stmt = " SELECT index_name FROM ${view}_indexes i "; if ( $view eq 'DBA' ) { $stmt .= " WHERE i.table_owner = UPPER('$owner') "; } } else # we're Oracle8 or newer { $stmt = " SELECT index_name FROM ${view}_indexes i , ${view}_tables t WHERE i.table_owner = UPPER('$owner') AND t.table_name = i.table_name AND ( t.iot_type <> 'IOT' OR ( NOT EXISTS ( SELECT null FROM ${view}_constraints WHERE constraint_type = 'P' AND constraint_name = i.index_name AND owner = i.table_owner ) ) ) "; if ( $view eq 'DBA' ) { $stmt .= " AND t.owner = i.table_owner "; } } $stmt .= " ORDER BY i.table_name , i.index_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_index( $schema, $owner, @$row->[0], $view ); } # # Add schema's constraints # # If we're an IOT (Oracle8 or newer), skip the PK constraint # because it was in the CREATE TABLE if ( $oracle_major == 7 ) { $stmt = " SELECT c.constraint_name , c.constraint_type , c.search_condition FROM ${view}_constraints c WHERE constraint_type IN('P','U','R','C') "; if ( $view eq 'DBA' ) { $stmt .= " AND c.owner = UPPER('$owner') "; } } else # we're Oracle8 or newer { $stmt = " SELECT c.constraint_name , c.constraint_type , c.search_condition FROM ${view}_constraints c , ${view}_tables t WHERE t.table_name = c.table_name AND ( ( ( t.iot_type <> 'IOT' OR t.iot_type IS NULL ) AND c.constraint_type IN('P','U','R','C') ) OR ( t.iot_type = 'IOT' AND c.constraint_type IN ('U','R','C') ) ) AND NOT EXISTS ( SELECT null FROM ${view}_snapshot_logs WHERE log_table = c.table_name "; if ( $view eq 'DBA' ) { $stmt .= " AND log_owner = c.owner "; } $stmt .= " ) AND NOT EXISTS ( SELECT null FROM ${view}_snapshots WHERE table_name = c.table_name "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = c.owner "; } $stmt .= " ) "; if ( $view eq 'DBA' ) { $stmt .= " AND c.owner = UPPER('$owner') AND t.owner = c.owner "; } } $stmt .= " ORDER BY DECODE( c.constraint_type ,'P',1 ,'U',2 ,'R',3 ,'C',4 ) , c.table_name , c.constraint_name "; $dbh->{ LongReadLen } = 8192; # Allows SEARCH_CONDITION length of 8K $dbh->{ LongTruncOk } = 1; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { my ( $cons_name, $cons_type, $condition ) = @$row; if ( $cons_type ne 'C' ) { $sql .= _create_constraint( $schema, $owner, $cons_name, $view ); } elsif ( $condition !~ /IS NOT NULL/ ) { $sql .= _create_constraint( $schema, $owner, $cons_name, $view ); } } # # Add schema's triggers # $stmt = " SELECT trigger_name FROM ${view}_triggers "; if ( $view eq 'DBA' ) { $stmt .= " WHERE table_owner = UPPER('$owner') "; } $stmt .= " ORDER BY table_name , trigger_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_trigger( $schema, $owner, @$row->[0], $view ); } # # Add schema's views # $stmt = " SELECT view_name FROM ${view}_views "; if ( $view eq 'DBA' ) { $stmt .= " WHERE owner = UPPER('$owner') "; } $stmt .= " ORDER BY view_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_view( $schema, $owner, @$row->[0], $view ); } # # Add schema's snapshot logs # $stmt = " SELECT master FROM ${view}_snapshot_logs "; if ( $view eq 'DBA' ) { $stmt .= " WHERE log_owner = UPPER('$owner') "; } $stmt .= " ORDER BY master "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_snapshot_log( $schema, $owner, @$row->[0], $view ); } # # Add schema's snapshots # $stmt = " SELECT name FROM ${view}_snapshots "; if ( $view eq 'DBA' ) { $stmt .= " WHERE owner = UPPER('$owner') "; } $stmt .= " ORDER BY name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_snapshot( $schema, $owner, @$row->[0], $view ); } # # Add schema's synonyms # $stmt = " SELECT synonym_name FROM ${view}_synonyms "; if ( $view eq 'DBA' ) { $stmt .= " WHERE owner = UPPER('$owner') "; } $stmt .= " ORDER BY synonym_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_synonym( $schema, $owner, @$row->[0], $view ); } # # Add schema's database links # $stmt = " SELECT db_link FROM ${view}_db_links "; if ( $view eq 'DBA' ) { $stmt .= " WHERE owner = UPPER('$owner') "; } $stmt .= " ORDER BY db_link "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_db_link( $schema, $owner, @$row->[0], $view ); } # # Add schema's functions # $stmt = " SELECT object_name FROM ${view}_objects WHERE object_type = 'FUNCTION' "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY object_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_function( $schema, $owner, @$row->[0], $view ); } # # Add schema's procedures # $stmt = " SELECT object_name FROM ${view}_objects WHERE object_type = 'PROCEDURE' "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY object_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_procedure( $schema, $owner, @$row->[0], $view ); } # # Add schema's packages # $stmt = " SELECT object_name FROM ${view}_objects WHERE object_type = 'PACKAGE' "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY object_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_package( $schema, $owner, @$row->[0], $view ); } # # Add schema's package bodies # $stmt = " SELECT object_name FROM ${view}_objects WHERE object_type = 'PACKAGE BODY' "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY object_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_package_body( $schema, $owner, @$row->[0], $view ); } # # Add schema's sequences # $stmt = " SELECT sequence_name FROM ${view}_sequences "; if ( $view eq 'DBA' ) { $stmt .= " WHERE sequence_owner = UPPER('$owner') "; } $stmt .= " ORDER BY sequence_name "; $sth = $dbh->prepare( $stmt ); $sth->execute; $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_sequence( $schema, $owner, @$row->[0], $view ); } $sql .= "PROMPT Recompile schema \U$owner\n\n" . "BEGIN dbms_utility.compile_schema('\U$owner') ; END ;\n/\n\n" unless $schema eq 'PUBLIC'; return $sql; } # sub _create_sequence # # Returns DDL to create the named sequence in the form of: # # CREATE SEQUENCE [schema.] # START WITH # INCREMENT BY # [NO]MINVALUE # [NO]MAXVALUE # [NO]CACHE # [NO]CYCLE # [NO]ORDER # sub _create_sequence { my ( $schema, $owner, $name, $view ) = @_; my $stmt = " SELECT 'START WITH ' || LTRIM(TO_CHAR(last_number + cache_size,'fm999999999')) AS start_with , 'INCREMENT BY ' || LTRIM(TO_CHAR(increment_by,'fm999999999')) AS imcrement_by , DECODE( min_value ,0,'NOMINVALUE' ,'MINVALUE ' || TO_CHAR(min_value) ) AS min_value , DECODE( TO_CHAR(max_value,'fm999999999999999999999999999') ,'999999999999999999999999999','NOMAXVALUE' ,'MAXVALUE ' || TO_CHAR(max_value) ) AS max_value , DECODE( cache_size ,0,'NOCACHE' ,'CACHE ' || TO_CHAR(cache_size) ) AS cache_size , DECODE( cycle_flag ,'Y','CYCLE' ,'N', 'NOCYCLE' ) AS cycle_flag , DECODE( order_flag ,'Y','ORDER' ,'N', 'NOORDER' ) AS order_flag FROM ${view}_sequences WHERE sequence_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND sequence_owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my @row = $sth->fetchrow_array; die "\nSequence \U$name \Ldoes not exist.\n\n" unless @row; my ( $start_with, $increment_by, $min_value, $max_value, $cache_size, $cycle_flag, $order_flag, ) = @row; my $sql = "PROMPT " . "CREATE SEQUENCE \L$schema$name\n\n" . "CREATE SEQUENCE \L$schema$name\n" . " $start_with\n" . " $increment_by\n" . " $min_value\n" . " $max_value\n" . " $cache_size\n" . " $cycle_flag\n" . " $order_flag\n" . ";\n\n"; if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $owner, $name, $view ); } return $sql; } # sub _create_snapshot # # Returns DDL to create the named materialized view # by calling _create_mview (which is shared with # _create_materialized_view) # sub _create_snapshot { _create_mview( @_, 'SNAPSHOT' ); } # sub _create_snapshot_log # # Returns DDL to create the named snapshot log # by calling _create_mview (which is shared with # _create_materialized_log) # sub _create_snapshot_log { _create_mview_log( @_, 'SNAPSHOT' ); } # sub _create_synonym # # Returns DDL to create the named synonym in the form of: # # CREATE [PUBLIC] SYNONYM FOR [schema.][@dblink] # sub _create_synonym { my ( $schema, $owner, $name, $view ) = @_; my $stmt = " SELECT table_owner , table_name , NVL(db_link,'NULL') FROM ${view}_synonyms WHERE synonym_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my @row = $sth->fetchrow_array; die "Synonym \U$name \Ldoes not exist.\n\n" unless @row; my ( $table_owner, $table_name, $db_link ) = @row; $db_link = ( $db_link eq 'NULL' ) ? '' : "\@$db_link"; $schema = ( $schema eq 'PUBLIC' ) ? '' : $schema; my $is_public = ( "\U$owner" eq 'PUBLIC' ) ? ' PUBLIC' : ''; my $table_schema = _set_schema( $table_owner ); my $sql = "PROMPT " . "CREATE$is_public SYNONYM \L$schema$name " . "FOR \L$table_schema$table_name$db_link \n\n" . "CREATE$is_public SYNONYM \L$schema$name " . "FOR \L$table_schema$table_name$db_link;\n\n"; if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $table_owner, $table_name, $view ); } return $sql; } # sub _create_table # # Returns DDL to create the named table and its comments # and its partition(s) in the form of: # # CREATE TABLE [schema.] # ( # # ) # ORGANIZATION {HEAP|INDEX} # [NO]MONIOTORING # PARALLEL # ( # DEGREE # INSTANCES # ) # [NO]CACHE # [PCTUSED] # PCTFREE # INITRANS # MAXTRANS # STORAGE # ( # # ) # [NO]LOGING # TABLESPACE # [] # sub _create_table { my ( $schema, $owner, $name, $view ) = @_; my $sql; my $stmt; if ( $oracle_major == 7 ) { $stmt = " SELECT 'NO' AS partitioned , 'NOT IOT' AS iot_type FROM ${view}_tables WHERE table_name = UPPER( ? ) "; } else { $stmt = " SELECT partitioned , iot_type FROM ${view}_tables WHERE table_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my @row = $sth->fetchrow_array; die "Table \U$name \Ldoes not exist.\n\n" unless @row; my ( $partitioned, $iot_type ) = @row; if ( $iot_type eq 'IOT' ) { if ( $partitioned eq 'YES' ) { return _create_partitioned_iot( $schema, $owner, $name, $view ) } else { return _create_iot( $schema, $owner, $name, $view ) } } elsif ( $partitioned eq 'YES' ) { return _create_partitioned_table( $schema, $owner, $name, $view ) } # We must be a plain, vanilla, non-partitioned, relational table. if ( $oracle_major == 7 ) { $stmt = " SELECT -- Table Properties 'N/A' AS monitoring , 'N/A' AS table_name -- Parallel Clause , LTRIM(t.degree) , LTRIM(t.instances) -- Physical Properties , 'N/A' AS organization -- Segment Attributes , DECODE( LTRIM(t.cache) ,'Y','CACHE' , 'NOCACHE' ) , t.pct_used , t.pct_free , DECODE( t.ini_trans ,0,1 ,null,1 ,t.ini_trans ) AS ini_trans , DECODE( t.max_trans ,0,255 ,null,255 ,t.max_trans ) AS max_trans -- Storage Clause , t.initial_extent , t.next_extent , t.min_extents , DECODE( t.max_extents ,2147483645,'unlimited' , t.max_extents ) AS max_extents , NVL(t.pct_increase,0) , NVL(t.freelists,1) , NVL(t.freelist_groups,1) , 'N/A' AS buffer_pool , 'N/A' AS logging , LOWER(t.tablespace_name) AS tablespace_name , s.blocks - NVL(t.empty_blocks,0) FROM ${view}_tables t , ${view}_segments s WHERE t.table_name = UPPER('$name') AND t.table_name = s.segment_name "; } elsif ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT -- Table Properties 'N/A' AS monitoring , 'N/A' AS table_name -- Parallel Clause , LTRIM(t.degree) , LTRIM(t.instances) -- Physical Properties , DECODE( t.iot_type ,'IOT','INDEX' , 'HEAP' ) AS organization -- Segment Attributes , DECODE( LTRIM(t.cache) ,'Y','CACHE' , 'NOCACHE' ) , t.pct_used , t.pct_free , DECODE( t.ini_trans ,0,1 ,null,1 ,t.ini_trans ) AS ini_trans , DECODE( t.max_trans ,0,255 ,null,255 ,t.max_trans ) AS max_trans -- Storage Clause , t.initial_extent , t.next_extent , t.min_extents , DECODE( t.max_extents ,2147483645,'unlimited' , t.max_extents ) AS max_extents , NVL(t.pct_increase,0) , NVL(t.freelists,1) , NVL(t.freelist_groups,1) , 'N/A' AS buffer_pool , DECODE( t.logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(t.tablespace_name) AS tablespace_name , s.blocks - NVL(t.empty_blocks,0) FROM ${view}_tables t , ${view}_segments s WHERE t.table_name = UPPER('$name') AND t.table_name = s.segment_name "; } else # We're Oracle8i or newer { $stmt = " SELECT -- Table Properties DECODE( t.monitoring ,'NO','NOMONITORING' , 'MONITORING' ) AS monitoring , 'N/A' AS table_name -- Parallel Clause , LTRIM(t.degree) , LTRIM(t.instances) -- Physical Properties , DECODE( t.iot_type ,'IOT','INDEX' , 'HEAP' ) AS organization -- Segment Attributes , DECODE( LTRIM(t.cache) ,'Y','CACHE' , 'NOCACHE' ) , t.pct_used , t.pct_free , DECODE( t.ini_trans ,0,1 ,null,1 ,t.ini_trans ) AS ini_trans , DECODE( t.max_trans ,0,255 ,null,255 ,t.max_trans ) AS max_trans -- Storage Clause , t.initial_extent , t.next_extent , t.min_extents , DECODE( t.max_extents ,2147483645,'unlimited' , t.max_extents ) AS max_extents , NVL(t.pct_increase,0) , NVL(t.freelists,1) , NVL(t.freelist_groups,1) , LOWER(t.buffer_pool) AS buffer_pool , DECODE( t.logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(t.tablespace_name) AS tablespace_name , s.blocks - NVL(t.empty_blocks,0) FROM ${view}_tables t , ${view}_segments s WHERE t.table_name = UPPER('$name') AND t.table_name = s.segment_name "; } if ( $view eq 'DBA' ) { $stmt .= " AND s.owner = UPPER('$owner') AND t.owner = s.owner "; } $sql = _create_table_text( $stmt, $schema, $owner, $name, $view ) . ";\n\n" . _create_comments( $schema, $owner, $name, $view ); if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $owner, $name, $view ); } return $sql; } # sub _create_table_family # # Combines the CREATE TABLE statement with its "family" -- Comments, # Triggers and Constraints # sub _create_table_family { my ( $schema, $owner, $name, $view ) = @_; my $stmt; my $sql = _create_table( @_ ); # Add table's indexes if ( $oracle_major == 7 ) { $stmt = " SELECT 'NOT IOT' AS iot_type FROM ${view}_tables WHERE table_name = UPPER( ? ) "; } else { $stmt = " SELECT iot_type FROM ${view}_tables WHERE table_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my ( $iot ) = $sth->fetchrow_array; $stmt = " SELECT index_name FROM ${view}_indexes WHERE table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND table_owner = UPPER('$owner') "; } if ( $iot eq 'IOT' ) { # Omit the PK, it's in the CREATE TABLE on an IOT $stmt .= " MINUS SELECT constraint_name FROM ${view}_constraints WHERE table_name = UPPER( '$name' ) AND constraint_type = 'P' "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } } $stmt .= " ORDER BY 1 "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_index( $schema, $owner, @$row->[0], $view ); } # Add table's constraints $stmt = " SELECT constraint_name , constraint_type , search_condition FROM ${view}_constraints cn WHERE owner = UPPER( ? ) AND table_name = UPPER( ? ) "; if ( $iot eq 'IOT' ) { $stmt .= " AND constraint_type IN('U','R','C') "; } else { $stmt .= " AND constraint_type IN('P','U','R','C') "; } $stmt .= " ORDER BY DECODE( constraint_type ,'P',1 ,'U',2 ,'R',3 ,'C',4 ) , constraint_name "; $dbh->{ LongReadLen } = 8192; # Allows SEARCH_CONDITION length of 8K $dbh->{ LongTruncOk } = 1; $sth = $dbh->prepare( $stmt ); $sth->execute( $owner, $name ); $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { my ( $cons_name, $cons_type, $condition ) = @$row; if ( $cons_type ne 'C' ) { $sql .= _create_constraint( $schema, $owner, $cons_name, $view ); } elsif ( $condition !~ /IS NOT NULL/ ) { $sql .= _create_constraint( $schema, $owner, $cons_name, $view ); } } # Add table's triggers $stmt = " SELECT trigger_name FROM ${view}_triggers WHERE table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND table_owner = UPPER('$owner') "; } $stmt .= " ORDER BY trigger_name "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= _create_trigger( $schema, $owner, @$row->[0], $view ); } return $sql; } # sub _create_table_text # # Formats the CREATE TABLE statement # sub _create_table_text { my ( $stmt, $schema, $owner, $name, $view ) = @_; $sth = $dbh->prepare( $stmt ); $sth->execute; my @row = $sth->fetchrow_array; # Turn warnings off $^W = 0; my $monitoring = shift @row; my $table = shift @row; my $degree = shift @row; my $instances = shift @row; my $organization = shift @row; my ( # Segment Attributes $cache, $pct_used, $pct_free, $ini_trans, $max_trans, $initial, $next, $min_extents, $max_extents, $pct_increase, $freelists, $freelist_groups, $buffer_pool, $logging, $tablespace, $blocks, ) = @row; ( $initial, $next ) = _initial_next( $blocks ) if $attr{ 'resize' }; my $sql = "PROMPT " . "CREATE TABLE \L$schema$name\n\n" . "CREATE TABLE \L$schema$name\n" . "(\n " . _table_columns( $owner, $name, $view ); if ( $organization eq 'INDEX' ) { $stmt = " SELECT constraint_name FROM ${view}_constraints WHERE table_name = UPPER( ? ) AND constraint_type = 'P' "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my ( $index ) = $sth->fetchrow_array; $sql .= " , CONSTRAINT \L$index \UPRIMARY KEY\n" . _index_columns( ' ', $owner, $index, $view, ); } $sql .= ")\n"; $sql .= "ORGANIZATION $organization\n" if $oracle_major > 7; if ( $oracle_major > 8 or ( $oracle_major == 8 and $oracle_minor > 0 ) ) { $sql .= "$monitoring\n"; } unless ( $organization eq 'INDEX' and $oracle_major == 8 and $oracle_minor == 0 ) { $sql .= "PARALLEL\n" . "(\n" . " DEGREE $degree\n" . " INSTANCES $instances\n" . ")\n"; } unshift @row, ( '', $organization ); $sql .= _segment_attributes( \@row ); if ( $organization eq 'INDEX' ) { if ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT c.column_name , i.pct_threshold , 'HEAP' AS organization -- Segment Attributes , 'N/A' AS cache , t.pct_used , t.pct_free , DECODE( t.ini_trans ,0,1 ,null,1 ,t.ini_trans ) AS ini_trans , DECODE( t.max_trans ,0,255 ,null,255 ,t.max_trans ) AS max_trans -- Storage Clause , t.initial_extent , t.next_extent , t.min_extents , DECODE( t.max_extents ,2147483645,'unlimited' , t.max_extents ) AS max_extents , NVL(t.pct_increase,0) , NVL(t.freelists,1) , NVL(t.freelist_groups,1) , 'N/A' AS buffer_pool , DECODE( t.logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(t.tablespace_name) AS tablespace_name , s.blocks - NVL(t.empty_blocks,0) FROM ${view}_tables t , ${view}_indexes i , ${view}_segments s , ${view}_tab_columns c WHERE t.iot_name = UPPER('$name') AND i.table_name = t.iot_name AND c.table_name (+) = i.table_name AND c.column_id (+) = i.include_column AND s.segment_name = t.table_name "; } else # We're Oracle8i or newer { $stmt = " SELECT c.column_name , i.pct_threshold , 'HEAP' AS organization -- Segment Attributes , 'N/A' AS cache , t.pct_used , t.pct_free , DECODE( t.ini_trans ,0,1 ,null,1 ,t.ini_trans ) AS ini_trans , DECODE( t.max_trans ,0,255 ,null,255 ,t.max_trans ) AS max_trans -- Storage Clause , t.initial_extent , t.next_extent , t.min_extents , DECODE( t.max_extents ,2147483645,'unlimited' , t.max_extents ) AS max_extents , NVL(t.pct_increase,0) , NVL(t.freelists,1) , NVL(t.freelist_groups,1) , LOWER(t.buffer_pool) AS buffer_pool , DECODE( t.logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , LOWER(t.tablespace_name) AS tablespace_name , s.blocks - NVL(t.empty_blocks,0) FROM ${view}_tables t , ${view}_indexes i , ${view}_segments s , ${view}_tab_columns c WHERE t.iot_name = UPPER('$name') AND i.table_name = t.iot_name AND c.table_name (+) = i.table_name AND c.column_id (+) = i.include_column AND s.segment_name = t.table_name "; } if ( $view eq 'DBA' ) { $stmt .= " AND t.owner = UPPER('$owner') AND s.owner = t.owner AND c.owner (+) = i.table_owner AND i.table_owner = t.owner "; } $sth = $dbh->prepare( $stmt ); $sth->execute; my @row = $sth->fetchrow_array; if ( @row ) { my $column = shift @row; my $pct_threshold = shift @row; $sql .= "PCTTHRESHOLD $pct_threshold\n"; $sql .= "INCLUDING $column\n" if $column; $sql .= "OVERFLOW\n"; } } return $sql; } # sub _create_tablespace # # Returns DDL to create the named tablespace in the form of: # # CREATE [TEMPORARY] TABLESPACE # {DATA|TEMP}FILE # '' # , '' # DEFAULT STORAGE # ( # # ) # [MINIMUM EXTENT ] # ]PERMANENT|TEMPORARY] # [EXTENT MANAGEMENT {DICTIONARY|LOCAL }] # [[NO]LOGGING] # sub _create_tablespace { my ( $schema, $owner, $name, $view ) = @_; die "\nYou must use the DBA views in order to CREATE TABLESPACE\n\n" unless $view eq 'DBA'; my $sql; my $stmt; my $file_type; if ( $oracle_major == 7 ) { $stmt = " SELECT initial_extent , next_extent , min_extents , DECODE( max_extents ,2147483645,'unlimited' ,null,DECODE( $block_size , 1, 57 , 2, 121 , 4, 249 , 8, 505 ,16,1017 ,32,2041 ,'???' ) ,max_extents ) AS max_extents , pct_increase , 0 AS min_extlen , contents , 'N/A' AS logging , 'N/A' AS extent_management , 'N/A' AS allocation_type FROM dba_tablespaces WHERE tablespace_name = UPPER( ? ) "; } elsif ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT initial_extent , next_extent , min_extents , DECODE( max_extents ,2147483645,'unlimited' ,null,DECODE( $block_size , 1, 57 , 2, 121 , 4, 249 , 8, 505 ,16,1017 ,32,2041 ,'???' ) ,max_extents ) AS max_extents , pct_increase , min_extlen , contents , DECODE( logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , 'N/A' AS extent_management , 'N/A' AS allocation_type FROM dba_tablespaces WHERE tablespace_name = UPPER( ? ) "; } else # We're newer than Oracle 8.0 { $stmt = " SELECT initial_extent , next_extent , min_extents , DECODE( max_extents ,2147483645,'unlimited' ,null,DECODE( $block_size , 1, 57 , 2, 121 , 4, 249 , 8, 505 ,16,1017 ,32,2041 ,'???' ) ,max_extents ) AS max_extents , pct_increase , min_extlen , contents , logging , extent_management , allocation_type FROM dba_tablespaces WHERE tablespace_name = UPPER( ? ) "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my @row = $sth->fetchrow_array; die "Tablespace \U$name \Ldoes not exist.\n\n" unless @row; my ( $initial, $next, $min_extents, $max_extents, $pct_increase, $min_extlen, $contents, $logging, $extent_management, $allocation_type, ) = @row; if ( $extent_management eq 'LOCAL' and $contents eq 'TEMPORARY' ) { $sql = "PROMPT " . "CREATE TEMPORARY TABLESPACE \L$name\n\n" . "CREATE TEMPORARY TABLESPACE \L$name\n"; } else { $sql = "PROMPT " . "CREATE TABLESPACE \L$name\n\n" . "CREATE TABLESPACE \L$name\n"; } if ( $oracle_major == 7 ) { $file_type = 'DATA'; $stmt = " SELECT file_name , bytes , 'N/A' AS autoextensible , 'N/A' AS maxbytes , 'N/A' AS increment_by FROM dba_data_files WHERE tablespace_name = UPPER( ? ) ORDER BY file_name "; } else # We're newer than Oracle7 { $stmt = " SELECT count(*) FROM dba_data_files WHERE tablespace_name = UPPER( ? ) "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my ( $cnt ) = $sth->fetchrow_array; $file_type = ( $cnt == 0 ) ? 'TEMP' : 'DATA'; $stmt = " SELECT file_name , bytes , autoextensible , DECODE( SIGN(2147483645 - maxbytes) ,-1,'unlimited' ,maxbytes ) AS maxbytes , increment_by * $block_size * 1024 AS increment_by FROM dba_${file_type}_files WHERE tablespace_name = UPPER( ? ) ORDER BY file_name "; } $sql .= "${file_type}FILE\n"; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; my $comma = ' '; foreach my $row ( @$aref ) { my ( $file_name, $bytes, $autoextensible, $maxbytes, $increment_by, ) = @$row; $sql .= "$comma '$file_name' SIZE $bytes REUSE\n"; if ( $oracle_major > 7 ) { $sql .= " AUTOEXTEND "; if ( $autoextensible eq 'YES' ) { $sql .= "ON NEXT $increment_by MAXSIZE $maxbytes\n"; } else { $sql .= "OFF\n"; } } $comma = ' ,'; } if ( $extent_management eq 'LOCAL' ) { $sql .= "EXTENT MANAGEMENT LOCAL "; if ( $allocation_type eq 'SYSTEM' ) { $sql .= "AUTOALLOCATE\n"; } else { $sql .= "UNIFORM SIZE $next\n"; } } else # It's Dictionary Managed, Oracle8.0 or Oracle7 { $sql .= "DEFAULT STORAGE\n" . "(\n" . " INITIAL $initial\n" . " NEXT $next\n" . " MINEXTENTS $min_extents\n" . " MAXEXTENTS $max_extents\n" . " PCTINCREASE $pct_increase\n" . ")\n" . "$contents\n";; if ( $min_extlen > 0 ) { $sql .= "MINUMUM EXTENT $min_extlen\n"; } if ( $oracle_major > 8 or ( $oracle_major == 8 and $oracle_minor > 0 ) ) { $sql .= "EXTENT MANAGEMENT DICTIONARY\n"; } } if ( $oracle_major > 7 ) { $sql .= "$logging\n" unless ( $contents eq 'TEMPORARY' and $extent_management eq 'LOCAL' ); } $sql .= ";\n\n"; return $sql; } # sub _create_trigger # # Returns DDL to create the named trigger in the form of: # # CREATE OR REPLACE TRIGGER [schema.] # {BEFORE|AFTER|INSTEAD OF} # [OF |DATABASE|SCHEMA} # REFERENCING AS NEW AS OLD # [WHEN ] # [FOR EACH ROW] # # sub _create_trigger { my ( $schema, $owner, $name, $view ) = @_; my $stmt; if ( $oracle_major > 8 or ( $oracle_major == 8 and $oracle_minor > 0 ) ) { $stmt = " SELECT trigger_type , RTRIM(triggering_event) , table_owner , table_name , base_object_type , referencing_names , DECODE( when_clause ,null,null ,'WHEN (' || when_clause || ')' || CHR(10) ) , trigger_body FROM ${view}_triggers WHERE trigger_name = UPPER( ? ) "; } else { $stmt = " SELECT trigger_type , RTRIM(triggering_event) , table_owner , table_name -- Only table triggers before 8i , 'TABLE' AS base_object_type , referencing_names , DECODE( when_clause ,null,null ,'WHEN (' || when_clause || ')' || CHR(10) ) , trigger_body FROM ${view}_triggers WHERE trigger_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND table_owner = UPPER('$owner') "; } $dbh->{ LongReadLen } = 65536; # Allows TRIGGER_BODY length of 64K $dbh->{ LongTruncOk } = 1; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my @row = $sth->fetchrow_array; die "\nTrigger \U$schema$name \Ldoes not exist.\n\n" unless @row; my ( $trigger_type, $event, $table_owner, $table, $base_type, $ref_names, $when, $body, ) = @row; my ( $trg_type ) = $trigger_type =~ /(BEFORE|AFTER|INSTEAD OF)/; my $schema2 = _set_schema( $table_owner ); my $object = ( $base_type eq 'TABLE' ) ? $schema2 . $table : ( $base_type eq 'SCHEMA' ) ? $schema . 'SCHEMA' : $base_type; $ref_names =~ s/ING (\w+) AS NEW (\w+)/ING \L$1 \UAS NEW \L$2/; # When clause sometimes ends in a null $when =~ s/\c@//g; # Body sometimes ends in a null $body =~ s/\c@//g; my $columns; if ( $event =~ /UPDATE/ ) { $stmt = " SELECT LOWER(column_name) FROM ${view}_trigger_cols WHERE trigger_name = UPPER( ? ) AND column_list = 'YES' "; if ( $view eq 'DBA' ) { $stmt .= " AND table_owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my (@columns) = map { $_->[0] } @{ $sth->fetchall_arrayref }; $columns = "\nOF\n " . join ("\n , ", @columns) . "\n" if ( @columns ); } my $sql = "PROMPT " . "CREATE OR REPLACE TRIGGER \L$schema$name\n\n" . "CREATE OR REPLACE TRIGGER \L$schema$name\n" . "$trg_type $event ${columns}ON \L$object\n"; $sql .= "$ref_names\n" if $base_type =~ /TABLE|VIEW/; $sql .= "FOR EACH ROW\n" if $trigger_type =~ /EACH ROW/; $sql .= $when if $when; $sql .= $body; $sql .= "\n" unless $sql =~ /\Z\n/; $sql .= "/\n\n"; return $sql; } # sub _create_type # # Returns DDL to create the named procedure in the form of: # # CREATE OR REPLACE TYPE [schema.] # AS # # # by calling _display_source # sub _create_type { my ( $schema, $owner, $name, $view ) = @_; my $sql = _display_source( $schema, $owner, $name, $view, 'TYPE' ); if ( $attr{ 'grants' } ) { $sql .= _object_privs( $schema, $owner, $name, $view ); } return $sql; } # sub _create_user # # Returns DDL to create the named user in the form of: # # CREATE USER IDENTIFIED {EXTERNALLY|BY VALUES ''} # PROFILE # DEFAULT TABLESPACE # TEMPORARY TABLESPACE # [QUOTA {UNLIMITED|} ON TABLESPACE ] # [QUOTA {UNLIMITED|} ON TABLESPACE ] # # [GRANT TO [WITH ADMIN OPTION]] # [GRANT TO [WITH ADMIN OPTION]] # [GRANT ON TO [WITH GRANT OPTION]] # sub _create_user { my ( $schema, $owner, $name, $view ) = @_; die "\nYou must use the DBA views in order to CREATE USER\n\n" unless $view eq 'DBA'; my $stmt = " SELECT DECODE( password ,'EXTERNAL','EXTERNALLY' ,'BY VALUES ''' || password || '''' ) AS password , profile , default_tablespace , temporary_tablespace FROM dba_users WHERE username = UPPER( ? ) "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my @row = $sth->fetchrow_array; die "\nUser \U$name \Ldoes not exist.\n\n" unless @row; my ( $password, $profile, $default_tablespace, $temporary_tablespace, ) = @row; my $sql = "PROMPT " . "CREATE USER \L$name\n\n" . "CREATE USER \L$name \UIDENTIFIED $password\n" . " \UPROFILE \L$profile\n" . " \UDEFAULT TABLESPACE \L$default_tablespace\n" . " \UTEMPORARY TABLESPACE \L$temporary_tablespace\n"; # Add tablespace quotas $stmt = " SELECT DECODE( max_bytes ,-1,'unlimited' ,TO_CHAR(max_bytes,'99999999') ) AS max_bytes , tablespace_name FROM dba_ts_quotas WHERE username = UPPER( ? ) ORDER BY tablespace_name "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= " QUOTA @$row->[0] ON \L@$row->[1]\n"; } $sql .= ";\n\n"; $sql .= _granted_privs( $name ); return $sql; } # sub _create_view # # Returns DDL to create the named view in the form of: # # CREATE OR REPLACE VIEW [schema.] # ( # # ) # AS # # sub _create_view { my ( $schema, $owner, $name, $view ) = @_; my $stmt = " SELECT text FROM ${view}_views WHERE view_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $dbh->{ LongReadLen } = 65536; # Allows View TEXT length of 64K $dbh->{ LongTruncOk } = 1; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my ( $text ) = $sth->fetchrow_array; die "\nView \U$name \Ldoes not exist.\n\n" unless $text; $stmt = " SELECT LOWER(column_name) FROM ${view}_tab_columns WHERE table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY column_id "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my (@columns) = map { $_->[0] } @{ $sth->fetchall_arrayref }; return "PROMPT " . "CREATE OR REPLACE VIEW \L$schema$name\n\n" . "CREATE OR REPLACE VIEW \L$schema$name\n" . "(\n " . join ("\n , ", @columns) . "\n)\n" . "AS\n" . "$text" . ";\n\n"; } # sub _display_source # # Returns DDL to create the named stored item in the form of: # # CREATE OR REPLACE [schema.] # # # where TYPE is one of: PROCEDURE, FUNCTION, PACKAGE, PACKAGE BODY # sub _display_source { my ( $schema, $owner, $name, $view, $type ) = @_; my $sql; my $stmt = " SELECT text FROM ${view}_source WHERE type = '$type' AND name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY line "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; die "\n\u\L$type \U$name \Ldoes not exist.\n\n" unless @$aref; $sql = "PROMPT " . "CREATE OR REPLACE $type \L$schema$name\n\n" . "CREATE OR REPLACE "; my $i = 1; foreach my $row ( @$aref ) { if ( $i++ == 1 ) { # source.text already includes # We want to insert the schema right before the name # @$row->[0] =~ s/$type\s+\S+/$type \L$schema$name/i; # The following line was submitted by Sandor Toth, to fix the condition # where parameters immediately followed the name, as in # CREATE OR REPLACE PROCEDURE foo( var1 IN VARCHAR2) # ^ # | # observe, no space between 'foo' and '(' @$row->[0] =~ s/($type)\s+($name)\s*(.*)$/$1 \L$schema$2 $3/i; } $sql .= "@$row->[0]"; } $sql .= "\n" unless $sql =~ /\Z\n/; $sql .= "/\n\n"; return $sql; } # sub _drop_constraint # # Returns DDL to drop the named constraint in the form of: # # ALTER TABLE [schema.] DROP CONSTRAINT # sub _drop_constraint { my ( $schema, $name, $type, $owner, $view ) = @_; my $stmt = " SELECT table_name FROM ${view}_constraints WHERE owner = UPPER( ? ) AND constraint_name = UPPER( ? ) "; $sth = $dbh->prepare( $stmt ); $sth->execute( $owner, $name ); my ( $table_name ) = $sth->fetchrow_array; return "PROMPT " . "ALTER TABLE \L$schema$table_name \UDROP CONSTRAINT \L$name \n\n" . "ALTER TABLE \L$schema$table_name \UDROP CONSTRAINT \L$name;\n\n"; } # sub _drop_database_link # # Returns DDL to drop the named database link in the form of: # # DROP [PUBLIC] DATABASE LINK # sub _drop_database_link { my ( $schema, $name, $type ) = @_; my $public = ( $schema eq 'PUBLIC' ) ? ' PUBLIC' : ''; return "PROMPT " . "DROP$public DATABASE LINK \L$name \n\n" . "DROP$public DATABASE LINK \L$name ;\n\n" ; } # sub _drop_materialized_view_log # # Returns DDL to drop the named materialized view # by calling _drop_mview_log (which is shared with # _drop_snapshot_log) # sub _drop_materialized_view_log { my ( $schema, $name, $type ) = @_; _drop_mview_log( $schema, $name, 'MATERIALIZED VIEW' ); } # sub _drop_mview_log # # Returns DDL to drop the named database link in the form of: # # DROP MATERIALIZED VIEW LOG ON [schema.] # or # DROP SNAPSHOT LOG ON [schema.] # sub _drop_mview_log { my ( $schema, $name, $type ) = @_; return "PROMPT " . "DROP $type LOG ON \L$schema$name \n\n" . "DROP $type LOG ON \L$schema$name ;\n\n" ; } # sub _drop_object # # Returns generic DDL to drop the named object in the form of: # # DROP # sub _drop_object { my ( $schema, $name, $type ) = @_; return "PROMPT " . "DROP \U$type \L$name \n\n" . "DROP \U$type \L$name ;\n\n"; } # sub _drop_profile # # Returns DDL to drop the named profile in the form of: # # DROP PROFILE CASCADE # sub _drop_profile { my ( $schema, $name, $type ) = @_; my $public = ( $schema eq 'PUBLIC' ) ? ' PUBLIC' : ''; return "PROMPT " . "DROP PROFILE \L$name \UCASCADE \n\n" . "DROP PROFILE \L$name \UCASCADE ; \n\n" ; } # sub _drop_schema_object # # Returns generic DDL to drop the named object in the form of: # # DROP [schema.] # sub _drop_schema_object { my ( $schema, $name, $type ) = @_; return "PROMPT " . "DROP \U$type \L$schema$name \n\n" . "DROP \U$type \L$schema$name ;\n\n"; } # sub _drop_snapshot_log # # Returns DDL to drop the named snapshot log # by calling _drop_mview_log (which is shared with # _drop_materialized_view_log) # sub _drop_snapshot_log { my ( $schema, $name, $type ) = @_; _drop_mview_log( $schema, $name, 'SNAPSHOT' ); } # sub _drop_synonym # # Returns DDL to drop the named object in the form of: # # DROP PUBLIC SYNONYM # or # DROP SYNONYM [schema.] # sub _drop_synonym { my ( $schema, $name, $type ) = @_; my $public = ( $schema eq 'PUBLIC' ) ? ' PUBLIC' : ''; if ( $public ) { return "PROMPT " . "DROP PUBLIC SYNONYM \L$name \n\n" . "DROP PUBLIC SYNONYM \L$name ;\n\n" ; } else { return "PROMPT " . "DROP SYNONYM \L$schema$name \n\n" . "DROP SYNONYM \L$schema$name ;\n\n"; } } # sub _drop_table # # Returns DDL to drop the named table in the form of: # # DROP TABLE [schema.] CASCADE CONSTRAINTS # sub _drop_table { my ( $schema, $name, $type ) = @_; return "PROMPT " . "DROP TABLE \L$schema$name \UCASCADE CONSTRAINTS \n\n" . "DROP TABLE \L$schema$name \UCASCADE CONSTRAINTS ;\n\n"; } # sub _drop_tablespace # # Returns DDL to drop the named tablespace in the form of: # # DROP TABLESPACE INCLUDING CONTENTS CASCADE CONSTRAINTS # sub _drop_tablespace { my ( $schema, $name, $type ) = @_; return "PROMPT " . "DROP TABLESPACE \L$name " . "\UINCLUDING CONTENTS CASCADE CONSTRAINTS \n\n" . "DROP TABLESPACE \L$name " . "\UINCLUDING CONTENTS CASCADE CONSTRAINTS ;\n\n"; } # sub _drop_user # # Returns DDL to drop the named user in the form of: # # DROP USER CASCADE # sub _drop_user { my ( $schema, $name, $type ) = @_; return "PROMPT " . "DROP USER \L$name \UCASCADE \n\n" . "DROP USER \L$name \UCASCADE ;\n\n"; } #sub _generate_heading # # Initializes $ddl # sub _generate_heading { $ddl = ""; return unless $attr{ heading }; my ( $module, $action, $type, $list ) = @_; $ddl = "REM This DDL was reverse engineered by\n" . "REM Perl module $module, Version $DDL::Oracle::VERSION\n" . "REM\n" . "REM at: $host\n" . "REM from: $instance, an Oracle Release $oracle_release instance\n" . "REM\n" . "REM on: " . scalar ( localtime ) . "\n" . "REM\n"; if ( $action eq 'FREE SPACE' ) { $ddl .= "REM Generating $action \Lreport"; } elsif ( "\U$type" eq 'COMPONENTS' ) { $ddl .= "REM Generating CREATE statements\n\n"; return; } elsif ( "\U$type" eq 'SCHEMA' ) { $ddl .= "REM Generating CREATE statements for all Objects in schema"; } else { $ddl .= "REM Generating $action \U$type \Lstatement"; } $ddl .= ( @$list == 1 ) ? '' : "s"; if ( "\U$type" eq 'SCHEMA' ) { $ddl .= "\n"; } else { $ddl .= " for:\n"; } $ddl .= "REM\n"; # Only include the schema if the Type has such a beast. foreach my $row ( @$list ) { # These don't if ( "\L$type" eq 'directory' or "\L$type" eq 'library' or "\L$type" eq 'profile' or "\L$type" eq 'role' or "\L$type" eq 'rollback segment' or "\L$type" eq 'tablespace' or "\L$type" eq 'user' or ( "\L@$row->[0]" ne 'public' and ( "\L$type" eq 'database link' or "\L$type" eq 'synonym' ) ) ) { $ddl .= "REM\t\U@$row->[1]\n"; } # Schema's don't name individual objects elsif ( "\L$type" eq 'schema' ) { $ddl .= "REM\t\U@$row->[0]\n"; } # The rest do. else { $ddl .= "REM\t\U@$row->[0].@$row->[1]\n"; } } return $ddl .= "\n"; }; # sub _get_oracle_release # # Determines Oracle Release number # sub _get_oracle_release { $sth = $dbh->prepare( " SELECT version FROM product_component_version WHERE product LIKE 'Oracle%' "); $sth->execute; my $version = $sth->fetchrow_array; ( $oracle_release, $oracle_major, $oracle_minor ) = $version =~ /((\d+)\.(\d+)\S+)/; if ( $attr{ heading } ) { $sth = $dbh->prepare( " SELECT LOWER(name) FROM v\$database "); $sth->execute; ( $instance ) = $sth->fetchrow_array; $host = `hostname`; chomp( $host ); } } # sub _granted_privs # # Returns DDL to create GRANT statements to the named grantee # in the form of: # # [GRANT TO {WITH ADMIN OPTION]] # [GRANT TO {WITH ADMIN OPTION]] # sub _granted_privs { my ( $name ) = @_; my $sql; # Add role privileges my $stmt = " SELECT granted_role , DECODE( admin_option ,'YES','WITH ADMIN OPTION ' ,null ) AS admin_option FROM dba_role_privs WHERE grantee = UPPER( ? ) ORDER BY granted_role "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= "PROMPT " . "GRANT \L@$row->[0] \UTO \L$name \U@$row->[1] \n\n" . "GRANT \L@$row->[0] \UTO \L$name \U@$row->[1];\n\n"; } # Add system privileges $stmt = " SELECT privilege , DECODE( admin_option ,'YES','WITH ADMIN OPTION ' ,null ) AS admin_option FROM dba_sys_privs WHERE grantee = UPPER( ? ) ORDER BY privilege "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { $sql .= "PROMPT " . "GRANT \L@$row->[0] \UTO \L$name \U@$row->[1] \n\n" . "GRANT \L@$row->[0] \UTO \L$name \U@$row->[1];\n\n"; } return $sql; } #sub _index_columns # # Returns a formatted string containing the index columns. # Starting with Oracle8i, columns may be DESCending. # sub _index_columns { my ( $indent, $owner, $name, $view, ) = @_; my $stmt; if ( $oracle_major > 8 or ( $oracle_major == 8 and $oracle_minor > 0 ) ) { $stmt = " SELECT LOWER(column_name) , descend FROM ${view}_ind_columns WHERE index_name = UPPER( ? ) "; } else { $stmt = " SELECT LOWER(column_name) , 'ASC' FROM ${view}_ind_columns WHERE index_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND index_owner = UPPER('$owner') "; } $stmt .= " ORDER BY column_position "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; my @cols; foreach my $row ( @$aref ) { my ( $column, $direction ) = @$row; if ( $column =~ /^sys_nc\d+\$$/ ) { $stmt = " SELECT c.default\$ FROM sys.col\$ c -- User needs SELECT on this , ${view}_indexes i , ${view}_objects o WHERE i.index_name = UPPER( ? ) AND o.object_name = i.table_name AND c.obj# = o.object_id AND c.name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND i.owner = UPPER('$owner') AND o.owner = i.table_owner "; } $dbh->{ LongReadLen } = 1024; $dbh->{ LongTruncOk } = 1; $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $column ); my ( $real_column ) = $sth->fetchrow_array; # Get rid of double quotes $real_column =~ s|\"||g; if ( $direction eq 'DESC' ) { push @cols, "\L$real_column" . ' ' . ' ' x ( 30 - length( $real_column ) ) . "DESC"; } else # Must be a function-based index { push @cols, $real_column; } } else { push @cols, $column; } } return "${indent}(\n$indent " . join ( "\n$indent , ", @cols ) . "\n${indent})\n"; } # sub _initial_next # # Given the number of blocks in a object, returns the smallest # INITIAL/NEXT values appropriate for an object of this size. # sub _initial_next { my $blocks = shift; # Turn warnings off $^W = 0; my $i = 0; my $initial; my $next; until ( $initial ) { $initial = ( $size_arr[$i][0] eq "UNLIMITED" ) ? $size_arr[$i][1] : ( $size_arr[$i][0] > $blocks ) ? $size_arr[$i][1] : undef; $next = ( $size_arr[$i][0] eq "UNLIMITED" ) ? $size_arr[$i][1] : ( $size_arr[$i][0] > $blocks ) ? $size_arr[$i][1] : undef; $i++; } return $initial, $next; } #sub _key_columns # # Returns a formatted string containing the partitioning key columns. # Called from _partition_key_columns and _subpartition_key_columns, # which merely control which key columns table to query. # sub _key_columns { my ( $owner, $name, $object_type, $view, $table ) = @_; my $stmt = " SELECT LOWER(column_name) FROM ${view}_${table}_key_columns WHERE name = UPPER( ? ) AND object_type LIKE UPPER('$object_type%') "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY column_position "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; my @cols; foreach my $row ( @$aref ) { push @cols, $row->[0]; } return join ( "\n , ", @cols ); } # sub _object_privs # # Returns DDL to create GRANT statements in the form of: # # GRANT ON TO [WITH GRANT OPTION] # # and/or # # GRANT # ( # column_name # , column_name # ) # ON TO [WITH GRANT OPTION] # sub _object_privs { my ( $schema, $owner, $name, $view ) = @_; my $sql; my $stmt = " SELECT grantee , privilege , DECODE( grantable ,'YES','WITH GRANT OPTION ' ,null ) AS grantable FROM ${view}_tab_privs WHERE grantor = UPPER( ? ) AND table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY grantee , privilege "; $sth = $dbh->prepare( $stmt ); $sth->execute( $owner, $name ); my $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { my ( $grantee, $privilege, $grantable,, ) = @$row; $sql .= "PROMPT " . "GRANT \L$privilege \UON \L$schema$name \UTO \L$grantee " . "\U$grantable \n\n" . "GRANT \L$privilege \UON \L$schema$name \UTO \L$grantee " . "\U$grantable;\n\n"; } $stmt = " SELECT DISTINCT grantee , privilege , DECODE( grantable ,'YES','WITH GRANT OPTION ' ,null ) AS grantable FROM ${view}_col_privs WHERE grantor = UPPER( ? ) AND table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY grantee , privilege "; $sth = $dbh->prepare( $stmt ); $sth->execute( $owner, $name ); $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { my ( $grantee, $privilege, $grantable,, ) = @$row; $sql .= "PROMPT " . "GRANT \L$privilege \UON \L$schema$name \UTO \L$grantee " . "\U$grantable\n\n" . "GRANT \L$privilege \n(\n "; $stmt = " SELECT LOWER(column_name) FROM ${view}_col_privs WHERE grantor = UPPER( ? ) AND privilege = UPPER( ? ) AND table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY grantee , privilege "; $sth = $dbh->prepare( $stmt ); $sth->execute( $owner, $privilege, $name ); my $aref = $sth->fetchall_arrayref; my @cols; foreach my $row ( @$aref ) { push @cols, $row->[0]; } $sql .= join ( "\n , ", @cols ); $sql .= "\n)\n\UON \L$schema$name \UTO \L$grantee \U$grantable;\n\n"; } return $sql; } # sub _partition_key_columns # # Returns a formatted string containing the partitioning key columns # sub _partition_key_columns { return _key_columns( @_, 'PART' ); } # sub _print_space # # Returns a formatted string containing the space analysis report. # sub _print_space { my ( $owner, $name, $type, $partition ) = @_; my ( $total_blocks, $total_bytes, $unused_blocks, $unused_bytes, $last_file_id, $last_block_id, $last_block, $free_blocks, ); my $max_length = 20; my $freelist_group_id = 0; if ( $partition ) { $sth = $dbh->prepare( " BEGIN dbms_space.unused_space ( ?,?,?,?,?,?,?,?,?,?,? ) ; END ; " ); $sth->bind_param( 1, "\U$owner" ); $sth->bind_param( 2, "\U$name" ); $sth->bind_param( 3, "\U$type" ); $sth->bind_param_inout( 4 , \$total_blocks , $max_length ); $sth->bind_param_inout( 5 , \$total_bytes , $max_length ); $sth->bind_param_inout( 6 , \$unused_blocks, $max_length ); $sth->bind_param_inout( 7 , \$unused_bytes , $max_length ); $sth->bind_param_inout( 8 , \$last_file_id , $max_length ); $sth->bind_param_inout( 9 , \$last_block_id, $max_length ); $sth->bind_param_inout( 10, \$last_block , $max_length ); $sth->bind_param( 11, $partition ); $sth->execute; $sth = $dbh->prepare( " BEGIN dbms_space.free_blocks( ?,?,?,?,?,?,? ) ; END ; " ); $sth->bind_param( 1, "\U$owner" ); $sth->bind_param( 2, "\U$name" ); $sth->bind_param( 3, "\U$type" ); $sth->bind_param( 4, $freelist_group_id ); $sth->bind_param_inout( 5 , \$free_blocks, $max_length ); $sth->bind_param( 6, '' ); $sth->bind_param( 7, $partition ); $sth->execute; } else { $sth = $dbh->prepare( " BEGIN dbms_space.unused_space ( ?,?,?,?,?,?,?,?,?,? ) ; END ; " ); $sth->bind_param( 1, "\U$owner" ); $sth->bind_param( 2, "\U$name" ); $sth->bind_param( 3, "\U$type" ); $sth->bind_param_inout( 4 , \$total_blocks , $max_length ); $sth->bind_param_inout( 5 , \$total_bytes , $max_length ); $sth->bind_param_inout( 6 , \$unused_blocks, $max_length ); $sth->bind_param_inout( 7 , \$unused_bytes , $max_length ); $sth->bind_param_inout( 8 , \$last_file_id , $max_length ); $sth->bind_param_inout( 9 , \$last_block_id, $max_length ); $sth->bind_param_inout( 10, \$last_block , $max_length ); $sth->execute; $sth = $dbh->prepare( " BEGIN dbms_space.free_blocks( ?,?,?,?,? ) ; END ; " ); $sth->bind_param( 1, "\U$owner" ); $sth->bind_param( 2, "\U$name" ); $sth->bind_param( 3, "\U$type" ); $sth->bind_param( 4, $freelist_group_id ); $sth->bind_param_inout( 5 , \$free_blocks, $max_length ); $sth->execute; } my $text; if ( $partition ) { $text = "Partition $partition BYTES"; } else { $text = " BYTES"; } $text .= " BLOCKS\n" . " ============" . " =========\n" . sprintf( "Used BELOW the high water mark %12d %9d\n", $total_bytes - $unused_bytes - $free_blocks * $block_size * 1024, $total_blocks - $unused_blocks - $free_blocks ) . sprintf( "Free ABOVE the high water mark %12d %9d\n", $unused_bytes, $unused_blocks ) . sprintf( "Free BELOW the high water mark %12d %9d\n", $free_blocks * $block_size * 1024, $free_blocks ) . " ------------" . " ---------\n" . sprintf( " TOTAL in segment %12d %9d\n\n", $total_bytes, $total_blocks ) . " FILE_ID BLOCK_ID" . " BLOCK_NBR\n" . " ======= ========" . " =========\n" . sprintf( "Last extent having data %7d %8d %9d\n\n", $last_file_id, $last_block_id, $last_block ); return ( $text, $total_blocks, $total_bytes, $unused_blocks, $unused_bytes, $free_blocks, ); } # sub _range_partitions # # Returns the ordered list of index range partitions with segment attributes # sub _range_partitions { my ( $owner, $index, $view, $subpartitioning_type, $caller ) = @_; my $sql .= "(\n"; my $stmt; if ( $oracle_major == 8 and $oracle_minor == 0 ) { $stmt = " SELECT partition_name , high_value , 'N/A' AS cache , 'N/A' AS pct_used , pct_free , ini_trans , max_trans -- Storage Clause , initial_extent , next_extent , min_extent , DECODE( max_extent ,2147483645,'unlimited' , max_extent ) AS max_extents , pct_increase , NVL(freelists,1) , NVL(freelist_groups,1) , 'N/A' AS buffer_pool , DECODE( logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , tablespace_name , leaf_blocks AS blocks FROM ${view}_ind_partitions WHERE index_name = UPPER( ? ) "; } else # We're Oracle8i or newer { $stmt = " SELECT partition_name , high_value , 'N/A' AS cache , 'N/A' AS pct_used , pct_free , ini_trans , max_trans -- Storage Clause , initial_extent , next_extent , min_extent , DECODE( max_extent ,2147483645,'unlimited' , max_extent ) AS max_extents , pct_increase , NVL(freelists,1) , NVL(freelist_groups,1) , LOWER(buffer_pool) , DECODE( logging ,'NO','NOLOGGING' , 'LOGGING' ) AS logging , tablespace_name , leaf_blocks AS blocks FROM ${view}_ind_partitions WHERE index_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND index_owner = UPPER('$owner') "; } $stmt .= " ORDER BY partition_name "; $dbh->{ LongReadLen } = 8192; # Allows HIGH_VALUE length of 8K $dbh->{ LongTruncOk } = 1; $sth = $dbh->prepare( $stmt ); $sth->execute( $index ); my $aref = $sth->fetchall_arrayref; my $comma = ' '; foreach my $row ( @$aref ) { my $partition = shift @$row; my $high_value = shift @$row; $sql .= "${comma}PARTITION \L$partition"; if ($caller ne 'LOCAL' ) { $sql .= " VALUES LESS THAN\n" . " (\n" . " $high_value\n" . " )\n"; } else { $sql .= "\n"; } unshift @$row, ( ' ', 'INDEX' ); $sql .= _segment_attributes( $row ); if ( $subpartitioning_type eq 'HASH' ) { $stmt = " SELECT subpartition_name , tablespace_name FROM ${view}_ind_subpartitions WHERE index_name = UPPER( ? ) AND partition_name = '$partition' "; if ( $view eq 'DBA' ) { $stmt .= " AND index_owner = UPPER('$owner') "; } $stmt .= " ORDER BY subpartition_name "; $sth = $dbh->prepare( $stmt ); $sth->execute( $index ); my $aref = $sth->fetchall_arrayref; $sql .= " (\n "; my @cols; foreach my $row ( @$aref ) { push @cols, "SUBPARTITION \L$row->[0] \UTABLESPACE \L$row->[1]"; } $sql .= join ( "\n , ", @cols ); $sql .= "\n )\n"; } $comma = ' , '; } $sql .= ");\n\n"; return $sql; } # sub _resize_index # # Returns DDL to rebuild the named index or its partition(s) in the form of: # # ALTER INDEX [schema.] REBUILD # [PARTITION ] # STORAGE # ( # INITIAL # NEXT # ) # sub _resize_index { my ( $schema, $owner, $name, $view ) = @_; my $cnt; my $sql; ( $name, my $partition ) = split /:/, $name; my $stmt = " SELECT count(*) AS cnt FROM ${view}_indexes WHERE index_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); $cnt = $sth->fetchrow_array; die "Index \U$name \Ldoes not exist.\n\n" unless $cnt; if ( $partition ) # User wants one partition resized { $stmt = " SELECT SUBSTR(segment_type,7) -- PARTITION or SUBPARTITION FROM ${view}_segments s WHERE s.segment_name = UPPER( ? ) AND s.partition_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND s.owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $partition ); my ( $seq_type, $partitioning_type ) = $sth->fetchrow_array; die "Partition \U$partition \Lof \UI\Lndex \U$name \Ldoes not exist,\n", " OR it is the parent of Hash subpartition(s)\n", " (i.e., it is not a segment and has no size).\n\n" unless $seq_type; $sql .= _resize_index_partition( $schema, $owner, $name, $partition, $seq_type, $view ); return $sql; } # Find out if the object is partitioned $stmt = " SELECT partitioned FROM ${view}_indexes WHERE index_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $partitioned = $sth->fetchrow_array; if ( $partitioned eq 'NO' ) { $stmt = " SELECT s.blocks , s.initial_extent , s.next_extent FROM ${view}_segments s WHERE s.segment_name = UPPER( ? ) AND s.segment_type = 'INDEX' "; if ( $view eq 'DBA' ) { $stmt .= " AND s.owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my ( $blocks, $initial, $next ) = $sth->fetchrow_array; ( $initial, $next ) = _initial_next( $blocks ) if $attr{ 'resize' }; $sql .= "PROMPT " . "ALTER INDEX \L$schema$name \UREBUILD\n\n" . "ALTER INDEX \L$schema$name \UREBUILD\n" . "STORAGE\n" . "(\n" . " INITIAL $initial\n" . " NEXT $next\n" . ") ;\n\n"; return $sql; } else { # It's partitioned -- get list of partitions # and call _resize_index_partition for each one $stmt = " SELECT partition_name , SUBSTR(segment_type,7) -- PARTITION or SUBPARTITION FROM ${view}_segments WHERE segment_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY partition_name "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { my ( $partition, $seg_type ) = @$row; $sql .= _resize_index_partition( $schema, $owner, $name, $partition, $seg_type, $view ); } return $sql; } } # sub _resize_index_partition # # Returns DDL to rebuild one partition of the named object in the form of: # # ALTER INDEX [schema.] REBUILD [SUB]PARTITION # STORAGE # ( # INITIAL # NEXT # ) # sub _resize_index_partition { my( $schema, $owner, $name, $partition, $seg_type, $view ) = @_; my $sql; my $stmt = " SELECT s.blocks , s.initial_extent , s.next_extent , p.partitioning_type FROM ${view}_segments s , ${view}_part_indexes p WHERE s.segment_name = UPPER( ? ) AND s.partition_name = UPPER( ? ) AND p.index_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND s.owner = UPPER('$owner') AND p.owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $partition, $name ); my ( $blocks, $initial, $next, $partitioning_type ) = $sth->fetchrow_array; ( $initial, $next ) = _initial_next( $blocks ) if $attr{ 'resize' }; $sql .= "PROMPT " . "ALTER INDEX \L$schema$name \UREBUILD $seg_type \L$partition\n\n" . "ALTER INDEX \L$schema$name \UREBUILD $seg_type \L$partition "; # Cannot specify storage parameters for a HASH [SUB]PARTITION if ( $seg_type eq 'PARTITION' and $partitioning_type eq 'RANGE' ) { $sql .= "\nSTORAGE\n" . "(\n" . " INITIAL $initial\n" . " NEXT $next\n" . ") "; } $sql .= ";\n\n"; return $sql; } # sub _resize_table # # Returns DDL to rebuild the named table or its partition(s) in the form of: # # ALTER TABLE [schema.] MOVE [[SUB]PARTITION ] # STORAGE # ( # INITIAL # NEXT # ) # sub _resize_table { my ( $schema, $owner, $name, $view ) = @_; my $cnt; my $sql; ( $name, my $partition ) = split /:/, $name; my $stmt = " SELECT count(*) AS cnt FROM ${view}_tables WHERE table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); $cnt = $sth->fetchrow_array; die "Table \U$name \Ldoes not exist.\n\n" unless $cnt; if ( $partition ) # User wants one partition resized { $stmt = " SELECT SUBSTR(segment_type,7) -- PARTITION or SUBPARTITION FROM ${view}_segments WHERE segment_name = UPPER( ? ) AND partition_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $ partition ); my $type = $sth->fetchrow_array; die "Partition \U$partition \Lof \UT\Lable \U$name \Ldoes not exist,\n", " OR it is the parent of Hash subpartition(s)\n", " (i.e., it is not a segment and has no size).\n\n" unless $type; $sql .= _resize_table_partition( $schema, $owner, $name, $partition, $type, $view ); # Rebuild this partition on all LOCAL indexes if ( $view eq 'DBA' ) { $stmt = " SELECT owner , index_name FROM dba_part_indexes WHERE table_name = UPPER( ? ) AND owner = UPPER('$owner') AND locality = 'LOCAL' "; } else # We're a mortal USER { $stmt = " SELECT '$owner' , index_name FROM user_part_indexes WHERE table_name = UPPER( ? ) AND locality = 'LOCAL' "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { my ( $owner, $index ) = @$row; my $schema = _set_schema( $owner ); $sql .= _resize_index( $schema, $owner, "$index:$partition", $view ); } } else # Didn't want single partition, so move entire table. # First, find out if the object is partitioned { $stmt = " SELECT partitioned FROM ${view}_tables WHERE table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $partitioned = $sth->fetchrow_array; if ( $partitioned eq 'NO' ) { $stmt = " SELECT s.blocks - NVL(t.empty_blocks,0) , s.initial_extent , s.next_extent FROM ${view}_segments s , ${view}_tables t WHERE s.segment_name = UPPER( ? ) AND s.segment_type = 'TABLE' AND t.table_name = s.segment_name "; if ( $view eq 'DBA' ) { $stmt .= " AND s.owner = UPPER('$owner') AND t.owner = s.owner "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my ( $blocks, $initial, $next ) = $sth->fetchrow_array; ( $initial, $next ) = _initial_next( $blocks ) if $attr{ 'resize' }; $sql .= "PROMPT " . "ALTER TABLE \L$schema$name \UMOVE\n\n" . "ALTER TABLE \L$schema$name \UMOVE\n" . "STORAGE\n" . "(\n" . " INITIAL $initial\n" . " NEXT $next\n" . ") ;\n\n"; return $sql; } else { # It's partitioned -- get list of partitions # and call _resize_table_partition for each one $stmt = " SELECT partition_name , SUBSTR(segment_type,7) -- PARTITION or SUBPARTITION FROM ${view}_segments WHERE segment_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY partition_name "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { my ( $partition, $type ) = @$row; $sql .= _resize_table_partition( $schema, $owner, $name, $partition, $type, $view ); } } # Rebuild all indexes (partitioned or not) if ( $view eq 'DBA' ) { $stmt = " SELECT owner , index_name FROM dba_part_indexes WHERE table_name = UPPER( ? ) AND owner = UPPER('$owner') "; } else # We're a mortal USER { $stmt = " SELECT '$owner' , index_name FROM user_part_indexes WHERE table_name = UPPER( ? ) "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; foreach my $row ( @$aref ) { my ( $owner, $index ) = @$row; my $schema = _set_schema( $owner ); $sql .= _resize_index( $schema, $owner, $index, $view ); } } return $sql; } # sub _resize_table_partition # # Returns DDL to rebuild one partition of the named object in the form of: # # ALTER TABLE [schema.] MOVE [SUB]PARTITION # STORAGE # ( # INITIAL # NEXT # ) # sub _resize_table_partition { my( $schema, $owner, $name, $partition, $seg_type, $view ) = @_; my $sql; my $stmt = " SELECT s.blocks - NVL(t.empty_blocks,0) , s.initial_extent , s.next_extent , p.partitioning_type FROM ${view}_segments s , ${view}_tab_${seg_type}s t , ${view}_part_tables p WHERE s.segment_name = UPPER( ? ) AND s.partition_name = UPPER( ? ) AND t.table_name = UPPER( ? ) AND t.partition_name = UPPER( ? ) AND p.table_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND s.owner = UPPER('$owner') AND p.owner = UPPER('$owner') AND t.table_owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name, $partition, $name, $partition, $name ); my ( $blocks, $initial, $next, $partitioning_type ) = $sth->fetchrow_array; ( $initial, $next ) = _initial_next( $blocks ) if $attr{ 'resize' }; $sql .= "PROMPT " . "ALTER TABLE \L$schema$name \UMOVE $seg_type \L$partition\n\n" . "ALTER TABLE \L$schema$name \UMOVE $seg_type \L$partition "; # Cannot specify storage parameters for a HASH [SUB]PARTITION if ( $seg_type eq 'PARTITION' and $partitioning_type eq 'RANGE' ) { $sql .= "\nSTORAGE\n" . "(\n" . " INITIAL $initial\n" . " NEXT $next\n" . ") "; } $sql .= ";\n\n"; return $sql; } # sub _scratch_prompts # # Eliminates all PROMPT statements # sub _scratch_prompts { # Drop all lines beginning with PROMPT $ddl = ( join "\n",grep !/^PROMPT/,split /\n/,$ddl ); # This would have left the first line blank, so drop it $ddl =~ s|\A\n||; # Get rid of double blank lines $ddl =~ s|\n\n+|\n\n|g; } # sub _segments_attributes # # Formats the segment attributes portion of CREATE TABLE and CREATE INDEX # statements # sub _segment_attributes { my ( $arrayref ) = @_; my $sql; my ( $indent, # Physical Properties $organization, # Segment Attributes $cache, $pct_used, $pct_free, $ini_trans, $max_trans, $initial, $next, $min_extents, $max_extents, $pct_increase, $freelists, $freelist_groups, $buffer_pool, $logging, $tablespace, $blocks, ) = @$arrayref; unless ( $attr{ 'storage' } ) { if ( $attr{ 'tblspace' } ) { $sql .= "${indent}TABLESPACE \L$tablespace\n"; } return $sql; } ( $initial, $next ) = _initial_next( $blocks ) if $attr{ 'resize' }; if ( $organization eq 'HEAP' ) { $sql = "${indent}$cache\n" unless $cache eq 'N/A'; $sql .="${indent}PCTUSED $pct_used\n" unless $isasnapindx; } $sql .= "${indent}PCTFREE $pct_free\n" unless $isasnapindx; $sql .= "${indent}INITRANS $ini_trans\n" unless $isasnaptabl; $sql .= "${indent}MAXTRANS $max_trans\n" . "${indent}STORAGE\n" . "${indent}(\n" . "${indent} INITIAL $initial\n" . "${indent} NEXT $next\n" . "${indent} MINEXTENTS $min_extents\n" . "${indent} MAXEXTENTS $max_extents\n" . "${indent} PCTINCREASE $pct_increase\n"; if ( $oracle_major < 8 or ( $oracle_major == 8 and $oracle_minor == 0 ) ) { unless ( $isasnaptabl or $isasnapindx ) { $sql .= "${indent} FREELISTS $freelists\n" . "${indent} FREELIST GROUPS $freelist_groups\n"; } } else { $sql .= "${indent} FREELISTS $freelists\n" . "${indent} FREELIST GROUPS $freelist_groups\n"; } if ( $oracle_major > 8 or ( $oracle_major == 8 and $oracle_minor > 0 ) ) { $sql .= "${indent} BUFFER_POOL $buffer_pool\n"; } $sql .= "${indent})\n"; $sql .= "${indent}$logging\n" if $oracle_major > 7; if ( $attr{ 'tblspace' } ) { $sql .= "${indent}TABLESPACE \L$tablespace\n"; } return $sql; } sub _set_schema { my $owner = shift; my $schema = ( "\U$owner" eq 'PUBLIC' ) ? 'PUBLIC' : ( $attr{ schema } == 1 ) ? $owner . '.' : ( $attr{ schema } ) ? $attr{ schema } . '.' : ''; return $schema; } # sub _set_sizing # # If %attr has an entry for "resize" == l, generates an arbitrary sizing # algorithm wherein the database block size is used to create an array such # that each object will have no more than 8 extents. The INITIAL and NEXT # sizes of Tables and Indexes are set to the calculated value. # # If %attr DOES contain an entry for "resize", it is parsed and stored in the # array called @size_arr. # sub _set_sizing { $sth = $dbh->prepare( " SELECT block_size FROM ( SELECT bytes / blocks AS block_size FROM user_segments WHERE bytes IS NOT NULL AND blocks IS NOT NULL AND rownum < 2 UNION SELECT bytes / blocks AS block_size FROM user_free_space WHERE bytes IS NOT NULL AND blocks IS NOT NULL AND rownum < 2 ) WHERE rownum < 2 "); $sth->execute; $block_size = $sth->fetchrow_array / 1024; if ( $attr{ 'resize' } == 1 ) { # Create default array for my $i ( 0 .. 4 ) { my $limit = ( 4 * ( 10 ** ( $i + 1 ) ) + 1 ); my $initial = my $next = ( 5 * $block_size ) * ( 10 ** $i ) . "K"; push @size_arr, [$limit, $initial, $next]; } # Force upper limit bound $size_arr[$#size_arr][0] = 'UNLIMITED'; } elsif ( $attr{ 'resize' } ) { # parse user supplied string into @size_arr my $remainder = $attr{ 'resize' }; while ( $remainder ) { ( my ($limit,$initial,$next),$remainder ) = split /:/, $remainder, 4; die "\nSupplied resize string is malformed.\n\n" unless $initial; die "\nSupplied resize string is malformed.\n\n" unless $next; push @size_arr, [$limit, $initial, $next]; } # Force upper limit bound $size_arr[$#size_arr][0] = 'UNLIMITED'; } } #sub _show_free_space # # Reutrns a report in the form of: # # Space analysis for: [schema.] # # BYTES BLOCKS # ============ ========= # Used BELOW the high water mark 1325056 647 # Free ABOVE the high water mark 716800 350 # Free BELOW the high water mark 6144 3 # ------------ --------- # TOTAL in segment 2048000 1000 # # FILE_ID BLOCK_ID BLOCK_NBR # ======= ======== ========= # Last extent having data 9 10287 150 # sub _show_free_space { my ( $owner, $name, $type, $view ) = @_; my $stmt = " SELECT 'Yes, I can execute package DBMS_SPACE' FROM all_tab_privs WHERE privilege = 'EXECUTE' AND table_name = 'DBMS_SPACE' AND table_schema = 'SYS' "; $sth = $dbh->prepare( $stmt ); $sth->execute; my ( $can_execute ) = $sth->fetchrow_array; die "Either you or PUBLIC must have EXECUTE privilege on package\n", "sys.DBMS_SPACE in order to produce the FREE SPACE report.\n\n" unless $can_execute; if ( $oracle_major == 7 or "\U$type" eq 'CLUSTER' ) { $stmt = " SELECT 'NO' AS partitioned FROM ${view}_segments WHERE segment_name = UPPER( ? ) AND segment_type = UPPER( '$type' ) "; } else { my $plural = ( "\U$type" eq 'INDEX' ) ? 'ES' : 'S'; $stmt = " SELECT partitioned FROM ${view}_$type$plural WHERE ${type}_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my ( $partitioned ) = $sth->fetchrow_array; die "\u\L$type \U$name \Ldoes not exist.\n\n" unless $partitioned; my $text = "Space analysis for: \U$owner.$name\n\n"; if ( $partitioned eq 'YES' ) { my ( $section, $total_blocks, $total_bytes, $unused_blocks, $unused_bytes, $free_blocks, $sum_total_blocks, $sum_total_bytes, $sum_unused_blocks, $sum_unused_bytes, $sum_free_blocks, ); $stmt = " SELECT RPAD(partition_name,30) , segment_type FROM ${view}_segments WHERE segment_name = UPPER( ? ) "; if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY partition_name "; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; foreach my $row (@$aref ) { my ( $partition, $seg_type ) = @$row; ( $section, $total_blocks, $total_bytes, $unused_blocks, $unused_bytes, $free_blocks, ) = _print_space( $owner, $name, $seg_type, $partition ); $text .= $section; $sum_total_blocks += $total_blocks; $sum_total_bytes += $total_bytes; $sum_unused_blocks += $unused_blocks; $sum_unused_bytes += $unused_bytes; $sum_free_blocks += $free_blocks; } $text .= "TOTAL segment BYTES" . " BLOCKS\n" . " ============" . " =========\n" . sprintf( "Used BELOW the high water mark %12d %9d\n", $sum_total_bytes - $sum_unused_bytes - $sum_free_blocks * $block_size * 1024, $sum_total_blocks - $sum_unused_blocks - $sum_free_blocks ) . sprintf( "Free ABOVE the high water mark %12d %9d\n", $sum_unused_bytes, $sum_unused_blocks ) . sprintf( "Free BELOW the high water mark %12d %9d\n", $sum_free_blocks * $block_size * 1024, $sum_free_blocks ) . " ------------" . " ---------\n" . sprintf( " GRAND TOTAL in segment %12d %9d\n\n", $sum_total_bytes, $sum_total_blocks ); return $text; } else # Not partitioned { ( my $section ) = _print_space( $owner, $name, $type ); return $text . $section; } } #sub _subpartition_key_columns # # Returns a formatted string containing the subpartitioning key columns # sub _subpartition_key_columns { return _key_columns( @_, 'SUBPART' ); } # sub _table_columns # # Returns a formatted string containing the column names, datatype and # length, and NOT NULL (if appropriate) for use in a CREATE TABLE # statement. # sub _table_columns { my ( $owner, $name, $view ) = @_; my $stmt; if ( $oracle_major == 7 ) { $stmt = " SELECT RPAD(LOWER(column_name),32) || RPAD( DECODE( data_type ,'NUMBER',DECODE( data_precision ,null,DECODE( data_scale ,0,'INTEGER' , 'NUMBER ' ) ,'NUMBER ' ) ,'RAW' ,'RAW ' ,'CHAR' ,'CHAR ' ,'NCHAR' ,'NCHAR ' ,'UROWID' ,'UROWID ' ,'VARCHAR2','VARCHAR2 ' ,data_type ) || DECODE( data_type ,'DATE',null ,'LONG',null ,'NUMBER',DECODE( data_precision ,null,null ,'(' ) ,'RAW' ,'(' ,'CHAR' ,'(' ,'NCHAR' ,'(' ,'UROWID' ,'(' ,'VARCHAR2' ,'(' ,'NVARCHAR2','(' ,null ) || DECODE( data_type ,'RAW' ,data_length ,'CHAR' ,data_length ,'NCHAR' ,data_length ,'UROWID' ,data_length ,'VARCHAR2' ,data_length ,'NVARCHAR2',data_length ,'NUMBER' ,data_precision , null ) || DECODE( data_type ,'NUMBER',DECODE( data_precision ,null,null ,DECODE( data_scale ,null,null ,0 ,null ,',' || data_scale ) ) ) || DECODE( data_type ,'DATE',null ,'LONG',null ,'NUMBER',DECODE( data_precision ,null,null ,')' ) ,'RAW' ,')' ,'CHAR' ,')' ,'NCHAR' ,')' ,'UROWID' ,')' ,'VARCHAR2' ,')' ,'NVARCHAR2',')' ,null ) ,33 ) , nullable , data_default FROM ${view}_tab_columns WHERE table_name = UPPER( ? ) "; } else # We're newer than Oracle7 { $stmt = " SELECT RPAD(LOWER(column_name),32) || RPAD( DECODE( data_type ,'NUMBER',DECODE( data_precision ,null,DECODE( data_scale ,0,'INTEGER' , 'NUMBER ' ) ,'NUMBER ' ) ,'RAW' ,'RAW ' ,'CHAR' ,'CHAR ' ,'NCHAR' ,'NCHAR ' ,'UROWID' ,'UROWID ' ,'VARCHAR2','VARCHAR2 ' ,data_type ) || DECODE( data_type ,'DATE',null ,'LONG',null ,'NUMBER',DECODE( data_precision ,null,null ,'(' ) ,'RAW' ,'(' ,'CHAR' ,'(' ,'NCHAR' ,'(' ,'UROWID' ,'(' ,'VARCHAR2' ,'(' ,'NVARCHAR2','(' ,null ) || DECODE( data_type ,'RAW' ,data_length ,'CHAR' ,data_length ,'NCHAR' ,data_length ,'UROWID' ,data_length ,'VARCHAR2' ,data_length ,'NVARCHAR2',data_length ,'NUMBER' ,data_precision , null ) || DECODE( data_type ,'NUMBER',DECODE( data_precision ,null,null ,DECODE( data_scale ,null,null ,0 ,null ,',' || data_scale ) ) ) || DECODE( data_type ,'DATE',null ,'LONG',null ,'NUMBER',DECODE( data_precision ,null,null ,')' ) ,'RAW' ,')' ,'CHAR' ,')' ,'NCHAR' ,')' ,'UROWID' ,')' ,'VARCHAR2' ,')' ,'NVARCHAR2',')' ,null ) ,32 ) , nullable , data_default FROM ${view}_tab_columns WHERE table_name = UPPER( ? ) "; } if ( $view eq 'DBA' ) { $stmt .= " AND owner = UPPER('$owner') "; } $stmt .= " ORDER BY column_id "; $dbh->{ LongReadLen } = 1024; # Allows Default to be 1K $dbh->{ LongTruncOk } = 1; $sth = $dbh->prepare( $stmt ); $sth->execute( $name ); my $aref = $sth->fetchall_arrayref; my @cols; foreach my $row ( @$aref ) { my ( $column, $nullable, $default ) = @$row; # Knock off any trailing newlines chomp $default; $column .= "DEFAULT $default " if defined $default; $column .= 'NOT NULL' if $nullable eq 'N'; push @cols, $column; } return join ( "\n , ", @cols ) . "\n"; } 1; __END__ ######################################################################## =head1 NAME DDL::Oracle - a DDL generator for Oracle databases =head1 VERSION VERSION = 1.11 =head1 SYNOPSIS use DBI; use DDL::Oracle; my $dbh = DBI->connect( "dbi:Oracle:dbname", "username", "password", { PrintError => 0, RaiseError => 1 } ); # Use default resize and schema options. # query default DBA_xxx tables (could use USER_xxx for non-DBA types) DDL::Oracle->configure( dbh => $dbh, ); # Create a list of one or more objects my $sth = $dbh->prepare( "SELECT owner , table_name FROM dba_tables WHERE tablespace_name = 'MY_TBLSP' -- your mileage may vary " ); $sth->execute; my $list = $sth->fetchall_arrayref; my $obj = DDL::Oracle->new( type => 'table', list => $list, ); ); my $ddl = $obj->create; # or $obj->resize; or $obj->drop; etc. print $ddl; # Use STDOUT so user can redirect to desired file. # Here's another example, this time for type 'components'. This type # differs from the norm, because it has no owner and no name. my $obj = DDL::Oracle->new( type => 'components', list => [[ 'no owner','no name' ]] ); my $ddl = $obj->create; print $ddl; =head1 DESCRIPTION =head2 Overview Designed for Oracle DBA's and users. It reverse engineers database objects (tables, indexes, users, profiles, tablespaces, roles, constraints, etc.). It generates DDL to *resize* tables and indexes to the provided standard or to a user defined standard. We originally wrote a script to defrag tablespaces, but as DBA's we regularly find a need for the DDL of a single object or a list of objects (such as all of the indexes for a certain table). So we took all of the DDL statement creation logic out of defrag.pl, and put it into the general purpose DDL::Oracle module, then expanded that to include tablespaces, users, roles, and all other dictionary objects. Oracle tablespaces tend to become fragmented (now THAT's an understatement). Even when object sizing standards are adopted, it is difficult to get 100% compliance from users. And even if you get a high degree of compliance, objects turn out to be a different size than originally thought/planned -- small tables grow to become large (i.e., hundreds of extents), what was thought would be a large table ends up having only a few rows, etc. So the main driver for DDL::Oracle was the object management needs of Oracle DBA's. The "resize" method generates DDL for a list of tables or indexes. For partitioned objects, the "appropriate" size of EACH partition is calculated and supplied in the generated DDL. =head2 Initialization and Constructor configure The B method is used to supply the DBI connection and to set several session level attributes. These are: dbh A reference to a valid DBI connection (obtained via DBI->connect). This is the only mandatory attribute. NOTE: The user connecting should have SELECT privileges on the following views (in addition to the DBA or USER views), but see attributes 'heading' for exceptions: V$DATABASE [i.e., sys.V_$DATABASE table] And, in order to generate CREATE SNAPSHOT LOG statements, you will also need to create a PUBLIC SYNONYM for DBA_SNAPSHOT_LOG_FILTER_COLS. In order for non-DBA users to do the same, you will need to grant SELECT on this view to them (e.g., to PUBLIC). Why Oracle Corp. feels this view is of no interest to non-replication users is a mystery to the author. And, in order to generate CREATE INDEX statements for indexes which have DESCending column(s) and/or include FUNCTION based column(s), you must have select privileges on SYS.COL$, wherein the real name of the column or function definition is held. schema Defines whether and what to use as the schema for DDL on objects which use this syntax. "1" means use the owner of the object as the schema; "0" or "" means omit the schema syntax; any other arbtrary string will be imbedded in the DDL as the schema. The default is "1". resize Defines whether and what to use in resizing segments. "1" means resize segments using the default algorithm; "0" or "" means keep the current INITIAL and NEXT values; any other string will be interpreted as a resize definition. The default is "1". To establish a user defined algorithm, define this with a string consisting of n sets of LIMIT:INITIAL:NEXT. LIMIT is expressed in Database Blocks. The highest LIMIT may contain the string 'UNLIMITED', and in any event will be forced to be so by DDL::Oracle. view Defines which Dictionary views to query: DBA or USER (e.g., DBA_TABLES or USER_TABLES). The default is DBA. heading Defines whether to include a Heading having Host, Instance, Date/Time, List of generated Objects, etc. "1" means include the heading; "0" or "" means to suppress the heading (and eliminate the query against V$DATABASE). The default is "1". prompt Defines whether to include a PROMPT statement along with the DDL. If the output is intended for use in SQL*Plus, this will cause SQL*Plus to display a comment about each statement before it executes, which can be helpful in a multi-statement file. "1" means include the prompt; "0" or "" means to suppress the prompt. grants Defines whether to include object grants following a CREATE statement for Tables, Views, Materialized Views [Snapshots], Sequences, Procedures, Functions, Packages, Types and Synonyms. "1" means include the grant state- ments; "0" or "" means to suppress the grant statements. The default is "0". storage Defines whether to include the STORAGE clause [plus PCTUSED, PCTFREE, INITRANS and MAXTRANS] in DDL for tables and indexes. "1" means include these clauses; "0" or "" means omit them. The default is "1". tblspace Defines whether to include the TABLESPACE clause in DDL for tables and indexes. "1" means include this clause; "0" or "" means omit it. The default is "1". new The B method is the object constructor. The two mandatory object definitions are supplied with this method, to wit: type The type of object (e.g., TABLE, INDEX, SYNONYM, family, etc.). For 'table family', supply the name(s) of tables -- the DDL will include the table and its: Comments (Table and Column) Indexes Constraints Triggers list An arrayref to an array of arrayrefs (as in the DBI's "fetchall_arrayref" method) containing pairs of owner and name. =head2 Object methods create The B method generates the DDL to create the list of Oracle objects. Virtually every type of Oracle object (table, index, user, synonym, trigger, etc.) can be CREATEd via this method -- see hash %create for a complete list. There is also a type called 'components' which is an aggregate type. It generates the DDL for all objects of types which do not have an owner (tablespace, rollback segment, profile, role, user) and for PUBLIC database links and synonyms. See the SYNOPSIS for an example of this. drop The B method generates the DDL to drop the list of Oracle objects. resize The B method generates the DDL to resize the list of Oracle objects. The 'type' defined in the 'new' method is limited to 'index' and 'table'. For tables, this generates an ALTER TABLE MOVE statement; for indexes, it generates an ALTER INDEX REBUILD statement. If the table or index is partitioned, then a statement for each partition is generated. To generate DDL for a single partition of an index or table, define the 'name' as a colon delimited field (e.g., 'name:partition'). compile The B method generates the DDL to compile the list of Oracle objects. The 'type' defined in the 'new' method is limited to 'function', 'package', 'procedure', 'trigger' and 'view'. show_space The B method produces a report showing used/unused bytes and blocks above/below the high water mark in a segment. It includes the free blocks below the high water mark. For partitioned objects, it shows the information for each partition, with grand totals for the table/index. The object does NOT need to be analyzed for this report to be accurate -- it uses package sys.DBMS_SPACE to collect the data. =head1 BUGS =head1 FILES copy_user.pl copy_user.sh ddl.pl defrag.pl query.pl =head1 AUTHOR Richard V. Sutherland rvsutherland@yahoo.com =head1 COPYRIGHT Copyright (c) 2000, 2001 Richard V. Sutherland. All rights reserved. This module is free software. It may be used, redistributed, and/or modified under the same terms as Perl itself. See: http://www.perl.com/perl/misc/Artistic.html =cut