#!/usr/bin/perl -w
#
#	$Id: dbschema.pl,v 1.1 1997/11/03 18:08:41 mpeppler Exp $
#
# dbschema.pl	A script to extract a database structure from
#		a Sybase database
#
# Written by:	Michael Peppler (mpeppler@mbay.net)
#		Substantially rewritten by David Whitmarsh from a partial
#		System 10 implementation by Ashu Joglekar
#		Ported to DBI/DBD::Sybase by Michael Peppler
#
# Last Mods:    31 October 1997
#
# Usage:	dbschema.pl -d database -o script.name -t pattern -s server -v
#		    where   database is self-explanatory (default: master)
#                           script.name is the output file (default: script.isql)
#                           pattern is the pattern of object names (in sysobjects)
#                           that we will look at (default: %), and server is
#			    the server to connect to (default, the value of $ENV{DSQUERY}).
#
#		    -v turns on a verbose switch.
#
#    Changes:   11/18/93 - bpapp - Put in interactive SA password prompt
#               11/18/93 - bpapp - Get protection information for views and
#                                  stored procedures.
#		02/22/94 - mpeppler - Merge bpapp's changes with itf version'
#		09/15/94 - mpeppler - Minor changes for use with Sybperl2
#				      alpha1
#		13/10/95 - Ashu Joglekar - System 10 w/o RI
#		11/11/96 - David Whitmarsh -
#				Use Sybase::DBlib
#				System 10 declarative RI
#				constraints
#				Eliminate key truncation problems
#				Optional password command line
#				Debugged and strictified
#				Some index/key options
#		17/2/97 - Michael Peppler
#				Fixed small ',' problem in printKeys()
#		11/3/97 - David Whitmarsh
#				bug handling user defined types used as
#				identity columns.
#				addtype now has scale, prec
#				removed spurious addtypes for nchar etc.
#				null/not null/identity on types
#               12/3/97 - Michael Peppler
#                               Added -i switch to set an alternate interfaces
#                               file.
#
#		If anyone knows a way to distinguish between key and reference
#		declarations made at column and table level, let me know.
#------------------------------------------------------------------------------


use strict;
use DBI;
use Getopt::Std;

sub getPerms;
sub getObj;
sub printKeys;
sub getComment;
sub PrintCols;
sub DumpTable;

my ($dbh, @dat, $dat, $udflt, $urule, %udflt, %urule, %tables, @tabnames, @col);
my $sth;
my ($rule, $dflt, $date, $name);


select (STDOUT); $| = 1;		# make unbuffered

getopts ('u:p:d:t:o:s:i:v');

$Getopt::Std::opt_u = `whoami` unless $Getopt::Std::opt_u;
$Getopt::Std::opt_d = 'master' unless $Getopt::Std::opt_d;
$Getopt::Std::opt_o = 'script.isql' unless $Getopt::Std::opt_o;
$Getopt::Std::opt_t = '%' unless $Getopt::Std::opt_t;
$Getopt::Std::opt_s = $ENV{DSQUERY} unless $Getopt::Std::opt_s;

open(SCRIPT, "> $Getopt::Std::opt_o") || die "Can't open $Getopt::Std::opt_o: $!\n";
open(LOG, "> $Getopt::Std::opt_o.log") || die "Can't open $Getopt::Std::opt_o.log: $!\n";

#
# Log us in to Sybase as '$Getopt::Std::opt_u' and prompt for password.
#
if (!$Getopt::Std::opt_p) {
    print "\nPassword: ";
    system("stty -echo");
    chop($Getopt::Std::opt_p = <>);
    system("stty echo");
}
my $ifile = '';
if($Getopt::Std::opt_i) {
    $ifile = "interfaces=$Getopt::Std::opt_i";
}

$dbh = DBI->connect("dbi:Sybase:server=$Getopt::Std::opt_s;$ifile", $Getopt::Std::opt_u, $Getopt::Std::opt_p);
$dbh->do("use $Getopt::Std::opt_d");


