#!/usr/bin/perl -w

=head1 NAME

debconf-copydb - copy a debconf database

=cut

use strict;
use Getopt::Long;
use Debconf::Log qw{:all};
use Debconf::Db;
use Debconf::DbDriver;
use Debconf::DbDriver::Backup;

=head1 SYNOPSIS

 debconf-copydb sourcedb destdb [--pattern=pattern] [--owner-pattern=pattern] [--config=Foo:bar]

=cut

sub usage {
	print STDERR <<EOF;
Usage: debconf-copydb sourcedb destdb [--pattern=pattern] [--owner-pattern=pattern] [--config=Foo:bar]
EOF
	exit(1);
}

=head1 DESCRIPTION

B<debconf-copydb> copies items from an existing debconf database into
another, possibly new database. The two databases may have different
formats; if so a conversion will automatically be done.

=head1 OPTIONS

=over 4

=item I<sourcedb>

The name of the source database. Typically it will be defined
in your debconf.conf (or .debconfrc) file.

=item I<destdb>

The name of the destination database. It may be defined in
debconf.conf or .debconfrc, or you might define it on the command line (see
below).

=item B<-p> I<pattern>, B<--pattern> I<pattern>

If this is specified, only items in I<sourcedb> whose names match the pattern
will be copied.

=item B<--owner-pattern> I<pattern>

If this is specified, only items in I<sourcedb> whose owners match the pattern
will be copied.

=item B<-c> I<foo:bar>, B<--config> I<Foo:bar>

Set option Foo to bar. This is similar to writing:

  Foo: bar

In debconf.conf, except you probably want to leave off the space on the
command line (or quote it: "Foo: bar"). Generally must be used multiple
times, to build up a full configuration stanza. While blank lines are used
to separate stanzas in debconf.conf, this program will assume that
"Name:dbname" denotes the beginning of a new stanza.

=back

=head1 EXAMPLES

  debconf-copydb configdb backup

Copy all of configdb to backup, assuming you already have the backup
database defined in debconf.conf.

  debconf-copydb configdb newdb --pattern='^slrn/' \
  	--config=Name:newdb --config=Driver:File \
	--config=Filename:newdb.dat

Copy slrn's data out of configdb, and into newdb. newdb is not defined in
the rc file, so the --config switches set up the database on the fly.

  debconf-copydb configdb stdout -c Name:stdout -c Driver:Pipe \
  	-c InFd:none --pattern='^foo/'

Spit out all the items in the debconf database related to package foo.

  debconf-copydb configdb pipe --config=Name:pipe \
                --config=Driver:Pipe --config=InFd:none | \
  	ssh remotehost debconf-copydb pipe configdb \
		--config=Name:pipe --config=Driver:Pipe

This uses the special purpose pipe driver to copy a database to a remote
system.

=head1 SEE ALSO

L<debconf.conf(5)>

=cut

my $pattern='.*';
my $owner_pattern;

# This hash holds config data. The sub adds a new item to the hash,
# and if it looks like a stanza just ended, tries to instantiate
# a dbdriver from the available config data first.
my %config;
sub config {
	my ($field, $value)=split(/\s*:\s*/, $_[1], 2);
	$field=~tr/-/_/;
	$field=lc($field);
	die "Parse error: \"$_[1]\"" unless defined $field and length $field;
	
	if ($field eq 'name') {
		if ($config{name}) {
			Debconf::Db->makedriver(%config);
		}
		elsif (%config) {
			warn "ignoring command line config data before $_[1]";
		}
		%config=();
	}

	$config{$field}=$value;
}

# Command line parsing.
GetOptions(
	"pattern|p=s"	=> \$pattern,
	"config|c=s"	=> \&config,
	"owner-pattern=s" => \$owner_pattern,
) || usage();
Debconf::Db->makedriver(%config) if %config;

my $srcname=shift || usage();
my $destname=shift || usage();

Debconf::Db->load;

my $src=Debconf::DbDriver->driver($srcname);
die "$0: source database, \"$srcname\" does not exist\n" unless ref $src;
my $dest=Debconf::DbDriver->driver($destname);
die "$0: destination database, \"$destname\" does not exist\n" unless ref $dest;

# Set up a copier to handle copying from one to the other.
my $copier=Debconf::DbDriver::Backup->new(
	db => $src, backupdb => $dest, name => 'copier');

# Now just iterate over all items in src that patch the pattern, and tell
# the copier to make a copy of them.
my $i=$copier->iterator;
while (my $item=$i->iterate) {
	next unless $item =~ /$pattern/;

	if (defined $owner_pattern) {
		my $fit_owner = 0;
		my $owner;
		foreach $owner ($src->owners($item)){
			$fit_owner = 1 if $owner =~ /$owner_pattern/;
		}
		next unless $fit_owner;
	}

	$copier->copy($item, $src, $dest);
}

$copier->shutdown;

=head1 AUTHOR

Joey Hess <joeyh@debian.org>

=cut

