<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl
# This file was preprocessed, do not edit!


package Debconf::DbDriver::PackageDir;
use warnings;
use strict;
use Debconf::Log qw(:all);
use IO::File;
use Fcntl qw(:DEFAULT :flock);
use Debconf::Iterator;
use base 'Debconf::DbDriver::Directory';


use fields qw(mode _loaded);


sub init {
	my $this=shift;

	if (exists $this-&gt;{mode}) {
		$this-&gt;{mode} = oct($this-&gt;{mode});
	}
	else {
		$this-&gt;{mode} = 0600;
	}
	$this-&gt;SUPER::init(@_);
}


sub loadfile {
	my $this=shift;
	my $file=$this-&gt;{directory}."/".shift;

	return if $this-&gt;{_loaded}-&gt;{$file};
	$this-&gt;{_loaded}-&gt;{$file}=1;

	debug "db $this-&gt;{name}" =&gt; "loading $file";
	return unless -e $file;

	my $fh=IO::File-&gt;new;
	open($fh, "&lt;", $file) or $this-&gt;error("$file: $!");
	my @item = $this-&gt;{format}-&gt;read($fh);
	while (@item) {
		$this-&gt;cacheadd(@item);
		@item = $this-&gt;{format}-&gt;read($fh);
	}
	close $fh;
}


sub load {
	my $this=shift;
	my $item=shift;
	$this-&gt;loadfile($this-&gt;filename($item));
}


sub filename {
	my $this=shift;
	my $item=shift;

	if ($item =~ m!^([^/]+)(?:/|$)!) {
		return $1.$this-&gt;{extension};
	}
	else {
		$this-&gt;error("failed parsing item name \"$item\"\n");
	}
}


sub iterator {
	my $this=shift;

	my $handle;
	opendir($handle, $this-&gt;{directory}) ||
		$this-&gt;error("opendir: $!");

	while (my $file=readdir($handle)) {
		next if length $this-&gt;{extension} and
		        not $file=~m/$this-&gt;{extension}/;
		next unless -f $this-&gt;{directory}."/".$file;
		next if $file eq '.lock' || $file =~ /-old$/;
		$this-&gt;loadfile($file);
	}

	$this-&gt;SUPER::iterator;
}


sub exists {
	my $this=shift;
	my $name=shift;
	my $incache=$this-&gt;Debconf::DbDriver::Cache::exists($name);
	return $incache if not defined $incache or $incache;
	my $file=$this-&gt;{directory}.'/'.$this-&gt;filename($name);
	return unless -e $file;

	$this-&gt;load($name);

	return $this-&gt;Debconf::DbDriver::Cache::exists($name);
}


sub shutdown {
	my $this=shift;

	return if $this-&gt;{readonly};

	my (%files, %filecontents, %killfiles, %dirtyfiles);
	foreach my $item (keys %{$this-&gt;{cache}}) {
		my $file=$this-&gt;filename($item);
		$files{$file}++;

		if (! defined $this-&gt;{cache}-&gt;{$item}) {
			$killfiles{$file}++;
			delete $this-&gt;{cache}-&gt;{$item};
		}
		else {
			push @{$filecontents{$file}}, $item;
		}

		if ($this-&gt;{dirty}-&gt;{$item}) {
			$dirtyfiles{$file}++;
			$this-&gt;{dirty}-&gt;{$item}=0;
		}
	}

	foreach my $file (keys %files) {
		if (! $filecontents{$file} &amp;&amp; $killfiles{$file}) {
			debug "db $this-&gt;{name}" =&gt; "removing $file";
			my $filename=$this-&gt;{directory}."/".$file;
			unlink $filename or
				$this-&gt;error("unable to remove $filename: $!");
			if (-e $filename."-old") {
				unlink $filename."-old" or
					$this-&gt;error("unable to remove $filename-old: $!");
			}
		}
		elsif ($dirtyfiles{$file}) {
			debug "db $this-&gt;{name}" =&gt; "saving $file";
			my $filename=$this-&gt;{directory}."/".$file;

			sysopen(my $fh, $filename."-new",
			                O_WRONLY|O_TRUNC|O_CREAT,$this-&gt;{mode}) or
				$this-&gt;error("could not write $filename-new: $!");
			$this-&gt;{format}-&gt;beginfile;
			foreach my $item (@{$filecontents{$file}}) {
				$this-&gt;{format}-&gt;write($fh, $this-&gt;{cache}-&gt;{$item}, $item)
					or $this-&gt;error("could not write $filename-new: $!");
			}
			$this-&gt;{format}-&gt;endfile;

			$fh-&gt;flush or $this-&gt;error("could not flush $filename-new: $!");
			$fh-&gt;sync or $this-&gt;error("could not sync $filename-new: $!");

			if (-e $filename &amp;&amp; $this-&gt;{backup}) {
				rename($filename, $filename."-old") or
					debug "db $this-&gt;{name}" =&gt; "rename failed: $!";
			}
			rename($filename."-new", $filename) or
				$this-&gt;error("rename failed: $!");
		}
	}

	$this-&gt;SUPER::shutdown(@_);
	return 1;
}


1
</pre></body></html>