$date = scalar(localtime);

print "dbschema.pl on Database $Getopt::Std::opt_d\n";

print LOG "Error log from dbschema.pl on Database $Getopt::Std::opt_d on $date\n\n";
print LOG "The following objects cannot be reliably created from the script in $Getopt::Std::opt_o.
Please correct the script to remove any inconsistencies.\n\n";

print SCRIPT
    "/* This Isql script was generated by dbschema.pl on $date.  */\n";

print SCRIPT "\nuse $Getopt::Std::opt_d\ngo\n"; # Change to the appropriate database


# first, Add the appropriate user data types:
#

print "Add user-defined data types...";
print SCRIPT
    "/* Add user-defined data types: */\n\n";

$sth = $dbh->prepare (<<SQLEND
select s.length, s.name, st.name,
       object_name(s.tdefault),
       object_name(s.domain),
       s.prec, s.scale,
       s.allownulls,
       isnull (s.ident, 1)
from   dbo.systypes s, dbo.systypes st
where  st.type = s.type
and s.usertype > 100 and st.usertype < 100
and st.name not in  ('intn', 'nvarchar', 'sysname', 'nchar')
SQLEND
);

$sth->execute;

while((@dat = $sth->fetchrow))
{
    print SCRIPT "sp_addtype $dat[1], ";
    ($dat[2] =~ /char\b|binary\b/ and
        print SCRIPT "'$dat[2]($dat[0])'")
    or ($dat[2] =~ /\bnumeric\b|\bdecimal\b/ and
	print SCRIPT "'$dat[2]($dat[5],$dat[6])'")
    or print SCRIPT "$dat[2]";

    (($dat[8] == 1) and print SCRIPT ", 'identity'")
    or (($dat[7] == 1) and print SCRIPT ", 'null'")
    or print SCRIPT ", 'not null'";

    print SCRIPT "\ngo\n";

    # Now remember the default & rule for later.

    $urule{$dat[1]} = $dat[4] if defined($dat[4]);
    $udflt{$dat[1]} = $dat[3] if defined($dat[3]);
}
$sth->finish();

print "Done\n";

print "Create rules...";
print SCRIPT
    "\n/* Now we add the rules... */\n\n";

getObj('Rule', 'R');
print "Done\n";

print "Create defaults...";
print SCRIPT
    "\n/* Now we add the defaults... */\n\n";

getObj('Default', 'D');
print "Done\n";

print "Bind rules & defaults to user data types...";
print SCRIPT "/* Bind rules & defaults to user data types... */\n\n";

while(($dat, $dflt)=each(%udflt))
{
    print SCRIPT "sp_bindefault $dflt, $dat\ngo\n";
}
while(($dat, $rule) = each(%urule))
{
    print SCRIPT "sp_bindrule $rule, $dat\ngo\n";
}
print "Done\n";

print "Create Tables & Indices...";
print "\n" if $Getopt::Std::opt_v;

# the fourth column set to 'N' becomes the indicator that this table has been 
# printed

$sth = $dbh->prepare (<<SQLEND
select o.name, u.name, o.id, 'N'
from dbo.sysobjects o, dbo.sysusers u
where o.type = 'U' and o.name like '$Getopt::Std::opt_t' and u.uid = o.uid
order by o.name
SQLEND
);

$sth->execute;

while((@dat = $sth->fetchrow))
{
    $tables{$dat[1] . "." . $dat[0]} = [ @dat ];
    @tabnames = ( @tabnames, $dat[1] . "." . $dat[0] );
}

$sth->finish;

foreach $name (@tabnames) {
    DumpTable ($tables{$name}, ());
}

print "Done\n";

#
# The key definitions - sp_primarykey etc, not constraints
# Primary keys first, then foreign and common
#

printKeys ();

#
# Now create any views that might exist
#

print "Create views...";
print SCRIPT
    "\n/* Now we add the views... */\n\n";

getObj('View', 'V');

