#!./perl
#
# dbschema -- Emit a dump of the table schema of a given Oracle Database
#
#	Written by Clint Goss <clint@goss.com>, November 1998
#

BEGIN {
	# Access Perl modules

	#push (@INC, ...your lib directory here...);

	# Point to our preferred installation of Oracle

	#$ENV{'ORACLE_HOME'} = ...your Oracle Home here...);
}

# Perl Modules

use OraConnection;	# Connection to Oracle, incl DBI and DBD::Oracle
use Getopt::Std;	# Command-line option processing
use strict;		# Restrict unsafe variables, refs, barewords

# Process command-line arguments and options

sub usage {
	print <<END_USAGE
usage: $0 [options]

 Required:
  -d DATABASE  TNS name of the database
  -u USERNAME  username for login

 Optional:
  -p PASSWORD  password for login - defaults to username
  -t           show ALL table attributes
  -c           show ALL column attributes
  -n           No comments. Suppress printing of comments.
  -b PATTERN   limit tables to ones beginning with the PATTERN
END_USAGE
}

# Command line processing

use vars qw ($opt_b $opt_c $opt_d $opt_n $opt_p $opt_t $opt_u);
if (!getopts ('b:cd:np:tu:')) { &usage (); exit; }

my ($database) = $opt_d;
my ($username) = $opt_u;

my ($password) = $opt_p ? $opt_p : $username;
my ($pattern) = $opt_b;
my ($cVerbose) = $opt_c;
my ($tVerbose) = $opt_t;
my ($showComments) = ! $opt_n;

if (! $database) { &usage(); exit; }
if (! $username) { &usage(); exit; }

# Print a banner

print "*** $0: Dump of $database/$username table schema\n";
print "Starting: ", `date`;

# Set up the connection to Oracle

my ($dbc) = new OraConnection;
$dbc->connect ($database, $username, $password);

#### Now we'll fetch the attributes of each table

print "\n";

my ($tnames) = $dbc->tableOrViewNames (); 
print "\nTable names by tableNames/columnNames\n\n";

my ($t);

