home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Debconf / DbDriver / PackageDir.pm < prev    next >
Encoding:
Perl POD Document  |  2006-07-24  |  3.6 KB  |  171 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::DbDriver::PackageDir;
  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::Directory';
  12.  
  13.  
  14. use fields qw(mode _loaded);
  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->SUPER::init(@_);
  27. }
  28.  
  29.  
  30. sub loadfile {
  31.     my $this=shift;
  32.     my $file=$this->{directory}."/".shift;
  33.  
  34.     return if $this->{_loaded}->{$file};
  35.     $this->{_loaded}->{$file}=1;
  36.     
  37.     debug "db $this->{name}" => "loading $file";
  38.     return unless -e $file;
  39.  
  40.     my $fh=IO::File->new;
  41.     open($fh, $file) or $this->error("$file: $!");
  42.     my @item = $this->{format}->read($fh);
  43.     while (@item) {
  44.         $this->cacheadd(@item);
  45.         @item = $this->{format}->read($fh);
  46.     }
  47.     close $fh;
  48. }
  49.  
  50.  
  51. sub load {
  52.     my $this=shift;
  53.     my $item=shift;
  54.     $this->loadfile($this->filename($item));
  55. }
  56.  
  57.  
  58. sub filename {
  59.     my $this=shift;
  60.     my $item=shift;
  61.  
  62.     if ($item =~ m!^([^/]+)(?:/|$)!) {
  63.         return $1.$this->{extension};
  64.     }
  65.     else {
  66.         $this->error("failed parsing item name \"$item\"\n");
  67.     }
  68. }
  69.  
  70.  
  71. sub iterator {
  72.     my $this=shift;
  73.     
  74.     my $handle;
  75.     opendir($handle, $this->{directory}) ||
  76.         $this->error("opendir: $!");
  77.  
  78.     while (my $file=readdir($handle)) {
  79.         next if length $this->{extension} and
  80.                 not $file=~m/$this->{extension}/;
  81.         next unless -f $this->{directory}."/".$file;
  82.         next if $file eq '.lock' || $file =~ /-old$/;
  83.         $this->loadfile($file);
  84.     }
  85.  
  86.     $this->SUPER::iterator;
  87. }
  88.  
  89.  
  90. sub exists {
  91.     my $this=shift;
  92.     my $name=shift;
  93.     my $incache=$this->Debconf::DbDriver::Cache::exists($name);
  94.     return $incache if (!defined $incache or $incache);
  95.     my $file=$this->{directory}.'/'.$this->filename($name);
  96.     return unless -e $file;
  97.  
  98.     $this->load($name);
  99.     
  100.     return $this->Debconf::DbDriver::Cache::exists($name);
  101. }
  102.  
  103.  
  104. sub shutdown {
  105.     my $this=shift;
  106.  
  107.     return if $this->{readonly};
  108.  
  109.     my (%files, %filecontents, %killfiles, %dirtyfiles);
  110.     foreach my $item (keys %{$this->{cache}}) {
  111.         my $file=$this->filename($item);
  112.         $files{$file}++;
  113.         
  114.         if (! defined $this->{cache}->{$item}) {
  115.             $killfiles{$file}++;
  116.             delete $this->{cache}->{$item};
  117.         }
  118.         else {
  119.             push @{$filecontents{$file}}, $item;
  120.         }
  121.  
  122.         if ($this->{dirty}->{$item}) {
  123.             $dirtyfiles{$file}++;
  124.             $this->{dirty}->{$item}=0;
  125.         }
  126.     }
  127.  
  128.     foreach my $file (keys %files) {
  129.         if (! $filecontents{$file} && $killfiles{$file}) {
  130.             debug "db $this->{name}" => "removing $file";
  131.             my $filename=$this->{directory}."/".$file;
  132.             unlink $filename or
  133.                 $this->error("unable to remove $filename: $!");
  134.             if (-e $filename."-old") {
  135.                 unlink $filename."-old" or
  136.                     $this->error("unable to remove $filename-old: $!");
  137.             }
  138.         }
  139.         elsif ($dirtyfiles{$file}) {
  140.             debug "db $this->{name}" => "saving $file";
  141.             my $filename=$this->{directory}."/".$file;
  142.         
  143.             sysopen(my $fh, $filename."-new",
  144.                             O_WRONLY|O_TRUNC|O_CREAT,$this->{mode}) or
  145.                 $this->error("could not write $filename-new: $!");
  146.             $this->{format}->beginfile;
  147.             foreach my $item (@{$filecontents{$file}}) {
  148.                 $this->{format}->write($fh, $this->{cache}->{$item}, $item)
  149.                     or $this->error("could not write $filename-new: $!");
  150.             }
  151.             $this->{format}->endfile;
  152.  
  153.             $fh->flush or $this->error("could not flush $filename-new: $!");
  154.             $fh->sync or $this->error("could not sync $filename-new: $!");
  155.  
  156.             if (-e $filename && $this->{backup}) {
  157.                 rename($filename, $filename."-old") or
  158.                     debug "db $this->{name}" => "rename failed: $!";
  159.             }
  160.             rename($filename."-new", $filename) or
  161.                 $this->error("rename failed: $!");
  162.         }
  163.     }
  164.     
  165.     $this->SUPER::shutdown(@_);
  166.     return 1;
  167. }
  168.  
  169.  
  170. 1
  171.