#!/usr/local/bin/perl
#
# $Header: wastedSpace.pl 26-may-2004.08:49:39 jochen Exp $
#
# wastedSpace.pl
#
# Copyright (c) 2003, 2004, Oracle. All rights reserved.
#
# NAME
# wastedSpace.pl
#
# DESCRIPTION
# For a given list of tablespaces or schemas, return a list of
# tables in the tablespaces or schemas with excess wasted space
# or row chaining problems.
#
# ARGV[0] must be a list of ";" separated tablespace names to check.
# Send ";" if no tablespaces.
# ARGV[1] must be a list of schema names. Send ";" if no schemas
# should be checked.
# ARGV[2] is the minimum wasted space % for which data is returned.
# ARGV[3] is the minimum row chaining % for which data is returned.
# ARGV[4] is 'true' if wasted space check is enabled
# ARGV[5] is 'true' if row chain check is enabled
# ARGV[6] is the minimum size(MB) of segments that should be checked.
#
# For old OMS's (10.1.0.2), an em_result wasted space row is printed
# if the wasted space below the HWM is > min wasted space %.
#
# For newer OMS's, an em_result wasted space row is printed
# if the total wasted space in the segment is > min wasted space %.
# This includes the unused blocks above the HWM.
# See the printWasteOutput function for the format of the output line.
#
# NOTES
#
# Instructions for testing script standalone in vob:
#
# setenv EMDROOT $ADE_VIEW_ROOT/emdw
# setenv EM_TARGET_ADDRESS "(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP)(HOST=<yourhost>)(Port=<yourport>))(CONNECT_DATA=(SID=<yoursid>)))"
# setenv VersionCategory <10i or 9i>
# setenv wastedSpacePerf <0 or 1> to show elapsed time
#
# runperl wastedSpace.pl "<tablespaces>" "<schemas>" "<wasteMin>" "<rowChainMin>" "<true or false>(waste check enabled)" "<true or false>(row chain check enabled"
# e.g. runperl wastedSpace.pl "ASSM;TS1" ";" "50" "0" "true" "true"
#
# The script will wait for stdin input. Type the following:
# EM_TARGET_USERNAME=<db username>
# EM_TARGET_PASSWORD=<db password>
# EM_TARGET_ROLE=NORMAL
# Cntrl-D
# or create a file with credentials and < creds_file at the end of the
# runperl command.
#
# Look for _sql to find sql statements
#
# Included segments
# Tables
# Table partitions
# Index for IOT tables
# Index partition for IOT tables
# Lobs
# Lob partitions
#
# Excluded segments (not checked)
# Segments in clusters
# IOT's in non-ASSM tablespaces (nyi)
# Subpartitions (nyi)
# Segments < 1 extent in size
# Segments associated with AQ table (cannot shrink or reorg)
#
# TODO
# Schemas not implemented
# Subpartitions not implemented
# Long row chain check
#
# MODIFIED (MM/DD/YY)
# jochen 05/19/04 - Report on reclaimable space
# Don't recommend both shrink and reorg.
# Check versioncategory in all caps so reg tests
# succeed without case sensitivity issues (unix)
# Use total segment size for new OMS's, not HWM.
# jochen 04/26/04 - Don't check small segments
# jochen 01/05/04 - Log and ignore invalid tablespaces
# jochen 01/02/04 - Ignore AQ tables
# jochen 12/30/03 - Don't show iot overflow in recycle bin
# jochen 11/14/03 - Server no longer supports shrinking lobs
# jochen 11/07/03 - Tune queries
# jochen 10/30/03 - Ignore tables in recycle bin
# jochen 10/24/03 - Performance: Isolate row chain check
# jochen 10/23/03 - Don't connect if nothing checked
# Get chain count for IOTs
# jochen 10/21/03 - Check lobs in MSSM tablespaces
# For 10i, check IOTs in MSSM tablespaces
# jochen 10/20/03 - Algorithm improvements - bug 3202112
# jochen 10/16/03 - Fix getBytesAllocated for non-ASSM
# jochen 10/14/03 - Handle new db version strings
# jochen 10/13/03 - Display IOTs as table segments
# jochen 10/10/03 - Can't use table partitions in 9i
# jochen 10/10/03 - Check objects owned by SYS
# jochen 10/09/03 - Improve IOT partition performance
# jochen 10/08/03 - Use object_space_usage for all 10i segments
# Only check privs if checking wasted space
# Use v$parameter
# Don't check segments in clusters
# Map IOT index partitions to table partitions
# jochen 10/07/03 - Limit inClause to 100 tablespaces
# jochen 10/06/03 - Always recommend shrink for 10i
# jochen 10/02/03 - getTables sql returning tables with no segment
# jochen 09/25/03 - Print SQL statements in performance runs
# abodge 09/03/03 - Improve query perf (bug 3117550)
# jochen 08/26/03 - Get objects for all tablespaces at once.
# Don't check objects < 1 extent. Don't call
# unused_space if estimating from stats.
# jochen 07/21/03 - Use space_usage for ASSM tablespaces
# jochen 06/30/03 - Add maxerrors
# pbantis 06/25/03 - Handle login role
# jochen 06/18/03 - Fix partition names lost
# jochen 06/09/03 - Add row chaining
# jochen 05/23/03 - Calculate bytes unused
# aaitghez 06/10/03 - credentials to be read from stdin
# jochen 04/17/03 - Fix StgPerf
# jochen 04/01/03 - jochen_metric
# jochen 03/24/03 -
# jochen 03/17/03 - Creation
#
use strict;
require "emd_common.pl";
my %stdinArgs = get_stdinvars();
use DBI;
use POSIX;
#-------------------
# Forward subroutines
#-------------------
sub processAll();
sub analyzeSegmentWaste($);
sub analyzeRowChaining($);
sub printEndData($);
sub processAllIOTs();
sub processAllTables();
sub processAllTabParts();
sub endTiming($);
sub startTiming($);
sub getPrivs($);
sub getCompat();
sub processAllIOTParts();
sub processAllLobs();
sub processAllLobParts();
sub clearSegment();
sub getIotPartDisplayName();
sub getAnalyzeSYS($);
sub verifyShrink($);
sub getSpace($);
#PERFORMANCE
# set PERFORMANCE_ON to either 1 or 0
my $PERFORMANCE_ON = $ENV{wastedSpacePerf};
startTiming('OVERALL');
#------------------------
# Get database version
#------------------------
#
# Major version number
my $verStr = $ENV{VersionCategory};
if (!defined($verStr))
{
$verStr = $ENV{VERSIONCATEGORY};
}
my $db_version = $verStr;
if (index($db_version, '8') == 0)
{
$db_version = 8;
}
elsif (index($db_version, '9') == 0)
{
$db_version = 9;
}
else
{
$db_version = substr($db_version, 0, 2);
}
# True if the db is 10.2 or higher.
my $is10_2 = 0;
if ($db_version > 10 || $verStr eq '10gR2')
{
$is10_2 = 1;
}
# compat10i will be set to "true" if 10i database with compatible = 10.0.0.0
# compatible of 10.0.0.0 or greater is needed for shrink
my $compat10i = 0;
EMD_PERL_DEBUG ("Db version $db_version; Is 10.2 = $is10_2\n");
#-----------------------------------------
# Get input tablespaces and schemas
#-----------------------------------------
EMD_PERL_DEBUG ("StgPerf input tablespaces $ARGV[0]\n");
#print ("StgPerf input tablespaces $ARGV[0]\n");
my @tsnames = split /;/ => shift(@ARGV);
#for (@tsnames)
#{
# print $i . " = " . $tsnames[$i] . "\n";
#}
EMD_PERL_DEBUG ("StgPerf input schemas $ARGV[0]\n");
my @schemas = split /;/ => shift(@ARGV);
#for (@schemas)
#{
# print $i . " = " . $schemas[$i] . "\n";
#}
# In clause is an IN clause with a chunk of tablespaces we are processing
# There is a max of 1000 objects in the IN clause so we may have to break
# processing up into batches
# 10/7/03 don't allow more than 100 tablespaces in IN clause to avoid
# shared pool fragmentation.
#
# After we fetch the info for the tablespaces, inASSMClause will contain an
# IN clause for only ASSM tablespaces. We don't estimate space for some
# segment types, so we only need segments in ASSM tablespaces.
#
# hasASSM will be 0 if the database has no ASSM tablespaces, 1 if it does.
my $inClauseLimit = 100;
my $inClause;
my $hasASSM = 0;
my $inASSMClause;
#
# oldOMS will be set to 1 if we are talking to a 10.1.0.3 or earlier agent.
#
my $oldOMS = 0;
#--------------------------------
# Get input minimum % value for wasted space
# Segments with unused space below this value will not be collected.
# If oldOMS == 1, this value is the minimum of wasted space below the
# HWM. If not an old oms, this value is the minimum of wasted space
# in the entire segment.
#--------------------------------
my $wasteMinValue = shift(@ARGV);
EMD_PERL_DEBUG("StgPerf input wasted space minValue $wasteMinValue\n");
#--------------------------------
# Get input minimum value for row chaining
# Segments with row chaining below this value will not be collected.
#--------------------------------
my $rcMinValue = shift(@ARGV);
EMD_PERL_DEBUG("StgPerf input row chaining minValue $rcMinValue\n");
#--------------------------------
# Get checks enabled
# Also print a line that will be loaded into the repository that tells the UI
# whether or not any checking is being done.
#--------------------------------
my $spaceEnabled = shift(@ARGV);
my $rowChainEnabled = shift(@ARGV);
EMD_PERL_DEBUG ("space enabled =" . $spaceEnabled . " chain enabled=" . $rowChainEnabled);
#--------------------------------
# Get the minimum absolute size of wasted space.
# Segments with wasted space below this value will not be reported
# This value defaults to -1 for old OMS (pre 10.2).
#--------------------------------
my $minWasteBytes = shift(@ARGV);
if (!defined($minWasteBytes) || $minWasteBytes < 0)
{
$minWasteBytes = 0;
$oldOMS = 1;
}
$minWasteBytes = $minWasteBytes * 1024 * 1024;
EMD_PERL_DEBUG ("min wasted space bytes = $minWasteBytes MB\n");
EMD_PERL_DEBUG ("old oms = $oldOMS\n");
#-------------------------------------
# print the eod record so we know
# we have processed the data even
# if there are no results
#-------------------------------------
if ($spaceEnabled ne 'true' && $rowChainEnabled ne 'true')
{
printEndData('false');
exit 0;
}
#---------------------------------
# Query to get object space used
#---------------------------------
my $objectSpace_sql =
"BEGIN "
. "dbms_space.object_space_usage("
. ":owner, :objectName, :objectType, 0.0, "
. ":used, :allocated, :partitionName);"
."END;";
#--------------------------------------
# Query to get dbms_space.space_usage
#--------------------------------------
my $spaceUsage_sql =
"BEGIN "
. "dbms_space.space_usage(:owner, :objectName, :objectType, "
. ":ubl, :uby, :fs1bl, :fs1by, :fs2bl, :fs2by, :fs3bl, :fs3by, "
. ":fs4bl, :fs4by, :flbl, :flby, :partitionName);"
."END;";
#---------------------------------
# Query to get unused space info
#---------------------------------
my $unusedSpace_sql =
"BEGIN "
. "dbms_space.unused_space("
. ":owner, :objectName, :objectType, "
. ":totalBlocks, :totalBytes, :unusedBlocks, :unusedBytes, "
. ":lastFileID, :lastBlockID, :lastBlock, :partitionName);"
."END;";
#---------------------------------
# Query to get free blocks
#---------------------------------
my $freeBlocks_sql =
"BEGIN "
. "dbms_space.free_blocks("
. ":owner, :segName, :segType, :freelist_group, :free_blocks);"
."END;";
#---------------------------------
# Query to verify shrink
#---------------------------------
# This verifies that the given wasted space is at least one extent
# in the segment.
# Returns 1 if the segment is shrinkable (wasted space is >1 extent), 0 if not.
#
# :owner IN
# :objectName IN
# :objectType IN
# :partitionName IN
# :waste IN - estimated amount of wasted space
# :shrinkable OUT
#
my $verifyShrink_sql =
"DECLARE "
. "doFree BOOLEAN; "
. "BEGIN "
. "doFree := dbms_space.verify_shrink_candidate( "
. ":owner, :objectName, :objectType, "
. ":waste, :partitionName); "
. "IF (doFree) THEN "
. ":shrinkable := 1; "
. "ELSE "
. ":shrinkable := 0; "
. "END IF; "
. "END; ";
#--------------------------------
# Get connection to the database
#--------------------------------
my $password = $stdinArgs{"EM_TARGET_PASSWORD"};
my $username = $stdinArgs{"EM_TARGET_USERNAME"};
my $role = $ENV{EM_TARGET_ROLE};
my $mode = 0;
if($role =~ /SYSDBA/i)
{
$mode = 2;
}
elsif($role =~ /SYSOPER/i)
{
$mode = 4;
}
my $address = $ENV{EM_TARGET_ADDRESS};
EMD_PERL_DEBUG ("Connecting to $username $address \n");
my $maxObjErrors := 20;
my $objErrCount := 0;
#PERFORMANCE
my $wasteCount := 0; #number of segments with wasted space
my $rcCount := 0; #number of segments with row chaining
my $segCount := 0; #number of segments analyzed
#--
#-- DB connect handle and cursors
#--
my $db;
my $isASSM = 0;
my $spaceCsr;
my $spcUsgCsr;
my $unusedSpcCsr;
my $freeBlocksCsr;
my $verifyCsr;
#--
#-- Tablespace specific data
#--
my $tablespace;
my $blockSize;
# Hash key is tablespace name
# Holds blocksize and tsnumber for tablespaces
my %tsInfo;
#--
#-- True if we have enough privs to check wasted space for objects owned by SYS
#--
my $canAnalyzeSYS := 0;
#--
#-- Segment type codes - must be in synch with emo/util/DBObject.java
#--
my $SEG_TABLE := 1; #-- table
my $SEG_INDEX := 2; #-- index
my $SEG_TABLE_PART := 3; #-- table partition
my $SEG_INDEX_PART := 4; #-- index partition
my $SEG_IOT_OF := 5; #-- iot overflow
my $SEG_LOBCOL_IDX := 6; #-- (not used) lob column index
my $SEG_LOBCOL := 7; #-- lob segment
my $SEG_LOB_PART := 8; #-- lob partition
my $SEG_TABLE_SUBPART := 9; #-- table subpartition
my $SEG_INDEX_SUBPART := 10; #-- index subpartition
my $SEG_LOB_SUBPART := 11; #-- lob subpartition
#my $SEG_CLUSTER := 12; #-- cluster segment (not used)
my $SEG_IOT_OF_PART := 13; #-- iot overflow partition
#--
#-- Problem codes
#--
my $WASTED_SPACE := 1;
my $ROW_CHAINING := 2;
#--
#-- Object specific data
#--
my $owner;
my $objectName;
my $objectType := 'TABLE'; #-- Type of object that segment belongs to.
my $segmentType; #-- Code for segment type
my $segTypeStr; #-- String for segment type
my $segName; #-- segName
#-- When used for lob segments
#-- dbms_space expects the lob segment name but
#-- we display the lob column and table name to
#-- the user, so put the lob segment name here
#-- If non-null, used by dbms_space calls.
my $partName;
my $segPartName; #-- Name of segment partition (lob partition name
#-- or index partition for IOTs)
my $iotName = ''; #-- IOT table name if segment is IOT overflow
my $lobCol; #-- lob column name for lob segments
my $pctFree;
my $initrans;
my $numRows = 0;
my $blocks; #-- Number of used blocks
my $avgRowLen;
my $bytesUnderHWM; #-- Bytes allocated to table under HWM
my $wastedSpacePct; #-- Percentage of wasted space below HWM
#-- For old OMS's this will be the wastedSpace below HWM
#-- For new OMS's this will be the total wasted space
#-- in the segment including the allocated unused blocks.
my $chainCnt = 0; #-- Number of chained rows
my $shrinkSegType; #-- 1 if shrinking segment type is supported
my $initExtent; #-- size of initial extent.
my $nextExtent; #-- size of next extent
my $pctIncrease; #-- PCTINCREASE
my $groups; #-- number of freelist groups
my $segTotalBytes; #-- Total bytes for the segment
my $bytesAllocated; #-- If old OMS, this is bytesUnderHWM.
#-- If new OMS, this is total bytes
#-------------------
# Recommendations
# NOTE: These values must match those in
# oracle.sysman.emo.util.stgAdv.StgAdvConstants
#-------------------
my $S_SHRINK = 1;
my $S_REORG = 2;
#-------
# try
#-------
eval
{
clearSegment();
#-----------------------------
# Connect to database
#-----------------------------
if (($#tsnames != -1) || ($#schemas != -1))
{
#PERFORMANCE
startTiming("connect");
$db= DBI->connect('dbi:Oracle:', "$username@".$address , "$password", {ora_session_mode => $mode})
or die "Could not connect to $username/$address: $DBI::errstr\n";
#PERFORMANCE
endTiming("connect");
#
# raise an exception if any problems occur. Default is to only print error
#
$db->{RaiseError} = 1;
register_metric_call($db);
#-----------------------------
# SQL Parse
#-----------------------------
#PERFORMANCE
startTiming("Parsing SQL");
$unusedSpcCsr = $db->prepare($unusedSpace_sql)
or die "Can't prepare unusedSpace: $DBI::errstr";
$spcUsgCsr = $db->prepare($spaceUsage_sql)
or die "Can't prepare spaceUsage: $DBI::errstr";
if ($db_version >= 10)
{
$spaceCsr = $db->prepare($objectSpace_sql)
or die "Can't prepare objectSpace: $DBI::errstr";
$spaceCsr->{RaiseError} = 1;
$verifyCsr = $db->prepare($verifyShrink_sql)
or die "Can't prepare verifyShrink: $DBI::errstr";
$verifyCsr->{RaiseError} = 1;
}
else
{
$freeBlocksCsr = $db->prepare($freeBlocks_sql)
or die "Can't prepare freeBlocks: $DBI::errstr";
$freeBlocksCsr->{RaiseError} = 1;
}
#PERFORMANCE
endTiming("Parsing SQL");
#
# Raise exceptions from any sql executions
#
$unusedSpcCsr->{RaiseError} = 1;
$spcUsgCsr->{RaiseError} = 1;
#PERF
startTiming('processAll');
#-----------------------------
# Determine if we have enough privs
# die if we don't
#-----------------------------
if ($spaceEnabled eq 'true')
{
getPrivs($db);
# Check if we have enough privs to analyze objects owned
# by SYS
$canAnalyzeSYS = getAnalyzeSYS($db);
}
#
# We can only recommend shrink if the "compatible" parameter
# is > 10.0
#
$compat10i = getCompat();
#print "num schemas " . $#schemas . " num ts " . $#tsnames . "\n";
if ($#tsnames >= 0)
{
printEndData('true');
}
else
{
printEndData('false');
exit 0;
}
#-------------------------------------
# Process all the tablespaces
#-------------------------------------
# Create an IN clause with tablespaces
$inClause = 'IN(';
my $first = 1;
my $tsCount = 0;
my $ts;
foreach $ts (@tsnames)
{
if ($first == 0)
{
$inClause = $inClause . ',' . "'" . $ts . "'";
$tsCount = $tsCount + 1;
}
else
{
$inClause = $inClause . "'" . $ts . "'";
$first = 0;
$tsCount = $tsCount + 1;
}
#
# Process one block of tablespaces at a time.
#
if ($tsCount == $inClauseLimit)
{
$inClause = $inClause . ') ';
#
# Process all segments
#
processAll();
$inClause = 'IN(';
$first = 1;
$tsCount = 0;
}
}
#
# Process all segments
if ($tsCount > 0)
{
$inClause = $inClause . ') ';
processAll();
}
endTiming('processAll');
if ($PERFORMANCE_ON == 1)
{
print("Number of segments with wasted space = $wasteCount\n");
print("Number of segments with row chaining = $rcCount\n");
print("Number of segments analyzed = $segCount\n");
}
EMD_PERL_DEBUG("Number of segments with wasted space = $wasteCount\n");
EMD_PERL_DEBUG("Number of segments with row chaining = $rcCount\n");
EMD_PERL_DEBUG("Number of segments analyzed = $segCount\n");
endTiming("OVERALL");
}
exit 0;
};
#-------
# catch
#-------
if ($@)
{
my $errMsg = "em_error=" . $@ . "\n";
EMD_PERL_ERROR($errMsg);
if (defined $db)
{
$db->disconnect;
}
die $errMsg;
};
#---------------
# DB cleanup
#---------------
# Do we need to close cursors?
# 8/28 - according to xxu, all resources get freed up when our agent-spawned
# process ends, and there is no clean way to free resources before that point
#
#my $ = $dbh->prepare("BEGIN CLOSE :cursor END");
#$sth3->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
#$sth3->execute;
if (defined $db)
{
$db->disconnect;
}
#----------------------
# processAll
#----------------------
#
# Analyze all segments specified in the INclause
#
#
sub processAll()
{
#-----------------------------
# Get all the tablespace info
#-----------------------------
# This resets the inClause to include only valid tablespaces
my $tsCount = getTablespaceInfo();
if ($tsCount == 0)
{
return;
}
#-----------------------------
# Process all row chain
#-----------------------------
if ($rowChainEnabled eq 'true')
{
startTiming('processAllRowChaining');
processAllRowChaining();
endTiming('processAllRowChaining');
}
if ($spaceEnabled eq 'true')
{
#-----------------------------
# Process all tables
#-----------------------------
startTiming('processAllTables');
processAllTables();
endTiming('processAllTables');
#-----------------------------
# Process all IOTs
#-----------------------------
startTiming('processAllIOTs');
processAllIOTs();
endTiming('processAllIOTs');
#-----------------------------
# Process all table partitions
#-----------------------------
startTiming('processAllTabParts');
processAllTabParts();
endTiming('processAllTabParts');
#---------------------------
# Process iot partitions
#---------------------------
#PERFORMANCE
startTiming("processAllIOTParts");
processAllIOTParts();
#PERFORMANCE
endTiming("processAllIOTParts");
#---------------------------
# Process all lobs
#---------------------------
#PERFORMANCE
startTiming("processAllLobs");
processAllLobs();
#PERFORMANCE
endTiming("processAllLobs");
#---------------------------
# Process all lob partitions
#---------------------------
#PERFORMANCE
startTiming("processAllLobParts");
processAllLobParts();
#PERFORMANCE
endTiming("processAllLobParts");
}
}
#----------------------
# analyzeSegmentWaste
#----------------------
#
# Analyze the object for wasted space.
#
# Returns 'true' if the object has wasted space, 'false' if not.
#
sub analyzeSegmentWaste($)
{
my ($tablespace) = @_;
# set up the tablespace info
$isASSM = $tsInfo{$tablespace}->{TSASSM};
$blockSize = $tsInfo{$tablespace}->{TSBLK};
my $status = 'false';
#print "ANALYZING " . getSegDisplayName() . "\n";
#print $tablespace . "=" . $blockSize . "\n";
if ($objErrCount > $maxObjErrors)
{
return $status;
}
$shrinkSegType = 1;
# This may be an IOT overflow segment
if (defined($iotName) && $iotName ne "")
{
# Shrink does not support iot overflow segments
$shrinkSegType = 0;
if ($partName ne "")
{
$segmentType = $SEG_IOT_OF_PART;
}
else
{
$segmentType = $SEG_IOT_OF;
}
}
elsif ($segmentType == $SEG_LOBCOL || $segmentType == $SEG_LOB_PART)
{
# Shrink does not support lob or lob partitions
$shrinkSegType = 0;
}
eval
{
#--
#-- Get bytes allocated to the table
#-- Sets bytesUnderHWM, segTotalBytes, and bytesAllocated
#-- For oldOMS (< 10.2), bytesAllocated is under HWM
#-- otherwise bytesAllocated is size of entire segment
#--
#PERFORMANCE
startTiming("unusedSpace");
$bytesAllocated = getBytesAllocated();
#PERFORMANCE
endTiming("unusedSpace");
#print getSegDisplayName() . " bytes $bytesAllocated init $initExtent\n";
#
# If there are less bytes than the minimum requested,
# don't do the check.
#
if ($bytesAllocated < $minWasteBytes)
{
#EMD_PERL_DEBUG("$segTypeStr $objectName too small under HWM - "
# . "$bytesAllocated < $minWasteBytes\n");
return $status;
}
#
# If the segment only has one extent, don't make a recommendation.
#
if ($bytesAllocated <= $initExtent)
{
#print $segTypeStr . " " . $objectName . " " . $bytesAllocated
# . " < " . $initExtent . "\n";
return $status;
}
#--
#-- dbms_space.object_space_usage only available in 10i
#--
if ($db_version >= 10)
{
#PERFORMANCE
startTiming("objSpcUsage");
$status = objSpaceUsage();
#PERFORMANCE
endTiming("objSpcUsage");
}
#--
#-- 9i assm can be checked by dbms_space.space_usage
#--
elsif ($isASSM == 1)
{
#PERFORMANCE
startTiming("spcUsage");
$status = spaceUsage();
#PERFORMANCE
endTiming("spcUsage");
}
#--
#-- 9i mssm lobs can be checked by dbms_space.free_blocks
#--
elsif ($segmentType == $SEG_LOBCOL)
{
startTiming("freeBlocks");
freeBlocks();
endTiming("freeBlocks");
}
#--
#-- else estimate using available statistics
#---
elsif ($avgRowLen != 0 && $numRows > 0)
{
startTiming("estimate");
# print "going to estimate\n";
$status = estimateWastedSpace();
#avgSpace();
endTiming("estimate");
}
};
#-------
# catch
#-------
if ($@)
{
handleObjErr($@);
};
return $status;
}
#--------------------
# estimateWastedSpace
#--------------------
#
# Estimate the amount of space needed to hold the data in a table.
# From there we can estimate the amount of space wasted.
# Algorithm from gajav and groyal.
#
# Returns - % wasted space
# Prints em_result output for space over minValue.
#
# Sets parent scope output values
# wastedSpacePct -- % space wasted below HWM
#
# Uses parent scope input values
# minValue - minimum wasted space % to return result for table
# blockSize - tablespace block size
# owner - object owner
# objectName - object name
# objectType - type of object that segment belongs to
# partName - partition name
# pctFree
# initrans
# numRows
# blocks - number of blocks allocated to object
# avgRowLen
#
#
sub estimateWastedSpace
{
my $status = 'false';
eval
{
# If we are talking to a new OMS, use the total segment size
# rather than the blocks below HWM.
if ($oldOMS == 0)
{
$blocks = $segTotalBytes / $blockSize;
}
#--
#-- Can't do anything if row length unknown.
#--
# print ("avgRowLen " . $avgRowLen . "\n");
if ($avgRowLen == 0)
{
return 0;
}
#--
#-- Estimate how much space is needed to store the object
#-- and compare with allocated space to determine wasted space
#--
#-- block header bytes is calculated as
#-- kcbh + ub4 + ktbbh + (initrans - 1) * ktbit + kdbh
#-- where kcbh (20), ub4 (4), ktbbh (48), ktbit (24)
#-- and kdbh (14) come from v$type_size
#-- blockHeaderInBytes = 86 + (initrans * 24).
#--
my $blockHeaderInBytes = 86 + ($initrans * 24);
#--
#-- Use PCTFREE to calculate the space in a block that can
#-- be used to insert new rows.
#--
my $spaceInBlock = floor(($blockSize - $blockHeaderInBytes)
* (1.0 - ($pctFree/100.0)));
# printf ("blocksize %f blockheader \n", $blockSize, $blockHeaderInBytes);
# printf ("space in block %f\n", $spaceInBlock);
#--
#-- Calculate the number of rows that will fit in a block
#-- and the blocks needed to fit all the rows.
#--
my $numRowsPerBlock = floor($spaceInBlock/$avgRowLen);
# printf ("num rows per block %f\n", $numRowsPerBlock);
if ($numRowsPerBlock < 1)
{
$numRowsPerBlock = 1;
}
my $blocksNeeded = ceil($numRows/$numRowsPerBlock);
# printf("numrows %f\n", $numRows);
# printf("blocks %f\n", $blocks);
# printf("blocks needed %f\n", $blocksNeeded);
#--
#-- Compare to allocated blocks to get potential waste
#--
$wastedSpacePct = (($blocks - $blocksNeeded)/($blocks*1.0)) * 100.0;
# printf("gaylen wasted space %f\n", $wastedSpacePct);
if ($wastedSpacePct > $wasteMinValue)
{
#print "Gaylen ";
printWasteOutput();
$status = 'true';
}
};
#-------
# catch
#-------
if ($@)
{
handleObjErr($@);
};
return $status;
}
#----------------
# objSpaceUsage
#----------------
#
# Get object space usage information using dbms_space.object_space_usage.
#
# Uses parent scope input values
# spaceCsr - cursor for space_usage call
# wasteMinValue - minimum wasted space % to return result for table
# owner - object owner
# objectName - object name
# segTypeStr - table, table partition, or table subpartition
# partName - partition name
# blocks - number of blocks allocated to object
#
# Sets parent scope output values
# wastedSpacePct -- % space wasted below HWM
#
# Returns 'true' if the object has wasted space, 'false' if not.
#
sub objSpaceUsage
{
my $spaceUsed;
my $outAlloc;
my $status = 'false';
eval
{
#print "object=" . $owner . $objectName . " type=" . $objectType;
bindSegmentInfo($spaceCsr);
$spaceCsr->bind_param_inout(":used", \$spaceUsed, 25);
$spaceCsr->bind_param_inout(":allocated", \$outAlloc, 25);
$spaceCsr->execute;
#print ($objectName . " alloc=" . $outAlloc . " spaceused="
# . $spaceUsed . "index=" . $segName . "\n");
#---------------
# Print results
#---------------
#
#print "spaceused - $spaceUsed allocated = $bytesAllocated\n";
if ($bytesAllocated != 0 && $spaceUsed != 0)
{
$wastedSpacePct = (1.0 - $spaceUsed/$bytesAllocated) * 100;
#print "objspc % " . $wastedSpacePct . "\n";
if ($wastedSpacePct > $wasteMinValue)
{
#print "ObjSpc ";
printWasteOutput();
$status = 'true';
}
}
};
#-------
# catch
#-------
if ($@)
{
handleObjErr($@);
};
return $status;
}
#-------------------
# printWasteOutput
#-------------------
#
# We have found an object that needs to be added to the output.
# Print a row of data for the current object.
#
# Uses parent scope values for
# owner - object owner
# objectName - object name
# objectType - table, table partition, or table subpartition
# partName
# tablespace
# bytesAllocated
# wastedSpacePct
# segmentType - segment type code, e.g. SEG_TABLE
#
# Format of output row is | delimited string
# NOTE: This must match code in UI
# oracle.sysman.emo.util.stgAdv.*
#
# displayName|segmentType|tablespace|problemType(always 1)|
# . recommendation|supporting parameters
#
# displayName is a ; separated concatenation of
# object type;schema;object name;partition name;lob column
# segmentType is a code - see segment type codes above
# tablespace is a tablespace name
# problem type = 1 for wasted space
# recommendation = 1 for shrink
# 2 for reorig
# 3 for shrink or reorg
#
# The supporting parameters are a ; separated list of values supporting
# the recommendation. They consist of the following:
# %wastedSpace below HWM; (valid if old oms)
# MB unused below HWM; (valid if old oms)
# MB allocated below HWM; (valid if old oms)
# %wastedSpace in segment; (valid if new oms)
# MB unused space in segment; (valid if new oms)
# MB allocated to segment; (valid if new oms)
# MB reclaimable space in segment (valid if new oms)
#
# Old OMS's display the wasted space below the HWM. Newer OMS's display the
# total wasted space in the segment, including the unused blocks above the
# HWM. We will only calculate one set of values and leave the others at 0,
# depending on the OMS we're talking to.
#
sub printWasteOutput()
{
#
# Behave like the server. If the wastedSpacePct < 1, don't return
# a result.
#
if ($wastedSpacePct < 1.0)
{
return;
}
my $wastedBytes = $bytesAllocated * $wastedSpacePct/100.0;
my $shrinkable = verifyShrink($wastedBytes);
if ($shrinkable == 0)
{
return;
}
#PERFORMANCE
$wasteCount = $wasteCount + 1;
# my $package;
# my $filename;
# my $line;
# ($package,$filename,$line) = caller;
# print "LINE " . $line . "\n";
my $recommendation = 0; #-- Recommendations for fixing problem
#-- bitwise OR of S_SHRINK and S_REORG
#
# Figure out what we should recommend to fix the problem.
#
if ($isASSM && $db_version >= 10 && $shrinkSegType == 1
&& $compat10i == 1)
{
$recommendation = $S_SHRINK;
}
$recommendation = $recommendation + $S_REORG;
#
# Calculate MB unused and MB allocated
#
my $mbAlloc = $bytesAllocated / 1048576.0;
my $mbUnused = $wastedBytes / 1048576.0;
#
# For old OMS's, the values are below HWM
# For new OMS's, the values are over the entire segment
# old OMS's use the first 3 values,
# new OMS's use the last 4 values.
#
my $supportVals;
$supportVals = sprintf("%d;%.2f;%.2f;%d;%.2f;%.2f;%.2f",
$wastedSpacePct, $mbUnused, $mbAlloc,
$wastedSpacePct, $mbUnused, $mbAlloc, $mbUnused);
my $displayName = getSegDisplayName();
#--
my $result = "em_result=$displayName|$segmentType|$tablespace|"
. $WASTED_SPACE
. "|" . $recommendation
. "|" . $supportVals . "\n";
EMD_PERL_DEBUG("wastedSpace - $result");
print $result;
}
#----------------------
# analyzeRowChaining
#----------------------
#
# Analyze the object for row chaining
#
# Input: tablespace
#
sub analyzeRowChaining($)
{
my ($tablespace) = @_;
if ($objErrCount > $maxObjErrors)
{
return;
}
# punt if we don't have statistics
if ((defined($numRows) && $numRows == 0 ) || $chainCnt == 0)
{
return;
}
# print $objectName . " chaincnt " . $chainCnt . "/" . $numRows . "\n";
my $rowChainPct = floor(($chainCnt/$numRows)*100);
# print " % " . $rowChainPct . "\n";
if ($rowChainPct >= $rcMinValue)
{
printRowChainOutput($rowChainPct)
}
}
#----------------------
# printRowChainOutput
#----------------------
#
# We have found an object that needs to be added to the output.
# Print a row of data for the current object.
#
# Input
# rowChainPct
#
# Uses parent scope values for
# owner - object owner
# objectType - table, table partition, or table subpartition
# partName
# tablespace
# chainCnt
# numRows
# segmentType - segment type code, e.g. SEG_TABLE
#
# Format of output row is | delimited string
# NOTE: This must match code in UI
# oracle.sysman.emo.util.stgAdv.*
#
# displayName|segmentType|tablespace|problemType(always 1)|
# . recommendation|%wastedSpace;MB unused;MB allocated
#
# display name is a ; separated concatenation of
# object type;schema;object name;partition name;lob column
# segmentType is a code - see segment type codes above
# tablespace is a tablespace name
# problem type = 2 for row chaining
# recommendation = 2 for reorig
# last value is a ; separated list of supporting data to display in
# the problem description - %row chained;#chained rows;#total rows
#
sub printRowChainOutput()
{
#PERFORMANCE
$rcCount = $rcCount + 1;
my ($rcPct) = @_;
my $recommendation = 0; #-- Recommendations for fixing problem
#-- bitwise OR of S_SHRINK and S_REORG
#
# We will always recommend reorg since nothing else fixes row chaining
#
$recommendation = $S_REORG;
#
# Supporting data is row chain%, # rows chained, #rows
#
my $supportVals = $rcPct . ";" . $chainCnt . ";" . $numRows;
my $displayName = getSegDisplayName();
#--
#-- The 1 after segment type is the problem code for wasted space.
my $result = "em_result=$displayName|$segmentType|$tablespace|"
. $ROW_CHAINING
. "|" . $recommendation
. "|" . $supportVals . "\n";
EMD_PERL_DEBUG("rowChain - $result");
print $result;
}
#----------------------
# getBytesAllocated
#----------------------
#
# Set the number of bytes under the high water mark, and total bytes
# allocated to the segment.
# If we are talking to an old OMS,
# return bytes under HWM
# else
# return total segment bytes
#
# Uses parent scope values for
# owner - object owner
# objectType - table, table partition, or table subpartition
# partName
# tablespace
# chainCnt
# numRows
#
# Sets
# bytesUnderHWM
# segTotalBytes
#
# NOTE: Do NOT use seg$.blocks. It does not always contain the size of
# the segment.
#
sub getBytesAllocated()
{
my $totalBlocks = 0;
my $totalBytes = 0;
my $unusedBlocks = 0;
my $unusedBytes = 0;
my $lastFileID;
my $lastBlockID;
my $lastUsedBlock;
eval
{
# print ("unused space: " . $owner . "." . "objName=<"
# . $objectName . "> segName=<" . $segName
# . "> partName=<" . $partName .
# "> type=" . $segTypeStr . "\n");
bindSegmentInfo($unusedSpcCsr);
$unusedSpcCsr->bind_param_inout(":totalBlocks", \$totalBlocks, 25);
$unusedSpcCsr->bind_param_inout(":totalBytes", \$totalBytes, 25);
$unusedSpcCsr->bind_param_inout(":unusedBlocks", \$unusedBlocks, 25);
$unusedSpcCsr->bind_param_inout(":unusedBytes", \$unusedBytes, 25);
$unusedSpcCsr->bind_param_inout(":lastFileID", \$lastFileID, 25);
$unusedSpcCsr->bind_param_inout(":lastBlockID", \$lastBlockID, 25);
$unusedSpcCsr->bind_param_inout(":lastBlock", \$lastUsedBlock, 25);
$unusedSpcCsr->execute;
# print ($objectName . " " . ($totalBytes - $unusedBytes) . " " . " totalBytes=" . $totalBytes
# . " unusedBytes=" . $unusedBytes
# . " lastBlock " . $lastUsedBlock . "\n\n\n");
};
#-------
# catch
#-------
if ($@)
{
handleObjErr($@);
};
#
# #bytes underHWM = total bytes allocated to table
# - unformatted bytes (above HWM)
# - 1 block for overhead (segment map)
#
$bytesUnderHWM = $totalBytes - $unusedBytes - $blockSize;
$segTotalBytes = $totalBytes;
#print("segTotal=$segTotalBytes underHWM=$bytesUnderHWM unused=$unusedBytes\n");
if ($oldOMS == 1)
{
return $bytesUnderHWM;
}
else
{
return $segTotalBytes;
}
}
#-------------
# spaceUsage
#-------------
#
# For ASSM tablespaces in 9i databases, use dbms_space.space_usage
# to estimate the amount of unused space.
#
# Parent scope input:
# $owner
# $objectName
# $segTypeStr
#
# Returns 'true' if the object has wasted space, 'false' if not.
#
sub spaceUsage()
{
my $status = 'false';
my $ubl;
my $uby;
my $fs1bl;
my $fs1by;
my $fs2bl;
my $fs2by;
my $fs3bl;
my $fs3by;
my $fs4bl;
my $fs4by;
my $flbl;
my $flby;
my $usedSpace;
eval
{
#print "spaceUsage - object=" . $owner . "." . $objectName
# . " segname=" . $segName . " type=" . $objectType . "\n";
bindSegmentInfo($spcUsgCsr);
$spcUsgCsr->bind_param_inout(":ubl", \$ubl, 25);
$spcUsgCsr->bind_param_inout(":uby", \$uby, 25);
$spcUsgCsr->bind_param_inout(":fs1bl", \$fs1bl, 25);
$spcUsgCsr->bind_param_inout(":fs1by", \$fs1by, 25);
$spcUsgCsr->bind_param_inout(":fs2bl", \$fs2bl, 25);
$spcUsgCsr->bind_param_inout(":fs2by", \$fs2by, 25);
$spcUsgCsr->bind_param_inout(":fs3bl", \$fs3bl, 25);
$spcUsgCsr->bind_param_inout(":fs3by", \$fs3by, 25);
$spcUsgCsr->bind_param_inout(":fs4bl", \$fs4bl, 25);
$spcUsgCsr->bind_param_inout(":fs4by", \$fs4by, 25);
$spcUsgCsr->bind_param_inout(":flbl", \$flbl, 25);
$spcUsgCsr->bind_param_inout(":flby", \$flby, 25);
$spcUsgCsr->execute;
# The values returned in fs<x>by values represent a range.
# fs1by = # of bytes with 0-25% free space,
# fs2by = 25-50% free space, etc. We will take the lower end of
# the range to avoid giving spurious reorg recommendations.
# print ("1 - " . $fs1by . "\n");
# print ("2 - " . $fs2by . "\n");
# print ("3 - " . $fs3by . "\n");
# print ("4 - " . $fs4by . "\n");
# print ("full - " . $flby . "\n");
# print ("allocated - " . $bytesAllocated . "\n");
# For IOT segments and lob segments, only use full bytes
# - Bug #3202112
# Note that iot segments are handled differently and their
# segment type codes are for TABLE rather than INDEX. We need
# to know if it's an index segment, so compare the segment type
# string.
if (($segTypeStr eq 'INDEX')
|| ($segTypeStr eq 'INDEX PARTITION')
|| ($segmentType == $SEG_LOBCOL)
|| ($segmentType == $SEG_LOB_PART))
{
$usedSpace = $flby;
}
else
{
$usedSpace = $fs1by + $fs2by * .75 + $fs3by * .50 +
$fs4by * .25 + $flby;
}
#print ($objectName . " alloc=" . $bytesAllocated . " spaceused="
# . $usedSpace . "\n");
#---------------
# Print results
#---------------
if ($bytesAllocated != 0)
{
$wastedSpacePct =
($bytesAllocated-$usedSpace)/$bytesAllocated * 100;
#print ("wasted space pct " . $wastedSpacePct . "\n");
if ($wastedSpacePct > $wasteMinValue)
{
#print "spcUsage ";
printWasteOutput();
$status = 'true';
}
}
};
#-------
# catch
#-------
if ($@)
{
handleObjErr($@);
};
return $status;
}
#----------------------
# freeBlocks
#----------------------
#
# Get wasted space information using dbms_space.free_blocks.
# Use only for < 10i MSSM lob segments
#
# Uses parent scope input values
# freeBlocksCsr - cursor for free_blocks call
# wasteMinValue - minimum wasted space % to return result for table
# owner - object owner
# segName - lob segment name
# segTypeStr - table, table partition, or table subpartition
# partName - partition name
#
# Sets parent scope output values
# wastedSpacePct -- % space wasted below HWM
#
# Returns 'true' if the object has wasted space, 'false' if not.
#
sub freeBlocks()
{
my $freeBlocks;
my $allFreeBlocks = 0;
my $status = 'false';
my $i;
eval
{
#
# If we are talking to a new OMS, we also need the space above
# the HWM to be reported as unused space.
#
if ($oldOMS == 0)
{
$allFreeBlocks = ($segTotalBytes - $bytesUnderHWM) / $blockSize;
}
#print "object=$owner.$objectName type=$objectType\n";
# seg$.groups can return 0
if ($groups == 0)
{
$groups = 1;
}
for ($i = 0; $i < $groups; $i++)
{
$freeBlocksCsr->bind_param(":owner", $owner);
$freeBlocksCsr->bind_param(":segName", $segName);
$freeBlocksCsr->bind_param(":segType", $segTypeStr);
$freeBlocksCsr->bind_param(":freelist_group", $i);
$freeBlocksCsr->bind_param_inout(
":free_blocks", \$freeBlocks, 25);
#print "$i freeBlocks $freeBlocks $allFreeBlocks\n";
$freeBlocksCsr->execute;
$allFreeBlocks = $allFreeBlocks + $freeBlocks;
}
#---------------
# Print results
#---------------
$wastedSpacePct = $allFreeBlocks*$blockSize/$bytesAllocated * 100;
if ($wastedSpacePct > $wasteMinValue)
{
#print "freeBlocks $allFreeBlocks allocated $bytesAllocated\n";
printWasteOutput();
$status = 'true';
}
};
#-------
# catch
#-------
if ($@)
{
handleObjErr($@);
};
return $status;
}
#----------------
# handleObjErr
#----------------
#
# Print an exception to the log and the agent output
#
# Input: exception
#
sub handleObjErr()
{
my ($exc) = @_;
#
# If we had lots of segment errors, don't report them all
#
$objErrCount = $objErrCount + 1;
# print STDERR $objErrCount . " " . $maxObjErrors . "\n" ;
if ($objErrCount == $maxObjErrors)
{
my $errStr = "em_error=Error limit exceeded\n";
print STDERR $errStr;
EMD_PERL_ERROR($errStr);
return;
}
elsif ($objErrCount < $maxObjErrors)
{
#
# SQL exceptions may have newlines. Get rid of them so the agent
# isn't confused.
#
$exc =~ s/\n/ /g;
my $errName = getSegDisplayName();
my $errMsg = "em_error=" . $segTypeStr . ": <" . $errName
. "> " . $exc . "\n";
print STDERR $errMsg;
EMD_PERL_ERROR($errMsg);
}
}
#----------------
# printEndData
#----------------
#
# Print a result line so old data will be purged. This fixes a problem
# where no data is generated by a sample and the purge trigger never fires.
#
# Input: checksEnabled 'true' if any checks are being done, 'false' otherwise
#
# Format of output row is | delimited string
# NOTE: This must match code in UI
# oracle.sysman.emo.util.stgAdv.*
#
# displayName|segmentType|tablespace|problemType(always 1)|
# . recommendation|data
#
# For this end of sample string we will set the
# displayName to "wastedSpaceEOF"
# and the data to checksEnabled
#
sub printEndData($)
{
my ($checksEnabled) = @_;
my $res = "em_result=wastedSpaceEOF|0|0|0|0|" . $checksEnabled . "\n";
EMD_PERL_DEBUG($res);
print $res;
}
#--------------------
# getSegDisplayName
#--------------------
#
# Form the display name for output.
#
# The display name is a "." separated concatenation of
#
# object type
# .schema
# .object name
# .partition name
# .iot overflow name
# .lob column
# .index name
# .lob partition name
#
# NOTE: This must match code in UI
# oracle.sysman.emo.util.stgAdv.DBObject
#
sub getSegDisplayName()
{
my $name;
#
# If the object is an IOT overflow segment, we can't reorganize it
# independent of the parent table. For the display name, use the
# table name instead of the overflow name.
#
# If the segment is an iot partition segment, we have to reorganize
# and shrink the table partition segment rather than the index partition
# segment, so send the table instead of the index as the object.
#
if (defined($iotName) && $iotName ne "")
{
$name = $iotName;
}
else
{
$name = $objectName;
}
$name = $objectType . "." . $owner . "." . $name;
#
# Add partition name
#
$name = $name . ".";
if ($partName ne "")
{
$name = $name . $partName;
}
#
# Append the segment name
# For IOT partitions, we don't want the segment name to show up
# since reorg and shrink want the table name, not the index name.
# The dbms_space functions in 9i can't handle the table name.
#
$name = $name . ".";
if ($segName ne "" && $segTypeStr ne 'INDEX PARTITION')
{
$name = $name . $segName;
}
#
# If lob, append the lob column name
#
$name = $name . ".";
if ($lobCol ne "")
{
$name = $name . $lobCol;
}
#
# Add lob partition name in segPartName.
#
$name = $name . ".";
if ($segPartName ne "")
{
$name = $name . $segPartName;
}
return $name;
}
#--------------------
# getCompat
#--------------------
#
# If this is a 10i db, determine whether shrink is applicable.
# Has to have compatible = 10.0.0.0 or higher.
#
# return 1 if compatible with 10i, 0 otherwise.
#
sub getCompat()
{
#------------------------------------
# Query to get db compatible param
#------------------------------------
#
# Shrink is only applicable to 10i databases with compatible
# set to 10.0.0.0
#
my $getCompatible_sql =
"SELECT value FROM v\$parameter WHERE name = 'compatible'";
my $compatible = 0;
if ($db_version >= 10)
{
my $compatCsr = $db->prepare($getCompatible_sql)
or die "Can't prepare getCompatible: $DBI::errstr";
$compatCsr->{RaiseError} = 1;
$compatCsr->execute;
my $compatValue = 9;
my @compatRow;
if (@compatRow = $compatCsr->fetchrow_array)
{
$compatValue = $compatRow[0];
($compatValue) = split(/\./, $compatValue);
if ($compatValue >= 10)
{
$compatible = 1;
}
}
}
return $compatible;
}
#--------------------
# getPrivs
#--------------------
#
# Determine if our user has enough privs to do the checks. Exit if not.
#
# input - dbhandle
#
sub getPrivs($)
{
my ($dbHandle) = @_;
#------------------------------------
# Query to determine session privs
#------------------------------------
#
# We need ANALYZE ANY priv to do the check.
#
my $getPrivs_sql =
"SELECT 1 FROM session_privs WHERE privilege = 'ANALYZE ANY'";
my $privCsr = $dbHandle->prepare($getPrivs_sql)
or die "Can't get session privileges: $DBI::errstr";
$privCsr->{RaiseError} = 1;
$privCsr->execute;
my $hasPrivs = 0;
my @privRow;
if (@privRow = $privCsr->fetchrow_array)
{
$hasPrivs = 1;
}
if ($hasPrivs == 0)
{
my $errMsg = "User " . $username
. " does not have the required privileges. "
. "Enable the OEM_MONITOR role.\n";
die $errMsg;
}
}
#--------------------
# getAnalyzeSYS
#--------------------
#
# Return 1 if we are able to analyze objects owned by SYS, 0 if not.
# We need the 'analyze any dictionary' in order to do the check.
#
# input - dbhandle
# return - 1 if we have analyze any dictionary, 0 otherwise
#
sub getAnalyzeSYS($)
{
my ($dbHandle) = @_;
#
# analyze any dictionary only exists in 10i.
#
if ($db_version < 10)
{
return 0;
}
#
# We need ANALYZE ANY DICTIONARY priv to do the check.
#
my $getPrivs_sql =
"SELECT 1 FROM session_privs WHERE privilege = 'ANALYZE ANY DICTIONARY'";
my $privCsr = $dbHandle->prepare($getPrivs_sql)
or die "Can't get session privileges: $DBI::errstr";
$privCsr->{RaiseError} = 1;
$privCsr->execute;
my $hasPrivs = 0;
my @privRow;
if (@privRow = $privCsr->fetchrow_array)
{
$hasPrivs = 1;
}
return $hasPrivs;
}
#-------------
# printTime
#-------------
# Print the current time to stdout
#
#
sub printTime()
{
my $sec; # second
my $min; # minute
my $hour; # hour
my $mday; # day of month
my $mon; # month 0-11 jan=0
my $year; # year since 1900
my $wday; # day of the week 0=Sunday
my $yday; # day of the year
my $isdst; # true if daylight savings
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
print "time: " . $hour . ":" . $min . ":" . $sec . "\n";
}
#-------------
# clearSegment
#-------------
#
# Clear the segment data
#
sub clearSegment()
{
$owner = "";
$objectName = "";
$objectType = "";
$segmentType = "";
$segTypeStr = "";
$segName = "";
$segPartName = "";
$partName = "";
$iotName = "";
$lobCol = "";
$pctFree = 0;
$initrans = 0;
$numRows = 0;
$blocks = 0;
$avgRowLen = 0;
$bytesAllocated = 0;
$wastedSpacePct = 0;
$chainCnt = 0;
$shrinkSegType = 1;
$initExtent = 0;
$groups = 1;
$segTotalBytes = 0;
$nextExtent = 0;
$pctIncrease = 0;
}
#-------------
# startTiming
#-------------
#
# Start timer - Prints the start time and starts timing a function, keyed
# by the description text.
#
# The list of timers is keyed by the description text, one timer
# per description.
#
# Input
# desc Text describing function being timed
# Used as hash key for list of timer.
#
my %timers;
sub startTiming($)
{
if ($PERFORMANCE_ON == 0)
{
return;
}
my ($desc) = @_;
print $desc . " START ";
printTime();
$timers{$desc} = time();
}
#-------------
# endTiming
#-------------
#
# End timer - Prints the current time and the elapsed time since
# startTiming was called. Description text is used as
# a key to find the appropriate timer in the list of timers.
#
# Input
# desc Text describing function being timed
# Used as hash key for timer
#
sub endTiming($)
{
if ($PERFORMANCE_ON == 0)
{
return;
}
my ($desc) = @_;
my $elapsedTime = time() - $timers{$desc};
print $desc . " END : ELAPSED = " . $elapsedTime . " ";
printTime();
}
#------------------------
# getTablespaceInfo
#------------------------
#
# Populate the tsInfo hash
# Hash key is tablespace name
# Also form the inASSMClause
# Resets the inClause to include only valid tablespaces
#
# Returns number of valid tablespaces
#
sub getTablespaceInfo()
{
#------------------------------------
# Query to get tablespace info
#------------------------------------
#-- Returns 0 - ts#
# 1 - tablespace name
#-- 2 - extent_management (DICTIONARY or LOCAL)
#-- 3 - segment_space_management (AUTO or MANUAL)
#-- 4 - block size
my $getTablespaces_sql =
"SELECT ts#, " # -- from dba_tablespaces
. "ts.name, "
. "DECODE(ts.bitmapped, 0, 'DICTIONARY', 'LOCAL'), "
. "DECODE(bitand(ts.flags,32), 32,'AUTO', 'MANUAL'), "
. "blocksize "
. "FROM sys.ts\$ ts "
. "WHERE ts.name " . $inClause
. "AND ts.contents\$ = 0 " # -- Must be PERMANENT tablespace
. "AND BITAND(ts.flags, 16) != 16 " # -- not UNDO tablespace
. "AND ts.online\$ = 1"; # -- Must be ONLINE
if ($PERFORMANCE_ON == 1)
{
print ($getTablespaces_sql . "\n");
}
my $getTSCsr = $db->prepare($getTablespaces_sql)
or die "Can't prepare getTablespaceInfo: $DBI::errstr";
$getTSCsr->{RaiseError} = 1;
$getTSCsr->execute;
my @tsRow;
$hasASSM = 0;
$inASSMClause = '';
while (@tsRow = $getTSCsr->fetchrow_array)
{
my $tsName = $tsRow[1];
# populate hash table, key is tablespace name
my $isASSM = 0;
if ($tsRow[2] eq 'LOCAL'
&& $tsRow[3] eq 'AUTO')
{
$isASSM = 1;
if ($hasASSM == 0)
{
$hasASSM = 1;
$inASSMClause = "IN('$tsName'";
}
else
{
$inASSMClause = "$inASSMClause,'$tsName'";
}
}
my $tsRec = { TSNUM => $tsRow[0],
TSASSM => $isASSM,
TSBLK => $tsRow[4],
};
$tsInfo{$tsName} = $tsRec;
#print ("TABLESPACE $tsRow[1] assm=" . $tsInfo{$tsRow[1]}->{TSASSM}
# . " blocks=" . $tsRow[4] . "\n");
}
if ($hasASSM)
{
$inASSMClause = "$inASSMClause) "
}
#
# If a specified tablespace is not valid, log a warning
# Form a new inClause with only valid tablespaces
#
my $ts;
$inClause = 'IN(';
my $first = 1;
my $tsCount = 0;
foreach $ts (@tsnames)
{
my $valid = $tsInfo{$ts};
if ($valid == '')
{
EMD_PERL_WARN ("Segment Findings - $ts not checked. Valid tablespace must be permanent, online, read/write, and not an UNDO tablespace\n");
}
elsif ($first == 0)
{
$inClause = $inClause . ',' . "'" . $ts . "'";
$tsCount = $tsCount + 1;
}
else
{
$inClause = $inClause . "'" . $ts . "'";
$first = 0;
$tsCount = $tsCount + 1;
}
}
$inClause = $inClause . ') ';
EMD_PERL_DEBUG ("$inClause\n");
return $tsCount;
}
#-----------------------------
# processAllTables
#-----------------------------
sub processAllTables()
{
startTiming("allTablesSql");
#--
#-- Get the tables in the tablespaces
#--
#-- Returns 0 - owner
#-- 1 - table_name
#-- 2 - tablespace_name
#-- 3 - pctFree
#-- 4 - iniTrans
#-- 5 - numRows
#-- 6 - blocks
#-- 7 - avg_row_len
#-- 8 - iot_name
#-- 9 - initial_extent
#-- 10 - current next extent size
#-- 11 - pctIncrease
#--
my $getTables_sql =
# Select owner, table_name, tablespace_name, pct_free,
# ini_trans, num_rows, blocks, avg_row_len, iot_name
# initial_extent
# for all table segments in a list of tablespaces
# Table not in cluster, not nested, not temporary, not iot,
# not in recycle bin, not typed table, not external table,
# not partitioned
# If not applicable, ignore tables owned by SYS
#
"SELECT /*+ USE_NL (t) USE_NL (s) */ "
. "u.name owner, "
. "o.name table_name, "
. "ts.name tablespace_name, "
. "DECODE(BITAND(t.property, 32 + 64), 0, MOD(t.pctfree\$, 100), 64, 0) pct_free, "
. "DECODE(BITAND(t.property, 32), 0, t.initrans, 0) ini_trans, "
. "t.rowcnt num_rows, "
. "DECODE(BITAND(t.property, 64), 0, t.blkcnt, 0) blocks, "
. "NVL(t.avgrln, 0) avg_row_len, "
. "DECODE(BITAND(t.property, 512) + BITAND(t.flags, 536870912), "
. "0, '', co.name) iot_name, "
. "s.iniexts * ts.blocksize initial_extent, "
. "s.extsize * ts.blocksize, "
. "s.extpct "
. "FROM sys.ts\$ ts, sys.tab\$ t, sys.user\$ u, sys.obj\$ o, sys.obj\$ co, "
. "sys.seg\$ s "
. "WHERE ts.name " . $inClause
. "AND t.ts# = ts.ts# "
. "AND BITAND(t.property, 4194400) = 0 " # -- Not IOT, partitioned, or temp
. "AND BITAND(t.property, 2147483648) = 0 " # -- Not external
. "AND BITAND(t.property, 1024) = 0 " # -- not in cluster
. "AND BITAND(t.property, 8388608) = 0 " # -- not session temp
. "AND BITAND(t.property, 131072) = 0 " # -- not AQ table
. "AND DECODE(BITAND(t.property, 8192), 8192, 1, DECODE(BITAND(t.property, 1), "
. "0, 0, 1)) = 0 " # -- not nested, typed table
. "AND o.owner# = u.user# "
. "AND s.user# = o.owner# "
. "AND s.user# = u.user# "
. "AND t.ts# = s.ts# "
. "AND t.file# = s.file# "
. "AND t.block# = s.block# "
. "AND o.obj# = t.obj# "
. "AND t.bobj# = co.obj#(+) ";
if ($canAnalyzeSYS == 0)
{
$getTables_sql = $getTables_sql
. "and u.name != 'SYS' ";
}
$getTables_sql = $getTables_sql
. "AND BITAND(o.flags, 128) = 0 " # -- not dropped
. "AND BITAND(s.spare1, 65536) = 0 "; # -- IOT OF not dropped
my @fetch_row;
if ($PERFORMANCE_ON == 1)
{
print ($getTables_sql . "\n");
}
my $getTablesCsr = $db->prepare($getTables_sql)
or die "Can't prepare getTables: $DBI::errstr";
$getTablesCsr->{RaiseError} = 1;
$getTablesCsr->execute;
endTiming("allTablesSql");
#---------------------------
# Loop over all tables
#---------------------------
$objectType = 'TABLE';
$segTypeStr = 'TABLE';
$partName = "";
my $tabStart = $segCount;
while (@fetch_row = $getTablesCsr->fetchrow_array)
{
#PERF
$segCount++;
$segmentType = $SEG_TABLE;
my $status;
#----------------------------
# Get data for one table
#----------------------------
$owner = $fetch_row[0];
$objectName = $fetch_row[1];
$tablespace = $fetch_row[2];
$pctFree = $fetch_row[3];
$initrans = $fetch_row[4];
$numRows = $fetch_row[5];
$blocks = $fetch_row[6];
$avgRowLen = $fetch_row[7];
$iotName = $fetch_row[8];
$initExtent = $fetch_row[9];
$nextExtent = $fetch_row[10];
$pctIncrease = $fetch_row[11];
#EMD_PERL_DEBUG ("StgPerf analyzing object $owner $objectName $objectType\n");
#print STDERR ("StgPerf analyzing table $owner $objectName $tablespace\n");
#print "$owner $objectName $tablespace $pctFree $initrans $numRows \n";
#print "$blocks $avgRowLen \n";
#--------------------------
# Check for wasted space
#--------------------------
if ($spaceEnabled eq 'true' )
{
analyzeSegmentWaste($tablespace);
}
$iotName = "";
} # loop over all tables
if ($PERFORMANCE_ON == 1)
{
print "TABLE COUNT " . ($segCount - $tabStart) . "\n";
}
clearSegment();
}
#----------------------
# processAllIOTs
#----------------------
#
# Check IOTs for problems
#
sub processAllIOTs()
{
# We don't try to estimate wasted space for IOTs
if ($hasASSM == 0 && $db_version < 10)
{
return;
}
#--
#-- Query to get the IOT's
#--
#-- Returns 0 - owner
#-- 1 - table_name
#-- 2 - index_name
#-- 3 - tablespace_name
#-- 4 - initial_extent
#-- 5 - current next extent size
#-- 6 - pctIncrease
#--
my $getIOTs_sql =
# Select owner, table_name, index_name,
# tablespace_name, initial_extent
# for all iot segments in a list of tablespaces
# Table not in cluster, not nested, not temporary
# not in recycle bin, not typed table, not external table
# not partitioned
# If not applicable, ignore tables owned by SYS
#
"SELECT /*+ ORDERED INDEX (o i_obj1) INDEX (io i_obj1) */ "
. "u.name owner, io.name table_name, o.name index_name, ts.name "
. "tablespace_name, s.iniexts * ts.blocksize initial_extent, "
. "s.extsize * ts.blocksize, "
. "s.extpct "
. "FROM sys.ind\$ i, sys.ts\$ ts, sys.tab\$ t, sys.obj\$ io, "
. "sys.obj\$ o, sys.user\$ u, sys.seg\$ s ";
if ($db_version < 10)
{
$getIOTs_sql = $getIOTs_sql
. "WHERE ts.name " . $inASSMClause;
}
else
{
$getIOTs_sql = $getIOTs_sql
. "WHERE ts.name " . $inClause;
}
$getIOTs_sql = $getIOTs_sql
. "AND i.type# = 4 " # iot top
. "AND i.ts# = ts.ts# "
. "AND i.bo# = io.obj# "
. "AND i.bo# = t.obj# "
. "AND io.obj# = t.obj# "
. "AND BITAND(t.property, 1) = 0 " # not typed table
. "AND BITAND(t.property, 1024) = 0 " # not in cluster
. "AND BITAND(t.property, 8192) = 0 " # not nested table
. "AND BITAND(t.property, 131072) = 0 " # -- not AQ table
. "AND BITAND(i.flags, 4096) = 0 " # not fake internal
. "AND BITAND(i.property, 1) = 1 " # unique index
. "AND BITAND(i.property, 2) = 0 " # not partitioned
. "AND BITAND(i.property, 32) = 0 " # not temp table index
. "AND o.obj# = i.obj# "
. "AND io.type# = 2 " # base object is table
. "AND BITAND(io.flags, 2) = 0 " # table not temporary
. "AND BITAND(io.flags, 128) = 0 " # table not dropped
. "AND i.file# = s.file# "
. "AND i.block# = s.block# "
. "AND i.ts# = s.ts# "
. "AND s.user# = o.owner# "
. "AND s.user# = io.owner# "
. "AND u.user# = o.owner# "
. "AND io.owner# = o.owner# ";
if ($canAnalyzeSYS == 0)
{
$getIOTs_sql = $getIOTs_sql
. "AND u.user# != 0 "
. "AND o.owner# != 0 "
. "AND io.owner# != 0 ";
}
#-------------------------------------------
# Get the IOTs in a tablespace
#-------------------------------------------
EMD_PERL_DEBUG ("StgPerf processing IOTs in $tablespace \n");
# print ("StgPerf processing IOTs in $tablespace \n");
#PERFORMANCE
startTiming("allIOTSql");
if ($PERFORMANCE_ON == 1)
{
print ($getIOTs_sql . "\n");
}
my $getIOTCsr = $db->prepare($getIOTs_sql)
or die "Can't prepare getIOTs: $DBI::errstr";
$getIOTCsr->{RaiseError} = 1;
$getIOTCsr->execute;
endTiming("allIOTSql");
#----------------------------------
# Loop over all IOTs
#----------------------------------
my @fetch_row;
my $iotCount = 0;
$objectType = 'TABLE';
$segTypeStr = 'INDEX';
$segmentType = $SEG_TABLE;
my $iotStart = $segCount;
while (@fetch_row = $getIOTCsr->fetchrow_array)
{
#PERF
$segCount++;
#----------------------------
# Get data for one iot
#----------------------------
$owner = $fetch_row[0];
$objectName = $fetch_row[1];
$segName = $fetch_row[2];
$tablespace = $fetch_row[3];
$initExtent = $fetch_row[4];
$nextExtent = $fetch_row[5];
$pctIncrease = $fetch_row[6];
#print ("StgPerf analyzing IOT $owner.$objectName.$partName.$objectType $segTotalBytes\n");
#--------------------------
# Check for wasted space
#--------------------------
if ($spaceEnabled eq 'true')
{
analyzeSegmentWaste($tablespace);
}
} # loop over all iots
if ($PERFORMANCE_ON == 1)
{
print "IOT COUNT " . ($segCount - $iotStart) . "\n";
}
clearSegment();
}
#----------------------
# processAllTabParts
#----------------------
#
# Check table partitions for problems
#
sub processAllTabParts()
{
#-------------------------------------------
# Query to get the table partitions
#-------------------------------------------
#--
#-- Get the table partitions
#--
#-- Returns 0 - owner
#-- 1 - table_name
#-- 2 - tablespace_name
#-- 3 - pctFree
#-- 4 - iniTrans
#-- 5 - numRows
#-- 6 - blocks
#-- 7 - avg_row_len
#-- 8 - partition_name
#-- 9 - initial_extent
#-- 10 - iot_name
#-- 11 - current next extent size
#-- 12 - pctIncrease
#--
my $getTablesParts_sql =
# Select owner, table_name, tablespace_name,
# pct_free, initrans, rowcnt, blkcnt, avgrln,
# partition_name, initial_extent, iot_name
# for all table partitions in a list of tablespaces
# Table not in cluster, not nested, not temporary, not iot
# not in recycle bin, not typed table, not external table
# If not applicable, ignore tables owned by SYS
#
# Note: Temporary tables cannot be partitioned
#
"SELECT u.name table_owner, "
. "o.name table_name, "
. "ts.name tablespace_name, "
. "tp.pctfree\$ pct_free, "
. "tp.initrans, "
. "NVL(tp.rowcnt, 0), "
. "NVL(tp.blkcnt, 0), "
. "NVL(tp.avgrln, 0), "
. "o.subname, "
. "s.iniexts * ts.blocksize, "
. "decode((bitand(t.property, 512)+bitand(t.flags, 536870912)), "
. "0, null, co.name) iot_name, "
. "s.extsize * ts.blocksize, "
. "s.extpct "
. "FROM sys.obj\$ o, sys.tabpart\$ tp, sys.ts\$ ts, "
. "sys.seg\$ s, sys.user\$ u, "
. "sys.tab\$ t, sys.obj\$ co "
. "WHERE ts.name " . $inClause
. "AND o.obj# = tp.obj# "
. "AND ts.ts# = tp.ts# "
. "AND tp.bo# = t.obj# "
. "AND u.user# = o.owner# "
. "AND tp.file# = s.file# "
. "AND tp.block# = s.block# "
. "AND tp.ts# = s.ts# "
. "AND t.bobj# = co.obj#(+) "
. "AND BITAND(t.property, 32) = 32 " # -- partitioned
. "AND BITAND(t.property, 8192) = 0 " # -- not nested
. "AND BITAND(t.property, 64) = 0 " # -- not iot
. "AND BITAND(t.property, 1024) = 0 " # -- not in cluster
. "AND BITAND(t.property, 131072) = 0 " # -- not AQ table
. "AND BITAND(t.property, 1) = 0 "; # -- not typed table
if ($canAnalyzeSYS == 0)
{
$getTablesParts_sql = $getTablesParts_sql
. "AND u.user# != 0 "
}
$getTablesParts_sql = $getTablesParts_sql
. "AND BITAND(s.spare1, 65536) = 0 "; # -- not dropped
#-------------------------------------------
# Get the table partitions
#-------------------------------------------
#PERFORMANCE
startTiming("getTablePartsQuery");
if ($PERFORMANCE_ON == 1)
{
print ($getTablesParts_sql . "\n");
}
my $getTabPartCsr = $db->prepare($getTablesParts_sql)
or die "Can't prepare getTableParts: $DBI::errstr";
$getTabPartCsr->{RaiseError} = 1;
$getTabPartCsr->execute;
#PERFORMANCE
endTiming("getTablePartsQuery");
#----------------------------------
# Loop over all table partitions
#----------------------------------
my @fetch_row;
$objectType = 'TABLE';
$segTypeStr = 'TABLE PARTITION';
my $tpStart = $segCount;
while (@fetch_row = $getTabPartCsr->fetchrow_array)
{
$segmentType = $SEG_TABLE_PART;
#PERF
$segCount++;
#----------------------------
# Get data for one partition
#----------------------------
$owner = $fetch_row[0];
$objectName = $fetch_row[1];
$tablespace = $fetch_row[2];
$pctFree = $fetch_row[3];
$initrans = $fetch_row[4];
$numRows = $fetch_row[5];
$blocks = $fetch_row[6];
$avgRowLen = $fetch_row[7];
$partName = $fetch_row[8];
$initExtent = $fetch_row[9];
$iotName = $fetch_row[10];
$nextExtent = $fetch_row[11];
$pctIncrease = $fetch_row[12];
#print ("StgPerf analyzing object $owner.$objectName.$partName.$objectType\n");
#--------------------------
# Check for wasted space
#--------------------------
if ($spaceEnabled eq 'true')
{
analyzeSegmentWaste($tablespace);
}
} # loop over all table partitions
if ($PERFORMANCE_ON == 1)
{
print "TABPART COUNT " . ($segCount - $tpStart) . "\n";
}
clearSegment();
}
#----------------------
# processAllIOTParts
#----------------------
#
# Check IOT partitions for problems
#
sub processAllIOTParts()
{
#
# We don't know how to estimate wasted space in iots.
#
if ($hasASSM == 0 && $db_version < 10)
{
return;
}
#-------------------------------------------
# Get the IOT partitions in a tablespace
#-------------------------------------------
#--
#-- Get the IOT partitions in a tablespace
#--
#-- Returns 0 - owner
#-- 1 - table name
#-- 2 - index name
#-- 3 - IOT partition name
#-- 4 - tablespace name
#-- 5 - initial extent
#-- 6 - current next extent size
#-- 7 - pctIncrease
#--
my $getIotParts_sql =
# Select owner, table_name, index_name,
# partition_name, tablespace_name, initial_extent
# for all iot partition segments in a list of tablespaces
# Table not in cluster, not nested,
# not in recycle bin, not typed table, not external table
# If not applicable, ignore tables owned by SYS
#
# Note: Temporary tables cannot be partitioned
#
"SELECT /*+ ORDERED */ "
. "u.name index_owner, "
. "bo.name table_name, "
. "io.name index_name, "
. "io.subname partition_name, "
. "ts.name tablespace_name, "
. "s.iniexts * ts.blocksize initial_extent, "
. "s.extsize * ts.blocksize, "
. "s.extpct "
. "FROM sys.indpart\$ ip, sys.ts\$ ts, sys.ind\$ i, sys.tab\$ t, "
. "sys.obj\$ io, sys.user\$ u, sys.obj\$ bo, sys.seg\$ s ";
if ($db_version < 10)
{
$getIotParts_sql = $getIotParts_sql
. "WHERE ts.name " . $inASSMClause;
}
else
{
$getIotParts_sql = $getIotParts_sql
. "WHERE ts.name " . $inClause;
}
$getIotParts_sql = $getIotParts_sql
. "AND ts.ts# = ip.ts# "
. "AND ip.bo# = i.obj# "
. "AND i.type# = 4 " # -- iot top
. "AND BITAND(i.property, 2) = 2 " # -- partitioned
. "AND BITAND(i.flags, 4096) = 0 " # -- not fake internal
. "AND BITAND(i.property, 1) = 1 " # -- unique index
. "AND t.obj# = i.bo# "
. "AND BITAND(t.property, 1) = 0 " # -- not typed table
. "AND BITAND(t.property, 1024) = 0 " # -- not in cluster
. "AND BITAND(t.property, 8192) = 0 " # -- not nested table
. "AND BITAND(bo.flags, 128) = 0 " # -- not dropped
. "AND BITAND(t.property, 131072) = 0 " # -- not AQ table
. "AND t.obj# = bo.obj# "
. "AND io.obj# = ip.obj# "
. "AND i.bo# = bo.obj# "
. "AND ip.ts# = s.ts# "
. "AND ip.file# = s.file# "
. "AND ip.block# = s.block# "
. "AND io.owner# = bo.owner# "
. "AND s.user# = io.owner# "
. "AND s.user# = bo.owner# "
. "AND io.owner# = u.user# "
. "AND s.user# = u.user# "
. "AND bo.owner# = u.user# ";
if ($canAnalyzeSYS == 0)
{
$getIotParts_sql = $getIotParts_sql
. "and u.name != 'SYS' ";
}
#PERFORMANCE
startTiming("getIOTPartsSQL");
EMD_PERL_DEBUG ("StgPerf processing IOT parts in $tablespace \n");
# print ("StgPerf processing IOT parts in $tablespace \n");
if ($PERFORMANCE_ON == 1)
{
print ($getIotParts_sql . "\n");
}
my $getIOTPartCsr = $db->prepare($getIotParts_sql)
or die "Can't prepare getIOTParts: $DBI::errstr";
$getIOTPartCsr->{RaiseError} = 1;
$getIOTPartCsr->execute;
#PERFORMANCE
endTiming("getIOTPartsSQL");
#----------------------------------
# Loop over all IOT partitions
#----------------------------------
my @fetch_row;
$objectType = 'TABLE';
$segTypeStr = 'INDEX PARTITION';
$segmentType = $SEG_TABLE_PART;
my $iotPartStart = $segCount;
while (@fetch_row = $getIOTPartCsr->fetchrow_array)
{
#PERF
$segCount++;
#----------------------------
# Get data for one iot partition
#----------------------------
$owner = $fetch_row[0];
$objectName = $fetch_row[1];
$segName = $fetch_row[2];
$partName = $fetch_row[3];
$tablespace = $fetch_row[4];
$initExtent = $fetch_row[5];
$nextExtent = $fetch_row[6];
$pctIncrease = $fetch_row[7];
#EMD_PERL_DEBUG ("StgPerf analyzing object $owner $objectName $objectType\n");
#print ("StgPerf analyzing index partition $owner $objectName $partName\n");
#--------------------------
# Check for wasted space
#--------------------------
if ($spaceEnabled eq 'true')
{
analyzeSegmentWaste($tablespace);
}
} # loop over all iot partitions
if ($PERFORMANCE_ON == 1)
{
print "IOT PART COUNT " . ($segCount - $iotPartStart) . "\n";
}
clearSegment();
}
#----------------------
# processAllLobs
#----------------------
#
# Check lob segments for problems
#
sub processAllLobs()
{
#-------------------------------------------
# Query to get all lobs
#-------------------------------------------
#--
#-- Get the lob segments in a tablespace
#--
#-- Returns 0 - owner
#-- 1 - table name
#-- 2 - lob column name
#-- 3 - segment name
#-- 4 - tablespace_name
#-- 5 - initial extent
#-- 6 - freelist groups
#-- 7 - current next extent size
#-- 8 - pctIncrease
#--
my $getLobs_sql =
# Select owner, table_name, lob column name,
# lob segment name, tablespace_name, initial_extent,
# freelist_groups
# for all lob segments in a list of tablespaces
# Table not in cluster, not nested, not partitioned,
# not in recycle bin, not typed table, not external table
# If not applicable, ignore tables owned by SYS
#
"SELECT /*+ ORDERED */ "
. "u.name owner, "
. "bo.name table_name, "
. "DECODE(BITAND(c.property, 1), 1, ac.name, c.name) column_name, "
. "lo.name segment_name, "
. "ts.name tablespace_name, "
. "s.iniexts * ts.blocksize initial_extent, "
. "s.groups, "
. "s.extsize * ts.blocksize, "
. "s.extpct "
. "FROM sys.ts\$ ts, sys.lob\$ l, sys.col\$ c, sys.obj\$ bo, sys.obj\$ lo, "
. "sys.attrcol\$ ac, sys.user\$ u, sys.tab\$ t, sys.seg\$ s "
. "WHERE ts.name " . $inClause
. "AND ts.ts# = l.ts# "
. "AND c.obj# = l.obj# "
. "AND lo.obj# = l.lobj# "
. "AND l.obj# = bo.obj# "
. "AND bo.obj# = c.obj# "
. "AND lo.type# = 21 "
. "AND c.intcol# = l.intcol# "
. "AND c.obj# = ac.obj#(+) "
. "AND c.intcol# = ac.intcol#(+) "
. "AND BITAND(c.property, 32768) != 32768 ";
if ($canAnalyzeSYS == 0)
{
$getLobs_sql = $getLobs_sql
. "AND lo.owner# != 0 "
. "AND bo.owner# != 0 "
. "AND u.user# != 0 "
}
$getLobs_sql = $getLobs_sql
. "AND lo.owner# = bo.owner# "
. "AND lo.owner# = u.user# "
. "AND bo.owner# = u.user# "
. "AND t.obj# = bo.obj# "
. "AND BITAND(t.property, 32) = 0 " # -- not partitioned
. "AND DECODE(BITAND(t.property, 8192), 8192, 1, " # -- not nested
. "DECODE(BITAND(t.property, 1), 0, 0, 1)) = 0 " # -- not typed table
. "AND BITAND(t.property, 4194304) = 0 " # -- Not temp
. "AND BITAND(t.property, 8388608) = 0 " # -- not session temp
. "AND BITAND(t.property, 131072) = 0 " # -- not AQ table
. "AND s.user# = u.user# "
. "AND s.type# = 8 "
. "AND s.file# = l.file# "
. "AND s.block# = l.block# "
. "AND s.ts# = l.ts# "
. "AND s.ts# = ts.ts# "
. "AND BITAND(s.spare1, 65536) = 0 "; # -- not dropped
#-------------------------------------------
# Get the lobs
#-------------------------------------------
#PERFORMANCE
startTiming("LobSQL");
EMD_PERL_DEBUG ("StgPerf processing lobs in $tablespace \n");
# print ("StgPerf processing lobs in $tablespace \n");
my $getLobCsr;
if ($PERFORMANCE_ON == 1)
{
print ($getLobs_sql . "\n");
}
$getLobCsr = $db->prepare($getLobs_sql)
or die "Can't prepare getLobs: $DBI::errstr";
$getLobCsr->{RaiseError} = 1;
$getLobCsr->execute;
#PERFORMANCE
endTiming("LobSQL");
#----------------------------------
# Loop over all lobs
#----------------------------------
my @fetch_row;
$objectType = 'TABLE';
$segTypeStr = 'LOB';
$segmentType = $SEG_LOBCOL;
my $lobStart = $segCount;
while (@fetch_row = $getLobCsr->fetchrow_array)
{
#PERF
$segCount++;
#----------------------------
# Get data for one lob
#----------------------------
$owner = $fetch_row[0];
$objectName = $fetch_row[1];
$lobCol = $fetch_row[2];
$segName = $fetch_row[3];
$tablespace = $fetch_row[4];
$initExtent = $fetch_row[5];
$groups = $fetch_row[6];
$nextExtent = $fetch_row[7];
$pctIncrease = $fetch_row[8];
#EMD_PERL_DEBUG ("StgPerf analyzing object $owner $objectName $objectType\n");
#print ("StgPerf analyzing lob $owner $objectName $segName \n");
#--------------------------
# Check for wasted space
#--------------------------
if ($spaceEnabled eq 'true')
{
analyzeSegmentWaste($tablespace);
}
} # loop over all lobs
if ($PERFORMANCE_ON == 1)
{
print "LOB COUNT " . ($segCount - $lobStart) . "\n";
}
clearSegment();
}
#----------------------
# processAllLobParts
#----------------------
#
# Check lob partition segments for problems
#
sub processAllLobParts()
{
#
# We can't use the dbms_space functions on lob partitions pre 10g.
# due to bug #2962980
#
if ($db_version < 10)
{
return;
}
#
#---------------------------------
# Query to get lob partitions
#---------------------------------
#--
#-- Get the lob partition segments in a tablespace
#-- No subpartitions
#--
#--
#-- Returns 0 - owner
#-- 1 - table name
#-- 2 - lob column name
#-- 3 - lob segment name
#-- 4 - lob partition name
#-- 5 - table partition name
#-- 6 - tablespace name
#-- 7 - initial extent
#-- 8 - current next extent size
#-- 9 - pctIncrease
#--
my $getLobParts_sql =
# Select owner, table_name, lob column name,
# lob segment name, lob partition name, tablespace_name,
# initial_extent,
# for all lob segments in a list of tablespaces
# Table not in cluster, not nested
# not in recycle bin, not typed table, not external table
# If not applicable, ignore tables owned by SYS
#
# Note: Temporary tables cannot be partitioned
#
"SELECT /*+ ORDERED */ "
. "u.name table_owner, "
. "po.name table_name, "
. "DECODE(BITAND(c.property, 1), 1, a.name, c.name) column_name, "
. "lo.name lob_name, "
. "lpo.subname lob_partition_name, "
. "po.subname partition_name, "
. "ts.name tablespace_name, "
. "TO_CHAR(s.iniexts * ts.blocksize) initial_extent, "
. "s.extsize * ts.blocksize, "
. "s.extpct "
. "FROM sys.ts\$ ts, sys.lobfrag\$ lf, sys.lob\$ l, "
. "sys.tab\$ t, sys.obj\$ lo, sys.col\$ c, sys.obj\$ lpo, "
. "sys.obj\$ po, sys.seg\$ s, "
. "sys.user\$ u, sys.attrcol\$ a "
. "WHERE ts.name " . $inClause
. "AND lf.ts# = ts.ts# "
. "AND lf.fragtype\$='P' " # -- not subpartition
. "AND lf.tabfragobj# = po.obj# " # -- get table partition
. "AND lf.fragobj# = lpo.obj# " # -- get lob partition
. "AND l.lobj# = lf.parentobj# " # -- get lob
. "AND l.lobj# = lo.obj# " # -- get lob
. "AND t.obj# = l.obj# " # -- get table
. "AND c.obj# = l.obj# " # -- get lob column
. "AND c.intcol# = l.intcol# "
. "AND BITAND(c.property, 32768) != 32768 " # -- not unused column
. "AND c.obj# = a.obj#(+) "
. "AND c.intcol# = a.intcol#(+) "
. "AND t.obj# = c.obj# ";
if ($canAnalyzeSYS == 0)
{
$getLobParts_sql = $getLobParts_sql
. "AND u.name != 'SYS'"
}
$getLobParts_sql = $getLobParts_sql
. "AND po.owner# = lpo.owner# "
. "AND lo.owner# = lpo.owner# "
. "AND po.owner# = lo.owner# "
. "AND u.user# = lpo.owner# "
. "AND u.user# = lo.owner# "
. "AND u.user# = po.owner# "
. "AND BITAND(t.property, 32) = 32 " # -- partitioned
. "AND BITAND(t.property, 1) = 0 " # -- not typed
. "AND BITAND(t.property, 64) = 0 " # -- not iot
. "AND BITAND(t.property, 2147483648) = 0 " # -- not external
. "AND BITAND(t.property, 131072) = 0 " # -- not AQ table
. "AND lf.file# = s.file# "
. "AND lf.block# = s.block# "
. "AND lf.ts# = s.ts# "
. "AND s.ts# = ts.ts# "
. "AND s.user# = u.user# "
. "AND BITAND(s.spare1, 65536) = 0 "; # -- not dropped
#-------------------------------------------
# Get the lob partitions in a tablespace
#-------------------------------------------
#PERFORMANCE
startTiming("LobPartsSQL");
EMD_PERL_DEBUG ("StgPerf processing lob partitions in $tablespace \n");
# print ("StgPerf processing lob partitions in $tablespace \n");
if ($PERFORMANCE_ON == 1)
{
print ($getLobParts_sql . "\n");
}
my $getLobPartCsr = $db->prepare($getLobParts_sql)
or die "Can't prepare getLobParts: $DBI::errstr";
$getLobPartCsr->{RaiseError} = 1;
$getLobPartCsr->execute;
#PERFORMANCE
endTiming("LobPartsSQL");
#----------------------------------
# Loop over all lob partitions
#----------------------------------
my @fetch_row;
$objectType = 'TABLE';
$segTypeStr = 'LOB PARTITION';
$segmentType = $SEG_LOB_PART;
my $lobPartStart = $segCount;
while (@fetch_row = $getLobPartCsr->fetchrow_array)
{
#PERFORMANCE
$segCount++;
#----------------------------
# Get data for one lob partition
#----------------------------
$owner = $fetch_row[0];
$objectName = $fetch_row[1];
$lobCol = $fetch_row[2];
$segName = $fetch_row[3];
$segPartName = $fetch_row[4];
$partName = $fetch_row[5];
$tablespace = $fetch_row[6];
$initExtent = $fetch_row[7];
$nextExtent = $fetch_row[8];
$pctIncrease = $fetch_row[9];
#EMD_PERL_DEBUG ("StgPerf analyzing lob partition "
# . $owner $objectName $partName\n");
#print ("StgPerf analyzing lob partition "
# . $owner $objectName $partName\n");
# We can't estimate wasted space, so set stats to 0 to prevent
# the analysis.
$avgRowLen = 0;
$numRows = 0;
#--------------------------
# Check for wasted space
#--------------------------
if ($spaceEnabled eq 'true')
{
analyzeSegmentWaste($tablespace);
}
} # loop over all lob partitions
if ($PERFORMANCE_ON == 1)
{
print "LOB PART COUNT " . ($segCount - $lobPartStart) . "\n";
}
clearSegment();
}
#----------------------
# processAllRowChaining
#----------------------
#
# Check all tablespaces for row chaining
#
sub processAllRowChaining()
{
#--
#-- Returns 0 - owner
#-- 1 - table_name
#-- 2 - partition_name
#-- 3 - tablespace_name
#-- 4 - iot_name
#-- 5 - chain_cnt
#-- 6 - numRows
#-- 7 - segment_type
#--
#-- Get table and table partition segments
#-- where chain_cnt/numRows > rowchaining threshold
#--
#-- Note that IOT chain_cnt values are not valid
#--
my $getRowChain_sql =
# tables
"SELECT /*+ INDEX (o i_obj1) */ "
. "u.name owner, o.name table_name, '' partition_name, ts.name "
. "tablespace_name, chncnt chain_cnt, rowcnt num_rows "
. "FROM sys.user\$ u, sys.ts\$ ts, sys.tab\$ t, sys.obj\$ o "
. "WHERE t.chncnt IS NOT NULL "
. "AND t.rowcnt IS NOT NULL "
. "AND t.chncnt > 0 "
. "AND t.rowcnt > 0 "
. "AND t.chncnt / DECODE(t.rowcnt, 0, 1, t.rowcnt) > :rcMin "
. "AND ts.name " . $inClause
. "AND t.ts# = ts.ts# "
. "AND o.owner# = u.user# "
. "AND o.obj# = t.obj# "
. "AND BITAND(t.property, 1) = 0 "; # -- not typed table
if ($canAnalyzeSYS == 0)
{
$getRowChain_sql = $getRowChain_sql
. "AND u.name != 'SYS'"
}
$getRowChain_sql = $getRowChain_sql
. "AND BITAND(t.property, 512) = 0 " # -- no iot overflow
. "and bitand(t.property, 1024) = 0 " # -- no clustered
. "and bitand(t.property, 8192) = 0 " # -- no nested
. "and bitand(t.property, 64) = 0 " # -- no iot
. "and bitand(o.flags, 128) = 0 " # -- not dropped
. "AND BITAND(t.property, 131072) = 0 " # -- not AQ table
# table partitions
. "union "
. "SELECT u.name table_owner, o.name table_name, o.subname partition_name, "
. "ts.name tablespace_name, tp.chncnt chain_cnt, tp.rowcnt "
. "num_rows "
. "FROM sys.obj\$ o, sys.tabpart\$ tp, sys.ts\$ ts, sys.user\$ u, "
. "sys.tab\$ t, sys.obj\$ bo "
. "WHERE tp.chncnt IS NOT NULL "
. "AND tp.rowcnt IS NOT NULL "
. "AND tp.chncnt > 0 "
. "AND tp.rowcnt > 0 "
. "AND tp.chncnt / DECODE(tp.rowcnt, 0, 1, tp.rowcnt) > :rcMin "
. "AND ts.ts# = tp.ts# "
. "AND o.obj# = tp.obj# "
. "AND t.obj# = bo.obj# "
. "AND u.user# = o.owner# "
. "AND t.obj# = tp.bo# "
. "AND ts.name " . $inClause;
if ($canAnalyzeSYS == 0)
{
$getRowChain_sql = $getRowChain_sql
. "AND u.name != 'SYS'"
}
$getRowChain_sql = $getRowChain_sql
. "AND BITAND(t.property, 512) = 0 " # -- no iot overflow
. "and bitand(t.property, 1024) = 0 " # -- no clustered
. "and bitand(t.property, 8192) = 0 " # -- no nested
. "and bitand(t.property, 64) = 0 " # -- no iot
. "AND BITAND(t.property, 131072) = 0 " # -- not AQ table
. "and bitand(bo.flags, 128) = 0 "; # -- not dropped
startTiming("allRowChainSql");
my @fetch_row;
if ($PERFORMANCE_ON == 1)
{
print ($getRowChain_sql . "\n");
}
my $getRowChainCsr = $db->prepare($getRowChain_sql)
or die "Can't prepare getRowChain: $DBI::errstr";
$getRowChainCsr->{RaiseError} = 1;
$getRowChainCsr->bind_param(":rcMin", $rcMinValue);
$getRowChainCsr->execute;
endTiming("allRowChainSql");
$objectType = 'TABLE';
while (@fetch_row = $getRowChainCsr->fetchrow_array)
{
#PERF
$segCount++;
my $status;
#----------------------------
# Get data for one table
#----------------------------
$owner = $fetch_row[0];
$objectName = $fetch_row[1];
$partName = $fetch_row[2];
$tablespace = $fetch_row[3];
$chainCnt = $fetch_row[4];
$numRows = $fetch_row[5];
if (!defined $partName || $partName eq '')
{
$segmentType = $SEG_TABLE;
}
else
{
$segmentType = $SEG_TABLE_PART;
}
#EMD_PERL_DEBUG ("StgPerf rowchain object $owner $objectName $objectType\n");
#print STDERR ("StgPerf rowchain table $owner $objectName $tablespace\n");
#--------------------------
# Check for chained rows
#--------------------------
if ($rowChainEnabled eq 'true')
{
analyzeRowChaining($tablespace);
}
$iotName = "";
} # loop over all problem segments
clearSegment();
}
#----------------------
# verifyShrink
#----------------------
#
# Check that the given amount of space would free at least one extent
#
# Input: # of wasted bytes
#
# Return 1 if at least one extent can be freed (# wasted bytes > 1 extent)
# Return 0 if the wasted space is too small to free an extent
#
#
sub verifyShrink($)
{
my ($wasted) = @_;
# Don't make a recommendation if the space is less than the
# minimum specified
if ($wasted < $minWasteBytes)
{
return 0;
}
# Don't make recommendation if waste is very small
if ($wasted < $initExtent)
{
return 0;
}
# Don't make recommendation unless we can free more than one extent
my $shrinkable = 1;
if (($isASSM && $db_version >= 10) || ($is10_2 == 1))
{
bindSegmentInfo($verifyCsr);
$verifyCsr->bind_param(":waste", $wasted);
$verifyCsr->bind_param_inout(":shrinkable", \$shrinkable, 25);
$verifyCsr->execute;
}
elsif ($isASSM == 0)
{
# for dictionary managed tables, estimate the size of the last extent
# to determine whether it's shrinkable
my $lastExtentSize = $nextExtent;
if ($pctIncrease > 0)
{
$lastExtentSize = $nextExtent / ($pctIncrease/100.0 + 1);
}
#print "next=$nextExtent pctIncrease=$pctIncrease \n";
#print " last=$lastExtentSize waste=$wasted\n";
#print " $owner $objectName $partName $segName $segTypeStr $segPartName\n";
if ($wasted < $lastExtentSize)
{
$shrinkable = 0;
}
}
return $shrinkable;
}
#----------------------
# bindSegmentInfo
#----------------------
#
# Bind the object info to the dbms_space cursor.
#
# Input the cursor
#
sub bindSegmentInfo($)
{
my ($csr) = @_;
$csr->bind_param(":owner", $owner);
# We need to send the index for IOT's to be evaluated. However,
# in the output to the user, we have to show the table.
if ($segName ne "")
{
$csr->bind_param(":objectName", $segName);
}
else
{
$csr->bind_param(":objectName", $objectName);
}
$csr->bind_param(":objectType", $segTypeStr);
# For lob partitions, we need the lob partition name, but reorg
# needs the table partition name
if ($segPartName ne "")
{
$csr->bind_param(":partitionName", $segPartName);
}
else
{
$csr->bind_param(":partitionName", $partName);
}
}