#! /usr/local/bin/sybperl
#
#	@(#)dbschema.pl	1.12	9/15/94
#
#
# dbschema.pl	A script to extract a database structure from
#		a Sybase database
#
# Written by:	Michael Peppler (mpeppler@itf.ch)
# Last Mods:    22 Feb 1994
#
# 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
#
#------------------------------------------------------------------------------


require 'sybperl.pl';
require 'getopts.pl';
require 'ctime.pl';

@nul = ('not null','null');

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

do Getopts('d:t:o:s:v');

$opt_d = 'master' unless $opt_d;
$opt_o = 'script.isql' unless $opt_o;
$opt_t = '%' unless $opt_t;
$opt_s = $ENV{DSQUERY} unless $opt_s;

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

#
# Log us in to Sybase as 'sa' and prompt for admin password.
#
print "\nAdministrative account password: ";
system("stty -echo");
chop($sapw = <>);
system("stty echo");

$dbproc = &dblogin("sa", $sapw, $opt_s);
&dbuse($dbproc, $opt_d);

chop($date = &ctime(time));

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

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

print SCRIPT
    "/* This Isql script was generated by dbschema.pl on $date.
** The indexes need to be checked: column names & index names
** might be truncated!
*/\n";

print SCRIPT "\nuse $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";

&dbcmd($dbproc, "select s.length, s.name, st.name,\n");
&dbcmd($dbproc, "       object_name(s.tdefault),\n");
&dbcmd($dbproc, "       object_name(s.domain)\n");
&dbcmd($dbproc, "from   $opt_d.dbo.systypes s, $opt_d.dbo.systypes st\n");
&dbcmd($dbproc, "where  st.type = s.type\n");
&dbcmd($dbproc, "and s.usertype > 100 and st.usertype < 100 and st.usertype != 18\n");
&dbsqlexec($dbproc);
&dbresults($dbproc);


while((@dat = &dbnextrow($dbproc)))
{
    print SCRIPT "sp_addtype $dat[1],";
    if ($dat[2] =~ /char|binary/)
    {
        print SCRIPT "'$dat[2]($dat[0])'";
    }
    else
    {
        print SCRIPT "$dat[2]";
    }
    print SCRIPT "\ngo\n";
				# Now remeber the default & rule for later.
    $urule{$dat[1]} = $dat[4] if defined($dat[4]);
    $udflt{$dat[1]} = $dat[3] if defined($dat[3]);
}

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 $opt_v;

&dbcmd($dbproc, "select o.name,u.name, o.id\n");
&dbcmd($dbproc, "from $opt_d.dbo.sysobjects o, $opt_d.dbo.sysusers u\n");
&dbcmd($dbproc, "where o.type = 'U' and o.name like '$opt_t' and u.uid = o.uid\n");
&dbcmd($dbproc, "order by o.name\n");

&dbsqlexec($dbproc);
&dbresults($dbproc);

while((@dat = &dbnextrow($dbproc)))
{
    $_ = join('@', @dat);	# join the data together on a line
    push(@tables,$_);		# and save it in a list
}


