#!/usr/bin/perl -w

=head1 NAME

Debconf::DbDriver::Cache - caching database driver

=cut

package Debconf::DbDriver::Cache;
use strict;
use Debconf::Log qw{:all};
use base 'Debconf::DbDriver';

=head1 DESCRIPTION

This is a base class for cacheable database drivers. Use this as the base
class for your driver if it makes sense to load and store items as a whole
(eg, if you are using text files to reprosent each item, or downloading whole
items over the net).

Don't use this base class for your driver if it makes more sense for your
driver to access individual parts of each item independantly (by
querying a (fast) database, for example).

=head1 FIELDS

=over 4

=item cache

A reference to a hash that holds the data for each loaded item in the
database. Each hash key is a item name; hash values are either undef
(used to indicate that a item used to exist here, but was deleted), or
are themselves references to hashes that hold the item data.

=item dirty

A reference to a hash that holds data about what items in the cache are
dirty. Each hash key is an item name; if the value is true, the item is
dirty.

=back

=cut

use fields qw(cache dirty);

=head1 ABSTRACT METHODS

Derived classes need to implement these methods in most cases.

=head2 load(itemname)

Load up the given item, and return a rather complex hashed structure to
represent the item. The structure is a reference to a hash with 4 items:

=over 4

=item owners

The value of this key must be a reference to a hash whose hash keys are
the owner names, and hash values are true.

=item fields

The value of this key must be a reference to a hash whose hash keys are
the field names, and hash values are the field values.

=item variables

The value of this key must be a reference to a hash whose hash keys are
the variable names, and hash values are the variable values.

=item flags

The value of this key must be a reference to a hash whose hash keys are
the flag names, and hash values are the flag values.

=back

If the item does not exist, return undef instead of the structure.

=head2 save(itemname,value)

This method will be passed a an identical hash reference with the same
format as what the load method should return. The data in the hash should
be saved.

=head2 remove(itemname)

Remove a item from the database.

=head1 METHODS

=head2 iterator

Derived classes should override this method and construct their own
iterator. Then at the end call:

	 $this->SUPER::iterator($myiterator);

This method will take it from there.

=cut

sub iterator {
	my $this=shift;
	my $subiterator=shift;

	my @items=keys %{$this->{cache}};
	my $iterator=Debconf::Iterator->new(callback => sub {
		# So, the trick is we will first iterate over everything in
		# the cache. Then, we will let the underlying driver take
		# over and iterate everything outside the cache. If it
		# returns something that is in the cache, or something that
		# is marked deleted in cache, just ask it for the next thing.
		while (my $item = pop @items) {
			next unless defined $this->{cache}->{$item};
			return $item;
		}
		return unless $subiterator;
		my $ret;
		do {
			$ret=$subiterator->iterate;
		} while defined $ret and exists $this->{cache}->{$ret};
		return $ret;
	});
	return $iterator;
}

=head2 exists(itemname)

Derived classes should override this method. Be sure to call
SUPER::exists(itemname) first, and return whatever it returns
*unless* it returns 0, to check if the item exists in the cache
first!

This method returns one of three values:

true  -- yes, it's in the cache
undef -- marked as deleted in the cache, so does not exist
0     -- not in the cache; up to derived class now

=cut

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

	return $this->{cache}->{$item}
		if exists $this->{cache}->{$item};
	return 0;
}

=head2 init

On initialization, the cache is empty.

=cut

sub init {
	my $this=shift;

	$this->{cache} = {} unless exists $this->{cache};
}

=cut

=head2 cached(itemname)

Ensure that a given item is loaded up in the cache. Returns the
cache entry for the item.

=cut

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

	unless (exists $this->{cache}->{$item}) {
		return unless $this->accept($item);
		debug "db $this->{name}" => "cache miss on $item";
		if (my $cache=$this->load($item)) {
			$this->{cache}->{$item}=$cache;
			$this->{dirty}->{$item}=0;
		}
	}
	return $this->{cache}->{$item};
}

=head2 shutdown

Synchronizes the underlying database with the cache.

Saving a item involves feeding the item from the cache into the underlying
database, and then telling the underlying db to save it.

However, if the item is undefined in the cache, we instead tell the
underlying db to remove it.

Returns true unless any of the operations fail.

=cut

sub shutdown {
	my $this=shift;
	
	return if $this->{readonly};

	my $ret=1;
	foreach my $item (keys %{$this->{cache}}) {
		if (not defined $this->{cache}->{$item}) {
			# Remove item, then remove marker in cache.
			$ret=undef unless defined $this->remove($item);
			delete $this->{cache}->{$item};
		}
		elsif ($this->{dirty}->{$item}) {
			$ret=undef unless defined $this->save($item, $this->{cache}->{$item});
			$this->{dirty}->{$item}=0;
		}
		
	}
	return $ret;
}

