^^&&^^

Edit File: debconf-copydb

#!/usr/bin/perl
# This file was preprocessed, do not edit!

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

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

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

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;
}

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;

my $copier=Debconf::DbDriver::Backup->new(
	db => $src, backupdb => $dest, name => 'copier');

my $i=$copier->iterator;
while (my $item=$i->iterate) {
	next unless $item =~ /$pattern/;

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

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

$copier->shutdown;