foreach $t (@$tnames) {

	if ($pattern) {
		if ($t !~ /$pattern/) { next; }
	}

	if ($showComments) {
		my ($tabComment) = $dbc->comment ($t);
		if ($tabComment) {
			$tabComment =~ s/\\n/\n# /g;
			print "# $tabComment\n\n";
		}
	}

	if ($tVerbose) {
		print "Table $t\n";

		print
		"  avg_row_len:     ", $dbc->avg_row_len ($t), "\n",
		"  avg_space:       ", $dbc->avg_space ($t), "\n",
		"  backed_up:       ", $dbc->backed_up ($t), "\n",
		"  blocks:          ", $dbc->blocks ($t), "\n",
		"  cache:           ", $dbc->cache ($t), "\n",
		"  chain_cnt:       ", $dbc->chain_cnt ($t), "\n",
		"  cluster_name:    ", $dbc->cluster_name ($t), "\n",
		"  degree:          ", $dbc->degree ($t), "\n",
		"  empty_blocks:    ", $dbc->empty_blocks ($t), "\n",
		"  freelists:       ", $dbc->freelists ($t), "\n",
		"  freelist_groups: ", $dbc->freelist_groups ($t), "\n",
		"  ini_trans:       ", $dbc->ini_trans ($t), "\n",
		"  initial_extent:  ", $dbc->initial_extent ($t), "\n",
		"  instances:       ", $dbc->instances ($t), "\n",
		"  max_extents:     ", $dbc->max_extents ($t), "\n",
		"  max_trans:       ", $dbc->max_trans ($t), "\n",
		"  min_extents:     ", $dbc->min_extents ($t), "\n",
		"  next_extent:     ", $dbc->next_extent ($t), "\n",
		"  num_rows:        ", $dbc->num_rows ($t), "\n",
		"  pct_free:        ", $dbc->pct_free ($t), "\n",
		"  pct_used:        ", $dbc->pct_used ($t), "\n",
		"  pct_increase:    ", $dbc->pct_increase ($t), "\n",
		"  table_lock:      ", $dbc->table_lock ($t), "\n",
		"  tablespace_name: ", $dbc->tablespace_name ($t), "\n",
		"  tabtype:         ", $dbc->tabtype  ($t), "\n";

		print " Columns:\n";
	} else {
		my ($tabtype) = $dbc->tabtype ($t);
		print "Table $t ($tabtype)\n";
	}

	my ($colNames) = $dbc->columnNames ($t);
	my ($f) = 1;
	my ($c);

	foreach $c (@$colNames) {

		# Show any comment for this column

		if ($showComments) {
			my ($colComment) = $dbc->comment ($t, $c);
			if ($colComment) {
				# $colComment =~ s/\\n/\n     # /g;
				# print "\n     # $colComment\n\n";
				$colComment =~ s/\\n/\n     # /g;
				print "     # $colComment\n";
			}
		}

		printf " %2d: %-24s ", $f, $c;

		my ($dtype) =  $dbc->data_type ($t, $c);
		my ($pkey) =  $dbc->primaryKeyPosition ($t, $c);

		my ($dtypeDisplay);
		my ($dlen) = $dbc->data_length ($t, $c);

		if ($dtype eq "NUMBER") {
			$dtypeDisplay = $dtype . " (" . $dlen . ", " .
				$dbc->data_scale ($t, $c) .  ")";

		} elsif (($dtype eq "DATE") && ($dlen == 7)) {

			$dtypeDisplay = $dtype;

		} else {
			$dtypeDisplay = $dtype . " (" . $dlen . ")";
		}

		printf " %-15s ", $dtypeDisplay;

		my ($nullable) = $dbc->nullable ($t, $c);
		if (! $nullable) {
			print " not NULL";
		} else {
			print "         ";
		}

		if ($pkey) {
			printf " PK %2d ", $pkey;
		} else {
			print "       ";
                }

		print "\n";

		if ($cVerbose) {

			print
			"  column_id:      ",
				$dbc->column_id ($t, $c), "\n",
			"  data_default:   ",
				$dbc->data_default ($t, $c), "\n",
			"  data_length:    ",
				$dbc->data_length ($t, $c), "\n",
			"  data_precision: ",
				$dbc->data_precision ($t, $c), "\n",
			"  data_scale:     ",
				$dbc->data_scale ($t, $c), "\n",
			"  data_type:      ",
				$dbc->data_type ($t, $c), "\n",
			"  default_length: ",
				$dbc->default_length ($t, $c), "\n",
			"  density:        ",
				$dbc->density ($t, $c), "\n",
			"  high_value:     ",
				$dbc->high_value ($t, $c), "\n",
			"  last_analyzed:  ",
				$dbc->last_analyzed ($t, $c), "\n",
			"  low_value:      ",
				$dbc->low_value ($t, $c), "\n",
			"  nullable:       ",
				$dbc->nullable ($t, $c), "\n",
			"  num_buckets:    ",
				$dbc->num_buckets ($t, $c), "\n",
			"  num_distinct:   ",
				$dbc->num_distinct ($t, $c), "\n",
			"  num_nulls:      ",
				$dbc->num_nulls ($t, $c), "\n",
			"  sample_size:    ",
				$dbc->sample_size ($t, $c), "\n";
		}

		$f++;
	}
	print "\n";

	# List all primary keys

	my ($pkNames) = $dbc->primaryKeyNames ($t);
	my ($pkName);
	foreach $pkName (@$pkNames) {

		printf "  Primary Key %s: ", $pkName;

		my ($pkColumnNames) =
			$dbc->primaryKeyColumnNames ($pkName);
		my ($pkColumnName);
		my ($cindex);
		foreach $pkColumnName (@$pkColumnNames) {

			$cindex++;

			if ($cindex == 1) {
				printf "($pkColumnName";
			} else {
				printf ", $pkColumnName";
			}
		}

		print ")\n";
	}
	print "\n";

	# List all foreign keys

	my ($fkNames) = $dbc->foreignKeyNames ($t);
	my ($fkName);
	foreach $fkName (@$fkNames) {

		printf "  Foreign Key %s: ", $fkName;

		my ($fkColumnNames) =
			$dbc->foreignKeyColumnNames ($fkName);
		my ($fkColumnName);
		my ($cindex);
		foreach $fkColumnName (@$fkColumnNames) {

			$cindex++;

			if ($cindex == 1) {
				printf "($fkColumnName";
			} else {
				printf ", $fkColumnName";
			}
		}

		print ")\n";

		my ($targPkName) = $dbc->foreignKeyTarget ($fkName);

		printf "           -> %s: ", $targPkName;

		my ($targPkColumnNames) =
			$dbc->primaryKeyColumnNames ($targPkName);
		my ($targPkColumnName);
		$cindex = 0;
		foreach $targPkColumnName (@$targPkColumnNames) {

			$cindex++;

			if ($cindex == 1) {
				printf "($targPkColumnName";
			} else {
				printf ", $targPkColumnName";
			}
		}

		print ")\n";
	}
	print "\n";
}

# Now we'll fetch the synonyms for this database

my ($synNames) = $dbc->synonymNames ();

if (scalar @$synNames) {
	print "\n";
	print "Synonyms\n";
	print "--------\n";
	print "\n";
	printf "%-24s %-10s %s\n", "Synonym", "Schema", "Table Name";
	printf "%-24s %-10s %s\n", "-------", "------", "----------";
	print "\n";
}

my ($synName);
foreach $synName (@$synNames) {

	my ($tableOwner) = $dbc->table_owner_of_synonym ($synName);
	my ($tableName) = $dbc->table_name_of_synonym ($synName);

	printf "%-24s %-10s %s\n", $synName, $tableOwner, $tableName;
}

# Unplug from Oracle and report completion to the log file

print "Done: ", `date`;

exit;