foreach (@tables)		# For each line in the list
{
    @tab = split(/@/, $_);

    print "Creating table $tab[0], owner $tab[1]\n" if $opt_v;

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

    &dbcmd($dbproc, "select Column_name = c.name, \n");
    &dbcmd($dbproc, "       Type = t.name, \n");
    &dbcmd($dbproc, "       Length = c.length, \n");
    &dbcmd($dbproc, "       Nulls = convert(bit, (c.status & 8)),\n");
    &dbcmd($dbproc, "       Default_name = object_name(c.cdefault),\n");
    &dbcmd($dbproc, "       Rule_name = object_name(c.domain)\n");
    &dbcmd($dbproc, "from   $opt_d.dbo.syscolumns c, $opt_d.dbo.systypes t\n");
    &dbcmd($dbproc, "where  c.id = $tab[2]\n");
    &dbcmd($dbproc, "and    c.usertype *= t.usertype\n");

    &dbsqlexec($dbproc);
    &dbresults($dbproc);

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

    print SCRIPT "\n\nCREATE TABLE $opt_d.$tab[1].$tab[0]\n ("; 
    $first = 1;
    while((@field = &dbnextrow($dbproc)))
    {
        print SCRIPT ",\n" if !$first;		# add a , and a \n if not first field in table
        
        print SCRIPT "\t$field[0] \t$field[1]";
        print SCRIPT "($field[2])" if $field[1] =~ /char|bin/;
        print SCRIPT " $nul[$field[3]]";
	
	$rule{"$tab[0].$field[0]"} = $field[5] if (defined($field[5]) && $urule{$field[1]} ne $field[5]);
	$dflt{"$tab[0].$field[0]"} = $field[4] if (defined($field[4]) && $udflt{$field[1]} ne $field[4]);;
        $first = 0 if $first;
        
    }
    print SCRIPT " )\n";

# now get the indexes...
#

    print "Indexes for table $tab[1].$tab[0]\n" if $opt_v;
    
    &dbcmd($dbproc, "sp_helpindex '$tab[1].$tab[0]'\n");

    &dbsqlexec($dbproc);
    &dbresults($dbproc);

    while((@field = &dbnextrow($dbproc)))
    {
        print SCRIPT "\nCREATE ";
        print SCRIPT "unique " if $field[1] =~ /unique/;
        print SCRIPT "clustered " if $field[1] =~ /^clust/;
        print SCRIPT "index $field[0]\n";
        @col = split(/,/,$field[2]);
        print SCRIPT "on $opt_d.$tab[1].$tab[0] (";
        $first = 1;
        foreach (@col)
        {
            print SCRIPT ", " if !$first;
            $first = 0;
            print SCRIPT "$_";
        }
        print SCRIPT ")\n";
    }

    &getPerms("$tab[1].$tab[0]");

    print SCRIPT "go\n";

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

    if($tab[1] ne 'dbo' && (keys(%dflt) || keys(%rule)))
    {
	print SCRIPT "/* The owner of the table is $tab[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 $tab[1].
*/";
	print LOG "Defaults/Rules for $tab[1].$tab[0] could not be bound\n";
    }

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

}

print "Done\n";


#
# 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);

&dbexit;


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

    &dbcmd($dbproc, "sp_helprotect '$obj'\n");
    &dbsqlexec($dbproc);

    $cnt = 0;
    while(($ret = &dbresults($dbproc)) != $NO_MORE_RESULTS && $ret != $FAIL)
    {
	while(@dat = &dbnextrow($dbproc))
	{
	    $act = 'to';
	    $act = 'from' if $dat[0] =~ /Revoke/;
	    print SCRIPT "$dat[0] $dat[1] on $obj $act $dat[2]\n";
	    ++$cnt;
	}
    }
    $cnt;
}

sub getObj
{
    local($objname, $obj) = @_;
    local(@dat, @items, @vi, $found);
    
    &dbcmd($dbproc, "select o.name, u.name, o.id\n");
    &dbcmd($dbproc, "from $opt_d.dbo.sysobjects o, $opt_d.dbo.sysusers u\n");
    &dbcmd($dbproc, "where o.type = '$obj' and o.name like '$opt_t' and u.uid = o.uid\n");
    &dbcmd($dbproc, "order by o.name\n");

    &dbsqlexec($dbproc);
    &dbresults($dbproc);

    while((@dat = &dbnextrow($dbproc)))
    {				# 
	$_ = join('@', @dat);	# join the data together on a line
	push(@items, $_);	# and save it in a list
    }

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

	&dbcmd($dbproc, "select text from syscomments where id = $vi[2]");
	&dbsqlexec($dbproc);
	&dbresults($dbproc);
	
	print SCRIPT
	    "/* $objname $vi[0], owner $vi[1] */\n";

	while(($text) = &dbnextrow($dbproc))
	{
	    if(!$found && $vi[1] ne 'dbo')
	    {
		++$found if($text =~ /$vi[1]/);
	    }
	    print SCRIPT $text;
	}
	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";
	}

    }
}