



package Debian::DebConf::ConfModule;
use strict;
use Debian::DebConf::Base;
use IPC::Open2;
use FileHandle;
use Debian::DebConf::ConfigDb;
use Debian::DebConf::Log ':all';
use vars qw($AUTOLOAD @ISA);
@ISA=qw(Debian::DebConf::Base);

my %codes = (
	success => 0,
	badquestion => 10,
	syntaxerror => 20,
	input_invisible => 30,
	version_bad => 30,
	go_back => 30,
);


sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self  = bless $proto->SUPER::new(@_), $class;
	$self->{frontend} = shift;
	$self->{version} = "2.0";

	$ENV{DEBIAN_HAS_FRONTEND}=1;

	return $self;
}


sub startup {
	my $this=shift;
	my $confmodule=shift;

	my @args=$this->confmodule($confmodule);
	push @args, @_ if @_;
	
	debug 2, "starting ".join(' ',@args);
	$this->pid(open2($this->read_handle(FileHandle->new),
		         $this->write_handle(FileHandle->new),
			 @args)) || die $!;

	$this->caught_sigpipe('');
	$SIG{PIPE}=sub { $this->caught_sigpipe(128) };
}

sub communicate {
	my $this=shift;

	my $r=$this->{read_handle};
	$_=<$r> || return $this->_finish;
	chomp;
	debug 1, "<-- $_";
	return 1 unless defined && ! /^\s*#/; # Skip blank lines, comments.
	chomp;
	my ($command, @params)=split(' ', $_);
	my $w=$this->{write_handle};
	if (lc($command) eq "stop") {
		return $this->_finish;
	}
	$command="command_".lc($command);
	my $ret=join(' ', $this->$command(@params));
	debug 1, "--> $ret";
	print $w $ret."\n";
	return 1;
}


sub _finish {
	my $this=shift;

	waitpid $this->pid, 0;
	$this->exitcode($this->caught_sigpipe || $? >> 8);
	return '';
}


sub command_input {
	my $this=shift;
	my $priority=shift;
	my $question_name=shift;

	my $question=Debian::DebConf::ConfigDb::getquestion($question_name) ||
		return $codes{badquestion}, "$question_name doesn't exist";

	return $this->frontend->add($question, $priority) ? $codes{success} : $codes{input_invisible};
}


sub command_clear {
	my $this=shift;
	
	$this->frontend->clear;
	return $codes{success};
}


sub command_version {
	my $this=shift;
	my $version=shift;
	if (defined $version) {
		return $codes{version_bad}, "Version too low ($version)"
			if int($version) < int($this->version);
		return $codes{version_bad}, "Version too high ($version)"
			if int($version) > int($this->version);
	}
	return $codes{success}, $this->version;
}


sub command_capb {
	my $this=shift;
	$this->client_capb([@_]);
	$this->frontend->capb_backup(1) if grep { $_ eq 'backup' } @_;
	my @capb=('multiselect');
	push @capb, $this->frontend->capb;
	return $codes{success}, @capb;
}


sub command_title {
	my $this=shift;
	$this->frontend->title(join ' ', @_);

	return $codes{success};
}


sub command_beginblock {
	return $codes{success};
}
sub command_endblock {
	return $codes{success};
}


sub command_go {
	my $this=shift;
	return $codes{go_back} unless $this->frontend->go;
	return $codes{success};
}


sub command_get {
	my $this=shift;
	my $question_name=shift;
	my $question=Debian::DebConf::ConfigDb::getquestion($question_name) ||
		return $codes{badquestion}, "$question_name doesn't exist";

	if (defined $question->value) {
		return $codes{success}, $question->value;
	}
	else {
		return $codes{success}, '';
	}
}


sub command_set {
	my $this=shift;
	my $question_name=shift;
	my $value=join(" ", @_);

	my $question=Debian::DebConf::ConfigDb::getquestion($question_name) ||
		return $codes{badquestion}, "$question_name doesn't exist";
	$question->value($value);
	return $codes{success};
}


sub command_reset {
	my $this=shift;
	my $question_name=shift;

	my $question=Debian::DebConf::ConfigDb::getquestion($question_name) ||
		return $codes{badquestion}, "$question_name doesn't exist";
	$question->value($question->default);
	$question->flag_isdefault('true');
	return $codes{success};
}


sub command_subst {
	my $this = shift;
	my $question_name = shift;
	my $variable = shift;
	my $value = (join ' ', @_);
	
	my $question=Debian::DebConf::ConfigDb::getquestion($question_name) ||
		return $codes{badquestion}, "$question_name doesn't exist";
	$question->variables($variable,$value);
	return $codes{success};
}


sub command_register {
	my $this=shift;
	my $template=shift;
	my $name=shift;
	
	Debian::DebConf::ConfigDb::addquestion($template, $name, $this->owner);
	return $codes{success};
}


sub command_unregister {
	my $this=shift;
	my $name=shift;
	
	Debian::DebConf::ConfigDb::disownquestion($name, $this->owner);
	return $codes{success};
}


sub command_purge {
	my $this=shift;
	
	Debian::DebConf::ConfigDb::disownall($this->owner);
	return $codes{success};
}


sub command_metaget {
	my $this=shift;
	my $question_name=shift;
	my $field=shift;
	
	my $question=Debian::DebConf::ConfigDb::getquestion($question_name) ||
		return $codes{badquestion}, "$question_name doesn't exist";
	return $codes{success}, $question->$field();
}


sub command_fget {
	my $this=shift;
	my $question_name=shift;
	my $flag="flag_".shift;
	
	my $question=Debian::DebConf::ConfigDb::getquestion($question_name) ||
		return $codes{badquestion},  "$question_name doesn't exist";
	return $codes{success}, $question->$flag();
}


sub command_fset {
	my $this=shift;
	my $question_name=shift;
	my $flag="flag_".shift;
	my $value=(join ' ', @_);
	
	my $question=Debian::DebConf::ConfigDb::getquestion($question_name) ||
		return $codes{badquestion}, "$question_name doesn't exist";
	return $codes{success}, $question->$flag($value);
}


sub command_visible {
	my $this=shift;
	my $priority=shift;
	my $question_name=shift;
	
	my $question=Debian::DebConf::ConfigDb::getquestion($question_name) ||
		return $codes{badquestion}, "$question_name doesn't exist";
	return $codes{success}, $this->frontend->visible($question, $priority) ? "true" : "false";
}


sub command_exist {
	my $this=shift;
	my $question_name=shift;
	
	return $codes{success}, 
		Debian::DebConf::ConfigDb::getquestion($question_name) ? "true" : "false";
}

sub AUTOLOAD {
	my $this=shift;
	my $property = $AUTOLOAD;
	$property =~ s|.*:||; # strip fully-qualified portion
	if ($property=~/^command_(.*)/) {
		return $codes{syntaxerror},
		       "Unsupported command \"$1\" received from confmodule.";
	}
	else {
		$this->{$property}=shift if @_;
		return $this->{$property};
	}
}


sub DESTROY {
	my $this=shift;
	
	$this->{read_handle}->close;
	$this->{write_handle}->close;
	if ($this->{pid} > 1) {
		kill 'TERM', $this->{pid};
	}
}


1
