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


package Debconf::DbDriver::File;
use strict;
use Debconf::Log qw(:all);
use Cwd 'abs_path';
use POSIX ();
use Fcntl qw(:DEFAULT :flock);
use IO::Handle;
use base 'Debconf::DbDriver::Cache';


use fields qw(filename mode format _fh);


sub init {
	my $this=shift;

	if (exists $this-&gt;{mode}) {
		$this-&gt;{mode} = oct($this-&gt;{mode});
	}
	else {
		$this-&gt;{mode} = 0600;
	}
	$this-&gt;{format} = "822" unless exists $this-&gt;{format};
	$this-&gt;{backup} = 1 unless exists $this-&gt;{backup};

	$this-&gt;error("No format specified") unless $this-&gt;{format};
	eval "use Debconf::Format::$this-&gt;{format}";
	if ($@) {
		$this-&gt;error("Error setting up format object $this-&gt;{format}: $@");
	}
	$this-&gt;{format}="Debconf::Format::$this-&gt;{format}"-&gt;new;
	if (not ref $this-&gt;{format}) {
		$this-&gt;error("Unable to make format object");
	}

	$this-&gt;error("No filename specified") unless $this-&gt;{filename};

	my ($directory)=$this-&gt;{filename}=~m!^(.*)/[^/]+!;
	if (! -d $directory) {
		mkdir $directory || $this-&gt;error("mkdir $directory:$!");
	}

	$this-&gt;{filename} = abs_path($this-&gt;{filename});

	debug "db $this-&gt;{name}" =&gt; "started; filename is $this-&gt;{filename}";
	
	if (! -e $this-&gt;{filename}) {
		$this-&gt;{backup}=0;
		sysopen(my $fh, $this-&gt;{filename}, 
				O_WRONLY|O_TRUNC|O_CREAT,$this-&gt;{mode}) or
			$this-&gt;error("could not open $this-&gt;{filename}");
		close $fh;
	}

	my $implicit_readonly=0;
	if (! $this-&gt;{readonly}) {
		if (open ($this-&gt;{_fh}, "+&lt;", $this-&gt;{filename})) {
			while (! flock($this-&gt;{_fh}, LOCK_EX | LOCK_NB)) {
				next if $! == &amp;POSIX::EINTR;
				$this-&gt;error("$this-&gt;{filename} is locked by another process: $!");
				last;
			}
		}
		else {
			$implicit_readonly=1;
		}
	}
	if ($this-&gt;{readonly} || $implicit_readonly) {
		if (! open ($this-&gt;{_fh}, "&lt;", $this-&gt;{filename})) {
			$this-&gt;error("could not open $this-&gt;{filename}: $!");
			return; # always abort, even if not throwing fatal error
		}
	}

	$this-&gt;SUPER::init(@_);

	debug "db $this-&gt;{name}" =&gt; "loading database";

	while (! eof $this-&gt;{_fh}) {
		my ($item, $cache)=$this-&gt;{format}-&gt;read($this-&gt;{_fh});
		$this-&gt;{cache}-&gt;{$item}=$cache;
	}
	if ($this-&gt;{readonly} || $implicit_readonly) {
		close $this-&gt;{_fh};
	}
}


sub shutdown {
	my $this=shift;

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

	if (grep $this-&gt;{dirty}-&gt;{$_}, keys %{$this-&gt;{cache}}) {
		debug "db $this-&gt;{name}" =&gt; "saving database";
	}
	else {
		debug "db $this-&gt;{name}" =&gt; "no database changes, not saving";

		delete $this-&gt;{_fh};

		return 1;
	}

	sysopen(my $fh, $this-&gt;{filename}."-new",
			O_WRONLY|O_TRUNC|O_CREAT,$this-&gt;{mode}) or
		$this-&gt;error("could not write $this-&gt;{filename}-new: $!");
	while (! flock($fh, LOCK_EX | LOCK_NB)) {
		next if $! == &amp;POSIX::EINTR;
		$this-&gt;error("$this-&gt;{filename}-new is locked by another process: $!");
		last;
	}
	$this-&gt;{format}-&gt;beginfile;
	foreach my $item (sort keys %{$this-&gt;{cache}}) {
		next unless defined $this-&gt;{cache}-&gt;{$item}; # skip deleted
		$this-&gt;{format}-&gt;write($fh, $this-&gt;{cache}-&gt;{$item}, $item)
			or $this-&gt;error("could not write $this-&gt;{filename}-new: $!");
	}
	$this-&gt;{format}-&gt;endfile;

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

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

	delete $this-&gt;{_fh};

	return 1;
}


sub load {
	return undef;
}


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