#!/usr/bin/perl -w
##############################################################################
#
# Script:   rserv_init.pl
#
# Author:   Grant McLean <grant@catalyst.net.nz>
#
# Description:
#
# Initialises the database tables and triggers required on a replication
# master.  Run this script with no arguments for a usage message.
#
# Note this script uses 'Pg', the native Postgres Perl API rather than DBD::Pg
# for compatibility with the standard RServ scripts.
#

use strict;
use Getopt::Std;
use Pod::Usage;

use Pg;

my $basedir;
BEGIN {
	$basedir = $0; $basedir =~ s#/[^/]+$##;
	unshift(@INC, "$basedir/../share");
}
#use lib '/usr/lib/postgresql/share/contrib/';

use RServ;


##############################################################################
#                   G L O B A L   V A R I A B L E S
##############################################################################

our $master_sql = "$basedir/master.sql";
our $slave_sql  = "$basedir/slave.sql";
our $db_changed = 0;


##############################################################################
# Parse command line arguments and handle errors
#

our %opt;
getopts('mst:h:u:p:o?', \%opt) or pod2usage(-exitstatus => 1, -verbose => 0);

pod2usage(-exitstatus => 0, -verbose => 2) if($opt{'?'});

unless(@ARGV) {
  pod2usage(
    -exitstatus => 1, -verbose => 0, 
    -message => 'You must specify the database name'
  );
}

my $cmd_count = 0;
foreach (qw(m s t)) { $cmd_count++ if exists $opt{$_}; }
if($cmd_count != 1) {
  print "$cmd_count\n";
  pod2usage(
    -exitstatus => 1, -verbose => 0, 
    -message =>
    'You must specify one of: -m for MASTER, -s for SLAVE or -t for TRIGGER'
  );
}

$opt{d} = shift(@ARGV);


##############################################################################
# Connect to database and 'do the business'
#

my $conn = db_connect();

if(exists $opt{t}) {
  toggle_app_triggers($conn, $opt{t});
  exit;
}

check_repl_tables($conn);
my %table_map = get_unique_columns($conn);
init_repl_tables($conn);

if($opt{m}) {
  init_repl_triggers($conn, %table_map);
}
elsif($opt{s}) {
  init_slave_tables($conn, %table_map);
  toggle_app_triggers($conn, 'off');
}

exit(0);



##############################################################################
#                        S U B R O U T I N E S
##############################################################################

sub abort {
  my($message) = @_;

  print "$message\nOperation aborted - ";
  if($db_changed) {
    print "warning: some updates were applied!\n";
  }
  else {
    print "no action taken\n";
  }
  exit(1);
}


##############################################################################
# Connect to database
#

sub db_connect {

  my $conn_str = "dbname=$opt{d}";

  $conn_str .= " host=$opt{h}"     if(defined($opt{h}));
  $conn_str .= " user=$opt{u}"     if(defined($opt{u}));
  $conn_str .= " password=$opt{p}" if(defined($opt{p}));


  my $conn = Pg::connectdb($conn_str);

  if(!ref($conn)  or  $conn->status != PGRES_CONNECTION_OK) {
    abort "Pg::connectdb($conn_str) failed.";
  }

  return $conn;
}


##############################################################################
# Determine whether replication structures have already been set up - bail out
# if they have and -o (overwrite) was not specified.
# 

sub check_repl_tables {
  my($conn) = @_;

  my $relname = $opt{m} ? '_rserv_tables_' : '_rserv_slave_tables_';

  my $result = $conn->exec(qq(
    select count(*) from pg_class where relname = '$relname'
  ));

  abort $conn->errorMessage if($result->resultStatus ne PGRES_TUPLES_OK);

  my($count) = $result->fetchrow;

  if($count > 0) {
    print "Replication structures have already been set up in this database";
    abort "" unless($opt{o});
    print " - Overwriting\n";
  }

}


##############################################################################
# Initialise replication structures.
# 

