#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-

## Script to control Bucardo
##
## Copyright 2006-2011 Greg Sabino Mullane <greg@endpoint.com>
##
## Please see http://bucardo.org/ for full documentation

package bucardo_ctl;
use strict;
use warnings;
use 5.008003;
use DBI;
use IO::Handle;
use Getopt::Long;
Getopt::Long::Configure(qw/no_ignore_case/);
use Time::HiRes 'sleep';
use POSIX qw/ceil setsid/;
use Data::Dumper 'Dumper';
$Data::Dumper::Indent = 1;

return 1 if $ENV{BUCARDO_CTL_TEST};

our $VERSION = '4.4.6';

*STDOUT->autoflush(1);
*STDERR->autoflush(1);

use vars qw/$dbh $SQL $sth %sth $count $info %global/;

my $DATEFORMAT       = q{Mon DD, YYYY HH24:MI:SS};
my $DEFAULT_DAYSBACK = 3;
my $WAITSLEEP        = 1;
my $PROGRESS         = 1;

my $progname = $0;
if (exists $ENV{PATH} and $progname =~ m{(.+)/(.+)}) {
    my ($base, $name) = ($1,$2);
    for my $seg (split /\:/ => $ENV{PATH}) {
        if ($seg eq $base) {
            $progname = $name;
            last;
        }
    }
}

help() unless @ARGV;

## Default arguments - most are for the bc constructor
my $bcargs = {
              quiet        => 0,
              verbose      => 0,
              bcverbose    => 1,
              dbname       => 'bucardo',
              dbuser       => 'bucardo',
              dbpass       => '',
              sendmail     => 0,
              extraname    => '',
              debugfilesep => 0,
              debugdir     => '.',
              debugname    => '',
              debugsyslog  => 1,
              debugfile    => 1,
              cleandebugs  => 0,
          };

## These options must come before the GetOptions call
for my $arg (@ARGV) {
    if ($arg eq '--no-bucardorc') {
        $bcargs->{'no-bucardorc'} = 1;
    }
    if ($arg =~ /--bucardorc=(.+)/) {
        $bcargs->{'bucardorc'} = $1;
    }
    if ($arg =~ /^-+\?$/) {
        help();
    }
}

## Values are first read from a .bucardorc, either in the current dir, or the home dir.
## These will be overwritten by command-line args.
my $file;
if (! $bcargs->{'no-bucardorc'}) {
    if ($bcargs->{bucardorc}) {
        -e $bcargs->{bucardorc} or die qq{Could not find the file "$bcargs->{bucardorc}"\n};
        $file = $bcargs->{bucardorc};
    }
    elsif (-e '.bucardorc') {
        $file = '.bucardorc';
    }
    elsif (-e "$ENV{HOME}/.bucardorc") {
        $file = "$ENV{HOME}/.bucardorc";
    }
    elsif (-e '/etc/bucardorc') {
        $file = '/etc/bucardorc';
    }
}
if (defined $file) {
    open my $rc, '<', $file or die qq{Could not open "$file": $!\n};
    while (<$rc>) {
        next if /^\s*#/;
        next unless /^\s*(\w+)\s*=\s*(.+?)\s*$/o;
        my ($name,$value) = ($1,$2); ## no critic (ProhibitCaptureWithoutTest)
        $bcargs->{$name} = $value;
    }
    close $rc or die;
}

GetOptions ## no critic (ProhibitCallsToUndeclaredSubs)
    ($bcargs,
     'verbose+',
     'vv',
     'quiet+',
     'notimer',
     'help',
     'debug',
     'version',
     'daysback=i',
     'sort=i',
     'showdays',
     'compress',
     'retry=i',
     'retrysleep=i',

     ## These are sent to the constructor:
     'bcverbose',
     'dbport=i',
     'dbhost=s',
     'dbname=s',
     'dbuser=s',
     'dbpass=s',
     'sendmail=i',
     'extraname=s',
     'debugfilesep',
     'debugname=s',
     'debugsyslog=i',
     'debugdir=s',
     'debugfile=i',
     'cleandebugs=i',

     ## Used internally
     'schema|n=s@',
     'exclude-schema|N=s@',
     'table|t=s@',
     'exclude-table|T=s@',
     'db=s',
     'herd=s',
     'piddir=s',
     ## These two already handled above, but need to be here so GetOptions is happy:
     'bucardorc=s',
     'no-bucardorc',

) or die "\n";

my $QUIET = delete $bcargs->{quiet};

help() if $bcargs->{help};

if ($bcargs->{version}) {
    print "bucardo_ctl version $VERSION\n";
    exit 0;
}

$bcargs->{vv} and $bcargs->{verbose} = 2;
my $VERBOSE    = delete $bcargs->{verbose};
my $DEBUG      = delete $bcargs->{debug} || 0;
my $DAYSBACK   = delete $bcargs->{daysback} || $DEFAULT_DAYSBACK;
my $COMPRESS   = delete $bcargs->{compress};
my $SHOWDAYS   = delete $bcargs->{showdays} || 1;
my $RETRY      = delete $bcargs->{retry} || 0;
my $RETRYSLEEP = delete $bcargs->{retrysleep} || 0;
my $NOTIMER    = delete $bcargs->{notimer} || 0;

my $DBCONN = "User: $bcargs->{dbuser}  Database: $bcargs->{dbname}";
$bcargs->{dbhost} and length $bcargs->{dbhost} and $DBCONN .= "  Host: $bcargs->{dbhost}";
$bcargs->{dbport} and length $bcargs->{dbport} and $DBCONN .= "  Port: $bcargs->{dbport}";

## Anything left over is the verb and noun(s)

my $verb = shift || '';
help() unless $verb;
$verb = lc $verb;
my @nouns = @ARGV;
my $nouns = join ' ' => @nouns;

## Installation must happen before we try to connect!
install() if $verb eq 'install';

