package Rumsti;

use TM;
use base qw(TM);
use Class::Trait ('TM::Synchronizable' => { exclude => 'mtime' } );


our $sync_in_called = 0;
our $sync_out_called = 0;

# I use this to reset the counters
sub reset {
  $sync_in_called = 0;
  $sync_out_called = 0;
}

sub synced {
  return [ $sync_in_called, $sync_out_called ];
}

sub source_in {
  my $self = shift;

#warn "rumsti source in $self";
  $sync_in_called++;
}

sub source_out {
#warn "rumsti source out $self";
  $sync_out_called++;
}

sub mtime {
#warn "Rumsti mtime + 1";
    return time + 1; # fake that we always have something new
}


1;

package Ramsti;

use TM::Tau::Filter;
use base qw(TM::Tau::Filter);

our $sync_in_called = 0;
our $sync_out_called = 0;

# I use this to reset the counters
sub reset {
  $sync_in_called = 0;
  $sync_out_called = 0;
}

sub synced {
    return [ $sync_in_called, $sync_out_called ];
}

sub source_out {
    $sync_out_called++;
}

1;

#-- test suite

use strict;
use warnings;

#use Class::Trait 'debug';

# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More qw(no_plan);

use Data::Dumper;

sub _chomp {
    my $s = shift;
    chomp $s;
    return $s;
}

# create tmp file
my @tmp;
use IO::File;
use POSIX qw(tmpnam);
for (0..1) {
    do { $tmp[$_] = tmpnam().".atm" ;  } until IO::File->new ($tmp[$_], O_RDWR|O_CREAT|O_EXCL);
}
##warn "tmp is $tmp";


END { unlink (@tmp) || die "cannot unlink '@tmp' file(s), but I am finished anyway"; }

sub _mk_file {
    my $file = shift;
    my $fh = IO::File->new ("> $file") || die "so what?";
    print $fh "
aaa (bbb)
bn: AAA

(ccc)
ddd: eee
fff: ggg
";
$fh->close;
}

_mk_file ($tmp[0]);

#close STDIN;
open (STDIN, $tmp[0]);

#== TESTS =====================================================================

require_ok ('TM::Tau');


{ # basic tests
    my $tm = new TM::Tau ('null: > null:', sync_in => 0, sync_out => 0);
#warn "============> ". ref ($tm->left) . " <-- left -- " . ref ($tm);
#    warn "this is it ".Dumper $tm;

    ok ($tm->isa ('TM::Tau'),              'class');
    ok ($tm->isa ('TM::Tau::Filter'),      'class');
    ok ($tm->isa ('TM'),                   'class');
    ok ($tm->does ('TM::Serializable::Dumper'), 'default: filter trait');

    ok ($tm->left->isa ('TM::Materialized::Null'),     'left null becomes a memory map');
}

{ # default
    my $tm = new TM::Tau (undef, sync_in => 0, sync_out => 0);
    ok ($tm->isa ('TM::Tau::Filter'),              'default: top level');
    ok ($tm->left->isa ('TM::Materialized::Null'), 'default: left');

    ok ($tm->does ('TM::Serializable::Dumper'), 'default: filter trait');

#    warn "this is it ".Dumper $tm;
}

eval { # errors
    my $tm = new TM::Tau ({});
}; like ($@, qr/undefined scheme/, _chomp ($@));

eval { # error
  my $tm = new TM::Tau ('rumsti:');
}; like ($@, qr/undefined scheme/, _chomp $@);

{ # test to override driver module
    my $tm = new TM::Tau ('ramsti: { Rumsti }', sync_in => 0, sync_out => 0);
    ok (ref ($tm->left) eq 'Rumsti',       'override: in special driver');

    { # test to override driver module
	eval {
	    my $tm = new TM::Tau ('> ramsti: { Rxxxumsti }');
	}; like ($@, qr/cannot load/, _chomp $@);
    }
}

{ # canonicalization trivia
    foreach my $s ('null:', '> null: <', '> null: >', '< null: >') {
	my $tm = new TM::Tau ($s, sync_in => 0, sync_out => 0);
	ok (1,                                          "canonical: parsing $s");
	ok ($tm->isa ('TM::Tau'),                       'canonical: class');
	ok ($tm->does ('TM::Serializable::Dumper'),     'canonical: filter trait');
	ok ($tm->left->isa ('TM::Materialized::Null'),  'canonical: left null becomes a memory map');
    }
}

{ # complex structure
    my $tm = new TM::Tau ('(null: * null: + null:) > (null:) > (null:)', sync_in => 0, sync_out => 0);

    ok ($tm->isa ('TM::Tau'),                                          'top level');
    ok ($tm->does ('TM::Serializable::Dumper'),                        'top level does');

    ok ($tm->left->isa ('TM::Tau::Filter'),                            'second level');

    ok ($tm->left->left->isa ('TM::Tau::Federate'),                    'third level');

    ok ($tm->left->left->right->isa ('TM::Materialized::Null'),        'federate right level');
    ok ($tm->left->left->left->isa  ('TM::Tau::Filter'),               'federate left level');

    ok ($tm->left->left->left->left->isa  ('TM::Materialized::Null'),  'federate left left level');
}

