#!/usr/bin/perl
#
# $Id: genRepDefs.pl,v 1.3 2003/01/20 00:52:17 mpeppler Exp $
#
# genRepDefs.pl - a script to generate RepDefs and Subscriptions
# Michael Peppler, Nov 7 2002
#
# Based on
# GenRepDefs.pl, a script to generate RepDefs and Subscriptions for a 
# database. Ashu Joglekar, Oct 6th 1995. Hacked from 
# dbschema.pl	A script to extract a database structure from
#		a Sybase database
#------------------------------------------------------------------------------

use strict;

use Sybase::CTlib;
use Getopt::Long;

my @nul = ('NOT NULL','NULL');

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

my %opts;

GetOptions(\%opts, 'user=s', 'pwd=s', 'server=s', 'db=s',
	   'logical_source_server=s',
	   'logical_source_db=s',
	   'logical_target_server=s',
	   'logical_target_db=s',
	   'verbose', 'help');

my $usr                   = $opts{user} || 'sa';
my $pwd                   = $opts{pwd};
my $database              = $opts{db};
my $server                = $opts{server};
my $verbose               = $opts{verbose};
my $replicate             = $opts{logical_target_server};
my $rep_db                = $opts{logical_target_db};
my $logical_source_server = $opts{logical_source_server} || $opts{server};
my $logical_source_db     = $opts{logical_source_db} || $opts{db};
#my $materialize           = $opts{m};

usage() if($opts{help});
usage() unless($usr && $database && $server && $replicate && $rep_db);

#open(REPDEFS, "> $database.RepDefs") 
#    || die "Can't open $database.RepDefs: $!\n";
#open(SUBSCRIPTIONS, "> $database.Subscriptions") 
#    || die "Can't open $database.Subscriptions: $!\n";
open(LOG, "> $database.log") || die "Can't open $database.log: $!\n";

if(!$pwd) {
    print "\nPassword: ";
    system("stty -echo");
    chomp($pwd = <>);
    system("stty echo");
}

my %sub_files = ( DEF => "$database.subs.define.sql",
		  ACT => "$database.subs.activate.sql",
		  VAL => "$database.subs.validate.sql",
		  CHK => "$database.subs.check.sql",
		  DRP => "$database.subs.drop.sql");


my $dbh = Sybase::CTlib->new($usr, $pwd, $server);
$dbh->ct_sql("use $database");

print "\ngenRepDefs.pl on Database $database\n";

print LOG "Error log from genRepDefs.pl on Database $database on ", scalar(localtime), "\n\n";
print LOG "The following objects cannot be reliably created from the script in 
$database.{Repdef, Subscription}.
Please correct the script to remove any inconsistencies.\n\n";

foreach (values(%sub_files)) {
    rename($_, "$_.old");
}

