FM / Debconf

/usr/share/perl5/Debconf

Name	Size	Mode	Actions
Client/	-	0755	rm
DbDriver/	-	0755	rm
Element/	-	0755	rm
Format/	-	0755	rm
FrontEnd/	-	0755	rm
Template/	-	0755	rm
AutoSelect.pm	1948	0644	edit dl rm
Base.pm	499	0644	edit dl rm
Config.pm	7153	0644	edit dl rm
ConfModule.pm	15639	0644	edit dl rm
Db.pm	1202	0644	edit dl rm
DbDriver.pm	2364	0644	edit dl rm
Element.pm	196	0644	edit dl rm
Encoding.pm	1487	0644	edit dl rm
Format.pm	133	0644	edit dl rm
FrontEnd.pm	2864	0644	edit dl rm
Gettext.pm	301	0644	edit dl rm
Iterator.pm	198	0644	edit dl rm
Log.pm	914	0644	edit dl rm
Path.pm	291	0644	edit dl rm
Priority.pm	642	0644	edit dl rm
Question.pm	5867	0644	edit dl rm
Template.pm	8201	0644	edit dl rm
TmpFile.pm	374	0644	edit dl rm

Edit: /usr/share/perl5/Debconf/DbDriver.pm (2364B)

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

package Debconf::DbDriver;
use Debconf::Log qw{:all};
use strict;
use base 1.01; # ensure that they don't have a broken perl installation

use fields qw(name readonly required backup failed
              accept_type reject_type accept_name reject_name root);

our %drivers;

sub new {
	my Debconf::DbDriver $this=shift;
	unless (ref $this) {
		$this = fields::new($this);
	}
	$this->{required}=1;
	$this->{readonly}=0;
	$this->{failed}=0;
	my %params=@_;
	foreach my $field (keys %params) {
		if ($field eq 'readonly' || $field eq 'required' || $field eq 'backup') {
			$this->{$field}=1,next if lc($params{$field}) eq "true";
			$this->{$field}=0,next if lc($params{$field}) eq "false";
		}
		elsif ($field=~/^(accept|reject)_/) {
			$this->{$field}=qr/$params{$field}/i;
		}
		$this->{$field}=$params{$field};
	}
	unless (exists $this->{name}) {
		$this->{name}="(unknown)";
		$this->error("no name specified");
	}
	$drivers{$this->{name}} = $this;
	$this->init;
	return $this;
}

sub init {}

sub error {
	my $this=shift;

if ($this->{required}) {
		warn('DbDriver "'.$this->{name}.'":', @_);
		exit 1;
	}
	else {
		warn('DbDriver "'.$this->{name}.'" warning:', @_);
	}
}

sub driver {
	my $this=shift;
	my $name=shift;
	
	return $drivers{$name};
}

sub accept {
	my $this=shift;
	my $name=shift;
	my $type=shift;
	
	return if $this->{failed};
	
	if ((exists $this->{accept_name} && $name !~ /$this->{accept_name}/) ||
	    (exists $this->{reject_name} && $name =~ /$this->{reject_name}/)) {
		debug "db $this->{name}" => "reject $name";
		return;
	}

if (exists $this->{accept_type} || exists $this->{reject_type}) {
		if (! defined $type || ! length $type) {
			my $template = Debconf::Template->get($this->getfield($name, 'template'));
			return 1 unless $template; # no type to act on
			$type=$template->type || '';
		}
		return if exists $this->{accept_type} && $type !~ /$this->{accept_type}/;
		return if exists $this->{reject_type} && $type =~ /$this->{reject_type}/;
	}

return 1;
}

sub ispassword {
	my $this=shift;
	my $item=shift;

my $template=$this->getfield($item, 'template');
	return unless defined $template;
	$template=Debconf::Template->get($template);
	return unless $template;
	my $type=$template->type || '';
	return 1 if $type eq 'password';
	return 0;
}

cmd: