package Yaala::Data::Persistent;

use strict;
use warnings;

=head1 Yaala::Data::Persistent

Saves datastructures to disk and retrieves them again. This allows data
to exist for longer than just one run.

=cut

use Yaala::Config qw#get_config get_checksum#;

@Yaala::Data::Persistent::EXPORT_OK = qw#init#;
@Yaala::Data::Persistent::ISA = ('Exporter');

our $HAVE_STORABLE = 0;
our $WANT_PERSISTENCY = 1;
our $DATA_STRUCTURE = {};
our $FILENAME = 'persistency.data';

my $VERSION = '$Id: Persistent.pm,v 1.5 2004/11/07 11:15:28 octo Exp $';
print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);

eval "use Storable qw#store retrieve#;";
if (!$@)
{
	$HAVE_STORABLE = 1;
	print STDERR ' - Storable is installed' if ($::DEBUG);
}
else
{
	print STDERR ' - Storable is NOT installed' if ($::DEBUG);
}

=head1 Configuration options

=head2 use_persistency

If set to false persistency will not be used, even if the required
module ``Storable'' is installed.

If unset it defaults to automatic detection of the ``Storable'' module
and uses persistency if possible.

=cut

if (get_config ('use_persistency'))
{
	my $want = lc (get_config ('use_persistency'));
	if ($want eq 'no' or $want eq 'false' or $want eq 'off')
	{
		$WANT_PERSISTENCY = 0;
	}
	elsif ($want eq 'yes' or $want eq 'true' or $want eq 'on')
	{
		if (!$HAVE_STORABLE)
		{
			print STDERR $/, __FILE__, ": You've set ``use_persistency'' to ``$want''.",
			$/, __FILE__, "  For this to work you need to have the perl module ``Storable'' installed.",
			$/, __FILE__, '  Please go to your nearest CPAN-mirror and install it first.',
			$/, __FILE__, '  This config-option will be ignored.';
		}
	}
	elsif ($want eq 'auto' or $want eq 'automatic')
	{
		# do nothing.. Already been done.
	}
	else
	{
		print STDERR $/, __FILE__, ": You've set ``use_persistency'' to ``$want''.",
		$/, __FILE__, '  This value is not understood and is being ignored.';
	}
}

=head2 persistency_file

Sets the file to store persistency data in. Defaults to
``persistency.data''

=cut

if (get_config ('persistency_file'))
{
	$FILENAME = get_config ('persistency_file');
}

if ($HAVE_STORABLE and $WANT_PERSISTENCY and -e $FILENAME)
{
	$DATA_STRUCTURE = retrieve ($FILENAME);

	my $checksum = get_checksum ();
	print STDERR $/, __FILE__, ": Config-checksum is ``$checksum''" if ($::DEBUG & 0x200);
	
	if (!defined ($DATA_STRUCTURE))
	{
		print STDERR $/, __FILE__, ": Persistent data could not be loaded.",
		$/, __FILE__, "``$FILENAME'' will be overwritten when the program exits.";
		$DATA_STRUCTURE = {'*CHECKSUM*' => $checksum};
	}
	else
	{
		if (!defined ($DATA_STRUCTURE->{'*CHECKSUM*'})
				or ($DATA_STRUCTURE->{'*CHECKSUM*'} ne $checksum))
		{
			print STDERR $/, __FILE__, ": Persistent data could be read, but checksums didn't match.",
			$/, __FILE__, ": The data will not be used and the file overwritten." if ($::DEBUG);

			if ($::DEBUG & 200)
			{
				if (!defined ($DATA_STRUCTURE->{'*CHECKSUM*'}))
				{
					print STDERR $/, __FILE__, ": \$DATA_STRUCTURE->{'*CHECKSUM*'} isn't defined.";
				}
				else
				{
					my $tmp = $DATA_STRUCTURE->{'*CHECKSUM*'};
					print STDERR $/, __FILE__, ": ``$tmp'' ne ``$checksum''";
				}
			}
			
			$DATA_STRUCTURE = {'*CHECKSUM*' => $checksum};
		}
	}
}
elsif ($HAVE_STORABLE and $WANT_PERSISTENCY and !-e $FILENAME)
{
	my $checksum = get_checksum ();
	print STDERR $/, __FILE__, ": Config-checksum is ``$checksum''" if ($::DEBUG & 0x200);

	$DATA_STRUCTURE = {'*CHECKSUM*' => $checksum};
}

return (1);

sub data_save
{
	if (!$HAVE_STORABLE) { return (undef); }
	
	my $pkg = caller;
	my $name = shift;
	my $ptr = shift;

	$DATA_STRUCTURE->{$pkg}{$name} = $ptr;
}

sub data_load
{
	if (!$HAVE_STORABLE) { return (undef); }
	
	my $pkg = caller;
	my $name = shift;
	my $ptr; # = undef;

	if (defined ($DATA_STRUCTURE->{$pkg}{$name}))
	{
		$ptr = $DATA_STRUCTURE->{$pkg}{$name};
	}
	
	return ($ptr);
}

=head1 Exported routines

=head2 init ($name, $type)

Initializes a variable in the persistency-namespace which is daved
automatically upon termination.

The type is needed for proper initialisazion when the persistency-file
could not be read. Valid veriable types are ``scalar'', ``hash'' and
``array''.

The name must be uniqe for each package so the module can identify which
variable is requested,

=cut

sub init
{
	my $pkg = caller;
	my $name = shift;
	my $type = shift;
	my $ptr;

	if (defined ($DATA_STRUCTURE->{$pkg}{$name}))
	{
		$ptr = $DATA_STRUCTURE->{$pkg}{$name};
	}
	else
	{
		if ($type eq 'scalar')
		{
			my $tmp = '';
			$ptr = \$tmp;
		}
		elsif ($type eq 'hash')
		{
			my %tmp = ();
			$ptr = \%tmp;
		}
		elsif ($type eq 'array')
		{
			my @tmp = ();
			$ptr = \@tmp;
		}
		else
		{
			die;
		}

		$DATA_STRUCTURE->{$pkg}{$name} = $ptr;
	}

	return ($ptr);
}

END
{
	if ($HAVE_STORABLE and $WANT_PERSISTENCY)
	{
		print STDERR $/, __FILE__, ": Writing persistent data to ``$FILENAME''" if ($::DEBUG);
		store ($DATA_STRUCTURE, $FILENAME);
	}
}
