home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Debconf / DbDriver / Directory.pm < prev    next >
Encoding:
Perl POD Document  |  2006-07-24  |  3.5 KB  |  149 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::DbDriver::Directory;
  6. use strict;
  7. use Debconf::Log qw(:all);
  8. use IO::File;
  9. use Fcntl qw(:DEFAULT :flock);
  10. use Debconf::Iterator;
  11. use base 'Debconf::DbDriver::Cache';
  12.  
  13.  
  14. use fields qw(directory extension lock format);
  15.  
  16.  
  17. sub init {
  18.     my $this=shift;
  19.  
  20.     $this->{extension} = "" unless exists $this->{extension};
  21.     $this->{format} = "822" unless exists $this->{format};
  22.     $this->{backup} = 1 unless exists $this->{backup};
  23.     
  24.     $this->error("No format specified") unless $this->{format};
  25.     eval "use Debconf::Format::$this->{format}";
  26.     if ($@) {
  27.         $this->error("Error setting up format object $this->{format}: $@");
  28.     }
  29.     $this->{format}="Debconf::Format::$this->{format}"->new;
  30.     if (not ref $this->{format}) {
  31.         $this->error("Unable to make format object");
  32.     }
  33.  
  34.     $this->error("No directory specified") unless $this->{directory};
  35.     if (not -d $this->{directory} and not $this->{readonly}) {
  36.         mkdir $this->{directory} ||
  37.             $this->error("mkdir $this->{directory}:$!");
  38.     }
  39.     if (not -d $this->{directory}) {
  40.         $this->error($this->{directory}." does not exist");
  41.     }
  42.     debug "db $this->{name}" => "started; directory is $this->{directory}";
  43.     
  44.     if (! $this->{readonly}) {
  45.         open ($this->{lock}, ">".$this->{directory}."/.lock") or
  46.             $this->error("could not lock $this->{directory}: $!");
  47.         flock($this->{lock}, LOCK_EX | LOCK_NB) or
  48.             $this->error("$this->{directory} is locked by another process");
  49.     }
  50. }
  51.  
  52.  
  53. sub load {
  54.     my $this=shift;
  55.     my $item=shift;
  56.  
  57.     debug "db $this->{name}" => "loading $item";
  58.     my $file=$this->{directory}.'/'.$this->filename($item);
  59.     return unless -e $file;
  60.  
  61.     my $fh=IO::File->new;
  62.     open($fh, $file) or $this->error("$file: $!");
  63.     $this->cacheadd($this->{format}->read($fh));
  64.     close $fh;
  65. }
  66.  
  67.  
  68. sub save {
  69.     my $this=shift;
  70.     my $item=shift;
  71.     my $data=shift;
  72.     
  73.     return unless $this->accept($item);
  74.     return if $this->{readonly};
  75.     debug "db $this->{name}" => "saving $item";
  76.     
  77.     my $file=$this->{directory}.'/'.$this->filename($item);
  78.  
  79.     my $fh=IO::File->new;
  80.     if ($this->ispassword($item)) {
  81.         sysopen($fh, $file."-new", O_WRONLY|O_TRUNC|O_CREAT, 0600)
  82.             or $this->error("$file-new: $!");
  83.     }
  84.     else {
  85.         open($fh, ">$file-new") or $this->error("$file-new: $!");
  86.     }
  87.     $this->{format}->beginfile;
  88.     $this->{format}->write($fh, $data, $item)
  89.         or $this->error("could not write $file-new: $!");
  90.     $this->{format}->endfile;
  91.     
  92.     $fh->flush or $this->error("could not flush $file-new: $!");
  93.     $fh->sync or $this->error("could not sync $file-new: $!");
  94.     close $fh or $this->error("could not close $file-new: $!");
  95.     
  96.     if (-e $file && $this->{backup}) {
  97.         rename($file, $file."-old") or
  98.             debug "db $this->{name}" => "rename failed: $!";
  99.     }
  100.     rename("$file-new", $file) or $this->error("rename failed: $!");
  101. }
  102.  
  103.  
  104. sub shutdown {
  105.     my $this=shift;
  106.     
  107.     $this->SUPER::shutdown(@_);
  108.     delete $this->{lock};
  109.     return 1;
  110. }
  111.  
  112.  
  113. sub exists {
  114.     my $this=shift;
  115.     my $name=shift;
  116.     
  117.     my $incache=$this->SUPER::exists($name);
  118.     return $incache if (!defined $incache or $incache);
  119.  
  120.     return -e $this->{directory}.'/'.$this->filename($name);
  121. }
  122.  
  123.  
  124. sub remove {
  125.     my $this=shift;
  126.     my $name=shift;
  127.  
  128.     return if $this->{readonly} or not $this->accept($name);
  129.     debug "db $this->{name}" => "removing $name";
  130.     my $file=$this->{directory}.'/'.$this->filename($name);
  131.     unlink $file or return undef;
  132.     if (-e $file."-old") {
  133.         unlink $file."-old" or return undef;
  134.     }
  135.     return 1;
  136. }
  137.  
  138.  
  139. sub accept {
  140.     my $this=shift;
  141.     my $name=shift;
  142.  
  143.     return if $name=~m#\.\./# or $name=~m#/\.\.#;
  144.     $this->SUPER::accept($name, @_);
  145. }
  146.  
  147.  
  148. 1
  149.