#-- synchronisation manual ----------------------------------

# avoid being bothered by STDOUT
close STDOUT;
open STDOUT, ">$tmp[1]";


#-- sync automatic

use TM::Tau;
{ # testing events
    $TM::Tau::sources{'rumsti:'} = 'Rumsti';
    $TM::Tau::filters{'rumsti:'} = 'Ramsti';

    my $tests = {
 	'01 rumsti: > rumsti:'      => { uc => [ 1, 0 ],
					 ac => [ 0, 0 ], debug => 0,
					 ud => [ 1, 0 ],
					 ad => [ 0, 1 ] },
	
 	'02 rumsti:'                => { uc => [ 1, 0 ],
					 ac => [ 0, 0 ],
					 ud => [ 1, 0 ],
					 ad => [ 0, 0 ] },

   	'03 rumsti: >'              => { uc => [ 1, 0 ],
					 ac => [ 0, 0 ],
					 ud => [ 1, 0 ],
					 ad => [ 0, 0 ] },

  	'04 > rumsti:'              => { uc => [ 0, 0 ],
					 ac => [ 0, 0 ],
					 ud => [ 0, 0 ],
					 ad => [ 0, 1 ] },

  	'05 > rumsti: <'            => { uc => [ 1, 0 ],
					 ac => [ 0, 0 ],
					 ud => [ 1, 0 ],
					 ad => [ 0, 0 ] },

   	'06 > rumsti: >'            => { uc => [ 1, 0 ],
					 ac => [ 0, 0 ],
					 ud => [ 1, 0 ],
					 ad => [ 0, 1 ] },

   	'07 < rumsti: <'            => { uc => [ 0, 0 ],
					 ac => [ 0, 0 ],
					 ud => [ 0, 0 ],
					 ad => [ 0, 0 ] },

  	'08 < rumsti: >'            => { uc => [ 0, 0 ],
					 ac => [ 0, 0 ],
					 ud => [ 0, 0 ],
					 ad => [ 0, 1 ] },

    };

    foreach my $t (sort { $a cmp $b } keys %$tests) {
	Rumsti::reset;
	Ramsti::reset;
#	  next unless $t =~ /02/;
	  (my $tau = $t) =~ s/\d+\s*//;
        {
	    my $tm = new TM::Tau ($tau);

#warn Dumper [ $tm->does ('TM::Serializable::AsTMa') ]; exit;
#warn Dumper $tm;
#warn "============> ". ref ($tm->left) . " <-- left -- " . ref ($tm);
#warn "test $tau";
#warn Dumper $tm if $tests->{$t}->{debug};      

#    warn "synced after create ".Dumper Rumsti::synced;
	    ok (eq_array ($tests->{$t}->{uc}, Rumsti::synced), "$tau : rumsti after creation");
	    ok (eq_array ($tests->{$t}->{ac}, Ramsti::synced), "$tau : ramsti after creation");
#warn "Ramsti after create ".Dumper Ramsti::synced;

            $tm->internalize ('remsti'); # do something with the map, so that the timestamp is modified

	}
#warn "Rumsti synced after destruct ".Dumper Rumsti::synced;
#warn "Ramsti after decon ".Dumper Ramsti::synced;
	ok (eq_array ($tests->{$t}->{ud}, Rumsti::synced), "$tau : rumsti after deconstruction");
	ok (eq_array ($tests->{$t}->{ad}, Ramsti::synced), "$tau : ramsti after deconstruction");
    }
}

{ # test with +
    foreach my $i (1..4) {
	Rumsti::reset;
	  {
	      my $tm = new TM::Tau ('('. join (" + ", ('rumsti:') x $i). ' ) > -');

#warn "============> ". ref ($tm->left) . " <-- left -- " . ref ($tm);
	  }
#warn Dumper Rumsti::synced;
	  ok (eq_array (Rumsti::synced,	[ $i, 0 ]), "$i: federated sync in/out");
    }
}

{ # testing auto registration of filters
    eval {
	my $tm = new TM::Tau ('null: * http://psi.tm.bond.edu.au/queries/1.0/analyze');
    }; like ($@, qr/undefined scheme/, 'auto reg: '._chomp ($@));

    {
	eval "use TM::Tau::Filter::Analyze;"; # we do it to postpone the loading
	my $tm = new TM::Tau ('null: * http://psi.tm.bond.edu.au/queries/1.0/analyze');
    }; 
    ok (1, 'auto reg: detected');
}

foreach my $tau ('io:stdin > io:stdout', 'io:stdin > -', '- > -', '- > io:stdout') { # testing stdin and stdout
    # redirect all to the file
    open STDOUT, ">$tmp[1]";
    {
	my $tm = new TM::Tau ($tau);
#warn Dumper $tm;
    }

    my $fh = IO::File->new ($tmp[1]) || die "cannot reopen what I just wrote";
    local $/ = undef;
    my $s = <$fh>;
    close $fh;
#    warn $s;

    like ($s, qr/\$tm = bless/, "$tau: dumper found");
    {
	my $tm;
	eval $s; # Perl is so sick :-)
	ok ($tm->isa ('TM'), "$tau: map found");
	ok ($tm->mids ('thing'), "map has things");
    }
}

__END__



__END__