print "Done\n";

#
# Now create any stored procs that might exist
#

print "Create stored procs...";
print SCRIPT
    "\n/* Now we add the stored procedures... */\n\n";
getObj('Stored Proc', 'P');

print "Done\n";

#
# Now create the triggers
#

print "Create triggers...";
print SCRIPT
    "\n/* Now we add the triggers... */\n\n";

getObj('Trigger', 'TR');


print "Done\n";

print "\nLooks like I'm all done!\n";
close(SCRIPT);
close(LOG);

$dbh->disconnect;


sub getPerms
{
    my ($obj) = $_[0];
    my ($ret, @dat, $act, $cnt);

    $sth = $dbh->prepare ("sp_helprotect '$obj'\n");
    $sth->execute;

    $cnt = 0;
    while(@dat = $sth->fetchrow)
    {
	$act = 'to';
	$act = 'from' if $dat[0] =~ /Revoke/;
	print SCRIPT "$dat[2] $dat[3] on $obj $act $dat[1]\n";
	++$cnt;
    }

    $sth->finish;

    $cnt;
}

sub getObj
{
    my ($objname, $obj) = @_;
    my (@dat, @items, @vi, $found, $text);
    
    $sth = $dbh->prepare (<<SQLEND
select	distinct o.name, u.name, o.id
from	dbo.sysobjects o, dbo.sysusers u,
	dbo.sysprocedures p
where	o.type = '$obj' and o.name like '$Getopt::Std::opt_t' and u.uid = o.uid
	and o.id = p.id and p.status & 4096 != 4096
order by o.name
SQLEND
    );

    $sth->execute;

    while((@dat = $sth->fetchrow))
    {
	push (@items, [ @dat ]);	# and save it in a list
    }
    $sth->finish;

    foreach (@items)
    {
	@vi = @$_;
	$found = 0;

	$sth = $dbh->prepare ("select text from dbo.syscomments where id = $vi[2]");
	$sth->execute;
	
	print SCRIPT
	    "/* $objname $vi[0], owner $vi[1] */\n";

	while(($text) = $sth->fetchrow)
	{
	    if(!$found && $vi[1] ne 'dbo')
	    {
		++$found if($text =~ /$vi[1]/);
	    }
	    print SCRIPT $text;
	}
	$sth->finish;

	print SCRIPT "\ngo\n";
	if(!$found && $vi[1] ne 'dbo')
	{
	    print "**Warning**\n$objname $vi[0] has owner $vi[1]\nbut this is not mentioned in the CREATE PROC statement!!\n";
	    print LOG "$objname $vi[0] (owner $vi[1])\n";
	}
	if ($obj eq 'V' || $obj eq 'P')
	{
	   getPerms("$vi[0]") && print SCRIPT "go\n";
	}

    }
}

sub printKeys
{

    print "Create sp_*key definitions...";
    print SCRIPT "\n/* Now create the key definitions ...*/\n\n";

    $sth = $dbh->prepare (<<SQLEND
select keytype = convert(char(10), v.name), object = object_name(k.id),
    related_object = object_name(k.depid),
    key1 = col_name(k.id, key1),
    key2 = col_name(k.id, key2),
    key3 = col_name(k.id, key3),
    key4 = col_name(k.id, key4),
    key5 = col_name(k.id, key5),
    key6 = col_name(k.id, key6),
    key7 = col_name(k.id, key7),
    key8 = col_name(k.id, key8),
    depkey1 = col_name(k.depid, key1),
    depkey2 = col_name(k.depid, key2),
    depkey3 = col_name(k.depid, key3),
    depkey4 = col_name(k.depid, key4),
    depkey5 = col_name(k.depid, key5),
    depkey6 = col_name(k.depid, key6),
    depkey7 = col_name(k.depid, key7),
    depkey8 = col_name(k.depid, key8)
from dbo.syskeys k, master.dbo.spt_values v, dbo.sysobjects o
where k.type = v.number and v.type = 'K'
and k.id = o.id
and o.type != 'S'
and o.name like '$Getopt::Std::opt_t'
order by v.number, object, related_object
SQLEND
);


    $sth->execute;

    while((@dat = $sth->fetchrow)) {
	if ($dat[0] eq "primary") {
	    print SCRIPT "sp_primarykey $dat[1],";

	    PrintCols (@dat[3..10]);
	    
	    print SCRIPT "\ngo\n";
	}
	if ($dat[0] eq "foreign") {
	    print SCRIPT "sp_foreignkey $dat[1], $dat[2],";
	    
	    PrintCols (@dat[11..18]);
	    
	    print SCRIPT "\ngo\n";
	}
	if ($dat[0] eq "common") {
	    print SCRIPT "sp_commonkey $dat[1], $dat[2],";
	    
	    PrintCols (@dat[3..10]);
	    
	    print SCRIPT "\ngo\n";
	}
    }
    $sth->finish;

    print "done\n"
}

