#
# (C) Copyright 2011-2012 Sergey A. Babkin.
# This file is a part of Triceps.
# See the file COPYRIGHT for the copyright notice and license information
#
# The example of clearing the data in small chunks.

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

# change 'tests => 1' to 'tests => last_test_to_print';

use ExtUtils::testlib;

use Test;
BEGIN { plan tests => 2 };
use Triceps;
use Carp;
ok(1); # If we made it this far, we're ok.

use strict;

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

# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.

#########################
# helper functions to support either user i/o or i/o from vars

# vars to serve as input and output sources
my @input;
my $result;

# simulates user input: returns the next line or undef
sub readLine # ()
{
	$_ = shift @input;
	$result .= "> $_" if defined $_; # have the inputs overlap in result, as on screen
	return $_;
}

# write a message to user
sub send # (@message)
{
	$result .= join('', @_);
}

# versions for the real user interaction
sub readLineX # ()
{
	$_ = <STDIN>;
	return $_;
}

sub sendX # (@message)
{
	print @_;
}

# a template to make a label that prints the data passing through another label
sub makePrintLabel($$) # ($print_label_name, $parent_label)
{
	my $name = shift;
	my $lbParent = shift;
	my $lb = $lbParent->getUnit()->makeLabel($lbParent->getType(), $name,
		undef, sub { # (label, rowop)
			&send($_[1]->printP(), "\n");
		}) or confess "$!";
	$lbParent->chain($lb) or confess "$!";
	return $lb;
}


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

sub doClearChunks {

our $uChunks = Triceps::Unit->new("uChunks");

# data is just some dumb easily-generated filler
our $rtData = Triceps::RowType->new(
	s => "string",
	i => "int32",
) or confess "$!";

# the data is auto-generated by a sequence
our $seq = 0;

our $ttData = Triceps::TableType->new($rtData)
	->addSubIndex("fifo", Triceps::IndexType->newFifo())
or confess "$!";
$ttData->initialize() or confess "$!";
our $tData = $uChunks->makeTable($ttData,
	&Triceps::EM_CALL, "tJoin1"
) or confess "$!";
makePrintLabel("lbPrintData", $tData->getOutputLabel());

# notifications about the clearing
our $rtNote = Triceps::RowType->new(
	text => "string",
) or confess "$!";

# rowops to run when the model is otherwise idle
our $trayIdle = $uChunks->makeTray();

our $lbReportNote = $uChunks->makeDummyLabel($rtNote, "lbReportNote"
) or confess "$!";
makePrintLabel("lbPrintNote", $lbReportNote);

# code that clears the table in small chunks
our $lbClear = $uChunks->makeLabel($rtNote, "lbClear", undef, sub {
	my $limit = 2; # no more than 2 rows per run
	my $next;
	for (my $rhit = $tData->begin(); !$rhit->isNull(); $rhit = $next) {
		if ($limit-- <= 0) {
			# request to be called again when the model becomes idle
			$trayIdle->push($_[0]->adopt($_[1])); 
			return;
		}
		$next = $rhit->next(); # advance before removal
		$tData->remove($rhit);
	}
	$uChunks->makeHashCall($lbReportNote, "OP_INSERT",
		text => "done clearing",
	);
}) or confess "$!";

while(&readLine) {
	chomp;
	my @data = split(/,/); # starts with a command, then string opcode
	my $type = shift @data;
	if ($type eq "data") {
		my $count = shift @data;
		for (; $count > 0; $count--) {
			++$seq;
			$uChunks->makeHashCall($tData->getInputLabel(), "OP_INSERT",
				s => ("data_" . $seq),
				i => $seq,
			);
		}
	} elsif ($type eq "dump") {
		for (my $rhit = $tData->begin(); !$rhit->isNull(); $rhit = $rhit->next()) {
			&send("dump: ", $rhit->getRow()->printP(), "\n");
		}
		for my $r ($trayIdle->toArray()) {
			&send("when idle: ", $r->printP(), "\n");
		}
	} elsif ($type eq "clear") {
		$uChunks->makeHashCall($lbClear, "OP_INSERT",
			text => "clear",
		);
	} elsif ($type eq "idle") {
		$uChunks->schedule($trayIdle);
		$trayIdle->clear();
	}
	$uChunks->drainFrame(); # just in case, for completeness
}

} # doClearChunks

@input = (
	"data,1\n",
	"clear\n",
	"data,5\n",
	"clear\n",
	"dump\n",
	"idle\n",
	"data,1\n",
	"dump\n",
	"idle\n",
	"dump\n",
	"idle\n",
);
$result = undef;
&doClearChunks();
#print $result;
ok($result, 
'> data,1
tJoin1.out OP_INSERT s="data_1" i="1" 
> clear
tJoin1.out OP_DELETE s="data_1" i="1" 
lbReportNote OP_INSERT text="done clearing" 
> data,5
tJoin1.out OP_INSERT s="data_2" i="2" 
tJoin1.out OP_INSERT s="data_3" i="3" 
tJoin1.out OP_INSERT s="data_4" i="4" 
tJoin1.out OP_INSERT s="data_5" i="5" 
tJoin1.out OP_INSERT s="data_6" i="6" 
> clear
tJoin1.out OP_DELETE s="data_2" i="2" 
tJoin1.out OP_DELETE s="data_3" i="3" 
> dump
dump: s="data_4" i="4" 
dump: s="data_5" i="5" 
dump: s="data_6" i="6" 
when idle: lbClear OP_INSERT text="clear" 
> idle
tJoin1.out OP_DELETE s="data_4" i="4" 
tJoin1.out OP_DELETE s="data_5" i="5" 
> data,1
tJoin1.out OP_INSERT s="data_7" i="7" 
> dump
dump: s="data_6" i="6" 
dump: s="data_7" i="7" 
when idle: lbClear OP_INSERT text="clear" 
> idle
tJoin1.out OP_DELETE s="data_6" i="6" 
tJoin1.out OP_DELETE s="data_7" i="7" 
lbReportNote OP_INSERT text="done clearing" 
> dump
> idle
');
