/usr/share/perl5/Debconf/DbDriver/DirTree.pm is in debconf 1.5.42ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 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
|