#!/usr/bin/perl
#------------------------------------------------------------------------------
#
# pg_dumpbinary - Dump a PostgreSQL database using binary format for data.
#
# This program is open source, licensed under the PostgreSQL license.
# For license terms, see the LICENSE file.
#
# Author: Gilles Darold
# Copyright: (C) 2019-2025 LzLabs, GmbH
#------------------------------------------------------------------------------
use strict;

use Getopt::Long  qw(:config bundling no_ignore_case_always);
use POSIX qw(locale_h sys_wait_h _exit);
use Time::HiRes qw/usleep/;
use File::Spec;
use File::Temp qw/ tempfile /;
use DBI;
use DBD::Pg;
use POSIX qw(strftime);

my $VERSION = '2.20';
my $PROGRAM = 'pg_dumpbinary';

my $DBNAME = '';
my $DBUSER = '';
my $DBHOST = '';
my $DBPORT = 5432;
my @INC_SCHEMA = ();
my @EXC_SCHEMA = ();
my @INC_TABLE = ();
my @EXC_TABLE = ();
my $WHERE = '';

my $TMP_DIR   = File::Spec->tmpdir() || '/tmp';
my $PGDUMP    = 'pg_dump';
my $PGRESTORE = 'pg_restore';
my $PSQL      = 'psql';
my $PG_OPT    = '';
my $PG_FILTER = '';
my $JOBS      = 1;
my $VER       = 0;
my $HELP      = 0;
my $PARTITION_ROOT = 0;
my $COMPRESS_LEVEL = 6;
my $SNAPSHOT_INFO_FILE = '/tmp/.snapshot_info';
my $ATTACH_SNAPSHOT = '';
my $VERBOSE   = 0;
my $WITH_CHILD = 0;

my $interrupt    = 0;
my $child_count  = 0;
my %RUNNING_PIDS = ();
my $dbh          = undef;
my %all_partition_names = ();

my @post_conn = (
	"SELECT pg_catalog.set_config('search_path', '', false);",
	"SET client_encoding TO 'UTF8';",
	"SET DATESTYLE = ISO;",
	"SET INTERVALSTYLE = POSTGRES;",
	"SET extra_float_digits TO 3;",
	"SET synchronize_seqscans TO off;",
	"SET statement_timeout = 0;",
	"SET lock_timeout = 0;",
	"SET idle_in_transaction_session_timeout = 0;",
	"SET row_security = off;",
	"BEGIN TRANSACTION ISOLATION LEVEL REPEATABLE READ, READ ONLY;"
);

my $parent_pid = $$;

####
# Method used to fork as many child as wanted,
# must be declared at top if the program.
####
sub spawn
{
	my $coderef = shift;

	unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE')
	{
		print "usage: spawn CODEREF";
		exit 0;
	}

	my $pid;
	if (!defined($pid = fork)) {
		print STDERR "Error: cannot fork: $!\n";
		return;
	} elsif ($pid) {
		$RUNNING_PIDS{$pid} = $pid;
		return; # the parent
	}
	# the child -- go spawn
	$< = $>;
	$( = $); # suid progs only

	exit &$coderef();
}


$SIG{'CHLD'} = 'DEFAULT';

# Child reports error
sub child_error
{
	my $sig = shift;

	$interrupt = 1;

	print STDERR "An error occurs from a child process, aborting...\n";
	if ($^O !~ /MSWin32|dos/i) {
		1 while wait != -1;
		$SIG{INT} = \&wait_child;
		$SIG{TERM} = \&wait_child;
		$SIG{USR1} = \&child_error;
	}
	_exit(1);
}

# With multiprocess we need to wait for all children
sub wait_child
{
	my $sig = shift;

	$interrupt = 1;

	print STDERR "Received terminating signal ($sig)\n";
	if ($^O !~ /MSWin32|dos/i) {
		1 while wait != -1;
		$SIG{INT} = \&wait_child;
		$SIG{TERM} = \&wait_child;
	}
	$dbh->disconnect() if (defined $dbh);

	_exit(0);
}
$SIG{INT} = \&wait_child;
$SIG{TERM} = \&wait_child;
$SIG{USR1} = \&child_error;