## Grab current information from the bucardo_config file
my $DSN = "dbi:Pg:dbname=$bcargs->{dbname}";
$bcargs->{dbhost} and length $bcargs->{dbhost} and $DSN .= ";host=$bcargs->{dbhost}";
$bcargs->{dbport} and length $bcargs->{dbport} and $DSN .= ";port=$bcargs->{dbport}";
$dbh = DBI->connect($DSN, $bcargs->{dbuser}, $bcargs->{dbpass}, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
$dbh->do('SET search_path = bucardo');
$dbh->commit();

my $REASONFILE = get_config('reason_file') or die "Invalid reason_file!\n";
my $PIDDIR     = get_config('piddir') or die "Invalid piddir!\n";
my $pidfile    = 'bucardo.mcp.pid';
my $stopfile   = get_config('stopfile') or die "Invalid stopfile!\n";

my $PIDFILE        = "$PIDDIR/$pidfile";
my $REASONFILE_LOG = "$REASONFILE.log";
my $STOPFILE       = "$PIDDIR/$stopfile";

## Handle all the verbs
status_all()    if $verb eq 'status' and ! @nouns;
status_detail() if $verb eq 'status';
restart()       if $verb eq 'restart';
start()         if $verb eq 'start';
stop()          if $verb eq 'stop';
reload_config() if $verb eq 'reload_config';
reload()        if $verb eq 'reload';
ping()          if $verb eq 'ping';
add_item()      if $verb eq 'add';
remove_item()   if $verb eq 'remove' or $verb eq 'delete';
upgrade()       if $verb eq 'upgrade';
message()       if $verb eq 'message';
list()          if $verb eq 'list' or $verb eq 'l';
config()        if $verb eq 'set' or $verb eq 'show' or $verb eq 'config';
validate()      if $verb eq 'validate';
update()        if $verb eq 'update';
inspect()       if $verb eq 'inspect';
superhelp()     if $verb eq 'help';

if ($verb ne 'kick' and $verb ne 'activate' and $verb ne 'deactivate') {
    help();
}

## For the rest, we expect a list of syncs with an optional decimal "timeout"
my $adverb;
my $syncs = get_syncs();
my @syncs;
my $gotall = 0;
my @allvars;
SYNCMATCH: for my $sync (@nouns) {
    if ($sync =~ /^\d+$/) {
        $adverb = $sync;
        next SYNCMATCH;
    }

    if ($sync eq 'all') { ## All proceeding nouns are treated special!
        $gotall = 1;
        next SYNCMATCH;
    }

    if ($gotall) {
        push @allvars => $sync;
        next;
    }

    if ($sync =~ /%/) {
        $SQL = qq{SELECT name FROM bucardo.sync WHERE name LIKE '$sync'};
        my $tmp = $dbh->selectall_arrayref($SQL);
        push @syncs, (map { $_->[0] } @$tmp);
        next SYNCMATCH;
    }
    if ($sync =~ /^\*(\w+)\*$/) {
        $SQL = qq{SELECT name FROM bucardo.sync WHERE name ~ '$1'};
        my $tmp = $dbh->selectall_arrayref($SQL);
        push @syncs => map { $_->[0] } @$tmp;
        next SYNCMATCH;
    }
    if ($sync =~ /^\*(\w+)$/) {
        $SQL = qq{SELECT name FROM bucardo.sync WHERE name ~ '$1\$'};
        my $tmp = $dbh->selectall_arrayref($SQL);
        push @syncs => map { $_->[0] } @$tmp;
        next SYNCMATCH;
    }
    if ($sync =~ /^(\w+)\*$/) {
        $SQL = qq{SELECT name FROM bucardo.sync WHERE name ~ '^$1'};
        my $tmp = $dbh->selectall_arrayref($SQL);
        push @syncs => map { $_->[0] } @$tmp;
        next SYNCMATCH;
    }
    next if $sync eq 'sync';
    if (! exists $syncs->{$sync}) {
        die qq{Sync "$sync" does not appear to exist\n};
    }
    push @syncs, $sync;
}

if ($gotall) {
    my @typelimit;
    my $active = 0;
    for my $v (@allvars) {
        if ($v =~ /^(?:copy|fullcopy)$/i) {
            push @typelimit => 'fullcopy';
        }
        elsif ($v =~ /^(?:delta|pushdelta)$/i) {
            push @typelimit => 'pushdelta';
        }
        elsif ($v =~ /^swap$/i) {
            push @typelimit => 'swap';
        }
        elsif ($v =~ /^active$/i) {
            $active = 1;
        }
        else {
            die "Usage: ... all [copy|delta|swap]\n";
        }
    }
    my $WHERE = '';
    if (@typelimit) {
        $WHERE = 'WHERE ' . (join ' OR ' => map { "synctype = '$_'" } @typelimit);
    }
    if ($active) {
        $WHERE
            ? ($WHERE =~ s/WHERE /WHERE status = 'active' AND /)
            : ($WHERE = q{WHERE status = 'active'});
    }
    $SQL = "SELECT name FROM sync $WHERE ORDER BY priority DESC, name ASC";
    $sth = $dbh->prepare($SQL);
    undef @syncs;
    my $tmp = $dbh->selectall_arrayref($SQL);
    push @syncs => map { $_->[0] } @$tmp;
}

vate_sync() if $verb eq 'activate' or $verb eq 'deactivate';
kick() if $verb eq 'kick';

help();


sub help {
    warn qq{Usage: $progname args
  install         ** Install the Bucardo database

  start <reason>  ** Force any existing sync(s) to quit, then starts Bucardo

  stop <reason>   ** Tell all Bucardo processes to stop permanently

  list <type> [name]   ** View information about dbs, dbgroups, herds, syncs, tables, or sequences
  add <type> <name>    ** Add a db, dbgroup, herd, sync, table, or sequence
  remove <type> <name> ** Remove a db, dbgroup, herd, sync, table, or sequence
  For detailed help on the above, prefix with a help like this:
    $progname help add db

  kick <syncname(s)> [timeout]
                  ** Kick off one or more syncs, optionally wait for result (0 = wait until done)

  ping [timeout]  ** Ping the MCP process for a response, return a Nagios-friendly string

  status [--sort=col#] [--daysback=#]
                  ** List information about all syncs

  status syncname[s] [--daysback=#]
                  ** List detailed information about one or more syncs

  reload syncname[s]
                 ** Reload a sync

  validate syncname[s]
                 ** Validate a sync

  upgrade
                 ** Upgrade Bucardo to the current version

  message
                 ** Write a message to the Bucardo logs

  config [set|show]
                 ** View or set configuration parameters

  reload_config   ** Force a running Bucardo to reload the bucardo_config table

For more details, try 'man bucardo_ctl'
} unless $QUIET; ## Mostly for the test suite
    exit 0;
}


sub superhelp {

    ## See if we can get more specific by looking at the nouns
    help() if ! @nouns;

    my $word1 = lc $nouns[0];
    my $word2 = lc $nouns[1];

    ## Because usage() sometimes relies on the verb
    $verb = $word1;

    if ('add' eq $word1) {
        if ('customcode' eq $word2 or 'custom_code' eq $word2 or 'code' eq $word2) {
            warn usage('add_customcode') . "\n";
            exit 0;
        }
        if ('db' eq $word2 or 'database' eq $word2) {
            warn usage('add_database') . "\n";
            exit 0;
        }
        if ('dbg' eq $word2 or 'dbgroup' eq $word2) {
            warn usage('add_dbgroup') . "\n";
            exit 0;
        }
        if ('herd' eq $word2) {
            warn usage('add_herd') . "\n";
            exit 0;
        }
        if ('sync' eq $word2) {
            warn usage('add_sync') . "\n";
            exit 0;
        }
        if ('table' eq $word2 or 'tab' eq $word2) {
            warn usage('add_table') . "\n";
            exit 0;
        }
        if ('sequence' eq $word2 or 'seq' eq $word2) {
            warn usage('add_sequence') . "\n";
            exit 0;
        }
        warn usage('add') . "\n";
        exit 0;
    }
    if ('config' eq $word1) {
        warn usage('config') . "\n";
        exit 0;
    }
    if ('inspect' eq $word1) {
        if ('table' eq $word2) {
            warn usage('inspect_table') . "\n";
            exit 0;
        }
        if ('herd' eq $word2) {
            warn usage('inspect_herd') . "\n";
            exit 0;
        }
        if ('sync' eq $word2) {
            warn usage('inspect_sync') . "\n";
            exit 0;
        }

        warn usage('inspect') . "\n";
        exit 0;
    }
    if ('kick' eq $word1) {
        warn usage('kick') . "\n";
        exit 0;
    }
    if ('list' eq $word1 or 'l' eq $word1) {
        if ('customcode' eq $word2 or 'custom_code' eq $word2) {
            warn usage('list_customcode') . "\n";
            exit 0;
        }
        if ('db' eq $word2 or 'database' eq $word2) {
            warn usage('list_databases') . "\n";
            exit 0;
        }
        if ('dbg' eq $word2 or 'dbgroup' eq $word2) {
            warn usage('list_dbgroups') . "\n";
            exit 0;
        }
        if ('herd' eq $word2) {
            warn usage('list_herds') . "\n";
            exit 0;
        }
        if ('sync' eq $word2) {
            warn usage('list_syncs') . "\n";
            exit 0;
        }
        if ('table' eq $word2 or 'tab' eq $word2) {
            warn usage('list_tables') . "\n";
            exit 0;
        }
        if ('sequence' eq $word2 or 'seq' eq $word2) {
            warn usage('list_sequences') . "\n";
            exit 0;
        }
        warn usage('list') . "\n";
        exit 0;
    }
    if ('message' eq $word1) {
        warn usage('message') . "\n";
        exit 0;
    }
    if ('ping' eq $word1) {
        warn usage('ping') . "\n";
        exit 0;
    }
    if ('reload' eq $word1) {
        warn usage('reload') . "\n";
        exit 0;
    }
    if ('reload_config' eq $word1) {
        warn usage('reload_config') . "\n";
        exit 0;
    }
    if ('remove' eq $word1 or 'delete' eq $word1) {
        if ('customcode' eq $word2 or 'custom_code' eq $word2) {
            warn usage('remove_customcode') . "\n";
            exit 0;
        }
        if ('db' eq $word2 or 'database' eq $word2) {
            warn usage('remove_database') . "\n";
            exit 0;
        }
        if ('dbg' eq $word2 or 'dbgroup' eq $word2) {
            warn usage('remove_dbgroup') . "\n";
            exit 0;
        }
        if ('herd' eq $word2) {
            warn usage('remove_herd') . "\n";
            exit 0;
        }
        if ('sync' eq $word2) {
            warn usage('remove_sync') . "\n";
            exit 0;
        }
        if ('table' eq $word2 or 'tab' eq $word2) {
            warn usage('remove_table') . "\n";
            exit 0;
        }
        if ('sequence' eq $word2 or 'seq' eq $word2) {
            warn usage('remove_sequence') . "\n";
            exit 0;
        }
        warn usage('remove') . "\n";
        exit 0;
    }
    if ('restart' eq $word1) {
        warn usage('restart') . "\n";
        exit 0;
    }
    if ('start' eq $word1) {
        warn usage('start') . "\n";
        exit 0;
    }
    if ('status' eq $word1) {
        warn usage('status') . "\n";
        exit 0;
    }
    if ('stop' eq $word1) {
        warn usage('stop') . "\n";
        exit 0;
    }
    if ('update' eq $word1) {
        warn usage('update') . "\n";
        exit 0;
    }
    if ('upgrade' eq $word1) {
        warn usage('upgrade') . "\n";
        exit 0;
    }
    if ('validate' eq $word1) {
        warn usage('validate') . "\n";
        exit 0;
    }

    ## Generic fallthrough
    help();

    exit 0;

} ## end of superhelp


sub restart {

    stop();
    sleep 1;
    start();
    return;

} ## end of restart


sub start {

    ## Attempt to start Bucardo

    set_reason(0);

    ## Refuse to go on if we get a ping response within 5 seconds
    $QUIET or print "Checking for existing processes\n";

    my $oldpid = 0;
    if ($oldpid) {
        $QUIET or print "Cannot start, process $oldpid is already running\n";
        exit 1;
    }

    ## Create a new Bucardo instance and connect to its database
    require Bucardo;
    my $bc = Bucardo->new($bcargs);

    my $pm_version = $bc->{version} || 'unknown';
    if ($VERSION ne $pm_version) {
        die "Version mismatch: bucardo_ctl is $VERSION, but Bucardo.pm is $pm_version\n";
    }

    stop_bucardo();

    sleep 2; ## Give everyone a chance to notice it
    ## TODO: be smarter about this by scanning PIDDIR

    if (-e $STOPFILE) {
        print "Removing $STOPFILE\n" unless $QUIET;
        unlink $STOPFILE;
    }
    if (-e $PIDFILE) {
        print "Removing $STOPFILE\n" unless $QUIET;
        unlink $PIDFILE;
    }

    $QUIET or print qq{Starting Bucardo\n};

    $dbh->disconnect();
    if (fork) {
    }
    else {
        close STDERR or warn "Could not close STDERR\n";
        close STDOUT or warn "Could not close STDOUT\n";
        setsid() or die;
        $bc->start_mcp();
    }
    exit 0;

} ## end of start


sub stop {

    ## Attempt to stop Bucardo

    set_reason(0);

    print "Creating $STOPFILE ... " unless $QUIET;
    stop_bucardo();
    print "Done\n" unless $QUIET;

    exit 0 if $verb eq 'stop';

    return;

} ## end of stop


sub reload_config {

    ## Reload configuration settings from the DB, restart all controllers and kids
    for (@nouns) {
        if (/^\d+$/) {
            $adverb = $1;
            last;
        }
    }

    $QUIET or print q{Forcing Bucardo to reload the bucardo_config table};

    my $done = 'bucardo_reload_config_finished';
    $dbh->do('NOTIFY bucardo_reload_config');
    if (defined $adverb) {
        print '...';
        $dbh->do("LISTEN $done");
    }
    $dbh->commit();

    if (!defined $adverb) {
        print "\n";
        exit 0;
    }
    sleep 0.1;
  WAITIN: {
        while (my $notify = $dbh->func('pg_notifies')) {
            my ($name, $pid) = @$notify;
            last WAITIN if $name eq $done;
        }
        $dbh->commit();
        sleep($WAITSLEEP);
        redo;
    }
    print "DONE!\n";

    exit 0;

} ## end of reload_config


sub reload {

    ## Ask for one or more syncs to be reloaded

    my $usage = usage('reload');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }

    for my $syncname (@nouns) {
        next if $syncname eq 'sync'; ## Allows $0 reload sync foobar

        ## Make sure this sync exists
        $SQL = 'SELECT status FROM bucardo.sync WHERE name = ?';
        $sth = $dbh->prepare($SQL);
        $count = $sth->execute($syncname);
        if ($count != 1) {
            warn "Invalid sync: $syncname\n";
            $sth->finish();
            next;
        }
        my $status = $sth->fetch()->[0];
        if ($status ne 'active') {
            warn qq{Cannot reload: status of sync "$syncname" is $status\n};
            next;
        }

        my $done = "bucardo_reloaded_sync_$syncname";
        print "Reloading sync $syncname...";
        $dbh->do(qq{LISTEN "$done"});
        $dbh->do(qq{NOTIFY "bucardo_reload_sync_$syncname"});
        $dbh->commit();

        sleep 0.1;
      WAITIN: {
            while (my $notify = $dbh->func('pg_notifies')) {
                my ($name, $pid) = @$notify;
                last WAITIN if $name eq $done;
            }
            $dbh->commit();
            sleep($WAITSLEEP);
            redo;
        }
        print "DONE!\n";
    }

    exit 0;

} ## end of reload


sub validate {

    ## Ask for one or more syncs to be validated

    my $usage = usage('validate');

    if (!@nouns) {
        warn "$usage\n";
        exit 0;
    }

    load_bucardo_info();
    my $synclist = $global{sync};

    my @synclist;
    if ($nouns[0] eq 'all' and ! defined $nouns[1]) {
        @synclist = keys %$synclist;
        if (! @synclist) {
            print "Sorry, there are no syncs to validate!\n";
            exit 0;
        }
    }
    else {
        for my $name (@nouns) {
            next if $name eq 'sync'; ## Allows $0 validate sync foobar
            if (! exists $synclist->{$name}) {
                die qq{Sorry, there is no sync named "$name"\n};
            }
            push @synclist => $name;
        }
    }

    ## Get the largest size to we can line up the dots all pretty
    my $maxsize = 1;
    for my $name (@synclist) {
        $maxsize = length $name if length $name > $maxsize;
    }
    $maxsize += 3;

    for my $name (@synclist) {
        my $done = "bucardo_validated_sync_$name";
        printf "Validating sync $name%s",
            '.' x ($maxsize - length $name);
        $dbh->do(qq{LISTEN "$done"});
        $SQL = 'SELECT validate_sync(?)';
        $sth = $dbh->prepare($SQL);
        $sth->execute($name);
        $dbh->commit();

        sleep 0.1;
      WAITIN: {
            while (my $notify = $dbh->func('pg_notifies')) {
                my ($name, $pid) = @$notify;
                last WAITIN if $name eq $done;
            }
            $dbh->commit();
            sleep($WAITSLEEP);
            redo;
        }
        print "DONE!\n";
    }

    exit 0;

} ## end of validate


sub update {

    ## Update some object in the database
    ## e.g. bucardo_ctl update sync foobar onetimecopy=2
    ## e.g. bucardo_ctl update sync foobar add tab1

    my $usage = usage('update');

    my $item = shift @nouns;
    my $name = shift @nouns;

    if (! @nouns or ! defined $item or ! defined $name) {
        warn "$usage\n";
        exit 1;
    }

    my $info;
    my $lookupcol = 'name';
    my $tabname;
    if ($item =~ /^code/i or $item =~ /^custom/i) {
        $tabname = $item = 'customcode';
    }
    elsif ($item =~ /^syn/i) {
        $tabname = $item = 'sync';
    }
    elsif ($item =~ /^tab/i or $item =~ /^seq/i) {
        $tabname = 'goat';
        $lookupcol = 'tablename';
    }
    elsif ($item =~ /^dbg/i) {
        $tabname = $item = 'dbgroup';
    }
    elsif ($item =~ /^db/i) {
        $tabname = $item = 'db';
    }
    else {
        die "Invalid item: must be code, db, dbgroup, sequence, sync, or table.\n";
    }

    $SQL = "SELECT * FROM $tabname WHERE $lookupcol = ?";
    if ($tabname eq 'goat' and $name =~ /(.+)\.(.+)/) {
        my ($sname,$tname) = ($1,$2);
        $SQL = 'SELECT * FROM bucardo.goat WHERE schemaname=? AND tablename=?';
        if ($sname =~ s/\*//) {
            $SQL =~ s/=/~/;
        }
        if ($tname =~ s/\*//) {
            $SQL =~ s/=\?$/~?/;
        }
        $sth = $dbh->prepare($SQL);
        $count = $sth->execute($sname,$tname);
    }
    else {
        if ($name =~ s/\*//) {
            $SQL =~ s/=/~/;
        }
        $sth = $dbh->prepare($SQL);
        $count = $sth->execute($name);
    }

    if ($count < 1) {
        $sth->finish();
        die qq{No matches found for $item "$name"\n};
    }

    my $pkcol = $tabname eq 'goat' ? 'id' : 'name';

    $dbh->{pg_bool_tf} = 1;
    $info = $sth->fetchall_arrayref({});

    my $validate_msg = 0;

    if ('sync' eq $item and ($nouns[0] eq 'add' or $nouns[0] eq 'remove')) {
        my $v = shift @nouns;
        die "Can only $v to one sync at a time\n" if @$info > 1;
        $info = $info->[0];
        my $miniusage = "Usage: update sync $name $v table|sequence <name(s)>\n";
        my $thing = shift @nouns or die $miniusage;
        @nouns or die $miniusage;

        ## Grab all goats in the source herd for this sync
        my $sourceherd = $info->{source};
        $SQL = 'SELECT id, schemaname, tablename FROM bucardo.goat g'
            . ' JOIN bucardo.herdmap h ON (h.goat = g.id) AND h.herd = ?';
        $sth = $dbh->prepare($SQL);
        $sth->execute($sourceherd);
        my $herdlist = $sth->fetchall_hashref('id');

        for my $tab (@nouns) {
            ## All of these must be valid tables
            my $t = $tab;
            my $wild = ($t =~ s/\*//) ? 1 : 0;
            my $find;
            if ($t =~ s/(\w+)\.//) {
                my $schema = $1;
                $SQL = 'SELECT * FROM bucardo.goat WHERE tablename = ? AND schemaname = ? AND reltype = ?';
                $wild and $SQL =~ s/=/~/;
                $find = $dbh->prepare_cached($SQL);
                $count = $find->execute($wild ? "^$t" : $t, $schema, $thing);
            }
            else {
                $SQL = 'SELECT * FROM bucardo.goat WHERE tablename = ? AND reltype = ?';
                $wild and $SQL =~ s/=/~/;
                $find = $dbh->prepare($SQL);
                $count = $find->execute($wild ? "^$t" : $t, $thing);
            }
            if ($count < 1) {
                die qq{Unknown table: $tab\n};
            }
            elsif ($count > 1 and ! $wild) {
                die qq{More than one table found for $tab: use wildcards or a schema\n};
            }

            my $tabinfo = $find->fetchall_arrayref({});
            for my $tab2 (@$tabinfo) {
                my $tabid = $tab2->{id};
                my $tablename = "$tab2->{schemaname}.$tab2->{tablename}";
                my $type = $tab2->{reltype};
                if ($v eq 'add' and exists $herdlist->{$tabid}) {
                    warn "Skipping $type $tablename: already part of that sync\n";
                    next;
                }
                if ($v eq 'remove' and !exists $herdlist->{$tabid}) {
                    warn "Skipping $type $tablename: does not belong to the sync\n";
                    next;
                }
                if ($v eq 'add') {
                    $SQL = 'INSERT INTO bucardo.herdmap(herd,goat) VALUES (?,?)';
                    my $add = $dbh->prepare($SQL);
                    $add->execute($sourceherd,$tabid);
                    warn "Added $type $tablename to herd $sourceherd\n";
                    if ($type eq 'table') {
                        $validate_msg = 1;
                    }
                }
                else {
                    $SQL = 'DELETE FROM bucardo.herdmap WHERE herd = ? AND goat = ?';
                    my $delete = $dbh->prepare($SQL);
                    $delete->execute($sourceherd,$tabid);
                    warn "Removed $type $tablename from herd $sourceherd\n";
                }
            }
        }

        if ($validate_msg) {
            print qq{Don't forget to run bucardo_ctl validate $name\n};
        }

        $dbh->commit();
        exit 0;
    }

    if ('dbgroup' eq $item and ($nouns[0] eq 'add' or $nouns[0] eq 'remove')) {
        my $v = shift @nouns;
        die "Can only $v to one dbgroup at a time\n" if @$info > 1;
        $info = $info->[0];
        my $miniusage = "Usage: update dbgroup $name $v <dbname(s)>\n";
        @nouns or die $miniusage;

        ## Grab all databases in this group
        $SQL = 'SELECT db, priority FROM bucardo.dbmap WHERE dbgroup = ?';
        $sth = $dbh->prepare($SQL);
        $sth->execute($name);
        my $dblist = $sth->fetchall_hashref('db');

        for my $db (@nouns) {
            ## All of these must be valid databases
            my $d = $db;
            my $wild = ($d =~ s/\*//) ? 1 : 0;
            my $find;
            $SQL = 'SELECT * FROM bucardo.db WHERE name = ?';
            $wild and $SQL =~ s/=/~/;
            $find = $dbh->prepare($SQL);
            $count = $find->execute($wild ? "^$d" : $d);
            if ($count < 1) {
                die qq{Unknown database: $db\n};
            }
            elsif ($count > 1 and ! $wild) {
                die qq{More than one database found for $db\n};
            }

            if ($v eq 'add' and exists $dblist->{$d}) {
                warn "Skipping dbgroup $db: already part of that group\n";
                next;
            }
            if ($v eq 'remove' and !exists $dblist->{$d}) {
                warn "Skipping dbgroup $db: does not belong to that group\n";
                next;
            }
            my $dbinfo = $find->fetchall_arrayref({});
            for my $db2 (@$dbinfo) {
                my $dbname = $db2->{name};
                if ($v eq 'add') {
                    $SQL = 'INSERT INTO bucardo.dbmap(db,dbgroup) VALUES (?,?)';
                    my $add = $dbh->prepare($SQL);
                    $add->execute($dbname,$name);
                    warn "Added database $dbname to database group $name\n";
                }
                else {
                    $SQL = 'DELETE FROM bucardo.dbmap WHERE db = ? AND dbgroup = ?';
                    my $delete = $dbh->prepare($SQL);
                    $delete->execute($dbname,$name);
                    warn "Removed database $dbname from database group $name\n";
                }
            }
        }

        $dbh->commit();
        exit 0;
    }

    ## Process each change in turn
    ## Can be code, sync, dbgroup, table, schema, or db
    my %change;
    for my $arg (@nouns) {
        next if $arg eq 'set';
        $arg =~ /(.+)=(.+)/ or die "Invalid argument: must be of form name=value\n";
        my ($n,$v) = (lc $1,$2);
        $n =~ /^\w+$/ or die "Invalid name\n";
        $n = 'server_side_prepares' if $n eq 'ssp';
        for my $row (@$info) {
            my $localname = $tabname eq 'goat' ? "$row->{schemaname}.$row->{tablename}" : $row->{name};
            my $localid = $tabname eq 'goat' ? $row->{id} : $row->{name};
            if (! exists $row->{$n}) {
                die qq{Sorry, cannot change "$n" for $item "$localname"\n};
            }
            if ($tabname eq 'db' and $n eq 'dbhost' and $v eq 'none') {
                $SQL = "UPDATE bucardo.db SET dbhost = '' WHERE $pkcol = ?";
                $sth = $dbh->prepare($SQL);
                $sth->execute($localid);
                push @{$change{$localname}} => [$n, $row->{$n}, 'NULL'];
                next;
            }
            if ($tabname eq 'customcode' and $n eq 'src_code') {
                my $tfile = $v;
                if (! -e $tfile) {
                    die qq{The 'src_file' value must be a file\n};
                }
                open my $fh, '<', $tfile or die qq{Could not open "$tfile": $!\n};
                { local $/; $v = <$fh>; } ## no critic (RequireInitializationForLocalVars)
                close $fh or warn qq{Could not close "$tfile": $!\n};
            }

            $SQL = "UPDATE bucardo.$tabname SET $n = ? WHERE $pkcol = ?";
            ## Only one of targetdb and targetgroup can be set, no NULL the other one
            if ($n eq 'targetgroup') {
                $SQL =~ s/SET/SET targetdb=NULL,/;
            }
            elsif ($n eq 'targetdb') {
                $SQL =~ s/SET/SET targetgroup=NULL,/;
            }

            $sth = $dbh->prepare($SQL);
            if ($DEBUG) {
                warn "SQL: $SQL\n";
                warn "Args: $v, $localid\n";
            }
            $sth->execute($v, $localid);
            push @{$change{$localname}} => [$n, $row->{$n}, $v];
        }
    }

    if (! keys %change) {
        print "No changes made\n";
        exit 0;
    }

    my %maxcol;
    for my $thing (keys %change) {
        $maxcol{$thing} = 1;
        for my $row (@{$change{$thing}}) {
            $maxcol{$thing} = length($row->[0]) if length($row->[0]) > $maxcol{$thing};
        }
    }

    for my $thing (sort keys %change) {
        print qq{Changes made to $item "$thing":\n};
        for my $row (@{$change{$thing}}) {
            my $col = $row->[0];
            my $old = defined $row->[1] ? qq{"$row->[1]"} : '(null)';
            my $new = qq{"$row->[2]"};
            if ($tabname eq 'customcode' and $col eq 'src_code') {
                my $lines = $old =~ tr/\n/\n/;
                $old = "old source (lines: $lines)";
                $lines = $new =~ tr/\n/\n/;
                $new = "contents of file 'foo' (lines: $lines)";
            }
            printf qq{ * %-*s : changed from %s to %s\n},
                $maxcol{$thing}, $col, $old, $new;
        }
    }

    $dbh->commit();
    $dbh->disconnect();
    exit 0;

} ## end of update


sub ping {

    ## See if the MCP is alive and responds to pings
    ## Default is to wait 15 seconds

    my $arg = shift || {};

    my $timeout = $arg->{timeout} || $ARGV[0] || 15;
    my $quiet = $arg->{quiet} || $ARGV[1] || 0;

    if (defined $nouns[0] and $nouns[0] =~ /^\d+$/) {
        $timeout = $nouns[0];
    }

    $VERBOSE and print "Pinging MCP, timeout = $timeout\n";
    $dbh->do('LISTEN bucardo_mcp_pong');
    $dbh->do('NOTIFY bucardo_mcp_ping');
    $dbh->commit();
    my $starttime = time;
    sleep 0.1;

  P:{
        my $notify = $dbh->func('pg_notifies');
        if (defined $notify) {
            my ($name, $pid) = @$notify;
            $quiet or print "OK: Got response from PID $pid\n";
            return $pid if $arg->{noexit};
            exit 0;
        }
        $dbh->rollback();
        sleep 0.5;
        my $totaltime = time - $starttime;
        if ($timeout and $totaltime >= $timeout) {
            $quiet or print "CRITICAL: Timed out ($totaltime s), no ping response from MCP\n";
            return 0 if $arg->{noexit};
            exit 1;
        }
        redo;
    }

    return;

} ## end of ping


sub kick {

    my $usage = usage('kick');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }

    ## Is someone listening for this sync? (We assume its the MCP)

    my ($exitstatus, $retries, $do_retry) = (0,0,0);

  RETRY: {
        $dbh->rollback();
        $exitstatus = 0;
      SYNC: for my $sync (@syncs) {
            my $relname = "bucardo_kick_sync_$sync";

            ## If nobody is listening, our kick is not going to be very effective!
            if ($dbh->{pg_server_version} < 90000) {
                $SQL = 'SELECT 1 FROM pg_listener WHERE relname = ?';
                my $sthl = $dbh->prepare($SQL);
                $count = $sthl->execute($relname);
                $sthl->finish();
                if ($count < 1) {
                    warn qq{Cannot kick sync "$sync" - are you sure it is active?\n};
                    next;
                }
            }

            ## If this sync is not active, cowardly refuse to kick it
            if ($syncs->{$sync}{status} ne 'active') {
                print qq{Cannot kick inactive sync "$sync"\n};
                next SYNC;
            }

            $dbh->do(qq{NOTIFY "bucardo_kick_sync_$sync"});
            my $done = "bucardo_syncdone_$sync";
            my $killed = "bucardo_synckill_$sync";
            if (! defined $adverb) {
                $dbh->commit();
                $QUIET or print qq{Kicked sync $sync\n};
                next;
            }

            $QUIET or print qq{Kick $sync: };
            $dbh->do(qq{LISTEN "$done"});
            $dbh->do(qq{LISTEN "$killed"});
            my $s = $syncs->{$sync};
            if ($s->{targetgroup}) {
                for (@{$s->{targets}}) {
                    $dbh->do(qq{LISTEN "bucardo_syncdone_${sync}_$_"});
                    $dbh->do(qq{LISTEN "bucardo_synckill_${sync}_$_"});
                }
            }
            else {
                $dbh->do(qq{LISTEN "bucardo_syncdone_${sync}_$s->{targetdb}"});
                $dbh->do(qq{LISTEN "bucardo_synckill_${sync}_$s->{targetdb}"});
            }
            $dbh->commit();

            my $time = time;
            sleep 0.1;

            my $timeout = (defined $adverb and $adverb > 0) ? $adverb : 0;

            my $printstring = $NOTIMER ? '' : '[0 s] ';
            print $printstring unless $QUIET or $NOTIMER;
            my $oldtime = 0;
            local $SIG{ALRM} = sub { die 'Timed out' };
            $do_retry = 0;
            eval {
                if ($timeout) {
                    alarm $timeout;
                }
              WAITIN: {
                    my $lastwait = '';
                    if ($PROGRESS and time - $time != $oldtime) {
                        $oldtime = time - $time;
                        if (!$QUIET and !$NOTIMER) {
                            print "\b" x length($printstring);
                            $printstring =~ s/\d+/$oldtime/;
                            print $printstring;
                        }
                    }
                  W: while (my $notify = $dbh->func('pg_notifies')) {
                        my ($name, $pid) = @$notify;
                        if ($name eq $done) {
                            $lastwait = 'DONE!';
                        }
                        elsif ($name eq $killed) {
                            $lastwait = 'KILLED!';
                            $exitstatus = 2;
                        }
                        elsif ($name =~ /^bucardo_syncdone_${sync}_(.+)$/) {
                            my $new = sprintf "$1(%ds) ", ceil(time-$time);
                            print $new unless $QUIET;
                            $printstring .= $new;
                        }
                        elsif ($name =~ /^bucardo_synckill_${sync}_(.+)$/) {
                            my $new = sprintf "$1 KILLED (%ds) ", ceil(time-$time);
                            print $new unless $QUIET;
                            $printstring .= $new;
                            $exitstatus = 2;
                            $lastwait = ' ';
                        }
                    }
                    $dbh->rollback();
                    if ($lastwait) {
                        print $lastwait unless $QUIET;
                        if ($lastwait ne 'DONE!' and $RETRY and ++$retries <= $RETRY) {
                            print "Retry #$retries\n";
                            $do_retry = 1;
                            die "Forcing eval to exit for retry attempt\n";
                        }
                        last WAITIN;
                    }
                    sleep($WAITSLEEP);
                    redo WAITIN;
                }
                alarm 0 if $timeout;
            };
            alarm 0 if $timeout;
            if ($do_retry) {
                $do_retry = 0;
                redo RETRY;
            }
            if ($@) {
                if ($@ =~ /Timed out/o) {
                    $exitstatus = 1;
                    warn "Timed out!\n";
                }
                else {
                    $exitstatus = 2;
                    warn "Error: $@\n";
                }
                next SYNC;
            }

            next SYNC if $QUIET;

            if ($PROGRESS) {
                print "\n";
            }
            else {
                printf "(%ds)\n", ceil(time - $time);
            }
        } ## end each sync

    } ## end RETRY

    exit $exitstatus;

} ## end of kick


sub status_all {

    ## Show status of all syncs in the database

    print "Days back: $DAYSBACK  $DBCONN  ";

    ## See if the MCP is running and what its PID is
    if (! -e $PIDFILE) {
        print "\nBucardo may not be running. No file found at $PIDFILE";
    }
    else {
        my $fh;
        if (!open $fh, '<', $PIDFILE) {
            print "\nERROR: Could not open $PIDFILE: $!";
        }
        else {
            my $pid = <$fh>;
            chomp $pid;
            close $fh or warn qq{Could not close $PIDFILE: $!\n};
            if ($pid =~ /^\d+$/) {
                print "PID of Bucardo MCP: $pid";
            }
            else {
                print "\nERROR: $PIDFILE contained: $pid";
            }
        }
    }
    print "\n";

    my $orderby = $bcargs->{sort} || '1';
    if ($orderby !~ /^\+?\-?\d$/) {
        die "Invalid sort option, must be +- 1 through 9\n";
    }

    our ($synclist,$max);
    ($synclist,$max) = get_detailed_syncs();

    if (! keys %$synclist) {
        print "No syncs have been created yet.\n";
        exit 0;
    }

    printf qq{%-*s %-*s %-*s %-*s %-*s %-*s %-*s %-*s %-*s\n},
        $max->{name},'Name',
        $max->{type}, 'Type',
        $max->{stat}, 'State',
        $max->{pid}, 'PID',
        $max->{good}, 'Last_good',
        $max->{total}, 'Time',
        $max->{iud}, 'I/U/D',
        $max->{bad}, 'Last_bad',
        $max->{totalbad}, 'Time';

    printf qq{%s+%s+%s+%s+%s+%s+%s+%s+%s\n},
        '=' x $max->{name},
        '=' x $max->{type},
        '=' x $max->{stat},
        '=' x $max->{pid},
        '=' x $max->{good},
        '=' x $max->{total},
        '=' x $max->{iud},
        '=' x $max->{bad},
        '=' x $max->{totalbad};

    ## If fancy sorting desired, call the list ourself to sort
    sub sortme {
        my $sortcol = $bcargs->{sort} || 1;

        +1 == $sortcol and return $a cmp $b;
        -1 == $sortcol and return $b cmp $a;

        my ($uno,$dos) = ($synclist->{$a}, $synclist->{$b});

        ## Synctype
        +2 == $sortcol and return ($uno->{synctype} cmp $dos->{synctype} or $a cmp $b);
        -2 == $sortcol and return ($dos->{synctype} cmp $uno->{synctype} or $a cmp $b);

        ## Status
        +3 == $sortcol and return ($uno->{state} cmp $dos->{state} or $a cmp $b);
        -3 == $sortcol and return ($dos->{state} cmp $uno->{state} or $a cmp $b);

        ## PID
        +4 == $sortcol and return $uno->{PID} <=> $dos->{PID};
        -4 == $sortcol and return $dos->{PID} <=> $uno->{PID};

        ## Last good
        +5 == $sortcol and return ($uno->{lastgoodsecs} <=> $dos->{lastgoodsecs} or $a cmp $b);
        -5 == $sortcol and return ($dos->{lastgoodsecs} <=> $uno->{lastgoodsecs} or $a cmp $b);

        ## Good time
        +6 == $sortcol and return ($uno->{lastgoodtime} <=> $dos->{lastgoodtime} or $a cmp $b);
        -6 == $sortcol and return ($dos->{lastgoodtime} <=> $uno->{lastgoodtime} or $a cmp $b);

        if ($sortcol == 7 or $sortcol == -7) {
            my ($total1,$total2) = (0,0);
            while ($uno->{iud} =~ /(\d+)/go) {
                $total1 += $1;
            }
            while ($dos->{iud} =~ /(\d+)/go) {
                $total2 += $1;
            }

            7 == $sortcol and return ($total1 <=> $total2 or $a cmp $b);

            return ($total2 <=> $total1 or $a cmp $b);
        }

        ## Last bad
        +8 == $sortcol and return ($uno->{lastbadsecs} <=> $dos->{lastbadsecs} or $a cmp $b);
        -8 == $sortcol and return ($dos->{lastbadsecs} <=> $uno->{lastbadsecs} or $a cmp $b);

        ## Bad time
        +9 == $sortcol and return ($uno->{lastbadtime} <=> $dos->{lastbadtime} or $a cmp $b);
        -9 == $sortcol and return ($dos->{lastbadtime} <=> $uno->{lastbadtime} or $a cmp $b);


        return $a cmp $b;

    }

    for my $sync (sort sortme keys %$synclist) {
        my $s = $synclist->{$sync};
        my $X = '|';
        printf qq{%-*s$X%-*s$X%-*s$X%-*s$X%-*s$X%-*s$X%-*s$X%-*s$X%-*s\n},
            $max->{name},$sync,
            $max->{type},$s->{typetext},
            $max->{stat}, $s->{state},
            $max->{pid}, $s->{PID} || '',
            $max->{good}, $s->{lastgood},
            $max->{total}, $s->{timegood},
            $max->{iud}, $s->{iud},
            $max->{bad}, $s->{lastbad},
            $max->{totalbad}, $s->{timebad};
    }


    exit 0;

} ## end of status_all


sub status_detail {

    ## Show detailed information about one or more syncs

    ## Verify that all named syncs exist
    my ($synclist,$max) = get_detailed_syncs({syncs => \@nouns});

    my @synclist;
    for my $sync (sort @nouns) {
        $DEBUG and warn "Verify sync: $sync\n";
        if (!exists $synclist->{$sync}) {
            ## If a number, skip for ease of "kick name #" toggling
            $sync !~ /^\d+$/ and die "No such sync: $sync\n";
        }
        else {
            push @synclist => $sync;
        }
    }

    ## Grab the mappings from herd to database
    ## We only need one from each herd!
    $SQL = 'SELECT name FROM bucardo.herd';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my $herdmap = $sth->fetchall_hashref('name');
    for my $herdname (keys %$herdmap) {
        $SQL = 'SELECT db FROM bucardo.goat WHERE id = (SELECT goat FROM bucardo.herdmap WHERE herd = ? LIMIT 1)';
        $sth = $dbh->prepare($SQL);
        $sth->execute($herdname);
        my $goatinfo = $sth->fetchall_arrayref({})->[0];
        $herdmap->{$herdname}{database} = $goatinfo->{db};
    }

    print "Days back: $DAYSBACK  $DBCONN\n";

    ## Present each ordered by name
    for my $sync (sort { lc $a cmp lc $b } @synclist) {
        print '=' x 70; print "\n";
        my $s = $synclist->{$sync};

        ## Undefined should be written as 'none'
        for (qw/checktime/) {
            $s->{$_} ||= 'none';
        }
        ## Not true should be empty
        for (qw/PID PIDFILE CREATED/) {
            $s->{$_} ||= '';
        }

        my $morepid = '';
        if ($s->{stayalive} or $s->{kidsalive}) {
            $morepid = " (PID = $s->{PID})";
        }

        ## Should be 'yes' or 'no'
        for (qw/makedelta analyze_after_copy stayalive kidsalive ping do_listen usecustomselect/) {
            $s->{$_} = (defined $s->{$_} and $s->{$_}) ? 'yes' : 'no ';
        }

        my $target;
        if ($s->{targetdb}) {
            $target = "Target database:      $s->{targetdb}";
        }
        else {
            $target = "Target group:         $s->{targetgroup} (";
            $target .= join ',' => @{$s->{targets}};
            $target .= ')';
        }

        $s->{iud} =~ s{/}{ / }g;
        $s->{state} =~ s{>}{ > };

        my $moregood = '';
        if ($s->{lastgood} ne 'unknown') {
            $moregood .= " (time to run: $s->{timegood})";
            $moregood .= "\nLast good time:       $s->{latest_good}{last_ended_date}";
            $moregood .= "  Target: $s->{latest_good}{targetdb}";
        }

        my $morebad = '';
        if ($s->{lastbad} ne 'unknown') {
            $morebad = " (time to run: $s->{timebad})";
            $morebad .= "\nLast bad time:        $s->{latest_bad}{last_aborted_date}";
            $morebad .= "  Target: $s->{latest_bad}{targetdb}";
            (my $why = $s->{latest_bad}{whydie}) =~ s/\s+$//;
            $why =~ s/^/                  /mg;

            $why =~ s/^\s+//;
            $morebad .= "\nLatest bad reason: $why";
        }

        my $sourcedb = $herdmap->{$s->{source}}{database} || '?';

        $SQL = 'SELECT count(*) FROM bucardo.herdmap WHERE herd = ?';
        $sth = $dbh->prepare($SQL);
        $sth->execute($s->{source});
        my $numtables = $sth->fetch()->[0];

        print qq{Sync name:            $sync
Current state:        $s->{state}$morepid
Type:                 $s->{synctype}
Source herd/database: $s->{source} / $sourcedb
$target
Tables in sync:       $numtables
Last good:            $s->{lastgood}$moregood
Ins/Upd/Del:          $s->{iud}
Last bad:             $s->{lastbad}$morebad
PID file:             $s->{PIDFILE}
PID file created:     $s->{CREATED}
Status:               $s->{status}
Limitdbs:             $s->{limitdbs}
Priority:             $s->{priority}
Checktime:            $s->{checktime}
Overdue time:         $s->{overdue}
Expired time:         $s->{expired}
Stayalive:            $s->{stayalive}      Kidsalive: $s->{kidsalive}
Rebuild index:        $s->{rebuild_index}        Do_listen: $s->{do_listen}
Ping:                 $s->{ping}      Makedelta: $s->{makedelta}
Onetimecopy:          $s->{onetimecopy}
};
        if ($s->{synctype} eq 'fullcopy'){
            print qq{Custom select:        $s->{usecustomselect} $s->{copyextra}\n};
            print qq{Post-copy analyze:    $s->{analyze_after_copy}\n};
            print qq{Delete method:        $s->{deletemethod}\n};
        }

    }
    exit 0;

} ## end of status_detail


sub get_config {

    my $name = shift;

    $SQL = 'SELECT value FROM bucardo.bucardo_config WHERE lower(setting) = ?';
    $sth = $dbh->prepare_cached($SQL);
    $count = $sth->execute(lc $name);
    if ($count < 1) {
        $sth->finish();
        die "Invalid bucardo_config setting: $name\n";
    }
    return $sth->fetchall_arrayref()->[0][0];

} ## end of get_config


sub set_reason {

    my $required = shift || 0;

    if (! length $nouns) {
        return 1 if ! $required;
        warn qq{Please provide a reason. For example:\n$progname $verb "Adding new table -Greg"\n};
        exit 1;
    }

    open my $fh, '>', $REASONFILE or die qq{Could not open "$REASONFILE": $!\n};
    print {$fh} (scalar localtime) . " | $nouns\n";
    close $fh or warn qq{Could not close $REASONFILE: $!\n};
    open $fh, '>>', $REASONFILE_LOG or die qq{Could not open "$REASONFILE_LOG": $!\n};
    print {$fh} (scalar localtime) . " | $verb | $nouns\n";
    close $fh or warn qq{Could not close $REASONFILE_LOG: $!\n};
    return 1;

} ## end of set_reason


sub stop_bucardo {

    open my $stop, '>', $STOPFILE or die qq{Could not create "$STOPFILE": $!\n};
    print {$stop} "Stopped by $progname on " . (scalar localtime) . "\n";
    close $stop or warn qq{Could not close "$STOPFILE": $!\n};
    return;

} ## end of stop_bucardo


sub get_detailed_syncs {

    my $arg = shift || {};

    my $synclist = get_syncs();

    ## Now see exactly what's going on with it at this moment (according to q)

    ## First, we need to hard-code our time backwards

    $SQL = "SELECT date (now() - '$DAYSBACK days'::interval)";
    my $oldtime = $dbh->selectall_arrayref($SQL)->[0][0];
    $dbh->do('SET constraint_exclusion = true');

    ## We want information about the last time it ran successfully
    $SQL = qq{
SELECT *, 
TO_CHAR(ended,'$DATEFORMAT') AS last_ended_date,
TO_CHAR(aborted,'$DATEFORMAT') AS last_aborted_date,
round(extract(epoch FROM ended-started)) AS total_time_ended,
round(extract(epoch FROM aborted-started)) AS total_time_aborted,
round(extract(epoch FROM now()-ended)) AS last_ended_secs,
round(extract(epoch FROM now()-aborted)) AS last_aborted_secs
FROM
(SELECT * FROM bucardo.q WHERE sync = \$1 AND cdate >= '$oldtime'
UNION ALL
SELECT * FROM freezer.master_q WHERE sync = \$1 AND cdate >= '$oldtime') AS foo
WHERE ended is NOT NULL AND aborted IS NULL
ORDER BY ended DESC LIMIT 1;
};
    $sth{latest_good} = $dbh->prepare($SQL);

    ## If the last one was an abort, find the latest good run:
    $SQL =~ s/IS NULL/IS NOT NULL/;
    $sth{latest_bad} = $dbh->prepare($SQL);

    ## Is it running right now?
    ## no critic (ProhibitInterpolationOfLiterals)
    $SQL = qq{
SELECT *,
round(extract(epoch FROM now()-cdate)) AS q1,
round(extract(epoch FROM now()-started)) AS q2
FROM bucardo.q
WHERE sync = \$1
AND ended IS NULL
AND aborted IS NULL
ORDER BY started DESC LIMIT 1
};
    ## use critic
    $sth{active_now} = $dbh->prepare($SQL);

    my %max = (
               name     => 4,
               type     => 5,
               stat     => 5,
               pid      => 3,
               q1       => 6,
               q2       => 6,
               iud      => 5,
               good     => 9,
               total    => 5,
               bad      => 8,
               totalbad => 4,
               );
    for my $sync (sort keys %$synclist) {
        if ($arg->{syncs}) {
            next unless grep { $_ eq $sync } @{$arg->{syncs}}; ## no critic (ProhibitBooleanGrep)
        }
        $DEBUG and warn "Reading sync $sync...\n";

        my $s = $synclist->{$sync};

        ## Normal types are too long
        $s->{typetext} = ' ' . uc(substr $s->{synctype},0,1);

        ## Set some basic lengths
        $max{name} = length($sync) if length($sync) > $max{name};
        $s->{PID} = 0 if ! defined $s->{PID};
        $max{pid} = length($s->{PID}) if length($s->{PID}) > $max{pid};

        ## Grab information from the q tables
        $sth{latest_good}->execute($sync);
        $s->{latest_good}  = $sth{latest_good}->fetchall_arrayref({})->[0];

        $sth{latest_bad}->execute($sync);
        $s->{latest_bad} = $sth{latest_bad}->fetchall_arrayref({})->[0];

        $sth{active_now}->execute($sync);
        $s->{active_now} = $sth{active_now}->fetchall_arrayref({});

        ## Pretty up the times
        $s->{lastgoodsecs} = $s->{lastgoodtime} = 0;
        $s->{lastbadsecs} = $s->{lastbadtime} = 0;
        $s->{lastgood} = $s->{lastbad} = 'unknown';
        $s->{timegood} = $s->{timebad} = '';
        $s->{iud} = '';
        $s->{is_overdue} = $s->{is_expired} = '?';
        if (defined $s->{latest_good}) {
            my $g = $s->{latest_good};
            $s->{iud} = "$g->{inserts}/$g->{updates}/$g->{deletes}";
            $max{iud} = length($s->{iud}) if length($s->{iud}) > $max{iud};

            $s->{timegood} = pretty_time($g->{total_time_ended});
            $max{total} = length($s->{timegood}) if length($s->{timegood}) > $max{total};
            $s->{lastgoodtime} = $g->{total_time_ended};

            $s->{lastgood} = pretty_time($g->{last_ended_secs});
            $max{good} = length($s->{lastgood}) if length($s->{lastgood}) > $max{good};
            $s->{lastgoodsecs} = $g->{last_ended_secs};

            $s->{is_overdue} = ($g->{last_ended_secs} > $s->{overdue_secs}) ? 'yes' : 'no';
            $s->{is_expired} = ($g->{last_ended_secs} > $s->{expired_secs}) ? 'yes' : 'no';

        }
        $s->{is_expired} = 'no' if $s->{expired_secs} < 1;
        $s->{is_overdue} = 'no' if $s->{overdue_secs} < 1;

        if (defined $s->{latest_bad}) {
            $s->{timebad} = pretty_time($s->{latest_bad}{total_time_aborted});
            $max{totalbad} = length($s->{timebad}) if length($s->{timebad}) > $max{totalbad};
            $s->{lastbadtime} = $s->{latest_bad}{total_time_aborted};

            $s->{lastbad} = pretty_time($s->{latest_bad}{last_aborted_secs});
            $max{bad} = length($s->{lastbad}) if length($s->{lastbad}) > $max{bad};
            $s->{lastbadsecs} = $s->{latest_bad}{last_aborted_secs};
        }

        ## Check for current activity
        $s->{timeq1} = $s->{timeq2} = '';
        for my $row (@{$s->{active_now}}) {
            $s->{timeq} = $s->{timeq1} = pretty_time($row->{q1});
            if (defined $row->{q2}) {
                $s->{timeq} = $s->{timeq2} = pretty_time($row->{q2});
            }
            my $len = length('WAIT:') + length($s->{timeq});
            if (length $s->{timeq2}) {
                $len += (1 + length($s->{targetdb}));
            }
            $max{stat} = $len if $len > $max{stat};
            last;
        }

        $s->{state} = length($s->{timeq2}) ? "RUN:$s->{timeq}>$s->{targetdb}" :
            length($s->{timeq1}) ? "WAIT:$s->{timeq}" :
            ($s->{status} eq 'active') ? 'idle' : 'off';

        ## Is anything overdue or expired?
        if ($s->{is_expired} eq 'yes') {
            $s->{typetext} .= ' E!'
        }
        elsif ($s->{is_overdue} eq 'yes') {
            $s->{typetext} .= ' O!';
        }
        elsif ($s->{is_expired} ne 'no') {
            $s->{typetext} .= ' ?';
        }

    }

    return $synclist, \%max;

} ## end of get_detailed_syncs


sub inspect {

    my $usage = usage('inspect');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }
    my $thing = shift @nouns;

    inspect_table() if $thing =~ /tab/i  or $thing eq 't';
    inspect_sync()  if $thing =~ /sync/i or $thing eq 's';
    inspect_herd()  if $thing =~ /herd/i or $thing eq 'h';

    warn "$usage\n";
    exit 1;

} ## end of inspect


sub inspect_table {

    my $usage = usage('inspect_table');

    if (! @nouns) {
        warn "$usage\n";
        exit 1;
    }

    $SQL = q{SELECT * FROM bucardo.goat WHERE tablename=?};
    my $sth_goat = $dbh->prepare($SQL);
    $SQL = q{SELECT * FROM bucardo.goat WHERE schemaname = ? AND tablename=?};
    my $sth_goat_schema = $dbh->prepare($SQL);
    my @tables;
    for my $name (@nouns) {
        my $sthg;
        if ($name =~ /(.+)\.(.+)/) {
            $sthg = $sth_goat_schema;
            $count = $sthg->execute($1,$2);
        }
        else {
            $sthg = $sth_goat;
            $count = $sthg->execute($name);
        }
        if ($count < 1) {
            die "Unknown table: $name\n";
        }

        for my $row (@{$sthg->fetchall_arrayref({})}) {
            push @tables, $row;
        }

    }

    for my $t (@tables) {
        my ($s,$t,$db,$id) = @$t{qw/schemaname tablename db id/};
        print "Inspecting $s.$t on $db\n";
        ## Grab all other tables referenced by this one
        my $tablist = get_reffed_tables($s,$t,$db);

        ## Check that each referenced table is in a herd with this table
        load_bucardo_info();

        my %seenit;
        for my $tab (@$tablist) {
            my ($type,$tab1,$tab2,$name,$def) = @$tab;
            my $table = $type==1 ? $tab1 : $tab2;
            if ($table !~ /(.+)\.(.+)/) {
                die "Invalid table information\n";
            }
            my $schema = $1;
            $table = $2;
            next if $seenit{"$schema.$table.$type"}++;

            ## Make sure that each herd with this table also has this new table
            my $ggoat = $global{goat};
            my $hherd = $global{herd};
            for my $herd (sort keys %{$ggoat->{$id}{herd}}) {
                $seenit{fktable} = 1;
                next if exists $hherd->{$herd}{hasgoat}{$schema}{$table};
                printf "Table %s.%s is in herd %s, but %s.%s (used as FK%s) is not\n",
                    $s, $t, $herd, $schema, $table,
                        $type == 1 ? '' : ' target';

            }
            if (! exists $seenit{fktable}) {
                printf "Table %s.%s is used as FK%s by %s.%s\n",
                    $s,$t,$type==1 ? '' : ' target', $schema, $table;
                delete $seenit{fktable};
            }
        }
    }

    exit 0;

} ## end of inspect_table


sub inspect_herd {

    my $usage = usage('inspect_herd');

    if (! @nouns) {
        warn "$usage\n";
        exit 1;
    }

    die "Not implemented yet\n";

} ## end of inspect_herd


sub inspect_sync {

    my $usage = usage('inspect_sync');

    if (! @nouns) {
        warn "$usage\n";
        exit 1;
    }

    die "Not implemented yet\n";

} ## end of inspect_sync


sub get_reffed_tables {

    my ($s,$t,$db) = @_;

    my $rdbh = connect_database({name => $db});

    ## So we get the schemas
    $rdbh->do('SET search_path = pg_catalog');

    $SQL= q{
SELECT CASE WHEN conrelid=x.toid THEN 1 ELSE 2 END,
 confrelid::regclass,
 conrelid::regclass,
 conname,
 pg_get_constraintdef(oid, true)
FROM pg_constraint,
(SELECT c.oid AS toid FROM pg_class c JOIN pg_namespace n
   ON (n.oid=c.relnamespace) WHERE nspname=? AND relname=?
) x
WHERE contype = 'f' AND
(confrelid = x.toid OR conrelid = x.toid)
};

    $sth = $rdbh->prepare($SQL);
    $count = $sth->execute($s,$t);
    return $sth->fetchall_arrayref();

} ## end of get_reffed_tables


sub load_bucardo_info {

    ## One-time load of all information from the database

    my $force = shift || 0;

    return if exists $global{db} and ! $force;

    ## Grab all database information
    $SQL = 'SELECT * FROM bucardo.db';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my $db = $sth->fetchall_hashref('name');

    ## Grab all database information
    $SQL = 'SELECT * FROM bucardo.dbgroup';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my $dbgroup = $sth->fetchall_hashref('name');

    ## Map databases to their groups
    $SQL = 'SELECT * FROM bucardo.dbmap';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    for my $row (@{$sth->fetchall_arrayref({})}) {
        $db->{$row->{db}}{group}{$row->{dbgroup}}++;
        $dbgroup->{$row->{dbgroup}}{db}{$row->{db}}++;
    }

    ## Grab all goat information
    $SQL = 'SELECT * FROM bucardo.goat';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my $goat = $sth->fetchall_hashref('id');
    ## Since relations cannot start with a number, we can also safely add the name to the hash
    for my $key (%$goat) {
        next if $key !~ /^\d/;
        my $tname = $goat->{$key}{tablename};
        my $name = "$goat->{$key}{schemaname}.$tname";
        $goat->{$name} = $goat->{$key};
        ## Also want a table-only version:
        push @{$goat->{$tname}} => $goat->{$key};
    }

    ## Grab all herd information
    $SQL = 'SELECT * FROM bucardo.herd';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my $herd = $sth->fetchall_hashref('name');

    ## Grab all herdmap information, stick into previous hashes
    $SQL = 'SELECT * FROM bucardo.herdmap ORDER BY priority DESC, goat ASC';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    for my $row (@{$sth->fetchall_arrayref({})}) {
        my ($g,$h,$p) = @$row{qw/goat herd priority/};
        $goat->{$g}{herd}{$h} = $p;
        push @{$herd->{$h}{goat}} => [$g,$p,$goat->{$g}{reltype},$goat->{$g}{schemaname},$goat->{$g}{tablename}];
        my ($s,$t) = @{$goat->{$g}}{qw/schemaname tablename/};
        $herd->{$h}{hasgoat}{$s}{$t} = $p;
        ## Assign each herd to a datbase via its included goats
        $herd->{$h}{db} = $goat->{$g}{db};
    }

    ## Grab all sync information
    $SQL = 'SELECT * FROM bucardo.sync';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my $sync;
    for my $row (@{$sth->fetchall_arrayref({})}) {
        my ($name,$p,$source,$td,$tg) = @$row{qw/name priority source targetdb targetgroup/};
        $sync->{$name} = $row;
        ## Add in herd information
        $sync->{$name}{herd} = $herd->{$source};
        ## Add this sync back to the herd
        $herd->{$source}{sync}{$name}++;
        ## Add this sync back to the source database
        if (defined $herd->{$source}{db}) {
            $db->{$herd->{$source}{db}}{sourcesync}{$name}++;
        }
        if (defined $td) {
            $db->{$td}{targetsync}{$name}++;
        }
        elsif (defined $tg) {
            for my $idb (keys %{$dbgroup->{$tg}{db}}) {
                $db->{$idb}{targetsync}{$name}++;
            }
        }
    }

    ## Grab all customcode information
    $SQL = 'SELECT * FROM bucardo.customcode';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my $cc = $sth->fetchall_hashref('name');
    $SQL = 'SELECT * FROM bucardo.customcode_map';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my %codename;
    for my $row (values %$cc) {
        $codename{$row->{id}} = $row->{name};
    }
    for my $row (@{$sth->fetchall_arrayref({})}) {
        my $codename = $codename{$row->{code}};
        push @{$cc->{$codename}{map}} => $row;
    }

    $global{cc} = $cc;
    $global{dbgroup} = $dbgroup;
    $global{db} = $db;
    $global{goat} = $goat;
    $global{herd} = $herd;
    $global{sync} = $sync;

    return;

} ## end of load_bucardo_info


sub show_all_columns {

    my $row = shift or die;

    my $maxkey = 1;
    for my $key (keys %$row) {
        $maxkey = length $key if length $key > $maxkey;
    }
    for my $key (sort {
        ($a eq 'src_code' and $b ne 'src_code' ? 1 : 0)
        or
        ($a ne 'src_code' and $b eq 'src_code' ? -1 : 0)
        or
        $a cmp $b } keys %$row
     ) {
        printf "    %-*s = %s\n", $maxkey, $key,
            defined $row->{$key} ? $row->{$key} : 'NULL';
    }

    return;

} ## end of show_all_columns


sub process_args {

    ## Break apart a string of args, return a clean hashref

    my $string = shift or return {};
    $string .= ' ';

    my %arg;

    while ($string =~ m/(\w+)\s*=\s*"(.+?)" /g) {
        $arg{$1} = $2;
    }
    $string =~ s/\w+\s*=\s*".+?" / /g;

    while ($string =~ m/(\w+)\s*=\s*'(.+?)' /g) {
        $arg{$1} = $2;
    }
    $string =~ s/\w+\s*=\s*'.+?' / /g;

    while ($string =~ m/(\w+)\s*=\s*(\S+)/g) {
        $arg{$1} = $2;
    }
    $string =~ s/\w+\s*=\s*\S+/ /g;

    if ($string =~ /\S/) {
        $string =~ s/^\s+//;
        $arg{extraargs} = [split /\s+/ => $string];
    }

    return \%arg;

} ## end of process_args


sub process_simple_args {

    ## Process args to an inner function in the style of a=b

    my $arg = shift;
    my $validcols = $arg->{cols} or die 'Need a list of valid cols!';
    my $list = $arg->{list}      or die 'Need a list of arguments!';
    my $usage = $arg->{usage}    or die 'Need a usage!';

    my %item;
    my %dbcol;
    ## Parse the validcols string, and setup any non-null defaults
    for my $row (split /\n/ => $validcols) {
        next if $row !~ /\w/ or $row =~ /^#/;
        $row =~ /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(.+)/ or die "Invalid valid cols ($row)";
        my ($args,$dbcol,$flag,$default) = ([split /\|/ => $1],$2,$3,$4);
        for my $name (@$args) {
            $item{$name} = [$dbcol,$flag,$default];
        }
        if ($default ne 'null' and $default ne 'skip') {
            $dbcol{$dbcol} = $default;
        }
    }

    ## Transform array of x=y into a hashref
    my $args = process_args(join ' ' => @$list);

    for my $arg (sort keys %$args) {
        next if $arg eq 'extraargs';
        if (! exists $item{$arg}) {
            die "Unknown option '$arg'\n$usage\n";
        }
        (my $val = $args->{$arg}) =~ s/^\s*(\S+)\s*$/$1/;
        my ($dbcol,$flag,$default) = @{$item{$arg}};
        if ($flag eq '0') {
            ## noop
        }
        elsif ($flag eq 'TF') {
            $val =~ s/^\s*t(?:rue)*\s*$/1/i;
            $val =~ s/^\s*f(?:alse)*\s*$/0/i;
            if ($val !~ /^[01]$/) {
                die "Invalid value for '$arg': must be true of false\n";
            }
        }
        elsif ($flag eq 'numeric') {
            if ($val !~ /^\d+$/) {
                die "Invalid value for '$arg': must be numeric\n";
            }
        }
        elsif ($flag =~ /^=(.+)/) {
            my $ok = 0;
            for my $okval (split /\|/ => $1) {
                if ($okval =~ /~/) { ## aliases - force to the first one
                    my @alias = split /~/ => $okval;
                    for my $al (@alias) {
                        if ($val eq $al) {
                            $ok = 1;
                            last;
                        }
                    }
                    if ($ok) {
                        $val = $alias[0];
                        last;
                    }
                }
                elsif (lc $val eq lc $okval) {
                    $ok = 1;
                    last;
                }
            }
            if (!$ok) {
                (my $arglist = $flag) =~ s/\|/ or /g;
                $arglist =~ s/^=//;
                $arglist =~ s/~\w+//g;
                die "Invalid value for '$arg': must be one of $arglist\n";
            }
        }
        elsif ($flag eq 'interval') {
            ## Nothing for now
        }
        else {
            die "Unknown flag '$flag' for $arg";
        }

        ## Value has survived our minimal checking. Store it and clobber any default
        $dbcol{$dbcol} = $val;

    }

    ## Build the lists of columns and placeholders for the SQL statement
    my ($cols,$phs,$vals) = ('','',[]);
    for my $col (sort keys %dbcol) {
        next if $item{$col}[2] eq 'skip';
        $cols .= "$col,";
        $phs .= '?,';
        push @$vals => $dbcol{$col};
    }
    $cols =~ s/,$//;
    $phs =~ s/,$//;

    return \%dbcol, $cols, $phs, $vals;

} ## end of process_simple_args


sub list {

    my $usage = usage('list');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }
    my $thing = shift @nouns;

    list_customcodes() if $thing =~ /^code/i or $thing =~ /^custom/i;
    list_dbgroups()    if $thing =~ /^dbg/i; ## Must come before the db check!
    list_dbs()         if $thing =~ /^db/i;
    list_herds()       if $thing =~ /^h/i;
    list_syncs()       if $thing =~ /^sy/i;
    list_tables()      if $thing =~ /^t/i;
    list_sequences()   if $thing =~ /^seq/i;

    warn "$usage\n";
    exit 1;

} ## end of list


sub list_customcodes {

    ## Show information about all or some subset of the 'customcode' table

    my $usage = usage('list_customcodes');

    ## Any nouns are filters against the whole list
    my $clause = generate_clause({col => 'name', items => \@nouns});
    my $WHERE = $clause ? "WHERE $clause" : '';
    $SQL = "SELECT * FROM bucardo.customcode $WHERE ORDER BY name";
    $sth = $dbh->prepare($SQL);
    $count = $sth->execute();
    if ($count < 1) {
        $sth->finish();
        printf "There are no%s entries in the 'db' table.\n",
            $WHERE ? ' matching' : '';
        exit 1;
    }

    $info = $sth->fetchall_arrayref({});

    my ($maxname,$maxwhen) = (1,1);
    for my $row (@$info) {
        $maxname = length $row->{name} if length $row->{name} > $maxname;
        $maxwhen = length $row->{whenrun} if length $row->{whenrun} > $maxwhen;
    }

    for my $row (@$info) {
        my $name = $row->{name};
        printf "Code: %-*s  When run: %-*s  Get dbh: %s  Get rows: %s Trigrules: %s\n",
            $maxname, $name,
            $maxwhen, $row->{whenrun},
            $row->{getdbh}, $row->{getrows}, $row->{trigrules};
        if (defined $row->{about} and $VERBOSE) {
            (my $about = $row->{about}) =~ s/(.)^/$1    /gsm;
            print "  About: $about\n";
        }
        $VERBOSE >= 2 and show_all_columns($row);
    }

    exit 0;

} ## end of list_customcodes


sub list_dbs {

    ## Show information about all or some subset of the 'db' table

    my $usage = usage('list_dbs');

    ## Any nouns are filters against the whole list
    my $clause = generate_clause({col => 'name', items => \@nouns});
    my $WHERE = $clause ? "WHERE $clause" : '';
    $SQL = "SELECT * FROM bucardo.db $WHERE ORDER BY name";
    $sth = $dbh->prepare($SQL);
    $count = $sth->execute();
    if ($count < 1) {
        $sth->finish();
        printf "There are no%s entries in the 'db' table.\n",
            $WHERE ? ' matching' : '';
        exit 1;
    }

    $info = $sth->fetchall_arrayref({});

    my ($maxdb,$maxstat,$maxlim1,$maxlim2,$showlim) = (1,1,1,1,0);
    for my $row (@$info) {
        $maxdb = length $row->{name} if length $row->{name} > $maxdb;
        $maxstat = length $row->{status} if length $row->{status} > $maxstat;
        $maxlim1 = length $row->{sourcelimit} if length $row->{sourcelimit} > $maxlim1;
        $maxlim2 = length $row->{targetlimit} if length $row->{targetlimit} > $maxlim2;
        $showlim = 1 if $row->{sourcelimit} or $row->{targetlimit};
    }

    for my $row (@$info) {
        my $name = $row->{name};
        printf 'Database: %-*s  Status: %-*s  ',
            $maxdb, $name,
            $maxstat, $row->{status};
        if ($showlim) {
            printf 'Limits: %-*s/%-*s  ',
                $maxlim1, $row->{sourcelimit},
                $maxlim2, $row->{targetlimit},
        }
        my $showhost = length $row->{dbhost} ? " -h $row->{dbhost}" : '';
        print "Conn: psql -p $row->{dbport} -U $row->{dbuser} -d $row->{dbname}$showhost";
        if (! $row->{server_side_prepares}) {
            print ' (SSP is off)';
        }
        print "\n";

        if ($VERBOSE) {
            load_bucardo_info();
            my $db = $global{db};

            ## Which database groups is this a member of?
            if (exists $db->{$name}{group}) {
                print '  Belongs to database groups: ';
                print join ', ' => sort keys %{$db->{$name}{group}};
                print "\n";
            }

            ## Which syncs are using it (source vs. target)
            if (exists $db->{$name}{sourcesync}) {
                print '  Used as source in syncs: ';
                print join ', ' => sort keys %{$db->{$name}{sourcesync}};
                print "\n";
            }
            if (exists $db->{$name}{targetsync}) {
                print '  Used as target in syncs: ';
                print join ', ' => sort keys %{$db->{$name}{targetsync}};
                print "\n";
            }

            $VERBOSE >= 2 and show_all_columns($row);
        }
    }

    exit 0;

} ## end of list_dbs


sub list_dbgroups {

    ## Show information about all or some subset of the 'dbgroup' table

    my $usage = usage('list_dbgroups');

    ## Any nouns are filters against the whole list
    my $clause = generate_clause({col => 'name', items => \@nouns});
    my $WHERE = $clause ? "WHERE $clause" : '';
    $SQL = "SELECT * FROM bucardo.dbgroup $WHERE ORDER BY name";
    $sth = $dbh->prepare($SQL);
    $count = $sth->execute();
    if ($count < 1) {
        $sth->finish();
        printf "There are no%s entries in the 'dbgroup' table.\n",
            $WHERE ? ' matching' : '';
        exit 1;
    }
    $info = $sth->fetchall_arrayref({});

    ## Get sizing information
    my $maxlen = 1;
    for my $row (@$info) {
        $maxlen = length $row->{name} if length $row->{name} > $maxlen;
    }

    load_bucardo_info();

    for my $row (@$info) {
        my $dbs = '';
        if (exists $global{dbgroup}{$row->{name}}{db}) {
            $dbs = '  Members: ';
            $dbs .= join ', ' => sort keys %{$global{dbgroup}{$row->{name}}{db}};
        }
        printf "Database group: %-*s%s\n",
            $maxlen, $row->{name}, $dbs;
        $VERBOSE >= 2 and show_all_columns($row);
    }

    exit 0;

} ## end of list_dbgroups


sub list_herds {

    ## Show information about all or some subset of the 'herd' table

    my $usage = usage('list_herds');

    ## Any nouns are filters against the whole list
    my $clause = generate_clause({col => 'name', items => \@nouns});
    my $WHERE = $clause ? "WHERE $clause" : '';
    $SQL = "SELECT * FROM bucardo.herd $WHERE ORDER BY name";
    $sth = $dbh->prepare($SQL);
    $count = $sth->execute();
    if ($count < 1) {
        $sth->finish();
        printf "There are no%s entries in the 'herd' table.\n",
            $WHERE ? ' matching' : '';
        exit 1;
    }
    $info = $sth->fetchall_arrayref({});

    ## Get sizing information
    my $maxlen = 1;
    for my $row (@$info) {
        $maxlen = length $row->{name} if length $row->{name} > $maxlen;
    }

    load_bucardo_info();

    ## Figure out which goats are in each of these herds
    for my $row (@$info) {
        my $name = $row->{name};
        my $h = $global{herd}{$name};
        printf 'Herd: %-*s  DB: %s ',
            $maxlen, $name, $h->{db};
        ## Got goats?
        if (exists $h->{goat}) {
            print ' Members: ';
            print join ', ' => map { "$_->[3].$_->[4]" } @{$h->{goat}};
        }
        ## Got syncs?
        if (exists $h->{sync}) {
            print "\n  Used in syncs: ";
            print join ', ' => sort keys %{$h->{sync}};
        }
        print "\n";
        $VERBOSE >= 2 and show_all_columns($row);
    }


    exit 0;

} ## end of list_herds


sub list_syncs {

    ## Show information about all or some subset of the 'sync' table

    my $usage = usage('list_syncs');

    ## Strip out special words from the nouns list as modifiers
    my @mod;
    my $WHERE = '';
    for my $term (@nouns) {
        if ($term =~ /^(?:swap|pushdelta|fullcopy)$/i) {
            push @mod => lc $term;
            next;
        }
        my $wild = $term =~ s/[*%]//g ? '~' : '=';
        $WHERE .= sprintf q{%s lower(name) %s %s },
            $WHERE ? 'OR' : 'WHERE',
            $wild,
            $dbh->quote(lc $term);
    }

    $SQL = "SELECT * FROM bucardo.sync $WHERE ORDER BY name";
    my $mod = join ' OR ' => map { "synctype = '$_'" } @mod;
    if ($mod) {
        if ($SQL =~ /WHERE /) {
            $SQL =~ s/WHERE (.+)\s+ORDER BY/WHERE ($mod) AND ($1) ORDER BY/;
        }
        else {
            $SQL =~ s/sync/sync WHERE $mod/;
        }
    }

    $sth = $dbh->prepare($SQL);
    $count = $sth->execute();
    if ($count < 1) {
        $sth->finish();
        printf "There are no%s entries in the 'sync' table.\n",
            $SQL =~ /WHERE/ ? ' matching' : '';
        exit 1;
    }

    $info = $sth->fetchall_arrayref({});
    my ($namelen,$goatlen,$maxsource,$maxtarget,$maxtype) = (5,1,3,3,4);
    for my $row (@$info) {
        $namelen = length $row->{name} if length $row->{name} > $namelen;
        $maxsource = length $row->{source} if length $row->{source} > $maxsource;
        my $tsize = $row->{targetdb} ? length $row->{targetdb} : length $row->{targetgroup};
        $maxtarget = $tsize if $tsize > $maxtarget;
        $maxtype = length $row->{synctype} if length $row->{synctype} > $maxtype;
    }

    ## If in verbose mode, grab all the tables as well
    my $tabinfo;
    if ($VERBOSE >= 1) {
        load_bucardo_info();
    }

    for my $row (@$info) {
        my $name = $row->{name};
        printf "Sync: %-*s  (%-*s)  %-*s %-3s %-*s  (%s)\n",
            $namelen, $name,
            $maxtype, $row->{synctype},
            $maxsource, $row->{source},
            $row->{synctype} eq 'swap' ? '<=>' : '=>',
            $maxtarget, $row->{targetdb} || $row->{targetgroup},
                ucfirst $row->{status};

        ## Show associated tables if in verbose mode
        if ($VERBOSE >= 1) {
            if (exists $global{sync}{$name}{herd}{goat}) {
                for my $irow (@{$global{sync}{$name}{herd}{goat}}) {
                    printf "  %s %s.%s\n",
                        ucfirst($irow->[2]),$irow->[3],$irow->[4];
                }
            }
        }

        $VERBOSE >= 2 and show_all_columns($row);
    }

    exit 0;

} ## end of list_syncs


sub list_tables {

    ## Show information about all or some tables in the 'goat' table

    my $usage = usage('list_tables');

    my $clause = generate_clause({col => 'tablename', items => \@nouns});
    my $WHERE = $clause ? "AND $clause" : '';
    $SQL = "SELECT * FROM bucardo.goat WHERE reltype='table' $WHERE ORDER BY schemaname, tablename";
    $sth = $dbh->prepare($SQL);
    $count = $sth->execute();
    if ($count < 1) {
        $sth->finish();
        printf "There are no%s entries in the 'goat' table.\n",
            $WHERE ? ' matching' : '';
        exit 1;
    }

    $info = $sth->fetchall_arrayref({});

    ## Are we showing verbose information? Get matching herds
    $VERBOSE and load_bucardo_info();

    my ($maxtable,$maxdb,$maxpkey) = (1,1,1);
    for my $row (@$info) {
        my $name = "$row->{schemaname}.$row->{tablename}";
        $maxtable = length $name if length $name > $maxtable;
        $name = $row->{pk} = $row->{pkey} ? "$row->{pkey} ($row->{pkeytype})" : 'none';
        $maxpkey = length $name if length $name > $maxpkey;
        $maxdb = length $row->{db} if length $row->{db} > $maxdb;
   }

    for my $row (@$info) {
        printf "Table: %-*s  DB: %-*s  PK: %s\n",
            $maxtable, "$row->{schemaname}.$row->{tablename}",
            $maxdb, $row->{db},
            $row->{pk};
        if ($VERBOSE) {
            my $g = $global{goat}->{$row->{id}};
            if (exists $g->{herd}) {
                print '  Belongs to herds: ';
                print join ', ' => sort keys %{$g->{herd}};
                print "\n";
                my %syncs;
                for my $herd (keys %{$g->{herd}}) {
                    my $h = $global{herd}->{$herd};
                    for my $s (keys %{$h->{sync}}) {
                        $syncs{$s}++;
                    }
                }
                if (keys %syncs) {
                    print '  Belongs to syncs: ';
                    print join ', ' => sort keys %syncs;
                    print "\n";
                }
            }
        }

        $VERBOSE >= 2 and show_all_columns($row);

    }

    exit 0;

} ## end of list_tables


sub list_sequences {

    ## Show information about all or some sequences in the 'goat' table

    my $usage = usage('list_sequences');

    my $clause = generate_clause({col => 'tablename', items => \@nouns});
    my $WHERE = $clause ? "AND $clause" : '';
    $SQL = "SELECT * FROM bucardo.goat WHERE reltype = 'sequence' $WHERE ORDER BY schemaname, tablename";
    $sth = $dbh->prepare($SQL);
    $count = $sth->execute();
    if ($count < 1) {
        $sth->finish();
        printf "There are no%s entries in the 'goat' table.\n",
            $WHERE ? ' matching' : '';
        exit 1;
    }

    $info = $sth->fetchall_arrayref({});
    my $maxq = 1;
    for my $row (@$info) {
        my $len = length "$row->{schemaname}.$row->{tablename}";
        $maxq = $len if $len > $maxq;
    }

    for my $row (@$info) {
        printf "Sequence: %-*s  DB: %s\n",
            $maxq, "$row->{schemaname}.$row->{tablename}",
              $row->{db};
        $VERBOSE >= 2 and show_all_columns($row);
    }

    exit 0;

} ## end of list_sequences


sub pretty_time {

    my $secs = shift;
    return '?' if ! defined $secs or $secs !~ /^\-?\d+$/o or $secs < 0;
    my ($D,$H,$M,$S) = (0,0,0,0);

    if ($bcargs->{showdays}) {
        if ($secs > 60*60*24) {
            $D = int $secs/(60*60*24);
            $secs -= $D*60*60*24;
        }
    }
    if ($secs > 60*60) {
        $H = int $secs/(60*60);
        $secs -= $H*60*60;
    }
    if ($secs > 60) {
        $M = int $secs/60;
        $secs -= $M*60;
    }
    $secs = int $secs;
    my $answer = sprintf "%s%s%s${secs}s",$D ? "${D}d " : '',$H ? "${H}h " : '',$M ? "${M}m " : '';

    ## Detailed listings get compressed
    if ((defined $COMPRESS and $COMPRESS) or (!defined $COMPRESS and !@nouns)) {
        $answer =~ s/ //g;
    }
    return $answer;
}


sub get_syncs {

    my %dbgroup;
    $SQL = 'SELECT dbgroup, db FROM bucardo.dbmap ORDER BY priority, db';
    for my $row (@{$dbh->selectall_arrayref($SQL)}) {
        push @{$dbgroup{$row->[0]}}, $row->[1];
    }

    $SQL = q{
        SELECT *,
            COALESCE(EXTRACT(epoch FROM checktime),0) AS checksecs,
            now()-overdue AS overdue_time,
            now()-expired AS expired_time,
            extract(epoch FROM overdue) AS overdue_secs,
            extract(epoch FROM expired) AS expired_secs
        FROM     bucardo.sync
        ORDER BY priority DESC, name DESC
    };
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my $sync = $sth->fetchall_hashref('name');

    ## Expand any targetgroups in use
    for (keys %$sync) {
        my $s = $sync->{$_};
        if (defined $s->{targetgroup}) {
            $s->{targets} = $dbgroup{$s->{targetgroup}};
        }
    }
    ## Check what exists in the pid directory
    opendir my $sdir, $PIDDIR or return $sync;
    my $syncpidfile;
    while (defined ($syncpidfile = readdir($sdir))) {
        next if $syncpidfile =~ /^\.\.?$/
            or "$PIDDIR/$syncpidfile" eq $STOPFILE
            or "$PIDDIR/$syncpidfile" eq $PIDFILE;
        if ($syncpidfile !~ /^bucardo\.ctl\.sync\.(.+)\.pid$/) {
            next;
        }
        my $syncname = $1; ## no critic (ProhibitCaptureWithoutTest)

        ## Is this a valid syncname?
        if (! exists $sync->{$syncname}) {
            warn qq{Invalid pid file found: $PIDDIR/$syncpidfile - removing it\n};
            unlink "$PIDDIR/$syncpidfile";
            next;
        }

        my $cdate = localtime ($^T - (-C "$PIDDIR/$syncpidfile")*24*60*60);
        $sync->{$syncname}{PIDFILE} = "$PIDDIR/$syncpidfile";
        $sync->{$syncname}{CREATED} = $cdate;

        ## Does it contain a pid?
        open my $fh, '<', "$PIDDIR/$syncpidfile" or die qq{Could not open "$PIDDIR/$syncpidfile": $!\n};
        my $pid = <$fh>;
        chomp $pid;
        if (! defined $pid) { $pid = ''; }
        close $fh or warn qq{Could not close $PIDDIR/$syncpidfile: $!\n};
        if ($pid !~ /^\d+$/) {
            $sync->{$syncname}{NOPID} = 1;
        }
        else {
            $sync->{$syncname}{PID} = $pid;
            $sync->{$syncname}{PIDPING} = kill 0, $pid;
        }
    }
    return $sync;

} ## end of get_syncs


sub vate_sync {

    my $name = lc $verb;
    my $ucname = ucfirst $name;
    @nouns or die qq{${name}_sync requires at least one sync name\n};

    my $wait = (defined $adverb and $adverb eq '0') ? 1 : 0;
    for my $sync (@syncs) {
        (my $vname = $ucname) =~ s/e$/ing/;
        $QUIET or print qq{$vname sync $sync};
        my $done = "bucardo_${name}d_sync_$sync";
        $dbh->do(qq{NOTIFY "bucardo_${name}_sync_$sync"});
        if ($wait) {
            print '...';
            $dbh->do(qq{LISTEN "$done"});
        }
        $dbh->commit();
        if (!$wait) {
            print "\n";
            next;
        }
        sleep 0.1;
      WAITIN: {
            while (my $notify = $dbh->func('pg_notifies')) {
                my ($xname, $pid) = @$notify;
                last WAITIN if $xname eq $done;
            }
            $dbh->commit();
            sleep($WAITSLEEP);
            redo;
        }
        print "OK\n";
    } ## end each sync
    exit 0;

} ## end of vate_sync


sub add_item {

    my $self = shift;

    my $usage = usage('add');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }

    ## First word must be a type we know about
    my $type = shift @nouns;
    $type = lc $type;

    if ($type eq 'code' or $type eq 'customcode' or $type eq 'custom_code') {
        add_customcode();
    }
    elsif ($type eq 'db' or $type eq 'database') {
        add_database();
    }
    elsif ($type eq 'dbgroup' or $type eq 'dbg') {
        add_dbgroup();
    }
    elsif ($type eq 'herd') {
        add_herd();
    }
    elsif ($type eq 'table') {
        add_table('table');
        exit 0;
    }
    elsif ($type eq 'sequence') {
        add_table('sequence');
        exit 0;
    }
    elsif ($type eq 'sync') {
        add_sync();
    }
    elsif ($type eq 'all') {
        my $type2 = shift @nouns || '';
        if ($type2 =~ /table/i) {
            add_all_tables();
        }
        elsif ($type2 =~ /sequence/i) {
            add_all_sequences();
        }
        else {
            warn qq{The 'all' option can only be used with 'table' and 'sequence'\n};
            exit 1;
        }
    }
    else {
        warn usage('add') . "\n";
    }
    exit 1;

} ## end of add_item


sub add_customcode {

    my $item_name = shift @nouns || '';

    my $usage = usage('add_customcode');

    if (!length $item_name) {
        warn "$usage\n";
        exit 1;
    }

    ## Inputs and aliases, database column name, flags, default
    my $whenrunlist = 'before_txn before_check_rows before_trigger_drop after_trigger_drop'
        . ' after_table_sync exception conflict before_trigger_enable after_trigger_enable'
        . ' after_txn before_sync after_sync';
    my $whenrun = join '|' => split /\s+/ => $whenrunlist;
    my $validcols = qq{
        name                     name                 0                $item_name
        about                    about                0                null
        whenrun|when_run         whenrun              =$whenrun        null
        getdbh                   getdbh               TF               null
        getrows                  getrows              TF               null
        trigrules                trigrules            TF               null
        sync                     sync                 0                skip
        goat                     goat                 0                skip
        active                   active               TF               skip
        priority                 priority             number           skip
        src_code                 src_code             0                skip
    };

    my ($dbcols,$cols,$phs,$vals)
        = process_simple_args({cols => $validcols, list => \@nouns, usage => $usage});

    my $newname = $dbcols->{name};

    load_bucardo_info();
    ## Does this already exist?
    if (exists $global{cc}{$newname}) {
        warn qq{Cannot create: customcode "$newname" already exists\n};
        exit 2;
    }

    ## We must have a "whenrun"
    if (! $dbcols->{whenrun}) {
        warn "$usage\n";
        exit 1;
    }

    ## We must have a src_code as a file
    if (! exists $dbcols->{src_code} or ! $dbcols->{src_code}) {
        warn "$usage\n";
        exit 1;
    }
    my $tfile = $dbcols->{src_code};
    if (! -e $tfile) {
        warn qq{Could not find a file named "$tfile"\n};
        exit 2;
    }
    open my $fh, '<', $tfile or die qq{Could not open "$tfile": $!\n};
    my $src = '';
    { local $/; $src = <$fh>; } ## no critic (RequireInitializationForLocalVars)
    close $fh or warn qq{Could not close "$tfile": $!\n};

    ## Attempt to insert this into the database
    $SQL = "INSERT INTO bucardo.customcode ($cols,src_code) VALUES ($phs,?)";
    $DEBUG and warn "SQL: $SQL\n";
    $DEBUG and warn Dumper $vals;
    $sth = $dbh->prepare($SQL);
    eval {
        $count = $sth->execute(@$vals, $src);
    };
    if ($@) {
        die "Failed to add customcode: $@\n";
    }

    my $finalmsg = '';

    ## See if any updates to customcode_map need to be made

    ## Only one of sync or goat can be specified
    if ($dbcols->{sync} and $dbcols->{goat}) {
        die qq{Sorry, you must specify a sync OR a goat, not both\n};
    }

    ## Makes no sense to specify priority or active if no goat or sync
    if (($dbcols->{priority} or $dbcols->{active}) and !$dbcols->{sync} and ! $dbcols->{goat}) {
        die qq{You must specify a sync or a goat when using priority or active\n};
    }

    ## Is this a valid sync?
    if ($dbcols->{sync} and ! exists $global{sync}{$dbcols->{sync}}) {
        die qq{Unknown sync: $dbcols->{sync}\n};
    }

    ## Is this a valid gaot?
    if ($dbcols->{goat} and ! exists $global{goat}{$dbcols->{goat}}) {
        die qq{Unknown goat: $dbcols->{goat}\n};
    }

    ## Add to the customcode_map table
    if ($dbcols->{sync} or $dbcols->{goat}) {
        $SQL = 'INSERT INTO customcode_map(code,';
        my @vals;
        for my $col (qw/sync goat priority active/) {
            if ($dbcols->{$col}) {
                $SQL .= "$col,";
                push @vals => $dbcols->{$col};
            }
        }
        my $phs2 = '?,' x @vals;
        $SQL .= ") VALUES ((SELECT currval('customcode_id_seq')),$phs2)";
        $SQL =~ s/,\)/)/g;
        $sth = $dbh->prepare($SQL);
        eval {
            $count = $sth->execute(@vals);
        };
        if ($@) {
            die "Failed to add customcode_map: $@\n";
        }
    }

    $dbh->commit();

    if (!$QUIET) {
        print qq{Added customcode "$newname"\n};
        $finalmsg and print $finalmsg;
    }

    exit 0;

} ## end of add_customcode


