home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Debconf / DbDriver / DirTree.pm < prev    next >
Encoding:
Perl POD Document  |  2006-07-24  |  2.0 KB  |  106 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::DbDriver::DirTree;
  6. use strict;
  7. use Debconf::Log qw(:all);
  8. use base 'Debconf::DbDriver::Directory';
  9.  
  10. use fields "perl_hates_dirtree";
  11.  
  12.  
  13. sub init {
  14.     my $this=shift;
  15.     if (! defined $this->{extension} or ! length $this->{extension}) {
  16.         $this->{extension}=".dat";
  17.     }
  18.     $this->SUPER::init(@_);
  19. }
  20.  
  21.  
  22. sub save {
  23.     my $this=shift;
  24.     my $item=shift;
  25.  
  26.     return unless $this->accept($item);
  27.     return if $this->{readonly};
  28.     
  29.     my @dirs=split(m:/:, $this->filename($item));
  30.     pop @dirs; # the base filename
  31.     my $base=$this->{directory};
  32.     foreach (@dirs) {
  33.         $base.="/$_";
  34.         next if -d $base;
  35.         mkdir $base or $this->error("mkdir $base: $!");
  36.     }
  37.     
  38.     $this->SUPER::save($item, @_);
  39. }
  40.  
  41.  
  42. sub filename {
  43.     my $this=shift;
  44.     my $item=shift;
  45.     $item =~ s/\.\.//g;
  46.     return $item.$this->{extension};
  47. }
  48.  
  49.  
  50. sub iterator {
  51.     my $this=shift;
  52.     
  53.     my @stack=();
  54.     my $currentdir="";
  55.     my $handle;
  56.     opendir($handle, $this->{directory}) or
  57.         $this->error("opendir: $this->{directory}: $!");
  58.         
  59.     my $iterator=Debconf::Iterator->new(callback => sub {
  60.         my $i;
  61.         while ($handle or @stack) {
  62.             while (@stack and not $handle) {
  63.                 $currentdir=pop @stack;
  64.                 opendir($handle, "$this->{directory}/$currentdir") or
  65.                     $this->error("opendir: $this->{directory}/$currentdir: $!");
  66.             }
  67.             $i=readdir($handle);
  68.             if (not defined $i) {
  69.             closedir $handle;
  70.                 $handle=undef;
  71.                 next;
  72.             }
  73.             next if $i eq '.lock' || $i =~ /-old$/;
  74.             if (-d "$this->{directory}/$currentdir$i") {
  75.                 if ($i ne '..' and $i ne '.') {
  76.                     push @stack, "$currentdir$i/";
  77.                 }
  78.                 next;
  79.             }
  80.             next unless $i=~s/$this->{extension}$//;
  81.             return $currentdir.$i;
  82.         }
  83.         return undef;
  84.     });
  85.  
  86.     $this->SUPER::iterator($iterator);
  87. }
  88.  
  89.  
  90. sub remove {
  91.     my $this=shift;
  92.     my $item=shift;
  93.  
  94.     my $ret=$this->SUPER::remove($item);
  95.     return $ret unless $ret;
  96.  
  97.     my $dir=$this->filename($item);
  98.     while ($dir=~s:(.*)/[^/]*:$1: and length $dir) {
  99.         rmdir "$this->{directory}/$dir" or last; # not empty, I presume
  100.     }
  101.     return $ret;
  102. }
  103.  
  104.  
  105. 1
  106.