$| = 1;

GetOptions(
	"A|attach=s"         => \$ATTACH_SNAPSHOT,
	"C|compress-level=i" => \$COMPRESS_LEVEL,
	"d|database=s"       => \$DBNAME,
	"h|host=s"           => \$DBHOST,
	"j|jobs=s"           => \$JOBS,
	"n|schema=s"         => \@INC_SCHEMA,
	"N|exclude-schema=s" => \@EXC_SCHEMA,
	"p|port=i"           => \$DBPORT,
	"s|snapshot-file=s"  => \$SNAPSHOT_INFO_FILE,
	"t|table=s"          => \@INC_TABLE,
	"T|exclude-table=s"  => \@EXC_TABLE,
	"u|user=s"           => \$DBUSER,
	"v|version!"         => \$VER,
	"V|verbose!"         => \$VERBOSE,
	"w|where=s"          => \$WHERE,
	"help!"              => \$HELP,
	"load-via-partition-root!" => \$PARTITION_ROOT,
	"with-child!"        => \$WITH_CHILD,
);

if ($VER)
{
	print "$PROGRAM Version: v$VERSION\n";
	exit 0;
}

&usage if ($HELP);

if ($COMPRESS_LEVEL && ($COMPRESS_LEVEL < 0 or $COMPRESS_LEVEL > 9)) {
	&usage("ERROR: compression level must be a number between 0 and 9\n");
}

if (!$DBNAME)
{
	&usage("ERROR: you must specify a database to dump, see -d option\n");
}

# Set the WHERE clause if we have a filter
$WHERE = ' WHERE ' . $WHERE if ($WHERE);

# Set pg_dump/psql option
if ($DBHOST)
{
	$PG_OPT .= " -h $DBHOST";
}
if ($DBPORT)
{
	$PG_OPT .= " -p $DBPORT";
}
if ($DBUSER)
{
	$PG_OPT .= " -U $DBUSER";
}

# Set schema/table filter options
&set_filter_option();

# Set default output directory name
my $CURDATE = get_current_date();
my $OUTDIR = $ARGV[0] || 'binary_bkup_' . $CURDATE;

# Change directory to writable one for pg_restore
if (! -w ".")
{
	# Force absolute path for input directory
	if ($OUTDIR !~ /^\//) {
		die "ERROR: the output directory must be an absolute path.\n";
	}
	chdir $TMP_DIR;
}

# Create output directory
if (!-d $OUTDIR)
{
	mkdir $OUTDIR or die "FATAL: can not create directory $OUTDIR, $!\n";
}

printf "Database $DBNAME dump created at %s\n", get_current_date();

# Set DBD::Pg options and connect to the database
# to create the snapshot for a consistent backup
my $dbpg_opt = '';
$dbpg_opt .= ";port=$DBPORT" if ($DBPORT);
$dbpg_opt .= ";host=$DBHOST" if ($DBHOST);
$dbh = DBI->connect("dbi:Pg:application_name=pg_dumpbinary;dbname=$DBNAME$dbpg_opt", $DBUSER, '', {AutoCommit => 1, InactiveDestroy => 1});
if (not defined $dbh)
{
	die "FATAL: can not connect to database $DBNAME\n";
}

# Verify that we have a PG >= 9.2
my $sth = $dbh->prepare("SELECT version()") or die "FATAL: " . $dbh->errstr . "\n";
$sth->execute or die "FATAL: " . $dbh->errstr . "\n";
my $pgversion = 0;
while (my $row = $sth->fetch)
{
	if ($row->[0] =~ /^[^\s]+ (\d+\.\d+)/)
	{
		$pgversion = $1;
		$pgversion =~ s/\..*// if ($pgversion >= 10);
	}
}
$sth->finish;

