diff options
| author | Manuel Traut <manut@mecka.net> | 2011-04-29 09:09:27 +0200 |
|---|---|---|
| committer | Manuel Traut <manut@mecka.net> | 2011-04-29 09:09:27 +0200 |
| commit | 5238ad5a0c4a9e1c8cd036f5de4055e39bd71297 (patch) | |
| tree | 4407c087b9fb5432b1dc11e70b52dacfa0b99feb /beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver.pm | |
| parent | 60ead65c41afba7e6aa4bbcf507a1d52f7a8fe9f (diff) | |
added debootstrap stuff
Signed-off-by: Manuel Traut <manut@mecka.net>
Diffstat (limited to 'beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver.pm')
| -rw-r--r-- | beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver.pm | 112 |
1 files changed, 112 insertions, 0 deletions
diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver.pm new file mode 100644 index 0000000..bd5edac --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver.pm @@ -0,0 +1,112 @@ +#!/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); + +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; +} + + +1 |