sub add_database {

    ## The first word is the name of the database we connect to (column dbname)
    my $item_name = shift @nouns || '';

    my $usage = usage('add_database');

    if (!length $item_name) {
        warn "$usage\n";
        exit 1;
    }

    ## Inputs and aliases, database column name, flags, default
    my $validcols = qq{
        name                     name                 0                $item_name
        dbname                   dbname               0                $item_name
        user|dbuser              dbuser               0                bucardo
        host|dbhost              dbhost               0                null
        port|dbport              dbport               numeric          null
        pass|dbpass              dbpass               0                null
        group|dbgroup            group                0                skip
        conn|dbconn              dbconn               0                null
        stat|status              status               =active|inactive null
        service|dbservice        dbservice            0                null
        pgpass                   pgpass               0                null
        sourcelimit              sourcelimit          numeric          null
        targetlimit              targetlimit          numeric          null
        server_side_prepares|ssp server_side_prepares TF               null
    };

    my ($dbcols,$cols,$phs,$vals)
        = process_simple_args({cols => $validcols, list => \@nouns, usage => $usage});

    my $newname = $dbcols->{name};

    ## Attempt to insert this into the database
    $SQL = "INSERT INTO bucardo.db ($cols) VALUES ($phs)";
    $DEBUG and warn "SQL: $SQL\n";
    $DEBUG and warn Dumper $vals;
    $sth = $dbh->prepare($SQL);
    eval {
        $count = $sth->execute(@$vals);
    };
    if ($@) {
        if ($@ =~ /"db_name_pk"/) {
            die qq{Cannot add database: the database name "$newname" already exists\n};
        }
        if ($@ =~ /"db_dsn_unique"/) {
            die qq{Cannot add database: already have a connection with the same parameters\n};
        }
        die "Failed to add database: $@\n";
    }

    my $finalmsg = '';

    ## If we got a group, process that as well
    if (exists $dbcols->{group}) {
        load_bucardo_info();
        my $gname = $dbcols->{group};
        if (! exists $global{dbgroup}{$gname}) {
            $SQL = 'INSERT INTO bucardo.dbgroup(name) VALUES (?)';
            $sth = $dbh->prepare($SQL);
            eval {
                $sth->execute($gname);
            };
            if ($@) {
                die qq{Failed to create new database group "$gname"\n$@\n};
            }
            $finalmsg .= qq{Added new database group "$gname"\n};
        }
        $SQL = 'INSERT INTO bucardo.dbmap(db,dbgroup) VALUES (?,?)';
        $sth = $dbh->prepare($SQL);
        eval {
            $sth->execute($newname,$gname);
        };
        if ($@) {
            die qq{Failed to add database "$newname" to group "$gname"\n$@\n};
        }
        $finalmsg .= qq{Added database "$newname" to group "$gname"\n};
    }

    $dbh->commit();

    if (!$QUIET) {
        print qq{Added database "$newname"\n};
        $finalmsg and print $finalmsg;
    }

    exit 0;

} ## end of add_database