# No way before PG 9.2
if ($pgversion < 9.2)
{
	$dbh->disconnect();
	die "FATAL: pg_dumpbinary require PG >= 9.2!\n";
}

# We need to retrieve the version of pg_restore about
# option -f - that is required with PG >= v12
my $pgrestore_version = `$PGRESTORE --version | awk '{print \$3}'`;
if ($?) {
	die "ERROR: cannot read pg_restore version.\n";
}
chomp($pgrestore_version);

# Be sure that the host is not in recovery mode or that we have PG >= 10
$sth = $dbh->prepare("SELECT pg_catalog.pg_is_in_recovery()") or die "FATAL: " . $dbh->errstr . "\n";
$sth->execute or die "FATAL: " . $dbh->errstr . "\n";
my $is_in_recovery = 0;
while (my $row = $sth->fetch)
{
	$is_in_recovery = $row->[0];
}
$sth->finish;
if ($is_in_recovery && $pgversion < 10)
{
	$dbh->disconnect();
	die "FATAL: PostgreSQL server is in recovery mode, this is not supported before PG 10.\n";
}

# When a snapshot is provided, used it, otherwise create one
my $snapshot = ''; 
if ($ATTACH_SNAPSHOT)
{
	$snapshot = $ATTACH_SNAPSHOT;
	$dbh->do("BEGIN TRANSACTION ISOLATION LEVEL REPEATABLE READ, READ ONLY;") or die "FATAL: " . $dbh->errstr . "\n";
	$dbh->do("SET TRANSACTION SNAPSHOT '$snapshot'") or die "FATAL: " . $dbh->errstr . "\n";
}
else
{
	# Create a snapshot that will be reused with pg_dump for DDL and psql to retrieve data
	foreach my $q (@post_conn)
	{
		next if ($pgversion < 9.6 and $q =~ /SET idle_in_transaction_session_timeout/);
		$dbh->do("$q") or die "FATAL: " . $dbh->errstr . "\n";
	}
	$sth = $dbh->prepare("SELECT pg_catalog.pg_export_snapshot()") or die "FATAL: " . $dbh->errstr . "\n";
	$sth->execute or die "FATAL: " . $dbh->errstr . "\n";
	while (my $row = $sth->fetch)
	{
		$snapshot = $row->[0];
	}
	$sth->finish;
	if (!$snapshot)
	{
		$dbh->disconnect();
		die "FATAL: can not obtain a snapshot, please check what's going wrong.\n";
	}
}

# Save snapshot information to file
unlink("$SNAPSHOT_INFO_FILE") if (-e "$SNAPSHOT_INFO_FILE");
open(my $sfh, '>', "$SNAPSHOT_INFO_FILE") or die "FATAL: can not save snapshot information to file $SNAPSHOT_INFO_FILE\n";
print $sfh $snapshot;
close($sfh);

# Fork a process to maintain activity in the snapshot connection to avoid
# timeout disconnection from a firwall. The process is terminated when the
# snapshot info file is removed.
spawn sub
{
	my $old_time = time;
	while (-e "$SNAPSHOT_INFO_FILE")
	{
		if (time > $old_time + 30)
		{
			$old_time = time;
			my $sth2 = $dbh->do("SELECT 1;") or die "FATAL: " . $dbh->errstr . "\n";
		}
		sleep(1);
	}
};

# Dump database pre-data section
printf "Dumping pre data section at %s\n", get_current_date();
`$PGDUMP --snapshot='$snapshot' $PG_OPT $PG_FILTER -d $DBNAME -Fc --section=pre-data -f "$OUTDIR/pre-data.dmp"`;
if ($?)
{
	unlink("$SNAPSHOT_INFO_FILE") if (-e "$SNAPSHOT_INFO_FILE");
	$dbh->disconnect();
	die "ERROR: pg_dump error to dump pre-data section.\n";
}

