# genSchema.pl generates schema for specified sql database.
# Adapted from genStoredProcs.pl (generates sql script for stored procedures).
#
# Written 21-sep-2006 by fgb (a month for sql scripts).
#
# Discovery: INFORMATION_SCHEMA is sql standard way to get schema information!
#
# How it works:
# ------------
# for each user table in database (by id) {
#   select name,xtype,length from syscolumns where id = user table id
#   select name from systypes where xtype = syscolumns.xtype
#   select name from sysobjects 
#     where xtype == 'PK' || xtype == 'F' AND sysobject.parent_obj == user table id
#   print col name, type, length, keyname (if exists)
#   }
# for each stored proc in database { print text }
# for each view in database { print same info as table }
#
# NB:
# --
# 1. requires DSN for database on machine this script runs on.
# 2. sysobjects where xtype = 'P'  == stored proc
# 3. sysobjects where xtype = 'U'  == user table
# 4. sysobjects where xtype = 'PK' == primary key
# 5. sysobjects where xtype = 'F'  == foreign key
# 6. sysobjects where xtype = 'TR' == trigger
# 7. sysobjects where xtype = 'V'  == view
# 8. sysobjects.parent_obj == id of parent object (for example, table id if trigger or constraint)
# 9. syscolumns.id == id of table this column belongs to (or stored proc)
# 10. syscolumns.name == column name
# 11. syscolumns.xtype == systypes.xtype (physical storage type)
# 12. syscolumns.length == max length
# 13. systypes.name == datatype name

require "ctime.pl";
use DBI;
use Term::ReadLine;

my $bDebug = 0;

my $sAppName = 'genSchema';
my $sDatabase = "";
my $sDbi = 'dbi:ADO:';
my $bFirst = 1;
my $bListOnly = 0;
my $sLocalMachine = Win32::NodeName;
my $sNow = &ctime(time); chop $sNow;
my $sObj = "";
my $sOutFile = "";
my $bOutputToFile = 0;
my $sProc = "";
my $sProcId = "";
my %procs;
my $nSpCount = 0;
my $sServer = "";
my $sTable = "";
my %tables;
my $nTableCount = 0;
my $term = Term::ReadLine->new($sAppName);
my $sText = "";
my $nTotal = 0;
my $bVerbose = 0;
my $sVersion = "1.0";
my $sView = "";
my $sViewId = "";
my @viewIds;
my $TABLE_T = 'U';
my $VIEW_T = 'V';

_main:

ParseCmdArgs();

if (length($sDatabase) < 1) { errExit("missing database name"); }
#if (length($sObj) < 1) { errExit("missing db object name"); }

$sDbi .= $sDatabase;

if (length($sOutFile) > 0) {
  open(HOUT,">$sOutFile") or die "Can't open output file $sOutFile: $!";
  }

&output("/**********************************************************************\n");
&output(" $sDatabase schema generated $sNow by $sAppName $sVersion\n");
&output("***********************************************************************/\n\n");

if ($sTable ne "") { processTables(); &output("\nProcessed $nTableCount table"); &pluralPrint($nTableCount); }
elsif ($sProc ne "") { processProcs(); &output("\nProcessed $nSpCount stored proc"); &pluralPrint($nSpCount); }
elsif ($sView ne "") { processViews(); &output("\nProcessed $nTableCount view"); &pluralPrint($nTableCount); }
else {  				# full schema (all objects):
  $sTable ='*';
  processTables();
  print "\nProcessed $nTableCount table"; &pluralPrint($nTableCount); print "\n\n";
  $sProc = '*';
  processProcs();
  print "\nProcessed $nSpCount stored proc"; &pluralPrint($nSpCount); print "\n\n";
  $sView = '*';
  processViews();
  print "\nProcessed $nTableCount view"; &pluralPrint($nTableCount); print "\n\n";
  }

if (defined(HOUT)) { close(HOUT); }


# subroutines:

sub errExit {
  my $s = "Error: " . @_[0];

  print "$s\n";
  print "$sAppName terminated\n";
  exit;
  }