sub add_dbgroup {

    ## Usage: add dbgroup name db1 db2 db3 ...

    my $name = shift @nouns || '';

    my $usage = usage('add_dbgroup');

    if (!length $name) {
        warn "$usage\n";
        exit 1;
    }

    load_bucardo_info();

    ## Create the group if it does not exist
    ## (If it does exist, we keep going in case there are new dbs to add)
    my $newgroup = '';
    if (! exists $global{dbgroup}{$name}) {
        $SQL = 'INSERT INTO bucardo.dbgroup(name) VALUES (?)';
        $sth = $dbh->prepare($SQL);
        $sth->execute($name);
        load_bucardo_info(1);
        $newgroup = 1;
    }

    my $dbg = $global{dbgroup}{$name};

    ## Make sure any leftover nouns are valid databases
    my $dblist = $global{db};

    my $finalmsg = '';

    my $clause = generate_clause({col => 'name', items => \@nouns});
    if ($clause) {
        $SQL = 'INSERT INTO bucardo.dbmap(db,dbgroup,priority) VALUES (?,?,?)';
        my $addrow = $dbh->prepare($SQL);
        $SQL = "SELECT * FROM bucardo.db WHERE $clause";
        $sth = $dbh->prepare($SQL);
        $count = $sth->execute();
        if ($count < 1) {
            die "No matching databases found\n";
        }
        for my $db (@{$sth->fetchall_arrayref({})}) {
            my $dbname = $db->{name};
            if (! exists $dblist->{$dbname}{group}{$name}) {
                $addrow->execute($dbname,$name,1);
                $finalmsg .= qq{Added database "$dbname" to group "$name"\n};
                $dblist->{$dbname}{group}{$name} = 1;
            }
        }
    }

    $dbh->commit();

    if (!$QUIET) {
        $finalmsg and print $finalmsg;
        $newgroup and print qq{Added database group "$name"\n};
    }

    exit 0;

} ## end of add_dbgroup


