



package Debian::DebConf::ConfigDb;
use Debian::DebConf::Template;
use Debian::DebConf::Question;
use strict;
use vars qw(%templates %questions);


sub getquestion {
	return $questions{(shift)};
}


sub gettree {
	my $root=shift;

	my @ret=();
	foreach my $name (keys %questions) {
		if ($name=~m:^\Q$root/\E:) {
			push @ret, $questions{$name};
		}
	}
	
	return @ret;
}


sub isunder {
	my $root=shift;
	my $name=shift->name;
	
	return $name=~m:^\Q$root/\E:;
}


sub loadtemplatefile {
	my $fn=shift;
	my $owner=shift;
	
	my $collect;
	open (TEMPLATE_IN, $fn) || die "$fn: $!";
	while (<TEMPLATE_IN>) {
		if ($_ ne "\n") {
			$collect.=$_;
		}
		if ($_ eq "\n" || eof TEMPLATE_IN) {
			loadtemplatedata($collect, $owner);
			$collect='';
		}
	}
	close TEMPLATE_IN;      
	return 1;
}


sub loadtemplatedata {
	my $data=shift;
	my $owner=shift;

	my $template=Debian::DebConf::Template->new();
	$template->parse($data);

	if ($templates{$template->template}) {
		$template->merge($templates{$template->template});
	}
	else {
		$templates{$template->template}=$template;
	}

	addquestion($template->template, $template->template,
		    $owner);
}


sub addquestion {
	my $template=shift;
	my $name=shift;
	my $owner=shift;

	my $question=$questions{$name} || Debian::DebConf::Question->new;

	$question->name($name);
	$question->template($templates{$template});
	$question->addowner($owner);
	$questions{$name}=$question;
}


sub disownquestion {
	my $name=shift;
	my $owner=shift;
	
	return unless $questions{$name};
	
	$questions{$name}->removeowner($owner);
	if ($questions{$name}->owners eq '') {
		my $template=$questions{$name}->template;
		my $users=0;
		foreach my $question (keys %questions) {
			$users++ if $questions{$question}->template eq $template;
		}
		delete $questions{$name};

		if ($users == 1) {
			delete $templates{$template->template};
		}
	}
}


sub disownall {
	my $owner=shift;
	
	foreach my $question (keys %questions) {
		disownquestion($question, $owner);
	}
}


use Data::Dumper;
sub savedb {
	my $dir=shift;

	my $dumper=Data::Dumper->new([\%questions], ['*questions']);
	my %seen;
	foreach (keys %templates) {
		$seen{"\$templates{'$_'}"}=$templates{$_};
	}
	$dumper->Seen({%seen});
	$dumper->Indent(1);
	open (OUT, ">$dir/debconf.new") || die "$dir/debconf.new: $!";
	print OUT $dumper->Dump;
	print OUT "\n1;\n"; # Return a true value so require works.
	close OUT;
	
	$dumper=Data::Dumper->new([\%templates],
		[qw{*templates}]);
	$dumper->Indent(1);
	open (OUT, ">$dir/templates.new") || die "$dir/templates.new: $!";
	print OUT $dumper->Dump;
	print OUT "\n1;\n"; # Return a true value so require works.
	close OUT;
	
	system 'mv', "-f", "$dir/templates.new", "$dir/templates.db";
	system 'mv', "-f", "$dir/debconf.new", "$dir/debconf.db";
}


sub loaddb {
	my $dir=shift;

	if (-e "$dir/templates.db") {
		eval qq{require "$dir/templates.db"};
	}

	if (-e "$dir/debconf.db") {
		eval qq{require "$dir/debconf.db"};
	}
}


1