sub getAllProcIds {
  my $dbh;
  my $hRow;
  my $i = 0;
  my $rc;
  my $rv;
  my $s1,$s2;
  my $sSql = "SELECT name,id FROM sysobjects WHERE xtype = 'P' AND status >= 0";
  my $sth;

  $dbh = DBI->connect($sDbi,undef,undef) || die "\nCan't connect to $sDbi: $DBI::errstr\nIs DSN for $sDatabase configured correctly?\n";

  if ($bDebug) { print "dbg: $sSql\n"; }
  $sth = $dbh->prepare($sSql);
  $rc = $sth->execute();
  if ($rc) { 
    ($hRow) = $sth->fetchrow_hashref();
    while ($hRow) { 
      $s1 = $hRow->{id}; $s2 = $hRow->{name};
      if ($bDebug) { print "dbg: pushing $s2 to procs hash\n"; }
      $procs{$s1} = $s2;
      ++$i;
      ($hRow) = $sth->fetchrow_hashref();
      }
    }
  $sth->finish();
  $rc = $dbh->disconnect;
  
  if ($bDebug) { print "dbg: retrieved $i procids\n"; }
  if ($i < 1) { errExit("can't get proc ids"); }
  else { return $i; }
}

sub getAllTableIds {			# used for views too
  my $sTypeCode = @_[0];
  my $dbh;
  my $hRow;
  my $i = 0;
  my $rc;
  my $rv;
  my $s = "";
  my $sSql = "SELECT name,id FROM sysobjects WHERE xtype = '$sTypeCode' AND status >= 0";
  my $sth;

  $dbh = DBI->connect($sDbi,undef,undef) || die "\nCan't connect to $sDbi: $DBI::errstr\nIs DSN for $sDatabase configured correctly?\n";

  if ($bDebug) { print "dbg: $sSql\n"; }
  $sth = $dbh->prepare($sSql);
  $rc = $sth->execute();
  if ($rc) { 
    ($hRow) = $sth->fetchrow_hashref();
    while ($hRow) { 
      $s1 = $hRow->{id}; $s2 = $hRow->{name};
      if ($bDebug) { print "dbg: adding $s2 to tables hash\n"; }
      $tables{$s1} = $s2;
      ++$i;
      ($hRow) = $sth->fetchrow_hashref();
      }
    }
  $sth->finish();
  $rc = $dbh->disconnect;
  
  if ($bDebug) { print "dbg: retrieved $i table ids\n"; }
  if ($i < 1) { errExit("can't get table ids"); }
  else { return $i; }
}

sub getTableId {
  my $sTableName = @_[0];
  my $sCode = @_[1];
  my $sId = "";
  my $dbh;
  my $hRow;
  my $rc;
  my $rv;
  my $s = "";
  my $sSql = "SELECT id FROM sysobjects WHERE xtype = '$sCode' AND name='$sTableName'";
  my $sth;

  $dbh = DBI->connect($sDbi,undef,undef) || die "\nCan't connect to $sDbi: $DBI::errstr\nIs DSN for $sDatabase configured correctly?\n";

  if ($bDebug) { print "dbg: $sSql\n"; }
  $sth = $dbh->prepare($sSql);
  $rc = $sth->execute();
  if ($rc) { 
    ($hRow) = $sth->fetchrow_hashref();
    if ($hRow) { $sId = $hRow->{id}; }
    }
  $sth->finish();
  $rc = $dbh->disconnect;
  
  if ($bDebug) { print "dbg: tableid=$sId\n"; }
  if (length($sId < 1)) { errExit("can't get id for $sTableName"); } 

  return $sId;
}

sub getIdForSp {
  my $sId = "";
  my $dbh;
  my $hRow;
  my $rc;
  my $rv;
  my $s = @_[0];
  my $sSql = "SELECT id FROM sysobjects WHERE xtype = 'P' AND name='$s'";
  my $sth;

  $dbh = DBI->connect($sDbi,undef,undef) || die "\nCan't connect to $sDbi: $DBI::errstr\nIs DSN for $sDatabase configured correctly?\n";

  if ($bDebug) { print "dbg: $sSql\n"; }
  $sth = $dbh->prepare($sSql);
  $rc = $sth->execute();
  if ($rc) { 
    ($hRow) = $sth->fetchrow_hashref();
    if ($hRow) { $sId = $hRow->{id}; }
    }
  $sth->finish();
  $rc = $dbh->disconnect;
  
  if ($bDebug) { print "dbg: procid=$sId\n"; }
  if (length($sId < 1)) { errExit("can't get id for $s"); }

  return $sId;
}

