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/DirTree.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/DirTree.pm')
| -rw-r--r-- | beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/DirTree.pm | 103 |
1 files changed, 103 insertions, 0 deletions
diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/DirTree.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/DirTree.pm new file mode 100644 index 0000000..8447e20 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/DirTree.pm @@ -0,0 +1,103 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::DbDriver::DirTree; +use strict; +use Debconf::Log qw(:all); +use base 'Debconf::DbDriver::Directory'; + + +sub init { + my $this=shift; + if (! defined $this->{extension} or ! length $this->{extension}) { + $this->{extension}=".dat"; + } + $this->SUPER::init(@_); +} + + +sub save { + my $this=shift; + my $item=shift; + + return unless $this->accept($item); + return if $this->{readonly}; + + my @dirs=split(m:/:, $this->filename($item)); + pop @dirs; # the base filename + my $base=$this->{directory}; + foreach (@dirs) { + $base.="/$_"; + next if -d $base; + mkdir $base or $this->error("mkdir $base: $!"); + } + + $this->SUPER::save($item, @_); +} + + +sub filename { + my $this=shift; + my $item=shift; + $item =~ s/\.\.//g; + return $item.$this->{extension}; +} + + +sub iterator { + my $this=shift; + + my @stack=(); + my $currentdir=""; + my $handle; + opendir($handle, $this->{directory}) or + $this->error("opendir: $this->{directory}: $!"); + + my $iterator=Debconf::Iterator->new(callback => sub { + my $i; + while ($handle or @stack) { + while (@stack and not $handle) { + $currentdir=pop @stack; + opendir($handle, "$this->{directory}/$currentdir") or + $this->error("opendir: $this->{directory}/$currentdir: $!"); + } + $i=readdir($handle); + if (not defined $i) { + closedir $handle; + $handle=undef; + next; + } + next if $i eq '.lock' || $i =~ /-old$/; + if (-d "$this->{directory}/$currentdir$i") { + if ($i ne '..' and $i ne '.') { + push @stack, "$currentdir$i/"; + } + next; + } + next unless $i=~s/$this->{extension}$//; + return $currentdir.$i; + } + return undef; + }); + + $this->SUPER::iterator($iterator); +} + + +sub remove { + my $this=shift; + my $item=shift; + + my $ret=$this->SUPER::remove($item); + return $ret unless $ret; + + my $dir=$this->filename($item); + while ($dir=~s:(.*)/[^/]*:$1: and length $dir) { + rmdir "$this->{directory}/$dir" or last; # not empty, I presume + } + return $ret; +} + + +1 |
