Tryag File Manager
Home
-
Turbo Force
Current Path :
/
proc
/
self
/
root
/
usr
/
share
/
doc
/
perl-DBD-Sybase-1.08
/
eg
/
Upload File :
New :
File
Dir
//proc/self/root/usr/share/doc/perl-DBD-Sybase-1.08/eg/dbschema.pl
#!/usr/local/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"; }