# genStoredProcs.pl generates sql script to create stored procedure(s) in sqlserver database.
# --don't need no stinkin SQL-DMO!
#
# Written 23-sep-2004 by frank brown http://www.inwa.net/~frog/
# Mod 25-may-2005, fgb: handle wildcard proc arg (e.g. '/proc=sp_tss_*') 
#
# How it works:
# ------------
# 1. lookup id for stored proc name in sysobjects
# 2. select ctext from syscomments where id = id retrieved in step 1
#
# NB:
# --
# 1. requires DSN for database on machine this script runs on.
# 2. sysobjects where xtype = 'P' == stored proc
# 3. run from account w db access

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

my $bDebug = 0;

my $sAppName = 'genStoredProcs';
my $sDatabase = "";
my $sDbi = 'dbi:ADO:';
my $bFirst = 1;
my $bIsWild = 0;
my $sLocalMachine = Win32::NodeName;
my $sMatch = "";
my $sNow = &ctime(time); chop $sNow;
my $sProc = "";
my $sProcId = "";
my @procIds;
my $sServer = "";
my $bSingleFile = 0;
my $term = Term::ReadLine->new($sAppName);
my $sText = "";
my $nTotal = 0;
my $bVerbose = 0;
my $sVersion = "1.1";

_main:

ParseCmdArgs();

if (length($sDatabase) < 1) { errExit("missing database name"); }
if (length($sProc) < 1) { errExit("missing stored procedure name"); }

$sDbi .= $sDatabase;

if ($sProc eq '*') {
  getAllProcIds();
  $n = @procIds;
  if ($n > 3) {
    if ($bSingleFile || userSaysYes("are you sure you want to create $n scripts?")) {
      foreach $id (@procIds) { 
        getTextFromDb($id);
        if (length($sText) > 1) { writeScript(); $sText = ""; }
        }
      }
    } 
  }
elsif ($sProc =~ /\*/) { 
  $bIsWild = 1;
  getWildProcIds();
  $n = @procIds;
  if ($n > 0) {
    if ($bSingleFile || userSaysYes("are you sure you want to create $n scripts?")) {
      foreach $id (@procIds) { 
        getTextFromDb($id);
        if (length($sText) > 1) { writeScript(); $sText = ""; }
        }
      }
    } 
  }
else {
  getIdForSp($sProc);
  getTextFromDb($sProcId);
  if (length($sText) > 1) { writeScript(); }
  }

print "\nRetrieved $nTotal stored procedure";
if ($nTotal != 1) { print 's'; }
print ".\n";