sub add_herd {

    ## Usage: add herd name (goat1, goat2, ...)

    my $name = shift @nouns || '';

    my $usage = usage('add_herd');

    if (!length $name) {
        warn "$usage\n";
        exit 1;
    }

    load_bucardo_info();

    ## Create the herd if it does not exist
    ## (If it does exist, we keep going in case there are new tables to add)
    my $newherd = '';
    if (! exists $global{herd}{$name}) {
        $SQL = 'INSERT INTO bucardo.herd(name) VALUES (?)';
        $sth = $dbh->prepare($SQL);
        $sth->execute($name);
        load_bucardo_info(1);
        $newherd = 1;
    }

    my $herd = $global{herd}{$name};

    ## Make sure any leftover nouns are valid goats
    ## These do not allow wildcards, but can be optionally schema prefixed
    my $goatlist = $global{goat};

    my %goat2add;
    for my $rel (@nouns) {
        if (! exists $goatlist->{$rel}) {
            die qq{Could not find a table or sequence named "$rel"\n};
        }
        if (ref $goatlist->{$rel} eq 'ARRAY') {
            for my $row (@{$goatlist->{$rel}}) {
                $goat2add{$row->{id}}++;
            }
        }
        else {
            $goat2add{$goatlist->{$rel}{id}}++;
        }
    }

    my $finalmsg = '';

    if (keys %goat2add) {
        $SQL = q{INSERT INTO bucardo.herdmap(herd,goat) VALUES (?,?)};
        my $addrow = $dbh->prepare($SQL);
        for my $id (keys %goat2add) {
            my $tname = "$goatlist->{$id}{schemaname}.$goatlist->{$id}{tablename}";
            if (exists $goatlist->{$id}{herd}{$name}) {
                $finalmsg .= sprintf qq{%s "%s" is already in the herd "$name"\n},
                    ucfirst ($goatlist->{$id}{reltype}),
                        $tname;
            }
            else {
                eval {
                    $addrow->execute($name,$id);
                };
                if ($@) {
                    die qq{Failed to add table "$tname" to herd "$name"\n$@};
                }
                $finalmsg .= sprintf qq{%s "%s" has been added to the herd "$name"\n},
                    ucfirst ($goatlist->{$id}{reltype}),
                        $tname;
            }
        }
    }

    $dbh->commit();

    if (!$QUIET) {
        $newherd and print qq{Added herd "$name"\n};
        $finalmsg and print $finalmsg;
    }

    exit 0;

} ## end of add_herd


sub add_sync {

    my $item_name = shift @nouns || '';

    my $usage = usage('add_sync');

    if (!length $item_name) {
        warn "$usage\n";
        exit 1;
    }

    ## Inputs and aliases, database column name, flags, default
    my $validcols = qq{
        name                     name                 0                $item_name
        source                   source               0                null
        targetdb                 targetdb             0                null
        targetgroup|group        targetgroup          0                null
        type|synctype            synctype             =pushdelta~delta|fullcopy~copy|swap null
        stayalive                stayalive            TF               null
        kidsalive                kidsalive            TF               null
        limitdbs                 limitdbs             numeric          null
        ping                     ping                 TF               null
        do_listen                do_listen            TF               null
        checktime                checktime            interval         null
        status                   status               =active|inactive null
        makedelta                makedelta            TF               null
        priority                 priority             numeric          null
        analyze_after_copy       analyze_after_copy   TF               null
        overdue                  overdue              interval         null
        expired                  expired              interval         null
        track_rates              track_rates          TF               null
        onetimecopy              onetimecopy          =0|1|2           null
        lifetime                 lifetime             interval         null
        maxkicks                 maxkicks             numeric          null
        rebuild_index|rebuildindex   rebuild_index    numeric          null
        customselect|usecustomselect usecustomselect  TF               null
        tables                   tables               0                skip
    };

    my ($dbcols,$cols,$phs,$vals)
        = process_simple_args({cols => $validcols, list => \@nouns, usage => $usage});

    if (! exists $dbcols->{synctype}) {
        die "Need to specify the type of sync: pushdelta, fullcopy, or swap\n";
    }
    if (! exists $dbcols->{source}) {
        die "Need to specify a source for this sync\n";
    }
    if (! exists $dbcols->{targetdb} and ! exists $dbcols->{targetgroup}) {
        die "Need to specify a targetdb or a targetgroup for this sync\n";
    }
    if (exists $dbcols->{targetdb} and exists $dbcols->{targetgroup}) {
        die "Need to specify only one: targetdb OR targetgroup\n";
    }

    load_bucardo_info();

    ## Already got a sync by this name?
    if (exists $global{sync}{$item_name}) {
        die qq{A sync with the name "$item_name" already exists\n};
    }

    ## Does this source exist? If not, and its a database, create a herd for the tables
    my $herd = $dbcols->{source};
    if (! exists $global{herd}{$herd}) {
        if (! $dbcols->{tables}) {
            die "No such source herd: $herd\n";
        }
        ## Well then, it must be the name of a database please
        if (! exists $global{db}{$herd}) {
            die "When using the tables option, the source argument must be a database\n";
        }
        my $db = $global{db}{$herd};
        my $dbname = $herd;

        ## Do we already have a herd of the same name as the sync?
        ## We can use it as long as it is empty
        if (exists $global{herd}{$item_name}) {
            if (exists $global{herd}{$item_name}{goat}) {
                 die qq{Cannot create sync: source herd "$item_name" already exists and contains tables\n};
            }
        }
        else {
            $SQL = 'INSERT INTO bucardo.herd(name) VALUES (?)';
            $sth = $dbh->prepare($SQL);
            $sth->execute($item_name);
        }

        ## At this point, we have a valid and empty herd ($item_name)
        ## Swap in the new value for both dbcols and vals!
        $dbcols->{source} = $item_name;
        (my $testcols = $cols) =~ s/(.*source).*/$1/;
        my $offset = $testcols =~ tr/,/,/;
        $vals->[$offset] = $item_name;

        ## Add all tables given to the new herd
        ## May be the same table in more than one schema, in which case we add them all!
        $SQL = q{INSERT INTO bucardo.herdmap(herd,goat) VALUES (?,?)};
        my $stha = $dbh->prepare($SQL);
        for my $tname (split /,/ => $dbcols->{tables}) {
            if (! exists $global{goat}{$tname}) {
                ## Try and add this table in
                @nouns = ($tname, "db=$dbname");
                if (exists $dbcols->{ping}) {
                    push @nouns, "ping=$dbcols->{ping}";
                }
                add_table();
                load_bucardo_info(1);
            }
            my $g = $global{goat}{$tname};
            if (ref $g eq 'ARRAY') {
                for my $row (@$g) {
                    $stha->execute($item_name,$row->{id});
                }
            }
            else {
                $stha->execute($item_name,$global{goat}{$tname}{id});
            }
        }

    } ## end of magic herd creation

    ## Attempt to insert this into the database
    $SQL = "INSERT INTO bucardo.sync ($cols) VALUES ($phs)";
    $DEBUG and warn "SQL: $SQL\n";
    $DEBUG and warn Dumper $vals;
    $sth = $dbh->prepare($SQL);
    eval {
        $count = $sth->execute(@$vals);
    };
    if ($@) {
        die "Failed to add sync: $@\n";
    }

    $dbh->commit();

    if (!$QUIET) {
        print qq{Added sync "$item_name"\n};
    }

    exit 0;

} ## end of add_sync


sub add_table {

    ## Usage: add table [schema].table [options]

    my $type = shift || 'table';

    my $usage = usage("add_$type");

    if (! @nouns) {
        warn "$usage\n";
        exit 1;
    }

    my $DEFAULT_SCHEMA = 'public';

    ## Inputs and aliases, database column name, flags, default
    my $validcols = q{
        db                       db                   0                null
        has_delta                has_delta            TF               null
        ping                     ping                 TF               null
        customselect             customselect         0                null
        makedelta                makedelta            TF               null
        rebuild_index            rebuild_index        numeric          null
        standard_conflict        standard_conflict    0                null
        analyze_after_copy       analyze_after_copy   TF               null
        delta_bypass             delta_bypass         TF               null
        delta_bypass_min         delta_bypass_min     numeric          null
        delta_bypass_count       delta_bypass_count   numeric          null
        delta_bypass_percent     delta_bypass_percent numeric          null
        delta_bypass             delta_bypass         TF               null
        herd                     herd                 0                skip
    };

    my ($dbcols,$cols,$phs,$vals)
        = process_simple_args({cols => $validcols, list => \@nouns, usage => $usage});

    ## Any single words are table names.
    my @tables;
    for (@nouns) {
        next if /=/;
        if (/^(\w*?)?\.?(\w+)$/) {
            push @tables => length $1 ? [$1,$2] : [$DEFAULT_SCHEMA,$2];
        }
        else {
            warn "Invalid $type name: $_\n";
            exit 1;
        }
    }

    if (! @tables) {
        warn "$usage\n";
        exit 1;
    }

    load_bucardo_info();

    if (! exists $dbcols->{db}) {
        ## If we only have one database, we can use that
        my $count = keys %{$global{db}};
        $count == 1 or die "Please specify a database with db=<name>\n";
        for (keys %{$global{db}}) {
            $dbcols->{db} = $global{db}{name};
            (my $testcols = $cols) =~ s/(.*db).*/$1/;
            my $offset = $testcols =~ tr/,/,/;
            $vals->[$offset] = $dbcols->{db};
        }
    }
    my $db = $dbcols->{db};

    if (! exists $global{db}{$db}) {
        die qq{Invalid database: "$db"\n};
    }

    my $finalmsg = '';

    ## If they requested a herd and it does not exist, create it
    if (exists $dbcols->{herd}) {
        my $herd = $dbcols->{herd};
        if (! exists $global{herd}{$herd}) {
            $SQL = 'INSERT INTO bucardo.herd(name) VALUES(?)';
            $sth = $dbh->prepare($SQL);
            $sth->execute($herd);
            load_bucardo_info(1);
            $finalmsg .= qq{Created herd "$herd"\n};
        }
    }

    ## Attempt to insert these tables into the database if they don't already exist
    $SQL = 'SELECT id FROM bucardo.goat WHERE schemaname=? AND tablename=? AND db=?';
    my $sthf = $dbh->prepare($SQL);
    $SQL = "INSERT INTO bucardo.goat (schemaname,tablename,reltype,$cols) VALUES (?,?,?,$phs)";
    $DEBUG and warn "SQL: $SQL\n";
    $DEBUG and warn Dumper $vals;
    $sth = $dbh->prepare($SQL);
    my $additions = '';
    my %oldtable;
    for my $row (@tables) {
        my ($s,$t) = @$row;
        $count = $sthf->execute($s,$t,$db);
        if ($count >= 1) {
            $oldtable{"$s.$t"}++;
            next;
        }
        eval {
            $sth->execute($s,$t,$type,@$vals);
        };
        if ($@) {
            die qq{Failed to add $type "$s.$t": $@\n};
        }
        $additions .= qq{Added $type "$s.$t"\n};
    }

    ## Add them to the herd if it was specificed and they are new tables
    if (exists $dbcols->{herd}) {
        my $herd = $dbcols->{herd};
        $SQL = 'INSERT INTO bucardo.herdmap (herd,priority,goat) VALUES (?,?,'
            . ' (SELECT id FROM goat WHERE schemaname=? AND tablename=? AND db=?))';
        $sth = $dbh->prepare($SQL);
        for my $row (@tables) {
            my ($s,$t) = @$row;
            next if exists $oldtable{"$s.$t"};
            eval {
                $sth->execute($herd,0,$s,$t,$db);
            };
            if ($@) {
                die qq{Failed to add $type "$s.$t" to herd "$herd": $@\n};
            }
        }
    }

    $dbh->commit();

    if (!$QUIET) {
        $finalmsg and print "$finalmsg";
        print "$additions";
    }

    return;

} ## end of add_table


sub add_all_tables {
    add_all_goats('table');
    return;
}

sub add_all_sequences {
    add_all_goats('sequence');
    return;
}


sub add_all_goats {

    my $type = shift;

    ## Usage: add all table(s) | add all sequence(s)
    ## Options:
    ## --db: use this database (internal name from the db table)
    ## --schema or -n: limit to one or more comma-separated schemas
    ## --exclude-schema or -N: exclude these schemas
    ## --table or -t: limit to the given tables
    ## --exclude-table or -t: exclude these tables
    ## --herd: name of the herd to add new tables to

    ## Transform command-line args to traditional format
    ## e.g. db=foo becomes the equivalent of --db=foo
    for my $noun (@nouns) {
        if ($noun =~ /(\w+)=(\w+)/) {
            $bcargs->{$1} = $2;
        }
    }

    ## Grab the list of databases. If none, cowardly refuse to continue
    my $dbs = get_dbs();
    if (! keys %$dbs) {
        die "Sorry, cannot add any ${type}s until at least one database has been added\n";
    }

    ## If there is more than one database, it must be selected via db=
    my $db;
    my $showdbs = 0;
    if (exists $bcargs->{db}) {
        if (! exists $dbs->{$bcargs->{db}}) {
            warn qq{Sorry, could not find a database named "$bcargs->{db}"\n};
            $showdbs = 1;
        }
        else {
            $db = $dbs->{$bcargs->{db}};
        }
    }
    elsif (keys %$dbs == 1) {
        ($db) = values %$dbs;
    }
    else {
        warn "Please specify which database to use with the db=<name> option\n";
        $showdbs = 1;
    }

    if ($showdbs) {
        warn "Database choices:\n";
        for my $row (sort keys %$dbs) {
            warn "  db=$row\n";
        }
        exit 1;
    }

    ## Connect to the remote database
    my $dbh2 = connect_database({name => $db->{name}});

    ## Query to pull all tables we may possibly need
    my $kind = $type eq 'table' ? 'r' : 'S';
    $SQL = q{SELECT nspname, relname FROM pg_catalog.pg_class c }
        . q{JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace) }
        . qq{WHERE relkind = '$kind' };

    ## We always exclude information_schema, system, and bucardo schemas
    $SQL .= q{AND n.nspname <> 'information_schema' AND nspname !~ '^pg' AND nspname !~ '^bucardo'};

    my @clause;

    ## If they gave a schema option, restrict the query by namespace
    push @clause => generate_clause({col => 'nspname', items => $bcargs->{schema}});

    ## If they have asked to exclude schemas, append that to the namespace clause
    push @clause => generate_clause({col => 'nspname', items => $bcargs->{'exclude-schema'}, not => 1});

    ## If they gave a table option, restrict the query by relname
    push @clause => generate_clause({col => 'relname', items => $bcargs->{table}});

    ## If they have asked to exclude tables, append that to the relname clause
    push @clause => generate_clause({col => 'relname', items => $bcargs->{'exclude-table'}, not => 1});

    for my $c (@clause) {
        next if ! $c;
        $SQL .= "\nAND ($c)";
    }

    ## Fetch all the items, bail if no matches are found
    $VERBOSE >= 2 and warn "Query: $SQL\n";
    $sth = $dbh2->prepare($SQL);
    $count = $sth->execute();
    if ($count < 1) {
        die "Sorry, no ${type}s were found\n";
    }

    ## Grab all current tables or sequences from the goat table.
    $SQL = qq{SELECT schemaname, tablename FROM bucardo.goat WHERE reltype= '$type' AND db = '$db->{name}'};
    my %hastable;
    for my $row (@{$dbh->selectall_arrayref($SQL)}) {
        $hastable{$row->[0]}{$row->[1]}++;
    }

    ## Do we have a herd request? Process it if so
    my $herd = '';
    my $addtoherd;
    if (exists $bcargs->{herd}) {
        $herd = $bcargs->{herd};
        $SQL = 'SELECT 1 FROM bucardo.herd WHERE name = ?';
        my $herdcheck = $dbh->prepare($SQL);
        $count = $herdcheck->execute($herd);
        $herdcheck->finish();
        if ($count < 1) {
            print "Creating herd: $herd\n";
            $SQL = 'INSERT INTO bucardo.herd(name) VALUES (?)';
            $herdcheck = $dbh->prepare($SQL);
            $herdcheck->execute($herd);
        }
        $SQL = 'INSERT INTO bucardo.herdmap(herd,goat) VALUES (?,?)';
        $addtoherd = $dbh->prepare($SQL);
    }

    ## Get ready to add tables or sequences to the goat table
    $SQL = q{INSERT INTO bucardo.goat (db,schemaname,tablename,reltype) VALUES (?,?,?,?)};
    my $addtable = $dbh->prepare($SQL);

    ## Walk through all returned tables from the remote database
    my %count = (seenit => 0, added => 0);
    my (%old, %new, %fail);
    for my $row (@{$sth->fetchall_arrayref()}) {
        my ($S,$T) = @$row;
        ## Do we already have this one?
        if (exists $hastable{$S}{$T}) {
            $VERBOSE >= 2 and warn "Skipping $type already in goat: $S.$T\n";
            $count{seenit}++;
            $old{$S}{$T} = 1;
            next;
        }
        $VERBOSE >= 2 and warn "Attempting to add $S.$T to the goat table\n";
        eval {
            $count = $addtable->execute($db->{name},$S,$T,$type);
        };
        if ($@) {
            warn "$@\n";
            if ($@ =~ /prepared statement.+already exists/) {
                warn "This message usually indicates you are using pgbouncer\n";
                warn "You can probably fix this problem by running:\n";
                warn "$progname update db $db->{name} server_side_prepares=false\n";
                warn "Then retry your command again\n\n";
            }
            exit 1;
        }
        if ($count != 1) {
            $addtable->finish();
            warn "Failed to add $type $S.$T to the goat table!\n";
            $fail{$S}{$T} = 1;
            next;
        }
        $SQL = q{SELECT currval('bucardo.goat_id_seq')};
        my $id = $dbh->selectall_arrayref($SQL)->[0][0];
        $VERBOSE >= 2 and warn "ID of new table $S.$T is $id\n";

        ## Pull the information back out about this item
        $SQL = 'SELECT * FROM bucardo.goat WHERE id = ?';
        $sth = $dbh->prepare($SQL);
        $sth->execute($id);
        my $info = $sth->fetchall_arrayref({});

        $count{added}++;
        $new{$S}{$T} = 1;
        if ($herd) {
            $addtoherd->execute($herd, $id);
            $VERBOSE >= 2 and warn "Added $type $id to herd $herd\n";
        }

    }
    $dbh->commit();

    if ($VERBOSE >= 1) {
        if (%new) {
            print "New ${type}s:\n";
            for my $s (sort keys %new) {
                for my $t (sort keys %{$new{$s}}) {
                    print "  $s.$t\n";
                }
            }
        }
        if (%fail) {
            print "Failed to add ${type}s:\n";
            for my $s (sort keys %fail) {
                for my $t (sort keys %{$fail{$s}}) {
                    print "  $s.$t\n";
                }
            }
        }
    }

    print "New ${type}s added: $count{added}\n";
    print "Already added: $count{seenit}\n";

    $dbh->disconnect();
    $dbh2->disconnect();

    exit 0;

} ## end of add_all_goats