sub init_repl_tables {
  my($conn) = @_;

  print "Creating replication tables\n";

  my $sql_file = $opt{m} ? $master_sql : $slave_sql;

  local($/) = ';';
  local(*SQL);
  open(SQL, '<', $sql_file) or abort "open($sql_file) failed: $!";

  while(<SQL>) {
    s/\s*--.*$//mg;       # Strip comments
    s/(^\s+|\s+$)//sg;    # Strip leading+trainling whitespace
    next unless /\S/;     # Skip empty queries

    my $sql = $_;
    my $result = $conn->exec($sql);
    $db_changed = 1;

    if($result->resultStatus ne PGRES_COMMAND_OK) {
      if($sql !~ /^drop\b/i) {
        abort $conn->errorMessage . "\n$sql";
      }
    }
  }

}



##############################################################################
# For each table in the database, determine the name of the column that can be
# used as a unique identifier.  On success, returns a hash of table name to
# column name mappings.  Aborts on failure (ie: if a table has no unique
# column)
# 

sub get_unique_columns {
  my($conn) = @_;

  print "Determining unique column for each table\n";

  my $result = $conn->exec(qq(
    select relname
    from pg_class
    where relkind = 'r'
    and relname not like 'pg%'
    and relname not like '_rserv%'
    order by relname
  ));

  abort $conn->errorMessage if($result->resultStatus ne PGRES_TUPLES_OK);

  my @table_names = ();
  my($name);
  while(($name) = $result->fetchrow) {
    push @table_names, $name;
  }

  my %unique_key = ();
  my @unindexed  = ();
  foreach $name (@table_names) {
    $unique_key{$name} = find_unique_key($conn, $name);
    push @unindexed, $name unless($unique_key{$name});
  }

  if(@unindexed) {
    my $message =
         "The following table(s) have no unique column\n  " .
         join("\n  ", @unindexed);
    #abort $message;
    print $message, "\n";
  }

  return(%unique_key);
}


##############################################################################
# Initialise replication triggers.
# 

sub init_repl_triggers {
  my($conn, %unique_key) = @_;

  print "Creating replication triggers\n";

  my $cmnd = "$basedir/../bin/MasterAddTable";
  $cmnd .= " --masterhost=$opt{h}"     if($opt{h});
  $cmnd .= " --masteruser=$opt{u}"     if($opt{u});
  $cmnd .= " --masterpassword=$opt{p}" if($opt{p});
  $cmnd .= " $opt{d}";

  foreach my $name (sort keys %unique_key) {
    next unless $unique_key{$name};  # debugging only
    printf "  Table: %-28s  Column: %s\n", $name, $unique_key{$name} ;

    my $sql = qq(drop trigger _rserv_trigger_t_ on $name);
    my $result = $conn->exec($sql);

    system "$cmnd $name $unique_key{$name}\n";
  }

}


##############################################################################
# Insert rows into _rserv_slave_tables mapping table name to unique column 
# name.
# 

sub init_slave_tables {
  my($conn, %unique_key) = @_;

  print "Initialising slave tables\n";

  my $cmnd = "$basedir/../bin/SlaveAddTable";
  $cmnd .= " --slavehost=$opt{h}"     if($opt{h});
  $cmnd .= " --slaveuser=$opt{u}"     if($opt{u});
  $cmnd .= " --slavepassword=$opt{p}" if($opt{p});
  $cmnd .= " $opt{d}";

  foreach my $name (sort keys %unique_key) {
    next unless $unique_key{$name};  # debugging only
    printf "  Table: %-28s  Column: %s\n", $name, $unique_key{$name} ;
    system "$cmnd $name $unique_key{$name}\n";
  }

}


##############################################################################
# Enable/disable all application triggers - ie: triggers that are not used by
# RServ and are not PostgreSQL integrity constraints.
# 

sub toggle_app_triggers {
  my($conn, $flag) = @_;

  my $bool;
  if(lc($flag) eq 'on') {
    print "Enabling Application Triggers\n";
    $bool = 't';
  }
  elsif(lc($flag) eq 'off') {
    print "Disabling Application Triggers\n";
    $bool = 'f';
  }
  else {
    abort "Triggers can only be toggled to 'on' or 'off'";
  }

  my $sql = qq(
    update pg_trigger
    set tgenabled = '$bool'
    where not tgisconstraint
    and not tgname like 'pg%'
    and not tgname like '_rserv_%'
  );

  my $result = $conn->exec($sql);

  if($result->resultStatus ne PGRES_COMMAND_OK) {
    abort $conn->errorMessage . "\n$sql";
  }

}