my $tables = $dbh->ct_sql("
select o.name, u.name, o.id
from $database.dbo.sysobjects o, 
     $database.dbo.sysusers u
where o.type = 'U' 
  and u.uid = o.uid
order by o.name
");

if(mkdir('RepDefs', 0777) && $! != 17) {
    die "Can't create the RepDefs directory: $!";
}

foreach my $tab (@$tables) {
    genRepDef($dbh, $tab);
}

print "Done\n";

print "\nLooks like I'm all done!\n";
#close(REPDEFS);
#close(SUBSCRIPTIONS);
close(LOG);

exit;


sub genRepDef {
    my $dbh = shift;
    my $tab = shift;

    my @text;

    print "Processing table $tab->[0], owner $tab->[1]\n" if $verbose;

    open(REPDEFS, ">RepDefs/$tab->[0].$tab->[0]_repdef.sql") || die "Can't open RepDefs/$tab->[1].$tab->[0]_repdef.sql";
    
    print REPDEFS "/* Start of RepDef of table $$tab[1].$$tab[0]\n";
    print REPDEFS " * Generated by genRepDefs on ", scalar(localtime), " */\n\n";

    my $cols = $dbh->ct_sql("
select 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))
from   $database.dbo.syscolumns c, $database.dbo.systypes t
where  c.id = $$tab[2]
and    c.usertype = t.usertype
");


    print REPDEFS "\n\nCREATE REPLICATION DEFINITION $$tab[0]_repdef\n"; 
    print REPDEFS "with primary at $logical_source_server.$logical_source_db\n";
    print REPDEFS "with all tables named '$$tab[0]'\n(";
    my $first = 1;
    foreach my $field (@$cols) {
        print REPDEFS ",\n" if !$first; # add a , and a \n if not first field in table
        
	# Check if its an identity column
	if ( $$field[8] != 1 ) {	
	    print REPDEFS "\t\"$$field[0]\" \t$$field[1]";
	    print REPDEFS "($$field[2])" if $$field[1] =~ /char|bin/;
	    if($$field[1] =~ /text|image/) {
		print REPDEFS " $nul[$$field[5]]";
		push(@text, $$field[0]);
	    }
	    $first = 0 if $first;
	} else {
	    print REPDEFS "\t\"$$field[0]\" \tidentity";
	    $first = 0 if $first;
	}
    }
    print REPDEFS "\n)\n";

# now get the indexes so we can figure out the primary key
#
    print "Indexes for table $$tab[1].$$tab[0]\n" if $verbose;
    
    my $index_list = $dbh->ct_sql("sp_helpindex '$$tab[1].$$tab[0]'\n");

    my $foundPrimaryKey = 0;
    foreach my $index (@$index_list) {
	# Important !!!
	# Assume that the first unique index found is the primary key

	if ( $$index[1] =~ /unique/ )
	{
	    $foundPrimaryKey = 1;
	    my @col = split(/,/, $$index[2]);
	    print REPDEFS "\nprimary key (";
	    my $first = 1;
	    foreach (@col)
	    {
		print REPDEFS ", " if !$first;
		$first = 0;
		s/\s+//g;
		print REPDEFS "\"$_\"";
	    }
	    print REPDEFS ")\n";
	}
	last if $foundPrimaryKey; # Don't look for more if we've found one!
    }

    if ( $foundPrimaryKey != 1 )
    {
	print REPDEFS "/***** primary key can't be determined! *****/\n";
	print LOG "Error! Table $$tab[1].$$tab[0] has no primary key !!\n";
	print "Error! Table $$tab[1].$$tab[0] has no primary key !!\n" if $verbose;
    }

    # I like to replicate minimal columns. If you do this you cannot use 
    # non-atomic or bulk materialisation
    print REPDEFS "replicate minimal columns\n";
    if(@text) {
	print REPDEFS "replicate_if_changed (";
	print REPDEFS join(',', map "\"$_\"", @text);
	print REPDEFS ")\n";
    }
    print REPDEFS "go\n";
    close(REPDEFS);

    # Write out the define/activate/validate/check and drop subscription 
    # commands
    
    open(SUBS, ">>$sub_files{DEF}") || die "Can't open $sub_files{DEF}: $!";
    print SUBS "DEFINE SUBSCRIPTION $$tab[0]_sub\n";
    print SUBS "for $$tab[0]_repdef\n";
    print SUBS "with replicate at $replicate.$rep_db\n";
    print SUBS "\ngo\n";
    close(SUBS);
    open(SUBS, ">>$sub_files{ACT}") || die "Can't open $sub_files{ACT}: $!";
    print SUBS "ACTIVATE SUBSCRIPTION $$tab[0]_sub\n";
    print SUBS "for $$tab[0]_repdef\n";
    print SUBS "with replicate at $replicate.$rep_db\n";
    print SUBS "\ngo\n";
    close(SUBS);
    open(SUBS, ">>$sub_files{VAL}") || die "Can't open $sub_files{VAL}: $!";
    print SUBS "VALIDATE SUBSCRIPTION $$tab[0]_sub\n";
    print SUBS "for $$tab[0]_repdef\n";
    print SUBS "with replicate at $replicate.$rep_db\n";
    print SUBS "\ngo\n";
    close(SUBS);
    open(SUBS, ">>$sub_files{CHK}") || die "Can't open $sub_files{CHK}: $!";
    print SUBS "CHECK SUBSCRIPTION $$tab[0]_sub\n";
    print SUBS "for $$tab[0]_repdef\n";
    print SUBS "with replicate at $replicate.$rep_db\n";
    print SUBS "\ngo\n";
    close(SUBS);
    open(SUBS, ">>$sub_files{DRP}") || die "Can't open $sub_files{DRP}: $!";
    print SUBS "DROP SUBSCRIPTION $$tab[0]_sub\n";
    print SUBS "for $$tab[0]_repdef\n";
    print SUBS "with replicate at $replicate.$rep_db\n";
    print SUBS "without purge\n";
    print SUBS "\ngo\n";
    close(SUBS);
}


sub usage {
    die "Usage: $0 --server <name> --db <name> --user <sa> --pwd <pwd> --logical_target_server <name> --logical_target_db <db> [--verbose] [--logical_source_server <name>] [--logical_source_db <name>]\n";
}