sub getComment
{

    my ($objid) = @_;
    my ($line, $text);

    $sth = $dbh->prepare (
	qq(select text from dbo.syscomments where id = $objid)); 
    $sth->execute;
    
    $text = "";

    while(($line) = $sth->fetchrow)
    {
	$text = $text . $line;
    }
    $sth->finish;

    return $text;
}

sub PrintCols
{
    my ($col, $first);

    $first = 1;
    while ($col = shift (@_)) {
	last if ($col eq '*');
	print SCRIPT ", " if !$first;
	$first = 0;
	print SCRIPT "$col";
    }
}

# Note: this is a recursive subroutine.
# If the current table references another that is in the list of
# tables to be dumped, and if that table has not yet been dumped,
# then DumpTable is called to dump it before proceeding

sub DumpTable
{

    my ($tabref, @referers) = @_;

    return if @$tabref[3] eq "Y";

    my @nul = ('not null','null');
    my (@dat, $dat, @col);
    my (@refcols, @reflist, @field, $rule, $dflt, %rule, %dflt, $ddlrule, $ddldflt);
    my ($refname, $first, $matchstring, $field, @constrids, $constrid);
    my ($frgntabref);
    my ($nultype);

# first, get any reference and ensure that dependent tables have already been
# created

    $sth = $dbh->prepare (<<SQLEND
select isnull (r.frgndbname, '$Getopt::Std::opt_d'),
    object_name (r.constrid),
    object_name (r.reftabid, r.frgndbid),
    user_name (o2.uid),
    fokey1 = col_name (r.tableid, r.fokey1),
    fokey2 = col_name (r.tableid, r.fokey2),
    fokey3 = col_name (r.tableid, r.fokey3),
    fokey4 = col_name (r.tableid, r.fokey4),
    fokey5 = col_name (r.tableid, r.fokey5),
    fokey6 = col_name (r.tableid, r.fokey6),
    fokey7 = col_name (r.tableid, r.fokey7),
    fokey8 = col_name (r.tableid, r.fokey8),
    fokey9 = col_name (r.tableid, r.fokey9),
    fokey10 = col_name (r.tableid, r.fokey10),
    fokey11 = col_name (r.tableid, r.fokey11),
    fokey12 = col_name (r.tableid, r.fokey12),
    fokey13 = col_name (r.tableid, r.fokey13),
    fokey14 = col_name (r.tableid, r.fokey14),
    fokey15 = col_name (r.tableid, r.fokey15),
    fokey16 = col_name (r.tableid, r.fokey16),
    refkey1 = col_name (r.reftabid, r.refkey1),
    refkey2 = col_name (r.reftabid, r.refkey2),
    refkey3 = col_name (r.reftabid, r.refkey3),
    refkey4 = col_name (r.reftabid, r.refkey4),
    refkey5 = col_name (r.reftabid, r.refkey5),
    refkey6 = col_name (r.reftabid, r.refkey6),
    refkey7 = col_name (r.reftabid, r.refkey7),
    refkey8 = col_name (r.reftabid, r.refkey8),
    refkey9 = col_name (r.reftabid, r.refkey9),
    refkey10 = col_name (r.reftabid, r.refkey10),
    refkey11 = col_name (r.reftabid, r.refkey11),
    refkey12 = col_name (r.reftabid, r.refkey12),
    refkey13 = col_name (r.reftabid, r.refkey13),
    refkey14 = col_name (r.reftabid, r.refkey14),
    refkey15 = col_name (r.reftabid, r.refkey15),
    refkey16 = col_name (r.reftabid, r.refkey16)
from dbo.sysreferences r, dbo.sysobjects o1, dbo.sysobjects o2
where r.tableid = o1.id
and r.pmrydbname is null
and o1.name = '@$tabref[0]'
and o1.uid = user_id ('@$tabref[1]')
and r.reftabid *= o2.id
SQLEND
    );

    $sth->execute;

    while((@refcols = $sth->fetchrow))
    {
	push (@reflist, [ @refcols ]);
    }
    $sth->finish;

    foreach (@reflist) {
	@refcols = @$_;

# if the foreign table is in a foreign database or is not in 
# our table list, then don't do any more than add it to the list

	next if $refcols[0] ne $Getopt::Std::opt_d;

	$refname = $refcols[3] . "." . $refcols[2];

	next if not defined ($tables{$refname});

	$frgntabref = $tables{$refname};

# otherwise check if it's already been dumped, if so, continue

	next if @$frgntabref[3] eq "Y";

# make sure we aren't in a refernce loop by checking to see if this table is
# already in the heirarchy of refering tables that led to the current invocation

	grep ($refname, @referers)
	    && print SCRIPT "/* WARNING: circular foreign key reference to $refname */\n"
	    && print LOG "@$tabref[1].@$tabref[0] in circular foreign key reference to $refname\n";

# so dump the referenced tables first

	DumpTable ($frgntabref, @referers, $refname);
    }

    print "Creating table @$tabref[0], owner @$tabref[1]\n" if $Getopt::Std::opt_v;

    print SCRIPT "/* Start of description of table @$tabref[1].@$tabref[0] */\n\n";

    $sth = $dbh->prepare (<<SQLEND
select distinct Column_name = c.name, 
   Type = t.name, 
   Length = c.length, 
   Prec = c.prec, 
   Scale = c.scale, 
   Nulls = convert(bit, (c.status & 8)),
   Default_name = object_name(c.cdefault),
   Rule_name = object_name(c.domain),
   Ident = convert(bit, (c.status & 0x80)),
   Default_Ddl = isnull (d.status & 4096, 0),
   Rule_Ddl = isnull (r.status & 4096, 0),
   DefaultId = c.cdefault,
   RuleId = c.domain
from   dbo.syscolumns c, dbo.systypes t,
   dbo.sysprocedures d, dbo.sysprocedures r
where  c.id = @$tabref[2]
and    c.usertype *= t.usertype
and    c.cdefault *= d.id
and    c.domain *= r.id
order by c.colid
SQLEND
    );

    $sth->execute;

    undef(%rule);
    undef(%dflt);

    print SCRIPT "\n\nCREATE TABLE @$tabref[1].@$tabref[0] (\n"; 
    $first = 1;
    @col = ();
    while (@field = $sth->fetchrow)
    {
	push @col, [ @field ];
    }
    $sth->finish;

    foreach (@col) {
	@field = @$_;

        print SCRIPT ",\n" if !$first;		# add a , and a \n if not first field in table

	# get the declarative rule and default (if set)

	if ($field[9] != 0) {
	    $ddldflt = getComment ($field[11]);
	} else {
	    $ddldflt = "";
	}
	if ($field[10] != 0) {
	    $ddlrule = getComment ($field[12]);
	} else {
	    $ddlrule = "";
	}
        
	# Check if its an identity column
	if ($field[8] == 1) {	
	    $nultype = "identity";
	} else {
	    $nultype = $nul[$field[5]];
	}

	print SCRIPT "\t$field[0] \t$field[1]";
	print SCRIPT "($field[2])" if $field[1] =~ /char|bin/;
	print SCRIPT "($field[3],$field[4])" if $field[1] =~ /\bnumeric\b|\bdecimal\b/;
	print SCRIPT " $ddldflt $nultype $ddlrule";

	if (defined ($field[7])
	    && ((!defined ($urule{$field[1]})) || $urule{$field[1]} ne $field[7])
	    && ($field[10] == 0)) {
	    $rule{"@$tabref[0].$field[0]"} = $field[7];
	}

	if (defined ($field[6])
	    && ((!defined ($udflt{$field[1]})) || $udflt{$field[1]} ne $field[6])
	    && ($field[9] == 0)) {
	    $dflt{"@$tabref[0].$field[0]"} = $field[6];
	}
        $first = 0 if $first;
        
    }

# references

    foreach (@reflist) {
	@refcols = @$_;

	print SCRIPT ",";

	$refname = $refcols[3] . "." . $refcols[2];

	if ($refcols[0] ne $Getopt::Std::opt_d) {
	    print SCRIPT "\n/* The following reference is in database
** $refcols[0], edit the script to create the reference manually
";
	    print LOG "Reference for @$tabref[1].@$tabref[0] in foreign database\n\t";
	    $refname = $refcols[0] . "." . $refname;
	}
	print SCRIPT "\n\t";

	$matchstring = substr($refcols[1], 0, 8) . "[_0-9][_0-9]*";
	$refcols[1] !~ /$matchstring/
		&& print SCRIPT "CONSTRAINT $refcols[1] ";

	print SCRIPT "FOREIGN KEY (";
	
	PrintCols (@refcols[4..19]);

	print SCRIPT ") REFERENCES $refname (";

	PrintCols (@refcols[20..35]);
        
	print SCRIPT ")";

	if ($refcols[0] ne $Getopt::Std::opt_d) {
	    print SCRIPT "*/";
	}
    }

# now get the indexes and keys...
#

    print "Indexes for table @$tabref[1].@$tabref[0]\n" if $Getopt::Std::opt_v;
    
    $sth = $dbh->prepare (<<SQLEND
select name, indid, status, status2,
    key1 = index_col ('@$tabref[1].@$tabref[0]', indid, 1),
    key2 = index_col ('@$tabref[1].@$tabref[0]', indid, 2),
    key3 = index_col ('@$tabref[1].@$tabref[0]', indid, 3),
    key4 = index_col ('@$tabref[1].@$tabref[0]', indid, 4),
    key5 = index_col ('@$tabref[1].@$tabref[0]', indid, 5),
    key6 = index_col ('@$tabref[1].@$tabref[0]', indid, 6),
    key7 = index_col ('@$tabref[1].@$tabref[0]', indid, 7),
    key8 = index_col ('@$tabref[1].@$tabref[0]', indid, 8),
    key9 = index_col ('@$tabref[1].@$tabref[0]', indid, 9),
    key10 = index_col ('@$tabref[1].@$tabref[0]', indid, 10),
    key11 = index_col ('@$tabref[1].@$tabref[0]', indid, 11),
    key12 = index_col ('@$tabref[1].@$tabref[0]', indid, 12),
    key13 = index_col ('@$tabref[1].@$tabref[0]', indid, 13),
    key14 = index_col ('@$tabref[1].@$tabref[0]', indid, 14),
    key15 = index_col ('@$tabref[1].@$tabref[0]', indid, 15),
    key16 = index_col ('@$tabref[1].@$tabref[0]', indid, 16)
from dbo.sysindexes
where id = object_id ('@$tabref[1].@$tabref[0]')
and indid between 1 and 254
SQLEND
);
    $sth->execute;

    @col = ();

    while((@field = $sth->fetchrow))
    {
# if this is a key or unique constraint, print out the details
# otherwise buffer it up to print as an index afterwards

	if ($field[3] & 2) {
	    print (SCRIPT ",\n\t");
	    print SCRIPT "CONSTRAINT $field[0] " unless ($field[3] & 8);

	    if ($field[2] & 2048) {
		print SCRIPT "PRIMARY KEY ";
		print SCRIPT "NONCLUSTERED " if ($field[1] != 1);
	    } else {
		print SCRIPT "UNIQUE ";
		print SCRIPT "CLUSTERED " if ($field[1] == 1);
	    }
	    print SCRIPT "(";
	    PrintCols (@field[4..19]);
	    print SCRIPT ")";
	} else {
	    push @col, [ @field ];
	}
    }
    $sth->finish;

# Now do the table level check constraints

    @constrids = ();

    $sth = $dbh->prepare (<<SQLEND
select constrid from dbo.sysconstraints
where tableid = object_id ('@$tabref[1].@$tabref[0]')
and status & 128 = 128
and colid = 0
SQLEND
);
    $sth->execute;

    while (@field = $sth->fetchrow) {
	@constrids = (@constrids, $field[0]);
    }
    $sth->finish;

    foreach $constrid (@constrids) {
	print SCRIPT ",\n\t" . getComment ($constrid);
    }

    print SCRIPT "\n)\ngo\n";	# end of CREATE TABLE

    foreach (@col) {	# now print the indexes

	@field = @$_;

        print SCRIPT "\nCREATE ";
        print SCRIPT "UNIQUE " if $field[2] & 2;
        print SCRIPT "CLUSTERED " if $field[1] == 1;
        print SCRIPT "INDEX $field[0]\n";
        print SCRIPT "ON @$tabref[1].@$tabref[0] (";

	PrintCols (@field[4..19]);
        
        print SCRIPT ")";

	$first = 1;
	if ($field[2] & 64) {
	    print SCRIPT " WITH ALLOW_DUP_ROW";
	    $first = 0;
	}
	if ($field[2] & 1) {
	    print SCRIPT (($first == 0) ? ", " : " WITH ") . "IGNORE_DUP_KEY";
	    $first = 0;
	}
	if ($field[2] & 4) {
	    print SCRIPT (($first == 0) ? ", " : " WITH ") . "IGNORE_DUP_ROW";
	    $first = 0;
	}

        print SCRIPT "\ngo\n";

    }

    getPerms("@$tabref[1].@$tabref[0]") && print SCRIPT "go\n";

    print "Bind rules & defaults to columns...\n" if $Getopt::Std::opt_v;
    print SCRIPT "/* Bind rules & defaults to columns... */\n\n";

    if(@$tabref[1] ne 'dbo' && (keys(%dflt) || keys(%rule)))
    {
	print SCRIPT "/* The owner of the table is @$tabref[1].
 * I can't bind the rules/defaults to a table of which I am not the owner.
 * The procedures below will have to be run manualy by user @$tabref[1].
 */";
	print LOG "Defaults/Rules for @$tabref[1].@$tabref[0] could not be bound\n";
    }

    while(($dat, $dflt)=each(%dflt))
    {
	print SCRIPT "/* " if @$tabref[1] ne 'dbo';
	print SCRIPT "sp_bindefault $dflt, '$dat'";
	if(@$tabref[1] ne 'dbo')
	{
	    print SCRIPT " */\n";
	}
	else
	{
	    print SCRIPT "\ngo\n";
	}
    }
    while(($dat, $rule) = each(%rule))
    {
	print SCRIPT "/* " if @$tabref[1] ne 'dbo';
	print SCRIPT "sp_bindrule $rule, '$dat'";
	if(@$tabref[1] ne 'dbo')
	{
	    print SCRIPT " */\n";
	}
	else
	{
	    print SCRIPT "\ngo\n";
	}
    }
    print SCRIPT "\n/* End of description of table @$tabref[1].@$tabref[0] */\n";

    @$tabref[3] = "Y";

}