##############################################################################
# For a given table name, returns the name of a column which has a unique
# index.  Dies if there is no unique index.
# 

sub find_unique_key {
  my($conn, $table) = @_;

  return 'replication_id' if(has_replication_id($conn, $table));

  my $result = $conn->exec(qq(
    select pgi.indkey
    from pg_class pgc, pg_index pgi
    where pgc.oid = pgi.indrelid
    and pgi.indisunique 
    and pgc.relname = '$table'
  ));

  abort $conn->errorMessage if($result->resultStatus ne PGRES_TUPLES_OK);

  my $att_num;
  my($keys, @key);
  while(($keys) = $result->fetchrow) {
    @key = split(/\s+/, $keys);
    next if(@key != 1);
    next if($key[0] < 1);
    $att_num = $key[0] unless(defined($att_num));
    $att_num = $key[0] if($key[0] < $att_num);
  }

  return unless defined($att_num);


  $result = $conn->exec(qq(
    select pga.attname
    from pg_class pgc, pg_attribute pga
    where pgc.oid = pga.attrelid
    and pgc.relname = '$table'
    and pgc.relkind = 'r'
    and attnum = $att_num
  ));

  abort $conn->errorMessage if($result->resultStatus ne PGRES_TUPLES_OK);

  my($att_name) = $result->fetchrow;
  
  abort "Error getting column name for $table.$att_num" unless($att_name);

  return $att_name;
}


##############################################################################
# For a given table name, returns true if the table has a column called 
# 'replication_id' or false otherwise.
# 

sub has_replication_id {
  my($conn, $table) = @_;

  my $result = $conn->exec(qq(
    select count(*)
    from pg_class pgc, pg_attribute pga
    where pgc.oid = pga.attrelid
    and pgc.relname = '$table'
    and pgc.relkind = 'r'
    and pga.attname = 'replication_id'
  ));

  abort $conn->errorMessage if($result->resultStatus ne PGRES_TUPLES_OK);

  my($count) = $result->fetchrow;
  
  return $count;

}


__END__

=head1 NAME

rserv_init.pl - Initialise structures for replication master or slave

=head1 SYNOPSIS

rserv_init.pl [options] (-m | -s | -t on/off) database

Options:

   -m           master mode
   -s           slave mode
   -t flag      turn application triggers 'on' or 'off'
   -h host      host where database should be created
   -u user      Postgres user which should create the database
   -p password  Postgres user's password
   -o           replace existing replication tables if present
   -?           detailed help message

=head1 DESCRIPTION

This script is used to prepare a database for replication using RServ.

It must be invoked with a database name and either '-m' to initialise
replication structures for a master or '-s' to initialise replication
structures for a slave.

Initialising a master will create the following tables and will also
create a trigger on every table to log updates:

 _rserv_tables_   stores name of unique column for each table
 _rserv_log_      tracks which rows of each table have been updated
 _rserv_servers_  details of slave servers (not used?)
 _rserv_sync_     tracks which updates have been seen by each slave

Initialising a slave will create the following tables:

 _rserv_slave_tables_ stores name of unique column for each table
 _rserv_slave_sync_   tracks which updates this slave has seen

=head1 OPTIONS

=over 4

=item B<-m>

Initialise structures for a replication MASTER.

=item B<-s>

Initialise structures for a replication SLAVE.

=item B<-t 'on' | 'off'>

Enable or disable application triggers (ie: all triggers that are not used by
RServ and are not PostgreSQL integrity constraints).

=item B<-h hostname>

Host on which database should be created (default is local host).

=item B<-u username>

Postgres user which should be used to create the database (defaults to current
user).

=item B<-p password>

Postgres user's password.

=item B<-o>

** WARNING ** This is a very dangerous option - do not enable it unless you
understand the implications.

This option causes the existing replication tables to be dropped and replaced
with new tables.  This is useful in testing but would have the effect of 
breaking the syncronisation with any slave(s).

=item B<-?>

Prints a detailed help message and exits.

=back

=cut