home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Debconf / DbDriver / File.pm < prev    next >
Encoding:
Perl POD Document  |  2006-07-24  |  3.0 KB  |  125 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::DbDriver::File;
  6. use strict;
  7. use Debconf::Log qw(:all);
  8. use Fcntl qw(:DEFAULT :flock);
  9. use IO::Handle;
  10. use base 'Debconf::DbDriver::Cache';
  11.  
  12.  
  13. use fields qw(filename mode format _fh);
  14.  
  15.  
  16. sub init {
  17.     my $this=shift;
  18.  
  19.     if (exists $this->{mode}) {
  20.         $this->{mode} = oct($this->{mode});
  21.     }
  22.     else {
  23.         $this->{mode} = 0600;
  24.     }
  25.     $this->{format} = "822" unless exists $this->{format};
  26.     $this->{backup} = 1 unless exists $this->{backup};
  27.  
  28.     $this->error("No format specified") unless $this->{format};
  29.     eval "use Debconf::Format::$this->{format}";
  30.     if ($@) {
  31.         $this->error("Error setting up format object $this->{format}: $@");
  32.     }
  33.     $this->{format}="Debconf::Format::$this->{format}"->new;
  34.     if (not ref $this->{format}) {
  35.         $this->error("Unable to make format object");
  36.     }
  37.  
  38.     $this->error("No filename specified") unless $this->{filename};
  39.  
  40.     debug "db $this->{name}" => "started; filename is $this->{filename}";
  41.     
  42.     if (! -e $this->{filename}) {
  43.         $this->{backup}=0;
  44.         sysopen(my $fh, $this->{filename}, 
  45.                 O_WRONLY|O_TRUNC|O_CREAT,$this->{mode}) or
  46.             $this->error("could not open $this->{filename}");
  47.         close $fh;
  48.     }
  49.  
  50.     if (! open ($this->{_fh}, $this->{filename})) {
  51.         $this->error("could not open $this->{filename}: $!");
  52.         return; # always abort, even if not throwing fatal error
  53.     }
  54.  
  55.     if (! $this->{readonly}) {
  56.         flock($this->{_fh}, LOCK_EX | LOCK_NB) or
  57.             $this->error("$this->{filename} is locked by another process");
  58.     }
  59.  
  60.     $this->SUPER::init(@_);
  61.  
  62.     debug "db $this->{name}" => "loading database";
  63.  
  64.     while (! eof $this->{_fh}) {
  65.         my ($item, $cache)=$this->{format}->read($this->{_fh});
  66.         $this->{cache}->{$item}=$cache;
  67.     }
  68.     if ($this->{readonly}) {
  69.         close $this->{_fh};
  70.     }
  71. }
  72.  
  73.  
  74. sub shutdown {
  75.     my $this=shift;
  76.  
  77.     return if $this->{readonly};
  78.  
  79.     if (grep $this->{dirty}->{$_}, keys %{$this->{cache}}) {
  80.         debug "db $this->{name}" => "saving database";
  81.     }
  82.     else {
  83.         debug "db $this->{name}" => "no database changes, not saving";
  84.  
  85.         delete $this->{_fh};
  86.  
  87.         return 1;
  88.     }
  89.  
  90.     sysopen(my $fh, $this->{filename}."-new",
  91.             O_WRONLY|O_TRUNC|O_CREAT,$this->{mode}) or
  92.         $this->error("could not write $this->{filename}-new: $!");
  93.     flock($fh, LOCK_EX | LOCK_NB) or
  94.         $this->error("$this->{filename}-new is locked by another process");
  95.     $this->{format}->beginfile;
  96.     foreach my $item (sort keys %{$this->{cache}}) {
  97.         next unless defined $this->{cache}->{$item}; # skip deleted
  98.         $this->{format}->write($fh, $this->{cache}->{$item}, $item)
  99.             or $this->error("could not write $this->{filename}-new: $!");
  100.     }
  101.     $this->{format}->endfile;
  102.  
  103.     $fh->flush or $this->error("could not flush $this->{filename}-new: $!");
  104.     $fh->sync or $this->error("could not sync $this->{filename}-new: $!");
  105.  
  106.     if (-e $this->{filename} && $this->{backup}) {
  107.         rename($this->{filename}, $this->{filename}."-old") or
  108.             debug "db $this->{name}" => "rename failed: $!";
  109.     }
  110.     rename($this->{filename}."-new", $this->{filename}) or
  111.         $this->error("rename failed: $!");
  112.  
  113.     delete $this->{_fh};
  114.  
  115.     return 1;
  116. }
  117.  
  118.  
  119. sub load {
  120.     return undef;
  121. }
  122.  
  123.  
  124. 1
  125.