#!/usr/local/bin/perl -w

###############################################################################
# Purpose : Unit test for Sub::Slice
# Author  : Simon Flack, John Alden and Tim Sweetman
# Created : Jan 2003
# CVS     : $Header: /home/cvs/software/cvsroot/sub_slice/t/slice.t,v 1.18 2005/11/23 14:31:51 colinr Exp $
###############################################################################
# -t : trace
# -T : deep trace
# -s : save output
###############################################################################

use strict;
use Test::Assertions 'test';
use Log::Trace;
use Getopt::Std;
use File::Path;

$|++;
use lib './lib', '../lib';
plan tests => 63;

my $path = 'test_output';
my %default_options = (storage_options => { path => $path });
rmtree($path,1); #ensure clean even if last run was -s

getopts('tTs', \my %opt);

#
# START OF TESTS
#

my $Ends = 0;

eval { require Sub::Slice; };
ASSERT(!$@ && $INC{'Sub/Slice.pm'}, "Sub::Slice compiles");
TRACE($INC{'Sub/Slice.pm'});

import Log::Trace 'print' if $opt{t};
deep_import Log::Trace 'print' if $opt{T};

my $token = make_token();
ASSERT( real_token($token),  "Create new token");
DUMP($token);
ASSERT($token->{estimate} == 10, "Set estimate");
ASSERT($token->{status} eq 'not run', "Set status");

my $last_total = 0;
for (1 .. 30) {
	my $total = eval { keep_going( $token ) };
	if (my $e = $@) {
		print STDERR 'Error --> ', $e, $/;
	}
	ASSERT( real_token($token)  && $total && $total ne $last_total,
			'running slice #' . $token->count );
	ASSERT($token->stage() =~ m/^(first_stage|second_stage|final)$/,"token has next_stage property");
	$last_total = $total;
	last if $token->done;
}

# test iterate=0
$token = make_token(0);
eval {keep_going($token)};
ASSERT($token->done() && $token->count() > 1, 'unlimited iterations - pass through in one op');
DUMP($token);

# check tampering is trapped
$token = make_token();
$token->{id} = 0;
ASSERT( DIED(sub { keep_going($token) } ), "dies when ID is tampered with");

$token = make_token();
$token->{pin} = 0;
ASSERT( DIED(sub { keep_going($token) } ), "dies when pin is tampered with");

ASSERT($Ends == 2, "right number of cleanup steps done");

#
# Some tests on the $job itself
#

my $job = new Sub::Slice( 
	%default_options, 
	iterations => 1, 
	backend => 'Sub::Slice::Backend::Filesystem',
	pin_length => 1e7,
	auto_blob_threshold => 5,
);
DUMP($job);

#Pin length
ASSERT(length $job->token->{pin} == 7, "pin length");

#Auto blob storage
$job->store('non-blob', '12345'); #At BLOB threshold
ASSERT(! defined ($job->fetch_blob('non-blob')), "short value not stored as blob");
$job->store('is-blob', '123456'); #Over BLOB threshold
ASSERT($job->fetch_blob('is-blob') eq '123456' && $job->fetch('is-blob') eq '123456', "long value auto stored as blob");

# Test job accessors
$job->set_estimate(10);
ASSERT($job->estimate() == 10, "estimate accessor");
ASSERT($job->count() eq '0', "count accessor");

# Input checking
ASSERT(DIED(sub{ $job->id(1) }), "id mutator check");
ASSERT(DIED(sub{ $job->token(1) }), "token mutator check");
ASSERT(DIED(sub{ $job->estimate(1) }), "estimate mutator check");
ASSERT(DIED(sub{ $job->count(1) }), "count mutator check");
ASSERT(DIED(sub{ $job->is_done(1) }), "is_done mutator check");
ASSERT(DIED(sub{ $job->stage(1) }), "stage mutator check");
ASSERT(DIED(sub{ $job->done(1) }), "done() args check");

ASSERT(DIED(sub{ $job->store(undef,1) }) && DIED(sub{ $job->store([],1) }), "store input checks");
ASSERT(DIED(sub{ $job->fetch() }) && DIED(sub{ $job->fetch([]) }), "fetch input checks");
ASSERT(DIED(sub{ $job->next_stage() }) && DIED(sub{ $job->next_stage([]) }), "next_stage input checks");

# Constructor validation
ASSERT(DIED(sub{
	new Sub::Slice( %default_options, iterations => 1, backend => 'Sub::Slice::Backend::Missing' );
}), "Non-existant backend raises an exception");

ASSERT(DIED(sub{
	new Sub::Slice( %default_options, iterations => 1, backend => 'Sub::Slice::Backend::..' );
}), "Illegal backend name raises an exception");

ASSERT(DIED(sub{
	new Sub::Slice( %default_options, token => "fribble" );
}), "Garbage for token #1");

ASSERT(DIED(sub{
	new Sub::Slice( %default_options, token => [] );
}), "Garbage for token #2");

ASSERT(DIED(sub{
	new Sub::Slice( "fribble" );
}), "odd number of arguments");

#
# END OF TESTS
#

#Cleanup
undef $job; #Needed to release any open files on win32
if($opt{s}){
	warn("output files saved in $path\n");
} else {
	rmtree($path);
}

###################################################################################

sub real_token {
	return $_[0] &&  UNIVERSAL::isa(shift, 'Sub::Slice::Token');
}

sub make_token {
	my $iterate = shift;
	$iterate = 1 unless defined $iterate;
	my $job = new Sub::Slice( %default_options, iterations => $iterate, backend => 'Filesystem' );
	$job->set_estimate(10);
	$job->status("not run");
	DUMP($job);
	return $job->token
}

sub keep_going {
	# rather bloated example...
	my $token = shift;

	# Check that this all works the same if the token has lost its
	# blessedness (which happens if you serialise using XML::Simple,
	# for example)
	# However, if we were to actually USE this $job, the counter
	# ends up stuck at 0 because we're relying on the blessed hash
	# that's kept in $token. That's probably not ideal,
	# because, as I understand it, no transport mechanism emulates
	# call-by-reference.
	my $job = new Sub::Slice (%default_options, token => {%$token});
	my $id_again = $job->token->{id};
	ASSERT($id_again, "token has ID");

	undef $job;
	$job = new Sub::Slice (%default_options, token => $token);
	my $id = $job->token->{id};
	ASSERT($id, "token has ID");
	ASSERT($id_again eq $id, "reblessing fetch works identically");


	at_start $job sub {
			$job->store('CODE', __PACKAGE__);
			$job->store('name', 'Simon Flack');
			$job->store('count', 0);
			$job->store('total', 0.1);
			$job->store_blob('data/foo.txt', "data");
		};
	at_stage $job 'first_stage',
		sub {
			$job->next_stage('second_stage');
			ASSERT($job->fetch('count') == 0, "check 0/undef distinction");
			$job->store('count', 1);
			my $file_data = $job->fetch_blob('data/foo.txt');
			die "file data missing or incorrect" unless $file_data eq 'data';
		};
	at_stage $job 'second_stage',
		sub {
			my $count = $job->fetch('count');
			$job->store('count', $count + 1);
			$job->next_stage('final') if $job->fetch('count') == 5;
		};
	at_stage $job 'never_happens',
		sub {
			die("Should never happen");
		};
	at_stage $job 'final',
		sub {
			my $name = $job->fetch('name');
			$job->done;
		};
	at_end $job
		sub {
			TRACE ("at_end");
			$job->status("ended");
			$Ends++;
		};

	$job->store('total', $job->fetch('count') + $job->fetch('total'));
	return $job->fetch('total');
}