# 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 $s = "";
  my $sSql = "SELECT 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) { 
      $sProcId = $hRow->{id};
      if ($bDebug) { print "dbg: pushing $sProcId to procids list\n"; }
      push(@procIds,$sProcId);
      ++$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 getWildProcIds {	# in work
  my $dbh;
  my $hRow;
  my $i = 0;
  my $n = index($sProc,"*");
  if ($n == -1) { errExit("invalid wildcard spec"); }
  $sMatch = substr($sProc,0,$n);
  if ($bDebug) { print "dbg: getWildProcIds will look for $sMatch*\n"; }
  my $rc;
  my $rv;
  my $s = "";
  my $sSql = "SELECT id FROM sysobjects WHERE xtype = 'P' AND status >= 0 AND substring(name,1,$n) = '$sMatch'";
  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) { 
      $sProcId = $hRow->{id};
      if ($bDebug) { print "dbg: pushing $sProcId to procids list\n"; }
      push(@procIds,$sProcId);
      ++$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 getIdForSp {
  my $dbh;
  my $hRow;
  my $rc;
  my $rv;
  my $s = "";
  my $sSql = "SELECT id FROM sysobjects WHERE xtype = 'P' AND name=";
  my $sth;

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

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

sub getTextFromDb {
  my $dbh;
  my $hRow;
  my $i = 0;
  my $rc;
  my $rv;
  my $s = "";
  my $sSql = 'SELECT ctext FROM syscomments WHERE status = 2 AND id=';
  my $sth;

  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:

  $spid = @_[0];
  $sSql .= $spid;
  if ($bDebug) { print "dbg: $sSql\n"; }
  $sth = $dbh->prepare($sSql);
  $rc = $sth->execute();
  if ($rc) { 
    ($hRow) = $sth->fetchrow_hashref();
    while ($hRow) {
      $s = $hRow->{ctext};
#      $s =~ s/\r\r/\r/g;			### doesn't work?!
      $sText .= $s;
      ++$i;
      if ($bDebug) { print "dbg: ($i rows) $s\n"; }
      ($hRow) = $sth->fetchrow_hashref();
      }
      $nTotal++; 
    }

  $sth->finish();
  $rc = $dbh->disconnect;
#  $sText =~ s/\x0d\x0d\x0a/\x0d\x0a/g;		### doesn't work?!
  }

sub Help() {
  print "\n$sAppName $sVersion generates sql script(s) to create stored procs.\n";
  print "Written 23-Sep-2004 by Frank Brown.\n";
  print "\nusage: $sAppName /database=myDatabase /proc={myProc | *} [/singleFile]\n";
  print "\n/proc=* gets all the stored procedures in the database.\n";
  print "/singleFile writes all stored procedures to one (potentially huge) file.\n";
}

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 = substr($_,1,3);			# parse 1st 3 chars:
      $arg =~ s/[A-Z]/[a-z]/;
      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 "pro") {  
        $i = index($_,"=");
        $i++;
        while (substr($_,$i,1) eq ' ') { ++$i; }
        $sProc = sprintf("%s",substr($_,$i));
        }
      if ($arg eq "sin") { $bSingleFile = 1; }
      if ($arg eq "ver") { $bVerbose = 1; }
      if (($arg eq "hel") || (substr($arg,0,1) eq "?")) {
        &Help();
	exit;
        }
      }
    else {					# not a switch
      if (/^[\\]/) {				# single machine (UNC)
        s/\s(.*)//;				# remove whitespace
        s/^\\\\//;				# remove leading \\
        }
      $sServer = $_;
      }
    }
  if ($bDebug) { 
    $bVerbose = 1; 
    print "dbg: server=$sServer db=$sDatabase sp=$sProc single=$bSingleFile\n";
    }
}

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;
}

sub writeScript {
  my $sScript;
  my $outFile;
  if (! $bSingleFile) { 
    $sScript = "mk_$sProc.sql";
    $outFile = ">" . $sScript; 
    }
  elsif ($bIsWild) {
    $sScript = "mk_$sDatabase" . "_" . $sMatch . "_procs.sql";
    if ($bFirst && -e $sScript) { $sOld = $sScript . "-old"; rename $sScript,$sOld; }
    $outFile = ">>" . $sScript; 
    }
  else { 
    $sScript = "mk_$sDatabase" . "_AllStoredProcs.sql";
    if ($bFirst && -e $sScript) { $sOld = $sScript . "-old"; rename $sScript,$sOld; }
    $outFile = ">>" . $sScript; 
    }
  if (!open(LST,$outFile)) { print "can't write script file $sScript: $!"; return; }
  if (! $bSingleFile || ($bFirst)) {
    print LST "/**********************************************************************\n";
    print LST " $sScript generated $sNow by $sAppName $sVersion\n";
    print LST "***********************************************************************/\n\n";
    }
  else { print LST "\n"; }
  if ($bSingleFile && $bFirst) {   
    my $n = @procIds;
    print LST "/* CREATE scripts for $n stored procedures in $sDatabase: */\n\n";
    }
  print LST $sText;
  if (! $bSingleFile) { print LST "\n/*** end of file $sScript ***/\n"; }
  else { print LST "\nGO\n"; }
  close LST;

  if ((! $bSingleFile) || ($bSingleFile && $bFirst)) { print "Created script $sScript\n"; }
  
  $bFirst = 0;
}

__END__