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