The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use warnings;
use strict;

use lib 't/lib', 'lib';

use Frost::Test;

use Test::More tests => 84;
#use Test::More 'no_plan';

use Frost::Asylum;

#	Here Asylum acts like an object factory - no Foo->new used!

{
	package Foo;

	use Frost;

	has num	=> ( is => 'rw', isa => 'Int', required => 1 );		#	just in case...

	no Frost;

	__PACKAGE__->meta->make_immutable	( debug => 0 );
}

my $MAX_ID	= 5;
my $REST		= 0;

{
	my $ASYL;

	lives_ok	{ $ASYL	= Frost::Asylum->new ( data_root => $TMP_PATH ); }	'Asylum created';

	throws_ok	{ $ASYL->silence () }
		qr/Param class missing/,												'Error: silence w/o param';

	throws_ok	{ $ASYL->silence ( 'Bar' ) }
		qr/Can\'t locate object method "new" via package "Bar"/,		'Error: silence with unknown class';

	throws_ok	{ $ASYL->silence ( 'Foo' ) }
		qr/Attribute \(id\) is required/,									'Error: silence w/o id';

	throws_ok	{ $ASYL->silence ( 'Foo', 1 ) }
		qr/Attribute \(num\) is required/,									'Error: silence w/o num';

	#	We're not dead, test is still running, so let's clean up:
	#
	lives_ok	{ $ASYL->remove;	}												'Asylum removed';

	throws_ok	{ $ASYL->evoke () }
		qr/Param class missing at/,											'Error: evoke w/o param';

	throws_ok	{ $ASYL->evoke ( 'Foo' ) }
		qr/Param id missing/,													'Error: evoke w/o id';

	throws_ok	{ $ASYL->evoke ( 'Foo', 1 ) }
		qr/Can not evoke un-silenced Foo->1/,								'Error: evoke w/o silence';

	#	We're not dead, test is still running, so let's clean up:
	#
	lives_ok	{ $ASYL->remove;	}												'Asylum removed';

	throws_ok	{ $ASYL->absolve () }
		qr/Param class missing at/,											'Error: absolve w/o param';

	throws_ok	{ $ASYL->absolve ( 'Foo' ) }
		qr/Param id missing/,													'Error: absolve w/o id';

	throws_ok	{ $ASYL->absolve ( 'Foo', 1 ) }
		qr/Can not absolve un-evoked Foo->1/,								'Error: absolve w/o evoke';

	#	We're not dead, test is still running, so let's clean up:
	#
	lives_ok	{ $ASYL->remove;	}												'Asylum removed';

	throws_ok	{ $ASYL->excommunicate () }
		qr/Param class missing at/,											'Error: excommunicate w/o param';

	throws_ok	{ $ASYL->excommunicate ( 'Foo' ) }
		qr/Param id missing/,													'Error: excommunicate w/o id';

	throws_ok	{ $ASYL->excommunicate ( 'Foo', 1 ) }
		qr/Can not excommunicate un-absolved Foo->1/,					'Error: excommunicate w/o absolve';

	#	We're not dead, test is still running, so let's clean up:
	#
	lives_ok	{ $ASYL->remove;	}												'Asylum removed';
}

{
	my $ASYL;

	lives_ok	{ $ASYL	= Frost::Asylum->new ( data_root => $TMP_PATH ); }	'Asylum created';

	for ( 1..$MAX_ID )
	{
		my $foo;

		lives_ok	{ $foo	= $ASYL->silence ( 'Foo', $_, num => $_ * 1000 );	}	"silenced $_";

		isa_ok	$foo,	'Foo',						'$foo';
		isa_ok	$foo,	'Frost::Locum',	'$foo';
		isa_ok	$foo,	'Moose::Object',			'$foo';

		is $foo->num, $_ * 1000, "got the right foo->num for $_";
	}

	is $ASYL->count ( 'Foo' ),		0,					"no spirits buried";
	is $ASYL->twilight_count,			$MAX_ID,			"$MAX_ID spirits in twilight";

	lives_ok	{ $ASYL->close; }	'Asylum closed and saved';

	is $ASYL->count ( 'Foo' ),		$MAX_ID,			'all spirits absolved now';
	is $ASYL->twilight_count,			0,					'no spirits in twilight anymore';
}

{
	my $ASYL;

	lives_ok	{ $ASYL	= Frost::Asylum->new ( data_root => $TMP_PATH ); }	'Asylum created';

	is $ASYL->count ( 'Foo' ),		$MAX_ID,			"all spirits buried";
	is $ASYL->twilight_count,			0,					"no spirits in twilight";

	$REST	= $MAX_ID;

	for ( 1..$MAX_ID )
	{
		if ( $_ % 2 )
		{
			#	To be excommunicated, a spirit does not need to be evoked - as in real life ;-)
			lives_ok	{ $ASYL->excommunicate ( 'Foo', $_ ); }	"excommunicated the odd spirit $_";

			$REST--;
		}
		else
		{
			#	To be absolved, a spirit must to be evoked - as in real life, too ;-)
			lives_ok	{ $ASYL->evoke ( 'Foo', $_ ); }				"evoked the even spirit $_";
			lives_ok	{ $ASYL->absolve ( 'Foo', $_ ); }			"absolved the even spirit $_";
		}
	}

	is $ASYL->count ( 'Foo' ),		$REST,			"$REST spirits buried still";
	is $ASYL->twilight_count,			$REST,			"$REST in twilight still";

	lives_ok	{ $ASYL->close; }	'Asylum closed and saved';

	is $ASYL->count ( 'Foo' ),		$REST,			"$REST spirits absolved now";
	is $ASYL->twilight_count,			0,					'no spirits in twilight anymore';
}

{
	my $ASYL;

	lives_ok	{ $ASYL	= Frost::Asylum->new ( data_root => $TMP_PATH ); }	'Asylum created';

	is $ASYL->count ( 'Foo' ),		$REST,			"$REST spirits buried";

	$REST	= 0;

	for ( 1..$MAX_ID )
	{
		if ( $_ % 2 )
		{
			isnt	$ASYL->exists ( 'Foo', $_ ), true,	"spirit $_ burns in hell";
		}
		else
		{
			my $foo;

			lives_ok	{ $foo	= $ASYL->evoke ( 'Foo', $_ );	}	"evoked spirit $_";

			isa_ok	$foo,	'Foo',						'$foo';
			isa_ok	$foo,	'Frost::Locum',	'$foo';
			isa_ok	$foo,	'Moose::Object',			'$foo';

			is $foo->num, $_ * 1000, "got the right foo->num for $_";

			$REST++;
		}
	}

	is $ASYL->count ( 'Foo' ),		$REST,			"$REST spirits absolved now";
	is $ASYL->twilight_count,			$REST,			"$REST spirits in twilight now";

	lives_ok	{ $ASYL->close; }	'Asylum closed and saved';

	is $ASYL->count ( 'Foo' ),		$REST,			"$REST spirits absolved now";
	is $ASYL->twilight_count,			0,					'no spirits in twilight anymore';
}