sub remove_item {

    my $self = shift;

    my $usage = usage('remove');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }

    ## First word must be a type we know about
    my $type = shift @nouns;
    $type = lc $type;

    if ($type eq 'code' or $type eq 'customcode' or $type eq 'custom_code') {
        remove_customcode();
    }
    elsif ($type eq 'd' or $type eq 'db' or $type eq 'database') {
        remove_database();
    }
    elsif ($type eq 'herd') {
        remove_herd();
    }
    elsif ($type eq 'table') {
        remove_table();
    }
    elsif ($type eq 'sequence') {
        remove_table('sequence');
    }
    elsif ($type eq 'sync') {
        remove_sync();
    }
    elsif ($type eq 'dbgroup' or $type eq 'dbg') {
        remove_dbgroup();
    }
    else {
        warn "Cannot remove: unknown type\n";
    }
    exit 1;

} ## end of remove_item


sub remove_customcode {

    ## Usage: remove customcode name [name2 name3 ...]

    my $usage = usage('remove_customcode');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }

    load_bucardo_info();

    ## Make sure all named codes exist
    my $code = $global{cc};
    for my $name (@nouns) {
        if (! exists $code->{$name}) {
            die qq{No such code: $name\n};
        }
    }

    $SQL = 'DELETE FROM bucardo.customcode WHERE name = ?';
    $sth = $dbh->prepare($SQL);

    for my $name (@nouns) {
        eval {
            $sth->execute($name);
        };
        if ($@) {
            die qq{Could not delete customcode "$name"\n$@\n};
        }
    }

    for my $name (@nouns) {
        print qq{Removed customcode "$name"\n};
    }

    $dbh->commit();

    exit 0;


} ## end of remove_customcode


sub remove_database {

    ## Usage: remove db dbname [dbname2 dbname3 ...]

    my $usage = usage('remove_database');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }

    load_bucardo_info();

    ## Make sure all named databases exist
    my $db = $global{db};
    for my $name (@nouns) {
        if (! exists $db->{$name}) {
            die qq{No such database: $name\n};
        }
    }

    $SQL = 'DELETE FROM bucardo.db WHERE name = ?';
    $sth = $dbh->prepare($SQL);

    for my $name (@nouns) {
        eval {
            $sth->execute($name);
        };
        if ($@) {
            if ($@ =~ /"goat_db_fk"/) {
                die qq{Cannot delete database "$name": must remove all tables that reference it first\n};
            }
            if ($@ =~ /"sync_targetdb_fk"/) {
                die qq{Cannot delete database "$name": must remove all syncs that reference it first\n};
            }
            die qq{Could not delete database "$name"\n$@\n};
        }
    }

    for my $name (@nouns) {
        print qq{Removed database "$name"\n};
    }

    $dbh->commit();

    exit 0;


} ## end of remove_database


sub remove_dbgroup {

    ## Usage: remove dbgroup name name2 name3

    my $usage = usage('remove_dbgroup');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }

    load_bucardo_info();

    my $dbg = $global{dbgroup};

    ## Do all the nouns exist?
    for my $name (@nouns) {
        if (! exists $dbg->{$name}) {
            die qq{No such database group: $name\n};
        }
    }

    $SQL = q{DELETE FROM bucardo.dbgroup WHERE name = ?};
    $sth = $dbh->prepare($SQL);
    for my $name (@nouns) {
        eval {
            $sth->execute($name);
        };
        if ($@) {
            if ($@ =~ /"sync_targetgroup_fk"/) {
                die qq{Cannot remove database group "$name": it is being used by one or more syncs\n};
            }
            die qq{Could not delete database group "$name"\n$@\n};
        }
    }

    for my $name (@nouns) {
        print qq{Removed database group "$name"\n};
    }

    $dbh->commit();

    exit 0;

} ## end of remove_dbgroup


sub remove_herd {

    ## Usage: remove herd herdname [herd2 herd3 ...]

    my $usage = usage('remove_herd');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }

    load_bucardo_info();

    my $herd = $global{herd};

    for my $name (@nouns) {
        if (! exists $herd->{$name}) {
            die qq{No such herd: $name\n};
        }
    }

    $SQL = 'DELETE FROM bucardo.herd WHERE name = ?';
    $sth = $dbh->prepare($SQL);
    for my $name (@nouns) {
        eval {
            $sth->execute($name);
        };
        if ($@) {
            if ($@ =~ /"sync_source_herd_fk"/) {
                die qq{Cannot delete herd "$name": must remove all syncs that reference it first\n};
            }
            die qq{Could not delete herd "$name"\n$@\n};
        }
    }

    for my $name (@nouns) {
        print qq{Removed herd "$name"\n};
    }

    $dbh->commit();

    exit 0;

} ## end of remove_herd


sub remove_sync {

    ## Usage: remove sync name [name2 name3 ...]

    my $usage = usage('remove_sync');

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }

    load_bucardo_info();

    ## Make sure all named syncs exist
    my $s = $global{sync};
    for my $name (@nouns) {
        if (! exists $s->{$name}) {
            die qq{No such sync: $name\n};
        }
    }

    ## Make sure none of the syncs are currently running
    ## Will not work on 9.0 and up: will need some other way to check...
    if ($dbh->{pg_server_version} < 90000) {
        $SQL = q{SELECT 1 FROM pg_catalog.pg_listener WHERE relname = ?};
        for my $name (@nouns) {
            my $dname = "bucardo_deactivate_sync_$name";
            $sth = $dbh->prepare($SQL);
            $count = $sth->execute($dname);
            $sth->finish();
            if (1 == $count) {
                die qq{Cannot remove active sync "$name": please deactivate it first\n};
            }
        }
    }

    $SQL = 'DELETE FROM bucardo.sync WHERE name = ?';
    $sth = $dbh->prepare($SQL);

    for my $name (@nouns) {
        eval {
            $sth->execute($name);
        };
        if ($@) {
            if ($@ =~ /"goat_db_fk"/) {
                die qq{Cannot delete database "$name": must remove all tables that reference it first\n};
            }
            die qq{Could not delete database "$name"\n$@\n};
        }
    }

    for my $name (@nouns) {
        print qq{Removed database "$name"\n};
        print "Note: table triggers (if any) are not automatically removed!\n";
    }

    $dbh->commit();

    exit 0;

} ## end of remove_sync


sub remove_table {

    ## Usage: remove table name [name2 name3 ...]

    my $type = shift || 'table';

    my $usage = usage("remove_$type");

    if (!@nouns) {
        warn "$usage\n";
        exit 1;
    }

    load_bucardo_info();

    ## Make sure all named tables exist
    my $goat = $global{goat};
    my @id;
    my %seenit;
    for my $name (@nouns) {
        if (! exists $goat->{$name}) {
            die qq{No such $type: $name\n};
        }
        my $g = $goat->{$name};
        if (ref $g eq 'ARRAY') { ## More than one match, remove them all
            for my $row (@{$goat->{$name}}) {
                next if $seenit{$row->{id}}++;
                push @id => [$row->{id}, "$row->{schemaname}.$row->{tablename}", $row->{reltype}];
            }
        }
        else {
            next if $seenit{$g->{id}}++;
            push @id => [$g->{id}, "$g->{schemaname}.$g->{tablename}", $g->{reltype}];
        }
    }

    $SQL = 'DELETE FROM bucardo.goat WHERE id = ?';
    $sth = $dbh->prepare($SQL);
    for my $i (@id) {
        my ($id,$name,$typ) = @$i;
        eval {
            $sth->execute($id);
        };
        if ($@) {
            die qq{Could not delete $typ "$name"\n$@\n};
        }
    }

    for my $i (@id) {
        my ($id,$name,$typ) = @$i;
        print qq{Removed $typ "$name"\n};
    }

    $dbh->commit();

    exit 0;

} ## end of remove_table


sub clog {

    my $msg = shift;
    chomp $msg;

    warn "$msg\n";

    return;

} ## end of clog


sub schema_exists {

    my ($schema) = @_;
    my $SQL = 'SELECT 1 FROM pg_catalog.pg_namespace WHERE nspname = ?';
    my $sth = $dbh->prepare_cached($SQL);
    my $count = $sth->execute($schema);
    $sth->finish();
    return $count < 1 ? 0 : 1;

} ## end of schema_exists


sub relation_exists {

    ## Checks if a relation exists. Returns the oid or 0
    my ($schema,$name) = @_;
    my $SQL = 'SELECT c.oid FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n '.
        'WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ?';
    my $sth = $dbh->prepare_cached($SQL);
    my $count = $sth->execute($schema,$name);
    if ($count == 1) {
        return $sth->fetchall_arrayref()->[0][0];
    }
    $sth->finish();
    return 0;

} ## end of relation_exists


sub config_exists {

    ## Checks if a configuration settings exists. Returns 1 or 0
    my $name = shift;

    my $SQL = 'SELECT 1 FROM bucardo.bucardo_config WHERE setting = ?';
    my $sth = $dbh->prepare_cached($SQL);
    my $count = $sth->execute($name);
    $sth->finish();
    return $count>=1 ? 1 : 0;

} ## end of config_exists


sub constraint_exists {

    my ($schema,$table,$constraint) = @_;
    my $SQL = 'SELECT 1 FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, pg_catalog.pg_constraint o '.
        'WHERE n.oid=c.relnamespace AND c.oid=o.conrelid AND n.nspname = ? AND c.relname = ? AND o.conname = ?';
    my $sth = $dbh->prepare_cached($SQL);
    my $count = $sth->execute($schema,$table,$constraint);
    $sth->finish();
    return $count < 1 ? 0 : 1;

} ## end of constraint_exists


sub column_exists {

    my ($schema,$table,$column) = @_;
    my $SQL = 'SELECT 1 FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, '.
        'pg_catalog.pg_attribute a WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ? '.
        'AND a.attname = ? AND a.attrelid = c.oid';
    my $sth = $dbh->prepare_cached($SQL);
    my $count = $sth->execute($schema,$table,$column);
    $sth->finish();
    return $count < 1 ? 0 : 1;

} ## end of column_exists


sub trigger_exists {

    my $name = shift;
    my $SQL = 'SELECT 1 FROM pg_catalog.pg_trigger WHERE tgname = ?';
    my $sth = $dbh->prepare_cached($SQL);
    my $count = $sth->execute($name);
    $sth->finish();
    return $count < 1 ? 0 : 1;

} ## end of trigger_exists


sub function_exists {

    my ($schema,$name,$args) = @_;
    $name = lc $name;
    $SQL = 'SELECT md5(prosrc) FROM pg_proc p, pg_language l '.
        'WHERE p.prolang = l.oid AND proname = ? AND oidvectortypes(proargtypes) = ?';
    $sth = $dbh->prepare($SQL);
    $count = $sth->execute($name,$args);
    if ($count eq '0E0') {
        $sth->finish();
        return '';
    }
    return $sth->fetchall_arrayref()->[0][0];

} ## end of function_exists


sub column_default {

    my ($schema,$table,$column) = @_;
    my $SQL = 'SELECT pg_get_expr(adbin,adrelid) FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, '.
        'pg_catalog.pg_attribute a, pg_attrdef d '.
        'WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ? '.
        'AND a.attname = ? AND a.attrelid = c.oid AND d.adnum = a.attnum AND d.adrelid = a.attrelid';
    my $sth = $dbh->prepare_cached($SQL);
    my $count = $sth->execute($schema,$table,$column);
    if ($count eq '0E0') {
        $sth->finish();
        return '';
    }
    return $sth->fetchall_arrayref()->[0][0];

} ## end of column_default


sub column_value {

    my ($schema,$table,$column,$where) = @_;
    my $SQL = "SELECT $column FROM $schema.$table WHERE $where";
    return $dbh->selectall_arrayref($SQL)->[0][0];

} ## end of column_value


sub column_type {

    my ($schema,$table,$column) = @_;
    my $SQL = 'SELECT  pg_catalog.format_type(a.atttypid, a.atttypmod) '.
        'FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, '.
        'pg_catalog.pg_attribute a '.
        'WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ? '.
        'AND a.attname = ? AND a.attrelid = c.oid';
    my $sth = $dbh->prepare_cached($SQL);
    my $count = $sth->execute($schema,$table,$column);
    if ($count eq '0E0') {
        $sth->finish();
        return '';
    }
    return $sth->fetchall_arrayref()->[0][0];

} ## end of column_type


sub constraint_definition {

    my $name = shift;

    my $SQL = qq{SELECT pg_get_constraintdef(oid) FROM pg_constraint WHERE conname = '$name'};
    my $def = $dbh->selectall_arrayref($SQL)->[0][0];

    return '' if ! defined $def;

    $def =~ s/\((\(.+\))\)/$1/;
    $def =~ s/\"?(\w+)\"? = ANY \(ARRAY\[(.+)\]\)/$1 IN ($2)/;
    $def =~ s/<> ALL \(ARRAY\[(.+)\]\)/NOT IN ($1)/;
    $def =~ s/::text//g;
    $def =~ s/(\w+) ~ '/$1 ~ E'/g;

    return $def;

} ## end of constraint_definition


sub find_bucardo_schema {

    ## Locate the best bucardo.schema file and return a file handle and name for it

    my $fh;

    ## Start by checking the current directory
    my $schema_file = 'bucardo.schema';
    return ($fh, $schema_file) if open $fh, '<', $schema_file;

    ## Try /usr/local/share/bucardo
    $schema_file = '/usr/local/share/bucardo/bucardo.schema';
    return ($fh, $schema_file) if open $fh, '<', $schema_file;

    ## Try /usr/share/bucardo
    $schema_file = '/usr/share/bucardo/bucardo.schema';
    return ($fh, $schema_file) if open $fh, '<', $schema_file;

    die "Could not find the bucardo.schema file!\n";

} ## end of find_bucardo_schema


sub table_definition {

    ## Pull the complete table definition from the bucardo.schema file
    ## Returns an arrayref of sequences, and the textual table def

    my $name = shift;

    my $def = '';

    my ($fh, $schema_file) = find_bucardo_schema();
    my @seq;
    while (<$fh>) {
        if (!$def) {
            if (/^CREATE TABLE $name/) {
                $def .= $_;
            }
        }
        else {
            $def .= $_;
            last if /^\);/;
        }
    }
    close $fh or die qq{Could not close "$schema_file": $!\n};
    while ($def =~ /nextval\('(.+?)'/g) {
        push @seq => $1;
    }

    if (! length($def)) {
        die "Could not find the table definition for $name\n";
    }

    return \@seq, $def;

} ## end of table_definition


sub generate_clause {

    ## Generate a snippet of SQL for a WHERE clause

    my $arg = shift or die;
    return '' if ! $arg->{items};

    my $col = $arg->{col} or die;
    my $items = $arg->{items};
    my ($NOT,$NOTR) = ('','');
    if (exists $arg->{not}) {
        $NOT = 'NOT ';
        $NOTR = '!';
    }
    my $andor = exists $arg->{andor} ? uc($arg->{andor}) : $NOT ? 'AND' : 'OR';

    my (@oneitem,@itemlist);
    for my $name (@{$items}) {
        $name =~ s/^\s*(.+?)\s*$/$1/;
        ## Break into schema and relation
        my $schema = '';
        if ($col eq 'tablename' and $name =~ s/(.+\w)\.(\w.+)/$2/) {
            $schema = $1;
        }

        my $one = 1;
        ## Contains:
        if ($name =~ s/^\*(.+)\*$/$1/) {
            push @oneitem => "$col ${NOTR}~ " . qquote($1);
        }
        ## Starts with:
        elsif ($name =~ s/^\*(.+)/$1/) {
            push @oneitem => "$col ${NOTR}~ " . qquote("$1\$");
        }
        ## Ends with:
        elsif ($name =~ s/(.+)\*$/$1/) {
            push @oneitem => "$col ${NOTR}~ " . qquote("^$1");
        }
        else {
            push @itemlist => qquote($name);
        }

        if ($schema) {
            my $col2 = 'schemaname';
            my $old = $one ? pop @oneitem : pop @itemlist;
            if ($schema =~ s/^\*(.+)\*$/$1/) {
                push @oneitem => "($old AND $col2 ${NOTR}~ " . qquote($1) . ')';
            }
            elsif ($schema =~ s/^\*(.+)/$1/) {
                push @oneitem => "($old AND $col2 ${NOTR}~ " . qquote("$1\$") . ')';
            }
            elsif ($schema =~ s/(.+)\*$/$1/) {
                push @oneitem => "($old AND $col2 ${NOTR}~ " . qquote("^$1") . ')';
            }
            else {
                push @oneitem => "($col = $old AND $col2 = " . qquote($schema) . ')';
            }
        }

    }
    if (@itemlist) {
        my $list = sprintf "$col ${NOT}IN (" . (join ',' => @itemlist) . ')';
        push @oneitem => $list;
    }
    my $SQL = join " $andor " => @oneitem;

    return $SQL;

} ## end of generate_clause


sub qquote {

    ## Quick quote
    my $thing = shift;
    $thing =~ s/'/''/g;
    return qq{'$thing'};

} ## end of qquote


