This is dbschema.pl in view mode; [Download] [Up]
#! /usr/local/bin/sybperl
#
# @(#)dbschema.pl 1.3 6/24/92
#
#
# dbschema.pl A script to extract a database structure from
# a Sybase database
#
# Written by: Michael Peppler (mpeppler@itf.ch)
# Last Modified: 24 June 1992
#
# Usage: dbschema.pl -d database -o script.name -t pattern -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: %)
#
# -v turns on a verbose switch.
#
require 'sybperl.pl';
require 'getopts.pl';
require 'ctime.pl';
@nul = ('not null','null');
select(STDOUT); $| = 1; # make unbuffered
do Getopts('d:t:o:v');
$opt_d = 'master' unless $opt_d;
$opt_o = 'script.isql' unless $opt_o;
$opt_t = '%' unless $opt_t;
open(SCRIPT, "> $opt_o") || die "Can't open $opt_o: $!\n";
open(LOG, "> $opt_o.log") || die "Can't open $opt_o.log: $!\n";
#
# NOTE: We login to Sybase with the default (Unix) user id.
# We should probably login as 'SA', and get the passwd
# from the user at run time.
#
$dbproc = &dblogin;
&dbuse($dproc, $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 $dat[4] !~ /NULL/;
$udflt{$dat[1]} = $dat[3] if $dat[3] !~ /NULL/;
}
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 ($field[5] !~ /NULL/ && $urule{$field[1]} ne $field[5]);
$dflt{"$tab[0].$field[0]"} = $field[4] if ($field[4] !~ /NULL/ && $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(%rules)))
{
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;
$cnt = 0;
while(($ret = &dbresults) != $NO_MORE_RESULTS && $ret != $FAIL)
{
while(@dat = &dbnextrow)
{
$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;
&dbresults;
print SCRIPT
"/* $objname $vi[0], owner $vi[1] */\n";
while(($text) = &dbnextrow)
{
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";
}
}
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.