diff options
Diffstat (limited to 'beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Stack.pm')
| -rw-r--r-- | beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Stack.pm | 246 |
1 files changed, 246 insertions, 0 deletions
diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Stack.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Stack.pm new file mode 100644 index 0000000..ebfe5b3 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/Stack.pm @@ -0,0 +1,246 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::DbDriver::Stack; +use strict; +use Debconf::Log qw{:all}; +use Debconf::Iterator; +use base 'Debconf::DbDriver::Copy'; + + + +use fields qw(stack stack_change_errors); + + +sub init { + my $this=shift; + + if (! ref $this->{stack}) { + my @stack; + foreach my $name (split(/\s*,\s/, $this->{stack})) { + my $driver=$this->driver($name); + unless (defined $driver) { + $this->error("could not find a db named \"$name\" to use in the stack (it should be defined before the stack in the config file)"); + next; + } + push @stack, $driver; + } + $this->{stack}=[@stack]; + } + + $this->error("no stack set") if ! ref $this->{stack}; + $this->error("stack is empty") if ! @{$this->{stack}}; +} + + +sub iterator { + my $this=shift; + + my %seen; + my @iterators = map { $_->iterator } @{$this->{stack}}; + my $i = pop @iterators; + my $iterator=Debconf::Iterator->new(callback => sub { + for (;;) { + while (my $ret = $i->iterate) { + next if $seen{$ret}; + $seen{$ret}=1; + return $ret; + } + $i = pop @iterators; + return undef unless defined $i; + } + }); +} + + +sub shutdown { + my $this=shift; + + my $ret=1; + foreach my $driver (@{$this->{stack}}) { + $ret=undef if not defined $driver->shutdown(@_); + } + + if ($this->{stack_change_errors}) { + $this->error("unable to save changes to: ". + join(" ", @{$this->{stack_change_errors}})); + $ret=undef; + } + + return $ret; +} + + +sub exists { + my $this=shift; + + foreach my $driver (@{$this->{stack}}) { + return 1 if $driver->exists(@_); + } + return 0; +} + +sub _query { + my $this=shift; + my $command=shift; + shift; # this again + + debug "db $this->{name}" => "trying to $command(@_) .."; + foreach my $driver (@{$this->{stack}}) { + if (wantarray) { + my @ret=$driver->$command(@_); + debug "db $this->{name}" => "$command done by $driver->{name}" if @ret; + return @ret if @ret; + } + else { + my $ret=$driver->$command(@_); + debug "db $this->{name}" => "$command done by $driver->{name}" if defined $ret; + return $ret if defined $ret; + } + } + return; # failure +} + +sub _change { + my $this=shift; + my $command=shift; + shift; # this again + my $item=shift; + + debug "db $this->{name}" => "trying to $command($item @_) .."; + + foreach my $driver (@{$this->{stack}}) { + if ($driver->exists($item)) { + last if $driver->{readonly}; # nope, hit a readonly one + debug "db $this->{name}" => "passing to $driver->{name} .."; + return $driver->$command($item, @_); + } + } + + my $src=0; + + foreach my $driver (@{$this->{stack}}) { + if ($driver->exists($item)) { + my $ret=$this->_nochange($driver, $command, $item, @_); + if (defined $ret) { + debug "db $this->{name}" => "skipped $command($item) as it would have no effect"; + return $ret; + } + + $src=$driver; + last + } + } + + my $writer; + foreach my $driver (@{$this->{stack}}) { + if ($driver == $src) { + push @{$this->{stack_change_errors}}, $item; + return; + } + if (! $driver->{readonly}) { + if ($command eq 'addowner') { + if ($driver->accept($item, $_[1])) { + $writer=$driver; + last; + } + } + elsif ($driver->accept($item)) { + $writer=$driver; + last; + } + } + } + + unless ($writer) { + debug "db $this->{name}" => "FAILED $command"; + return; + } + + if ($src) { + $this->copy($item, $src, $writer); + } + + debug "db $this->{name}" => "passing to $writer->{name} .."; + return $writer->$command($item, @_); +} + +sub _nochange { + my $this=shift; + my $driver=shift; + my $command=shift; + my $item=shift; + + if ($command eq 'addowner') { + my $value=shift; + foreach my $owner ($driver->owners($item)) { + return $value if $owner eq $value; + } + return; + } + elsif ($command eq 'removeowner') { + my $value=shift; + + foreach my $owner ($driver->owners($item)) { + return if $owner eq $value; + } + return $value; # no change + } + elsif ($command eq 'removefield') { + my $value=shift; + + foreach my $field ($driver->fields($item)) { + return if $field eq $value; + } + return $value; # no change + } + + my @list; + my $get; + if ($command eq 'setfield') { + @list=$driver->fields($item); + $get='getfield'; + } + elsif ($command eq 'setflag') { + @list=$driver->flags($item); + $get='getflag'; + } + elsif ($command eq 'setvariable') { + @list=$driver->variables($item); + $get='getvariable'; + } + else { + $this->error("internal error; bad command: $command"); + } + + my $thing=shift; + my $value=shift; + my $currentvalue=$driver->$get($item, $thing); + + my $exists=0; + foreach my $i (@list) { + $exists=1, last if $thing eq $i; + } + return $currentvalue unless $exists; + + return $currentvalue if $currentvalue eq $value; + return undef; +} + +sub addowner { $_[0]->_change('addowner', @_) } +sub removeowner { $_[0]->_change('removeowner', @_) } +sub owners { $_[0]->_query('owners', @_) } +sub getfield { $_[0]->_query('getfield', @_) } +sub setfield { $_[0]->_change('setfield', @_) } +sub removefield { $_[0]->_change('removefield', @_) } +sub fields { $_[0]->_query('fields', @_) } +sub getflag { $_[0]->_query('getflag', @_) } +sub setflag { $_[0]->_change('setflag', @_) } +sub flags { $_[0]->_query('flags', @_) } +sub getvariable { $_[0]->_query('getvariable', @_) } +sub setvariable { $_[0]->_change('setvariable', @_) } +sub variables { $_[0]->_query('variables', @_) } + + +1 |