sub upgrade {

    ## Make upgrades to an existing Bucardo schema to match the current version

    my $self = shift;

    ## Ensure the bucardo.schema file is available and the correct version
    my ($fh, $schema_file) = find_bucardo_schema();

    my $schema_version = 0;
    while (<$fh>) {
        if (/\-\- Version (\d+\.\d+\.\d+)/) {
            $schema_version = $1;
            last;
        }
    }
    if (! $schema_version) {
        die qq{Could not find version number in the file "$schema_file"!\n};
    }
    if ($schema_version ne $VERSION) {
        die qq{Cannot continue: bucardo_ctl is version $VERSION, but $schema_file is version $schema_version\n};
    }

    $dbh->do(q{SET escape_string_warning = 'OFF'});

    my $changes = 0;

    ## Make sure the upgrade_log table is in place

    if (!relation_exists('bucardo', 'upgrade_log')) {
        my ($seqlist, $tabledef) = table_definition('bucardo.upgrade_log');
        upgrade_and_log($tabledef,'CREATE TABLE bucardo.upgrade_log');
        $dbh->commit();
    }

    my @old_sequences = (
        'dbgroup_id_seq',
    );

    my @new_sequences = (
        'audit_pid_id_seq',
    );

    my @old_configs = (
        'pidfile',
    );

    my @old_constraints = (
        ['bucardo', 'goat', 'goat_pkeytype_check'],
        ['bucardo', 'sync', 'sync_replica_allornone'],
        ['bucardo', 'sync', 'sync_disable_triggers_method'],
        ['bucardo', 'sync', 'sync_disable_rules_method'],
    );

    my @old_columns = (
        ['bucardo', 'sync', 'disable_rules'],
        ['bucardo', 'sync', 'disable_triggers'],
    );

    my @old_functions = (
        ['create_child_q', 'text'],
    );

    my @old_indexes = (
        ['bucardo', 'sync', 'sync_source_targetdb'],
        ['bucardo', 'sync', 'sync_source_targetgroup'],
    );

    my @old_views = (
        'goats_in_herd'
    );

    my @new_columns = (
        ['bucardo', 'audit_pid', 'id',                   q{INTEGER NOT NULL DEFAULT nextval('audit_pid_id_seq')}],
        ['bucardo', 'audit_pid', 'parentid',             q{INTEGER     NULL}],
        ['bucardo', 'audit_pid', 'familyid',             q{INTEGER     NULL}],
        ['bucardo', 'audit_pid', 'source',               q{TEXT        NULL}],
        ['bucardo', 'audit_pid', 'target',               q{TEXT        NULL}],
        ['bucardo', 'audit_pid', 'master_backend',       q{INT     NOT NULL DEFAULT pg_backend_pid()}],
        ['bucardo', 'audit_pid', 'source_backend',       q{INT         NULL}],
        ['bucardo', 'audit_pid', 'target_backend',       q{INT         NULL}],
        ['bucardo', 'customcode','trigrules',            q{BOOLEAN NOT NULL DEFAULT 'false'}],
        ['bucardo', 'db',        'dbservice',            q{TEXT        NULL}],
        ['bucardo', 'db',        'server_side_prepares', q{BOOLEAN NOT NULL DEFAULT 'true'}],
        ['bucardo', 'goat',      'delta_bypass',         q{BOOLEAN NOT NULL DEFAULT 'false'}],
        ['bucardo', 'goat',      'delta_bypass_min',     q{BIGINT      NULL}],
        ['bucardo', 'goat',      'delta_bypass_count',   q{BIGINT      NULL}],
        ['bucardo', 'goat',      'delta_bypass_percent', q{SMALLINT    NULL}],
        ['bucardo', 'goat',      'qpkey',                q{TEXT        NULL}],
        ['bucardo', 'sync',      'lifetime',             q{INTERVAL NULL}],
        ['bucardo', 'sync',      'maxkicks',             q{INTEGER NOT NULL DEFAULT 0}],
        ['bucardo', 'sync',      'onetimecopy',          q{SMALLINT NOT NULL DEFAULT 0}],
        ['bucardo', 'sync',      'strict_checking',      q{BOOLEAN NOT NULL DEFAULT 'true'}],
        ['bucardo', 'sync',      'track_rates',          q{BOOLEAN NOT NULL DEFAULT 'false'}],

        ['freezer', 'old_audit_pid', 'id',              q{INTEGER}],
        ['freezer', 'old_audit_pid', 'parentid',        q{INTEGER}],
        ['freezer', 'old_audit_pid', 'familyid',        q{INTEGER}],
        ['freezer', 'old_audit_pid', 'source',          q{TEXT}   ],
        ['freezer', 'old_audit_pid', 'target',          q{TEXT}   ],
        ['freezer', 'old_audit_pid', 'master_backend',  q{INT}    ],
        ['freezer', 'old_audit_pid', 'source_backend',  q{INT}    ],
        ['freezer', 'old_audit_pid', 'target_backend',  q{INT}    ],
    );

    my @altered_columns = (
        ['bucardo', 'goat', 'schemaname',    'NO DEFAULT'],
        ['bucardo', 'goat', 'rebuild_index', 'BOOL2SMALLINT'],
        ['bucardo', 'sync', 'rebuild_index', 'BOOL2SMALLINT'],
    );

    my @row_values = (

        ['bucardo_config','about',q{setting = 'log_showtime'}, 1,
         'Show timestamp in the log output?  0=off  1=seconds since epoch  2=scalar gmtime  3=scalar localtime'],
    );

    my @drop_all_rules = (
        ['freezer','master_q'],
    );

    ## Drop all existing rules from a table:
    for my $row (@drop_all_rules) {
        my ($schema,$table) = @$row;
        my $oid = relation_exists($schema,$table);
        if (!$oid) {
            warn "Could not find table $schema.$table to check!\n";
            next;
        }
        $SQL = 'SELECT rulename FROM pg_catalog.pg_rewrite WHERE ev_class = ? ORDER BY rulename';
        $sth = $dbh->prepare($SQL);
        $count = $sth->execute($oid);
        if ($count < 1) {
            $sth->finish();
            next;
        }
        for my $rule (map { $_->[0] } @{$sth->fetchall_arrayref()}) {
            upgrade_and_log(qq{DROP RULE "$rule" ON $schema.$table});
            clog "Dropped rule $rule on table $schema.$table";
            $changes++;
        }
    }

    ## Drop any old views
    for my $name (@old_views) {
        next if !relation_exists('bucardo', $name);
        upgrade_and_log("DROP VIEW $name");
        clog "Dropped view $name";
        $changes++;
    }

    ## Drop any old sequences
    for my $sequence (@old_sequences) {
        next if !relation_exists('bucardo', $sequence);
        upgrade_and_log("DROP SEQUENCE bucardo.$sequence");
        clog "Dropped sequence: $sequence";
        $changes++;
    }

    ## Drop any old constraints
    for my $con (@old_constraints) {
        my ($schema, $table, $constraint) = @$con;
        next if !constraint_exists($schema, $table, $constraint);
        upgrade_and_log(qq{ALTER TABLE $schema.$table DROP CONSTRAINT "$constraint"});
        clog "Dropped constraint $constraint ON $schema.$table";
        $changes++;
    }

    ## Add new sequences as needed
    for my $name (@new_sequences) {
        next if relation_exists('bucardo', $name);
        upgrade_and_log("CREATE SEQUENCE $name");
        clog "Created sequence $name";
        $changes++;
    }

    ## Add new columns as needed
    for my $row (@new_columns) {
        my ($schema,$table,$column,$def) = @$row;
        next if column_exists($schema, $table, $column);
        $def =~ s/\s+/ /g;
        upgrade_and_log("ALTER TABLE $schema.$table ADD COLUMN $column $def");
        clog "Created column: $schema.$table.$column $def";
        $changes++;
    }

    ## Change any altered columns
    for my $row (@altered_columns) {
        my ($schema,$table,$column,$change) = @$row;
        next if ! column_exists($schema, $table, $column);
        if ($change eq 'NO DEFAULT') {
            my $def = column_default($schema, $table, $column);
            next if !$def;
            upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column DROP DEFAULT");
            clog "Removed DEFAULT ($def) from $schema.$table.$column";
            $changes++;
        }
        elsif ($change =~ /^RENAME\s+(\w+)/) {
            my $newname = $1;
            upgrade_and_log("ALTER TABLE $schema.$table RENAME COLUMN $column TO $newname");
            clog("Renamed $schema.$table.$column to $newname");
            $changes++;
        }
        elsif ($change =~ /^DEFAULT\s+(.+)/) {
            my $newname = $1;
            my $oldname = column_default($schema, $table, $column);
            next if $newname eq $oldname;
            upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column SET DEFAULT $newname");
            clog("Changed DEFAULT on $schema.$table.$column to $newname");
            $changes++;
        }
        elsif ($change eq 'BOOL2SMALLINT') {
            my $oldtype = column_type($schema, $table, $column);
            next if $oldtype eq 'smallint';
            upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column DROP DEFAULT");
            upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column TYPE smallint "
                            . "USING CASE WHEN $column IS NULL OR $column IS FALSE THEN 0 ELSE 1 END");
            upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column SET DEFAULT 0");
            clog("Changed type of $schema.$table.$column to smallint");
            $changes++;
        }
        else {
            die qq{Do not know how to handle altered column spec of "$change"};
        }
    }

    ## Drop any old columns
    for my $row (@old_columns) {
        my ($schema,$table,$column) = @$row;
        next if !column_exists($schema, $table, $column);
        upgrade_and_log("ALTER TABLE $schema.$table DROP COLUMN $column");
        clog "Dropped column: $schema.$table.$column";
        $changes++;
    }

    ## Drop any old indexes
    for my $row (@old_indexes) {
        my ($schema,$table,$name) = @$row;
        next if !relation_exists($schema, $name);
        upgrade_and_log("DROP INDEX $name");
        clog "Dropped index $name";
        $changes++;
    }

    ## Drop any old functions
    for my $row (@old_functions) {
        my ($name, $args) = @$row;
        next if ! function_exists('bucardo', $name, $args);
        clog "Dropped function $name($args)";
        upgrade_and_log(qq{DROP FUNCTION bucardo."$name"($args)});
        $changes++;
    }

    ## Drop any old config items
    for my $name (@old_configs) {
        next if ! config_exists($name);
        clog "Removed old bucardo_config setting: $name";
        upgrade_and_log(qq{DELETE FROM bucardo.bucardo_config WHERE setting = '$name'});
        $changes++;
    }

    ## Check for any new config items
    $SQL = 'SELECT value FROM bucardo.bucardo_config WHERE lower(setting) = ?';
    my $cfgsth = $dbh->prepare($SQL);
    $SQL = 'INSERT INTO bucardo.bucardo_config(setting,value,about) VALUES (?,?,?)';
    my $newcfg = $dbh->prepare($SQL);
    my %config;
    my $inside = 0;
    seek $fh, 0, 0;
    while (<$fh>) {
        if (!$inside) {
            if (/^WITH DELIMITER/) {
                $inside = 1;
            }
            next;
        }
        if (/^\\/) {
            $inside = 0;
            next;
        }
        ## Scoop
        my ($setting,$value,$about) = split /\|/ => $_;
        $config{$setting} = [$value,$about];
        $count = $cfgsth->execute($setting);
        $cfgsth->finish();
        if ($count eq '0E0') {
            clog "Added new bucardo_config setting: $setting";
            $changes++;
            $newcfg->execute($setting,$value,$about);
        }
    }

    ## Apply any specific row changes
    for my $row (@row_values) {
        my ($table,$column,$where,$force,$value) = @$row;
        my $val = column_value('bucardo',$table,$column,$where);
        if (!defined $val) {
            die "Failed to find $table.$column where $where!\n";
        }
        next if $val eq $value;
        $SQL = sprintf "UPDATE bucardo.$table SET $column=%s WHERE $where",
            $dbh->quote($value);
        upgrade_and_log($SQL);
        clog "New value set for bucardo.$table.$column WHERE $where";
        $changes++;
    }

    ## Parse the bucardo.schema file and verify the following types of objects exist:
    ## Functions, triggers, constraints, sequences, and indexes
    my (@flist, @tlist, @ilist, @clist, @clist2, @slist, @tablelist);
    my ($fname,$args,$fbody) = ('','','');
    my ($tname,$tbody) = ('','');
    my ($tablename,$tablebody) = ('','');
    my ($altername,$alterbody,$alterstat) = ('','','');
    seek $fh, 0, 0;
    while (<$fh>) {
        if ($fbody) {
            if (/^(\$bc\$;)/) {
                $fbody .= $1;
                push @flist, [$fname, $args, $fbody];
                $fbody = $fname = $args = '';
            }
            else {
                $fbody .= $_;
            }
            next;
        }
        if ($tbody) {
            $tbody .= $_;
            if (/;/) {
                push @tlist, [$tname, $tbody];
                $tbody = $tname = '';
            }
            next;
        }
        if ($tablebody) {
            $tablebody .= $_;
            if (/^\s*CONSTRAINT\s+(\w+)\s+(.+?)\s*$/) {
                my ($cname,$def) = ($1,$2);
                $def =~ s/,$//;
                $def =~ s/\bbucardo\.//;
                push @clist2, [$tablename, $cname, $def];
            }
            if (/;/) {
                push @tablelist, [$tablename, $tablebody];
                $tablebody = $tablename = '';
            }
            next;
        }
        if ($altername) {
            $alterbody =~ s/\s+$//;
            $alterbody ? s/^\s+/ / : s/^\s+//;
            s/\s+$/ /;
            $alterbody .= $_;
            $alterstat .= $_;
            if ($alterbody =~ s/;\s*$//) {
                push @clist, [$altername->[0], $altername->[1], $alterbody, $alterstat];
                $alterbody = $altername = $alterstat = '';
            }
            next;
        }
        if (/^CREATE (?:OR REPLACE )?FUNCTION\s+bucardo\.(\S+)/) {
            $fname = $1;
            $fbody .= $_;
            $fname =~ s/\((.*)\)// or die "No args found for function: $_\n";
            $args = $1;
            $args =~ s/,(\S)/, $1/g;
            next;
        }
        if (/^CREATE TRIGGER (\S+)/) {
            $tname = $1;
            $tbody .= $_;
            next;
        }
        if (/^CREATE TABLE bucardo\.(\w+)/) {
            $tablename = $1;
            $tablebody .= $_;
            next;
        }
        if (/^CREATE (UNIQUE )?INDEX (\S+)/) {
            push @ilist, [$1, $2, $_];
            next;
        }
        if (/^ALTER TABLE bucardo\.(\S+)\s+ADD CONSTRAINT\s*(\S+)\s*(\S*.*)/) {
            $altername = [$1,$2];
            $alterbody = $3 || '';
            $alterstat = $_;
            next;
        }
        if (/^CREATE SEQUENCE bucardo\.(\w+)/) {
            push @slist, [$1, $_];
            next;
        }
    }
    close $fh or die qq{Could not close file "$file": $!\n};

    $SQL = 'SELECT pg_catalog.md5(?)';
    my $md5sth = $dbh->prepare($SQL);
    for my $row (@flist) {
        my ($name,$arg,$body) = @$row;
        next if $name =~ /plperlu_test/;
        my $oldbody = function_exists('bucardo',$name,$arg);
        if (!$oldbody) {
            upgrade_and_log($body,"CREATE FUNCTION $name($arg)");
            clog "Added function $name($arg)";
            $changes++;
            next;
        }
        my $realbody = $body;
        $realbody =~ s/.*?\$bc\$(.+)\$bc\$;/$1/sm;
        $md5sth->execute($realbody);
        my $newbody = $md5sth->fetchall_arrayref()->[0][0];
        next if $oldbody eq $newbody;
        $body =~ s/^CREATE FUNCTION/CREATE OR REPLACE FUNCTION/;
        (my $short = $body) =~ s/^(.+?)\n.*/$1/s;
        $dbh->do('SAVEPOINT bucardo_upgrade');
        eval { upgrade_and_log($body,$short); };
        if ($@) {
            $dbh->do('ROLLBACK TO bucardo_upgrade');
            (my $dropbody = $short) =~ s/CREATE OR REPLACE/DROP/;
            $dropbody .= ' CASCADE';
            upgrade_and_log($dropbody);
            upgrade_and_log($body,$short);
        }
        else {
            $dbh->do('RELEASE bucardo_upgrade');
        }
        clog "Updated function: $name($arg)";
        $changes++;
    }

    ## Check for any added sequences
    for my $row (@slist) {
        my ($sname,$body) = @$row;
        next if relation_exists('bucardo', $sname);
        upgrade_and_log($body);
        clog "Created sequence $sname";
        $changes++;
    }

    ## Check for any added tables
    for my $row (@tablelist) {
        my ($name,$body) = @$row;
        next if relation_exists('bucardo', $name);
        upgrade_and_log($body);
        clog "Created table $name";
        $changes++;
    }

    ## Check for any added triggers
    for my $row (@tlist) {
        my ($name,$body) = @$row;
        next if trigger_exists($name);
        upgrade_and_log($body);
        clog "Created trigger $name";
        $changes++;
    }

    ## Check for any added indexes
    for my $row (@ilist) {
        my ($uniq,$name,$body) = @$row;
        next if relation_exists('bucardo',$name);
        upgrade_and_log($body);
        clog "Created index $name";
        $changes++;
    }

    ## Check for any added constraints
    for my $row (@clist) {
        my ($tcname,$cname,$cdef,$body) = @$row;
        if (! constraint_exists('bucardo', $tcname, $cname)) {
            upgrade_and_log($body);
            clog "Created constraint $cname on $tcname";
            $changes++;
            next;
        }

        ## Clean up the constraint to make it match what comes back from the database:
        $cdef =~ s/;$//;
        $cdef =~ s/','/', '/g;
        if ($cdef =~ s/([^)]) (OR|AND) (\w)/$1) $2 ($3/g) {
            $cdef =~ s/CHECK (.+)/CHECK ($1)/;
        }
        my $condef = constraint_definition($cname);
        if ($condef ne $cdef) {
            upgrade_and_log("ALTER TABLE $tcname DROP CONSTRAINT $cname");
            upgrade_and_log("ALTER TABLE $tcname ADD CONSTRAINT $cname $cdef");
            clog "Altered constraint $cname on $tcname";
            $changes++;
        }
    }

    ## Check that any bare constraints (e.g. foreign keys) are unchanged
    for my $row (@clist2) {
        my ($tcname,$cname,$cdef) = @$row;
        my $condef = constraint_definition($cname);
        next if ! $condef or $condef eq $cdef;
        if ($condef and $condef ne $cdef) {
            upgrade_and_log("ALTER TABLE $tcname DROP CONSTRAINT $cname");
        }
        upgrade_and_log("ALTER TABLE $tcname ADD CONSTRAINT $cname $cdef");
        my $action = $condef ? 'Altered' : 'Added';
        clog "$action constraint $cname on $tcname";
        $changes++;
    }

    ## The freezer.q_staging table is no longer needed, but we must empty it before dropping
    if (relation_exists('freezer','q_staging')) {
        upgrade_and_log('INSERT INTO freezer.master_q SELECT * FROM freezer.q_staging');
        upgrade_and_log('DROP TABLE freezer.q_staging');
        clog 'Dropped deprecated table freezer.q_staging';
        $changes++;
    }

    ## Make sure bucardo_config has the new schema version
    $count = $cfgsth->execute('bucardo_current_version');
    if ($count eq '0E0') {
        $cfgsth->finish();
        warn "Weird: could not find bucardo_current_version in the bucardo_config table!\n";
    }
    else {
        my $curval = $cfgsth->fetchall_arrayref()->[0][0];
        if ($curval ne $schema_version) {
            $SQL = 'UPDATE bucardo.bucardo_config SET value = ? WHERE setting = ?';
            my $updatecfg = $dbh->prepare($SQL);
            $updatecfg->execute($schema_version, 'bucardo_current_version');
            clog "Set bucardo_config.bucardo_current_version to $schema_version";
            $changes++;
        }
    }

    if ($changes) {
        printf "Okay to commit $changes %s? ", $changes==1 ? 'change' : 'changes';
        exit if <STDIN> !~ /Y/i;
        $dbh->commit();
        print "Changes have been commited\n";
    }
    else {
        print "No schema changes were needed\n";
        exit 1;
    }

    print "Don't forget to run '$progname validate all' as well: see the UPGRADE file for details\n";

    exit 1;

} ## end of upgrade


sub upgrade_and_log {

    my $action = shift;
    my $short = shift || $action;

    eval {
        $dbh->do($action);
    };
    if ($@) {
        my $line = (caller)[2];
        die "From line $line, action $action\n$@\n";
    }

    $SQL = 'INSERT INTO bucardo.upgrade_log(action,version,summary) VALUES (?,?,?)';
    eval {
        $sth = $dbh->prepare($SQL);
        $sth->execute($action,$VERSION,$short);
    };
    if ($@) {
        my $line = (caller)[2];
        die "From line $line, insert to upgrade_log failed\n$@\n";
    }

    return;

} ## end of upgrade_and_log