=head2 addowner(itemname, ownername)

Add an owner, if the underlying db is not readonly.

=cut

sub addowner {
	my $this=shift;
	my $item=shift;
	my $owner=shift;

	return if $this->{readonly};
	$this->cached($item);

	if (! defined $this->{cache}->{$item}) {
		return if ! $this->accept($item);
		debug "db $this->{name}" => "creating in-cache $item";
		# The item springs into existance.
		$this->{cache}->{$item}={
			owners => {},
			fields => {},
			variables => {},
			flags => {},
		}
	}

	$this->{dirty}->{$item}=1;
	$this->{cache}->{$item}->{owners}->{$owner}=1;
	return $owner;
}

=head2 removeowner(itemname, ownername)

Remove an owner from the cache. If all owners are removed, the item
is marked as removed in the cache.

=cut

sub removeowner {
	my $this=shift;
	my $item=shift;
	my $owner=shift;

	return if $this->{readonly};
	return unless $this->cached($item);

	if (exists $this->{cache}->{$item}->{owners}->{$owner}) {
		delete $this->{cache}->{$item}->{owners}->{$owner};
		$this->{dirty}->{$item}=1;
	}
	unless (keys %{$this->{cache}->{$item}->{owners}}) {
		$this->{cache}->{$item}=undef;
		$this->{dirty}->{$item}=1;
	}
	return $owner;
}

=head2 owners(itemname)

Pull owners out of the cache.

=cut

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

	return unless $this->cached($item);
	return keys %{$this->{cache}->{$item}->{owners}};
}

=head2 getfield(itemname, fieldname)

Pulls the field out of the cache.

=cut

sub getfield {
	my $this=shift;
	my $item=shift;
	my $field=shift;
	
	return unless $this->cached($item);
	return $this->{cache}->{$item}->{fields}->{$field};
}

=head2 setfield(itemname, fieldname, value)

Set the field in the cache, if the underlying db is not readonly.

=cut

sub setfield {
	my $this=shift;
	my $item=shift;
	my $field=shift;
	my $value=shift;

	return if $this->{readonly};
	return unless $this->cached($item);
	$this->{dirty}->{$item}=1;
	return $this->{cache}->{$item}->{fields}->{$field} = $value;	
}

=head2 removefield(itemname, fieldname)

Remove the field from the cache, if the underlying db is not readonly.

=cut

sub removefield {
	my $this=shift;
	my $item=shift;
	my $field=shift;

	return if $this->{readonly};
	return unless $this->cached($item);
	$this->{dirty}->{$item}=1;
	return delete $this->{cache}->{$item}->{fields}->{$field};
}

=head2 fields(itemname)

Pulls the field list out of the cache.

=cut

sub fields {
	my $this=shift;
	my $item=shift;
	
	return unless $this->cached($item);
	return keys %{$this->{cache}->{$item}->{fields}};
}

=head2 getflag(itemname, flagname)

Pulls the flag out of the cache.

=cut

sub getflag {
	my $this=shift;
	my $item=shift;
	my $flag=shift;
	
	return unless $this->cached($item);
	return $this->{cache}->{$item}->{flags}->{$flag}
		if exists $this->{cache}->{$item}->{flags}->{$flag};
	return 'false';
}

=head2 setflag(itemname, flagname, value)

Sets the flag in the cache, if the underlying db is not readonly.

=cut

sub setflag {
	my $this=shift;
	my $item=shift;
	my $flag=shift;
	my $value=shift;

	return if $this->{readonly};
	return unless $this->cached($item);
	$this->{dirty}->{$item}=1;
	return $this->{cache}->{$item}->{flags}->{$flag} = $value;
}

=head2 flags(itemname)

Pulls the flag list out of the cache.

=cut

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

	return unless $this->cached($item);
	return keys %{$this->{cache}->{$item}->{flags}};
}

=head2 getvariable(itemname, variablename)

Pulls the variable out of the cache.

=cut

sub getvariable {
	my $this=shift;
	my $item=shift;
	my $variable=shift;

	return unless $this->cached($item);
	return $this->{cache}->{$item}->{variables}->{$variable};
}

=head2 setvariable(itemname, variablename, value)

Sets the flag in the cache, if the underlying db is not readonly.

=cut

sub setvariable {
	my $this=shift;
	my $item=shift;
	my $variable=shift;
	my $value=shift;

	return if $this->{readonly};
	return unless $this->cached($item);
	$this->{dirty}->{$item}=1;
	return $this->{cache}->{$item}->{variables}->{$variable} = $value;
}

=head2 variables(itemname)

Pulls the variable list out of the cache.

=cut

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

	return unless $this->cached($item);
	return keys %{$this->{cache}->{$item}->{variables}};
}

=head1 AUTHOR

Joey Hess <joey@kitenet.net>

=cut

1