sub Help() {
  print "\n$sAppName $sVersion generates schema from sql database.\n";
  print "Written 22-Sep-2006 by Frank Brown.\n";
  print "\nusage: $sAppName /database=myDatabase [/table={myTable | *} | /proc={myProc | *} | /view={myView | *}] [/nodetail] [/output=myFile]\n";
  print "\n* lists all the specified objects in the database.\n";
  print "If no objects are specified, all tables, views and stored procs are listed.\n";
  print "/nodetail means just list objects without their definitions.\n";
  print "/output lets you redirect output to a specified file.\n";
}

sub output() {
  if ($bOutputToFile && defined(HOUT)) { print HOUT "@_[0]"; }
  else { print "@_[0]"; }
}

sub ParseCmdArgs {
  my $arg;
  my $i;

  if ($#ARGV < 1) { Help(); exit; }
  while (@ARGV) {
    $_ = shift @ARGV;
    if ($bDebug) { print "dbg: parsing $_\n"; }
    if (/^[\/\-]/) {				# is arg a switch?
      $arg = lc(substr($_,1,3));		# parse 1st 3 chars:
      if ($arg eq "deb") { $bDebug = 1; }
      if ($arg eq "dat") {  
        $i = index($_,"=");
        $i++;
        while (substr($_,$i,1) eq ' ') { ++$i; }
        $sDatabase = sprintf("%s",substr($_,$i));
        }
      if ($arg eq "nod") { $bListOnly = 1; }
      if ($arg eq "out") {
        $i = index($_,"=");
        $i++;
        while (substr($_,$i,1) eq ' ') { ++$i; }
        $sOutFile = sprintf("%s",substr($_,$i));
	$bOutputToFile = 1;
        }
      if ($arg eq "pro") {  
        $i = index($_,"=");
        $i++;
        while (substr($_,$i,1) eq ' ') { ++$i; }
        $sProc = sprintf("%s",substr($_,$i));
        }
      if ($arg eq "tab") { 
        $i = index($_,"=");
        $i++;
        while (substr($_,$i,1) eq ' ') { ++$i; }
        $sTable = sprintf("%s",substr($_,$i));
        }
      if ($arg eq "ver") { $bVerbose = 1; }
      if ($arg eq "vie") { 
        $i = index($_,"=");
        $i++;
        while (substr($_,$i,1) eq ' ') { ++$i; }
        $sView = sprintf("%s",substr($_,$i));
        }
      if (($arg eq "hel") || (substr($arg,0,1) eq "?")) {
        &Help();
	exit;
        }
      }
    else {					# not a switch
      Help();
      exit;
      }
    }
  if ($bDebug) { 
    $bVerbose = 1; 
    print "dbg: db=$sDatabase sp=$sProc table=$sTable";
    if (length($sOutFile) > 0) { print " outfile=$sOutFile"; }
    print "\n";
    }
}

sub pluralPrint {
if (@_[0] != 1) { &output('s'); }
}

sub processOneProc {
  my $sId = getIdForSp(@_[0]);			# arg is proc name
  #else { $sId = @_[0]; }
  my $dbh;
  my $hRow;
  my $i = 0;
  my $rc;
  my $rv;
  my $sSql = "SELECT ctext FROM syscomments WHERE status = 2 AND id='$sId'";
  my $sth;
  my $sText = "";

  if ($bListOnly) { 
    if ($sProc ne '*') { &output("$sProc\n"); }
    else { &output("@_[0]\n"); }
    return;
    }

  if ($bVerbose) { print "Connecting to database $sDatabase...\n"; }

  $dbh = DBI->connect($sDbi,undef,undef) || die "\nCan't connect to $sDbi: $DBI::errstr\n Is DSN for $sDatabase configured correctly?\n";
  
  # prepare SQL statement, then execute it:

  if ($bDebug) { print "dbg: $sSql\n"; }
  $sth = $dbh->prepare($sSql);
  $rc = $sth->execute();
  if ($rc) { 
    $hRow = $sth->fetchrow_hashref();			# entire proc def is returned in 1 row
    if ($hRow) {
      $sText = ($hRow->{ctext});
      $sText =~ s/\x0D\x0D/\x0D/g;			# replace double x0d chars with single char *** doesn't work!?*
      $sText =~ s/\n\n/\n/g;			# replace double newline with single newline *** doesn't work!?*
      $sText =~ s/\r\r/\r/g;			# replace double return with single return *** doesn't work!?*
      if ($bDebug) { print "dbg: ctext='$sText'\n"; }
      }
    $nSpCount++; 
    &output("$sText\n");
    }

  $sth->finish();
  $rc = $dbh->disconnect;

  if (defined(HOUT)) { print '.'; }
}

sub processOneTable {
  my $sTableName = @_[0];
  my $sCode = @_[1];
  my $sId = &getTableId($sTableName,$sCode); 
  my $sSql = "select column_name,data_type,character_maximum_length,is_nullable,ORDINAL_POSITION from information_schema.columns where table_name = '@_[0]'";
  $sSql .= " ORDER BY ORDINAL_POSITION";
  #my $sSql = "select c.name,t.name type,c.length,c.isnullable from syscolumns c,systypes t where c.id = '$sId' and c.xtype = t.xtype";
  my $s1,$s2,$s3,$s4;

  if ($bListOnly) { &output("$sTableName\n"); return; }

  if ($bVerbose) { print "Connecting to database $sDatabase...\n"; }

  $dbh = DBI->connect($sDbi,undef,undef) || die "\nCan't connect to $sDbi: $DBI::errstr\n Is DSN for $sDatabase configured correctly?\n";
  
  # prepare SQL statement, then execute it:

  if ($bDebug) { print "dbg: $sSql\n"; }
  $sth = $dbh->prepare($sSql);
  $rc = $sth->execute();
  if ($rc) { 
    ($hRow) = $sth->fetchrow_hashref();
    if ($sCode eq $TABLE_T) { &output("TABLE $sTableName (\n"); }
    if ($sCode eq $VIEW_T) { &output("VIEW $sTableName (\n"); }
    while ($hRow) {
      #$s1 = $hRow->{name}; $s2 = $hRow->{type}; $s3 = $hRow->{length};
      $s1 = $hRow->{column_name}; $s2 = $hRow->{data_type}; $s3 = $hRow->{character_maximum_length};
      &output("$s1 $s2 ");
      if ($s2 =~ /char/) { &output("($s3) "); }
      if ($bDebug) { &output("dbg: nullable=$s4\n"); }
      if ($s4 eq '0') { &output("NOT "); }
      &output("NULL\n");
      ++$i;
      ($hRow) = $sth->fetchrow_hashref();
      }
    &output(")\n\n");
    if ($bDebug) { print "dbg: ($i rows) $s\n"; }
    }
  $sth->finish();
  $rc = $dbh->disconnect;

  ++$nTableCount;
  if (defined(HOUT)) { print '.'; }
}

sub processProcs {
  my $s = "";

  if ($sProc eq '*') {
    getAllProcIds();
    @vals = sort (values %procs);
    foreach $s (@vals) { 
      if ($bDebug) { print "dbg: val=$s\n"; } 
      processOneProc($s); 
      }	
    }
  else { processOneProc($sProc); }				# arg is name
}

sub processTables {
  my $s = "";

  if ($sTable eq '*') {
    getAllTableIds($TABLE_T);
    @vals = sort (values %tables);
    foreach $s (@vals) { processOneTable($s,$TABLE_T); }
    }
  else { processOneTable($sTable,$TABLE_T); }
}

sub processViews {			# views look a lot like tables
  my $s = "";

  if ($sView eq '*') {
    getAllTableIds($VIEW_T);
    @vals = sort (values %tables);
    foreach $s (@vals) { processOneTable($s,$VIEW_T); }
    }
  else { processOneTable($sView,$VIEW_T); }

}

sub userSaysYes {
  my $sMsg = @_[0];
  my $ans = 0;
  my $sInput = $term->readline("$sMsg (y/n): ");
  if (lc(substr($sInput,0,1)) eq 'y') { $ans = 1; }

  return $ans;
}

__END__