sub usage {

    my $name = shift or die;

    ## no critic (RequireInterpolationOfMetachars)
    if ('add' eq $name) {
        return qq{Usage: add <type> <name> [options]
Adds an item to the internal Bucardo database.
The type is one of: code, db, dbgroup, herd, sync, table, or sequence
For more information, run: $progname help add <type>};
    }
    if ('add_customcode' eq $name) {
        return q{Usage: add customcode <name> <whenrun=value> <src_code=filename> [optional information]};
    }
    if ('add_database' eq $name) {
        return q{Usage: add db <name> [optional information]
Adds a database

Optional information:
 name=internal_name (defaults to the database name)
 host=hostname      (defaults to none: Unix socket)
 user=username      (defaults to 'bucardo')
 port=#             (defaults to system default, usually 5432)
 group=groupname    (database group, will be created if needed)
 conn=string        (extra connection parameters, e.g. "sslmode=require")
 status=status      (active or inactive, defaults to 'active')
 sourcelimit=#      (maximum concurrent reads from this database. Default is 0 (no limit))
 targetlimit=#      (maximum concurrent writes from this database. Default is 0 (no limit))
 ssp=#              (if server-side prepares are used, defaults to 1 (on))};
    }
    if ('add_dbgroup' eq $name) {
        return q{Usage: add dbgroup <name> [database1 database2 ...]
Adds a database group, and optionally which databases are members of it.
This can also be used to assign databases to an existing group.};
    }
    if ('add_herd' eq $name) {
        return q{Usage: add herd <name> [table1 table2 ...]
Adds a herd, and optionally which tables are members of it.
This can also be used to assign tables to an existing herd.};
    }
    if ('add_sync' eq $name) {
        return q{Usage: add sync <name> type=x source=x targetdb=x or targetgroup=x [options]
Adds a sync. Required args:
  type=name          (type of sync, must be one of pushdelta, fullcopy, or swap)
  source=name        (the source herd)
  targetdb=name      (the target database)
  targetgroup=name   (the target database group)

Optional information:
  status=x           (One of 'active' or 'inactive', defaults to 'active')
  rebuild_index      (whether to rebuild indexes after every sync, defaults to 0 (off))
  lifetime=number    (how long a kid can live before being reaped, defaults to null (no limit))
  maxkicks=number    (how many kicks a kid can process before being reaped, defaults to 0 (no limit))
  onetimecopy=number (for pushdelta syncs only, controls whether we switch to a fullcopy mode for one run,
                      0=off, 1=always full copy, 2=only copy tables which are empty on the target)
  tables=list        (list of tables to add to this new sync,
                      will create a herd with the same name as the sync)};
    }
    if ('add_sequence' eq $name) {
        return q{Usage: add sequence <name> [name2 name3 ...]
Adds one or more sequences to the internal Bucardo database.};
    }
    if ('add_table' eq $name) {
        return q{Usage: add table <name> [name2 name3 ...]
Adds one or more tables to the internal Bucardo database.};
    }
    if ('config' eq $name) {
        return q{Usage: config show [all | name]
Usage: config set foo=bar [foo2=bar2]
Displays or sets settings from the bucardo_config table.
Using 'show' will display all settings or a subset based on the given name.
Using 'set' will change one or more settings.};
    }
    if ('inspect' eq $name) {
        return q{Usage: inspect <type> <name>
Inspects an object to see if it has dependency issues.
The only supported type is currently 'table'.};
    }
    if ('inspect_herd' eq $name) {
        return q{Usage: inspect herd <name>
Inspects a herd to see if it has dependency issues.};
    }
    if ('inspect_sync' eq $name) {
        return q{Usage: inspect sync <name>
Inspects a sync to see if it has dependency issues.};
    }
    if ('inspect_table' eq $name) {
        return q{Usage: inspect table <name>
Inspects a table to see if it has dependency issues.};
    }
    if ('kick' eq $name) {
        return q{Usage: kick <name> [# of seconds] [name2 name3...] [--notimer]
Kicks one or more named syncs.
If a number is given, that is how long to wait for the sync to signal that it is finished.
If the number 0 is given, we wait as long as it takes.
By default a graphical timer is given: this can be turned off with the --notimer option.};
    }
    if ('list' eq $name) {
        return q{Usage: list <type> [options]
Shows information about items in the internal Bucardo database.
The type is one of: code, db, dbgroup, table, sequence, herd, sync, customcode
For more information, run: $progname help list <type>};
    }
    if ('list_customcode' eq $name) {
        return q{Usage: list customcode name [options]
Lists information about each customcode.
If ''verbose' is added, the 'About' for each code is shown.
If '--verbose --verbose' is added, the internal database columns for the 'customcode' table are shown.};
    }
    if ('list_databases' eq $name) {
        return q{Usage: list db [name] [--verbose] [--verbose]
Lists information about each database Bucardo knows about.

Without a name, all databases are listed.
The name can have wildcards with a '*' at the start and/or end.
If '--verbose' is added, information is shown about which groups and syncs are involved.
If a second '--verbose' is added, the internal database columns for the 'db' table are shown.};
    }
    if ('list_dbgroups' eq $name) {
        return q{Usage: list dbgroup [name] [--verbose --verbose]
Lists database groups, and which databases (if any) are members.

Without a name, all database groups are listed.
The name can have wildcards with a '*' at the start and/or end.
If '--verbose --verbose' is added, the internal database columns for the 'dbgroup' table are shown.};
    }
    if ('list_herds' eq $name) {
        return q{Usage: list herd [name] [--verbose --verbose]
Lists herds, and which tables (if any) are members.

Without a name, all herds are listed.
The name can have wildcards with a '*' at the start and/or end.
If '--verbose --verbose' is added, the internal database columns for the 'herd' table are shown.};
    }
    if ('list_syncs' eq $name) {
        return q{Usage: list sync [name] [--verbose --verbose]
Lists syncs

Without a name, all syncs are listed.
The name can have wildcards with a '*' at the start and/or end.
If '--verbose --verbose' is added, the internal database columns for the 'sync' table are shown.};
    }
    if ('list_sequences' eq $name) {
        return q{Usage: list sequence [name] [--verbose --verbose]
Lists sequences

Without a name, all sequences are listed.
The name can have wildcards with a '*' at the start and/or end.
If '--verbose --verbose' is added, the internal database columns for the 'goat' table are shown.};
    }
    if ('list_tables' eq $name) {
        return q{Usage: list table [name] [--verbose --verbose]
Lists tables

Without a name, all tables are listed.
The name can have wildcards with a '*' at the start and/or end.
If '--verbose --verbose' is added, the internal database columns for the 'goat' table are shown.};
    }
    if ('message' eq $name) {
        return q{Usage: message "text"
Asks a running Bucardo daemon to insert the given text into the Bucardo log files.};
    }
    if ('ping' eq $name) {
        return q{Usage: ping [# of seconds]
Sends a ping notice to the main Bucardo process (MCP) to see if it will respond.
By default, it will wait 15 seconds for a response.
If a number is given, it will wait that number of seconds instead.
Returns a Nagios like message starting with "OK" or "CRITICAL" for success or failure.\n};
    }
    if ('reload' eq $name) {
        return q{Usage: reload sync [sync2 sync3 ...]
Reloads one or more syncs.
This sends a message to Bucardo to stop the named syncs, reload their
information from the database, and start them up again.
Useful if you have changed a setting for an active syncs and need
to put the change in place right away.};
    }
    if ('reload_config' eq $name) {
        return q{Usage: reload_config
Instructs the Bucardo daemon to reload its configuration file and restart.};
    }
    if ('remove' eq $name or 'delete' eq $name) {
        return qq{Usage: remove <type> <name> [options]
Removes an item from the internal Bucardo database.
The type is one of: code, db, dbgroup, table, sequence, herd, sync
For more information, run: $progname help remove <type>};
    }
    if ('remove_customcode' eq $name) {
        return qq{Usage: $verb customcode <name> [name2 name3 ...]
Removes one or more customcodes.};
    }
if ('remove_database' eq $name) {
        return qq{Usage: $verb db <name> [name2 name3 ...]
Removes one or more databases.};
    }
    if ('remove_dbgroup' eq $name) {
        return qq{Usage: $verb dbgroup <name> [name2 name3 ...]
Removes one or more database groups.};
    }
    if ('remove_herd' eq $name) {
        return qq{Usage: $verb herd <name> [name2 name3 ...]
Removes one or more herds.};
    }
    if ('remove_sync' eq $name) {
        return qq{Usage: $verb sync <name> [name2 name3 ...]
Removes one or more syncs.};
    }
    if ('remove_sequence' eq $name) {
        return qq{Usage: $verb sequence <name> [name2 name3 ...]
Removes one or more sequences.};
    }
    if ('remove_table' eq $name) {
        return qq{Usage: $verb table <name> [name2 name3 ...]
Removes one or more tables.};
    }
    if ('restart' eq $name) {
        return q{Usage: restart ["reason"]
Restarts Bucardo by stopping, then starting it up again.
An optional reason can be given.};
    }
    if ('start' eq $name) {
        return q{Usage: start ["reason"]
Starts Bucardo.
An optional reason can be given.};
    }
    if ('status' eq $name) {
        return q{Usage: status [sync1 sync2]
Displays information about the status of syncs.
With no arguments, shows a summary of all syncs.
If one or more named syncs are given, detailed information
about each sync is given.}
    }
    if ('stop' eq $name) {
        return q{Usage: stop ["reason"]
Stops Bucardo and all of its child processes.
An optional reason can be given.
Active children will not stop until they have finished their current task.};
    }
    if ('update' eq $name) {
        return q{Usage: update <type> <name> col1=val [col2=val2 col3=val3 ...]
Updates an item from the internal Bucardo database.
The type is one of: code, db, dbgroup, table, sequence, herd, sync.};
    }
    if ('upgrade' eq $name) {
        return q{Usage: upgrade
Upgrades an existing Bucardo database to the current version.};
    }
    if ('validate' eq $name) {
        return q{Usage: validate [all] [sync1 sync2]
Validates one or more named syncs.
Use 'all' to validate all known syncs at once};
    }

    ## use critic

    return '';

} ## end of usage


sub get_dbs {

    ## Grab information about all entries in the 'db' table

    $SQL = 'SELECT * FROM bucardo.db ORDER BY name';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my $info = $sth->fetchall_hashref('name');
    return $info;

} ## end of get_dbs


sub connect_database {

    ## Connect to a datbase and return a dbh

    my $dbh2;

    my $opt = shift || {};

    if (exists $opt->{name}) {
        $SQL = qq{SELECT bucardo.db_getconn('$opt->{name}')};
        my $conn = $dbh->selectall_arrayref($SQL)->[0][0];
        my ($dsn,$user,$pass) = split /\n/ => $conn;
        eval {
            $dbh2 = DBI->connect_cached($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
        };
        if ($@) {
            ## The bucardo user may not exist yet.
            if ($user eq 'bucardo' and $@ =~ /FATAL/ and $@ =~ /bucardo/) {
                $user = 'postgres';
                $dbh2 = DBI->connect_cached($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
                $dbh2->do('CREATE USER bucardo SUPERUSER');
                $dbh2->commit();
                $user = 'bucardo';
                $dbh2 = DBI->connect_cached($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
            }
        }
    }

    return $dbh2;

} ## end of connect_database


sub config {

    ## View or change a value inside the bucardo_config table

    my $setusage = "Usage: $progname set setting=value [setting=value ...]\n";

    if (!@nouns) {
        $verb eq 'set' and die $setusage;
        die "Usage: $progname show <all|setting1> [settting2 ...]\n";
    }

    $SQL = 'SELECT * FROM bucardo.bucardo_config';
    $sth = $dbh->prepare($SQL);
    $sth->execute();
    my $config = $sth->fetchall_hashref('setting');
    if ($verb eq 'show') {
        my $all = $nouns[0] =~ /\ball\b/i ? 1 : 0;
        my $maxsize = 3;
        for my $s (keys %$config) {
            next if ! $all and ! grep { $s =~ /$_/i } @nouns;
            $maxsize = length $s if length $s > $maxsize;
        }
        for my $s (sort keys %$config) {
            next if ! $all and ! grep { $s =~ /$_/i } @nouns;
            printf "%-*s = %s\n", $maxsize, $s, $config->{$s}{value};
        }
        exit 1;
    }

    $SQL = 'UPDATE bucardo.bucardo_config SET value = ? WHERE setting = ?';
    $sth = $dbh->prepare($SQL);

    for my $noun (@nouns) {
        $noun =~ /(\w+)=(.+)/ or die $setusage;
        my ($setting,$val) = (lc $1,$2);

        if (! exists $config->{$setting}) {
            die qq{Unknown setting "$setting"\n};
        }

        $sth->execute($val,$setting);
        print qq{Set "$setting" to "$val"\n};

    }

    $dbh->commit();

    exit 0;

} ## end of config


sub message {

    ## Add a message to the Bucardo logs, via the bucardo_log_message table
    ## Note: If no MCP processes are listening, the message will hang out until an MCP processes it

    if (! length($nouns)) {
        die qq{Usage: bucardo_ctl message "Some message to send to the logs"\n};
    }

    $SQL = 'INSERT INTO bucardo.bucardo_log_message(msg) VALUES (?)';
    $sth = $dbh->prepare($SQL);
    $sth->execute($nouns);
    $dbh->commit();
    $VERBOSE and print "Message added\n";
    exit 0;

} ## end of message


sub install {

    print "This will install the bucardo database into an existing Postgres cluster.\n";
    print "Postgres must have been compiled with Perl support,\n";
    print "and you must connect as a superuser\n\n";
    print "We will create a new superuser named 'bucardo',\n";
    print "and make it the owner of a new database named 'bucardo'\n\n";

    my $ans;
    my $host = $bcargs->{dbhost} || $ENV{DBHOST} || '<none>';
    my $port = $bcargs->{dbport} || $ENV{DBPORT} || 5432;
    my $user = $ENV{DBUSER} || 'postgres';
    my $dbname = $ENV{DBNAME} || 'postgres';

    ## Make sure the bucardo.schema file is available, and extract some config items
    my ($fh, $schema_file) = find_bucardo_schema();
    my %confvar = (piddir => '');
    while (<$fh>) {
        for my $string (keys %confvar) {
            if (/^$string\|(.+?)\|/) {
                $confvar{$string} = $1;
            }
        }
    }
    close $fh or warn qq{Could not close "$schema_file": $!\n};
    for my $key (keys %confvar) {
        if (!$confvar{$key}) {
            warn "Could not find default configuration for $key!\n";
        }
    }

    my $piddir = $bcargs->{piddir} || $confvar{piddir};

  GOOEY:
    {

        print "Current connection settings:\n";

        print "1. Host:          $host\n";
        print "2. Port:          $port\n";
        print "3. User:          $user\n";
        print "4. Database:      $dbname\n";
        print "5. PID directory: $piddir\n";

        print 'Enter a number to change it, P to proceed, or Q to quit: ';

        $ans = <>;
        print "\n";

        if ($ans =~ /^\s*(\d+)(.*)/) {
            my ($num,$text) = (int $1,$2);
            $text =~ s/^\s*(\S+)\s*$/$1/;
            my $new = length $text ? $text : '';
            if (1 == $num) {
                if (!length $new) {
                    print 'Change the host to: ';
                    $new = <>;
                    print "\n";
                    chomp $new;
                }
                $host = length $new ? $new : '<none>';
                print "Changed host to: $host\n";
            }
            elsif (2 == $num) {
                if (!length $new) {
                    print 'Change the port to: ';
                    $new = <>;
                    print "\n";
                    chomp $new;
                }
                if ($new !~ /^\d+$/) {
                    print "-->Sorry, but the port must be a number\n\n";
                    redo GOOEY;
                }
                $port = $new;
                print "Changed port to: $port\n";
            }
            elsif (3 == $num) {
                if (!length $new) {
                    print 'Change the user to: ';
                    $new = <>;
                    print "\n";
                    chomp $new;
                }
                if (! length $new) {
                    print "-->Sorry, you must specify a user\n\n";
                    redo GOOEY;
                }
                $user = $new;
                print "Changed user to: $user\n";
            }
            elsif (4 == $num) {
                if (!length $new) {
                    print 'Change the database name to: ';
                    $new = <>;
                    print "\n";
                    chomp $new;
                }
                if (! length $new) {
                    print "-->Sorry, you must specify a database name\n\n";
                    redo GOOEY;
                }
                $dbname = $new;
                print "Changed database name to: $dbname\n";
            }
            elsif (5 == $num) {
                if (!length $new) {
                    print 'Change the PID directory to: ';
                    $new = <>;
                    print "\n";
                    chomp $new;
                }
                if (! length $new) {
                    print "-->Sorry, you must specify a directory\n\n";
                    redo GOOEY;
                }
                if ($new !~ m{^/}) {
                    print "-->Sorry, the PID directory must be absolute (start with a slash)\n";
                    redo GOOEY;
                }
                if (! -d $new) {
                    print "-->Sorry, that is not a valid directory\n";
                    redo GOOEY;
                }
                $piddir = $new;
                print "Changed PID dir to: $piddir\n";
            }
        }
        elsif ($ans =~ /^\s*Q/i) {
            die "Goodbye!\n";
        }
        elsif ($ans =~ /^\s*P/i) {
            if (! -d $piddir) {
                print "-->Sorry, that is not a valid PID directory\n";
                redo GOOEY;
            }
            last GOOEY;
        }
        else {
            print "-->Please enter Q to quit, P to proceed, or enter a number to change a setting\n";
        }

        redo GOOEY;

    }

    my $PSQL = "psql -p $port -U $user -d $dbname -c 'SELECT version()'";
    $host !~ /</ and $PSQL .= " --host=$host";

    my $COM = "$PSQL -c 'SELECT version()'";

    my $res = qx{$COM};
    if ($res !~ /(\d+)\.(\d+)(\S+)/) {
        die "Sorry, unable to determine the database version\n";
    }
    my ($maj,$min,$rev) = ($1,$2,$3);
    $rev =~ s/^\.//;

    print "Postgres version is: $maj.$min\n";

    if ($maj < 8 or (8 == $maj and $min < 1)) {
        die "Sorry, Bucardo requires Postgres version 8.1 or higher. This is only $maj.$min\n";
    }

    $COM = "$PSQL -AX -qt -f $schema_file 2>&1";

    print "Attempting to create and populate the bucardo database and schema\n";

    $res= qx{$COM};

    if ($res !~ m{Pl/PerlU was successfully installed}) {
        warn "\nINSTALLATION FAILED! ($res)\n\n";
        warn "Installation cannot proceed unless the Pl/PerlU language is available\n";
        warn "This is usually available as a separate package\n";
        warn "For example, you might try: yum install postgresql-plperl\n";
        warn "If compiling from source, add the --with-perl option to your ./configure command\n\n";
        exit 1;
    }

    print "Database creation is complete\n\n";

    ## Whether or not we really need to, change the bucardo_config items:

    print "Connecting to database 'bucardo' as user 'bucardo'\n";
    my $BDSN  = 'dbi:Pg:dbname=bucardo';
    $host and $host ne '<none>' and $BDSN .= ";host=$host";
    $port and $BDSN .= ";port=$port";
    my $default_bucardo_password = 'goat';
    $dbh = DBI->connect($BDSN, 'bucardo', $default_bucardo_password, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
    $dbh->do('SET search_path = bucardo');

    $SQL = 'UPDATE bucardo.bucardo_config SET value = ? WHERE setting = ?';
    $sth = $dbh->prepare($SQL);
    $confvar{piddir} = $piddir;
    for my $key (sort keys %confvar) {
        $count = $sth->execute($confvar{$key}, $key);
        if ($count != 1) {
            warn "!! Failed to set $key to $confvar{$key}\n";
        }
        else {
            print qq{Updated configuration setting "$key"\n};
        }
    }
    $dbh->commit();

    print "Installation is now complete.\n\n";
    print "If you see any unexpected errors above, please report them to bucardo-general\@bucardo.org\n\n";

    print "You should probably check over the configuration variables next, by running:\n";
    print "$progname show all\n";
    print "Change any setting by using: $progname set foo=bar\n\n";

    exit 0;

} ## end of install


__END__

=head1 NAME

bucardo_ctl - utility script for controlling the Bucardo program

=head1 VERSION

This document describes version 4.4.6 of bucardo_ctl

=head1 SYNOPSIS

  ./bucardo_ctl install

  ./bucardo_ctl list dbs

  ./bucardo_ctl add sync testsync source=herd1 type=pushdelta targetdb=B

  ./bucardo_ctl add sync testsync source=herd1 type=pushdelta targetdb=B tables=tab1,tab2,tab3

  ./bucardo_ctl add database newdb name=internal_name port=5432 host=myserver

  ./bucardo_ctl add all tables db=foo

  ./bucardo_ctl add all sequences db=foo

  ./bucardo_ctl add herd newherd table1 table2 table3 ...

  ./bucardo_ctl add dbgroup name db1 db2 db3 ...

  ./bucardo_ctl start "Starting up - Greg"

  ./bucardo_ctl stop "Bringing down for debugging - Raul E."

  ./bucardo_ctl ping

  ./bucardo_ctl status

  ./bucardo_ctl status sync1 sync2

  ./bucardo_ctl kick sync1 sync2

  ./bucardo_ctl kick sync1 0

  ./bucardo_ctl reload_config

  ./bucardo_ctl upgrade

  ./bucardo_ctl reload sync

  ./bucardo_ctl validate sync

  ./bucardo_ctl message "Your message here"

  ./bucardo_ctl config show

  ./bucardo_ctl config set foo=bar baz=123


=head1 DESCRIPTION

The bucardo_ctl script is the main interaction to a running Bucardo instance. It can 
be used to start and stop Bucardo, add new items, kick syncs, and even install and 
upgrade Bucardo itself. For more complete documentation, please view the wiki at:

http://bucardo.org/

=head1 COMMANDS

=over 4

=item B<install>

Usage: ./bucardo_ctl install

Attempts to install the Bucardo schema from the file 'bucardo.schema' into an existing 
Postgres cluster. The user 'bucardo' and database 'bucardo' will be created first as needed.
This is an interactive installer, but you can supply the following values from the command 
line:

=over 2

=item --dbuser (defaults to postgres)

=item --dbname (defaults to postgres)

=item --dbport (defaults to 5432)

=item --piddir (defaults to /var/run/bucardo/)

=back

=item B<upgrade>

Usage: ./bucardo_ctl upgrade

Upgrades an existing Bucardo installation to the current version of the bucardo_ctl script. 
Requires that the bucardo_ctl script and the bucardo.schema file be the same version. All 
changes should be backwards compatible, but you may need to re-validate existing scripts 
to make sure changes get propagated to all databases.

=item B<start>

Usage: ./bucardo_ctl start "Reason --name"

Restarts Bucardo cleanly by first issuing the equivalent of a stop to ask any existing Bucardo 
processes to exit, and then starting a new Bucardo MCP process. A short reason and name should 
be provided - these are logged in the reason_file file and sent in the email sent when Bucardo 
has been started up.

Before attempting to kill any old processes, a ping command with a timeout of 5 seconds is issued. 
If this returns successfully (indicating an active MCP process already running), the script will 
exit with a return value of 2.

=item B<stop>

Usage: ./bucardo_ctl stop "Reason --name"

Forces Bucardo to quit by creating a stop file which all MCP, CTL, and KID processes should 
detect and cause them to exit. Note that active syncs will not exit right away, as they 
will not look for the stop file until they have finished their current run. Typically, 
you should scan the list of processes after running this program to make sure that all Bucardo 
processes have stopped. One should also provide a reason for issuing the stop - usually 
this is a short explanation and your name. This is logged in the reason_file file and 
is also used by Bucardo when it exits and sends out mail about its death.

=item B<list>

Usage: ./bucardo_ctl list <type> <regex>

Lists summary information about databases, tables, sequences, syncs, or herds. Adding anything 
after the type will look up all matching entries.

=item B<add>

Usage:  add <item_type> <item_name>

Usage:  add database <dbname> name=internal_name port=xxx host=xxx user=xxx pass=xxx service=xxx conn=xxx sourcelimit=xxx targetlimit=xxx ssp=1/0

Usage:  add table [schema].table db=internal_db_name ping=bool standard_conflict=xxx makedelta=bool herd=xxx

Usage:  add all tables herd=xxx

Usage:  add sequence [schema].table herd=xxx

Usage:  add all sequences herd=xxx

Usage:  add sync syncname options

Usage:  add herd name

Usage:  add dbgroup name db1 db2 db3 ...

Tells Bucardo about new objects it should know about. These commands can
replace direct manipulation of the tables in the bucardo schema for the
supported object types (you'll still need to add things like the mappings between objects on your own).

=item B<remove>

Usage:  remove <item_type> <item_name>

Removes one or more items from the Bucardo database. Valid item types are database, 
dbgroup, herd, sync, table, and sequence.

=item B<kick>

Usage: ./bucardo_ctl kick <syncname(s)> [timeout]

Tells one or more named syncs to fire as soon as possible. Note that this simply sends a request that 
the sync fire: it may not start right away if the same sync is already running, or if the source or 
target database has exceeded the number of allowed Bucardo connections. If the final argument is a 
number, it is treated as a timeout. If this number is zero, the bucardo_ctl command will not return 
until the sync has finished. For any other number, the sync will wait at most that number of seconds. 
If any sync has not finished before the timeout, a false value is returned. In all other cases, a 
true value is returned.

If a timeout is given, the total completion time in seconds is also displayed. If the sync is going to 
multiple targets, the time that each target takes from the start of the kick is also shown as each 
target finishes.

=item B<reload_config>

Forces Bucardo to reload the bucardo_config file, and then restart all processes to ensure that the new 
information is loaded.

=item B<show>

Usage: ./bucardo_ctl show <all|setting1> [setting2..]

Shows the current values in the bucardo_config table. Use the keyword 'all' to see all the settings, or 
specify one or more search terms.

=item B<set>

Usage: ./bucardo_ctl set setting1=value [setting2=value]

Sets one or more items inside the bucardo_config table. Setting names are case-insensitive.

=item B<ping>

Sends a ping notice to the MCP process to see if it will respond. By default, it will wait 15 seconds. A 
numeric argument will change this timeout. Using a 0 as the timeout indicates waiting forever. If a response 
was returned, the program will exit with a value of 0. If it times out, the value will be 1.

=item B<status>

Usage: ./bucardo_ctl status [syncname(s)] [--sort=#] [--daysback=#] [--showdays]

Shows the current status of all known syncs in a tabular format. If given one or more syncnames, 
shows detailed information for each one.

When showing all syncs, the columns are:

=over 8

=item 1. B<Name>

The name of the sync

=item 2. B<Type>

The type of the sync. C<F> = fullcopy, C<S> = swap, C<P> = pushdelta. In addition, if a sync is overdue, a C<O!> will 
appear, and if it is expired, a C<E!> will appear.

=item 3. B<State>

The current status of this sync. If no sync is running, C<idle> will appear. If a sync has been requested, but has not 
started yet, C<WAIT> will appear, along with how long since the sync was requested. If a sync is 
currently running, C<RUN> will appear, followed by the amount of time the sync has been running, followed by which 
target the sync is running against. Note that syncs running to more than one database at a time will only show 
the one most recently started.

=item 4. B<PID>

The PID of the current sync's controller (CTL). Note that if this is not a persistent sync and the state is C<idle>, 
this is merely a historical record and does not represent an active process.

=item 5. B<Last_good>

How long since this sync last ran successfully. Remember that this is affected by the --daysback parameter.

=item 6. B<Time>

The amount of time the last successful sync took to run.

=item 7. B<I/U/D>

The number of inserts. updates, and deletes performed by the last successful sync.

=item 8. B<Last_bad>

How long since this sync failed to run successfully. Strongly affected by the --daysback parameter.

=item 9. B<Time>

The amount of time the last failed sync took before it was aborted.

=back


=item B<activate> syncname [syncname2 syncname3 ...] [timeout]

Activates one or more named syncs. If given a timeout argument, it will wait until it has received 
confirmation from Bucardo that each sync has been successfully activated.

=item B<deactivate> syncname [syncname2 syncname3 ...] [timeout]

Deactivates one or more named syncs. If given a timeout argument, it will wait until it has received 
confirmation from Bucardo that the sync has been successfully deactivated.

=item B<message>

Adds a message to the running Bucardo logs. This message will appear prefixed with "MESSAGE: ". If 
Bucardo is not running, the message will go to the logs the next time Bucardo is running and someone 
adds another message.

=back

=head1 OPTIONS

It is usually easier to set most of these options at the top of the script, or make an alias for them, 
as they will not change very often if at all.

=over 4

=item B<--dbport=number>

=item B<--dbhost=string>

=item B<--dbname=string>

=item B<--dbuser=string>

=item B<--dbpass=string>

The port, host, and name of the Bucardo database, the user to connect as, and the password to use.

=item B<--verbose>

Makes bucardo_ctl run verbosely. Default is off.

=item B<--quiet>

Tells bucardo_ctl to be as quiet as possible. Default is off.

=item B<--help>

Shows a brief summary of usage for bucardo_ctl.

=back

=head2 Kick arguments

The following arguments are only used with the 'kick' command:

=over 4

=item B<--retry=#>

The number of times to retry a sync if it fails. Defaults to 0.

=item B<--retrysleep>

How long to sleep, in seconds, between each retry attempt.

=item B<--notimer>

By default, kicks with a timeout argument give a running real-time summary of time elapsed by 
using the backspace character. This may not be wanted if running a kick, for example, 
via a cronjob, so turning --notimer on will simply print the entire message without backspaces.

=back

=head2 Status arguments

The following arguments are only used with the 'status' command:

=over 4

=item B<--daysback=#>

Sets how many days backwards to search the old 'q' logs for information. Defaults to 3 days.

=item B<--showdays>

Specifies whether or not do list the time interval with days, or simply show the hours. For example, 
"3d 12h 6m 3s" vs. "48h 6m 3s"

=item B<--compress>

Specifies whether or not to compress the time interval by removing spaces. Mostly used to limit 
the width of the 'status' display.

=item B<--sort=#>

Requests sorting of the 'status' output by one of the nine columns. Use a negative number to reverse 
the sort order.

=back

=head2 Startup arguments

The following arguments are only applicable when using the "start" command:

=over 4

=item B<--sendmail>

Tells Bucardo whether or not to send mail on interesting events: startup, shutdown, and errors. Default is on.
Only applicable when using ./bucardo_ctl start.

=item B<--extraname=string>

A short string that will be appended to the version string as output by the Bucardo process names. Mostly 
useful for debugging.

=item B<--debugfilesep>

Forces creation of separate log files for each Bucardo process of the form "log.bucardo.X.Y", 
where X is the type of process (MCP, CTL, or KID), and Y is the process ID.

=item B<--debugsyslog>

Sends all log messages to the syslog daemon. On by default. The facility used is controlled by 
the row "syslog_facility" in the bucardo_config table, and defaults to "LOG_LOCAL1".

=item B<--debugfile>

If set, writes detailed debugging information to one or more files.

=item B<--debugdir=directory name>

Directory where the debug files should go.

=item B<--debugname=string>

Appends the given string to the end of the default debug file name, "log.bucardo". A dot is added 
before the name as well, so a debugname of "rootdb" would produce a log file named "log.bucardo.rootdb".

=item B<--cleandebugs>

Forces removal of all old debug files before running.

=back

=head1 FILES

In addition to command-line configurations, you can put any options inside of a file. The file F<.bucardorc> in 
the current directory will be used if found. If not found, then the file F<~/.bucardorc> will be used. Finally, 
the file /etc/bucardorc will be used if available. The format of the file is option = value, one per line. Any 
line starting with a '#' will be skipped. Any values loaded from a bucardorc file will be overwritten by 
command-line options. All bucardorc files can be ignored by supplying a C<--no-bucardorc> argument. A specific 
file can be forced with the C<--bucardorc=file> option; if this option is set, bucardo_ctl will refuse to run 
unless that file can be read.

=head1 ENVIRONMENT VARIABLES

The bucardo_ctl script uses I<$ENV{HOME}> to look for a F<.bucardorc> file.

=head1 BUGS

The 'status' command does not yet return current information, and the start time in particular should be 
taken with a grain of salt.

Bug reports and feature requests are always welcome, please visit http://bucardo.org or email bucardo-general@bucardo.org.

=head1 SEE ALSO

Bucardo

=head1 COPYRIGHT

Copyright 2006-2010 Greg Sabino Mullane <greg@endpoint.com>

This program is free to use, subject to the limitations in the LICENSE file.

=cut