# Get list of extensions tables that will need to be restored
my @ext_tables = `$PSQL $PG_OPT -d $DBNAME -AtXc "SET search_path TO ''; SELECT extname, unnest(extconfig)::regclass FROM pg_catalog.pg_extension WHERE extconfig IS NOT NULL"`;
if ($?)
{
	unlink("$SNAPSHOT_INFO_FILE") if (-e "$SNAPSHOT_INFO_FILE");
	$dbh->disconnect();
	die "ERROR: can not get extensions tables that must be dumped.\n";
}
chomp(@ext_tables);
shift(@ext_tables); # remove SET from the list
if ($#ext_tables >= 0)
{
	open(my $of, '>', "$OUTDIR/extensions-tables.lst") or die "FATAL: can not write to file $OUTDIR/extensions-tables.lst, $!\n";
	foreach my $l (@ext_tables) {
		print $of "$l\n"
	}
	close($of);
}

# Retrieve the list of partition table
my %partitions = get_partition_list();

# Retrieve list of schema.tables to restore and condition for foreign tables
# as well as the list of statements to gather sequences last values.
my %ext_cond = ();
my %tbl_list = ();
get_table_list();

# Generate all sequences ALTER statements in a file data-sequences.lst to be
# able to set the last values of sequences when the data will be restored
gen_sequences_statements();

# Distribute all tables equally between all processes.
my %distributed_table = ();
my $proc = 1;
foreach my $s (sort keys %tbl_list)
{
	for (my $i = 0; $i <= $#{$tbl_list{$s}}; $i++)
	{
		# exclude partitionned table from export, COPY will be done from the partitions
		next if (!$PARTITION_ROOT && exists $partitions{$s}{$tbl_list{$s}[$i]});
		# exclude all partition from the export when data are exported from the partition root
		next if ($PARTITION_ROOT && exists $all_partition_names{$s}{$tbl_list{$s}[$i]});
		my $file = quotemeta($s) . '.' . quotemeta($tbl_list{$s}[$i]);
		# write target list to file (exclude generated columns)
		my $tb = $tbl_list{$s}[$i];
		my $schm = $s;
		$tb =~ s/\$/\\\$/g;
		$schm =~ s/\$/\\\$/g;
		`$PSQL $PG_OPT -d $DBNAME -AtXc "SELECT quote_ident(attname) FROM pg_attribute a JOIN pg_class c ON (a.attrelid = c.oid) JOIN pg_namespace n ON (c.relnamespace = n.oid) WHERE c.relname = '$tb' AND n.nspname = '$schm' AND a.attnum > 0 AND NOT a.attisdropped AND attgenerated = '' ORDER BY a.attnum;" > "$OUTDIR/meta-$file.txt"`;
		if ($?) {
			die "ERROR: psql fail to write target list.\n";
		}
		my @target_list = `cat "$OUTDIR/meta-$file.txt"`;
		chomp(@target_list);
		my $targets = join(',', @target_list);

		push(@{ $distributed_table{$proc} }, "\\o");
		push(@{ $distributed_table{$proc} }, "\\echo Dumping data from table $s.$tbl_list{$s}[$i]");
		printf "Adding to export list table $s.$tbl_list{$s}[$i]\n" if ($VERBOSE);
		if (!$COMPRESS_LEVEL)
		{
			$file = $s . '.' . $tbl_list{$s}[$i];
			push(@{ $distributed_table{$proc} }, qq{\\o $OUTDIR/data-$file.bin});
		}
		else
		{
			push(@{ $distributed_table{$proc} }, qq{\\o |gzip -$COMPRESS_LEVEL -c - > "$OUTDIR/data-$file.bin.gz"});
		}
		# Use the COPY (SELECT ...) TO syntax to be able to select the partition to dump and to apply a filter
		my $alias = '';
		if (exists $ext_cond{$s}{$tbl_list{$s}[$i]} && $ext_cond{$s}{$tbl_list{$s}[$i]} eq '') {
			$alias = $ext_cond{$s}{$tbl_list{$s}[$i]};
		}
		push(@{ $distributed_table{$proc} }, qq{COPY (SELECT $targets FROM "$s"."$tbl_list{$s}[$i]" $alias$WHERE) TO stdout WITH (FORMAT binary);});
		$proc++;
		$proc = 1 if ($proc > $JOBS);
	}
}

# Fork a process to call psql to execute COPY in binary format
# with the per process dedicated tables to export.
printf "Dumping data at %s\n", get_current_date();
foreach my $p (sort keys %distributed_table)
{
	spawn sub
	{
		my ($fh, $filename) = tempfile('pg_dumpbinXXXX', SUFFIX => '.tmp', DIR => $TMP_DIR, UNLINK => 1 );
		if (defined $fh)
		{
			print $fh "\\o /dev/null\n";
			foreach my $q (@post_conn)
			{
				next if ($pgversion < 9.6 and $q =~ /SET idle_in_transaction_session_timeout/);
				print $fh "$q\n";
			}
			print $fh "SET TRANSACTION SNAPSHOT '$snapshot';\n";
			print $fh "\\o\n";
			map { print $fh "$_\n"; } @{ $distributed_table{$p} };
			close($fh);
			my $cmd = "$PSQL $PG_OPT -v ON_ERROR_STOP=1 -d $DBNAME -f $filename";
			&eval_command($cmd);

			# Remove empty data file
			foreach my $t (@{ $distributed_table{$p} } )
			{

				if (!$COMPRESS_LEVEL)
				{
					# extract filename part from COPY command
					if ($t =~ /\\o (.*)$/)
					{
						# When size is 21 bytes, it is considered as empty
						if ((stat("$1"))[7] == 21) {
							unlink($1);
						}
					}
				}
				else
				{
					# extract filename part from COPY command
					if ($t =~ /gzip -$COMPRESS_LEVEL -c - > "([^\"]+)"$/)
					{
						# When size is 35 bytes, it is considered as empty
						if ((stat("$1"))[7] == 35) {
							unlink($1);
						}
					}
				}
			}
		}
		unlink($filename);
	};
}

# Wait for all child processes to localdie
while (scalar keys %RUNNING_PIDS > 1)
{
        my $kid = waitpid(-1, WNOHANG);
        if ($kid > 0)
	{
                delete $RUNNING_PIDS{$kid};
        }
	usleep(50000);
}

# Dump database post-data section
if (!$interrupt)
{
	printf "Dumping post data section at %s\n", get_current_date();
	`$PGDUMP --snapshot="$snapshot" $PG_OPT $PG_FILTER -d $DBNAME -Fc --section=post-data -f "$OUTDIR/post-data.dmp"`;
	if ($?)
	{
		unlink("$SNAPSHOT_INFO_FILE") if (-e "$SNAPSHOT_INFO_FILE");
		$dbh->disconnect();
		die "ERROR: pg_dump error for post-data section.\n";
	}
}

# Remove the snapshot information file to terminate the last child process
unlink("$SNAPSHOT_INFO_FILE");

# Then wait for all child processes to die
while (scalar keys %RUNNING_PIDS > 0)
{
        my $kid = waitpid(-1, WNOHANG);
        if ($kid > 0)
	{
                delete $RUNNING_PIDS{$kid};
        }
	usleep(50000);
}

# Disconnect from snapshot connection
$dbh->disconnect;

exit(1) if ($interrupt);

printf "Dump ended at %s\n", get_current_date();

exit 0;

#----------------------------------------------------------------------------------

####
# Show program usage
####
sub usage
{
	my $msg = shift();

	print qq{
Program used to dump a PostgreSQL database with data dumped in binary
format. The resulting dumps can be restored using pg_restorebinary.

usage: pg_dumpbinary -d dbname [options] backup_name

    backup_name   output directory where dump will be saved. Default
                  directory name is binary_bkup_YYYY-MM-DDTHH:MM:SS
		  when no output directory is provided.
options:

  -A, --attach SNAPSHOT        attach pg_dumpbinary to an existing snapshot
                               instead of creating a dedicated one.
  -C, --compress-level 0-9     speed of the gzip compression using the specified
                               digit, between 1 and 9, default to 6. Setting it
                               to 0 disable the compression.
  -d, --database DBNAME        database to dump.
  -h, --host HOSTNAME          database server host or socket directory.
  -j, --job NUM                use this many parallel jobs to dump.
  -n, --schema SCHEMA          dump the named schema(s) only.
  -N, --exclude-schema SCHEMA  do NOT dump the named schema(s).
  -p, --port PORT              database server port number, default: 5432.
  -s, --snapshot-file FILE     change the path to the snapshot information file
                               used by multiprocess. Default: /tmp/snapshot_info
  -t, --table TABLE            dump named relation.
  -T, --exclude-table TABLE    do NOT dump the named table.
  -u, --user NAME              connect as specified database user.
  -v, --version                show program version.
  -V, --verbose                display the list of tables parts of the dump.
  -w, --where                  add a filter in a WHERE clause to data export.
  --help                       show usage.
  --load-via-partition-root    dump data through partitioned table only, make
                               the COPY statements target the root of the
			       partitioning hierarchy rather than the partition.
  --with-child                 when -t or -T option are used, include or exclude
                               child and partition tables. pg_dump will be used
			       instead with options --table-and-children or
			       --exclude-table-and-children (PostgreSQL >= 16).

$msg
};
	exit 0;
}

####
# Set the list of tables and foreign tables per schema of the database.
# Set also the conditions for foreign tables.
####
sub get_table_list
{
	# Get regular tables
	my @list =  `$PGRESTORE -l "$OUTDIR/pre-data.dmp" | grep " TABLE "`;
	if ($?) {
		die "ERROR: pg_restore fail to get regular tables list.\n";
	}
	chomp(@list);

	foreach my $l (@list)
	{
		# 198; 1259 57159 TABLE public T1 gilles
		next if ($l =~ /\d+: \d+ \d+ TABLE /);
		my @inf = split(/\s/, $l);
		next if ($#inf != 6);
		push( @{ $tbl_list{$inf[4]} }, $inf[5]);
	}

	# Get any table registered in extension's configuration tables as
	# they are logically not exported in the pre-data section.
	# Sequences are exclude from this export, they will be exported later
	my @exttbl = `$PSQL $PG_OPT -d $DBNAME -AtXc "BEGIN TRANSACTION ISOLATION LEVEL REPEATABLE READ, READ ONLY; SET TRANSACTION SNAPSHOT '$snapshot'; WITH extinf AS (SELECT unnest(extconfig) as id, unnest(extcondition) cond FROM pg_extension WHERE extconfig IS NOT NULL) SELECT n.nspname||'.'||c.relname||'.'||coalesce(t.cond, '') FROM pg_catalog.pg_class AS c JOIN pg_catalog.pg_namespace AS n ON (c.relnamespace = n.oid) JOIN extinf t ON (t.id = c.oid) WHERE c.oid = t.id AND c.relkind = 'r';"`;
	if ($?) {
		die "ERROR: psql fail to start a repeatable read transaction.\n";
	}
	chomp(@exttbl);
	foreach my $t (@exttbl)
	{
		if ($t =~ /^([^\.]+)\.([^\.]+)\.(.*)$/)
		{
			# Exclude / include some schemas only?
			next if ($#INC_SCHEMA >= 0 and !grep(/^\Q$1\E$/, @INC_SCHEMA));
			next if ($#EXC_SCHEMA >= 0 and grep(/^\Q$1\E$/, @EXC_SCHEMA));
			# Exclude / include some tables only?
			next if ($#INC_TABLE >= 0 and !grep(/^\Q$2\E$/, @INC_TABLE));
			next if ($#EXC_TABLE >= 0 and grep(/^\Q$2\E$/, @EXC_TABLE));
			push( @{ $tbl_list{$1} }, $2);
			$ext_cond{$1}{$2} = $3;
		}
	}

}

# Get the list of partitions to export
sub get_partition_list
{
	my %part_list = ();

	my $pgr_opt = '';
	$pgr_opt = '-f -' if ($pgrestore_version >= 12);
	my @list =  `$PGRESTORE $pgr_opt "$OUTDIR/pre-data.dmp"`;
	if ($?) {
		die "ERROR: pg_restore fail to get partition list.\n";
	}
	chomp(@list);

	my $current_table = '';
	my $current_schema = '';
	foreach my $l (@list)
	{
		if ($l =~ /CREATE (?:UNLOGGED |TEMPORARY |FOREIGN )?TABLE ["]*([^"\.]+)["]*\.["]*([^"\s]+)["]* \(/)
		{
			$current_schema = $1;
			$current_table = $2;
		}
		# ALTER TABLE ONLY schema.table ATTACH PARTITION schema.partition
		elsif ($l =~ /ALTER TABLE ONLY ["]*([^"\.]+)["]*\.["]*([^"\s]+)["]* ATTACH PARTITION ["]*([^"\.]+)["]*\.["]*([^"\s]+)["]* /)
		{
			# register partition tables
			push(@{$part_list{$1}{$2}}, $3 . '.' . $4);
			$all_partition_names{$3}{$4} = "$1.$2" if ($PARTITION_ROOT);
		}
		elsif ($l =~ /PARTITION BY .*/)
		{
			# register partitioned tables
			@{$part_list{$current_schema}{$current_table}} = ();
		}

		# reset current schema+tablename
		if ($l =~ /;/)
		{
			$current_schema = '';
			$current_table = '';
		}
	}

	return %part_list
}

####
# Return the date in ISO 8601 format minus the timezone part.
# As an example of returned value: 2019-09-03T09:03:12
####
sub get_current_date
{
    return strftime("%FT%T", localtime);
}

####
# Set schema/table option to use with pg_dump
####
sub set_filter_option
{

	if ($#INC_SCHEMA >= 0)
	{
		foreach my $s (@INC_SCHEMA)
		{
			$PG_FILTER .= " -n '$s'";
		}
	}

	if ($#EXC_SCHEMA >= 0)
	{
		foreach my $s (@EXC_SCHEMA)
		{
			$PG_FILTER .= " -N '$s'";
		}
	}

	if ($#INC_TABLE >= 0)
	{
		foreach my $s (@INC_TABLE)
		{
			if ($WITH_CHILD) {
				$PG_FILTER .= " --table-and-children '$s'";
			} else {
				$PG_FILTER .= " -t '$s'";
			}
		}
	}

	if ($#EXC_TABLE >= 0)
	{
		foreach my $s (@EXC_TABLE)
		{
			if ($WITH_CHILD) {
				$PG_FILTER .= " --exclude-table-and-children '$s'";
			} else {
				$PG_FILTER .= " -T '$s'";
			}
		}
	}
}

sub gen_sequences_statements
{
	my %seq = ();

	# Generate the SQL statements to retrieves last values for all sequences
	my ($fh, $fname) = tempfile('pg_dumpbinXXXX', SUFFIX => '.tmp', DIR => $TMP_DIR, UNLINK => 1 );
	print $fh "BEGIN TRANSACTION ISOLATION LEVEL REPEATABLE READ, READ ONLY;\nSET TRANSACTION SNAPSHOT '$snapshot';";
	my @seq_list =  `$PGRESTORE -l "$OUTDIR/pre-data.dmp" | grep " SEQUENCE " | grep -vE " OWNED BY | ACL .* SEQUENCE "`;
	chomp(@seq_list);
	foreach my $l (@seq_list)
	{
		# 391; 1259 1279956 SEQUENCE schname seq_name owner
		my @inf = split(/\s/, $l);
		# Try to fix sequence name with space.
		# Space in schema are not handled.
		pop(@inf);
		$inf[5] = join(' ', @inf[5..$#inf]);
		# Quote identifiers
		$inf[4] = '"' . $inf[4] . '"' if ($inf[4] =~ /[^a-z0-9_]/);
		$inf[5] = '"' . $inf[5] . '"' if ($inf[5] =~ /[^a-z0-9_]/);
		print $fh "SELECT '$inf[4].$inf[5].'||last_value FROM $inf[4].$inf[5];\n";
	}

	# Get any sequences registered as an extension's configuration tables as
	# they are logically not exported in the pre-data section.
	my @extseq = `$PSQL $PG_OPT -d $DBNAME -AtXc "BEGIN TRANSACTION ISOLATION LEVEL REPEATABLE READ, READ ONLY; SET TRANSACTION SNAPSHOT '$snapshot'; WITH extinf AS (SELECT unnest(extconfig) as id, unnest(extcondition) cond FROM pg_extension WHERE extconfig IS NOT NULL) SELECT n.nspname||'.'||c.relname||'.'||coalesce(t.cond, '') FROM pg_catalog.pg_class AS c JOIN pg_catalog.pg_namespace AS n ON (c.relnamespace = n.oid) JOIN extinf t ON (t.id = c.oid) WHERE c.oid = t.id AND c.relkind = 'S';"`;
	if ($?) {
		die "ERROR: psql fail to start a repeatable read transaction.\n";
	}
	chomp(@extseq);
	foreach my $t (@extseq)
	{
		if ($t =~ /^([^\.]+)\.([^\.]+)\.(.*)$/)
		{
			# Exclude / include some schemas only?
			next if ($#INC_SCHEMA >= 0 and !grep(/^\Q$1\E$/, @INC_SCHEMA));
			next if ($#EXC_SCHEMA >= 0 and grep(/^\Q$1\E$/, @EXC_SCHEMA));
			# Exclude / include some tables only?
			next if ($#INC_TABLE >= 0 and !grep(/^\Q$2\E$/, @INC_TABLE));
			next if ($#EXC_TABLE >= 0 and grep(/^\Q$2\E$/, @EXC_TABLE));
			my $n = $1;
			my $s = $2;
			$n = '"' . $n . '"' if ($n =~ /[^a-z0-9_]/);
			$s = '"' . $s . '"' if ($s =~ /[^a-z0-9_]/);
			print $fh "SELECT '$n.$s.'||last_value FROM $n.$s;\n";
		}
	}
	close($fh);

	my @res = `$PSQL $PG_OPT -v ON_ERROR_STOP=1 -d $DBNAME -At -f $fname`;
	if ($?) {
		die "ERROR: psql fail to get sequences last values.\n";
	}
	chomp(@res);
	foreach my $l (@res)
	{
		# Line format: schema.sequence_name.value
		if ($l =~ s/^([^\.]+)\.([^\.]+)\.(\d*)$/$1\.$2/)
		{
			my $schema = $1;
			my $table = $2;
			my $value = $3;
			$schema =~ s/"//g;
			$table =~ s/"//g;
			if ($value ne '')
			{
				$seq{$schema}{$table}{value} = $value;
				$seq{$schema}{$table}{fqdn}  = $l;
			}
		}
	}

	if (scalar keys %seq)
	{
		open(my $ofh, '>', "$OUTDIR/data-sequences.lst") or die "FATAL: can not write to file $OUTDIR/data-sequences.lst, $!\n";
		foreach my $s (keys %seq)
		{
			foreach my $t (sort keys %{ $seq{$s} })
			{
				print $ofh "$seq{$s}{$t}{fqdn}.$seq{$s}{$t}{value}\n";
			}
		}
		close($ofh);
	}
}

####
# Execute a system command and check its code result.
# Exit with the code returned in case of error.
# With success it returns the command output.
####
sub eval_command
{
	my $cmd = shift;

	my @result = `$cmd`;

	my $exit_val = $? >> 8;
	if ($exit_val)
	{
		print STDERR "ERROR running command: $cmd\n";
		kill USR1 => $parent_pid; 
		exit 1;
	}

	return wantarray ? @result : $result[0];
}


